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