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         if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1179             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1180         }
1181     }
1182 }
1183
1184 sub new
1185 {
1186     my ($class, %arg) = @_;
1187     my $self = bless {
1188         dbh => undef,           # connect_db();
1189         info => {
1190             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1191             user  => 'bacula',
1192             password => 'test',
1193         },
1194     } ;
1195
1196     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1197
1198     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1199         $self->{sql} = $sql_func{$1};
1200     }
1201
1202     $self->{debug} = $self->{info}->{debug};
1203     $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1204
1205     return $self;
1206 }
1207
1208 sub display_begin
1209 {
1210     my ($self) = @_;
1211     $self->display($self->{info}, "begin.tpl");
1212 }
1213
1214 sub display_end
1215 {
1216     my ($self) = @_;
1217     $self->display($self->{info}, "end.tpl");
1218 }
1219
1220 sub display_clients
1221 {
1222     my ($self) = @_;
1223
1224     my $where='';
1225     my $arg = $self->get_form("client", "qre_client");
1226
1227     if ($arg->{qre_client}) {
1228         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1229     } elsif ($arg->{client}) {
1230         $where = "WHERE Name = '$arg->{client}' ";
1231     }
1232
1233     my $query = "
1234 SELECT Name   AS name,
1235        Uname  AS uname,
1236        AutoPrune AS autoprune,
1237        FileRetention AS fileretention,
1238        JobRetention  AS jobretention
1239 FROM Client
1240 $where
1241 ";
1242
1243     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1244
1245     my $dsp = { ID => $cur_id++,
1246                 clients => [ values %$all] };
1247
1248     $self->display($dsp, "client_list.tpl") ;
1249 }
1250
1251 sub get_limit
1252 {
1253     my ($self, %arg) = @_;
1254
1255     my $limit = '';
1256     my $label = '';
1257
1258     if ($arg{age}) {
1259         $limit =
1260   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1261          >
1262        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1263          -
1264          $self->{sql}->{TO_SEC}($arg{age})
1265        )" ;
1266
1267         $label = "last " . human_sec($arg{age});
1268     }
1269
1270     if ($arg{groupby}) {
1271         $limit .= " GROUP BY $arg{groupby} ";
1272     }
1273
1274     if ($arg{order}) {
1275         $limit .= " ORDER BY $arg{order} ";
1276     }
1277
1278     if ($arg{limit}) {
1279         $limit .= " LIMIT $arg{limit} ";
1280         $label .= " limited to $arg{limit}";
1281     }
1282
1283     if ($arg{offset}) {
1284         $limit .= " OFFSET $arg{offset} ";
1285         $label .= " with $arg{offset} offset ";
1286     }
1287
1288     unless ($label) {
1289         $label = 'no filter';
1290     }
1291
1292     return ($limit, $label);
1293 }
1294
1295 =head1 FUNCTION
1296
1297     $bweb->get_form(...) - Get useful stuff
1298
1299 =head2 DESCRIPTION
1300
1301     This function get and check parameters against regexp.
1302
1303     If word begin with 'q', the return will be quoted or join quoted
1304     if it's end with 's'.
1305
1306
1307 =head2 EXAMPLE
1308
1309     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1310
1311     { jobid    => 12,
1312       qclient  => 'plume-fd',
1313       qpools   => "'plume-fd', 'test-fd', '...'",
1314     }
1315
1316 =cut
1317
1318 sub get_form
1319 {
1320     my ($self, @what) = @_;
1321     my %what = map { $_ => 1 } @what;
1322     my %ret;
1323
1324     my %opt_i = (
1325                  limit  => 100,
1326                  cost   =>  10,
1327                  offset =>   0,
1328                  width  => 640,
1329                  height => 480,
1330                  jobid  =>   0,
1331                  slot   =>   0,
1332                  drive  =>   0,
1333                  priority => 10,
1334                  age    => 60*60*24*7,
1335                  days   => 1,
1336                  maxvoljobs  => 0,
1337                  maxvolbytes => 0,
1338                  maxvolfiles => 0,
1339                  );
1340
1341     my %opt_s = (               # default to ''
1342                  ach    => 1,
1343                  status => 1,
1344                  volstatus => 1,
1345                  inchanger => 1,
1346                  client => 1,
1347                  level  => 1,
1348                  pool   => 1,
1349                  media  => 1,
1350                  ach    => 1,
1351                  jobtype=> 1,
1352                  graph  => 1,
1353                  gtype  => 1,
1354                  type   => 1,
1355                  );
1356     my %opt_p = (               # option with path
1357                  fileset=> 1,
1358                  mtxcmd => 1,
1359                  precmd => 1,
1360                  device => 1,
1361                  );
1362
1363     my %opt_d = (               # option with date
1364                  voluseduration=> 1,
1365                  volretention => 1,
1366                 );
1367
1368     foreach my $i (@what) {
1369         if (exists $opt_i{$i}) {# integer param
1370             my $value = CGI::param($i) || $opt_i{$i} ;
1371             if ($value =~ /^(\d+)$/) {
1372                 $ret{$i} = $1;
1373             }
1374         } elsif ($opt_s{$i}) {  # simple string param
1375             my $value = CGI::param($i) || '';
1376             if ($value =~ /^([\w\d\.-]+)$/) {
1377                 $ret{$i} = $1;
1378             }
1379
1380         } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1381             my @value = CGI::param($1) ;
1382             if (@value) {
1383                 $ret{$i} = $self->dbh_join(@value) ;
1384             }
1385
1386         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1387             my $value = CGI::param($1) ;
1388             if ($value) {
1389                 $ret{$i} = $self->dbh_quote($value);
1390             }
1391
1392         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1393             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1394                                   CGI::param($1) ];
1395         } elsif (exists $opt_p{$i}) {
1396             my $value = CGI::param($i) || '';
1397             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1398                 $ret{$i} = $1;
1399             }
1400         } elsif (exists $opt_d{$i}) {
1401             my $value = CGI::param($i) || '';
1402             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1403                 $ret{$i} = $1;
1404             }
1405         }
1406     }
1407
1408     if ($what{slots}) {
1409         foreach my $s (CGI::param('slot')) {
1410             if ($s =~ /^(\d+)$/) {
1411                 push @{$ret{slots}}, $s;
1412             }
1413         }
1414     }
1415
1416     if ($what{db_clients}) {
1417         my $query = "
1418 SELECT Client.Name as clientname
1419 FROM Client
1420 ";
1421
1422         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1423         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1424                               values %$clients] ;
1425     }
1426
1427     if ($what{db_mediatypes}) {
1428         my $query = "
1429 SELECT MediaType as mediatype
1430 FROM MediaType
1431 ";
1432
1433         my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1434         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1435                                   values %$medias] ;
1436     }
1437
1438     if ($what{db_locations}) {
1439         my $query = "
1440 SELECT Location as location, Cost as cost FROM Location
1441 ";
1442         my $loc = $self->dbh_selectall_hashref($query, 'location');
1443         $ret{db_locations} = [ sort { $a->{location}
1444                                       cmp
1445                                       $b->{location}
1446                                   } values %$loc ];
1447     }
1448
1449     if ($what{db_pools}) {
1450         my $query = "SELECT Name as name FROM Pool";
1451
1452         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1453         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1454     }
1455
1456     if ($what{db_filesets}) {
1457         my $query = "
1458 SELECT FileSet.FileSet AS fileset
1459 FROM FileSet
1460 ";
1461
1462         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1463
1464         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1465                                values %$filesets] ;
1466     }
1467
1468     if ($what{db_jobnames}) {
1469         my $query = "
1470 SELECT DISTINCT Job.Name AS jobname
1471 FROM Job
1472 ";
1473
1474         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1475
1476         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1477                                values %$jobnames] ;
1478     }
1479
1480     if ($what{db_devices}) {
1481         my $query = "
1482 SELECT Device.Name AS name
1483 FROM Device
1484 ";
1485
1486         my $devices = $self->dbh_selectall_hashref($query, 'name');
1487
1488         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1489                                values %$devices] ;
1490     }
1491
1492     return \%ret;
1493 }
1494
1495 sub display_graph
1496 {
1497     my ($self) = @_;
1498
1499     my $fields = $self->get_form(qw/age level status clients filesets
1500                                     graph gtype type
1501                                     db_clients limit db_filesets width height
1502                                     qclients qfilesets qjobnames db_jobnames/);
1503
1504
1505     my $url = CGI::url(-full => 0,
1506                        -base => 0,
1507                        -query => 1);
1508     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1509
1510 # this organisation is to keep user choice between 2 click
1511 # TODO : fileset and client selection doesn't work
1512
1513     $self->display({
1514         url => $url,
1515         %$fields,
1516     }, "graph.tpl")
1517
1518 }
1519
1520 sub display_client_job
1521 {
1522     my ($self, %arg) = @_ ;
1523
1524     $arg{order} = ' Job.JobId DESC ';
1525     my ($limit, $label) = $self->get_limit(%arg);
1526
1527     my $clientname = $self->dbh_quote($arg{clientname});
1528
1529     my $query="
1530 SELECT DISTINCT Job.JobId       AS jobid,
1531                 Job.Name        AS jobname,
1532                 FileSet.FileSet AS fileset,
1533                 Level           AS level,
1534                 StartTime       AS starttime,
1535                 JobFiles        AS jobfiles,
1536                 JobBytes        AS jobbytes,
1537                 JobStatus       AS jobstatus,
1538                 JobErrors       AS joberrors
1539
1540  FROM Client,Job,FileSet
1541  WHERE Client.Name=$clientname
1542  AND Client.ClientId=Job.ClientId
1543  AND Job.FileSetId=FileSet.FileSetId
1544  $limit
1545 ";
1546
1547     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1548
1549     $self->display({ clientname => $arg{clientname},
1550                      Filter => $label,
1551                      ID => $cur_id++,
1552                      Jobs => [ values %$all ],
1553                    },
1554                    "display_client_job.tpl") ;
1555 }
1556
1557 sub get_selected_media_location
1558 {
1559     my ($self) = @_ ;
1560
1561     my $medias = $self->get_form('jmedias');
1562
1563     unless ($medias->{jmedias}) {
1564         return undef;
1565     }
1566
1567     my $query = "
1568 SELECT Media.VolumeName AS volumename, Location.Location AS location
1569 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1570 WHERE Media.VolumeName IN ($medias->{jmedias})
1571 ";
1572
1573     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1574
1575     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1576     #               ..
1577     #             }
1578     # }
1579     return $all;
1580 }
1581
1582 sub move_media
1583 {
1584     my ($self) = @_ ;
1585
1586     my $medias = $self->get_selected_media_location();
1587
1588     unless ($medias) {
1589         return ;
1590     }
1591
1592     my $elt = $self->get_form('db_locations');
1593
1594     $self->display({ ID => $cur_id++,
1595                      %$elt,     # db_locations
1596                      medias => [
1597             sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1598                                ],
1599                      },
1600                    "move_media.tpl");
1601 }
1602
1603 sub help_extern
1604 {
1605     my ($self) = @_ ;
1606
1607     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1608     $self->debug($elt);
1609     $self->display($elt, "help_extern.tpl");
1610 }
1611
1612 sub help_extern_compute
1613 {
1614     my ($self) = @_;
1615
1616     my $number = CGI::param('limit') || '' ;
1617     unless ($number =~ /^(\d+)$/) {
1618         return $self->error("Bad arg number : $number ");
1619     }
1620
1621     my ($sql, undef) = $self->get_param('pools',
1622                                         'locations', 'mediatypes');
1623
1624     my $query = "
1625 SELECT Media.VolumeName  AS volumename,
1626        Media.VolStatus   AS volstatus,
1627        Media.LastWritten AS lastwritten,
1628        Media.MediaType   AS mediatype,
1629        Media.VolMounts   AS volmounts,
1630        Pool.Name         AS name,
1631        Media.Recycle     AS recycle,
1632        $self->{sql}->{FROM_UNIXTIME}(
1633           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1634         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1635        ) AS expire
1636 FROM Media
1637  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1638  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1639
1640 WHERE Media.InChanger = 1
1641   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1642   $sql
1643 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1644 LIMIT $number
1645 " ;
1646
1647     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1648
1649     $self->display({ Medias => [ values %$all ] },
1650                    "help_extern_compute.tpl");
1651 }
1652
1653 sub help_intern
1654 {
1655     my ($self) = @_ ;
1656
1657     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1658     $self->display($param, "help_intern.tpl");
1659 }
1660
1661 sub help_intern_compute
1662 {
1663     my ($self) = @_;
1664
1665     my $number = CGI::param('limit') || '' ;
1666     unless ($number =~ /^(\d+)$/) {
1667         return $self->error("Bad arg number : $number ");
1668     }
1669
1670     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1671
1672     if (CGI::param('expired')) {
1673         $sql = "
1674 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1675        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1676     ) < NOW()
1677  " . $sql ;
1678     }
1679
1680     my $query = "
1681 SELECT Media.VolumeName  AS volumename,
1682        Media.VolStatus   AS volstatus,
1683        Media.LastWritten AS lastwritten,
1684        Media.MediaType   AS mediatype,
1685        Media.VolMounts   AS volmounts,
1686        Pool.Name         AS name,
1687        $self->{sql}->{FROM_UNIXTIME}(
1688           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1689         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1690        ) AS expire
1691 FROM Media
1692  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1693  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1694
1695 WHERE Media.InChanger <> 1
1696   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1697   AND Media.Recycle = 1
1698   $sql
1699 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1700 LIMIT $number
1701 " ;
1702
1703     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1704
1705     $self->display({ Medias => [ values %$all ] },
1706                    "help_intern_compute.tpl");
1707
1708 }
1709
1710 sub display_general
1711 {
1712     my ($self, %arg) = @_ ;
1713
1714     my ($limit, $label) = $self->get_limit(%arg);
1715
1716     my $query = "
1717 SELECT
1718     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1719     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1720     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1721     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1722     (SELECT count(Job.JobId)
1723       FROM Job
1724       WHERE Job.JobStatus IN ('E','e','f','A')
1725       $limit
1726     )                                         AS nb_err,
1727     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1728 ";
1729
1730     my $row = $self->dbh_selectrow_hashref($query) ;
1731
1732     $row->{nb_bytes} = human_size($row->{nb_bytes});
1733
1734     $row->{db_size} = '???';
1735     $row->{label} = $label;
1736
1737     $self->display($row, "general.tpl");
1738 }
1739
1740 sub get_param
1741 {
1742     my ($self, @what) = @_ ;
1743     my %elt = map { $_ => 1 } @what;
1744     my %ret;
1745
1746     my $limit = '';
1747
1748     if ($elt{clients}) {
1749         my @clients = CGI::param('client');
1750         if (@clients) {
1751             $ret{clients} = \@clients;
1752             my $str = $self->dbh_join(@clients);
1753             $limit .= "AND Client.Name IN ($str) ";
1754         }
1755     }
1756
1757     if ($elt{filesets}) {
1758         my @filesets = CGI::param('fileset');
1759         if (@filesets) {
1760             $ret{filesets} = \@filesets;
1761             my $str = $self->dbh_join(@filesets);
1762             $limit .= "AND FileSet.FileSet IN ($str) ";
1763         }
1764     }
1765
1766     if ($elt{mediatypes}) {
1767         my @medias = CGI::param('mediatype');
1768         if (@medias) {
1769             $ret{mediatypes} = \@medias;
1770             my $str = $self->dbh_join(@medias);
1771             $limit .= "AND Media.MediaType IN ($str) ";
1772         }
1773     }
1774
1775     if ($elt{client}) {
1776         my $client = CGI::param('client');
1777         $ret{client} = $client;
1778         $client = $self->dbh_join($client);
1779         $limit .= "AND Client.Name = $client ";
1780     }
1781
1782     if ($elt{level}) {
1783         my $level = CGI::param('level') || '';
1784         if ($level =~ /^(\w)$/) {
1785             $ret{level} = $1;
1786             $limit .= "AND Job.Level = '$1' ";
1787         }
1788     }
1789
1790     if ($elt{jobid}) {
1791         my $jobid = CGI::param('jobid') || '';
1792
1793         if ($jobid =~ /^(\d+)$/) {
1794             $ret{jobid} = $1;
1795             $limit .= "AND Job.JobId = '$1' ";
1796         }
1797     }
1798
1799     if ($elt{status}) {
1800         my $status = CGI::param('status') || '';
1801         if ($status =~ /^(\w)$/) {
1802             $ret{status} = $1;
1803             if ($1 eq 'f') {
1804                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1805             } else {
1806                 $limit .= "AND Job.JobStatus = '$1' ";
1807             }
1808         }
1809     }
1810
1811     if ($elt{locations}) {
1812         my @location = CGI::param('location') ;
1813         if (@location) {
1814             $ret{locations} = \@location;
1815             my $str = $self->dbh_join(@location);
1816             $limit .= "AND Location.Location IN ($str) ";
1817         }
1818     }
1819
1820     if ($elt{pools}) {
1821         my @pool = CGI::param('pool') ;
1822         if (@pool) {
1823             $ret{pools} = \@pool;
1824             my $str = $self->dbh_join(@pool);
1825             $limit .= "AND Pool.Name IN ($str) ";
1826         }
1827     }
1828
1829     if ($elt{location}) {
1830         my $location = CGI::param('location') || '';
1831         if ($location) {
1832             $ret{location} = $location;
1833             $location = $self->dbh_quote($location);
1834             $limit .= "AND Location.Location = $location ";
1835         }
1836     }
1837
1838     if ($elt{pool}) {
1839         my $pool = CGI::param('pool') || '';
1840         if ($pool) {
1841             $ret{pool} = $pool;
1842             $pool = $self->dbh_quote($pool);
1843             $limit .= "AND Pool.Name = $pool ";
1844         }
1845     }
1846
1847     if ($elt{jobtype}) {
1848         my $jobtype = CGI::param('jobtype') || '';
1849         if ($jobtype =~ /^(\w)$/) {
1850             $ret{jobtype} = $1;
1851             $limit .= "AND Job.Type = '$1' ";
1852         }
1853     }
1854
1855     return ($limit, %ret);
1856 }
1857
1858 =head1
1859
1860     get last backup
1861
1862 =cut
1863
1864 sub display_job
1865 {
1866     my ($self, %arg) = @_ ;
1867
1868     $arg{order} = ' Job.JobId DESC ';
1869
1870     my ($limit, $label) = $self->get_limit(%arg);
1871     my ($where, undef) = $self->get_param('clients',
1872                                           'level',
1873                                           'filesets',
1874                                           'jobtype',
1875                                           'jobid',
1876                                           'status');
1877
1878     my $query="
1879 SELECT  Job.JobId       AS jobid,
1880         Client.Name     AS client,
1881         FileSet.FileSet AS fileset,
1882         Job.Name        AS jobname,
1883         Level           AS level,
1884         StartTime       AS starttime,
1885         Pool.Name       AS poolname,
1886         JobFiles        AS jobfiles,
1887         JobBytes        AS jobbytes,
1888         JobStatus       AS jobstatus,
1889      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1890                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1891                         AS duration,
1892
1893         JobErrors       AS joberrors
1894
1895  FROM Client,
1896       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1897           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1898  WHERE Client.ClientId=Job.ClientId
1899    AND Job.JobStatus != 'R'
1900  $where
1901  $limit
1902 ";
1903
1904     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1905
1906     $self->display({ Filter => $label,
1907                      ID => $cur_id++,
1908                      Jobs =>
1909                            [
1910                              sort { $a->{jobid} <=>  $b->{jobid} }
1911                                         values %$all
1912                              ],
1913                    },
1914                    "display_job.tpl");
1915 }
1916
1917 # display job informations
1918 sub display_job_zoom
1919 {
1920     my ($self, $jobid) = @_ ;
1921
1922     $jobid = $self->dbh_quote($jobid);
1923
1924     my $query="
1925 SELECT DISTINCT Job.JobId       AS jobid,
1926                 Client.Name     AS client,
1927                 Job.Name        AS jobname,
1928                 FileSet.FileSet AS fileset,
1929                 Level           AS level,
1930                 Pool.Name       AS poolname,
1931                 StartTime       AS starttime,
1932                 JobFiles        AS jobfiles,
1933                 JobBytes        AS jobbytes,
1934                 JobStatus       AS jobstatus,
1935                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1936                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1937
1938  FROM Client,
1939       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1940           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1941  WHERE Client.ClientId=Job.ClientId
1942  AND Job.JobId = $jobid
1943 ";
1944
1945     my $row = $self->dbh_selectrow_hashref($query) ;
1946
1947     # display all volumes associate with this job
1948     $query="
1949 SELECT Media.VolumeName as volumename
1950 FROM Job,Media,JobMedia
1951 WHERE Job.JobId = $jobid
1952  AND JobMedia.JobId=Job.JobId
1953  AND JobMedia.MediaId=Media.MediaId
1954 ";
1955
1956     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1957
1958     $row->{volumes} = [ values %$all ] ;
1959
1960     $self->display($row, "display_job_zoom.tpl");
1961 }
1962
1963 sub display_media
1964 {
1965     my ($self) = @_ ;
1966
1967     my ($where, %elt) = $self->get_param('pool',
1968                                          'location');
1969
1970     my $arg = $self->get_form('jmedias', 'qre_media');
1971
1972     if ($arg->{jmedias}) {
1973         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1974     }
1975     if ($arg->{qre_media}) {
1976         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1977     }
1978
1979     my $query="
1980 SELECT Media.VolumeName  AS volumename,
1981        Media.VolBytes    AS volbytes,
1982        Media.VolStatus   AS volstatus,
1983        Media.MediaType   AS mediatype,
1984        Media.InChanger   AS online,
1985        Media.LastWritten AS lastwritten,
1986        Location.Location AS location,
1987        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
1988        Pool.Name         AS poolname,
1989        $self->{sql}->{FROM_UNIXTIME}(
1990           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1991         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1992        ) AS expire
1993 FROM      Pool, Media
1994 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1995 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1996                   Media.MediaType     AS MediaType
1997            FROM Media
1998           WHERE Media.VolStatus = 'Full'
1999           GROUP BY Media.MediaType
2000            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2001
2002 WHERE Media.PoolId=Pool.PoolId
2003 $where
2004 ";
2005
2006     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2007
2008     $self->display({ ID => $cur_id++,
2009                      Pool => $elt{pool},
2010                      Location => $elt{location},
2011                      Medias => [ values %$all ]
2012                    },
2013                    "display_media.tpl");
2014 }
2015
2016 sub display_medias
2017 {
2018     my ($self) = @_ ;
2019
2020     my $pool = $self->get_form('db_pools');
2021
2022     foreach my $name (@{ $pool->{db_pools} }) {
2023         CGI::param('pool', $name->{name});
2024         $self->display_media();
2025     }
2026 }
2027
2028 sub display_media_zoom
2029 {
2030     my ($self) = @_ ;
2031
2032     my $medias = $self->get_form('jmedias');
2033
2034     unless ($medias->{jmedias}) {
2035         return $self->error("Can't get media selection");
2036     }
2037
2038     my $query="
2039 SELECT InChanger     AS online,
2040        VolBytes      AS nb_bytes,
2041        VolumeName    AS volumename,
2042        VolStatus     AS volstatus,
2043        VolMounts     AS nb_mounts,
2044        Media.VolUseDuration   AS voluseduration,
2045        Media.MaxVolJobs AS maxvoljobs,
2046        Media.MaxVolFiles AS maxvolfiles,
2047        Media.MaxVolBytes AS maxvolbytes,
2048        VolErrors     AS nb_errors,
2049        Pool.Name     AS poolname,
2050        Location.Location AS location,
2051        Media.Recycle AS recycle,
2052        Media.VolRetention AS volretention,
2053        Media.LastWritten  AS lastwritten,
2054        Media.VolReadTime/1000000  AS volreadtime,
2055        Media.VolWriteTime/1000000 AS volwritetime,
2056        $self->{sql}->{FROM_UNIXTIME}(
2057           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2058         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2059        ) AS expire
2060  FROM Pool,
2061       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2062  WHERE Pool.PoolId = Media.PoolId
2063  AND VolumeName IN ($medias->{jmedias})
2064 ";
2065
2066     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2067
2068     foreach my $media (values %$all) {
2069         my $mq = $self->dbh_quote($media->{volumename});
2070
2071         $query = "
2072 SELECT DISTINCT Job.JobId AS jobid,
2073                 Job.Name  AS name,
2074                 Job.StartTime AS starttime,
2075                 Job.Type  AS type,
2076                 Job.Level AS level,
2077                 Job.JobFiles AS files,
2078                 Job.JobBytes AS bytes,
2079                 Job.jobstatus AS status
2080  FROM Media,JobMedia,Job
2081  WHERE Media.VolumeName=$mq
2082  AND Media.MediaId=JobMedia.MediaId
2083  AND JobMedia.JobId=Job.JobId
2084 ";
2085
2086         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2087
2088         $query = "
2089 SELECT LocationLog.Date    AS date,
2090        Location.Location   AS location,
2091        LocationLog.Comment AS comment
2092  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2093  WHERE Media.MediaId = LocationLog.MediaId
2094    AND Media.VolumeName = $mq
2095 ";
2096
2097         my $logtxt = '';
2098         my $log = $self->dbh_selectall_arrayref($query) ;
2099         if ($log) {
2100             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2101         }
2102
2103         $self->display({ jobs => [ values %$jobs ],
2104                          LocationLog => $logtxt,
2105                          %$media },
2106                        "display_media_zoom.tpl");
2107     }
2108 }
2109
2110 sub location_edit
2111 {
2112     my ($self) = @_ ;
2113
2114     my $loc = $self->get_form('qlocation');
2115     unless ($loc->{qlocation}) {
2116         return $self->error("Can't get location");
2117     }
2118
2119     my $query = "
2120 SELECT Location.Location AS location,
2121        Location.Cost   AS cost,
2122        Location.Enabled AS enabled
2123 FROM Location
2124 WHERE Location.Location = $loc->{qlocation}
2125 ";
2126
2127     my $row = $self->dbh_selectrow_hashref($query);
2128
2129     $self->display({ ID => $cur_id++,
2130                      %$row }, "location_edit.tpl") ;
2131
2132 }
2133
2134 sub location_save
2135 {
2136     my ($self) = @_ ;
2137
2138     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2139     unless ($arg->{qlocation}) {
2140         return $self->error("Can't get location");
2141     }
2142     unless ($arg->{qnewlocation}) {
2143         return $self->error("Can't get new location name");
2144     }
2145     unless ($arg->{cost}) {
2146         return $self->error("Can't get new cost");
2147     }
2148
2149     my $enabled = CGI::param('enabled') || '';
2150     $enabled = $enabled?1:0;
2151
2152     my $query = "
2153 UPDATE Location SET Cost     = $arg->{cost},
2154                     Location = $arg->{qnewlocation},
2155                     Enabled   = $enabled
2156 WHERE Location.Location = $arg->{qlocation}
2157 ";
2158
2159     $self->dbh_do($query);
2160
2161     $self->display_location();
2162 }
2163
2164 sub location_del
2165 {
2166     my ($self) = @_ ;
2167     my $arg = $self->get_form(qw/qlocation/) ;
2168
2169     unless ($arg->{qlocation}) {
2170         return $self->error("Can't get location");
2171     }
2172
2173     my $query = "
2174 SELECT count(Media.MediaId) AS nb
2175   FROM Media INNER JOIN Location USING (LocationID)
2176 WHERE Location = $arg->{qlocation}
2177 ";
2178
2179     my $res = $self->dbh_selectrow_hashref($query);
2180
2181     if ($res->{nb}) {
2182         return $self->error("Sorry, the location must be empty");
2183     }
2184
2185     $query = "
2186 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2187 ";
2188
2189     $self->dbh_do($query);
2190
2191     $self->display_location();
2192 }
2193
2194
2195 sub location_add
2196 {
2197     my ($self) = @_ ;
2198     my $arg = $self->get_form(qw/qlocation cost/) ;
2199
2200     unless ($arg->{qlocation}) {
2201         $self->display({}, "location_add.tpl");
2202         return 1;
2203     }
2204     unless ($arg->{cost}) {
2205         return $self->error("Can't get new cost");
2206     }
2207
2208     my $enabled = CGI::param('enabled') || '';
2209     $enabled = $enabled?1:0;
2210
2211     my $query = "
2212 INSERT INTO Location (Location, Cost, Enabled)
2213        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2214 ";
2215
2216     $self->dbh_do($query);
2217
2218     $self->display_location();
2219 }
2220
2221 sub display_location
2222 {
2223     my ($self) = @_ ;
2224
2225     my $query = "
2226 SELECT Location.Location AS location,
2227        Location.Cost     AS cost,
2228        Location.Enabled  AS enabled,
2229        (SELECT count(Media.MediaId)
2230          FROM Media
2231         WHERE Media.LocationId = Location.LocationId
2232        ) AS volnum
2233 FROM Location
2234 ";
2235
2236     my $location = $self->dbh_selectall_hashref($query, 'location');
2237
2238     $self->display({ ID => $cur_id++,
2239                      Locations => [ values %$location ] },
2240                    "display_location.tpl");
2241 }
2242
2243 sub update_location
2244 {
2245     my ($self) = @_ ;
2246
2247     my $medias = $self->get_selected_media_location();
2248     unless ($medias) {
2249         return ;
2250     }
2251
2252     my $arg = $self->get_form('db_locations', 'qnewlocation');
2253
2254     $self->display({ email  => $self->{info}->{email_media},
2255                      %$arg,
2256                      medias => [ values %$medias ],
2257                    },
2258                    "update_location.tpl");
2259 }
2260
2261 sub get_media_max_size
2262 {
2263     my ($self, $type) = @_;
2264     my $query =
2265 "SELECT avg(VolBytes) AS size
2266   FROM Media
2267  WHERE Media.VolStatus = 'Full'
2268    AND Media.MediaType = '$type'
2269 ";
2270
2271     my $res = $self->selectrow_hashref($query);
2272
2273     if ($res) {
2274         return $res->{size};
2275     } else {
2276         return 0;
2277     }
2278 }
2279
2280 sub update_media
2281 {
2282     my ($self) = @_ ;
2283
2284     my $media = $self->get_form('qmedia');
2285
2286     unless ($media->{qmedia}) {
2287         return $self->error("Can't get media");
2288     }
2289
2290     my $query = "
2291 SELECT Media.Slot         AS slot,
2292        Pool.Name          AS poolname,
2293        Media.VolStatus    AS volstatus,
2294        Media.InChanger    AS inchanger,
2295        Location.Location  AS location,
2296        Media.VolumeName   AS volumename,
2297        Media.MaxVolBytes  AS maxvolbytes,
2298        Media.MaxVolJobs   AS maxvoljobs,
2299        Media.MaxVolFiles  AS maxvolfiles,
2300        Media.VolUseDuration AS voluseduration,
2301        Media.VolRetention AS volretention
2302
2303 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2304            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2305
2306 WHERE Media.VolumeName = $media->{qmedia}
2307 ";
2308
2309     my $row = $self->dbh_selectrow_hashref($query);
2310     $row->{volretention} = human_sec($row->{volretention});
2311     $row->{voluseduration} = human_sec($row->{voluseduration});
2312
2313     my $elt = $self->get_form(qw/db_pools db_locations/);
2314
2315     $self->display({
2316         %$elt,
2317         %$row,
2318     }, "update_media.tpl");
2319 }
2320
2321 sub save_location
2322 {
2323     my ($self) = @_ ;
2324
2325     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2326
2327     unless ($arg->{jmedias}) {
2328         return $self->error("Can't get selected media");
2329     }
2330
2331     unless ($arg->{qnewlocation}) {
2332         return $self->error("Can't get new location");
2333     }
2334
2335     my $query = "
2336  UPDATE Media
2337      SET LocationId = (SELECT LocationId
2338                        FROM Location
2339                        WHERE Location = $arg->{qnewlocation})
2340      WHERE Media.VolumeName IN ($arg->{jmedias})
2341 ";
2342
2343     my $nb = $self->dbh_do($query);
2344
2345     print "$nb media updated, you may have to update your autochanger.";
2346
2347     $self->display_media();
2348 }
2349
2350 sub change_location
2351 {
2352     my ($self) = @_ ;
2353
2354     my $medias = $self->get_selected_media_location();
2355     unless ($medias) {
2356         return $self->error("Can't get media selection");
2357     }
2358     my $newloc = CGI::param('newlocation');
2359
2360     my $user = CGI::param('user') || 'unknow';
2361     my $comm = CGI::param('comment') || '';
2362     $comm = $self->dbh_quote("$user: $comm");
2363
2364     my $query;
2365
2366     foreach my $media (keys %$medias) {
2367         $query = "
2368 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2369  VALUES(
2370        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2371        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2372        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2373       )
2374 ";
2375         $self->dbh_do($query);
2376         $self->debug($query);
2377     }
2378
2379     my $q = new CGI;
2380     $q->param('action', 'update_location');
2381     my $url = $q->url(-full => 1, -query=>1);
2382
2383     $self->display({ email  => $self->{info}->{email_media},
2384                      url => $url,
2385                      newlocation => $newloc,
2386                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2387                      medias => [ values %$medias ],
2388                    },
2389                    "change_location.tpl");
2390
2391 }
2392
2393 sub display_client_stats
2394 {
2395     my ($self, %arg) = @_ ;
2396
2397     my $client = $self->dbh_quote($arg{clientname});
2398     my ($limit, $label) = $self->get_limit(%arg);
2399
2400     my $query = "
2401 SELECT
2402     count(Job.JobId)     AS nb_jobs,
2403     sum(Job.JobBytes)    AS nb_bytes,
2404     sum(Job.JobErrors)   AS nb_err,
2405     sum(Job.JobFiles)    AS nb_files,
2406     Client.Name          AS clientname
2407 FROM Job INNER JOIN Client USING (ClientId)
2408 WHERE
2409     Client.Name = $client
2410     $limit
2411 GROUP BY Client.Name
2412 ";
2413
2414     my $row = $self->dbh_selectrow_hashref($query);
2415
2416     $row->{ID} = $cur_id++;
2417     $row->{label} = $label;
2418
2419     $self->display($row, "display_client_stats.tpl");
2420 }
2421
2422 # poolname can be undef
2423 sub display_pool
2424 {
2425     my ($self, $poolname) = @_ ;
2426
2427 # TODO : afficher les tailles et les dates
2428
2429     my $query = "
2430 SELECT subq.volmax        AS volmax,
2431        subq.volnum        AS volnum,
2432        subq.voltotal      AS voltotal,
2433        Pool.Name          AS name,
2434        Pool.Recycle       AS recycle,
2435        Pool.VolRetention  AS volretention,
2436        Pool.VolUseDuration AS voluseduration,
2437        Pool.MaxVolJobs    AS maxvoljobs,
2438        Pool.MaxVolFiles   AS maxvolfiles,
2439        Pool.MaxVolBytes   AS maxvolbytes,
2440        subq.PoolId        AS PoolId
2441 FROM
2442   (
2443     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2444            count(Media.MediaId)  AS volnum,
2445            sum(Media.VolBytes)   AS voltotal,
2446            Media.PoolId          AS PoolId,
2447            Media.MediaType       AS MediaType
2448     FROM Media
2449     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2450                       Media.MediaType     AS MediaType
2451                FROM Media
2452               WHERE Media.VolStatus = 'Full'
2453               GROUP BY Media.MediaType
2454                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2455     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2456   ) AS subq
2457 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2458 ";
2459
2460     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2461
2462     $query = "
2463 SELECT Pool.Name AS name,
2464        sum(VolBytes) AS size
2465 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2466 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
2467 GROUP BY Pool.Name;
2468 ";
2469     my $empty = $self->dbh_selectall_hashref($query, 'name');
2470
2471     foreach my $p (values %$all) {
2472         if ($p->{volmax} > 0) { # mysql returns 0.0000
2473             # we remove Recycled/Purged media from pool usage
2474             if (defined $empty->{$p->{name}}) {
2475                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2476             }
2477             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2478         } else {
2479             $p->{poolusage} = 0;
2480         }
2481
2482         $query = "
2483   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2484     FROM Media
2485    WHERE PoolId=$p->{poolid}
2486 GROUP BY VolStatus
2487 ";
2488         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2489         foreach my $t (values %$content) {
2490             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2491         }
2492     }
2493
2494     $self->debug($all);
2495     $self->display({ ID => $cur_id++,
2496                      Pools => [ values %$all ]},
2497                    "display_pool.tpl");
2498 }
2499
2500 sub display_running_job
2501 {
2502     my ($self) = @_;
2503
2504     my $arg = $self->get_form('client', 'jobid');
2505
2506     if (!$arg->{client} and $arg->{jobid}) {
2507
2508         my $query = "
2509 SELECT Client.Name AS name
2510 FROM Job INNER JOIN Client USING (ClientId)
2511 WHERE Job.JobId = $arg->{jobid}
2512 ";
2513
2514         my $row = $self->dbh_selectrow_hashref($query);
2515
2516         if ($row) {
2517             $arg->{client} = $row->{name};
2518             CGI::param('client', $arg->{client});
2519         }
2520     }
2521
2522     if ($arg->{client}) {
2523         my $cli = new Bweb::Client(name => $arg->{client});
2524         $cli->display_running_job($self->{info}, $arg->{jobid});
2525         if ($arg->{jobid}) {
2526             $self->get_job_log();
2527         }
2528     } else {
2529         $self->error("Can't get client or jobid");
2530     }
2531 }
2532
2533 sub display_running_jobs
2534 {
2535     my ($self, $display_action) = @_;
2536
2537     my $query = "
2538 SELECT Job.JobId AS jobid,
2539        Job.Name  AS jobname,
2540        Job.Level     AS level,
2541        Job.StartTime AS starttime,
2542        Job.JobFiles  AS jobfiles,
2543        Job.JobBytes  AS jobbytes,
2544        Job.JobStatus AS jobstatus,
2545 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2546                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2547          AS duration,
2548        Client.Name AS clientname
2549 FROM Job INNER JOIN Client USING (ClientId)
2550 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2551 ";
2552     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2553
2554     $self->display({ ID => $cur_id++,
2555                      display_action => $display_action,
2556                      Jobs => [ values %$all ]},
2557                    "running_job.tpl") ;
2558 }
2559
2560 sub eject_media
2561 {
2562     my ($self) = @_;
2563     my $arg = $self->get_form('jmedias');
2564
2565     unless ($arg->{jmedias}) {
2566         return $self->error("Can't get media selection");
2567     }
2568
2569     my $query = "
2570 SELECT Media.VolumeName  AS volumename,
2571        Storage.Name      AS storage,
2572        Location.Location AS location,
2573        Media.Slot        AS slot
2574 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2575            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2576 WHERE Media.VolumeName IN ($arg->{jmedias})
2577   AND Media.InChanger = 1
2578 ";
2579
2580     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2581
2582     foreach my $vol (values %$all) {
2583         my $a = $self->ach_get($vol->{location});
2584         next unless ($a) ;
2585
2586         unless ($a->{have_status}) {
2587             $a->status();
2588             $a->{have_status} = 1;
2589         }
2590
2591         print "eject $vol->{volumename} from $vol->{storage} : ";
2592         if ($a->send_to_io($vol->{slot})) {
2593             print "ok</br>";
2594         } else {
2595             print "err</br>";
2596         }
2597     }
2598 }
2599
2600 sub move_email
2601 {
2602     my ($self) = @_;
2603
2604     my ($to, $subject, $content) = (CGI::param('email'),
2605                                     CGI::param('subject'),
2606                                     CGI::param('content'));
2607     $to =~ s/[^\w\d\.\@<>,]//;
2608     $subject =~ s/[^\w\d\.\[\]]/ /;
2609
2610     open(MAIL, "|mail -s '$subject' '$to'") ;
2611     print MAIL $content;
2612     close(MAIL);
2613
2614     print "Mail sent";
2615 }
2616
2617 sub restore
2618 {
2619     my ($self) = @_;
2620
2621     my $arg = $self->get_form('jobid', 'client');
2622
2623     print CGI::header('text/brestore');
2624     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2625     print "client=$arg->{client}\n" if ($arg->{client});
2626     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2627     print "\n";
2628 }
2629
2630 # TODO : move this to Bweb::Autochanger ?
2631 # TODO : make this internal to not eject tape ?
2632 use Bconsole;
2633
2634
2635 sub ach_get
2636 {
2637     my ($self, $name) = @_;
2638
2639     unless ($name) {
2640         return $self->error("Can't get your autochanger name ach");
2641     }
2642
2643     unless ($self->{info}->{ach_list}) {
2644         return $self->error("Could not find any autochanger");
2645     }
2646
2647     my $a = $self->{info}->{ach_list}->{$name};
2648
2649     unless ($a) {
2650         $self->error("Can't get your autochanger $name from your ach_list");
2651         return undef;
2652     }
2653
2654     $a->{bweb} = $self;
2655
2656     return $a;
2657 }
2658
2659 sub ach_register
2660 {
2661     my ($self, $ach) = @_;
2662
2663     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2664
2665     $self->{info}->save();
2666
2667     return 1;
2668 }
2669
2670 sub ach_edit
2671 {
2672     my ($self) = @_;
2673     my $arg = $self->get_form('ach');
2674     if (!$arg->{ach}
2675         or !$self->{info}->{ach_list}
2676         or !$self->{info}->{ach_list}->{$arg->{ach}})
2677     {
2678         return $self->error("Can't get autochanger name");
2679     }
2680
2681     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2682
2683     my $i=0;
2684     $ach->{drives} =
2685         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2686
2687     my $b = $self->get_bconsole();
2688
2689     my @storages = $b->list_storage() ;
2690
2691     $ach->{devices} = [ map { { name => $_ } } @storages ];
2692
2693     $self->display($ach, "ach_add.tpl");
2694     delete $ach->{drives};
2695     delete $ach->{devices};
2696     return 1;
2697 }
2698
2699 sub ach_del
2700 {
2701     my ($self) = @_;
2702     my $arg = $self->get_form('ach');
2703
2704     if (!$arg->{ach}
2705         or !$self->{info}->{ach_list}
2706         or !$self->{info}->{ach_list}->{$arg->{ach}})
2707     {
2708         return $self->error("Can't get autochanger name");
2709     }
2710
2711     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2712
2713     $self->{info}->save();
2714     $self->{info}->view();
2715 }
2716
2717 sub ach_add
2718 {
2719     my ($self) = @_;
2720     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2721
2722     my $b = $self->get_bconsole();
2723     my @storages = $b->list_storage() ;
2724
2725     unless ($arg->{ach}) {
2726         $arg->{devices} = [ map { { name => $_ } } @storages ];
2727         return $self->display($arg, "ach_add.tpl");
2728     }
2729
2730     my @drives ;
2731     foreach my $drive (CGI::param('drives'))
2732     {
2733         unless (grep(/^$drive$/,@storages)) {
2734             return $self->error("Can't find $drive in storage list");
2735         }
2736
2737         my $index = CGI::param("index_$drive");
2738         unless (defined $index and $index =~ /^(\d+)$/) {
2739             return $self->error("Can't get $drive index");
2740         }
2741
2742         $drives[$index] = $drive;
2743     }
2744
2745     unless (@drives) {
2746         return $self->error("Can't get drives from Autochanger");
2747     }
2748
2749     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2750                                   precmd => $arg->{precmd},
2751                                   drive_name => \@drives,
2752                                   device => $arg->{device},
2753                                   mtxcmd => $arg->{mtxcmd});
2754
2755     $self->ach_register($a) ;
2756
2757     $self->{info}->view();
2758 }
2759
2760 sub delete
2761 {
2762     my ($self) = @_;
2763     my $arg = $self->get_form('jobid');
2764
2765     if ($arg->{jobid}) {
2766         my $b = $self->get_bconsole();
2767         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2768
2769         $self->display({
2770             content => $ret,
2771             title => "Delete a job ",
2772             name => "delete jobid=$arg->{jobid}",
2773         }, "command.tpl");
2774     }
2775 }
2776
2777 sub do_update_media
2778 {
2779     my ($self) = @_ ;
2780
2781     my $arg = $self->get_form(qw/media volstatus inchanger pool
2782                                  slot volretention voluseduration
2783                                  maxvoljobs maxvolfiles maxvolbytes
2784                               /);
2785
2786     unless ($arg->{media}) {
2787         return $self->error("Can't find media selection");
2788     }
2789
2790     my $update = "update volume=$arg->{media} ";
2791
2792     if ($arg->{volstatus}) {
2793         $update .= " volstatus=$arg->{volstatus} ";
2794     }
2795
2796     if ($arg->{inchanger}) {
2797         $update .= " inchanger=yes " ;
2798         if ($arg->{slot}) {
2799             $update .= " slot=$arg->{slot} ";
2800         }
2801     } else {
2802         $update .= " slot=0 inchanger=no ";
2803     }
2804
2805     if ($arg->{pool}) {
2806         $update .= " pool=$arg->{pool} " ;
2807     }
2808
2809     $arg->{volretention} ||= 0 ;
2810     if ($arg->{volretention}) {
2811         $update .= " volretention=\"$arg->{volretention}\" " ;
2812     }
2813
2814     $arg->{voluseduration} ||= 0 ;
2815     if ($arg->{voluseduration}) {
2816         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2817     }
2818
2819     $arg->{maxvoljobs} ||= 0;
2820     if ($arg->{maxvoljobs}) {
2821         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2822     }
2823
2824     $arg->{maxvolfiles} ||= 0;
2825     if ($arg->{maxvolfiles}) {
2826         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2827     }
2828
2829     $arg->{maxvolbytes} ||= 0;
2830     if ($arg->{maxvolbytes}) {
2831         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2832     }
2833
2834     my $b = $self->get_bconsole();
2835
2836     $self->display({
2837         content => $b->send_cmd($update),
2838         title => "Update a volume ",
2839         name => $update,
2840     }, "command.tpl");
2841
2842
2843     my $loc = CGI::param('location') || '';
2844     if ($loc) {
2845         my $media = $self->dbh_quote($arg->{media});
2846         $loc = $self->dbh_quote($loc); # is checked by db
2847         my $query = "
2848 UPDATE Media
2849    SET LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)
2850  WHERE Media.VolumeName = $media
2851 ";
2852         $self->dbh_do($query);
2853     }
2854
2855     $self->update_media();
2856 }
2857
2858 sub update_slots
2859 {
2860     my ($self) = @_;
2861
2862     my $ach = CGI::param('ach') ;
2863     $ach = $self->ach_get($ach);
2864     unless ($ach) {
2865         return $self->error("Bad autochanger name");
2866     }
2867
2868     print "<pre>";
2869     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2870     $b->update_slots($ach->{name});
2871     print "</pre>\n"
2872 }
2873
2874 sub get_job_log
2875 {
2876     my ($self) = @_;
2877
2878     my $arg = $self->get_form('jobid');
2879     unless ($arg->{jobid}) {
2880         return $self->error("Can't get jobid");
2881     }
2882
2883     my $t = CGI::param('time') || '';
2884
2885     my $query = "
2886 SELECT Job.Name as name, Client.Name as clientname
2887  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2888  WHERE JobId = $arg->{jobid}
2889 ";
2890
2891     my $row = $self->dbh_selectrow_hashref($query);
2892
2893     unless ($row) {
2894         return $self->error("Can't find $arg->{jobid} in catalog");
2895     }
2896
2897     $query = "
2898 SELECT Time AS time, LogText AS log
2899  FROM  Log
2900  WHERE JobId = $arg->{jobid}
2901  ORDER BY Time
2902 ";
2903     my $log = $self->dbh_selectall_arrayref($query);
2904     unless ($log) {
2905         return $self->error("Can't get log for jobid $arg->{jobid}");
2906     }
2907
2908     my $logtxt;
2909     if ($t) {
2910         # log contains \n
2911         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2912     } else {
2913         $logtxt = join("", map { $_->[1] } @$log ) ;
2914     }
2915
2916     $self->display({ lines=> $logtxt,
2917                      jobid => $arg->{jobid},
2918                      name  => $row->{name},
2919                      client => $row->{clientname},
2920                  }, 'display_log.tpl');
2921 }
2922
2923
2924 sub label_barcodes
2925 {
2926     my ($self) = @_ ;
2927
2928     my $arg = $self->get_form('ach', 'slots', 'drive');
2929
2930     unless ($arg->{ach}) {
2931         return $self->error("Can't find autochanger name");
2932     }
2933
2934     my $slots = '';
2935     my $t = 300 ;
2936     if ($arg->{slots}) {
2937         $slots = join(",", @{ $arg->{slots} });
2938         $t += 60*scalar( @{ $arg->{slots} }) ;
2939     }
2940
2941     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2942     print "<h1>This command can take long time, be patient...</h1>";
2943     print "<pre>" ;
2944     $b->label_barcodes(storage => $arg->{ach},
2945                        drive => $arg->{drive},
2946                        pool  => 'Scratch',
2947                        slots => $slots) ;
2948     $b->close();
2949     print "</pre>";
2950 }
2951
2952 sub purge
2953 {
2954     my ($self) = @_;
2955
2956     my @volume = CGI::param('media');
2957
2958     unless (@volume) {
2959         return $self->error("Can't get media selection");
2960     }
2961
2962     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2963
2964     $self->display({
2965         content => $b->purge_volume(@volume),
2966         title => "Purge media",
2967         name => "purge volume=" . join(' volume=', @volume),
2968     }, "command.tpl");
2969     $b->close();
2970 }
2971
2972 sub prune
2973 {
2974     my ($self) = @_;
2975
2976     my @volume = CGI::param('media');
2977     unless (@volume) {
2978         return $self->error("Can't get media selection");
2979     }
2980
2981     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2982
2983     $self->display({
2984         content => $b->prune_volume(@volume),
2985         title => "Prune media",
2986         name => "prune volume=" . join(' volume=', @volume),
2987     }, "command.tpl");
2988
2989     $b->close();
2990 }
2991
2992 sub cancel_job
2993 {
2994     my ($self) = @_;
2995
2996     my $arg = $self->get_form('jobid');
2997     unless ($arg->{jobid}) {
2998         return $self->error("Can't get jobid");
2999     }
3000
3001     my $b = $self->get_bconsole();
3002     $self->display({
3003         content => $b->cancel($arg->{jobid}),
3004         title => "Cancel job",
3005         name => "cancel jobid=$arg->{jobid}",
3006     }, "command.tpl");
3007 }
3008
3009 sub fileset_view
3010 {
3011     # Warning, we display current fileset
3012     my ($self) = @_;
3013
3014     my $arg = $self->get_form('fileset');
3015
3016     if ($arg->{fileset}) {
3017         my $b = $self->get_bconsole();
3018         my $ret = $b->get_fileset($arg->{fileset});
3019         $self->display({ fileset => $arg->{fileset},
3020                          %$ret,
3021                      }, "fileset_view.tpl");
3022     } else {
3023         $self->error("Can't get fileset name");
3024     }
3025 }
3026
3027 sub director_show_sched
3028 {
3029     my ($self) = @_ ;
3030
3031     my $arg = $self->get_form('days');
3032
3033     my $b = $self->get_bconsole();
3034     my $ret = $b->director_get_sched( $arg->{days} );
3035
3036     $self->display({
3037         id => $cur_id++,
3038         list => $ret,
3039     }, "scheduled_job.tpl");
3040 }
3041
3042 sub enable_disable_job
3043 {
3044     my ($self, $what) = @_ ;
3045
3046     my $name = CGI::param('job') || '';
3047     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3048         return $self->error("Can't find job name");
3049     }
3050
3051     my $b = $self->get_bconsole();
3052
3053     my $cmd;
3054     if ($what) {
3055         $cmd = "enable";
3056     } else {
3057         $cmd = "disable";
3058     }
3059
3060     $self->display({
3061         content => $b->send_cmd("$cmd job=\"$name\""),
3062         title => "$cmd $name",
3063         name => "$cmd job=\"$name\"",
3064     }, "command.tpl");
3065 }
3066
3067 sub get_bconsole
3068 {
3069     my ($self) = @_;
3070     return new Bconsole(pref => $self->{info});
3071 }
3072
3073 sub run_job_select
3074 {
3075     my ($self) = @_;
3076     my $b = $self->get_bconsole();
3077
3078     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3079
3080     $self->display({ Jobs => $joblist }, "run_job.tpl");
3081 }
3082
3083 sub run_parse_job
3084 {
3085     my ($self, $ouput) = @_;
3086
3087     my %arg;
3088     foreach my $l (split(/\r\n/, $ouput)) {
3089         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3090             $arg{$1} = $2;
3091             $l = $3
3092                 if ($3) ;
3093         }
3094
3095         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3096             %arg = (%arg, @l);
3097         }
3098     }
3099
3100     my %lowcase ;
3101     foreach my $k (keys %arg) {
3102         $lowcase{lc($k)} = $arg{$k} ;
3103     }
3104
3105     return \%lowcase;
3106 }
3107
3108 sub run_job_mod
3109 {
3110     my ($self) = @_;
3111     my $b = $self->get_bconsole();
3112
3113     my $job = CGI::param('job') || '';
3114
3115     my $info = $b->send_cmd("show job=\"$job\"");
3116     my $attr = $self->run_parse_job($info);
3117
3118     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3119
3120     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3121     my $clients = [ map { { name => $_ } }$b->list_client()];
3122     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3123     my $storages= [ map { { name => $_ } }$b->list_storage()];
3124
3125     $self->display({
3126         jobs     => $jobs,
3127         pools    => $pools,
3128         clients  => $clients,
3129         filesets => $filesets,
3130         storages => $storages,
3131         %$attr,
3132     }, "run_job_mod.tpl");
3133 }
3134
3135 sub run_job
3136 {
3137     my ($self) = @_;
3138     my $b = $self->get_bconsole();
3139
3140     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3141
3142     $self->display({
3143         jobs     => $jobs,
3144     }, "run_job.tpl");
3145 }
3146
3147 sub run_job_now
3148 {
3149     my ($self) = @_;
3150     my $b = $self->get_bconsole();
3151
3152     # TODO: check input (don't use pool, level)
3153
3154     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3155     my $job = CGI::param('job') || '';
3156     my $storage = CGI::param('storage') || '';
3157
3158     my $jobid = $b->run(job => $job,
3159                         client => $arg->{client},
3160                         priority => $arg->{priority},
3161                         level => $arg->{level},
3162                         storage => $storage,
3163                         pool => $arg->{pool},
3164                         );
3165
3166     print $jobid, $b->{error};
3167
3168     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3169 }
3170
3171 1;