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

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