git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/Bweb.pm

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6     Copyright (C) 2006 Eric Bollengier
   7         All rights reserved.
   8
   9     This program is free software; you can redistribute it and/or modify
  10     it under the terms of the GNU General Public License as published by
  11     the Free Software Foundation; either version 2 of the License, or
  12     any later version.
  13
  14     This program is distributed in the hope that it will be useful,
  15     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17     GNU General Public License for more details.
  18
  19     You should have received a copy of the GNU General Public License
  20     along with this program; if not, write to the Free Software
  21     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 =head1 VERSION
  24
  25     $Id$
  26
  27 =cut
  28
  29 package Bweb::Gui;
  30
  31 =head1 PACKAGE
  32
  33     Bweb::Gui - Base package for all Bweb object
  34
  35 =head2 DESCRIPTION
  36
  37     This package define base fonction like new, display, etc..
  38
  39 =cut
  40
  41 use HTML::Template;
  42 our $template_dir='/usr/share/bweb/tpl';
  43
  44
  45 =head1 FUNCTION
  46
  47     new - creation a of new Bweb object
  48
  49 =head2 DESCRIPTION
  50
  51     This function take an hash of argument and place them
  52     on bless ref
  53
  54     IE : $obj = new Obj(name => 'test', age => '10');
  55
  56          $obj->{name} eq 'test' and $obj->{age} eq 10
  57
  58 =cut
  59
  60 sub new
  61 {
  62     my ($class, %arg) = @_;
  63     my $self = bless {
  64         name => undef,
  65     }, $class;
  66
  67     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
  68
  69     return $self;
  70 }
  71
  72 sub debug
  73 {
  74     my ($self, $what) = @_;
  75
  76     if ($self->{debug}) {
  77         if (ref $what) {
  78             print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
  79         } else {
  80             print "<pre>$what</pre>";
  81         }
  82     }
  83 }
  84
  85 =head1 FUNCTION
  86
  87     error - display an error to the user
  88
  89 =head2 DESCRIPTION
  90
  91     this function set $self->{error} with arg, display a message with
  92     error.tpl and return 0
  93
  94 =head2 EXAMPLE
  95
  96     unless (...) {
  97         return $self->error("Can't use this file");
  98     }
  99
 100 =cut
 101
 102 sub error
 103 {
 104     my ($self, $what) = @_;
 105     $self->{error} = $what;
 106     $self->display($self, 'error.tpl');
 107     return 0;
 108 }
 109
 110 =head1 FUNCTION
 111
 112     display - display an html page with HTML::Template
 113
 114 =head2 DESCRIPTION
 115
 116     this function is use to render all html codes. it takes an
 117     ref hash as arg in which all param are usable in template.
 118
 119     it will use global template_dir to search the template file.
 120
 121     hash keys are not sensitive. See HTML::Template for more
 122     explanations about the hash ref. (it's can be quiet hard to understand)
 123
 124 =head2 EXAMPLE
 125
 126     $ref = { name => 'me', age => 26 };
 127     $self->display($ref, "people.tpl");
 128
 129 =cut
 130
 131 sub display
 132 {
 133     my ($self, $hash, $tpl) = @_ ;
 134
 135     my $template = HTML::Template->new(filename => $tpl,
 136                                        path =>[$template_dir],
 137                                        die_on_bad_params => 0,
 138                                        case_sensitive => 0);
 139
 140     foreach my $var (qw/limit offset/) {
 141
 142         unless ($hash->{$var}) {
 143             my $value = CGI::param($var) || '';
 144
 145             if ($value =~ /^(\d+)$/) {
 146                 $template->param($var, $1) ;
 147             }
 148         }
 149     }
 150
 151     $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
 152     $template->param('loginname', CGI::remote_user());
 153
 154     $template->param($hash);
 155     print $template->output();
 156 }
 157 1;
 158
 159 ################################################################
 160
 161 package Bweb::Config;
 162
 163 use base q/Bweb::Gui/;
 164
 165 =head1 PACKAGE
 166
 167     Bweb::Config - read, write, display, modify configuration
 168
 169 =head2 DESCRIPTION
 170
 171     this package is used for manage configuration
 172
 173 =head2 USAGE
 174
 175     $conf = new Bweb::Config(config_file => '/path/to/conf');
 176     $conf->load();
 177
 178     $conf->edit();
 179
 180     $conf->save();
 181
 182 =cut
 183
 184 use CGI;
 185
 186 =head1 PACKAGE VARIABLE
 187
 188     %k_re - hash of all acceptable option.
 189
 190 =head2 DESCRIPTION
 191
 192     this variable permit to check all option with a regexp.
 193
 194 =cut
 195
 196 our %k_re = ( dbi      => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
 197               user     => qr/^([\w\d\.-]+)$/i,
 198               password => qr/^(.*)$/i,
 199               template_dir => qr!^([/\w\d\.-]+)$!,
 200               debug    => qr/^(on)?$/,
 201               email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
 202               graph_font  => qr!^([/\w\d\.-]+.ttf)$!,
 203               bconsole    => qr!^(.+)?$!,
 204               syslog_file => qr!^(.+)?$!,
 205               log_dir     => qr!^(.+)?$!,
 206               );
 207
 208 =head1 FUNCTION
 209
 210     load - load config_file
 211
 212 =head2 DESCRIPTION
 213
 214     this function load the specified config_file.
 215
 216 =cut
 217
 218 sub load
 219 {
 220     my ($self) = @_ ;
 221
 222     unless (open(FP, $self->{config_file}))
 223     {
 224         return $self->error("$self->{config_file} : $!");
 225     }
 226     my $f=''; my $tmpbuffer;
 227     while(read FP,$tmpbuffer,4096)
 228     {
 229         $f .= $tmpbuffer;
 230     }
 231     close(FP);
 232
 233     my $VAR1;
 234
 235     no strict; # I have no idea of the contents of the file
 236     eval "$f" ;
 237     use strict;
 238
 239     if ($f and $@) {
 240         $self->load_old();
 241         $self->save();
 242         return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
 243     }
 244
 245     foreach my $k (keys %$VAR1) {
 246         $self->{$k} = $VAR1->{$k};
 247     }
 248
 249     return 1;
 250 }
 251
 252 =head1 FUNCTION
 253
 254     load_old - load old configuration format
 255
 256 =cut
 257
 258 sub load_old
 259 {
 260     my ($self) = @_ ;
 261
 262     unless (open(FP, $self->{config_file}))
 263     {
 264         return $self->error("$self->{config_file} : $!");
 265     }
 266
 267     while (my $line = <FP>)
 268     {
 269         chomp($line);
 270         my ($k, $v) = split(/\s*=\s*/, $line, 2);
 271         if ($k_re{$k}) {
 272             $self->{$k} = $v;
 273         }
 274     }
 275
 276     close(FP);
 277     return 1;
 278 }
 279
 280 =head1 FUNCTION
 281
 282     save - save the current configuration to config_file
 283
 284 =cut
 285
 286 sub save
 287 {
 288     my ($self) = @_ ;
 289
 290     if ($self->{ach_list}) {
 291         # shortcut for display_begin
 292         $self->{achs} = [ map {{ name => $_ }}
 293                           keys %{$self->{ach_list}}
 294                         ];
 295     }
 296
 297     unless (open(FP, ">$self->{config_file}"))
 298     {
 299         return $self->error("$self->{config_file} : $!\n" .
 300                             "You must add this to your config file\n"
 301                             . Data::Dumper::Dumper($self));
 302     }
 303
 304     print FP Data::Dumper::Dumper($self);
 305
 306     close(FP);
 307     return 1;
 308 }
 309
 310 =head1 FUNCTIONS
 311
 312     edit, view, modify - html form ouput
 313
 314 =cut
 315
 316 sub edit
 317 {
 318     my ($self) = @_ ;
 319
 320     $self->display($self, "config_edit.tpl");
 321 }
 322
 323 sub view
 324 {
 325     my ($self) = @_ ;
 326     $self->display($self, "config_view.tpl");
 327 }
 328
 329 sub modify
 330 {
 331     my ($self) = @_;
 332
 333     $self->{error} = '';
 334     $self->{debug} = 0;
 335
 336     foreach my $k (CGI::param())
 337     {
 338         next unless (exists $k_re{$k}) ;
 339         my $val = CGI::param($k);
 340         if ($val =~ $k_re{$k}) {
 341             $self->{$k} = $1;
 342         } else {
 343             $self->{error} .= "bad parameter : $k = [$val]";
 344         }
 345     }
 346
 347     $self->view();
 348
 349     if ($self->{error}) {       # an error as occured
 350         $self->display($self, 'error.tpl');
 351     } else {
 352         $self->save();
 353     }
 354 }
 355
 356 1;
 357
 358 ################################################################
 359
 360 package Bweb::Client;
 361
 362 use base q/Bweb::Gui/;
 363
 364 =head1 PACKAGE
 365
 366     Bweb::Client - Bacula FD
 367
 368 =head2 DESCRIPTION
 369
 370     this package is use to do all Client operations like, parse status etc...
 371
 372 =head2 USAGE
 373
 374     $client = new Bweb::Client(name => 'zog-fd');
 375     $client->status();            # do a 'status client=zog-fd'
 376
 377 =cut
 378
 379 =head1 FUNCTION
 380
 381     display_running_job - Html display of a running job
 382
 383 =head2 DESCRIPTION
 384
 385     this function is used to display information about a current job
 386
 387 =cut
 388
 389 sub display_running_job
 390 {
 391     my ($self, $conf, $jobid) = @_ ;
 392
 393     my $status = $self->status($conf);
 394
 395     if ($jobid) {
 396         if ($status->{$jobid}) {
 397             $self->display($status->{$jobid}, "client_job_status.tpl");
 398         }
 399     } else {
 400         for my $id (keys %$status) {
 401             $self->display($status->{$id}, "client_job_status.tpl");
 402         }
 403     }
 404 }
 405
 406 =head1 FUNCTION
 407
 408     $client = new Bweb::Client(name => 'plume-fd');
 409
 410     $client->status($bweb);
 411
 412 =head2 DESCRIPTION
 413
 414     dirty hack to parse "status client=xxx-fd"
 415
 416 =head2 INPUT
 417
 418    JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
 419        Backup Job started: 06-jun-06 17:22
 420        Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
 421        Files Examined=10,697
 422        Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
 423        SDReadSeqNo=5 fd=5
 424
 425 =head2 OUTPUT
 426
 427     $VAR1 = { 105 => {
 428                 JobName => Full_plume.2006-06-06_17.22.23,
 429                 JobId => 105,
 430                 Files => 8,971,
 431                 Bytes => 194,484,132,
 432                 ...
 433               },
 434               ...
 435     };
 436
 437 =cut
 438
 439 sub status
 440 {
 441     my ($self, $conf) = @_ ;
 442
 443     if (defined $self->{cur_jobs}) {
 444         return $self->{cur_jobs} ;
 445     }
 446
 447     my $arg = {};
 448     my $b = new Bconsole(pref => $conf);
 449     my $ret = $b->send_cmd("st client=$self->{name}");
 450     my @param;
 451     my $jobid;
 452
 453     for my $r (split(/\n/, $ret)) {
 454         chomp($r);
 455         $r =~ s/(^\s+|\s+$)//g;
 456         if ($r =~ /JobId (\d+) Job (\S+)/) {
 457             if ($jobid) {
 458                 $arg->{$jobid} = { @param, JobId => $jobid } ;
 459             }
 460
 461             $jobid = $1;
 462             @param = ( JobName => $2 );
 463
 464         } elsif ($r =~ /=.+=/) {
 465             push @param, split(/\s+|\s*=\s*/, $r) ;
 466
 467         } elsif ($r =~ /=/) {   # one per line
 468             push @param, split(/\s*=\s*/, $r) ;
 469
 470         } elsif ($r =~ /:/) {   # one per line
 471             push @param, split(/\s*:\s*/, $r, 2) ;
 472         }
 473     }
 474
 475     if ($jobid and @param) {
 476         $arg->{$jobid} = { @param,
 477                            JobId => $jobid,
 478                            Client => $self->{name},
 479                        } ;
 480     }
 481
 482     $self->{cur_jobs} = $arg ;
 483
 484     return $arg;
 485 }
 486 1;
 487
 488 ################################################################
 489
 490 package Bweb::Autochanger;
 491
 492 use base q/Bweb::Gui/;
 493
 494 =head1 PACKAGE
 495
 496     Bweb::Autochanger - Object to manage Autochanger
 497
 498 =head2 DESCRIPTION
 499
 500     this package will parse the mtx output and manage drives.
 501
 502 =head2 USAGE
 503
 504     $auto = new Bweb::Autochanger(precmd => 'sudo');
 505     or
 506     $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
 507
 508     $auto->status();
 509
 510     $auto->slot_is_full(10);
 511     $auto->transfer(10, 11);
 512
 513 =cut
 514
 515 sub new
 516 {
 517     my ($class, %arg) = @_;
 518
 519     my $self = bless {
 520         name  => '',    # autochanger name
 521         label => {},    # where are volume { label1 => 40, label2 => drive0 }
 522         drive => [],    # drive use [ 'media1', 'empty', ..]
 523         slot  => [],    # slot use [ undef, 'empty', 'empty', ..] no slot 0
 524         io    => [],    # io slot number list [ 41, 42, 43...]
 525         info  => {slot => 0,    # informations (slot, drive, io)
 526                   io   => 0,
 527                   drive=> 0,
 528                  },
 529         mtxcmd => '/usr/sbin/mtx',
 530         debug => 0,
 531         device => '/dev/changer',
 532         precmd => '',   # ssh command
 533         bweb => undef,  # link to bacula web object (use for display)
 534     } ;
 535
 536     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
 537
 538     return $self;
 539 }
 540
 541 =head1 FUNCTION
 542
 543     status - parse the output of mtx status
 544
 545 =head2 DESCRIPTION
 546
 547     this function will launch mtx status and parse the output. it will
 548     give a perlish view of the autochanger content.
 549
 550     it uses ssh if the autochanger is on a other host.
 551
 552 =cut
 553
 554 sub status
 555 {
 556     my ($self) = @_;
 557     my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
 558
 559     # TODO : reset all infos
 560     $self->{info}->{drive} = 0;
 561     $self->{info}->{slot}  = 0;
 562     $self->{info}->{io}    = 0;
 563
 564     #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
 565
 566 #
 567 #  Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
 568 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
 569 #Data Transfer Element 1:Empty
 570 #      Storage Element 1:Empty
 571 #      Storage Element 2:Full :VolumeTag=000002
 572 #      Storage Element 3:Empty
 573 #      Storage Element 4:Full :VolumeTag=000004
 574 #      Storage Element 5:Full :VolumeTag=000001
 575 #      Storage Element 6:Full :VolumeTag=000003
 576 #      Storage Element 7:Empty
 577 #      Storage Element 41 IMPORT/EXPORT:Empty
 578 #      Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
 579 #
 580
 581     for my $l (@out) {
 582
 583         #          Storage Element 7:Empty
 584         #          Storage Element 2:Full :VolumeTag=000002
 585         if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
 586
 587             if ($2 eq 'Empty') {
 588                 $self->set_empty_slot($1);
 589             } else {
 590                 $self->set_slot($1, $4);
 591             }
 592
 593         } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
 594
 595             if ($2 eq 'Empty') {
 596                 $self->set_empty_drive($1);
 597             } else {
 598                 $self->set_drive($1, $4, $6);
 599             }
 600
 601         } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
 602         {
 603             if ($2 eq 'Empty') {
 604                 $self->set_empty_io($1);
 605             } else {
 606                 $self->set_io($1, $4);
 607             }
 608
 609 #       Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
 610
 611         } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
 612             $self->{info}->{drive} = $1;
 613             $self->{info}->{slot} = $2;
 614             if ($l =~ /(\d+)\s+Import/) {
 615                 $self->{info}->{io} = $1 ;
 616             } else {
 617                 $self->{info}->{io} = 0;
 618             }
 619         }
 620     }
 621
 622     $self->debug($self) ;
 623 }
 624
 625 sub is_slot_loaded
 626 {
 627     my ($self, $slot) = @_;
 628
 629     # no barcodes
 630     if ($self->{slot}->[$slot] eq 'loaded') {
 631         return 1;
 632     }
 633
 634     my $label = $self->{slot}->[$slot] ;
 635
 636     return $self->is_media_loaded($label);
 637 }
 638
 639 sub unload
 640 {
 641     my ($self, $drive, $slot) = @_;
 642
 643     return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
 644     return 0 if     ($self->slot_is_full($slot)) ;
 645
 646     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
 647
 648     if ($? == 0) {
 649         my $content = $self->get_slot($slot);
 650         print "content = $content<br/> $drive => $slot<br/>";
 651         $self->set_empty_drive($drive);
 652         $self->set_slot($slot, $content);
 653         return 1;
 654     } else {
 655         $self->{error} = $out;
 656         return 0;
 657     }
 658 }
 659
 660 # TODO: load/unload have to use mtx script from bacula
 661 sub load
 662 {
 663     my ($self, $drive, $slot) = @_;
 664
 665     return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
 666     return 0 unless ($self->slot_is_full($slot)) ;
 667
 668     print "Loading drive $drive with slot $slot<br/>\n";
 669     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
 670
 671     if ($? == 0) {
 672         my $content = $self->get_slot($slot);
 673         print "content = $content<br/> $slot => $drive<br/>";
 674         $self->set_drive($drive, $slot, $content);
 675         return 1;
 676     } else {
 677         $self->{error} = $out;
 678         print $out;
 679         return 0;
 680     }
 681 }
 682
 683 sub is_media_loaded
 684 {
 685     my ($self, $media) = @_;
 686
 687     unless ($self->{label}->{$media}) {
 688         return 0;
 689     }
 690
 691     if ($self->{label}->{$media} =~ /drive\d+/) {
 692         return 1;
 693     }
 694
 695     return 0;
 696 }
 697
 698 sub have_io
 699 {
 700     my ($self) = @_;
 701     return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
 702 }
 703
 704 sub set_io
 705 {
 706     my ($self, $slot, $tag) = @_;
 707     $self->{slot}->[$slot] = $tag || 'full';
 708     push @{ $self->{io} }, $slot;
 709
 710     if ($tag) {
 711         $self->{label}->{$tag} = $slot;
 712     }
 713 }
 714
 715 sub set_empty_io
 716 {
 717     my ($self, $slot) = @_;
 718
 719     push @{ $self->{io} }, $slot;
 720
 721     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 722         $self->{slot}->[$slot] = 'empty';
 723     }
 724 }
 725
 726 sub get_slot
 727 {
 728     my ($self, $slot) = @_;
 729     return $self->{slot}->[$slot];
 730 }
 731
 732 sub set_slot
 733 {
 734     my ($self, $slot, $tag) = @_;
 735     $self->{slot}->[$slot] = $tag || 'full';
 736
 737     if ($tag) {
 738         $self->{label}->{$tag} = $slot;
 739     }
 740 }
 741
 742 sub set_empty_slot
 743 {
 744     my ($self, $slot) = @_;
 745
 746     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 747         $self->{slot}->[$slot] = 'empty';
 748     }
 749 }
 750
 751 sub set_empty_drive
 752 {
 753     my ($self, $drive) = @_;
 754     $self->{drive}->[$drive] = 'empty';
 755 }
 756
 757 sub set_drive
 758 {
 759     my ($self, $drive, $slot, $tag) = @_;
 760     $self->{drive}->[$drive] = $tag || $slot;
 761
 762     $self->{slot}->[$slot] = $tag || 'loaded';
 763
 764     if ($tag) {
 765         $self->{label}->{$tag} = "drive$drive";
 766     }
 767 }
 768
 769 sub slot_is_full
 770 {
 771     my ($self, $slot) = @_;
 772
 773     # slot don't exists => full
 774     if (not defined $self->{slot}->[$slot]) {
 775         return 0 ;
 776     }
 777
 778     if ($self->{slot}->[$slot] eq 'empty') {
 779         return 0;
 780     }
 781     return 1;                   # vol, full, loaded
 782 }
 783
 784 sub slot_get_first_free
 785 {
 786     my ($self) = @_;
 787     for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
 788         return $slot unless ($self->slot_is_full($slot));
 789     }
 790 }
 791
 792 sub io_get_first_free
 793 {
 794     my ($self) = @_;
 795
 796     foreach my $slot (@{ $self->{io} }) {
 797         return $slot unless ($self->slot_is_full($slot));
 798     }
 799     return 0;
 800 }
 801
 802 sub get_media_slot
 803 {
 804     my ($self, $media) = @_;
 805
 806     return $self->{label}->{$media} ;
 807 }
 808
 809 sub have_media
 810 {
 811     my ($self, $media) = @_;
 812
 813     return defined $self->{label}->{$media} ;
 814 }
 815
 816 sub send_to_io
 817 {
 818     my ($self, $slot) = @_;
 819
 820     unless ($self->slot_is_full($slot)) {
 821         print "Autochanger $self->{name} slot $slot is empty\n";
 822         return 1;               # ok
 823     }
 824
 825     # first, eject it
 826     if ($self->is_slot_loaded($slot)) {
 827         # bconsole->umount
 828         # self->eject
 829         print "Autochanger $self->{name} $slot is currently in use\n";
 830         return 0;
 831     }
 832
 833     # autochanger must have I/O
 834     unless ($self->have_io()) {
 835         print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
 836         return 0;
 837     }
 838
 839     my $dst = $self->io_get_first_free();
 840
 841     unless ($dst) {
 842         print "Autochanger $self->{name} you must empty I/O first\n";
 843     }
 844
 845     $self->transfer($slot, $dst);
 846 }
 847
 848 sub transfer
 849 {
 850     my ($self, $src, $dst) = @_ ;
 851     print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
 852     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
 853
 854     if ($? == 0) {
 855         my $content = $self->get_slot($src);
 856         print "$content ($src) => $dst<br/>";
 857         $self->{slot}->[$src] = 'empty';
 858         $self->set_slot($dst, $content);
 859         return 1;
 860     } else {
 861         $self->{error} = $out;
 862         return 0;
 863     }
 864 }
 865
 866 sub get_drive_name
 867 {
 868     my ($self, $index) = @_;
 869     return $self->{drive_name}->[$index];
 870 }
 871
 872 # TODO : do a tapeinfo request to get informations
 873 sub tapeinfo
 874 {
 875     my ($self) = @_;
 876 }
 877
 878 sub clear_io
 879 {
 880     my ($self) = @_;
 881
 882     for my $slot (@{$self->{io}})
 883     {
 884         if ($self->is_slot_loaded($slot)) {
 885             print "$slot is currently loaded\n";
 886             next;
 887         }
 888
 889         if ($self->slot_is_full($slot))
 890         {
 891             my $free = $self->slot_get_first_free() ;
 892             print "want to move $slot to $free\n";
 893
 894             if ($free) {
 895                 $self->transfer($slot, $free) || print "$self->{error}\n";
 896
 897             } else {
 898                 $self->{error} = "E : Can't find free slot";
 899             }
 900         }
 901     }
 902 }
 903
 904 # TODO : this is with mtx status output,
 905 # we can do an other function from bacula view (with StorageId)
 906 sub display_content
 907 {
 908     my ($self) = @_;
 909     my $bweb = $self->{bweb};
 910
 911     # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
 912     my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
 913
 914     my $query="
 915 SELECT Media.VolumeName  AS volumename,
 916        Media.VolStatus   AS volstatus,
 917        Media.LastWritten AS lastwritten,
 918        Media.VolBytes    AS volbytes,
 919        Media.MediaType   AS mediatype,
 920        Media.Slot        AS slot,
 921        Media.InChanger   AS inchanger,
 922        Pool.Name         AS name,
 923        $bweb->{sql}->{FROM_UNIXTIME}(
 924           $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
 925         + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
 926        ) AS expire
 927 FROM Media
 928  INNER JOIN Pool USING (PoolId)
 929
 930 WHERE Media.VolumeName IN ($media_list)
 931 ";
 932
 933     my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
 934
 935     # TODO : verify slot and bacula slot
 936     my $param = [];
 937     my @to_update;
 938
 939     for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
 940
 941         if ($self->slot_is_full($slot)) {
 942
 943             my $vol = $self->{slot}->[$slot];
 944             if (defined $all->{$vol}) {    # TODO : autochanger without barcodes
 945
 946                 my $bslot = $all->{$vol}->{slot} ;
 947                 my $inchanger = $all->{$vol}->{inchanger};
 948
 949                 # if bacula slot or inchanger flag is bad, we display a message
 950                 if ($bslot != $slot or !$inchanger) {
 951                     push @to_update, $slot;
 952                 }
 953
 954                 $all->{$vol}->{realslot} = $slot;
 955
 956                 push @{ $param }, $all->{$vol};
 957
 958             } else {            # empty or no label
 959                 push @{ $param }, {realslot => $slot,
 960                                    volstatus => 'Unknow',
 961                                    volumename => $self->{slot}->[$slot]} ;
 962             }
 963         } else {                # empty
 964             push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
 965         }
 966     }
 967
 968     my $i=0; my $drives = [] ;
 969     foreach my $d (@{ $self->{drive} }) {
 970         $drives->[$i] = { index => $i,
 971                           load  => $self->{drive}->[$i],
 972                           name  => $self->{drive_name}->[$i],
 973                       };
 974         $i++;
 975     }
 976
 977     $bweb->display({ Name   => $self->{name},
 978                      nb_drive => $self->{info}->{drive},
 979                      nb_io => $self->{info}->{io},
 980                      Drives => $drives,
 981                      Slots  => $param,
 982                      Update => scalar(@to_update) },
 983                    'ach_content.tpl');
 984
 985 }
 986
 987 1;
 988
 989
 990 ################################################################
 991
 992 package Bweb;
 993
 994 use base q/Bweb::Gui/;
 995
 996 =head1 PACKAGE
 997
 998     Bweb - main Bweb package
 999
1000 =head2
1001
1002     this package is use to compute and display informations
1003
1004 =cut
1005
1006 use DBI;
1007 use POSIX qw/strftime/;
1008
1009 our $cur_id=0;
1010
1011 =head1 VARIABLE
1012
1013     %sql_func - hash to make query mysql/postgresql compliant
1014
1015 =cut
1016
1017 our %sql_func = (
1018           Pg => {
1019               UNIX_TIMESTAMP => '',
1020               FROM_UNIXTIME => '',
1021               TO_SEC => " interval '1 second' * ",
1022               SEC_TO_INT => "SEC_TO_INT",
1023               SEC_TO_TIME => '',
1024               MATCH => " ~ ",
1025               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1026               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1027               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1028               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1029               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1030               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1031           },
1032           mysql => {
1033               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1034               FROM_UNIXTIME => 'FROM_UNIXTIME',
1035               SEC_TO_INT => '',
1036               TO_SEC => '',
1037               SEC_TO_TIME => 'SEC_TO_TIME',
1038               MATCH => " REGEXP ",
1039               STARTTIME_DAY  => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1040               STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1041               STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1042               STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1043               STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1044               STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1045           },
1046          );
1047
1048 sub dbh_selectall_arrayref
1049 {
1050     my ($self, $query) = @_;
1051     $self->connect_db();
1052     $self->debug($query);
1053     return $self->{dbh}->selectall_arrayref($query);
1054 }
1055
1056 sub dbh_join
1057 {
1058     my ($self, @what) = @_;
1059     return join(',', $self->dbh_quote(@what)) ;
1060 }
1061
1062 sub dbh_quote
1063 {
1064     my ($self, @what) = @_;
1065
1066     $self->connect_db();
1067     if (wantarray) {
1068         return map { $self->{dbh}->quote($_) } @what;
1069     } else {
1070         return $self->{dbh}->quote($what[0]) ;
1071     }
1072 }
1073
1074 sub dbh_do
1075 {
1076     my ($self, $query) = @_ ;
1077     $self->connect_db();
1078     $self->debug($query);
1079     return $self->{dbh}->do($query);
1080 }
1081
1082 sub dbh_selectall_hashref
1083 {
1084     my ($self, $query, $join) = @_;
1085
1086     $self->connect_db();
1087     $self->debug($query);
1088     return $self->{dbh}->selectall_hashref($query, $join) ;
1089 }
1090
1091 sub dbh_selectrow_hashref
1092 {
1093     my ($self, $query) = @_;
1094
1095     $self->connect_db();
1096     $self->debug($query);
1097     return $self->{dbh}->selectrow_hashref($query) ;
1098 }
1099
1100 # display Mb/Gb/Kb
1101 sub human_size
1102 {
1103     my @unit = qw(b Kb Mb Gb Tb);
1104     my $val = shift || 0;
1105     my $i=0;
1106     my $format = '%i %s';
1107     while ($val / 1024 > 1) {
1108         $i++;
1109         $val /= 1024;
1110     }
1111     $format = ($i>0)?'%0.1f %s':'%i %s';
1112     return sprintf($format, $val, $unit[$i]);
1113 }
1114
1115 # display Day, Hour, Year
1116 sub human_sec
1117 {
1118     use integer;
1119
1120     my $val = shift;
1121     $val /= 60;                 # sec -> min
1122
1123     if ($val / 60 <= 1) {
1124         return "$val mins";
1125     }
1126
1127     $val /= 60;                 # min -> hour
1128     if ($val / 24 <= 1) {
1129         return "$val hours";
1130     }
1131
1132     $val /= 24;                 # hour -> day
1133     if ($val / 365 < 2) {
1134         return "$val days";
1135     }
1136
1137     $val /= 365 ;               # day -> year
1138
1139     return "$val years";
1140 }
1141
1142 # get Day, Hour, Year
1143 sub from_human_sec
1144 {
1145     use integer;
1146
1147     my $val = shift;
1148     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1149         return 0;
1150     }
1151
1152     my %times = ( m   => 60,
1153                   h   => 60*60,
1154                   d   => 60*60*24,
1155                   m   => 60*60*24*31,
1156                   y   => 60*60*24*365,
1157                   );
1158     my $mult = $times{$2} || 0;
1159
1160     return $1 * $mult;
1161 }
1162
1163
1164 sub connect_db
1165 {
1166     my ($self) = @_;
1167
1168     unless ($self->{dbh}) {
1169         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1170                                     $self->{info}->{user},
1171                                     $self->{info}->{password});
1172
1173         print "Can't connect to your database, see error log\n"
1174             unless ($self->{dbh});
1175
1176         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1177     }
1178 }
1179
1180 sub new
1181 {
1182     my ($class, %arg) = @_;
1183     my $self = bless {
1184         dbh => undef,           # connect_db();
1185         info => {
1186             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1187             user  => 'bacula',
1188             password => 'test',
1189         },
1190     } ;
1191
1192     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1193
1194     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1195         $self->{sql} = $sql_func{$1};
1196     }
1197
1198     $self->{debug} = $self->{info}->{debug};
1199     $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1200
1201     return $self;
1202 }
1203
1204 sub display_begin
1205 {
1206     my ($self) = @_;
1207     $self->display($self->{info}, "begin.tpl");
1208 }
1209
1210 sub display_end
1211 {
1212     my ($self) = @_;
1213     $self->display($self->{info}, "end.tpl");
1214 }
1215
1216 sub display_clients
1217 {
1218     my ($self) = @_;
1219
1220     my $where='';
1221     my $arg = $self->get_form("client", "qre_client");
1222
1223     if ($arg->{qre_client}) {
1224         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1225     } elsif ($arg->{client}) {
1226         $where = "WHERE Name = '$arg->{client}' ";
1227     }
1228
1229     my $query = "
1230 SELECT Name   AS name,
1231        Uname  AS uname,
1232        AutoPrune AS autoprune,
1233        FileRetention AS fileretention,
1234        JobRetention  AS jobretention
1235 FROM Client
1236 $where
1237 ";
1238
1239     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1240
1241     my $dsp = { ID => $cur_id++,
1242                 clients => [ values %$all] };
1243
1244     $self->display($dsp, "client_list.tpl") ;
1245 }
1246
1247 sub get_limit
1248 {
1249     my ($self, %arg) = @_;
1250
1251     my $limit = '';
1252     my $label = '';
1253
1254     if ($arg{age}) {
1255         $limit =
1256   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1257          >
1258        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1259          -
1260          $self->{sql}->{TO_SEC}($arg{age})
1261        )" ;
1262
1263         $label = "last " . human_sec($arg{age});
1264     }
1265
1266     if ($arg{groupby}) {
1267         $limit .= " GROUP BY $arg{groupby} ";
1268     }
1269
1270     if ($arg{order}) {
1271         $limit .= " ORDER BY $arg{order} ";
1272     }
1273
1274     if ($arg{limit}) {
1275         $limit .= " LIMIT $arg{limit} ";
1276         $label .= " limited to $arg{limit}";
1277     }
1278
1279     if ($arg{offset}) {
1280         $limit .= " OFFSET $arg{offset} ";
1281         $label .= " with $arg{offset} offset ";
1282     }
1283
1284     unless ($label) {
1285         $label = 'no filter';
1286     }
1287
1288     return ($limit, $label);
1289 }
1290
1291 =head1 FUNCTION
1292
1293     $bweb->get_form(...) - Get useful stuff
1294
1295 =head2 DESCRIPTION
1296
1297     This function get and check parameters against regexp.
1298
1299     If word begin with 'q', the return will be quoted or join quoted
1300     if it's end with 's'.
1301
1302
1303 =head2 EXAMPLE
1304
1305     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1306
1307     { jobid    => 12,
1308       qclient  => 'plume-fd',
1309       qpools   => "'plume-fd', 'test-fd', '...'",
1310     }
1311
1312 =cut
1313
1314 sub get_form
1315 {
1316     my ($self, @what) = @_;
1317     my %what = map { $_ => 1 } @what;
1318     my %ret;
1319
1320     my %opt_i = (
1321                  limit  => 100,
1322                  cost   =>  10,
1323                  offset =>   0,
1324                  width  => 640,
1325                  height => 480,
1326                  jobid  =>   0,
1327                  slot   =>   0,
1328                  drive  =>   0,
1329                  priority => 10,
1330                  age    => 60*60*24*7,
1331                  days   => 1,
1332                  maxvoljobs  => 0,
1333                  maxvolbytes => 0,
1334                  maxvolfiles => 0,
1335                  );
1336
1337     my %opt_s = (               # default to ''
1338                  ach    => 1,
1339                  status => 1,
1340                  volstatus => 1,
1341                  inchanger => 1,
1342                  client => 1,
1343                  level  => 1,
1344                  pool   => 1,
1345                  media  => 1,
1346                  ach    => 1,
1347                  jobtype=> 1,
1348                  graph  => 1,
1349                  gtype  => 1,
1350                  type   => 1,
1351                  );
1352     my %opt_p = (               # option with path
1353                  fileset=> 1,
1354                  mtxcmd => 1,
1355                  precmd => 1,
1356                  device => 1,
1357                  );
1358
1359     my %opt_d = (               # option with date
1360                  voluseduration=> 1,
1361                  volretention => 1,
1362                 );
1363
1364     foreach my $i (@what) {
1365         if (exists $opt_i{$i}) {# integer param
1366             my $value = CGI::param($i) || $opt_i{$i} ;
1367             if ($value =~ /^(\d+)$/) {
1368                 $ret{$i} = $1;
1369             }
1370         } elsif ($opt_s{$i}) {  # simple string param
1371             my $value = CGI::param($i) || '';
1372             if ($value =~ /^([\w\d\.-]+)$/) {
1373                 $ret{$i} = $1;
1374             }
1375
1376         } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1377             my @value = CGI::param($1) ;
1378             if (@value) {
1379                 $ret{$i} = $self->dbh_join(@value) ;
1380             }
1381
1382         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1383             my $value = CGI::param($1) ;
1384             if ($value) {
1385                 $ret{$i} = $self->dbh_quote($value);
1386             }
1387
1388         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1389             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1390                                   CGI::param($1) ];
1391         } elsif (exists $opt_p{$i}) {
1392             my $value = CGI::param($i) || '';
1393             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1394                 $ret{$i} = $1;
1395             }
1396         } elsif (exists $opt_d{$i}) {
1397             my $value = CGI::param($i) || '';
1398             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1399                 $ret{$i} = $1;
1400             }
1401         }
1402     }
1403
1404     if ($what{slots}) {
1405         foreach my $s (CGI::param('slot')) {
1406             if ($s =~ /^(\d+)$/) {
1407                 push @{$ret{slots}}, $s;
1408             }
1409         }
1410     }
1411
1412     if ($what{db_clients}) {
1413         my $query = "
1414 SELECT Client.Name as clientname
1415 FROM Client
1416 ";
1417
1418         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1419         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1420                               values %$clients] ;
1421     }
1422
1423     if ($what{db_mediatypes}) {
1424         my $query = "
1425 SELECT MediaType as mediatype
1426 FROM MediaType
1427 ";
1428
1429         my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1430         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1431                                   values %$medias] ;
1432     }
1433
1434     if ($what{db_locations}) {
1435         my $query = "
1436 SELECT Location as location, Cost as cost FROM Location
1437 ";
1438         my $loc = $self->dbh_selectall_hashref($query, 'location');
1439         $ret{db_locations} = [ sort { $a->{location}
1440                                       cmp
1441                                       $b->{location}
1442                                   } values %$loc ];
1443     }
1444
1445     if ($what{db_pools}) {
1446         my $query = "SELECT Name as name FROM Pool";
1447
1448         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1449         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1450     }
1451
1452     if ($what{db_filesets}) {
1453         my $query = "
1454 SELECT FileSet.FileSet AS fileset
1455 FROM FileSet
1456 ";
1457
1458         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1459
1460         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1461                                values %$filesets] ;
1462     }
1463
1464     if ($what{db_jobnames}) {
1465         my $query = "
1466 SELECT DISTINCT Job.Name AS jobname
1467 FROM Job
1468 ";
1469
1470         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1471
1472         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1473                                values %$jobnames] ;
1474     }
1475
1476     if ($what{db_devices}) {
1477         my $query = "
1478 SELECT Device.Name AS name
1479 FROM Device
1480 ";
1481
1482         my $devices = $self->dbh_selectall_hashref($query, 'name');
1483
1484         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1485                                values %$devices] ;
1486     }
1487
1488     return \%ret;
1489 }
1490
1491 sub display_graph
1492 {
1493     my ($self) = @_;
1494
1495     my $fields = $self->get_form(qw/age level status clients filesets
1496                                     graph gtype type
1497                                     db_clients limit db_filesets width height
1498                                     qclients qfilesets qjobnames db_jobnames/);
1499
1500
1501     my $url = CGI::url(-full => 0,
1502                        -base => 0,
1503                        -query => 1);
1504     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1505
1506 # this organisation is to keep user choice between 2 click
1507 # TODO : fileset and client selection doesn't work
1508
1509     $self->display({
1510         url => $url,
1511         %$fields,
1512     }, "graph.tpl")
1513
1514 }
1515
1516 sub display_client_job
1517 {
1518     my ($self, %arg) = @_ ;
1519
1520     $arg{order} = ' Job.JobId DESC ';
1521     my ($limit, $label) = $self->get_limit(%arg);
1522
1523     my $clientname = $self->dbh_quote($arg{clientname});
1524
1525     my $query="
1526 SELECT DISTINCT Job.JobId       AS jobid,
1527                 Job.Name        AS jobname,
1528                 FileSet.FileSet AS fileset,
1529                 Level           AS level,
1530                 StartTime       AS starttime,
1531                 JobFiles        AS jobfiles,
1532                 JobBytes        AS jobbytes,
1533                 JobStatus       AS jobstatus,
1534                 JobErrors       AS joberrors
1535
1536  FROM Client,Job,FileSet
1537  WHERE Client.Name=$clientname
1538  AND Client.ClientId=Job.ClientId
1539  AND Job.FileSetId=FileSet.FileSetId
1540  $limit
1541 ";
1542
1543     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1544
1545     $self->display({ clientname => $arg{clientname},
1546                      Filter => $label,
1547                      ID => $cur_id++,
1548                      Jobs => [ values %$all ],
1549                    },
1550                    "display_client_job.tpl") ;
1551 }
1552
1553 sub get_selected_media_location
1554 {
1555     my ($self) = @_ ;
1556
1557     my $medias = $self->get_form('jmedias');
1558
1559     unless ($medias->{jmedias}) {
1560         return undef;
1561     }
1562
1563     my $query = "
1564 SELECT Media.VolumeName AS volumename, Location.Location AS location
1565 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1566 WHERE Media.VolumeName IN ($medias->{jmedias})
1567 ";
1568
1569     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1570
1571     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1572     #               ..
1573     #             }
1574     # }
1575     return $all;
1576 }
1577
1578 sub move_media
1579 {
1580     my ($self) = @_ ;
1581
1582     my $medias = $self->get_selected_media_location();
1583
1584     unless ($medias) {
1585         return ;
1586     }
1587
1588     my $elt = $self->get_form('db_locations');
1589
1590     $self->display({ ID => $cur_id++,
1591                      %$elt,     # db_locations
1592                      medias => [
1593             sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1594                                ],
1595                      },
1596                    "move_media.tpl");
1597 }
1598
1599 sub help_extern
1600 {
1601     my ($self) = @_ ;
1602
1603     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1604     $self->debug($elt);
1605     $self->display($elt, "help_extern.tpl");
1606 }
1607
1608 sub help_extern_compute
1609 {
1610     my ($self) = @_;
1611
1612     my $number = CGI::param('limit') || '' ;
1613     unless ($number =~ /^(\d+)$/) {
1614         return $self->error("Bad arg number : $number ");
1615     }
1616
1617     my ($sql, undef) = $self->get_param('pools',
1618                                         'locations', 'mediatypes');
1619
1620     my $query = "
1621 SELECT Media.VolumeName  AS volumename,
1622        Media.VolStatus   AS volstatus,
1623        Media.LastWritten AS lastwritten,
1624        Media.MediaType   AS mediatype,
1625        Media.VolMounts   AS volmounts,
1626        Pool.Name         AS name,
1627        Media.Recycle     AS recycle,
1628        $self->{sql}->{FROM_UNIXTIME}(
1629           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1630         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1631        ) AS expire
1632 FROM Media
1633  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1634  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1635
1636 WHERE Media.InChanger = 1
1637   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1638   $sql
1639 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1640 LIMIT $number
1641 " ;
1642
1643     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1644
1645     $self->display({ Medias => [ values %$all ] },
1646                    "help_extern_compute.tpl");
1647 }
1648
1649 sub help_intern
1650 {
1651     my ($self) = @_ ;
1652
1653     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1654     $self->display($param, "help_intern.tpl");
1655 }
1656
1657 sub help_intern_compute
1658 {
1659     my ($self) = @_;
1660
1661     my $number = CGI::param('limit') || '' ;
1662     unless ($number =~ /^(\d+)$/) {
1663         return $self->error("Bad arg number : $number ");
1664     }
1665
1666     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1667
1668     if (CGI::param('expired')) {
1669         $sql = "
1670 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1671        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1672     ) < NOW()
1673  " . $sql ;
1674     }
1675
1676     my $query = "
1677 SELECT Media.VolumeName  AS volumename,
1678        Media.VolStatus   AS volstatus,
1679        Media.LastWritten AS lastwritten,
1680        Media.MediaType   AS mediatype,
1681        Media.VolMounts   AS volmounts,
1682        Pool.Name         AS name,
1683        $self->{sql}->{FROM_UNIXTIME}(
1684           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1685         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1686        ) AS expire
1687 FROM Media
1688  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1689  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1690
1691 WHERE Media.InChanger <> 1
1692   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1693   AND Media.Recycle = 1
1694   $sql
1695 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1696 LIMIT $number
1697 " ;
1698
1699     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1700
1701     $self->display({ Medias => [ values %$all ] },
1702                    "help_intern_compute.tpl");
1703
1704 }
1705
1706 sub display_general
1707 {
1708     my ($self, %arg) = @_ ;
1709
1710     my ($limit, $label) = $self->get_limit(%arg);
1711
1712     my $query = "
1713 SELECT
1714     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1715     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1716     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1717     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1718     (SELECT count(Job.JobId)
1719       FROM Job
1720       WHERE Job.JobStatus IN ('E','e','f','A')
1721       $limit
1722     )                                         AS nb_err,
1723     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1724 ";
1725
1726     my $row = $self->dbh_selectrow_hashref($query) ;
1727
1728     $row->{nb_bytes} = human_size($row->{nb_bytes});
1729
1730     $row->{db_size} = '???';
1731     $row->{label} = $label;
1732
1733     $self->display($row, "general.tpl");
1734 }
1735
1736 sub get_param
1737 {
1738     my ($self, @what) = @_ ;
1739     my %elt = map { $_ => 1 } @what;
1740     my %ret;
1741
1742     my $limit = '';
1743
1744     if ($elt{clients}) {
1745         my @clients = CGI::param('client');
1746         if (@clients) {
1747             $ret{clients} = \@clients;
1748             my $str = $self->dbh_join(@clients);
1749             $limit .= "AND Client.Name IN ($str) ";
1750         }
1751     }
1752
1753     if ($elt{filesets}) {
1754         my @filesets = CGI::param('fileset');
1755         if (@filesets) {
1756             $ret{filesets} = \@filesets;
1757             my $str = $self->dbh_join(@filesets);
1758             $limit .= "AND FileSet.FileSet IN ($str) ";
1759         }
1760     }
1761
1762     if ($elt{mediatypes}) {
1763         my @medias = CGI::param('mediatype');
1764         if (@medias) {
1765             $ret{mediatypes} = \@medias;
1766             my $str = $self->dbh_join(@medias);
1767             $limit .= "AND Media.MediaType IN ($str) ";
1768         }
1769     }
1770
1771     if ($elt{client}) {
1772         my $client = CGI::param('client');
1773         $ret{client} = $client;
1774         $client = $self->dbh_join($client);
1775         $limit .= "AND Client.Name = $client ";
1776     }
1777
1778     if ($elt{level}) {
1779         my $level = CGI::param('level') || '';
1780         if ($level =~ /^(\w)$/) {
1781             $ret{level} = $1;
1782             $limit .= "AND Job.Level = '$1' ";
1783         }
1784     }
1785
1786     if ($elt{jobid}) {
1787         my $jobid = CGI::param('jobid') || '';
1788
1789         if ($jobid =~ /^(\d+)$/) {
1790             $ret{jobid} = $1;
1791             $limit .= "AND Job.JobId = '$1' ";
1792         }
1793     }
1794
1795     if ($elt{status}) {
1796         my $status = CGI::param('status') || '';
1797         if ($status =~ /^(\w)$/) {
1798             $ret{status} = $1;
1799             if ($1 eq 'f') {
1800                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1801             } else {
1802                 $limit .= "AND Job.JobStatus = '$1' ";
1803             }
1804         }
1805     }
1806
1807     if ($elt{locations}) {
1808         my @location = CGI::param('location') ;
1809         if (@location) {
1810             $ret{locations} = \@location;
1811             my $str = $self->dbh_join(@location);
1812             $limit .= "AND Location.Location IN ($str) ";
1813         }
1814     }
1815
1816     if ($elt{pools}) {
1817         my @pool = CGI::param('pool') ;
1818         if (@pool) {
1819             $ret{pools} = \@pool;
1820             my $str = $self->dbh_join(@pool);
1821             $limit .= "AND Pool.Name IN ($str) ";
1822         }
1823     }
1824
1825     if ($elt{location}) {
1826         my $location = CGI::param('location') || '';
1827         if ($location) {
1828             $ret{location} = $location;
1829             $location = $self->dbh_quote($location);
1830             $limit .= "AND Location.Location = $location ";
1831         }
1832     }
1833
1834     if ($elt{pool}) {
1835         my $pool = CGI::param('pool') || '';
1836         if ($pool) {
1837             $ret{pool} = $pool;
1838             $pool = $self->dbh_quote($pool);
1839             $limit .= "AND Pool.Name = $pool ";
1840         }
1841     }
1842
1843     if ($elt{jobtype}) {
1844         my $jobtype = CGI::param('jobtype') || '';
1845         if ($jobtype =~ /^(\w)$/) {
1846             $ret{jobtype} = $1;
1847             $limit .= "AND Job.Type = '$1' ";
1848         }
1849     }
1850
1851     return ($limit, %ret);
1852 }
1853
1854 =head1
1855
1856     get last backup
1857
1858 =cut
1859
1860 sub display_job
1861 {
1862     my ($self, %arg) = @_ ;
1863
1864     $arg{order} = ' Job.JobId DESC ';
1865
1866     my ($limit, $label) = $self->get_limit(%arg);
1867     my ($where, undef) = $self->get_param('clients',
1868                                           'level',
1869                                           'filesets',
1870                                           'jobtype',
1871                                           'jobid',
1872                                           'status');
1873
1874     my $query="
1875 SELECT  Job.JobId       AS jobid,
1876         Client.Name     AS client,
1877         FileSet.FileSet AS fileset,
1878         Job.Name        AS jobname,
1879         Level           AS level,
1880         StartTime       AS starttime,
1881         Pool.Name       AS poolname,
1882         JobFiles        AS jobfiles,
1883         JobBytes        AS jobbytes,
1884         JobStatus       AS jobstatus,
1885      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1886                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1887                         AS duration,
1888
1889         JobErrors       AS joberrors
1890
1891  FROM Client,
1892       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1893           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1894  WHERE Client.ClientId=Job.ClientId
1895    AND Job.JobStatus != 'R'
1896  $where
1897  $limit
1898 ";
1899
1900     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1901
1902     $self->display({ Filter => $label,
1903                      ID => $cur_id++,
1904                      Jobs =>
1905                            [
1906                              sort { $a->{jobid} <=>  $b->{jobid} }
1907                                         values %$all
1908                              ],
1909                    },
1910                    "display_job.tpl");
1911 }
1912
1913 # display job informations
1914 sub display_job_zoom
1915 {
1916     my ($self, $jobid) = @_ ;
1917
1918     $jobid = $self->dbh_quote($jobid);
1919
1920     my $query="
1921 SELECT DISTINCT Job.JobId       AS jobid,
1922                 Client.Name     AS client,
1923                 Job.Name        AS jobname,
1924                 FileSet.FileSet AS fileset,
1925                 Level           AS level,
1926                 Pool.Name       AS poolname,
1927                 StartTime       AS starttime,
1928                 JobFiles        AS jobfiles,
1929                 JobBytes        AS jobbytes,
1930                 JobStatus       AS jobstatus,
1931                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1932                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1933
1934  FROM Client,
1935       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1936           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1937  WHERE Client.ClientId=Job.ClientId
1938  AND Job.JobId = $jobid
1939 ";
1940
1941     my $row = $self->dbh_selectrow_hashref($query) ;
1942
1943     # display all volumes associate with this job
1944     $query="
1945 SELECT Media.VolumeName as volumename
1946 FROM Job,Media,JobMedia
1947 WHERE Job.JobId = $jobid
1948  AND JobMedia.JobId=Job.JobId
1949  AND JobMedia.MediaId=Media.MediaId
1950 ";
1951
1952     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1953
1954     $row->{volumes} = [ values %$all ] ;
1955
1956     $self->display($row, "display_job_zoom.tpl");
1957 }
1958
1959 sub display_media
1960 {
1961     my ($self) = @_ ;
1962
1963     my ($where, %elt) = $self->get_param('pool',
1964                                          'location');
1965
1966     my $arg = $self->get_form('jmedias', 'qre_media');
1967
1968     if ($arg->{jmedias}) {
1969         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1970     }
1971     if ($arg->{qre_media}) {
1972         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1973     }
1974
1975     my $query="
1976 SELECT Media.VolumeName  AS volumename,
1977        Media.VolBytes    AS volbytes,
1978        Media.VolStatus   AS volstatus,
1979        Media.MediaType   AS mediatype,
1980        Media.InChanger   AS online,
1981        Media.LastWritten AS lastwritten,
1982        Location.Location AS location,
1983        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
1984        Pool.Name         AS poolname,
1985        $self->{sql}->{FROM_UNIXTIME}(
1986           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1987         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1988        ) AS expire
1989 FROM      Pool, Media
1990 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1991 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1992                   Media.MediaType     AS MediaType
1993            FROM Media
1994           WHERE Media.VolStatus = 'Full'
1995           GROUP BY Media.MediaType
1996            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
1997
1998 WHERE Media.PoolId=Pool.PoolId
1999 $where
2000 ";
2001
2002     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2003
2004     $self->display({ ID => $cur_id++,
2005                      Pool => $elt{pool},
2006                      Location => $elt{location},
2007                      Medias => [ values %$all ]
2008                    },
2009                    "display_media.tpl");
2010 }
2011
2012 sub display_medias
2013 {
2014     my ($self) = @_ ;
2015
2016     my $pool = $self->get_form('db_pools');
2017
2018     foreach my $name (@{ $pool->{db_pools} }) {
2019         CGI::param('pool', $name->{name});
2020         $self->display_media();
2021     }
2022 }
2023
2024 sub display_media_zoom
2025 {
2026     my ($self) = @_ ;
2027
2028     my $medias = $self->get_form('jmedias');
2029
2030     unless ($medias->{jmedias}) {
2031         return $self->error("Can't get media selection");
2032     }
2033
2034     my $query="
2035 SELECT InChanger     AS online,
2036        VolBytes      AS nb_bytes,
2037        VolumeName    AS volumename,
2038        VolStatus     AS volstatus,
2039        VolMounts     AS nb_mounts,
2040        Media.VolUseDuration   AS voluseduration,
2041        Media.MaxVolJobs AS maxvoljobs,
2042        Media.MaxVolFiles AS maxvolfiles,
2043        Media.MaxVolBytes AS maxvolbytes,
2044        VolErrors     AS nb_errors,
2045        Pool.Name     AS poolname,
2046        Location.Location AS location,
2047        Media.Recycle AS recycle,
2048        Media.VolRetention AS volretention,
2049        Media.LastWritten  AS lastwritten,
2050        Media.VolReadTime/1000000  AS volreadtime,
2051        Media.VolWriteTime/1000000 AS volwritetime,
2052        $self->{sql}->{FROM_UNIXTIME}(
2053           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2054         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2055        ) AS expire
2056  FROM Pool,
2057       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2058  WHERE Pool.PoolId = Media.PoolId
2059  AND VolumeName IN ($medias->{jmedias})
2060 ";
2061
2062     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2063
2064     foreach my $media (values %$all) {
2065         my $mq = $self->dbh_quote($media->{volumename});
2066
2067         $query = "
2068 SELECT DISTINCT Job.JobId AS jobid,
2069                 Job.Name  AS name,
2070                 Job.StartTime AS starttime,
2071                 Job.Type  AS type,
2072                 Job.Level AS level,
2073                 Job.JobFiles AS files,
2074                 Job.JobBytes AS bytes,
2075                 Job.jobstatus AS status
2076  FROM Media,JobMedia,Job
2077  WHERE Media.VolumeName=$mq
2078  AND Media.MediaId=JobMedia.MediaId
2079  AND JobMedia.JobId=Job.JobId
2080 ";
2081
2082         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2083
2084         $query = "
2085 SELECT LocationLog.Date    AS date,
2086        Location.Location   AS location,
2087        LocationLog.Comment AS comment
2088  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2089  WHERE Media.MediaId = LocationLog.MediaId
2090    AND Media.VolumeName = $mq
2091 ";
2092
2093         my $logtxt = '';
2094         my $log = $self->dbh_selectall_arrayref($query) ;
2095         if ($log) {
2096             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2097         }
2098
2099         $self->display({ jobs => [ values %$jobs ],
2100                          LocationLog => $logtxt,
2101                          %$media },
2102                        "display_media_zoom.tpl");
2103     }
2104 }
2105
2106 sub location_edit
2107 {
2108     my ($self) = @_ ;
2109
2110     my $loc = $self->get_form('qlocation');
2111     unless ($loc->{qlocation}) {
2112         return $self->error("Can't get location");
2113     }
2114
2115     my $query = "
2116 SELECT Location.Location AS location,
2117        Location.Cost   AS cost,
2118        Location.Enabled AS enabled
2119 FROM Location
2120 WHERE Location.Location = $loc->{qlocation}
2121 ";
2122
2123     my $row = $self->dbh_selectrow_hashref($query);
2124
2125     $self->display({ ID => $cur_id++,
2126                      %$row }, "location_edit.tpl") ;
2127
2128 }
2129
2130 sub location_save
2131 {
2132     my ($self) = @_ ;
2133
2134     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2135     unless ($arg->{qlocation}) {
2136         return $self->error("Can't get location");
2137     }
2138     unless ($arg->{qnewlocation}) {
2139         return $self->error("Can't get new location name");
2140     }
2141     unless ($arg->{cost}) {
2142         return $self->error("Can't get new cost");
2143     }
2144
2145     my $enabled = CGI::param('enabled') || '';
2146     $enabled = $enabled?1:0;
2147
2148     my $query = "
2149 UPDATE Location SET Cost     = $arg->{cost},
2150                     Location = $arg->{qnewlocation},
2151                     Enabled   = $enabled
2152 WHERE Location.Location = $arg->{qlocation}
2153 ";
2154
2155     $self->dbh_do($query);
2156
2157     $self->display_location();
2158 }
2159
2160 sub location_del
2161 {
2162     my ($self) = @_ ;
2163     my $arg = $self->get_form(qw/qlocation/) ;
2164
2165     unless ($arg->{qlocation}) {
2166         return $self->error("Can't get location");
2167     }
2168
2169     my $query = "
2170 SELECT count(Media.MediaId) AS nb
2171   FROM Media INNER JOIN Location USING (LocationID)
2172 WHERE Location = $arg->{qlocation}
2173 ";
2174
2175     my $res = $self->dbh_selectrow_hashref($query);
2176
2177     if ($res->{nb}) {
2178         return $self->error("Sorry, the location must be empty");
2179     }
2180
2181     $query = "
2182 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2183 ";
2184
2185     $self->dbh_do($query);
2186
2187     $self->display_location();
2188 }
2189
2190
2191 sub location_add
2192 {
2193     my ($self) = @_ ;
2194     my $arg = $self->get_form(qw/qlocation cost/) ;
2195
2196     unless ($arg->{qlocation}) {
2197         $self->display({}, "location_add.tpl");
2198         return 1;
2199     }
2200     unless ($arg->{cost}) {
2201         return $self->error("Can't get new cost");
2202     }
2203
2204     my $enabled = CGI::param('enabled') || '';
2205     $enabled = $enabled?1:0;
2206
2207     my $query = "
2208 INSERT INTO Location (Location, Cost, Enabled)
2209        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2210 ";
2211
2212     $self->dbh_do($query);
2213
2214     $self->display_location();
2215 }
2216
2217 sub display_location
2218 {
2219     my ($self) = @_ ;
2220
2221     my $query = "
2222 SELECT Location.Location AS location,
2223        Location.Cost     AS cost,
2224        Location.Enabled  AS enabled,
2225        (SELECT count(Media.MediaId)
2226          FROM Media
2227         WHERE Media.LocationId = Location.LocationId
2228        ) AS volnum
2229 FROM Location
2230 ";
2231
2232     my $location = $self->dbh_selectall_hashref($query, 'location');
2233
2234     $self->display({ ID => $cur_id++,
2235                      Locations => [ values %$location ] },
2236                    "display_location.tpl");
2237 }
2238
2239 sub update_location
2240 {
2241     my ($self) = @_ ;
2242
2243     my $medias = $self->get_selected_media_location();
2244     unless ($medias) {
2245         return ;
2246     }
2247
2248     my $arg = $self->get_form('db_locations', 'qnewlocation');
2249
2250     $self->display({ email  => $self->{info}->{email_media},
2251                      %$arg,
2252                      medias => [ values %$medias ],
2253                    },
2254                    "update_location.tpl");
2255 }
2256
2257 sub get_media_max_size
2258 {
2259     my ($self, $type) = @_;
2260     my $query =
2261 "SELECT avg(VolBytes) AS size
2262   FROM Media
2263  WHERE Media.VolStatus = 'Full'
2264    AND Media.MediaType = '$type'
2265 ";
2266
2267     my $res = $self->selectrow_hashref($query);
2268
2269     if ($res) {
2270         return $res->{size};
2271     } else {
2272         return 0;
2273     }
2274 }
2275
2276 sub update_media
2277 {
2278     my ($self) = @_ ;
2279
2280     my $media = $self->get_form('qmedia');
2281
2282     unless ($media->{qmedia}) {
2283         return $self->error("Can't get media");
2284     }
2285
2286     my $query = "
2287 SELECT Media.Slot         AS slot,
2288        Pool.Name          AS poolname,
2289        Media.VolStatus    AS volstatus,
2290        Media.InChanger    AS inchanger,
2291        Location.Location  AS location,
2292        Media.VolumeName   AS volumename,
2293        Media.MaxVolBytes  AS maxvolbytes,
2294        Media.MaxVolJobs   AS maxvoljobs,
2295        Media.MaxVolFiles  AS maxvolfiles,
2296        Media.VolUseDuration AS voluseduration,
2297        Media.VolRetention AS volretention
2298
2299 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2300            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2301
2302 WHERE Media.VolumeName = $media->{qmedia}
2303 ";
2304
2305     my $row = $self->dbh_selectrow_hashref($query);
2306     $row->{volretention} = human_sec($row->{volretention});
2307     $row->{voluseduration} = human_sec($row->{voluseduration});
2308
2309     my $elt = $self->get_form(qw/db_pools db_locations/);
2310
2311     $self->display({
2312         %$elt,
2313         %$row,
2314     }, "update_media.tpl");
2315 }
2316
2317 sub save_location
2318 {
2319     my ($self) = @_ ;
2320
2321     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2322
2323     unless ($arg->{jmedias}) {
2324         return $self->error("Can't get selected media");
2325     }
2326
2327     unless ($arg->{qnewlocation}) {
2328         return $self->error("Can't get new location");
2329     }
2330
2331     my $query = "
2332  UPDATE Media
2333      SET LocationId = (SELECT LocationId
2334                        FROM Location
2335                        WHERE Location = $arg->{qnewlocation})
2336      WHERE Media.VolumeName IN ($arg->{jmedias})
2337 ";
2338
2339     my $nb = $self->dbh_do($query);
2340
2341     print "$nb media updated, you may have to update your autochanger.";
2342
2343     $self->display_media();
2344 }
2345
2346 sub change_location
2347 {
2348     my ($self) = @_ ;
2349
2350     my $medias = $self->get_selected_media_location();
2351     unless ($medias) {
2352         return $self->error("Can't get media selection");
2353     }
2354     my $newloc = CGI::param('newlocation');
2355
2356     my $user = CGI::param('user') || 'unknow';
2357     my $comm = CGI::param('comment') || '';
2358     $comm = $self->dbh_quote("$user: $comm");
2359
2360     my $query;
2361
2362     foreach my $media (keys %$medias) {
2363         $query = "
2364 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2365  VALUES(
2366        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2367        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2368        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2369       )
2370 ";
2371         $self->dbh_do($query);
2372         $self->debug($query);
2373     }
2374
2375     my $q = new CGI;
2376     $q->param('action', 'update_location');
2377     my $url = $q->url(-full => 1, -query=>1);
2378
2379     $self->display({ email  => $self->{info}->{email_media},
2380                      url => $url,
2381                      newlocation => $newloc,
2382                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2383                      medias => [ values %$medias ],
2384                    },
2385                    "change_location.tpl");
2386
2387 }
2388
2389 sub display_client_stats
2390 {
2391     my ($self, %arg) = @_ ;
2392
2393     my $client = $self->dbh_quote($arg{clientname});
2394     my ($limit, $label) = $self->get_limit(%arg);
2395
2396     my $query = "
2397 SELECT
2398     count(Job.JobId)     AS nb_jobs,
2399     sum(Job.JobBytes)    AS nb_bytes,
2400     sum(Job.JobErrors)   AS nb_err,
2401     sum(Job.JobFiles)    AS nb_files,
2402     Client.Name          AS clientname
2403 FROM Job INNER JOIN Client USING (ClientId)
2404 WHERE
2405     Client.Name = $client
2406     $limit
2407 GROUP BY Client.Name
2408 ";
2409
2410     my $row = $self->dbh_selectrow_hashref($query);
2411
2412     $row->{ID} = $cur_id++;
2413     $row->{label} = $label;
2414
2415     $self->display($row, "display_client_stats.tpl");
2416 }
2417
2418 # poolname can be undef
2419 sub display_pool
2420 {
2421     my ($self, $poolname) = @_ ;
2422
2423 # TODO : afficher les tailles et les dates
2424
2425     my $query = "
2426 SELECT subq.volmax        AS volmax,
2427        subq.volnum        AS volnum,
2428        subq.voltotal      AS voltotal,
2429        Pool.Name          AS name,
2430        Pool.Recycle       AS recycle,
2431        Pool.VolRetention  AS volretention,
2432        Pool.VolUseDuration AS voluseduration,
2433        Pool.MaxVolJobs    AS maxvoljobs,
2434        Pool.MaxVolFiles   AS maxvolfiles,
2435        Pool.MaxVolBytes   AS maxvolbytes,
2436        subq.PoolId        AS PoolId
2437 FROM
2438   (
2439     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2440            count(Media.MediaId)  AS volnum,
2441            sum(Media.VolBytes)   AS voltotal,
2442            Media.PoolId          AS PoolId,
2443            Media.MediaType       AS MediaType
2444     FROM Media
2445     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2446                       Media.MediaType     AS MediaType
2447                FROM Media
2448               WHERE Media.VolStatus = 'Full'
2449               GROUP BY Media.MediaType
2450                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2451     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2452   ) AS subq
2453 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2454 ";
2455
2456     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2457
2458     foreach my $p (values %$all) {
2459         if ($p->{volmax}) {
2460             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2461         } else {
2462             $p->{poolusage} = 0;
2463         }
2464
2465         $query = "
2466   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2467     FROM Media
2468    WHERE PoolId=$p->{poolid}
2469 GROUP BY VolStatus
2470 ";
2471         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2472         foreach my $t (values %$content) {
2473             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2474         }
2475     }
2476
2477     $self->debug($all);
2478     $self->display({ ID => $cur_id++,
2479                      Pools => [ values %$all ]},
2480                    "display_pool.tpl");
2481 }
2482
2483 sub display_running_job
2484 {
2485     my ($self) = @_;
2486
2487     my $arg = $self->get_form('client', 'jobid');
2488
2489     if (!$arg->{client} and $arg->{jobid}) {
2490
2491         my $query = "
2492 SELECT Client.Name AS name
2493 FROM Job INNER JOIN Client USING (ClientId)
2494 WHERE Job.JobId = $arg->{jobid}
2495 ";
2496
2497         my $row = $self->dbh_selectrow_hashref($query);
2498
2499         if ($row) {
2500             $arg->{client} = $row->{name};
2501             CGI::param('client', $arg->{client});
2502         }
2503     }
2504
2505     if ($arg->{client}) {
2506         my $cli = new Bweb::Client(name => $arg->{client});
2507         $cli->display_running_job($self->{info}, $arg->{jobid});
2508         if ($arg->{jobid}) {
2509             $self->get_job_log();
2510         }
2511     } else {
2512         $self->error("Can't get client or jobid");
2513     }
2514 }
2515
2516 sub display_running_jobs
2517 {
2518     my ($self, $display_action) = @_;
2519
2520     my $query = "
2521 SELECT Job.JobId AS jobid,
2522        Job.Name  AS jobname,
2523        Job.Level     AS level,
2524        Job.StartTime AS starttime,
2525        Job.JobFiles  AS jobfiles,
2526        Job.JobBytes  AS jobbytes,
2527        Job.JobStatus AS jobstatus,
2528 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2529                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2530          AS duration,
2531        Client.Name AS clientname
2532 FROM Job INNER JOIN Client USING (ClientId)
2533 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2534 ";
2535     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2536
2537     $self->display({ ID => $cur_id++,
2538                      display_action => $display_action,
2539                      Jobs => [ values %$all ]},
2540                    "running_job.tpl") ;
2541 }
2542
2543 sub eject_media
2544 {
2545     my ($self) = @_;
2546     my $arg = $self->get_form('jmedias');
2547
2548     unless ($arg->{jmedias}) {
2549         return $self->error("Can't get media selection");
2550     }
2551
2552     my $query = "
2553 SELECT Media.VolumeName  AS volumename,
2554        Storage.Name      AS storage,
2555        Location.Location AS location,
2556        Media.Slot        AS slot
2557 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2558            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2559 WHERE Media.VolumeName IN ($arg->{jmedias})
2560   AND Media.InChanger = 1
2561 ";
2562
2563     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2564
2565     foreach my $vol (values %$all) {
2566         my $a = $self->ach_get($vol->{location});
2567         next unless ($a) ;
2568
2569         unless ($a->{have_status}) {
2570             $a->status();
2571             $a->{have_status} = 1;
2572         }
2573
2574         print "eject $vol->{volumename} from $vol->{storage} : ";
2575         if ($a->send_to_io($vol->{slot})) {
2576             print "ok</br>";
2577         } else {
2578             print "err</br>";
2579         }
2580     }
2581 }
2582
2583 sub move_email
2584 {
2585     my ($self) = @_;
2586
2587     my ($to, $subject, $content) = (CGI::param('email'),
2588                                     CGI::param('subject'),
2589                                     CGI::param('content'));
2590     $to =~ s/[^\w\d\.\@<>,]//;
2591     $subject =~ s/[^\w\d\.\[\]]/ /;
2592
2593     open(MAIL, "|mail -s '$subject' '$to'") ;
2594     print MAIL $content;
2595     close(MAIL);
2596
2597     print "Mail sent";
2598 }
2599
2600 sub restore
2601 {
2602     my ($self) = @_;
2603
2604     my $arg = $self->get_form('jobid', 'client');
2605
2606     print CGI::header('text/brestore');
2607     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2608     print "client=$arg->{client}\n" if ($arg->{client});
2609     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2610     print "\n";
2611 }
2612
2613 # TODO : move this to Bweb::Autochanger ?
2614 # TODO : make this internal to not eject tape ?
2615 use Bconsole;
2616
2617
2618 sub ach_get
2619 {
2620     my ($self, $name) = @_;
2621
2622     unless ($name) {
2623         return $self->error("Can't get your autochanger name ach");
2624     }
2625
2626     unless ($self->{info}->{ach_list}) {
2627         return $self->error("Could not find any autochanger");
2628     }
2629
2630     my $a = $self->{info}->{ach_list}->{$name};
2631
2632     unless ($a) {
2633         $self->error("Can't get your autochanger $name from your ach_list");
2634         return undef;
2635     }
2636
2637     $a->{bweb} = $self;
2638
2639     return $a;
2640 }
2641
2642 sub ach_register
2643 {
2644     my ($self, $ach) = @_;
2645
2646     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2647
2648     $self->{info}->save();
2649
2650     return 1;
2651 }
2652
2653 sub ach_edit
2654 {
2655     my ($self) = @_;
2656     my $arg = $self->get_form('ach');
2657     if (!$arg->{ach}
2658         or !$self->{info}->{ach_list}
2659         or !$self->{info}->{ach_list}->{$arg->{ach}})
2660     {
2661         return $self->error("Can't get autochanger name");
2662     }
2663
2664     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2665
2666     my $i=0;
2667     $ach->{drives} =
2668         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2669
2670     my $b = $self->get_bconsole();
2671
2672     my @storages = $b->list_storage() ;
2673
2674     $ach->{devices} = [ map { { name => $_ } } @storages ];
2675
2676     $self->display($ach, "ach_add.tpl");
2677     delete $ach->{drives};
2678     delete $ach->{devices};
2679     return 1;
2680 }
2681
2682 sub ach_del
2683 {
2684     my ($self) = @_;
2685     my $arg = $self->get_form('ach');
2686
2687     if (!$arg->{ach}
2688         or !$self->{info}->{ach_list}
2689         or !$self->{info}->{ach_list}->{$arg->{ach}})
2690     {
2691         return $self->error("Can't get autochanger name");
2692     }
2693
2694     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2695
2696     $self->{info}->save();
2697     $self->{info}->view();
2698 }
2699
2700 sub ach_add
2701 {
2702     my ($self) = @_;
2703     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2704
2705     my $b = $self->get_bconsole();
2706     my @storages = $b->list_storage() ;
2707
2708     unless ($arg->{ach}) {
2709         $arg->{devices} = [ map { { name => $_ } } @storages ];
2710         return $self->display($arg, "ach_add.tpl");
2711     }
2712
2713     my @drives ;
2714     foreach my $drive (CGI::param('drives'))
2715     {
2716         unless (grep(/^$drive$/,@storages)) {
2717             return $self->error("Can't find $drive in storage list");
2718         }
2719
2720         my $index = CGI::param("index_$drive");
2721         unless (defined $index and $index =~ /^(\d+)$/) {
2722             return $self->error("Can't get $drive index");
2723         }
2724
2725         $drives[$index] = $drive;
2726     }
2727
2728     unless (@drives) {
2729         return $self->error("Can't get drives from Autochanger");
2730     }
2731
2732     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2733                                   precmd => $arg->{precmd},
2734                                   drive_name => \@drives,
2735                                   device => $arg->{device},
2736                                   mtxcmd => $arg->{mtxcmd});
2737
2738     $self->ach_register($a) ;
2739
2740     $self->{info}->view();
2741 }
2742
2743 sub delete
2744 {
2745     my ($self) = @_;
2746     my $arg = $self->get_form('jobid');
2747
2748     if ($arg->{jobid}) {
2749         my $b = $self->get_bconsole();
2750         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2751
2752         $self->display({
2753             content => $ret,
2754             title => "Delete a job ",
2755             name => "delete jobid=$arg->{jobid}",
2756         }, "command.tpl");
2757     }
2758 }
2759
2760 sub do_update_media
2761 {
2762     my ($self) = @_ ;
2763
2764     my $arg = $self->get_form(qw/media volstatus inchanger pool
2765                                  slot volretention voluseduration
2766                                  maxvoljobs maxvolfiles maxvolbytes
2767                               /);
2768
2769     unless ($arg->{media}) {
2770         return $self->error("Can't find media selection");
2771     }
2772
2773     my $update = "update volume=$arg->{media} ";
2774
2775     if ($arg->{volstatus}) {
2776         $update .= " volstatus=$arg->{volstatus} ";
2777     }
2778
2779     if ($arg->{inchanger}) {
2780         $update .= " inchanger=yes " ;
2781         if ($arg->{slot}) {
2782             $update .= " slot=$arg->{slot} ";
2783         }
2784     } else {
2785         $update .= " slot=0 inchanger=no ";
2786     }
2787
2788     if ($arg->{pool}) {
2789         $update .= " pool=$arg->{pool} " ;
2790     }
2791
2792     $arg->{volretention} ||= 0 ;
2793     if ($arg->{volretention}) {
2794         $update .= " volretention=\"$arg->{volretention}\" " ;
2795     }
2796
2797     $arg->{voluseduration} ||= 0 ;
2798     if ($arg->{voluseduration}) {
2799         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2800     }
2801
2802     $arg->{maxvoljobs} ||= 0;
2803     if ($arg->{maxvoljobs}) {
2804         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2805     }
2806
2807     $arg->{maxvolfiles} ||= 0;
2808     if ($arg->{maxvolfiles}) {
2809         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2810     }
2811
2812     $arg->{maxvolbytes} ||= 0;
2813     if ($arg->{maxvolbytes}) {
2814         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2815     }
2816
2817     my $b = $self->get_bconsole();
2818
2819     $self->display({
2820         content => $b->send_cmd($update),
2821         title => "Update a volume ",
2822         name => $update,
2823     }, "command.tpl");
2824
2825
2826     my $loc = CGI::param('location') || '';
2827     if ($loc) {
2828         my $media = $self->dbh_quote($arg->{media});
2829         $loc = $self->dbh_quote($loc); # is checked by db
2830         my $query = "
2831 UPDATE Media
2832    SET LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)
2833  WHERE Media.VolumeName = $media
2834 ";
2835         $self->dbh_do($query);
2836     }
2837
2838     $self->update_media();
2839 }
2840
2841 sub update_slots
2842 {
2843     my ($self) = @_;
2844
2845     my $ach = CGI::param('ach') ;
2846     unless ($ach =~ /^([\w\d\.-]+)$/) {
2847         return $self->error("Bad autochanger name");
2848     }
2849
2850     print "<pre>";
2851     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2852     $b->update_slots($ach);
2853     print "</pre>\n"
2854 }
2855
2856 sub get_job_log
2857 {
2858     my ($self) = @_;
2859
2860     my $arg = $self->get_form('jobid');
2861     unless ($arg->{jobid}) {
2862         return $self->error("Can't get jobid");
2863     }
2864
2865     my $t = CGI::param('time') || '';
2866
2867     my $query = "
2868 SELECT Job.Name as name, Client.Name as clientname
2869  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2870  WHERE JobId = $arg->{jobid}
2871 ";
2872
2873     my $row = $self->dbh_selectrow_hashref($query);
2874
2875     unless ($row) {
2876         return $self->error("Can't find $arg->{jobid} in catalog");
2877     }
2878
2879     $query = "
2880 SELECT Time AS time, LogText AS log
2881  FROM  Log
2882  WHERE JobId = $arg->{jobid}
2883  ORDER BY Time
2884 ";
2885     my $log = $self->dbh_selectall_arrayref($query);
2886     unless ($log) {
2887         return $self->error("Can't get log for jobid $arg->{jobid}");
2888     }
2889
2890     my $logtxt;
2891     if ($t) {
2892         # log contains \n
2893         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2894     } else {
2895         $logtxt = join("", map { $_->[1] } @$log ) ;
2896     }
2897
2898     $self->display({ lines=> $logtxt,
2899                      jobid => $arg->{jobid},
2900                      name  => $row->{name},
2901                      client => $row->{clientname},
2902                  }, 'display_log.tpl');
2903 }
2904
2905
2906 sub label_barcodes
2907 {
2908     my ($self) = @_ ;
2909
2910     my $arg = $self->get_form('ach', 'slots', 'drive');
2911
2912     unless ($arg->{ach}) {
2913         return $self->error("Can't find autochanger name");
2914     }
2915
2916     my $slots = '';
2917     my $t = 300 ;
2918     if ($arg->{slots}) {
2919         $slots = join(",", @{ $arg->{slots} });
2920         $t += 60*scalar( @{ $arg->{slots} }) ;
2921     }
2922
2923     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2924     print "<h1>This command can take long time, be patient...</h1>";
2925     print "<pre>" ;
2926     $b->label_barcodes(storage => $arg->{ach},
2927                        drive => $arg->{drive},
2928                        pool  => 'Scratch',
2929                        slots => $slots) ;
2930     $b->close();
2931     print "</pre>";
2932 }
2933
2934 sub purge
2935 {
2936     my ($self) = @_;
2937
2938     my @volume = CGI::param('media');
2939
2940     unless (@volume) {
2941         return $self->error("Can't get media selection");
2942     }
2943
2944     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2945
2946     $self->display({
2947         content => $b->purge_volume(@volume),
2948         title => "Purge media",
2949         name => "purge volume=" . join(' volume=', @volume),
2950     }, "command.tpl");
2951     $b->close();
2952 }
2953
2954 sub prune
2955 {
2956     my ($self) = @_;
2957
2958     my @volume = CGI::param('media');
2959     unless (@volume) {
2960         return $self->error("Can't get media selection");
2961     }
2962
2963     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2964
2965     $self->display({
2966         content => $b->prune_volume(@volume),
2967         title => "Prune media",
2968         name => "prune volume=" . join(' volume=', @volume),
2969     }, "command.tpl");
2970
2971     $b->close();
2972 }
2973
2974 sub cancel_job
2975 {
2976     my ($self) = @_;
2977
2978     my $arg = $self->get_form('jobid');
2979     unless ($arg->{jobid}) {
2980         return $self->error("Can't get jobid");
2981     }
2982
2983     my $b = $self->get_bconsole();
2984     $self->display({
2985         content => $b->cancel($arg->{jobid}),
2986         title => "Cancel job",
2987         name => "cancel jobid=$arg->{jobid}",
2988     }, "command.tpl");
2989 }
2990
2991 sub fileset_view
2992 {
2993     # Warning, we display current fileset
2994     my ($self) = @_;
2995
2996     my $arg = $self->get_form('fileset');
2997
2998     if ($arg->{fileset}) {
2999         my $b = $self->get_bconsole();
3000         my $ret = $b->get_fileset($arg->{fileset});
3001         $self->display({ fileset => $arg->{fileset},
3002                          %$ret,
3003                      }, "fileset_view.tpl");
3004     } else {
3005         $self->error("Can't get fileset name");
3006     }
3007 }
3008
3009 sub director_show_sched
3010 {
3011     my ($self) = @_ ;
3012
3013     my $arg = $self->get_form('days');
3014
3015     my $b = $self->get_bconsole();
3016     my $ret = $b->director_get_sched( $arg->{days} );
3017
3018     $self->display({
3019         id => $cur_id++,
3020         list => $ret,
3021     }, "scheduled_job.tpl");
3022 }
3023
3024 sub enable_disable_job
3025 {
3026     my ($self, $what) = @_ ;
3027
3028     my $name = CGI::param('job') || '';
3029     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3030         return $self->error("Can't find job name");
3031     }
3032
3033     my $b = $self->get_bconsole();
3034
3035     my $cmd;
3036     if ($what) {
3037         $cmd = "enable";
3038     } else {
3039         $cmd = "disable";
3040     }
3041
3042     $self->display({
3043         content => $b->send_cmd("$cmd job=\"$name\""),
3044         title => "$cmd $name",
3045         name => "$cmd job=\"$name\"",
3046     }, "command.tpl");
3047 }
3048
3049 sub get_bconsole
3050 {
3051     my ($self) = @_;
3052     return new Bconsole(pref => $self->{info});
3053 }
3054
3055 sub run_job_select
3056 {
3057     my ($self) = @_;
3058     my $b = $self->get_bconsole();
3059
3060     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3061
3062     $self->display({ Jobs => $joblist }, "run_job.tpl");
3063 }
3064
3065 sub run_parse_job
3066 {
3067     my ($self, $ouput) = @_;
3068
3069     my %arg;
3070     foreach my $l (split(/\r\n/, $ouput)) {
3071         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3072             $arg{$1} = $2;
3073             $l = $3
3074                 if ($3) ;
3075         }
3076
3077         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3078             %arg = (%arg, @l);
3079         }
3080     }
3081
3082     my %lowcase ;
3083     foreach my $k (keys %arg) {
3084         $lowcase{lc($k)} = $arg{$k} ;
3085     }
3086
3087     return \%lowcase;
3088 }
3089
3090 sub run_job_mod
3091 {
3092     my ($self) = @_;
3093     my $b = $self->get_bconsole();
3094
3095     my $job = CGI::param('job') || '';
3096
3097     my $info = $b->send_cmd("show job=\"$job\"");
3098     my $attr = $self->run_parse_job($info);
3099
3100     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3101
3102     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3103     my $clients = [ map { { name => $_ } }$b->list_client()];
3104     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3105     my $storages= [ map { { name => $_ } }$b->list_storage()];
3106
3107     $self->display({
3108         jobs     => $jobs,
3109         pools    => $pools,
3110         clients  => $clients,
3111         filesets => $filesets,
3112         storages => $storages,
3113         %$attr,
3114     }, "run_job_mod.tpl");
3115 }
3116
3117 sub run_job
3118 {
3119     my ($self) = @_;
3120     my $b = $self->get_bconsole();
3121
3122     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3123
3124     $self->display({
3125         jobs     => $jobs,
3126     }, "run_job.tpl");
3127 }
3128
3129 sub run_job_now
3130 {
3131     my ($self) = @_;
3132     my $b = $self->get_bconsole();
3133
3134     # TODO: check input (don't use pool, level)
3135
3136     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3137     my $job = CGI::param('job') || '';
3138     my $storage = CGI::param('storage') || '';
3139
3140     my $jobid = $b->run(job => $job,
3141                         client => $arg->{client},
3142                         priority => $arg->{priority},
3143                         level => $arg->{level},
3144                         storage => $storage,
3145                         pool => $arg->{pool},
3146                         );
3147
3148     print $jobid, $b->{error};
3149
3150     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3151 }
3152
3153 1;