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

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