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