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

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