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