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