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

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