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                 JobErrors       AS joberrors,
1936                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1937                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1938
1939  FROM Client,
1940       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1941           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1942  WHERE Client.ClientId=Job.ClientId
1943  AND Job.JobId = $jobid
1944 ";
1945
1946     my $row = $self->dbh_selectrow_hashref($query) ;
1947
1948     # display all volumes associate with this job
1949     $query="
1950 SELECT Media.VolumeName as volumename
1951 FROM Job,Media,JobMedia
1952 WHERE Job.JobId = $jobid
1953  AND JobMedia.JobId=Job.JobId
1954  AND JobMedia.MediaId=Media.MediaId
1955 ";
1956
1957     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1958
1959     $row->{volumes} = [ values %$all ] ;
1960
1961     $self->display($row, "display_job_zoom.tpl");
1962 }
1963
1964 sub display_media
1965 {
1966     my ($self) = @_ ;
1967
1968     my ($where, %elt) = $self->get_param('pool',
1969                                          'location');
1970
1971     my $arg = $self->get_form('jmedias', 'qre_media');
1972
1973     if ($arg->{jmedias}) {
1974         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1975     }
1976     if ($arg->{qre_media}) {
1977         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1978     }
1979
1980     my $query="
1981 SELECT Media.VolumeName  AS volumename,
1982        Media.VolBytes    AS volbytes,
1983        Media.VolStatus   AS volstatus,
1984        Media.MediaType   AS mediatype,
1985        Media.InChanger   AS online,
1986        Media.LastWritten AS lastwritten,
1987        Location.Location AS location,
1988        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
1989        Pool.Name         AS poolname,
1990        $self->{sql}->{FROM_UNIXTIME}(
1991           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1992         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1993        ) AS expire
1994 FROM      Pool, Media
1995 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1996 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1997                   Media.MediaType     AS MediaType
1998            FROM Media
1999           WHERE Media.VolStatus = 'Full'
2000           GROUP BY Media.MediaType
2001            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2002
2003 WHERE Media.PoolId=Pool.PoolId
2004 $where
2005 ";
2006
2007     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2008
2009     $self->display({ ID => $cur_id++,
2010                      Pool => $elt{pool},
2011                      Location => $elt{location},
2012                      Medias => [ values %$all ]
2013                    },
2014                    "display_media.tpl");
2015 }
2016
2017 sub display_medias
2018 {
2019     my ($self) = @_ ;
2020
2021     my $pool = $self->get_form('db_pools');
2022
2023     foreach my $name (@{ $pool->{db_pools} }) {
2024         CGI::param('pool', $name->{name});
2025         $self->display_media();
2026     }
2027 }
2028
2029 sub display_media_zoom
2030 {
2031     my ($self) = @_ ;
2032
2033     my $medias = $self->get_form('jmedias');
2034
2035     unless ($medias->{jmedias}) {
2036         return $self->error("Can't get media selection");
2037     }
2038
2039     my $query="
2040 SELECT InChanger     AS online,
2041        VolBytes      AS nb_bytes,
2042        VolumeName    AS volumename,
2043        VolStatus     AS volstatus,
2044        VolMounts     AS nb_mounts,
2045        Media.VolUseDuration   AS voluseduration,
2046        Media.MaxVolJobs AS maxvoljobs,
2047        Media.MaxVolFiles AS maxvolfiles,
2048        Media.MaxVolBytes AS maxvolbytes,
2049        VolErrors     AS nb_errors,
2050        Pool.Name     AS poolname,
2051        Location.Location AS location,
2052        Media.Recycle AS recycle,
2053        Media.VolRetention AS volretention,
2054        Media.LastWritten  AS lastwritten,
2055        Media.VolReadTime/1000000  AS volreadtime,
2056        Media.VolWriteTime/1000000 AS volwritetime,
2057        $self->{sql}->{FROM_UNIXTIME}(
2058           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2059         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2060        ) AS expire
2061  FROM Pool,
2062       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2063  WHERE Pool.PoolId = Media.PoolId
2064  AND VolumeName IN ($medias->{jmedias})
2065 ";
2066
2067     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2068
2069     foreach my $media (values %$all) {
2070         my $mq = $self->dbh_quote($media->{volumename});
2071
2072         $query = "
2073 SELECT DISTINCT Job.JobId AS jobid,
2074                 Job.Name  AS name,
2075                 Job.StartTime AS starttime,
2076                 Job.Type  AS type,
2077                 Job.Level AS level,
2078                 Job.JobFiles AS files,
2079                 Job.JobBytes AS bytes,
2080                 Job.jobstatus AS status
2081  FROM Media,JobMedia,Job
2082  WHERE Media.VolumeName=$mq
2083  AND Media.MediaId=JobMedia.MediaId
2084  AND JobMedia.JobId=Job.JobId
2085 ";
2086
2087         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2088
2089         $query = "
2090 SELECT LocationLog.Date    AS date,
2091        Location.Location   AS location,
2092        LocationLog.Comment AS comment
2093  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2094  WHERE Media.MediaId = LocationLog.MediaId
2095    AND Media.VolumeName = $mq
2096 ";
2097
2098         my $logtxt = '';
2099         my $log = $self->dbh_selectall_arrayref($query) ;
2100         if ($log) {
2101             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2102         }
2103
2104         $self->display({ jobs => [ values %$jobs ],
2105                          LocationLog => $logtxt,
2106                          %$media },
2107                        "display_media_zoom.tpl");
2108     }
2109 }
2110
2111 sub location_edit
2112 {
2113     my ($self) = @_ ;
2114
2115     my $loc = $self->get_form('qlocation');
2116     unless ($loc->{qlocation}) {
2117         return $self->error("Can't get location");
2118     }
2119
2120     my $query = "
2121 SELECT Location.Location AS location,
2122        Location.Cost   AS cost,
2123        Location.Enabled AS enabled
2124 FROM Location
2125 WHERE Location.Location = $loc->{qlocation}
2126 ";
2127
2128     my $row = $self->dbh_selectrow_hashref($query);
2129
2130     $self->display({ ID => $cur_id++,
2131                      %$row }, "location_edit.tpl") ;
2132
2133 }
2134
2135 sub location_save
2136 {
2137     my ($self) = @_ ;
2138
2139     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2140     unless ($arg->{qlocation}) {
2141         return $self->error("Can't get location");
2142     }
2143     unless ($arg->{qnewlocation}) {
2144         return $self->error("Can't get new location name");
2145     }
2146     unless ($arg->{cost}) {
2147         return $self->error("Can't get new cost");
2148     }
2149
2150     my $enabled = CGI::param('enabled') || '';
2151     $enabled = $enabled?1:0;
2152
2153     my $query = "
2154 UPDATE Location SET Cost     = $arg->{cost},
2155                     Location = $arg->{qnewlocation},
2156                     Enabled   = $enabled
2157 WHERE Location.Location = $arg->{qlocation}
2158 ";
2159
2160     $self->dbh_do($query);
2161
2162     $self->display_location();
2163 }
2164
2165 sub location_del
2166 {
2167     my ($self) = @_ ;
2168     my $arg = $self->get_form(qw/qlocation/) ;
2169
2170     unless ($arg->{qlocation}) {
2171         return $self->error("Can't get location");
2172     }
2173
2174     my $query = "
2175 SELECT count(Media.MediaId) AS nb
2176   FROM Media INNER JOIN Location USING (LocationID)
2177 WHERE Location = $arg->{qlocation}
2178 ";
2179
2180     my $res = $self->dbh_selectrow_hashref($query);
2181
2182     if ($res->{nb}) {
2183         return $self->error("Sorry, the location must be empty");
2184     }
2185
2186     $query = "
2187 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2188 ";
2189
2190     $self->dbh_do($query);
2191
2192     $self->display_location();
2193 }
2194
2195
2196 sub location_add
2197 {
2198     my ($self) = @_ ;
2199     my $arg = $self->get_form(qw/qlocation cost/) ;
2200
2201     unless ($arg->{qlocation}) {
2202         $self->display({}, "location_add.tpl");
2203         return 1;
2204     }
2205     unless ($arg->{cost}) {
2206         return $self->error("Can't get new cost");
2207     }
2208
2209     my $enabled = CGI::param('enabled') || '';
2210     $enabled = $enabled?1:0;
2211
2212     my $query = "
2213 INSERT INTO Location (Location, Cost, Enabled)
2214        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2215 ";
2216
2217     $self->dbh_do($query);
2218
2219     $self->display_location();
2220 }
2221
2222 sub display_location
2223 {
2224     my ($self) = @_ ;
2225
2226     my $query = "
2227 SELECT Location.Location AS location,
2228        Location.Cost     AS cost,
2229        Location.Enabled  AS enabled,
2230        (SELECT count(Media.MediaId)
2231          FROM Media
2232         WHERE Media.LocationId = Location.LocationId
2233        ) AS volnum
2234 FROM Location
2235 ";
2236
2237     my $location = $self->dbh_selectall_hashref($query, 'location');
2238
2239     $self->display({ ID => $cur_id++,
2240                      Locations => [ values %$location ] },
2241                    "display_location.tpl");
2242 }
2243
2244 sub update_location
2245 {
2246     my ($self) = @_ ;
2247
2248     my $medias = $self->get_selected_media_location();
2249     unless ($medias) {
2250         return ;
2251     }
2252
2253     my $arg = $self->get_form('db_locations', 'qnewlocation');
2254
2255     $self->display({ email  => $self->{info}->{email_media},
2256                      %$arg,
2257                      medias => [ values %$medias ],
2258                    },
2259                    "update_location.tpl");
2260 }
2261
2262 sub get_media_max_size
2263 {
2264     my ($self, $type) = @_;
2265     my $query =
2266 "SELECT avg(VolBytes) AS size
2267   FROM Media
2268  WHERE Media.VolStatus = 'Full'
2269    AND Media.MediaType = '$type'
2270 ";
2271
2272     my $res = $self->selectrow_hashref($query);
2273
2274     if ($res) {
2275         return $res->{size};
2276     } else {
2277         return 0;
2278     }
2279 }
2280
2281 sub update_media
2282 {
2283     my ($self) = @_ ;
2284
2285     my $media = $self->get_form('qmedia');
2286
2287     unless ($media->{qmedia}) {
2288         return $self->error("Can't get media");
2289     }
2290
2291     my $query = "
2292 SELECT Media.Slot         AS slot,
2293        Pool.Name          AS poolname,
2294        Media.VolStatus    AS volstatus,
2295        Media.InChanger    AS inchanger,
2296        Location.Location  AS location,
2297        Media.VolumeName   AS volumename,
2298        Media.MaxVolBytes  AS maxvolbytes,
2299        Media.MaxVolJobs   AS maxvoljobs,
2300        Media.MaxVolFiles  AS maxvolfiles,
2301        Media.VolUseDuration AS voluseduration,
2302        Media.VolRetention AS volretention
2303
2304 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2305            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2306
2307 WHERE Media.VolumeName = $media->{qmedia}
2308 ";
2309
2310     my $row = $self->dbh_selectrow_hashref($query);
2311     $row->{volretention} = human_sec($row->{volretention});
2312     $row->{voluseduration} = human_sec($row->{voluseduration});
2313
2314     my $elt = $self->get_form(qw/db_pools db_locations/);
2315
2316     $self->display({
2317         %$elt,
2318         %$row,
2319     }, "update_media.tpl");
2320 }
2321
2322 sub save_location
2323 {
2324     my ($self) = @_ ;
2325
2326     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2327
2328     unless ($arg->{jmedias}) {
2329         return $self->error("Can't get selected media");
2330     }
2331
2332     unless ($arg->{qnewlocation}) {
2333         return $self->error("Can't get new location");
2334     }
2335
2336     my $query = "
2337  UPDATE Media
2338      SET LocationId = (SELECT LocationId
2339                        FROM Location
2340                        WHERE Location = $arg->{qnewlocation})
2341      WHERE Media.VolumeName IN ($arg->{jmedias})
2342 ";
2343
2344     my $nb = $self->dbh_do($query);
2345
2346     print "$nb media updated, you may have to update your autochanger.";
2347
2348     $self->display_media();
2349 }
2350
2351 sub change_location
2352 {
2353     my ($self) = @_ ;
2354
2355     my $medias = $self->get_selected_media_location();
2356     unless ($medias) {
2357         return $self->error("Can't get media selection");
2358     }
2359     my $newloc = CGI::param('newlocation');
2360
2361     my $user = CGI::param('user') || 'unknow';
2362     my $comm = CGI::param('comment') || '';
2363     $comm = $self->dbh_quote("$user: $comm");
2364
2365     my $query;
2366
2367     foreach my $media (keys %$medias) {
2368         $query = "
2369 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2370  VALUES(
2371        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2372        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2373        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2374       )
2375 ";
2376         $self->dbh_do($query);
2377         $self->debug($query);
2378     }
2379
2380     my $q = new CGI;
2381     $q->param('action', 'update_location');
2382     my $url = $q->url(-full => 1, -query=>1);
2383
2384     $self->display({ email  => $self->{info}->{email_media},
2385                      url => $url,
2386                      newlocation => $newloc,
2387                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2388                      medias => [ values %$medias ],
2389                    },
2390                    "change_location.tpl");
2391
2392 }
2393
2394 sub display_client_stats
2395 {
2396     my ($self, %arg) = @_ ;
2397
2398     my $client = $self->dbh_quote($arg{clientname});
2399     my ($limit, $label) = $self->get_limit(%arg);
2400
2401     my $query = "
2402 SELECT
2403     count(Job.JobId)     AS nb_jobs,
2404     sum(Job.JobBytes)    AS nb_bytes,
2405     sum(Job.JobErrors)   AS nb_err,
2406     sum(Job.JobFiles)    AS nb_files,
2407     Client.Name          AS clientname
2408 FROM Job INNER JOIN Client USING (ClientId)
2409 WHERE
2410     Client.Name = $client
2411     $limit
2412 GROUP BY Client.Name
2413 ";
2414
2415     my $row = $self->dbh_selectrow_hashref($query);
2416
2417     $row->{ID} = $cur_id++;
2418     $row->{label} = $label;
2419
2420     $self->display($row, "display_client_stats.tpl");
2421 }
2422
2423 # poolname can be undef
2424 sub display_pool
2425 {
2426     my ($self, $poolname) = @_ ;
2427
2428 # TODO : afficher les tailles et les dates
2429
2430     my $query = "
2431 SELECT subq.volmax        AS volmax,
2432        subq.volnum        AS volnum,
2433        subq.voltotal      AS voltotal,
2434        Pool.Name          AS name,
2435        Pool.Recycle       AS recycle,
2436        Pool.VolRetention  AS volretention,
2437        Pool.VolUseDuration AS voluseduration,
2438        Pool.MaxVolJobs    AS maxvoljobs,
2439        Pool.MaxVolFiles   AS maxvolfiles,
2440        Pool.MaxVolBytes   AS maxvolbytes,
2441        subq.PoolId        AS PoolId
2442 FROM
2443   (
2444     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2445            count(Media.MediaId)  AS volnum,
2446            sum(Media.VolBytes)   AS voltotal,
2447            Media.PoolId          AS PoolId,
2448            Media.MediaType       AS MediaType
2449     FROM Media
2450     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2451                       Media.MediaType     AS MediaType
2452                FROM Media
2453               WHERE Media.VolStatus = 'Full'
2454               GROUP BY Media.MediaType
2455                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2456     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2457   ) AS subq
2458 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2459 ";
2460
2461     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2462
2463     $query = "
2464 SELECT Pool.Name AS name,
2465        sum(VolBytes) AS size
2466 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2467 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
2468 GROUP BY Pool.Name;
2469 ";
2470     my $empty = $self->dbh_selectall_hashref($query, 'name');
2471
2472     foreach my $p (values %$all) {
2473         if ($p->{volmax} > 0) { # mysql returns 0.0000
2474             # we remove Recycled/Purged media from pool usage
2475             if (defined $empty->{$p->{name}}) {
2476                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2477             }
2478             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2479         } else {
2480             $p->{poolusage} = 0;
2481         }
2482
2483         $query = "
2484   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2485     FROM Media
2486    WHERE PoolId=$p->{poolid}
2487 GROUP BY VolStatus
2488 ";
2489         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2490         foreach my $t (values %$content) {
2491             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2492         }
2493     }
2494
2495     $self->debug($all);
2496     $self->display({ ID => $cur_id++,
2497                      Pools => [ values %$all ]},
2498                    "display_pool.tpl");
2499 }
2500
2501 sub display_running_job
2502 {
2503     my ($self) = @_;
2504
2505     my $arg = $self->get_form('client', 'jobid');
2506
2507     if (!$arg->{client} and $arg->{jobid}) {
2508
2509         my $query = "
2510 SELECT Client.Name AS name
2511 FROM Job INNER JOIN Client USING (ClientId)
2512 WHERE Job.JobId = $arg->{jobid}
2513 ";
2514
2515         my $row = $self->dbh_selectrow_hashref($query);
2516
2517         if ($row) {
2518             $arg->{client} = $row->{name};
2519             CGI::param('client', $arg->{client});
2520         }
2521     }
2522
2523     if ($arg->{client}) {
2524         my $cli = new Bweb::Client(name => $arg->{client});
2525         $cli->display_running_job($self->{info}, $arg->{jobid});
2526         if ($arg->{jobid}) {
2527             $self->get_job_log();
2528         }
2529     } else {
2530         $self->error("Can't get client or jobid");
2531     }
2532 }
2533
2534 sub display_running_jobs
2535 {
2536     my ($self, $display_action) = @_;
2537
2538     my $query = "
2539 SELECT Job.JobId AS jobid,
2540        Job.Name  AS jobname,
2541        Job.Level     AS level,
2542        Job.StartTime AS starttime,
2543        Job.JobFiles  AS jobfiles,
2544        Job.JobBytes  AS jobbytes,
2545        Job.JobStatus AS jobstatus,
2546 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2547                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2548          AS duration,
2549        Client.Name AS clientname
2550 FROM Job INNER JOIN Client USING (ClientId)
2551 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2552 ";
2553     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2554
2555     $self->display({ ID => $cur_id++,
2556                      display_action => $display_action,
2557                      Jobs => [ values %$all ]},
2558                    "running_job.tpl") ;
2559 }
2560
2561 sub eject_media
2562 {
2563     my ($self) = @_;
2564     my $arg = $self->get_form('jmedias');
2565
2566     unless ($arg->{jmedias}) {
2567         return $self->error("Can't get media selection");
2568     }
2569
2570     my $query = "
2571 SELECT Media.VolumeName  AS volumename,
2572        Storage.Name      AS storage,
2573        Location.Location AS location,
2574        Media.Slot        AS slot
2575 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2576            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2577 WHERE Media.VolumeName IN ($arg->{jmedias})
2578   AND Media.InChanger = 1
2579 ";
2580
2581     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2582
2583     foreach my $vol (values %$all) {
2584         my $a = $self->ach_get($vol->{location});
2585         next unless ($a) ;
2586
2587         unless ($a->{have_status}) {
2588             $a->status();
2589             $a->{have_status} = 1;
2590         }
2591
2592         print "eject $vol->{volumename} from $vol->{storage} : ";
2593         if ($a->send_to_io($vol->{slot})) {
2594             print "ok</br>";
2595         } else {
2596             print "err</br>";
2597         }
2598     }
2599 }
2600
2601 sub move_email
2602 {
2603     my ($self) = @_;
2604
2605     my ($to, $subject, $content) = (CGI::param('email'),
2606                                     CGI::param('subject'),
2607                                     CGI::param('content'));
2608     $to =~ s/[^\w\d\.\@<>,]//;
2609     $subject =~ s/[^\w\d\.\[\]]/ /;
2610
2611     open(MAIL, "|mail -s '$subject' '$to'") ;
2612     print MAIL $content;
2613     close(MAIL);
2614
2615     print "Mail sent";
2616 }
2617
2618 sub restore
2619 {
2620     my ($self) = @_;
2621
2622     my $arg = $self->get_form('jobid', 'client');
2623
2624     print CGI::header('text/brestore');
2625     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2626     print "client=$arg->{client}\n" if ($arg->{client});
2627     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2628     print "\n";
2629 }
2630
2631 # TODO : move this to Bweb::Autochanger ?
2632 # TODO : make this internal to not eject tape ?
2633 use Bconsole;
2634
2635
2636 sub ach_get
2637 {
2638     my ($self, $name) = @_;
2639
2640     unless ($name) {
2641         return $self->error("Can't get your autochanger name ach");
2642     }
2643
2644     unless ($self->{info}->{ach_list}) {
2645         return $self->error("Could not find any autochanger");
2646     }
2647
2648     my $a = $self->{info}->{ach_list}->{$name};
2649
2650     unless ($a) {
2651         $self->error("Can't get your autochanger $name from your ach_list");
2652         return undef;
2653     }
2654
2655     $a->{bweb} = $self;
2656
2657     return $a;
2658 }
2659
2660 sub ach_register
2661 {
2662     my ($self, $ach) = @_;
2663
2664     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2665
2666     $self->{info}->save();
2667
2668     return 1;
2669 }
2670
2671 sub ach_edit
2672 {
2673     my ($self) = @_;
2674     my $arg = $self->get_form('ach');
2675     if (!$arg->{ach}
2676         or !$self->{info}->{ach_list}
2677         or !$self->{info}->{ach_list}->{$arg->{ach}})
2678     {
2679         return $self->error("Can't get autochanger name");
2680     }
2681
2682     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2683
2684     my $i=0;
2685     $ach->{drives} =
2686         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2687
2688     my $b = $self->get_bconsole();
2689
2690     my @storages = $b->list_storage() ;
2691
2692     $ach->{devices} = [ map { { name => $_ } } @storages ];
2693
2694     $self->display($ach, "ach_add.tpl");
2695     delete $ach->{drives};
2696     delete $ach->{devices};
2697     return 1;
2698 }
2699
2700 sub ach_del
2701 {
2702     my ($self) = @_;
2703     my $arg = $self->get_form('ach');
2704
2705     if (!$arg->{ach}
2706         or !$self->{info}->{ach_list}
2707         or !$self->{info}->{ach_list}->{$arg->{ach}})
2708     {
2709         return $self->error("Can't get autochanger name");
2710     }
2711
2712     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2713
2714     $self->{info}->save();
2715     $self->{info}->view();
2716 }
2717
2718 sub ach_add
2719 {
2720     my ($self) = @_;
2721     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2722
2723     my $b = $self->get_bconsole();
2724     my @storages = $b->list_storage() ;
2725
2726     unless ($arg->{ach}) {
2727         $arg->{devices} = [ map { { name => $_ } } @storages ];
2728         return $self->display($arg, "ach_add.tpl");
2729     }
2730
2731     my @drives ;
2732     foreach my $drive (CGI::param('drives'))
2733     {
2734         unless (grep(/^$drive$/,@storages)) {
2735             return $self->error("Can't find $drive in storage list");
2736         }
2737
2738         my $index = CGI::param("index_$drive");
2739         unless (defined $index and $index =~ /^(\d+)$/) {
2740             return $self->error("Can't get $drive index");
2741         }
2742
2743         $drives[$index] = $drive;
2744     }
2745
2746     unless (@drives) {
2747         return $self->error("Can't get drives from Autochanger");
2748     }
2749
2750     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2751                                   precmd => $arg->{precmd},
2752                                   drive_name => \@drives,
2753                                   device => $arg->{device},
2754                                   mtxcmd => $arg->{mtxcmd});
2755
2756     $self->ach_register($a) ;
2757
2758     $self->{info}->view();
2759 }
2760
2761 sub delete
2762 {
2763     my ($self) = @_;
2764     my $arg = $self->get_form('jobid');
2765
2766     if ($arg->{jobid}) {
2767         my $b = $self->get_bconsole();
2768         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2769
2770         $self->display({
2771             content => $ret,
2772             title => "Delete a job ",
2773             name => "delete jobid=$arg->{jobid}",
2774         }, "command.tpl");
2775     }
2776 }
2777
2778 sub do_update_media
2779 {
2780     my ($self) = @_ ;
2781
2782     my $arg = $self->get_form(qw/media volstatus inchanger pool
2783                                  slot volretention voluseduration
2784                                  maxvoljobs maxvolfiles maxvolbytes
2785                               /);
2786
2787     unless ($arg->{media}) {
2788         return $self->error("Can't find media selection");
2789     }
2790
2791     my $update = "update volume=$arg->{media} ";
2792
2793     if ($arg->{volstatus}) {
2794         $update .= " volstatus=$arg->{volstatus} ";
2795     }
2796
2797     if ($arg->{inchanger}) {
2798         $update .= " inchanger=yes " ;
2799         if ($arg->{slot}) {
2800             $update .= " slot=$arg->{slot} ";
2801         }
2802     } else {
2803         $update .= " slot=0 inchanger=no ";
2804     }
2805
2806     if ($arg->{pool}) {
2807         $update .= " pool=$arg->{pool} " ;
2808     }
2809
2810     $arg->{volretention} ||= 0 ;
2811     if ($arg->{volretention}) {
2812         $update .= " volretention=\"$arg->{volretention}\" " ;
2813     }
2814
2815     $arg->{voluseduration} ||= 0 ;
2816     if ($arg->{voluseduration}) {
2817         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2818     }
2819
2820     $arg->{maxvoljobs} ||= 0;
2821     if ($arg->{maxvoljobs}) {
2822         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2823     }
2824
2825     $arg->{maxvolfiles} ||= 0;
2826     if ($arg->{maxvolfiles}) {
2827         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2828     }
2829
2830     $arg->{maxvolbytes} ||= 0;
2831     if ($arg->{maxvolbytes}) {
2832         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2833     }
2834
2835     my $b = $self->get_bconsole();
2836
2837     $self->display({
2838         content => $b->send_cmd($update),
2839         title => "Update a volume ",
2840         name => $update,
2841     }, "command.tpl");
2842
2843
2844     my $loc = CGI::param('location') || '';
2845     if ($loc) {
2846         my $media = $self->dbh_quote($arg->{media});
2847         $loc = $self->dbh_quote($loc); # is checked by db
2848         my $query = "
2849 UPDATE Media
2850    SET LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)
2851  WHERE Media.VolumeName = $media
2852 ";
2853         $self->dbh_do($query);
2854     }
2855
2856     $self->update_media();
2857 }
2858
2859 sub update_slots
2860 {
2861     my ($self) = @_;
2862
2863     my $ach = CGI::param('ach') ;
2864     $ach = $self->ach_get($ach);
2865     unless ($ach) {
2866         return $self->error("Bad autochanger name");
2867     }
2868
2869     print "<pre>";
2870     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2871     $b->update_slots($ach->{name});
2872     print "</pre>\n"
2873 }
2874
2875 sub get_job_log
2876 {
2877     my ($self) = @_;
2878
2879     my $arg = $self->get_form('jobid');
2880     unless ($arg->{jobid}) {
2881         return $self->error("Can't get jobid");
2882     }
2883
2884     my $t = CGI::param('time') || '';
2885
2886     my $query = "
2887 SELECT Job.Name as name, Client.Name as clientname
2888  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2889  WHERE JobId = $arg->{jobid}
2890 ";
2891
2892     my $row = $self->dbh_selectrow_hashref($query);
2893
2894     unless ($row) {
2895         return $self->error("Can't find $arg->{jobid} in catalog");
2896     }
2897
2898     $query = "
2899 SELECT Time AS time, LogText AS log
2900  FROM  Log
2901  WHERE JobId = $arg->{jobid}
2902  ORDER BY Time
2903 ";
2904     my $log = $self->dbh_selectall_arrayref($query);
2905     unless ($log) {
2906         return $self->error("Can't get log for jobid $arg->{jobid}");
2907     }
2908
2909     my $logtxt;
2910     if ($t) {
2911         # log contains \n
2912         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2913     } else {
2914         $logtxt = join("", map { $_->[1] } @$log ) ;
2915     }
2916
2917     $self->display({ lines=> $logtxt,
2918                      jobid => $arg->{jobid},
2919                      name  => $row->{name},
2920                      client => $row->{clientname},
2921                  }, 'display_log.tpl');
2922 }
2923
2924
2925 sub label_barcodes
2926 {
2927     my ($self) = @_ ;
2928
2929     my $arg = $self->get_form('ach', 'slots', 'drive');
2930
2931     unless ($arg->{ach}) {
2932         return $self->error("Can't find autochanger name");
2933     }
2934
2935     my $slots = '';
2936     my $t = 300 ;
2937     if ($arg->{slots}) {
2938         $slots = join(",", @{ $arg->{slots} });
2939         $t += 60*scalar( @{ $arg->{slots} }) ;
2940     }
2941
2942     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2943     print "<h1>This command can take long time, be patient...</h1>";
2944     print "<pre>" ;
2945     $b->label_barcodes(storage => $arg->{ach},
2946                        drive => $arg->{drive},
2947                        pool  => 'Scratch',
2948                        slots => $slots) ;
2949     $b->close();
2950     print "</pre>";
2951 }
2952
2953 sub purge
2954 {
2955     my ($self) = @_;
2956
2957     my @volume = CGI::param('media');
2958
2959     unless (@volume) {
2960         return $self->error("Can't get media selection");
2961     }
2962
2963     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2964
2965     $self->display({
2966         content => $b->purge_volume(@volume),
2967         title => "Purge media",
2968         name => "purge volume=" . join(' volume=', @volume),
2969     }, "command.tpl");
2970     $b->close();
2971 }
2972
2973 sub prune
2974 {
2975     my ($self) = @_;
2976
2977     my @volume = CGI::param('media');
2978     unless (@volume) {
2979         return $self->error("Can't get media selection");
2980     }
2981
2982     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2983
2984     $self->display({
2985         content => $b->prune_volume(@volume),
2986         title => "Prune media",
2987         name => "prune volume=" . join(' volume=', @volume),
2988     }, "command.tpl");
2989
2990     $b->close();
2991 }
2992
2993 sub cancel_job
2994 {
2995     my ($self) = @_;
2996
2997     my $arg = $self->get_form('jobid');
2998     unless ($arg->{jobid}) {
2999         return $self->error("Can't get jobid");
3000     }
3001
3002     my $b = $self->get_bconsole();
3003     $self->display({
3004         content => $b->cancel($arg->{jobid}),
3005         title => "Cancel job",
3006         name => "cancel jobid=$arg->{jobid}",
3007     }, "command.tpl");
3008 }
3009
3010 sub fileset_view
3011 {
3012     # Warning, we display current fileset
3013     my ($self) = @_;
3014
3015     my $arg = $self->get_form('fileset');
3016
3017     if ($arg->{fileset}) {
3018         my $b = $self->get_bconsole();
3019         my $ret = $b->get_fileset($arg->{fileset});
3020         $self->display({ fileset => $arg->{fileset},
3021                          %$ret,
3022                      }, "fileset_view.tpl");
3023     } else {
3024         $self->error("Can't get fileset name");
3025     }
3026 }
3027
3028 sub director_show_sched
3029 {
3030     my ($self) = @_ ;
3031
3032     my $arg = $self->get_form('days');
3033
3034     my $b = $self->get_bconsole();
3035     my $ret = $b->director_get_sched( $arg->{days} );
3036
3037     $self->display({
3038         id => $cur_id++,
3039         list => $ret,
3040     }, "scheduled_job.tpl");
3041 }
3042
3043 sub enable_disable_job
3044 {
3045     my ($self, $what) = @_ ;
3046
3047     my $name = CGI::param('job') || '';
3048     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3049         return $self->error("Can't find job name");
3050     }
3051
3052     my $b = $self->get_bconsole();
3053
3054     my $cmd;
3055     if ($what) {
3056         $cmd = "enable";
3057     } else {
3058         $cmd = "disable";
3059     }
3060
3061     $self->display({
3062         content => $b->send_cmd("$cmd job=\"$name\""),
3063         title => "$cmd $name",
3064         name => "$cmd job=\"$name\"",
3065     }, "command.tpl");
3066 }
3067
3068 sub get_bconsole
3069 {
3070     my ($self) = @_;
3071     return new Bconsole(pref => $self->{info});
3072 }
3073
3074 sub run_job_select
3075 {
3076     my ($self) = @_;
3077     my $b = $self->get_bconsole();
3078
3079     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3080
3081     $self->display({ Jobs => $joblist }, "run_job.tpl");
3082 }
3083
3084 sub run_parse_job
3085 {
3086     my ($self, $ouput) = @_;
3087
3088     my %arg;
3089     foreach my $l (split(/\r\n/, $ouput)) {
3090         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3091             $arg{$1} = $2;
3092             $l = $3
3093                 if ($3) ;
3094         }
3095
3096         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3097             %arg = (%arg, @l);
3098         }
3099     }
3100
3101     my %lowcase ;
3102     foreach my $k (keys %arg) {
3103         $lowcase{lc($k)} = $arg{$k} ;
3104     }
3105
3106     return \%lowcase;
3107 }
3108
3109 sub run_job_mod
3110 {
3111     my ($self) = @_;
3112     my $b = $self->get_bconsole();
3113
3114     my $job = CGI::param('job') || '';
3115
3116     my $info = $b->send_cmd("show job=\"$job\"");
3117     my $attr = $self->run_parse_job($info);
3118
3119     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3120
3121     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3122     my $clients = [ map { { name => $_ } }$b->list_client()];
3123     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3124     my $storages= [ map { { name => $_ } }$b->list_storage()];
3125
3126     $self->display({
3127         jobs     => $jobs,
3128         pools    => $pools,
3129         clients  => $clients,
3130         filesets => $filesets,
3131         storages => $storages,
3132         %$attr,
3133     }, "run_job_mod.tpl");
3134 }
3135
3136 sub run_job
3137 {
3138     my ($self) = @_;
3139     my $b = $self->get_bconsole();
3140
3141     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3142
3143     $self->display({
3144         jobs     => $jobs,
3145     }, "run_job.tpl");
3146 }
3147
3148 sub run_job_now
3149 {
3150     my ($self) = @_;
3151     my $b = $self->get_bconsole();
3152
3153     # TODO: check input (don't use pool, level)
3154
3155     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3156     my $job = CGI::param('job') || '';
3157     my $storage = CGI::param('storage') || '';
3158
3159     my $jobid = $b->run(job => $job,
3160                         client => $arg->{client},
3161                         priority => $arg->{priority},
3162                         level => $arg->{level},
3163                         storage => $storage,
3164                         pool => $arg->{pool},
3165                         );
3166
3167     print $jobid, $b->{error};
3168
3169     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3170 }
3171
3172 1;