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) 2006-2010 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    This program is Free Software; you can redistribute it and/or
  15    modify it under the terms of version three of the GNU Affero General Public
  16    License as published by the Free Software Foundation and included
  17    in the file LICENSE.
  18
  19    This program is distributed in the hope that it will be useful, but
  20    WITHOUT ANY WARRANTY; without even the implied warranty of
  21    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  22    Affero General Public License for more details.
  23
  24    You should have received a copy of the GNU Affero General Public License
  25    along with this program; if not, write to the Free Software
  26    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27    02110-1301, USA.
  28
  29    Bacula® is a registered trademark of Kern Sibbald.
  30    The licensor of Bacula is the Free Software Foundation Europe
  31    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
  32    Switzerland, email:ftf@fsfeurope.org.
  33
  34 =cut
  35
  36 package Bweb::Gui;
  37
  38 =head1 PACKAGE
  39
  40     Bweb::Gui - Base package for all Bweb object
  41
  42 =head2 DESCRIPTION
  43
  44     This package define base fonction like new, display, etc..
  45
  46 =cut
  47
  48 use HTML::Template;
  49 our $template_dir='/usr/share/bweb/tpl';
  50
  51 =head1 FUNCTION
  52
  53     new - creation a of new Bweb object
  54
  55 =head2 DESCRIPTION
  56
  57     This function take an hash of argument and place them
  58     on bless ref
  59
  60     IE : $obj = new Obj(name => 'test', age => '10');
  61
  62          $obj->{name} eq 'test' and $obj->{age} eq 10
  63
  64 =cut
  65
  66 sub new
  67 {
  68     my ($class, %arg) = @_;
  69     my $self = bless {
  70         name => undef,
  71     }, $class;
  72
  73     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
  74
  75     return $self;
  76 }
  77
  78 sub debug
  79 {
  80     my ($self, $what) = @_;
  81
  82     if ($self->{debug}) {
  83         if (ref $what) {
  84             print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
  85         } else {
  86             print "<pre>$what</pre>";
  87         }
  88     }
  89 }
  90
  91 sub fdebug
  92 {
  93     my ($self, $what) = @_;
  94
  95     my $old = $self->{debug};
  96     $self->{debug}=1;
  97     $self->debug($what);
  98     $self->{debug} = $old;
  99 }
 100
 101 =head1 FUNCTION
 102
 103     error - display an error to the user
 104
 105 =head2 DESCRIPTION
 106
 107     this function set $self->{error} with arg, display a message with
 108     error.tpl and return 0
 109
 110 =head2 EXAMPLE
 111
 112     unless (...) {
 113         return $self->error("Can't use this file");
 114     }
 115
 116 =cut
 117
 118 sub error
 119 {
 120     my ($self, $what) = @_;
 121     $self->{error} = $what;
 122     $self->display($self, 'error.tpl');
 123     return 0;
 124 }
 125
 126 =head1 FUNCTION
 127
 128     display - display an html page with HTML::Template
 129
 130 =head2 DESCRIPTION
 131
 132     this function is use to render all html codes. it takes an
 133     ref hash as arg in which all param are usable in template.
 134
 135     it will use user template_dir then global template_dir
 136     to search the template file.
 137
 138     hash keys are not sensitive. See HTML::Template for more
 139     explanations about the hash ref. (it's can be quiet hard to understand)
 140
 141 =head2 EXAMPLE
 142
 143     $ref = { name => 'me', age => 26 };
 144     $self->display($ref, "people.tpl");
 145
 146 =cut
 147
 148 sub display
 149 {
 150     my ($self, $hash, $tpl) = @_ ;
 151     my $dir = $self->{template_dir} || $template_dir;
 152     my $lang = $self->{lang} || 'en';
 153     my $template = HTML::Template->new(filename => $tpl,
 154                                        path =>["$dir/$lang",
 155                                                "$dir/$lang/tpl",
 156                                                $dir],
 157                                        die_on_bad_params => 0,
 158                                        case_sensitive => 0);
 159
 160     foreach my $var (qw/limit offset/) {
 161
 162         unless ($hash->{$var}) {
 163             my $value = CGI::param($var) || '';
 164
 165             if ($value =~ /^(\d+)$/) {
 166                 $template->param($var, $1) ;
 167             }
 168         }
 169     }
 170
 171     $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
 172     $template->param('loginname', CGI::remote_user());
 173
 174     $template->param($hash);
 175     print $template->output();
 176 }
 177 1;
 178
 179 ################################################################
 180
 181 package Bweb::Config;
 182
 183 use base q/Bweb::Gui/;
 184
 185 =head1 PACKAGE
 186
 187     Bweb::Config - read, write, display, modify configuration
 188
 189 =head2 DESCRIPTION
 190
 191     this package is used for manage configuration
 192
 193 =head2 USAGE
 194
 195     $conf = new Bweb::Config(config_file => '/path/to/conf');
 196     $conf->load();
 197
 198     $conf->edit();
 199
 200     $conf->save();
 201
 202 =cut
 203
 204 use CGI;
 205
 206 =head1 PACKAGE VARIABLE
 207
 208     %k_re - hash of all acceptable option.
 209
 210 =head2 DESCRIPTION
 211
 212     this variable permit to check all option with a regexp.
 213
 214 =cut
 215
 216 our %k_re = ( dbi      => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
 217               user     => qr/^([\w\d\.-]+)$/i,
 218               password => qr/^(.*)$/,
 219               fv_write_path => qr!^([/\w\d\.-]*)$!,
 220               template_dir => qr!^([/\w\d\.-]+)$!,
 221               debug    => qr/^(on)?$/,
 222               lang     => qr/^(\w\w)?$/,
 223               email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
 224               graph_font  => qr!^([/\w\d\.-]+.ttf)?$!,
 225               bconsole    => qr!^(.+)?$!,
 226               syslog_file => qr!^(.+)?$!,
 227               log_dir     => qr!^(.+)?$!,
 228               wiki_url    => qr!(.*)$!,
 229               stat_job_table => qr!^(\w*)$!,
 230               display_log_time => qr!^(on)?$!,
 231               enable_security => qr/^(on)?$/,
 232               enable_security_acl => qr/^(on)?$/,
 233               default_age => qr/^((?:\d+(?:[ywdhms]\s*?)?)+)\s*$/,
 234               );
 235
 236 =head1 FUNCTION
 237
 238     load - load config_file
 239
 240 =head2 DESCRIPTION
 241
 242     this function load the specified config_file.
 243
 244 =cut
 245
 246 sub load
 247 {
 248     my ($self) = @_ ;
 249
 250     unless (open(FP, $self->{config_file}))
 251     {
 252         return $self->error("can't load config_file $self->{config_file} : $!");
 253     }
 254     my $f=''; my $tmpbuffer;
 255     while(read FP,$tmpbuffer,4096)
 256     {
 257         $f .= $tmpbuffer;
 258     }
 259     close(FP);
 260
 261     my $VAR1;
 262
 263     no strict; # I have no idea of the contents of the file
 264     eval "$f" ;
 265     use strict;
 266
 267     if ($f and $@) {
 268         $self->load_old();
 269         $self->save();
 270         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...") ;
 271     }
 272
 273     # set default values
 274     $self->{default_age} = '7d';
 275
 276     foreach my $k (keys %$VAR1) {
 277         $self->{$k} = $VAR1->{$k};
 278     }
 279
 280     return 1;
 281 }
 282
 283 =head1 FUNCTION
 284
 285     load_old - load old configuration format
 286
 287 =cut
 288
 289 sub load_old
 290 {
 291     my ($self) = @_ ;
 292
 293     unless (open(FP, $self->{config_file}))
 294     {
 295         return $self->error("$self->{config_file} : $!");
 296     }
 297
 298     while (my $line = <FP>)
 299     {
 300         chomp($line);
 301         my ($k, $v) = split(/\s*=\s*/, $line, 2);
 302         if ($k_re{$k}) {
 303             $self->{$k} = $v;
 304         }
 305     }
 306
 307     close(FP);
 308     return 1;
 309 }
 310
 311 =head1 FUNCTION
 312
 313     save - save the current configuration to config_file
 314
 315 =cut
 316
 317 sub save
 318 {
 319     my ($self) = @_ ;
 320
 321     if ($self->{ach_list}) {
 322         # shortcut for display_begin
 323         $self->{achs} = [ map {{ name => $_ }}
 324                           keys %{$self->{ach_list}}
 325                         ];
 326     }
 327
 328     unless (open(FP, ">$self->{config_file}"))
 329     {
 330         return $self->error("$self->{config_file} : $!\n" .
 331                             "You must add this to your config file\n"
 332                             . Data::Dumper::Dumper($self));
 333     }
 334
 335     print FP Data::Dumper::Dumper($self);
 336
 337     close(FP);
 338     return 1;
 339 }
 340
 341 =head1 FUNCTIONS
 342
 343     edit, view, modify - html form ouput
 344
 345 =cut
 346
 347 sub edit
 348 {
 349     my ($self) = @_ ;
 350
 351     $self->display($self, "config_edit.tpl");
 352 }
 353
 354 sub view
 355 {
 356     my ($self) = @_ ;
 357     $self->display($self, "config_view.tpl");
 358 }
 359
 360 sub modify
 361 {
 362     my ($self) = @_;
 363
 364     $self->{error} = '';
 365     # we need to reset checkbox first
 366     $self->{debug} = 0;
 367     $self->{display_log_time} = 0;
 368     $self->{enable_security} = 0;
 369     $self->{enable_security_acl} = 0;
 370
 371     foreach my $k (CGI::param())
 372     {
 373         next unless (exists $k_re{$k}) ;
 374         my $val = CGI::param($k);
 375         if ($val =~ $k_re{$k}) {
 376             $self->{$k} = $1;
 377         } else {
 378             $self->{error} .= "bad parameter : $k = [$val]";
 379         }
 380     }
 381
 382     $self->view();
 383
 384     if ($self->{error}) {       # an error as occured
 385         $self->display($self, 'error.tpl');
 386     } else {
 387         $self->save();
 388     }
 389 }
 390
 391 1;
 392
 393 ################################################################
 394
 395 package Bweb::Client;
 396
 397 use base q/Bweb::Gui/;
 398
 399 =head1 PACKAGE
 400
 401     Bweb::Client - Bacula FD
 402
 403 =head2 DESCRIPTION
 404
 405     this package is use to do all Client operations like, parse status etc...
 406
 407 =head2 USAGE
 408
 409     $client = new Bweb::Client(name => 'zog-fd');
 410     $client->status();            # do a 'status client=zog-fd'
 411
 412 =cut
 413
 414 =head1 FUNCTION
 415
 416     display_running_job - Html display of a running job
 417
 418 =head2 DESCRIPTION
 419
 420     this function is used to display information about a current job
 421
 422 =cut
 423
 424 sub display_running_job
 425 {
 426     my ($self, $bweb, $jobid, $infos) = @_ ;
 427     my $status = $self->status($bweb->{info});
 428
 429     if ($jobid) {
 430         if ($status->{$jobid}) {
 431             $status = $status->{$jobid};
 432             $status->{last_jobbytes} = $infos->{jobbytes};
 433             $status->{last_jobfiles} = $infos->{jobfiles};
 434             $status->{corr_jobbytes} = $infos->{corr_jobbytes};
 435             $status->{corr_jobfiles} = $infos->{corr_jobfiles};
 436             $status->{jobbytes}=$status->{Bytes};
 437             $status->{jobbytes} =~ s![^\d]!!g;
 438             $status->{jobfiles}=$status->{'Files Examined'};
 439             $status->{jobfiles} =~ s/,//g;
 440             $bweb->display($status, "client_job_status.tpl");
 441         }
 442     } else {
 443         for my $id (keys %$status) {
 444             $bweb->display($status->{$id}, "client_job_status.tpl");
 445         }
 446     }
 447 }
 448
 449 =head1 FUNCTION
 450
 451     $client = new Bweb::Client(name => 'plume-fd');
 452
 453     $client->status($bweb);
 454
 455 =head2 DESCRIPTION
 456
 457     dirty hack to parse "status client=xxx-fd"
 458
 459 =head2 INPUT
 460
 461    JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
 462        Backup Job started: 06-jun-06 17:22
 463        Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
 464        Files Examined=10,697
 465        Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
 466        SDReadSeqNo=5 fd=5
 467
 468 =head2 OUTPUT
 469
 470     $VAR1 = { 105 => {
 471                 JobName => Full_plume.2006-06-06_17.22.23,
 472                 JobId => 105,
 473                 Files => 8,971,
 474                 Bytes => 194,484,132,
 475                 ...
 476               },
 477               ...
 478     };
 479
 480 =cut
 481
 482 sub status
 483 {
 484     my ($self, $conf) = @_ ;
 485
 486     if (defined $self->{cur_jobs}) {
 487         return $self->{cur_jobs} ;
 488     }
 489
 490     my $arg = {};
 491     my $b = new Bconsole(pref => $conf);
 492     my $ret = $b->send_cmd("st client=$self->{name}");
 493     my @param;
 494     my $jobid;
 495
 496     for my $r (split(/\n/, $ret)) {
 497         chomp($r);
 498         $r =~ s/(^\s+|\s+$)//g;
 499         if ($r =~ /JobId (\d+) Job (\S+)/) {
 500             if ($jobid) {
 501                 $arg->{$jobid} = { @param, JobId => $jobid } ;
 502             }
 503
 504             $jobid = $1;
 505             @param = ( JobName => $2 );
 506
 507         } elsif ($r =~ /=.+=/) {
 508             push @param, split(/\s+|\s*=\s*/, $r) ;
 509
 510         } elsif ($r =~ /=/) {   # one per line
 511             push @param, split(/\s*=\s*/, $r) ;
 512
 513         } elsif ($r =~ /:/) {   # one per line
 514             push @param, split(/\s*:\s*/, $r, 2) ;
 515         }
 516     }
 517
 518     if ($jobid and @param) {
 519         $arg->{$jobid} = { @param,
 520                            JobId => $jobid,
 521                            Client => $self->{name},
 522                        } ;
 523     }
 524
 525     $self->{cur_jobs} = $arg ;
 526
 527     return $arg;
 528 }
 529 1;
 530
 531 ################################################################
 532
 533 package Bweb::Autochanger;
 534
 535 use base q/Bweb::Gui/;
 536
 537 =head1 PACKAGE
 538
 539     Bweb::Autochanger - Object to manage Autochanger
 540
 541 =head2 DESCRIPTION
 542
 543     this package will parse the mtx output and manage drives.
 544
 545 =head2 USAGE
 546
 547     $auto = new Bweb::Autochanger(precmd => 'sudo');
 548     or
 549     $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
 550
 551     $auto->status();
 552
 553     $auto->slot_is_full(10);
 554     $auto->transfer(10, 11);
 555
 556 =cut
 557
 558 sub new
 559 {
 560     my ($class, %arg) = @_;
 561
 562     my $self = bless {
 563         name  => '',    # autochanger name
 564         label => {},    # where are volume { label1 => 40, label2 => drive0 }
 565         drive => [],    # drive use [ 'media1', 'empty', ..]
 566         slot  => [],    # slot use [ undef, 'empty', 'empty', ..] no slot 0
 567         io    => [],    # io slot number list [ 41, 42, 43...]
 568         info  => {slot => 0,    # informations (slot, drive, io)
 569                   io   => 0,
 570                   drive=> 0,
 571                  },
 572         mtxcmd => '/usr/sbin/mtx',
 573         debug => 0,
 574         device => '/dev/changer',
 575         precmd => '',   # ssh command
 576         bweb => undef,  # link to bacula web object (use for display)
 577     } ;
 578
 579     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
 580
 581     return $self;
 582 }
 583
 584 =head1 FUNCTION
 585
 586     status - parse the output of mtx status
 587
 588 =head2 DESCRIPTION
 589
 590     this function will launch mtx status and parse the output. it will
 591     give a perlish view of the autochanger content.
 592
 593     it uses ssh if the autochanger is on a other host.
 594
 595 =cut
 596
 597 sub status
 598 {
 599     my ($self) = @_;
 600     my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
 601
 602     # TODO : reset all infos
 603     $self->{info}->{drive} = 0;
 604     $self->{info}->{slot}  = 0;
 605     $self->{info}->{io}    = 0;
 606
 607     #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
 608
 609 #
 610 #  Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
 611 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
 612 #Data Transfer Element 1:Empty
 613 #      Storage Element 1:Empty
 614 #      Storage Element 2:Full :VolumeTag=000002
 615 #      Storage Element 3:Empty
 616 #      Storage Element 4:Full :VolumeTag=000004
 617 #      Storage Element 5:Full :VolumeTag=000001
 618 #      Storage Element 6:Full :VolumeTag=000003
 619 #      Storage Element 7:Empty
 620 #      Storage Element 41 IMPORT/EXPORT:Empty
 621 #      Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
 622 #
 623
 624     for my $l (@out) {
 625
 626         #          Storage Element 7:Empty
 627         #          Storage Element 2:Full :VolumeTag=000002
 628         if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d.-]+))?/){
 629
 630             if ($2 eq 'Empty') {
 631                 $self->set_empty_slot($1);
 632             } else {
 633                 $self->set_slot($1, $4);
 634             }
 635
 636         } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d.-]+))?)?/) {
 637
 638             if ($2 eq 'Empty') {
 639                 $self->set_empty_drive($1);
 640             } else {
 641                 $self->set_drive($1, $4, $6);
 642             }
 643
 644         } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w.-]+))?/)
 645         {
 646             if ($2 eq 'Empty') {
 647                 $self->set_empty_io($1);
 648             } else {
 649                 $self->set_io($1, $4);
 650             }
 651
 652 #       Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
 653
 654         } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
 655             $self->{info}->{drive} = $1;
 656             $self->{info}->{slot} = $2;
 657             if ($l =~ /(\d+)\s+Import/) {
 658                 $self->{info}->{io} = $1 ;
 659             } else {
 660                 $self->{info}->{io} = 0;
 661             }
 662         }
 663     }
 664
 665     $self->debug($self) ;
 666 }
 667
 668 sub is_slot_loaded
 669 {
 670     my ($self, $slot) = @_;
 671
 672     # no barcodes
 673     if ($self->{slot}->[$slot] eq 'loaded') {
 674         return 1;
 675     }
 676
 677     my $label = $self->{slot}->[$slot] ;
 678
 679     return $self->is_media_loaded($label);
 680 }
 681
 682 sub unload
 683 {
 684     my ($self, $drive, $slot) = @_;
 685
 686     return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
 687     return 0 if     ($self->slot_is_full($slot)) ;
 688
 689     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
 690
 691     if ($? == 0) {
 692         my $content = $self->get_slot($slot);
 693         print "content = $content<br/> $drive => $slot<br/>";
 694         $self->set_empty_drive($drive);
 695         $self->set_slot($slot, $content);
 696         return 1;
 697     } else {
 698         $self->{error} = $out;
 699         return 0;
 700     }
 701 }
 702
 703 # TODO: load/unload have to use mtx script from bacula
 704 sub load
 705 {
 706     my ($self, $drive, $slot) = @_;
 707
 708     return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
 709     return 0 unless ($self->slot_is_full($slot)) ;
 710
 711     print "Loading drive $drive with slot $slot<br/>\n";
 712     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
 713
 714     if ($? == 0) {
 715         my $content = $self->get_slot($slot);
 716         print "content = $content<br/> $slot => $drive<br/>";
 717         $self->set_drive($drive, $slot, $content);
 718         return 1;
 719     } else {
 720         $self->{error} = $out;
 721         print $out;
 722         return 0;
 723     }
 724 }
 725
 726 sub is_media_loaded
 727 {
 728     my ($self, $media) = @_;
 729
 730     unless ($self->{label}->{$media}) {
 731         return 0;
 732     }
 733
 734     if ($self->{label}->{$media} =~ /drive\d+/) {
 735         return 1;
 736     }
 737
 738     return 0;
 739 }
 740
 741 sub have_io
 742 {
 743     my ($self) = @_;
 744     return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
 745 }
 746
 747 sub set_io
 748 {
 749     my ($self, $slot, $tag) = @_;
 750     $self->{slot}->[$slot] = $tag || 'full';
 751     push @{ $self->{io} }, $slot;
 752
 753     if ($tag) {
 754         $self->{label}->{$tag} = $slot;
 755     }
 756 }
 757
 758 sub set_empty_io
 759 {
 760     my ($self, $slot) = @_;
 761
 762     push @{ $self->{io} }, $slot;
 763
 764     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 765         $self->{slot}->[$slot] = 'empty';
 766     }
 767 }
 768
 769 sub get_slot
 770 {
 771     my ($self, $slot) = @_;
 772     return $self->{slot}->[$slot];
 773 }
 774
 775 sub set_slot
 776 {
 777     my ($self, $slot, $tag) = @_;
 778     $self->{slot}->[$slot] = $tag || 'full';
 779
 780     if ($tag) {
 781         $self->{label}->{$tag} = $slot;
 782     }
 783 }
 784
 785 sub set_empty_slot
 786 {
 787     my ($self, $slot) = @_;
 788
 789     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 790         $self->{slot}->[$slot] = 'empty';
 791     }
 792 }
 793
 794 sub set_empty_drive
 795 {
 796     my ($self, $drive) = @_;
 797     $self->{drive}->[$drive] = 'empty';
 798 }
 799
 800 sub set_drive
 801 {
 802     my ($self, $drive, $slot, $tag) = @_;
 803     $self->{drive}->[$drive] = $tag || $slot;
 804     $self->{drive_slot}->[$drive] = $slot;
 805
 806     $self->{slot}->[$slot] = $tag || 'loaded';
 807
 808     if ($tag) {
 809         $self->{label}->{$tag} = "drive$drive";
 810     }
 811 }
 812
 813 sub slot_is_full
 814 {
 815     my ($self, $slot) = @_;
 816
 817     # slot don't exists => full
 818     if (not defined $self->{slot}->[$slot]) {
 819         return 0 ;
 820     }
 821
 822     if ($self->{slot}->[$slot] eq 'empty') {
 823         return 0;
 824     }
 825     return 1;                   # vol, full, loaded
 826 }
 827
 828 sub slot_get_first_free
 829 {
 830     my ($self) = @_;
 831     for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
 832         return $slot unless ($self->slot_is_full($slot));
 833     }
 834 }
 835
 836 sub io_get_first_free
 837 {
 838     my ($self) = @_;
 839
 840     foreach my $slot (@{ $self->{io} }) {
 841         return $slot unless ($self->slot_is_full($slot));
 842     }
 843     return 0;
 844 }
 845
 846 sub get_media_slot
 847 {
 848     my ($self, $media) = @_;
 849
 850     return $self->{label}->{$media} ;
 851 }
 852
 853 sub have_media
 854 {
 855     my ($self, $media) = @_;
 856
 857     return defined $self->{label}->{$media} ;
 858 }
 859
 860 sub send_to_io
 861 {
 862     my ($self, $slot) = @_;
 863
 864     unless ($self->slot_is_full($slot)) {
 865         print "Autochanger $self->{name} slot $slot is empty<br>\n";
 866         return 1;               # ok
 867     }
 868
 869     # first, eject it
 870     if ($self->is_slot_loaded($slot)) {
 871         # bconsole->umount
 872         # self->eject
 873         print "Autochanger $self->{name} $slot is currently in use<br>\n";
 874         return 0;
 875     }
 876
 877     # autochanger must have I/O
 878     unless ($self->have_io()) {
 879         print "Autochanger $self->{name} don't have I/O, you can take media yourself<br>\n";
 880         return 0;
 881     }
 882
 883     my $dst = $self->io_get_first_free();
 884
 885     unless ($dst) {
 886         print "Autochanger $self->{name} mailbox is full, you must empty I/O first<br>\n";
 887         return 0;
 888     }
 889
 890     $self->transfer($slot, $dst);
 891 }
 892
 893 sub transfer
 894 {
 895     my ($self, $src, $dst) = @_ ;
 896     if ($self->{debug}) {
 897         print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
 898     }
 899     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
 900
 901     if ($? == 0) {
 902         my $content = $self->get_slot($src);
 903         $self->{slot}->[$src] = 'empty';
 904         $self->set_slot($dst, $content);
 905         return 1;
 906     } else {
 907         $self->{error} = $out;
 908         return 0;
 909     }
 910 }
 911
 912 sub get_drive_name
 913 {
 914     my ($self, $index) = @_;
 915     return $self->{drive_name}->[$index];
 916 }
 917
 918 # TODO : do a tapeinfo request to get informations
 919 sub tapeinfo
 920 {
 921     my ($self) = @_;
 922 }
 923
 924 sub clear_io
 925 {
 926     my ($self) = @_;
 927
 928     print "<table><tr>\n";
 929     for my $slot (@{$self->{io}})
 930     {
 931         if ($self->is_slot_loaded($slot)) {
 932             print "<td></td><td>Slot $slot is currently loaded</td></tr>\n";
 933             next;
 934         }
 935
 936         if ($self->slot_is_full($slot))
 937         {
 938             my $free = $self->slot_get_first_free() ;
 939             print "</tr><tr><td>move slot $slot to $free :</td>";
 940
 941             if ($free) {
 942                 if ($self->transfer($slot, $free)) {
 943                     print "<td><img src='/bweb/T.png' alt='ok'></td>\n";
 944                 } else {
 945                     print "<td><img src='/bweb/E.png' alt='ok' title='$self->{error}'></td>\n";
 946                 }
 947
 948             } else {
 949                 $self->{error} = "<td><img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'></td>\n";
 950             }
 951         }
 952     }
 953     print "</tr></table>\n";
 954 }
 955
 956 # TODO : this is with mtx status output,
 957 # we can do an other function from bacula view (with StorageId)
 958 sub display_content
 959 {
 960     my ($self) = @_;
 961     my $bweb = $self->{bweb};
 962
 963     # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
 964     my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
 965
 966     my $query="
 967 SELECT Media.VolumeName  AS volumename,
 968        Media.VolStatus   AS volstatus,
 969        Media.LastWritten AS lastwritten,
 970        Media.VolBytes    AS volbytes,
 971        Media.MediaType   AS mediatype,
 972        Media.Slot        AS slot,
 973        Media.InChanger   AS inchanger,
 974        Pool.Name         AS name,
 975        $bweb->{sql}->{FROM_UNIXTIME}(
 976           $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
 977         + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
 978        ) AS expire
 979 FROM Media
 980  INNER JOIN Pool USING (PoolId)
 981
 982 WHERE Media.VolumeName IN ($media_list)
 983 ";
 984
 985     my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
 986
 987     # TODO : verify slot and bacula slot
 988     my $param = [];
 989     my @to_update;
 990
 991     for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
 992
 993         if ($self->slot_is_full($slot)) {
 994
 995             my $vol = $self->{slot}->[$slot];
 996             if (defined $all->{$vol}) {    # TODO : autochanger without barcodes
 997
 998                 my $bslot = $all->{$vol}->{slot} ;
 999                 my $inchanger = $all->{$vol}->{inchanger};
1000
1001                 # if bacula slot or inchanger flag is bad, we display a message
1002                 if ($bslot != $slot or !$inchanger) {
1003                     push @to_update, $slot;
1004                 }
1005
1006                 $all->{$vol}->{realslot} = $slot;
1007
1008                 push @{ $param }, $all->{$vol};
1009
1010             } else {            # empty or no label
1011                 push @{ $param }, {realslot => $slot,
1012                                    volstatus => 'Unknown',
1013                                    volumename => $self->{slot}->[$slot]} ;
1014             }
1015         } else {                # empty
1016             push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
1017         }
1018     }
1019
1020     my $i=0; my $drives = [] ;
1021     foreach my $d (@{ $self->{drive} }) {
1022         $drives->[$i] = { index => $i,
1023                           load  => $self->{drive}->[$i],
1024                           name  => $self->{drive_name}->[$i],
1025                       };
1026         $i++;
1027     }
1028
1029     $bweb->display({ Name   => $self->{name},
1030                      nb_drive => $self->{info}->{drive},
1031                      nb_io => $self->{info}->{io},
1032                      Drives => $drives,
1033                      Slots  => $param,
1034                      Update => scalar(@to_update) },
1035                    'ach_content.tpl');
1036
1037 }
1038
1039 1;
1040
1041 ################################################################
1042
1043 package Bweb::Sched;
1044 use base q/Bweb::Gui/;
1045
1046 =head1 PACKAGE
1047
1048     Bweb::Sched() - Bweb package that parse show schedule ouput
1049
1050     new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1051
1052 =head2 USAGE
1053
1054  my $b = $bweb->get_bconsole();
1055  my $s = $b->send_cmd("show schedule");
1056  my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1057  $sched->parse_scheds(split(/\r?\n/, $s));
1058
1059
1060 $VAR1 = {
1061           'event' => [
1062                        '2007-01-04 04:05',
1063                        '2007-12-05 04:05',
1064                        '2007-12-12 04:05',
1065                        '2007-12-19 04:05',
1066                        '2007-12-26 04:05'
1067                      ],
1068           'level' => 'Differential',
1069           'pool' => 'Semaine'
1070         };
1071 =cut
1072
1073 sub new
1074 {
1075     my ($class, @arg) = @_;
1076     my $self = $class->SUPER::new(@arg);
1077
1078     # we compare the current schedule date with begin and end
1079     # in a float form ex: 20071212.1243 > 20070101
1080     if ($self->{begin} and $self->{end}) {
1081         ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1082         $self->{fbegin} =~ s/(-|:)//g;  $self->{fbegin} =~ s/ /./;
1083         $self->{fend}   =~ s/(-|:)//g;  $self->{fend}   =~ s/ /./;
1084     }
1085
1086     bless($self,$class);
1087
1088     if ($self->{bconsole}) {
1089         my $sel = $self->{name}?"=\"$self->{name}\"":'';
1090         my $b = $self->{bconsole};
1091         my $out = $b->send_cmd("show schedule$sel");
1092         $self->parse_scheds(split(/\r?\n/, $out));
1093         undef $self->{bconsole}; # useless now
1094     }
1095
1096     return $self;
1097 }
1098
1099 # cleanup and add a schedule
1100 sub add_sched
1101 {
1102     my ($self, $name, $info) = @_;
1103     # bacula uses dates that start from 0, we start from 1
1104     foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1105
1106     # get events
1107     $info->{event} = [ $self->get_events($info, $self->{format}) ];
1108
1109     foreach my $i (qw/hour mday month wday wom woy mins/) {
1110         delete $info->{$i};
1111     }
1112
1113     push @{$self->{schedules}->{$name}}, $info;
1114 }
1115
1116 # return the name of all schedules
1117 sub list_scheds
1118 {
1119     my ($self, $name) = @_;
1120     my %ret;
1121     return keys %{ $self->{schedules} };
1122 }
1123
1124 # return an array of all schedule
1125 sub get_scheds
1126 {
1127     my ($self, $sched) = @_;
1128     return $self->{schedules}->{$sched};
1129 }
1130
1131 # return an ref array of all events
1132 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1133 sub get_event
1134 {
1135     my ($self, $sched) = @_;
1136     return $sched->{event};
1137 }
1138
1139 # return the pool name
1140 sub get_pool
1141 {
1142     my ($self, $sched) = @_;
1143     return $sched->{pool} || '';
1144 }
1145
1146 # return the level name (Incremental, Differential, Full)
1147 sub get_level
1148 {
1149     my ($self, $sched) = @_;
1150     return $sched->{level};
1151 }
1152
1153 # parse bacula sched bitmap
1154 sub parse_scheds
1155 {
1156     my ($self, @output) = @_;
1157
1158     my $run;
1159     my $name;
1160     my $schedule;
1161     my $elt;
1162
1163     foreach my $ligne (@output) {
1164         if ($ligne =~ /Schedule: name=(.+)/) {
1165             if ($name and $elt) {
1166                 $elt->{level} = $run;
1167                 $self->add_sched($name, $elt);
1168                 $elt=undef;
1169             }
1170             $name = $1;
1171         }
1172         elsif ($ligne =~ /Run Level=(.+)/) {
1173             if ($name and $elt) {
1174                 $elt->{level} = $run;
1175                 $self->add_sched($name, $elt);
1176                 $elt=undef;
1177             }
1178             $run = $1;
1179         }
1180         elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1181             # All theses lines have the same format
1182
1183             my ($k,$v) = ($1,$2);
1184             # we get all values (0 1 4 9)
1185             $elt->{$k}=[split (/\s/,$v)];
1186         }
1187         # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1188         elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1189             my ($k,$v) = ($1,$2);
1190             foreach my $e (split (/\s/,$v)) {
1191                 $elt->{$k}->[$e]=1;
1192             }
1193         }
1194         elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1195             $elt->{pool} = $1;
1196         }
1197     }
1198
1199     if ($name and $elt) {
1200         $elt->{level} = $run;
1201         $self->add_sched($name, $elt);
1202     }
1203 }
1204
1205 use Date::Calc qw(:all);
1206
1207 # read bacula schedule bitmap and get $format date string
1208 sub get_events
1209 {
1210     use integer;
1211     my ($self, $s,$format) = @_;
1212     my $year = $self->{year} || ((localtime($Bweb::btime))[5] + 1900);
1213     $format = $format || '%u-%02u-%02u %02u:%02u';
1214     my @ret;
1215     foreach my $m (@{$s->{month}})              # mois de l'annee
1216     {
1217         foreach my $md (@{$s->{mday}})  # jour du mois
1218         {
1219 #           print "  m=$m md=$md\n";
1220             # we check if this day exists (31 fev)
1221             next if (!check_date($year,$m,$md));
1222 #           print "    check_date ok\n";
1223
1224             my $w = ($md-1)/7; # we use the same thing than bacula
1225             next if (! $s->{wom}->[$w]);
1226 #           print "      wom ok\n";
1227
1228             # on recupere le jour de la semaine
1229             my $wd = Day_of_Week($year,$m,$md);
1230
1231             my ($w1,undef) = Week_of_Year($year,$m,$wd);
1232             next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1233 #           print "        woy ok\n";
1234
1235             $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1236             next if (! $s->{wday}->[$wd]);
1237 #           print "          wday ok\n";
1238
1239             foreach my $h (@{$s->{hour}}) # hour of the day
1240             {
1241                 foreach my $min (@{$s->{mins}}) # minute
1242                 {
1243                     if ($self->{fbegin}) {
1244                         no integer;
1245                         my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1246                                         $year,$m,$md,$h,$min);
1247                         next if ($d < $self->{fbegin} or $d > $self->{fend});
1248                     }
1249                     push @ret, sprintf($format, $year,$m,$md,$h,$min);
1250                 }
1251             }
1252         }
1253     }
1254     return @ret;
1255 }
1256 1;
1257
1258 ################################################################
1259
1260 package Bweb;
1261
1262 use base q/Bweb::Gui/;
1263
1264 =head1 PACKAGE
1265
1266     Bweb - main Bweb package
1267
1268 =head2
1269
1270     this package is use to compute and display informations
1271
1272 =cut
1273
1274 use DBI;
1275 use POSIX qw/strftime/;
1276
1277 our $config_file= '/etc/bacula/bweb.conf';
1278
1279 if ($ENV{BWEBCONF} && -f $ENV{BWEBCONF}) {
1280     $config_file = $ENV{BWEBCONF};
1281 }
1282
1283 our $cur_id=0;
1284
1285 =head1 VARIABLE
1286
1287     %sql_func - hash to make query mysql/postgresql compliant
1288
1289 =cut
1290
1291 our %sql_func = (
1292           Pg => {
1293               UNIX_TIMESTAMP => '',
1294               FROM_UNIXTIME => '',
1295               TO_SEC => " interval '1 second' * ",
1296               SEC_TO_INT => "SEC_TO_INT",
1297               SEC_TO_TIME => '',
1298               MATCH => " ~* ",
1299               STARTTIME_SEC  => " date_trunc('sec', Job.StartTime) ",
1300               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1301               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1302               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1303               STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1304               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1305               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1306               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1307               STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1308               DB_SIZE => " SELECT pg_database_size(current_database()) ",
1309               CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1310               CONCAT_SEP => "",
1311               NOW => "NOW()",
1312               #NOW  => "TIMESTAMP '2010-07-15 00:00:00' "
1313           },
1314           mysql => {
1315               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1316               FROM_UNIXTIME => 'FROM_UNIXTIME',
1317               SEC_TO_INT => '',
1318               TO_SEC => '',
1319               SEC_TO_TIME => 'SEC_TO_TIME',
1320               MATCH => " REGEXP ",
1321               STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1322               STARTTIME_DAY  => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1323               STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1324               STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1325               STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1326               STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1327               STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1328               STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1329               STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1330               # with mysql < 5, you have to play with the ugly SHOW command
1331               #DB_SIZE => " SELECT 0 ",
1332               # works only with mysql 5
1333               DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1334               CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1335               CONCAT_SEP => " SEPARATOR '' ",
1336               NOW => "NOW()",
1337           },
1338          );
1339
1340 use Exporter 'import';
1341 our @EXPORT_OK = qw($btime);
1342
1343 #our $btime = 1279144800;
1344 our $btime = time;
1345
1346 sub dbh_is_mysql
1347 {
1348     my ($self) = @_;
1349     return $self->{info}->{dbi} =~ /dbi:mysql/i;
1350 }
1351
1352 sub dbh_disconnect
1353 {
1354     my ($self) = @_;
1355     if ($self->{dbh}) {
1356        $self->{dbh}->disconnect();
1357        undef $self->{dbh};
1358     }
1359 }
1360
1361 sub dbh_selectall_arrayref
1362 {
1363     my ($self, $query) = @_;
1364     $self->connect_db();
1365     $self->debug($query);
1366     return $self->{dbh}->selectall_arrayref($query);
1367 }
1368
1369 sub dbh_join
1370 {
1371     my ($self, @what) = @_;
1372     return join(',', $self->dbh_quote(@what)) ;
1373 }
1374
1375 sub dbh_quote
1376 {
1377     my ($self, @what) = @_;
1378
1379     $self->connect_db();
1380     if (wantarray) {
1381         return map { $self->{dbh}->quote($_) } @what;
1382     } else {
1383         return $self->{dbh}->quote($what[0]) ;
1384     }
1385 }
1386
1387 sub dbh_do
1388 {
1389     my ($self, $query) = @_ ;
1390     $self->connect_db();
1391     $self->debug($query);
1392     return $self->{dbh}->do($query);
1393 }
1394
1395 sub dbh_selectall_hashref
1396 {
1397     my ($self, $query, $join) = @_;
1398
1399     $self->connect_db();
1400     $self->debug($query);
1401     return $self->{dbh}->selectall_hashref($query, $join) ;
1402 }
1403
1404 sub dbh_selectrow_hashref
1405 {
1406     my ($self, $query) = @_;
1407
1408     $self->connect_db();
1409     $self->debug($query);
1410     return $self->{dbh}->selectrow_hashref($query) ;
1411 }
1412
1413 sub dbh_strcat
1414 {
1415     my ($self, @what) = @_;
1416     if ($self->dbh_is_mysql()) {
1417         return 'CONCAT(' . join(',', @what) . ')' ;
1418     } else {
1419         return join(' || ', @what);
1420     }
1421 }
1422
1423 sub dbh_prepare
1424 {
1425     my ($self, $query) = @_;
1426     $self->debug($query, up => 1);
1427     return $self->{dbh}->prepare($query);
1428 }
1429
1430 # display Mb/Gb/Kb
1431 sub human_size
1432 {
1433     my @unit = qw(B KB MB GB TB);
1434     my $val = shift || 0;
1435     my $i=0;
1436     my $format = '%i %s';
1437     while ($val / 1024 > 1) {
1438         $i++;
1439         $val /= 1024;
1440     }
1441     $format = ($i>0)?'%0.1f %s':'%i %s';
1442     return sprintf($format, $val, $unit[$i]);
1443 }
1444
1445 sub human_sec_unit
1446 {
1447     my $val = shift;
1448     my $orig = $val;
1449     if ($val =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) {
1450         for ($val) {
1451             s/y/*52w/g;
1452             s/w/*7d/g;
1453             s/d/*24h/g;
1454             s/h/*60m/g;
1455             s/m/*60s/g;
1456             s/s(\d)/+$1/g;
1457             s/s//;
1458         }
1459         $val = eval $val;
1460     }
1461     return int($val);
1462 }
1463
1464 # display Day, Hour, Year
1465 sub human_sec
1466 {
1467     use integer;
1468
1469     my $val = shift;
1470     $val /= 60;                 # sec -> min
1471
1472     if ($val / 60 <= 1) {
1473         return "$val mins";
1474     }
1475
1476     $val /= 60;                 # min -> hour
1477     if ($val / 24 <= 1) {
1478         return "$val hours";
1479     }
1480
1481     $val /= 24;                 # hour -> day
1482     if ($val / 365 < 2) {
1483         return "$val days";
1484     }
1485
1486     $val /= 365 ;               # day -> year
1487
1488     return "$val years";
1489 }
1490
1491 # display Enabled
1492 sub human_enabled
1493 {
1494     my $val = shift || 0;
1495
1496     if ($val eq '1' or $val eq "yes") {
1497         return "yes";
1498     } elsif ($val eq '2' or $val eq "archived") {
1499         return "archived";
1500     } else {
1501         return  "no";
1502     }
1503 }
1504
1505 # display Enabled
1506 sub from_human_enabled
1507 {
1508     my $val = shift || 0;
1509
1510     if ($val eq '1' or $val eq "yes") {
1511         return 1;
1512     } elsif ($val eq '2' or $val eq "archived") {
1513         return 2;
1514     } else {
1515         return  0;
1516     }
1517 }
1518
1519 # get Day, Hour, Year
1520 sub from_human_sec
1521 {
1522     use integer;
1523
1524     my $val = shift;
1525     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1526         return 0;
1527     }
1528
1529     my %times = ( m   => 60,
1530                   h   => 60*60,
1531                   d   => 60*60*24,
1532                   m   => 60*60*24*31,
1533                   y   => 60*60*24*365,
1534                   );
1535     my $mult = $times{$2} || 0;
1536
1537     return $1 * $mult;
1538 }
1539
1540 # get long term statistic table
1541 sub get_stat_table
1542 {
1543     my ($self) = @_;
1544     my $ret = $self->{info}->{stat_job_table} || 'JobHisto';
1545     if ($ret !~ m/^job$/i) {
1546         $ret = "(SELECT * FROM Job UNION SELECT * FROM $ret)";
1547     }
1548     return $ret;
1549 }
1550
1551 sub connect_db
1552 {
1553     my ($self) = @_;
1554
1555     unless ($self->{dbh}) {
1556
1557         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1558                                     $self->{info}->{user},
1559                                     $self->{info}->{password});
1560
1561         $self->error("Can't connect to your database:\n$DBI::errstr\n")
1562             unless ($self->{dbh});
1563
1564         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1565
1566         if ($self->dbh_is_mysql()) {
1567             $self->{dbh}->do("SET group_concat_max_len=1000000");
1568         } else {
1569             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1570         }
1571     }
1572 }
1573
1574 sub new
1575 {
1576     my ($class, %arg) = @_;
1577     my $self = bless ({
1578         dbh => undef,           # connect_db();
1579         info => {
1580             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1581             user  => 'bacula',
1582             password => 'test',
1583         },
1584     },$class) ;
1585
1586     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1587
1588     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1589         $self->{sql} = $sql_func{$1};
1590     }
1591
1592     $self->{loginname} = CGI::remote_user();
1593     $self->{debug} = $self->{info}->{debug};
1594     $self->{lang} = $self->{info}->{lang};
1595     $self->{template_dir} = $self->{info}->{template_dir};
1596
1597     return $self;
1598 }
1599
1600 sub display_begin
1601 {
1602     my ($self) = @_;
1603     if ($self->{info}->{enable_security}) {
1604         $self->get_roles();     # get lang
1605     }
1606     $self->display($self->{info}, "begin.tpl");
1607 }
1608
1609 sub display_end
1610 {
1611     my ($self) = @_;
1612     $self->display($self->{info}, "end.tpl");
1613 }
1614
1615 sub client_edit
1616 {
1617     my ($self) = @_;
1618     my $arg = $self->get_form("qclient");
1619     my $f1 = $self->get_client_group_filter();
1620     my $f2 = $self->get_client_filter();
1621
1622 # client_group_name | here
1623 #-------------------+-----
1624 #      GROUP1       | 1
1625 #      GRP3         | 0
1626
1627     my $query = "
1628 SELECT client_group_name, max(here) AS here FROM (
1629   SELECT client_group_name, 1 AS here
1630     FROM client_group
1631     JOIN client_group_member USING (client_group_id)
1632     JOIN Client USING (ClientId) $f2
1633    WHERE Name = $arg->{qclient}
1634   UNION ALL
1635   SELECT client_group_name, 0
1636     FROM client_group $f1
1637 ) AS temp
1638 GROUP by client_group_name";
1639
1640     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
1641
1642     $self->display({ client_group => [ values %$all ], %$arg }, "client_edit.tpl");
1643 }
1644
1645 sub display_clients
1646 {
1647     my ($self) = @_;
1648     my $where='';       # by default
1649
1650     my $arg = $self->get_form("client", "qre_client",
1651                               "jclient_groups", "qnotingroup");
1652
1653     if ($arg->{qre_client}) {
1654         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1655     } elsif ($arg->{client}) {
1656         $where = "WHERE Name = '$arg->{client}' ";
1657     } elsif ($arg->{jclient_groups}) {
1658         # $filter could already contains client_group_member
1659         $where = "
1660  JOIN client_group_member USING (ClientId)
1661  JOIN client_group USING (client_group_id)
1662  WHERE client_group_name IN ($arg->{jclient_groups}) ";
1663     } elsif ($arg->{qnotingroup}) {
1664         $where =   "
1665   WHERE NOT EXISTS
1666    (SELECT 1 FROM client_group_member
1667      WHERE Client.ClientId = client_group_member.ClientId
1668    )
1669 ";
1670     }
1671
1672     my $query = "
1673 SELECT Name   AS name,
1674        Uname  AS uname,
1675        AutoPrune AS autoprune,
1676        FileRetention AS fileretention,
1677        JobRetention  AS jobretention
1678 FROM Client " . $self->get_client_filter() .
1679 $where ;
1680
1681     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1682
1683     my $dsp = { ID => $cur_id++,
1684                 clients => [ values %$all] };
1685
1686     $self->display($dsp, "client_list.tpl") ;
1687 }
1688
1689 sub get_limit
1690 {
1691     my ($self, %arg) = @_;
1692
1693     my $limit = '';
1694     my $label = '';
1695     my $sql = $self->{sql};
1696
1697     if ($arg{since} and $arg{age}) {
1698         my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1699         my $d = strftime('%Y-%m-%d %H:%M:%S', localtime($btime + $arg{age}));
1700         $limit .= "
1701  AND StartTime > '$arg{since}'
1702  AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1703
1704         $label .= "since $arg{since} and during " . human_sec($arg{age});
1705
1706     } elsif ($arg{age}) {
1707         my $d = strftime('%Y-%m-%d %H:%M:%S', localtime($btime - $arg{age}));
1708         $limit .=  "AND EndTime > '$d' " ;
1709
1710         $label = "last " . human_sec($arg{age});
1711     }
1712
1713     if ($arg{groupby}) {
1714         $limit .= " GROUP BY $arg{groupby} ";
1715     }
1716
1717     if ($arg{order}) {
1718         $limit .= " ORDER BY $arg{order} ";
1719     }
1720
1721     if ($arg{limit}) {
1722         $limit .= " LIMIT $arg{limit} ";
1723         $label .= " limited to $arg{limit}";
1724     }
1725
1726     if ($arg{offset}) {
1727         $limit .= " OFFSET $arg{offset} ";
1728         $label .= " with $arg{offset} offset ";
1729     }
1730
1731     unless ($label) {
1732         $label = 'no filter';
1733     }
1734
1735     return ($limit, $label);
1736 }
1737
1738 =head1 FUNCTION
1739
1740     $bweb->get_form(...) - Get useful stuff
1741
1742 =head2 DESCRIPTION
1743
1744     This function get and check parameters against regexp.
1745
1746     If word begin with 'q', the return will be quoted or join quoted
1747     if it's end with 's'.
1748
1749
1750 =head2 EXAMPLE
1751
1752     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1753
1754     { jobid    => 12,
1755       qclient  => 'plume-fd',
1756       qpools   => "'plume-fd', 'test-fd', '...'",
1757     }
1758
1759 =cut
1760
1761 sub get_form
1762 {
1763     my ($self, @what) = @_;
1764     my %what = map { $_ => 1 } @what;
1765     my %ret;
1766
1767     my %opt_i = (
1768                  limit  => 100,
1769                  cost   =>  10,
1770                  offset =>   0,
1771                  start  =>   0,
1772                  width  => 640,
1773                  height => 480,
1774                  jobid  =>   0,
1775                  slot   =>   0,
1776                  drive  =>   0,
1777                  priority => 10,
1778                  age    => $self->{info}->{default_age},
1779                  days   => 1,
1780                  maxvoljobs  => 0,
1781                  maxvolbytes => 0,
1782                  maxvolfiles => 0,
1783                  filenameid => 0,
1784                  pathid => 0,
1785                  nb => 0,
1786                  );
1787
1788     my %opt_ss =(               # string with space
1789                  job     => 1,
1790                  storage => 1,
1791                  );
1792     my %opt_s = (               # default to ''
1793                  ach    => 1,
1794                  status => 1,
1795                  volstatus => 1,
1796                  inchanger => 1,
1797                  client => 1,
1798                  level  => 1,
1799                  pool   => 1,
1800                  media  => 1,
1801                  ach    => 1,
1802                  jobtype=> 1,
1803                  graph  => 1,
1804                  gtype  => 1,
1805                  type   => 1,
1806                  poolrecycle => 1,
1807                  replace => 1,
1808                  expired => 1,
1809                  enabled => 1,
1810                  username => 1,
1811                  rolename => 1,
1812                  storage_cmd => 1,
1813                  );
1814     my %opt_p = (               # option with path
1815                  fileset=> 1,
1816                  mtxcmd => 1,
1817                  precmd => 1,
1818                  device => 1,
1819                  where  => 1,
1820                  );
1821     my %opt_r = (regexwhere => 1);
1822     my %opt_d = (               # option with date
1823                  voluseduration=> 1,
1824                  volretention => 1,
1825                 );
1826     my %opt_t = (when => 2,     # option with time
1827                  begin => 1,    # 1 hh:min are optionnal
1828                  end => 1,      # 2 hh:min are required
1829                  );
1830
1831     foreach my $i (@what) {
1832         if (exists $opt_i{$i}) {# integer param
1833             my $value = CGI::param($i) || $opt_i{$i} ;
1834             if ($value =~ /^(\d+)$/) {
1835                 $ret{$i} = $1;
1836             } elsif ($i eq 'age' &&  # can have unit
1837                      $value =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) # 2y1h2m34s
1838             {
1839                 $ret{$i} = human_sec_unit($value);
1840             }
1841         } elsif ($opt_s{$i}) {  # simple string param
1842             my $value = CGI::param($i) || '';
1843             if ($value =~ /^([\w\d\.-]+)$/) {
1844                 $ret{$i} = $1;
1845             }
1846         } elsif ($opt_ss{$i}) { # simple string param (with space)
1847             my $value = CGI::param($i) || '';
1848             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1849                 $ret{$i} = $1;
1850             }
1851         } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1852             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1853             if (@value) {
1854                 $ret{$i} = $self->dbh_join(@value) ;
1855             }
1856
1857         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1858             my $value = CGI::param($1) ;
1859             if ($value) {
1860                 $ret{$i} = $self->dbh_quote($value);
1861             }
1862
1863         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1864             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1865                                            grep { ! /^\s*$/ } CGI::param($1) ];
1866         } elsif (exists $opt_p{$i}) {
1867             my $value = CGI::param($i) || '';
1868             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1869                 $ret{$i} = $1;
1870             }
1871         } elsif (exists $opt_r{$i}) {
1872             my $value = CGI::param($i) || '';
1873             if ($value =~ /^([^'"']+)$/) {
1874                 $ret{$i} = $1;
1875             }
1876         } elsif (exists $opt_d{$i}) {
1877             my $value = CGI::param($i) || '';
1878             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1879                 $ret{$i} = $1;
1880             }
1881         } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1882             my $when = CGI::param($i) || '';
1883             if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}(:\d{2})?)?)/) {
1884                 if ($opt_t{$i} == 1 or defined $2) {
1885                     $ret{$i} = $1;
1886                 }
1887             }
1888         }
1889     }
1890
1891     if ($what{storage_cmd}) {
1892         if (!grep {/^\Q$ret{storage_cmd}\E$/} ('mount', 'umount', 'release','status')) {
1893             delete $ret{storage_cmd};
1894         }
1895     }
1896
1897     if ($what{slots}) {
1898         foreach my $s (CGI::param('slot')) {
1899             if ($s =~ /^(\d+)$/) {
1900                 push @{$ret{slots}}, $s;
1901             }
1902         }
1903     }
1904
1905     if ($what{since}) {
1906         my $age = $ret{age} || human_sec_unit($opt_i{age});
1907         my $since = CGI::param('since') || strftime('%F %T', localtime($btime - $age));
1908         if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1909             $ret{since} = $1;
1910         }
1911     }
1912
1913     if ($what{lang}) {
1914         my $lang = CGI::param('lang') || 'en';
1915         if ($lang =~ /^(\w\w)$/) {
1916             $ret{lang} = $1;
1917         }
1918     }
1919
1920     if ($what{db_clients}) {
1921         my $filter='';
1922         if ($what{filter}) {
1923             # get security filter only if asked
1924             $filter = $self->get_client_filter();
1925         }
1926
1927         my $query = "
1928 SELECT Client.Name as clientname
1929   FROM Client $filter
1930 ";
1931
1932         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1933         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1934                               values %$clients] ;
1935     }
1936
1937     if ($what{db_client_groups}) {
1938         my $filter='';
1939         if ($what{filter}) {
1940             # get security filter only if asked
1941             $filter = $self->get_client_group_filter();
1942         }
1943
1944         my $query = "
1945 SELECT client_group_name AS name, comment AS comment
1946   FROM client_group $filter
1947 ";
1948         my $grps = $self->dbh_selectall_hashref($query, 'name');
1949         $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1950                                   values %$grps] ;
1951     }
1952
1953     if ($what{db_usernames}) {
1954         my $query = "
1955 SELECT username, comment
1956   FROM bweb_user
1957 ";
1958         my $users = $self->dbh_selectall_hashref($query, 'username');
1959         $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1960                                   values %$users] ;
1961     }
1962
1963     if ($what{db_roles}) {
1964         my $query = "
1965 SELECT rolename, comment
1966   FROM bweb_role
1967 ";
1968         my $r = $self->dbh_selectall_hashref($query, 'rolename');
1969         $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1970                                   values %$r] ;
1971     }
1972
1973     if ($what{db_mediatypes}) {
1974         my $query = "
1975 SELECT MediaType as mediatype
1976   FROM MediaType
1977 ";
1978         my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1979         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1980                                   values %$media] ;
1981     }
1982
1983     if ($what{db_locations}) {
1984         my $query = "
1985 SELECT Location as location, Cost as cost
1986   FROM Location
1987 ";
1988         my $loc = $self->dbh_selectall_hashref($query, 'location');
1989         $ret{db_locations} = [ sort { $a->{location}
1990                                       cmp
1991                                       $b->{location}
1992                                   } values %$loc ];
1993     }
1994
1995     if ($what{db_pools}) {
1996         my $query = "SELECT Name as name FROM Pool";
1997
1998         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1999         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
2000     }
2001
2002     if ($what{db_filesets}) {
2003         my $query = "
2004 SELECT FileSet.FileSet AS fileset
2005   FROM FileSet
2006 ";
2007         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
2008
2009         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
2010                                values %$filesets] ;
2011     }
2012
2013     if ($what{db_jobnames}) {
2014         my $filter='';
2015         if ($what{filter}) {
2016             $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
2017         }
2018         my $query = "
2019 SELECT DISTINCT Job.Name AS jobname
2020   FROM Job $filter
2021 ";
2022         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
2023
2024         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
2025                                values %$jobnames] ;
2026     }
2027
2028     if ($what{db_devices}) {
2029         my $query = "
2030 SELECT Device.Name AS name
2031   FROM Device
2032 ";
2033         my $devices = $self->dbh_selectall_hashref($query, 'name');
2034
2035         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
2036                                values %$devices] ;
2037     }
2038
2039     return \%ret;
2040 }
2041
2042 sub display_graph
2043 {
2044     my ($self) = @_;
2045     $self->can_do('r_view_stat');
2046     my $fields = $self->get_form(qw/age level status clients filesets
2047                                     graph gtype type filter db_clients
2048                                     limit db_filesets width height
2049                                     qclients qfilesets qjobnames db_jobnames/);
2050
2051     my $url = CGI::url(-full => 0,
2052                       -base => 0,
2053                       -query => 1);
2054     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
2055
2056 # this organisation is to keep user choice between 2 click
2057 # TODO : fileset and client selection doesn't work
2058
2059     $self->display({
2060         url => $url,
2061         %$fields,
2062     }, "graph.tpl");
2063
2064     if ($fields->{gtype} and $fields->{gtype} eq 'balloon') {
2065         system("./bgraph.pl");
2066     }
2067 }
2068
2069 sub get_selected_media_location
2070 {
2071     my ($self) = @_ ;
2072
2073     my $media = $self->get_form('jmedias');
2074
2075     unless ($media->{jmedias}) {
2076         return undef;
2077     }
2078
2079     my $query = "
2080 SELECT Media.VolumeName AS volumename, Location.Location AS location
2081 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2082 WHERE Media.VolumeName IN ($media->{jmedias})
2083 ";
2084
2085     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2086
2087     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
2088     #               ..
2089     #             }
2090     # }
2091     return $all;
2092 }
2093
2094 sub move_media
2095 {
2096     my ($self, $in) = @_ ;
2097     $self->can_do('r_media_mgnt');
2098     my $media = $self->get_selected_media_location();
2099
2100     unless ($media) {
2101         return ;
2102     }
2103
2104     my $elt = $self->get_form('db_locations');
2105
2106     $self->display({ ID => $cur_id++,
2107                      enabled => human_enabled($in),
2108                      %$elt,     # db_locations
2109                      media => [
2110             sort { $a->{volumename} cmp $b->{volumename} } values %$media
2111                                ],
2112                      },
2113                    "move_media.tpl");
2114 }
2115
2116 sub help_extern
2117 {
2118     my ($self) = @_ ;
2119     $self->can_do('r_media_mgnt');
2120
2121     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2122     $self->debug($elt);
2123     $self->display($elt, "help_extern.tpl");
2124 }
2125
2126 sub help_extern_compute
2127 {
2128     my ($self) = @_;
2129     $self->can_do('r_media_mgnt');
2130
2131     my $number = CGI::param('limit') || '' ;
2132     unless ($number =~ /^(\d+)$/) {
2133         return $self->error("Bad arg number : $number ");
2134     }
2135
2136     my ($sql, undef) = $self->get_param('pools',
2137                                         'locations', 'mediatypes');
2138
2139     my $query = "
2140 SELECT Media.VolumeName  AS volumename,
2141        Media.VolStatus   AS volstatus,
2142        Media.LastWritten AS lastwritten,
2143        Media.MediaType   AS mediatype,
2144        Media.VolMounts   AS volmounts,
2145        Pool.Name         AS name,
2146        Media.Recycle     AS recycle,
2147        $self->{sql}->{FROM_UNIXTIME}(
2148           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2149         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2150        ) AS expire
2151 FROM Media
2152  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
2153  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2154
2155 WHERE Media.InChanger = 1
2156   AND Media.VolStatus IN ('Disabled', 'Error', 'Full', 'Used')
2157   $sql
2158 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2159 LIMIT $number
2160 " ;
2161
2162     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2163
2164     $self->display({ Media => [ values %$all ] },
2165                    "help_extern_compute.tpl");
2166 }
2167
2168 sub help_intern
2169 {
2170     my ($self) = @_ ;
2171     $self->can_do('r_media_mgnt');
2172
2173     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2174     $self->display($param, "help_intern.tpl");
2175 }
2176
2177 sub help_intern_compute
2178 {
2179     my ($self) = @_;
2180     $self->can_do('r_media_mgnt');
2181
2182     my $number = CGI::param('limit') || '' ;
2183     unless ($number =~ /^(\d+)$/) {
2184         return $self->error("Bad arg number : $number ");
2185     }
2186
2187     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2188
2189     if (CGI::param('expired')) {
2190         # we take only expired volumes or purged/recycle ones
2191         $sql = "
2192 AND (
2193  (  ($self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2194       + $self->{sql}->{TO_SEC}(Media.VolRetention)
2195     ) < $self->{sql}->{NOW}
2196  ) OR (
2197   Media.VolStatus IN ('Purged', 'Recycle')
2198  )
2199 )
2200  " . $sql ;
2201     }
2202
2203     my $query = "
2204 SELECT Media.VolumeName  AS volumename,
2205        Media.VolStatus   AS volstatus,
2206        Media.LastWritten AS lastwritten,
2207        Media.MediaType   AS mediatype,
2208        Media.VolMounts   AS volmounts,
2209        Pool.Name         AS name,
2210        $self->{sql}->{FROM_UNIXTIME}(
2211           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2212         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2213        ) AS expire
2214 FROM Media
2215  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2216  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
2217
2218 WHERE Media.InChanger <> 1
2219   AND Media.VolStatus IN ('Purged', 'Full', 'Append', 'Recycle')
2220   AND Media.Recycle = 1
2221   $sql
2222 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2223 LIMIT $number
2224 " ;
2225
2226     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2227
2228     $self->display({ Media => [ values %$all ] },
2229                    "help_intern_compute.tpl");
2230
2231 }
2232
2233 sub display_general
2234 {
2235     my ($self, %arg) = @_ ;
2236
2237     my ($limit, $label) = $self->get_limit(%arg);
2238     my $filter = $self->get_client_filter();
2239     $filter = $filter? " JOIN Client USING (ClientId) $filter " : '';
2240     my $query = "
2241 SELECT
2242     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
2243     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
2244     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
2245     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
2246     ($self->{sql}->{DB_SIZE})                 AS db_size,
2247     (SELECT count(Job.JobId)
2248       FROM Job $filter
2249       WHERE Job.JobStatus IN ('E','e','f','A')
2250       $limit
2251     )                                         AS nb_err,
2252     (SELECT count(Client.ClientId) FROM Client) AS nb_client
2253 ";
2254
2255     my $row = $self->dbh_selectrow_hashref($query) ;
2256
2257     $row->{nb_bytes} = human_size($row->{nb_bytes});
2258
2259     $row->{db_size} = human_size($row->{db_size});
2260     $row->{label} = $label;
2261     $row->{age} = $arg{age};
2262
2263     $self->display($row, "general.tpl");
2264 }
2265
2266 sub get_param
2267 {
2268     my ($self, @what) = @_ ;
2269     my %elt = map { $_ => 1 } @what;
2270     my %ret;
2271
2272     my $limit = '';
2273
2274     if ($elt{clients}) {
2275         my @clients = grep { ! /^\s*$/ } CGI::param('client');
2276         if (@clients) {
2277             $ret{clients} = \@clients;
2278             my $str = $self->dbh_join(@clients);
2279             $limit .= "AND Client.Name IN ($str) ";
2280         }
2281     }
2282
2283     if ($elt{client_groups}) {
2284         my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2285         if (@clients) {
2286             $ret{client_groups} = \@clients;
2287             my $str = $self->dbh_join(@clients);
2288             $limit .= "AND client_group_name IN ($str) ";
2289         }
2290     }
2291
2292     if ($elt{filesets}) {
2293         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2294         if (@filesets) {
2295             $ret{filesets} = \@filesets;
2296             my $str = $self->dbh_join(@filesets);
2297             $limit .= "AND FileSet.FileSet IN ($str) ";
2298         }
2299     }
2300
2301     if ($elt{mediatypes}) {
2302         my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2303         if (@media) {
2304             $ret{mediatypes} = \@media;
2305             my $str = $self->dbh_join(@media);
2306             $limit .= "AND Media.MediaType IN ($str) ";
2307         }
2308     }
2309
2310     if ($elt{client}) {
2311         my $client = CGI::param('client');
2312         if ($client) {
2313             $ret{client} = $client;
2314             $client = $self->dbh_quote($client);
2315             $limit .= "AND Client.Name = $client ";
2316         }
2317     }
2318
2319     if ($elt{level}) {
2320         my $level = CGI::param('level') || '';
2321         if ($level =~ /^(\w)$/) {
2322             $ret{level} = $1;
2323             $limit .= "AND Job.Level = '$1' ";
2324         }
2325     }
2326
2327     if ($elt{jobid}) {
2328         my $jobid = CGI::param('jobid') || '';
2329
2330         if ($jobid =~ /^(\d+)$/) {
2331             $ret{jobid} = $1;
2332             $limit .= "AND Job.JobId = '$1' ";
2333         }
2334     }
2335
2336     if ($elt{status}) {
2337         my $status = CGI::param('status') || '';
2338         if ($status =~ /^(\w)$/) {
2339             $ret{status} = $1;
2340             if ($1 eq 'f') {
2341                 $limit .= "AND Job.JobStatus IN ('E','e','f','A') ";
2342             } elsif ($1 eq 'W') {
2343                 $limit .= "AND Job.JobStatus IN ('T', 'W') OR Job.JobErrors > 0 ";
2344             } else {
2345                 $limit .= "AND Job.JobStatus = '$1' ";
2346             }
2347         }
2348     }
2349
2350     if ($elt{volstatus}) {
2351         my $status = CGI::param('volstatus') || '';
2352         if ($status =~ /^(\w+)$/) {
2353             $ret{status} = $1;
2354             $limit .= "AND Media.VolStatus = '$1' ";
2355         }
2356     }
2357
2358     if ($elt{locations}) {
2359         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2360         if (@location) {
2361             $ret{locations} = \@location;
2362             my $str = $self->dbh_join(@location);
2363             $limit .= "AND Location.Location IN ($str) ";
2364         }
2365     }
2366
2367     if ($elt{pools}) {
2368         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2369         if (@pool) {
2370             $ret{pools} = \@pool;
2371             my $str = $self->dbh_join(@pool);
2372             $limit .= "AND Pool.Name IN ($str) ";
2373         }
2374     }
2375
2376     if ($elt{location}) {
2377         my $location = CGI::param('location') || '';
2378         if ($location) {
2379             $ret{location} = $location;
2380             $location = $self->dbh_quote($location);
2381             $limit .= "AND Location.Location = $location ";
2382         }
2383     }
2384
2385     if ($elt{pool}) {
2386         my $pool = CGI::param('pool') || '';
2387         if ($pool) {
2388             $ret{pool} = $pool;
2389             $pool = $self->dbh_quote($pool);
2390             $limit .= "AND Pool.Name = $pool ";
2391         }
2392     }
2393
2394     if ($elt{jobtype}) {
2395         my $jobtype = CGI::param('jobtype') || '';
2396         if ($jobtype =~ /^(\w)$/) {
2397             $ret{jobtype} = $1;
2398             $limit .= "AND Job.Type = '$1' ";
2399         }
2400     }
2401
2402     return ($limit, %ret);
2403 }
2404
2405 =head1
2406
2407     get last backup
2408
2409 =cut
2410
2411 sub display_job
2412 {
2413     my ($self, %arg) = @_ ;
2414     return if $self->cant_do('r_view_job');
2415
2416     $arg{order} = ' Job.JobId DESC ';
2417
2418     my ($limit, $label) = $self->get_limit(%arg);
2419     my ($where, undef) = $self->get_param('clients',
2420                                           'client_groups',
2421                                           'level',
2422                                           'filesets',
2423                                           'jobtype',
2424                                           'pools',
2425                                           'jobid',
2426                                           'status');
2427     my $cgq='';
2428     if (CGI::param('client_group')) {
2429         $cgq .= "
2430 JOIN client_group_member USING (ClientId)
2431 JOIN client_group USING (client_group_id)
2432 ";
2433     }
2434     my $filter = $self->get_client_filter();
2435
2436     my $query="
2437 SELECT  Job.JobId       AS jobid,
2438         Client.Name     AS client,
2439         FileSet.FileSet AS fileset,
2440         Job.Name        AS jobname,
2441         Level           AS level,
2442         StartTime       AS starttime,
2443         EndTime         AS endtime,
2444         Pool.Name       AS poolname,
2445         JobFiles        AS jobfiles,
2446         JobBytes        AS jobbytes,
2447         JobStatus       AS jobstatus,
2448         Type            AS jobtype,
2449      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2450                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2451                         AS duration,
2452
2453         JobErrors       AS joberrors
2454
2455  FROM Client $filter $cgq,
2456       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2457           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2458  WHERE Client.ClientId=Job.ClientId
2459    AND Job.JobStatus NOT IN ('R', 'C')
2460  $where
2461  $limit
2462 ";
2463
2464     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2465
2466     $self->display({ Filter => $label,
2467                      ID => $cur_id++,
2468                      Jobs =>
2469                            [
2470                              sort { $a->{jobid} <=>  $b->{jobid} }
2471                                         values %$all
2472                              ],
2473                    },
2474                    "display_job.tpl");
2475 }
2476
2477 # display job informations
2478 sub display_job_zoom
2479 {
2480     my ($self, $jobid) = @_ ;
2481     $self->can_do('r_view_job');
2482
2483     $jobid = $self->dbh_quote($jobid);
2484
2485     # get security filter
2486     my $filter = $self->get_client_filter();
2487
2488     my $query="
2489 SELECT DISTINCT Job.JobId       AS jobid,
2490                 Client.Name     AS client,
2491                 Job.Name        AS jobname,
2492                 FileSet.FileSet AS fileset,
2493                 Level           AS level,
2494                 Pool.Name       AS poolname,
2495                 StartTime       AS starttime,
2496                 JobFiles        AS jobfiles,
2497                 JobBytes        AS jobbytes,
2498                 JobStatus       AS jobstatus,
2499                 JobErrors       AS joberrors,
2500                 Type            AS jobtype,
2501                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2502                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2503
2504  FROM Client $filter,
2505       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2506           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2507  WHERE Client.ClientId=Job.ClientId
2508  AND Job.JobId = $jobid
2509 ";
2510
2511     my $row = $self->dbh_selectrow_hashref($query) ;
2512
2513     # display all volumes associate with this job
2514     $query="
2515 SELECT Media.VolumeName as volumename
2516 FROM Job,Media,JobMedia
2517 WHERE Job.JobId = $jobid
2518  AND JobMedia.JobId=Job.JobId
2519  AND JobMedia.MediaId=Media.MediaId
2520 ";
2521
2522     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2523
2524     $row->{volumes} = [ values %$all ] ;
2525     $row->{wiki_url} = $self->{info}->{wiki_url};
2526
2527     $self->display($row, "display_job_zoom.tpl");
2528 }
2529
2530 sub display_job_group
2531 {
2532     my ($self, %arg) = @_;
2533     $self->can_do('r_view_job');
2534
2535     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2536
2537     my ($where, undef) = $self->get_param('client_groups',
2538                                           'level',
2539                                           'pools');
2540     my $filter = $self->get_client_group_filter();
2541     my $query =
2542 "
2543 SELECT client_group_name AS client_group_name,
2544        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2545        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2546        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2547        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2548        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2549        COALESCE(jobok.duration, '0:0:0') AS duration
2550
2551 FROM client_group $filter LEFT JOIN (
2552     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2553            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2554            SUM(JobErrors) AS joberrors,
2555            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2556                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2557                         AS duration
2558
2559     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2560              JOIN client_group USING (client_group_id)
2561
2562     WHERE Type IN ('B', 'R') AND JobStatus IN ('T', 'W')
2563     $where
2564     $limit
2565 ) AS jobok USING (client_group_name) LEFT JOIN
2566
2567 (
2568     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2569            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2570            SUM(JobErrors) AS joberrors
2571     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2572              JOIN client_group USING (client_group_id)
2573
2574     WHERE Type IN ('B', 'R') AND JobStatus IN ('f','E', 'A')
2575     $where
2576     $limit
2577 ) AS joberr USING (client_group_name)
2578
2579     ";
2580
2581     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2582
2583     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2584
2585     $self->debug($rep);
2586     $self->display($rep, "display_job_group.tpl");
2587 }
2588
2589 sub display_media
2590 {
2591     my ($self, %arg) = @_ ;
2592     $self->can_do('r_view_media');
2593
2594     my ($limit, $label) = $self->get_limit(%arg);
2595     my ($where, %elt) = $self->get_param('pools',
2596                                          'mediatypes',
2597                                          'volstatus',
2598                                          'locations');
2599
2600     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2601
2602     if ($arg->{jmedias}) {
2603         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2604     }
2605     if ($arg->{qre_media}) {
2606         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2607     }
2608     if ($arg->{expired}) {
2609         $where = "
2610         AND VolStatus IN ('Full', 'Used')
2611         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2612                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2613             ) < $self->{sql}->{NOW}  " . $where ;
2614     }
2615
2616     my $query="
2617 SELECT Media.VolumeName  AS volumename,
2618        Media.VolBytes    AS volbytes,
2619        Media.VolStatus   AS volstatus,
2620        Media.MediaType   AS mediatype,
2621        Media.InChanger   AS online,
2622        Media.LastWritten AS lastwritten,
2623        Location.Location AS location,
2624        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2625        Pool.Name         AS poolname,
2626        $self->{sql}->{FROM_UNIXTIME}(
2627           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2628         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2629        ) AS expire
2630 FROM      Pool, Media
2631 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2632 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2633                   Media.MediaType     AS MediaType
2634            FROM Media
2635           WHERE Media.VolStatus = 'Full'
2636           GROUP BY Media.MediaType
2637            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2638
2639 WHERE Media.PoolId=Pool.PoolId
2640 $where
2641 $limit
2642 ";
2643
2644     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2645
2646     $self->display({ ID => $cur_id++,
2647                      Pool => $elt{pool},
2648                      Location => $elt{location},
2649                      Media => [ values %$all ],
2650                    },
2651                    "display_media.tpl");
2652 }
2653
2654 sub display_allmedia
2655 {
2656     my ($self) = @_ ;
2657
2658     my $pool = $self->get_form('db_pools');
2659
2660     foreach my $name (@{ $pool->{db_pools} }) {
2661         CGI::param('pool', $name->{name});
2662         $self->display_media();
2663     }
2664 }
2665
2666 sub display_media_zoom
2667 {
2668     my ($self) = @_ ;
2669
2670     my $media = $self->get_form('jmedias');
2671
2672     unless ($media->{jmedias}) {
2673         return $self->error("Can't get media selection");
2674     }
2675
2676     my $query="
2677 SELECT InChanger     AS online,
2678        Media.Enabled AS enabled,
2679        VolBytes      AS nb_bytes,
2680        VolumeName    AS volumename,
2681        VolStatus     AS volstatus,
2682        VolMounts     AS nb_mounts,
2683        Media.VolUseDuration   AS voluseduration,
2684        Media.MaxVolJobs AS maxvoljobs,
2685        Media.MaxVolFiles AS maxvolfiles,
2686        Media.MaxVolBytes AS maxvolbytes,
2687        VolErrors     AS nb_errors,
2688        Pool.Name     AS poolname,
2689        Location.Location AS location,
2690        Media.Recycle AS recycle,
2691        Media.VolRetention AS volretention,
2692        Media.LastWritten  AS lastwritten,
2693        Media.VolReadTime/1000000  AS volreadtime,
2694        Media.VolWriteTime/1000000 AS volwritetime,
2695        Media.RecycleCount AS recyclecount,
2696        Media.Comment      AS comment,
2697        $self->{sql}->{FROM_UNIXTIME}(
2698           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2699         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2700        ) AS expire
2701  FROM Pool,
2702       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2703  WHERE Pool.PoolId = Media.PoolId
2704  AND VolumeName IN ($media->{jmedias})
2705 ";
2706
2707     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2708
2709     foreach my $media (values %$all) {
2710         my $mq = $self->dbh_quote($media->{volumename});
2711
2712         $query = "
2713 SELECT DISTINCT Job.JobId AS jobid,
2714                 Job.Name  AS name,
2715                 Job.StartTime AS starttime,
2716                 Job.Type  AS type,
2717                 Job.Level AS level,
2718                 Job.JobFiles AS files,
2719                 Job.JobBytes AS bytes,
2720                 Job.jobstatus AS status
2721  FROM Media,JobMedia,Job
2722  WHERE Media.VolumeName=$mq
2723  AND Media.MediaId=JobMedia.MediaId
2724  AND JobMedia.JobId=Job.JobId
2725 ";
2726
2727         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2728
2729         $query = "
2730 SELECT LocationLog.Date    AS date,
2731        Location.Location   AS location,
2732        LocationLog.Comment AS comment
2733  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2734  WHERE Media.MediaId = LocationLog.MediaId
2735    AND Media.VolumeName = $mq
2736 ";
2737
2738         my $logtxt = '';
2739         my $log = $self->dbh_selectall_arrayref($query) ;
2740         if ($log) {
2741             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2742         }
2743
2744         $self->display({ jobs => [ values %$jobs ],
2745                          LocationLog => $logtxt,
2746                          %$media },
2747                        "display_media_zoom.tpl");
2748     }
2749 }
2750
2751 sub location_edit
2752 {
2753     my ($self) = @_ ;
2754     $self->can_do('r_location_mgnt');
2755
2756     my $loc = $self->get_form('qlocation');
2757     unless ($loc->{qlocation}) {
2758         return $self->error("Can't get location");
2759     }
2760
2761     my $query = "
2762 SELECT Location.Location AS location,
2763        Location.Cost   AS cost,
2764        Location.Enabled AS enabled
2765 FROM Location
2766 WHERE Location.Location = $loc->{qlocation}
2767 ";
2768
2769     my $row = $self->dbh_selectrow_hashref($query);
2770     $row->{enabled} = human_enabled($row->{enabled});
2771     $self->display({ ID => $cur_id++,
2772                      %$row }, "location_edit.tpl") ;
2773 }
2774
2775 sub location_save
2776 {
2777     my ($self) = @_ ;
2778     $self->can_do('r_location_mgnt');
2779
2780     my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2781     unless ($arg->{qlocation}) {
2782         return $self->error("Can't get location");
2783     }
2784     unless ($arg->{qnewlocation}) {
2785         return $self->error("Can't get new location name");
2786     }
2787     unless ($arg->{cost}) {
2788         return $self->error("Can't get new cost");
2789     }
2790
2791     my $enabled = from_human_enabled($arg->{enabled});
2792
2793     my $query = "
2794 UPDATE Location SET Cost     = $arg->{cost},
2795                     Location = $arg->{qnewlocation},
2796                     Enabled   = $enabled
2797 WHERE Location.Location = $arg->{qlocation}
2798 ";
2799
2800     $self->dbh_do($query);
2801
2802     $self->location_display();
2803 }
2804
2805 sub location_del
2806 {
2807     my ($self) = @_ ;
2808     $self->can_do('r_location_mgnt');
2809
2810     my $arg = $self->get_form(qw/qlocation/) ;
2811
2812     unless ($arg->{qlocation}) {
2813         return $self->error("Can't get location");
2814     }
2815
2816     my $query = "
2817 SELECT count(Media.MediaId) AS nb
2818   FROM Media INNER JOIN Location USING (LocationID)
2819 WHERE Location = $arg->{qlocation}
2820 ";
2821
2822     my $res = $self->dbh_selectrow_hashref($query);
2823
2824     if ($res->{nb}) {
2825         return $self->error("Sorry, the location must be empty");
2826     }
2827
2828     $query = "
2829 DELETE FROM Location WHERE Location = $arg->{qlocation}
2830 ";
2831
2832     $self->dbh_do($query);
2833
2834     $self->location_display();
2835 }
2836
2837 sub location_add
2838 {
2839     my ($self) = @_ ;
2840     $self->can_do('r_location_mgnt');
2841
2842     my $arg = $self->get_form(qw/qlocation cost/) ;
2843
2844     unless ($arg->{qlocation}) {
2845         $self->display({}, "location_add.tpl");
2846         return 1;
2847     }
2848     unless ($arg->{cost}) {
2849         return $self->error("Can't get new cost");
2850     }
2851
2852     my $enabled = CGI::param('enabled') || '';
2853     $enabled = from_human_enabled($enabled);
2854
2855     my $query = "
2856 INSERT INTO Location (Location, Cost, Enabled)
2857        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2858 ";
2859
2860     $self->dbh_do($query);
2861
2862     $self->location_display();
2863 }
2864
2865 sub location_display
2866 {
2867     my ($self) = @_ ;
2868
2869     my $query = "
2870 SELECT Location.Location AS location,
2871        Location.Cost     AS cost,
2872        Location.Enabled  AS enabled,
2873        (SELECT count(Media.MediaId)
2874          FROM Media
2875         WHERE Media.LocationId = Location.LocationId
2876        ) AS volnum
2877 FROM Location
2878 ";
2879
2880     my $location = $self->dbh_selectall_hashref($query, 'location');
2881
2882     $self->display({ ID => $cur_id++,
2883                      Locations => [ values %$location ] },
2884                    "display_location.tpl");
2885 }
2886
2887 sub update_location
2888 {
2889     my ($self) = @_ ;
2890
2891     my $media = $self->get_selected_media_location();
2892     unless ($media) {
2893         return ;
2894     }
2895
2896     my $arg = $self->get_form('db_locations', 'qnewlocation');
2897
2898     $self->display({ email  => $self->{info}->{email_media},
2899                      %$arg,
2900                      media => [ values %$media ],
2901                    },
2902                    "update_location.tpl");
2903 }
2904
2905 ###########################################################
2906
2907 sub client_save
2908 {
2909     my ($self) = @_;
2910     my $arg = $self->get_form(qw/jclient_groups qclient/);
2911
2912     unless ($arg->{qclient}) {
2913         return $self->error("Can't get client name");
2914     }
2915
2916     $self->can_do('r_group_mgnt');
2917
2918     my $f1 = $self->get_client_filter();
2919     my $f2 = $self->get_client_group_filter();
2920
2921     $self->{dbh}->begin_work();
2922
2923     my $query = "
2924 DELETE FROM client_group_member
2925       WHERE ClientId IN
2926            (SELECT ClientId
2927               FROM Client $f1
2928              WHERE Client.Name = $arg->{qclient})
2929 ";
2930     $self->dbh_do($query);
2931
2932     if ($arg->{jclient_groups}) {
2933         $query = "
2934  INSERT INTO client_group_member (client_group_id, ClientId)
2935     (SELECT client_group_id, (SELECT ClientId
2936                 FROM Client $f1
2937                WHERE Name = $arg->{qclient})
2938        FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
2939     )
2940 ";
2941         $self->dbh_do($query);
2942     }
2943
2944     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2945
2946     $self->display_clients();
2947 }
2948
2949 sub groups_edit
2950 {
2951     my ($self) = @_;
2952     my $grp = $self->get_form(qw/qclient_group db_clients/);
2953
2954     unless ($grp->{qclient_group}) {
2955         $self->can_do('r_group_mgnt');
2956         $self->display({ ID => $cur_id++,
2957                          client_group => "''",
2958                          %$grp,
2959                      }, "groups_edit.tpl");
2960         return;
2961     }
2962
2963     unless ($self->cant_do('r_group_mgnt')) {
2964         $self->can_do('r_view_group');
2965     }
2966
2967     my $query = "
2968 SELECT Name AS name
2969   FROM Client JOIN client_group_member using (ClientId)
2970               JOIN client_group using (client_group_id)
2971 WHERE client_group_name = $grp->{qclient_group}
2972 ";
2973
2974     my $row = $self->dbh_selectall_hashref($query, "name");
2975     $self->debug($row);
2976     $self->display({ ID => $cur_id++,
2977                      client_group => $grp->{qclient_group},
2978                      %$grp,
2979                      client_group_member => [ values %$row]},
2980                    "groups_edit.tpl");
2981 }
2982
2983 sub groups_save
2984 {
2985     my ($self) = @_;
2986     $self->can_do('r_group_mgnt');
2987
2988     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
2989     if (!$arg->{qcomment}) {
2990         $arg->{qcomment} = "''";
2991     }
2992
2993     if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2994         my $query = "
2995 INSERT INTO client_group (client_group_name, comment)
2996 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
2997 ";
2998         $self->dbh_do($query);
2999         $arg->{qclient_group} = $arg->{qnewgroup};
3000     }
3001
3002     unless ($arg->{qclient_group}) {
3003         return $self->error("Can't get groups");
3004     }
3005
3006     $self->{dbh}->begin_work();
3007
3008     my $query = "
3009 DELETE FROM client_group_member
3010       WHERE client_group_id IN
3011            (SELECT client_group_id
3012               FROM client_group
3013              WHERE client_group_name = $arg->{qclient_group})
3014 ";
3015     $self->dbh_do($query);
3016
3017     if ($arg->{jclients}) {
3018         $query = "
3019     INSERT INTO client_group_member (ClientId, client_group_id)
3020        (SELECT  ClientId,
3021                 (SELECT client_group_id
3022                    FROM client_group
3023                   WHERE client_group_name = $arg->{qclient_group})
3024           FROM Client WHERE Name IN ($arg->{jclients})
3025        )
3026 ";
3027         $self->dbh_do($query);
3028     }
3029     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
3030         $query = "
3031 UPDATE client_group
3032    SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
3033  WHERE client_group_name = $arg->{qclient_group}
3034 ";
3035
3036         $self->dbh_do($query);
3037     }
3038
3039     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
3040
3041     $self->display_groups();
3042 }
3043
3044 sub groups_del
3045 {
3046     my ($self) = @_;
3047     $self->can_do('r_group_mgnt');
3048
3049     my $arg = $self->get_form(qw/qclient_group/);
3050
3051     unless ($arg->{qclient_group}) {
3052         return $self->error("Can't get groups");
3053     }
3054
3055     $self->{dbh}->begin_work();
3056
3057     $self->dbh_do("
3058 DELETE FROM client_group_member
3059       WHERE client_group_id IN
3060            (SELECT client_group_id
3061               FROM client_group
3062              WHERE client_group_name = $arg->{qclient_group})");
3063
3064     $self->dbh_do("
3065 DELETE FROM bweb_client_group_acl
3066       WHERE client_group_id IN
3067            (SELECT client_group_id
3068               FROM client_group
3069              WHERE client_group_name = $arg->{qclient_group})");
3070
3071     $self->dbh_do("
3072 DELETE FROM client_group
3073       WHERE client_group_name = $arg->{qclient_group}");
3074
3075     $self->{dbh}->commit();
3076     $self->display_groups();
3077 }
3078
3079 sub display_groups
3080 {
3081     my ($self) = @_;
3082     my $arg;
3083
3084     if ($self->cant_do('r_group_mgnt')) {
3085         $arg = $self->get_form(qw/db_client_groups filter/) ;
3086     } else {
3087         $arg = $self->get_form(qw/db_client_groups/) ;
3088     }
3089
3090     if ($self->{dbh}->errstr) {
3091         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3092     }
3093
3094     $self->debug($arg);
3095
3096     $self->display({ ID => $cur_id++,
3097                      %$arg},
3098                    "display_groups.tpl");
3099 }
3100
3101 ###########################################################
3102
3103 sub get_roles
3104 {
3105     my ($self) = @_;
3106     if (not $self->{info}->{enable_security}) {
3107         return 1;
3108     }
3109     if (!$self->{loginname}) {
3110         $self->error("Can't get your login name");
3111         $self->display_end();
3112         exit 0;
3113     }
3114     # admin is a special user that can do everything
3115     if ($self->{loginname} eq 'admin') {
3116         return 1;
3117     }
3118     # already fill
3119     if (defined $self->{security}) {
3120         return 1;
3121     }
3122     $self->{security} = {};
3123     my $u = $self->dbh_quote($self->{loginname});
3124
3125     my $query = "
3126  SELECT use_acl, rolename, tpl
3127   FROM bweb_user
3128        JOIN bweb_role_member USING (userid)
3129        JOIN bweb_role USING (roleid)
3130  WHERE username = $u
3131 ";
3132     my $rows = $self->dbh_selectall_arrayref($query);
3133     # do cache with this role
3134     if (!$rows or !scalar(@$rows)) {
3135         $self->error("Can't get $self->{loginname}'s roles");
3136         $self->display_end();
3137         exit 0;
3138     }
3139     foreach my $r (@$rows) {
3140         $self->{security}->{$r->[1]}=1;
3141     }
3142     $self->{security}->{use_acl} = $rows->[0]->[0];
3143     if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3144         $self->{lang} = $1;
3145     }
3146     return 1;
3147 }
3148
3149 sub can_view_client
3150 {
3151     my ($self, $client) = @_;
3152
3153     my $filter = $self->get_client_filter();
3154     if (!$filter) {
3155         return 1;
3156     }
3157     my $cont = $self->dbh_selectrow_hashref("
3158  SELECT 1
3159    FROM Client $filter
3160   WHERE Name = '$client'
3161 ");
3162     return defined $cont;
3163 }
3164
3165 sub cant_do
3166 {
3167     my ($self, $action) = @_;
3168     # is security enabled in configuration ?
3169     if (not $self->{info}->{enable_security}) {
3170         return 0
3171     }
3172     # admin is a special user that can do everything
3173     if ($self->{loginname} eq 'admin') {
3174         return 0;
3175     }
3176     # must be logged
3177     if (!$self->{loginname}) {
3178         $self->{error} = "Can't do $action, your are not logged. " .
3179             "Check security with your administrator";
3180         return 1;
3181     }
3182     if (!$self->get_roles()) {
3183         return 0;
3184     }
3185     if (!$self->{security}->{$action}) {
3186         $self->{error} =
3187             "$self->{loginname} sorry, but this action ($action) " .
3188             "is not permited. " .
3189             "Check security with your administrator";
3190         return 1;
3191     }
3192     return 0;
3193 }
3194
3195 # make like an assert (program die)
3196 sub can_do
3197 {
3198     my ($self, $action) = @_;
3199     if ($self->cant_do($action)) {
3200         $self->error($self->{error});
3201         $self->display_end();
3202         exit 0;
3203     }
3204     return 1;
3205 }
3206
3207 sub use_filter
3208 {
3209     my ($self) = @_;
3210
3211     if (!$self->{info}->{enable_security} or
3212         !$self->{info}->{enable_security_acl})
3213     {
3214         return 0 ;
3215     }
3216
3217     if ($self->get_roles()) {
3218         return $self->{security}->{use_acl};
3219     } else {
3220         return 1;
3221     }
3222 }
3223
3224 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3225 sub get_client_filter
3226 {
3227     my ($self, $login) = @_;
3228     my $u;
3229     if ($login) {
3230         $u = $self->dbh_quote($login);
3231     } elsif ($self->use_filter()) {
3232         $u = $self->dbh_quote($self->{loginname});
3233     } else {
3234         return '';
3235     }
3236     return "
3237  JOIN (SELECT ClientId FROM client_group_member
3238    JOIN client_group USING (client_group_id)
3239    JOIN bweb_client_group_acl USING (client_group_id)
3240    JOIN bweb_user USING (userid)
3241    WHERE bweb_user.username = $u
3242  ) AS filter USING (ClientId)";
3243 }
3244
3245 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3246 sub get_client_group_filter
3247 {
3248     my ($self, $login) = @_;
3249     my $u;
3250     if ($login) {
3251         $u = $self->dbh_quote($login);
3252     } elsif ($self->use_filter()) {
3253         $u = $self->dbh_quote($self->{loginname});
3254     } else {
3255         return '';
3256     }
3257     return "
3258  JOIN (SELECT client_group_id
3259          FROM bweb_client_group_acl
3260          JOIN bweb_user USING (userid)
3261    WHERE bweb_user.username = $u
3262  ) AS filter USING (client_group_id)";
3263 }
3264
3265 # role and username have to be quoted before
3266 # role and username can be a quoted list
3267 sub revoke
3268 {
3269     my ($self, $role, $username) = @_;
3270     $self->can_do("r_user_mgnt");
3271
3272     my $nb = $self->dbh_do("
3273  DELETE FROM bweb_role_member
3274        WHERE roleid = (SELECT roleid FROM bweb_role
3275                         WHERE rolename IN ($role))
3276          AND userid = (SELECT userid FROM bweb_user
3277                         WHERE username IN ($username))");
3278     return $nb;
3279 }
3280
3281 # role and username have to be quoted before
3282 # role and username can be a quoted list
3283 sub grant
3284 {
3285     my ($self, $role, $username) = @_;
3286     $self->can_do("r_user_mgnt");
3287
3288     my $nb = $self->dbh_do("
3289    INSERT INTO bweb_role_member (roleid, userid)
3290      SELECT roleid, userid FROM bweb_role, bweb_user
3291       WHERE rolename IN ($role)
3292         AND username IN ($username)
3293      ");
3294     return $nb;
3295 }
3296
3297 # role and username have to be quoted before
3298 # role and username can be a quoted list
3299 sub grant_like
3300 {
3301     my ($self, $copy, $user) = @_;
3302     $self->can_do("r_user_mgnt");
3303
3304     my $nb = $self->dbh_do("
3305   INSERT INTO bweb_role_member (roleid, userid)
3306    SELECT roleid, a.userid
3307      FROM bweb_user AS a, bweb_role_member
3308      JOIN bweb_user USING (userid)
3309     WHERE bweb_user.username = $copy
3310       AND a.username = $user");
3311     return $nb;
3312 }
3313
3314 # username can be a join quoted list of usernames
3315 sub revoke_all
3316 {
3317     my ($self, $username) = @_;
3318     $self->can_do("r_user_mgnt");
3319
3320     $self->dbh_do("
3321    DELETE FROM bweb_role_member
3322          WHERE userid IN (
3323            SELECT userid
3324              FROM bweb_user
3325             WHERE username in ($username))");
3326     $self->dbh_do("
3327 DELETE FROM bweb_client_group_acl
3328  WHERE userid IN (
3329   SELECT userid
3330     FROM bweb_user
3331    WHERE username IN ($username))");
3332
3333 }
3334
3335 sub users_del
3336 {
3337     my ($self) = @_;
3338     $self->can_do("r_user_mgnt");
3339
3340     my $arg = $self->get_form(qw/jusernames/);
3341
3342     unless ($arg->{jusernames}) {
3343         return $self->error("Can't get user");
3344     }
3345
3346     $self->{dbh}->begin_work();
3347     {
3348         $self->revoke_all($arg->{jusernames});
3349         $self->dbh_do("
3350 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3351     }
3352     $self->{dbh}->commit();
3353
3354     $self->display_users();
3355 }
3356
3357 sub users_add
3358 {
3359     my ($self) = @_;
3360     $self->can_do("r_user_mgnt");
3361
3362     # we don't quote username directly to check that it is conform
3363     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3364                                  lang qcopy_username jclient_groups/) ;
3365
3366     if (not $arg->{qcreate}) {
3367         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3368         $self->display($arg, "display_user.tpl");
3369         return 1;
3370     }
3371
3372     my $u = $self->dbh_quote($arg->{username});
3373
3374     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3375
3376     if (!$arg->{qpasswd}) {
3377         $arg->{qpasswd} = "''";
3378     }
3379     if (!$arg->{qcomment}) {
3380         $arg->{qcomment} = "''";
3381     }
3382
3383     # will fail if user already exists
3384     # UPDATE with mysql dbi does not return if update is ok
3385     ($self->dbh_do("
3386   UPDATE bweb_user
3387      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3388          use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3389    WHERE username = $u")
3390 #     and (! $self->dbh_is_mysql() )
3391      ) and
3392     $self->dbh_do("
3393   INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3394         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3395                 $arg->{qcomment}, '$arg->{lang}')");
3396
3397     $self->{dbh}->begin_work();
3398     {
3399         $self->revoke_all($u);
3400
3401         if ($arg->{qcopy_username}) {
3402             $self->grant_like($arg->{qcopy_username}, $u);
3403         } else {
3404             $self->grant($arg->{jrolenames}, $u);
3405         }
3406
3407         if ($arg->{jclient_groups}) {
3408             $self->dbh_do("
3409 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3410  SELECT client_group_id, userid
3411    FROM client_group, bweb_user
3412   WHERE client_group_name IN ($arg->{jclient_groups})
3413     AND username = $u
3414 ");
3415         }
3416     }
3417     $self->{dbh}->commit();
3418
3419     $self->display_users();
3420 }
3421
3422 # TODO: we miss a matrix with all user/roles
3423 sub display_users
3424 {
3425     my ($self) = @_;
3426     $self->can_do("r_user_mgnt");
3427
3428     my $arg = $self->get_form(qw/db_usernames/) ;
3429
3430     if ($self->{dbh}->errstr) {
3431         return $self->error("Can't use users with bweb, read INSTALL to enable them");
3432     }
3433
3434     $self->display({ ID => $cur_id++,
3435                      %$arg},
3436                    "display_users.tpl");
3437 }
3438
3439 sub display_user
3440 {
3441     my ($self) = @_;
3442     $self->can_do("r_user_mgnt");
3443
3444     my $arg = $self->get_form('username');
3445     my $user = $self->dbh_quote($arg->{username});
3446
3447     my $userp = $self->dbh_selectrow_hashref("
3448    SELECT username, passwd, comment, use_acl, tpl
3449      FROM bweb_user
3450     WHERE username = $user
3451 ");
3452     if (!$userp) {
3453         return $self->error("Can't find $user in catalog");
3454     }
3455     my $filter = $self->get_client_group_filter($arg->{username});
3456     my $scg = $self->dbh_selectall_hashref("
3457  SELECT client_group_name AS name
3458    FROM client_group $filter
3459 ", 'name');
3460
3461 #  rolename  | userid
3462 #------------+--------
3463 # cancel_job |      0
3464 # restore    |      0
3465 # run_job    |      1
3466
3467     my $role = $self->dbh_selectall_hashref("
3468 SELECT rolename, max(here) AS userid FROM (
3469         SELECT rolename, 1 AS here
3470           FROM bweb_user
3471           JOIN bweb_role_member USING (userid)
3472           JOIN bweb_role USING (roleid)
3473           WHERE username = $user
3474        UNION ALL
3475        SELECT rolename, 0
3476          FROM bweb_role
3477 ) AS temp
3478 GROUP by rolename", 'rolename');
3479
3480     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3481
3482     $self->display({
3483         db_usernames => $arg->{db_usernames},
3484         username => $userp->{username},
3485         comment => $userp->{comment},
3486         passwd => $userp->{passwd},
3487         lang => $userp->{tpl},
3488         use_acl => $userp->{use_acl},
3489         db_client_groups => $arg->{db_client_groups},
3490         client_group => [ values %$scg ],
3491         db_roles => [ values %$role],
3492     }, "display_user.tpl");
3493 }
3494
3495
3496 ###########################################################
3497
3498 sub get_media_max_size
3499 {
3500     my ($self, $type) = @_;
3501     my $query =
3502 "SELECT avg(VolBytes) AS size
3503   FROM Media
3504  WHERE Media.VolStatus = 'Full'
3505    AND Media.MediaType = '$type'
3506 ";
3507
3508     my $res = $self->selectrow_hashref($query);
3509
3510     if ($res) {
3511         return $res->{size};
3512     } else {
3513         return 0;
3514     }
3515 }
3516
3517 sub update_media
3518 {
3519     my ($self) = @_ ;
3520
3521     my $media = $self->get_form('qmedia');
3522
3523     unless ($media->{qmedia}) {
3524         return $self->error("Can't get media");
3525     }
3526
3527     my $query = "
3528 SELECT Media.Slot         AS slot,
3529        PoolMedia.Name     AS poolname,
3530        Media.VolStatus    AS volstatus,
3531        Media.InChanger    AS inchanger,
3532        Location.Location  AS location,
3533        Media.VolumeName   AS volumename,
3534        Media.MaxVolBytes  AS maxvolbytes,
3535        Media.MaxVolJobs   AS maxvoljobs,
3536        Media.MaxVolFiles  AS maxvolfiles,
3537        Media.VolUseDuration AS voluseduration,
3538        Media.VolRetention AS volretention,
3539        Media.Comment      AS comment,
3540        PoolRecycle.Name   AS poolrecycle,
3541        Media.Enabled      AS enabled
3542
3543 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3544            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3545            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3546
3547 WHERE Media.VolumeName = $media->{qmedia}
3548 ";
3549
3550     my $row = $self->dbh_selectrow_hashref($query);
3551     $row->{volretention} = human_sec($row->{volretention});
3552     $row->{voluseduration} = human_sec($row->{voluseduration});
3553     $row->{enabled} = human_enabled($row->{enabled});
3554
3555     my $elt = $self->get_form(qw/db_pools db_locations/);
3556
3557     $self->display({
3558         %$elt,
3559         %$row,
3560     }, "update_media.tpl");
3561 }
3562
3563 sub save_location
3564 {
3565     my ($self) = @_ ;
3566     $self->can_do('r_media_mgnt');
3567
3568     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3569
3570     unless ($arg->{jmedias}) {
3571         return $self->error("Can't get selected media");
3572     }
3573
3574     unless ($arg->{qnewlocation}) {
3575         return $self->error("Can't get new location");
3576     }
3577
3578     my $query = "
3579  UPDATE Media
3580      SET LocationId = (SELECT LocationId
3581                        FROM Location
3582                        WHERE Location = $arg->{qnewlocation})
3583      WHERE Media.VolumeName IN ($arg->{jmedias})
3584 ";
3585
3586     my $nb = $self->dbh_do($query);
3587
3588     print "$nb media updated, you may have to update your autochanger.";
3589
3590     $self->display_media();
3591 }
3592
3593 sub location_change
3594 {
3595     my ($self) = @_ ;
3596     $self->can_do('r_media_mgnt');
3597
3598     my $media = $self->get_selected_media_location();
3599     unless ($media) {
3600         return $self->error("Can't get media selection");
3601     }
3602     my $newloc = CGI::param('newlocation');
3603
3604     my $user = CGI::param('user') || 'unknown';
3605     my $comm = CGI::param('comment') || '';
3606     $comm = $self->dbh_quote("$user: $comm");
3607
3608     my $arg = $self->get_form('enabled');
3609     my $en = from_human_enabled($arg->{enabled});
3610     my $b = $self->get_bconsole();
3611
3612     my $query;
3613     foreach my $vol (keys %$media) {
3614         $query = "
3615 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3616  SELECT $self->{sql}->{NOW}, $comm, Media.MediaId, Location.LocationId,
3617         $en, VolStatus
3618    FROM Media, Location
3619   WHERE Media.VolumeName = '$vol'
3620     AND Location.Location = '$media->{$vol}->{location}'
3621 ";
3622         $self->dbh_do($query);
3623         $self->debug($query);
3624         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3625     }
3626     $b->close();
3627
3628     my $q = new CGI;
3629     $q->param('action', 'update_location');
3630     my $url = $q->url(-full => 1, -query=>1);
3631
3632     $self->display({ email  => $self->{info}->{email_media},
3633                      url => $url,
3634                      newlocation => $newloc,
3635                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3636                      media => [ values %$media ],
3637                    },
3638                    "change_location.tpl");
3639
3640 }
3641
3642 sub display_client_stats
3643 {
3644     my ($self, %arg) = @_ ;
3645     $self->can_do('r_view_stat');
3646
3647     my $client = $self->dbh_quote($arg{clientname});
3648     # get security filter
3649     my $filter = $self->get_client_filter();
3650
3651     my ($limit, $label) = $self->get_limit(%arg);
3652     my $query = "
3653 SELECT
3654     count(Job.JobId)     AS nb_jobs,
3655     sum(Job.JobBytes)    AS nb_bytes,
3656     sum(Job.JobErrors)   AS nb_err,
3657     sum(Job.JobFiles)    AS nb_files,
3658     Client.Name          AS clientname
3659 FROM Job JOIN Client USING (ClientId) $filter
3660 WHERE
3661     Client.Name = $client
3662     $limit
3663 GROUP BY Client.Name
3664 ";
3665
3666     my $row = $self->dbh_selectrow_hashref($query);
3667
3668     $row->{ID} = $cur_id++;
3669     $row->{label} = $label;
3670     $row->{grapharg} = "client";
3671     $row->{age} = $arg{age};
3672
3673     $self->display($row, "display_client_stats.tpl");
3674 }
3675
3676
3677 sub _display_group_stats
3678 {
3679     my ($self, %arg) = @_ ;
3680
3681     my $carg = $self->get_form(qw/qclient_group/);
3682
3683     unless ($carg->{qclient_group}) {
3684         return $self->error("Can't get group");
3685     }
3686     my $jobt = $self->get_stat_table();
3687     my ($limit, $label) = $self->get_limit(%arg);
3688
3689     my $query = "
3690 SELECT
3691     count(Job.JobId)     AS nb_jobs,
3692     sum(Job.JobBytes)    AS nb_bytes,
3693     sum(Job.JobErrors)   AS nb_err,
3694     sum(Job.JobFiles)    AS nb_files,
3695     client_group.client_group_name  AS clientname
3696 FROM $jobt AS Job
3697          JOIN Client USING (ClientId)
3698          JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3699          JOIN client_group USING (client_group_id)
3700 WHERE
3701     client_group.client_group_name = $carg->{qclient_group}
3702     $limit
3703 GROUP BY client_group.client_group_name
3704 ";
3705
3706     my $row = $self->dbh_selectrow_hashref($query);
3707
3708     $row->{ID} = $cur_id++;
3709     $row->{label} = $label;
3710     $row->{grapharg} = "client_group";
3711
3712     $self->display($row, "display_client_stats.tpl");
3713 }
3714
3715 # [ name, num, value, joberrors, nb_job ] =>
3716 # {  items =>
3717 #      [ { name => 'ALL',
3718 #          events => [ { num => 1, label => '2007-01',
3719 #                        value => 'T', title => 10 },
3720 #                      { num => 2, label => '2007-02',
3721 #                        value => 'R', title => 11 },
3722 #                     ]
3723 #         },
3724 #         { name => 'Other',
3725 #            ...
3726 #       ]
3727 # };
3728 sub make_overview_tab
3729 {
3730     my ($self, $q) = @_;
3731     my $ret = $self->dbh_selectall_arrayref($q);
3732     my @items;
3733     my $events=[];
3734     my $cur_name='';
3735     for my $elt (@$ret) {
3736         if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3737             push @items, { name => $cur_name, events => $events};
3738             $events = [];
3739         }
3740         $cur_name = $elt->[0];
3741         push @$events,
3742           { num => $elt->[1], status => $elt->[2],
3743             joberrors => $elt->[3], title => "$elt->[4] jobs", date => $elt->[5]};
3744     }
3745     push @items, { name => $cur_name, events => $events};
3746     return \@items;
3747 }
3748
3749 sub get_time_overview
3750 {
3751     my ($self, $arg) = @_; # want since et age from get_form();
3752     my $type = $arg->{type} || 'day';
3753     if ($type =~ /^(day|week|hour|month)$/) {
3754         $type = uc($1);
3755     } else {
3756         $arg->{type}='day';
3757         $type = 'DAY';
3758     }
3759     my $jobt = $self->get_stat_table();
3760     my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1, 2, 3, 4
3761     $stime1 =~ s/Job.StartTime/date/;
3762     my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3763
3764     my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3765                                            'age' => $arg->{age});
3766     return ($stime1, $stime2, $limit, $label, $jobt);
3767 }
3768
3769 #              lu ma me je ve sa di
3770 #  groupe1     v  v  x  w  v  v  v    overview
3771 #   |-- s1     v  v  v  v  v  v  v    overview_zoom
3772 #   |-- s2     v  v  x  v  v  v  v
3773 #   `-- s3     v  v  v  w  v  v  v
3774 sub display_overview_zoom
3775 {
3776     my ($self) = @_;
3777     $self->can_do('r_view_stat');
3778
3779     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3780     $arg->{type} = $arg->{type} || 'day';
3781
3782     if (!$arg->{jclient_groups}) {
3783         return $self->error("Can't get client_group selection");
3784     }
3785     my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3786     my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3787
3788     my $filter = $self->get_client_filter();
3789     my $q = "
3790 SELECT name, $stime1 AS num,
3791        JobStatus AS value, joberrors, nb_job, date
3792 FROM (
3793   SELECT $stime2        AS date,
3794          Client.Name    AS name,
3795          MAX(severity)  AS severity,
3796          COUNT(1)       AS nb_job,
3797          SUM(JobErrors) AS joberrors
3798     FROM $jobt AS Job
3799     JOIN client_group_member USING (ClientId)
3800     JOIN client_group        USING (client_group_id)
3801     JOIN Client              USING (ClientId)  $filter
3802     JOIN Status              USING (JobStatus)
3803    WHERE client_group_name IN ($arg->{jclient_groups})
3804      AND JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3805          $limit $filter2
3806    GROUP BY Client.Name, date
3807 ) AS sub JOIN Status USING (severity)
3808  ORDER BY name, date
3809 ";
3810     my $items = $self->make_overview_tab($q);
3811     $self->display({label => $label,
3812                     type => $arg->{type},
3813                     action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3814                     items => $items}, "overview.tpl");
3815 }
3816
3817 sub display_overview
3818 {
3819     my ($self) = @_ ;
3820     $self->can_do('r_view_stat');
3821
3822     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3823     $arg->{type} = $arg->{type} || 'day';
3824     my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3825     my $filter3 = $self->get_client_group_filter();
3826     my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3827
3828     my $q = "
3829 SELECT name, $stime1 AS num,
3830        JobStatus AS value, joberrors, nb_job, date
3831 FROM (
3832   SELECT $stime2        AS date,
3833          client_group_name AS name,
3834          MAX(severity)  AS severity,
3835          COUNT(1)       AS nb_job,
3836          SUM(JobErrors) AS joberrors
3837     FROM $jobt AS Job
3838     JOIN client_group_member USING (ClientId)
3839     JOIN client_group        USING (client_group_id) $filter3
3840     JOIN Status              USING (JobStatus)
3841    WHERE JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3842        $filter1 $filter2
3843    GROUP BY client_group_name, date
3844 ) AS sub JOIN Status USING (severity)
3845  ORDER BY name, date
3846 ";
3847     my $items = $self->make_overview_tab($q);
3848     $self->display({label=>$label,
3849                     type => $arg->{type},
3850                     action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3851                     items => $items}, "overview.tpl");
3852
3853 }
3854
3855 # poolname can be undef
3856 sub display_pool
3857 {
3858     my ($self, $poolname) = @_ ;
3859     $self->can_do('r_view_media');
3860
3861     my $whereA = '';
3862     my $whereW = '';
3863
3864     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3865     if ($arg->{jmediatypes}) {
3866         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3867         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3868     }
3869
3870 # TODO : afficher les tailles et les dates
3871
3872     my $query = "
3873 SELECT subq.volmax        AS volmax,
3874        subq.volnum        AS volnum,
3875        subq.voltotal      AS voltotal,
3876        Pool.Name          AS name,
3877        Pool.Recycle       AS recycle,
3878        Pool.VolRetention  AS volretention,
3879        Pool.VolUseDuration AS voluseduration,
3880        Pool.MaxVolJobs    AS maxvoljobs,
3881        Pool.MaxVolFiles   AS maxvolfiles,
3882        Pool.MaxVolBytes   AS maxvolbytes,
3883        subq.PoolId        AS PoolId,
3884        subq.MediaType     AS mediatype,
3885        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3886 FROM
3887   (
3888     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3889            count(Media.MediaId)  AS volnum,
3890            sum(Media.VolBytes)   AS voltotal,
3891            Media.PoolId          AS PoolId,
3892            Media.MediaType       AS MediaType
3893     FROM Media
3894     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3895                       Media.MediaType     AS MediaType
3896                FROM Media
3897               WHERE Media.VolStatus = 'Full'
3898               GROUP BY Media.MediaType
3899                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3900     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3901   ) AS subq
3902 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3903 $whereW
3904 ";
3905
3906     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3907
3908     $query = "
3909 SELECT Pool.Name AS name,
3910        sum(VolBytes) AS size
3911 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3912 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3913        $whereA
3914 GROUP BY Pool.Name;
3915 ";
3916     my $empty = $self->dbh_selectall_hashref($query, 'name');
3917
3918     foreach my $p (values %$all) {
3919         if ($p->{volmax} > 0) { # mysql returns 0.0000
3920             # we remove Recycled/Purged media from pool usage
3921             if (defined $empty->{$p->{name}}) {
3922                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3923             }
3924             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3925         } else {
3926             $p->{poolusage} = 0;
3927         }
3928
3929         $query = "
3930   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3931     FROM Media
3932    WHERE PoolId=$p->{poolid}
3933      AND Media.MediaType = '$p->{mediatype}'
3934          $whereA
3935 GROUP BY VolStatus
3936 ";
3937         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3938         foreach my $t (values %$content) {
3939             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3940         }
3941     }
3942
3943     $self->debug($all);
3944     $self->display({ ID => $cur_id++,
3945                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3946                      Pools => [ values %$all ]},
3947                    "display_pool.tpl");
3948 }
3949
3950 # With this function, we get an estimation of next jobfiles/jobbytes count
3951 sub get_estimate_query
3952 {
3953     my ($self, $mode, $job, $level) = @_;
3954     # get security filter
3955     my $filter = $self->get_client_filter();
3956
3957     my $query;
3958
3959     if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
3960         $query = "
3961 SELECT jobname AS jobname,
3962        0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
3963        COUNT(1) AS nb_jobbytes ";
3964     } else {
3965         # postgresql have functions that permit to handle lineal regression
3966         # in y=ax + b
3967         # REGR_SLOPE(Y,X) = get x
3968         # REGR_INTERCEPT(Y,X) = get b
3969         # and we need y when x=now()
3970         # CORR gives the correlation
3971         # (TODO: display progress bar only if CORR > 0.8)
3972         my $now = $btime;
3973         $query = "
3974 SELECT temp.jobname AS jobname,
3975        COALESCE(CORR(jobbytes,jobtdate),0) AS corr_jobbytes,
3976        ($now*REGR_SLOPE(jobbytes,jobtdate)
3977          + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
3978        COUNT(1) AS nb_jobbytes ";
3979     }
3980     # if it's a differential, we need to compare since the last full
3981     #
3982     #   F D D D F D D D      F I I I I D I I I
3983     # | #     # #     #    | #         #
3984     # | #   # # #   # #    | #         #
3985     # | # # # # # # # #    | # # # # # # # # #
3986     # +-----------------   +-------------------
3987     my $filter2='';
3988     if ($level eq 'D') {
3989         $filter2 = "
3990 AND Job.StartTime > (
3991  SELECT StartTime
3992    FROM Job
3993   WHERE Job.Name = '$job'
3994     AND Job.Level = 'F'
3995     AND Job.JobStatus IN ('T', 'W')
3996 ORDER BY Job.StartTime DESC LIMIT 1
3997 ) ";
3998     }
3999
4000     $query .=
4001 "
4002 FROM (
4003    SELECT Job.Name AS jobname,
4004           JobBytes AS jobbytes,
4005           JobTDate AS jobtdate
4006    FROM Job INNER JOIN Client USING (ClientId) $filter
4007    WHERE Job.Name = '$job'
4008      AND Job.Level = '$level'
4009      AND Job.JobStatus IN ('T', 'W')
4010      $filter2
4011    ORDER BY StartTime DESC
4012    LIMIT 4
4013 ) AS temp GROUP BY temp.jobname
4014 ";
4015
4016     if ($mode eq 'jobfiles') {
4017         $query =~ s/jobbytes/jobfiles/g;
4018         $query =~ s/JobBytes/JobFiles/g;
4019     }
4020     return $query;
4021 }
4022
4023 sub display_running_job
4024 {
4025     my ($self) = @_;
4026     return if $self->cant_do('r_view_running_job');
4027
4028     my $arg = $self->get_form('jobid');
4029
4030     return $self->error("Can't get jobid") unless ($arg->{jobid});
4031
4032     # get security filter
4033     my $filter = $self->get_client_filter();
4034
4035     my $query = "
4036 SELECT Client.Name AS name, Job.Name AS jobname,
4037        Job.Level AS level, Type AS type, JobStatus AS jobstatus
4038 FROM Job INNER JOIN Client USING (ClientId) $filter
4039 WHERE Job.JobId = $arg->{jobid}
4040 ";
4041
4042     my $row = $self->dbh_selectrow_hashref($query);
4043
4044     if ($row) {
4045         $arg->{client} = $row->{name};
4046     } else {
4047         return $self->error("Can't get client");
4048     }
4049
4050     my $status = $row->{jobstatus};
4051
4052     if ($status =~ /[TfAaEWD]/) {
4053         $self->display_job_zoom($arg->{jobid});
4054         $self->get_job_log();
4055         return;
4056     }
4057
4058     if ($row->{type} eq 'B') {
4059         # for jobfiles, we use only last Full backup. status client= returns
4060         # all files that have been checked
4061         my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
4062         my $query2 = $self->get_estimate_query('jobbytes',
4063                                                $row->{jobname}, $row->{level});
4064
4065         # LEFT JOIN because we always have a previous Full
4066         $query = "
4067 SELECT  corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
4068   FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
4069 ";
4070         $row = $self->dbh_selectrow_hashref($query);
4071
4072         if (!$row) {
4073             $row->{jobbytes} = $row->{jobfiles} = 0;
4074         }
4075     }
4076     if ($status =~ /[RBSmMsjlL]/) {
4077         my $cli = new Bweb::Client(name => $arg->{client});
4078         $cli->display_running_job($self, $arg->{jobid}, $row);
4079     }
4080     if ($arg->{jobid}) {
4081         $self->get_job_log();
4082     }
4083 }
4084
4085 sub display_running_jobs
4086 {
4087     my ($self, $display_action) = @_;
4088     return if $self->cant_do('r_view_running_job');
4089
4090     # get security filter
4091     my $filter = $self->get_client_filter();
4092
4093     my $query = "
4094 SELECT Job.JobId AS jobid,
4095        Job.Name  AS jobname,
4096        Job.Level     AS level,
4097        Job.StartTime AS starttime,
4098        Job.JobFiles  AS jobfiles,
4099        Job.JobBytes  AS jobbytes,
4100        Job.JobStatus AS jobstatus,
4101 $self->{sql}->{SEC_TO_TIME}($self->{sql}->{UNIX_TIMESTAMP}($self->{sql}->{NOW})
4102                           - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4103          AS duration,
4104        Client.Name AS clientname
4105 FROM Job INNER JOIN Client USING (ClientId) $filter
4106 WHERE
4107   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4108 ";
4109     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4110
4111     $self->display({ ID => $cur_id++,
4112                      display_action => $display_action,
4113                      Jobs => [ values %$all ]},
4114                    "running_job.tpl") ;
4115 }
4116
4117 sub display_group_stats
4118 {
4119     my ($self) = @_;
4120     my $arg = $self->get_form('age', 'since');
4121     return if $self->cant_do('r_view_stat');
4122
4123     my $filter = $self->get_client_group_filter();
4124
4125     my $jobt = $self->get_stat_table();
4126
4127     my ($limit, $label) = $self->get_limit(%$arg);
4128     my ($where, undef) = $self->get_param('client_groups', 'level');
4129
4130     my $query = "
4131 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_err, nb_resto
4132   FROM (
4133
4134     SELECT sum(JobBytes) AS nb_byte,
4135            sum(JobFiles) AS nb_file,
4136            count(1) AS nb_job, client_group_name
4137       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4138       JOIN client_group USING (client_group_id) $filter
4139      WHERE JobStatus IN ('T', 'W') AND Type IN ('M', 'B', 'g')
4140            $where $limit
4141     GROUP BY client_group_name ORDER BY client_group_name
4142
4143   ) AS T1 LEFT JOIN (
4144
4145     SELECT count(1) AS nb_err, client_group_name
4146       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4147       JOIN client_group USING (client_group_id)
4148      WHERE JobStatus IN ('E','e','f','A') AND Type = 'B'
4149            $where $limit
4150     GROUP BY client_group_name ORDER BY client_group_name
4151
4152   ) AS T3 USING (client_group_name) LEFT JOIN (
4153
4154     SELECT count(1) AS nb_resto, client_group_name
4155       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4156       JOIN client_group USING (client_group_id)
4157      WHERE JobStatus IN ('T','W') AND Type = 'R'
4158            $where $limit
4159     GROUP BY client_group_name ORDER BY client_group_name
4160
4161   ) AS T2 USING (client_group_name)
4162 ";
4163     $self->debug($query);
4164     my $all = $self->dbh_selectall_hashref($query, 'name') ;
4165     $self->debug($all);
4166
4167     $self->display({ ID => $cur_id++,
4168                      label => $label,
4169                      Stats => [ values %$all ]},
4170                    "display_stats.tpl") ;
4171 }
4172
4173 # return the autochanger list to update
4174 sub eject_media
4175 {
4176     my ($self) = @_;
4177     $self->can_do('r_media_mgnt');
4178
4179     my %ret;
4180     my $arg = $self->get_form('jmedias');
4181
4182     unless ($arg->{jmedias}) {
4183         return $self->error("Can't get media selection");
4184     }
4185
4186     my $query = "
4187 SELECT Media.VolumeName  AS volumename,
4188        Storage.Name      AS storage,
4189        Location.Location AS location,
4190        Media.Slot        AS slot
4191 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
4192            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
4193 WHERE Media.VolumeName IN ($arg->{jmedias})
4194   AND Media.InChanger = 1
4195 ";
4196
4197     my $all = $self->dbh_selectall_hashref($query, 'volumename');
4198
4199     foreach my $vol (values %$all) {
4200         my $a = $self->ach_get($vol->{location});
4201         next unless ($a) ;
4202         $ret{$vol->{location}} = 1;
4203
4204         unless ($a->{have_status}) {
4205             $a->status();
4206             $a->{have_status} = 1;
4207         }
4208         # TODO: set enabled
4209         print "eject $vol->{volumename} from $vol->{storage} : ";
4210         if ($a->send_to_io($vol->{slot})) {
4211             print "<img src='/bweb/T.png' alt='ok'><br/>";
4212         } else {
4213             print "<img src='/bweb/E.png' alt='err'><br/>";
4214         }
4215     }
4216     return keys %ret;
4217 }
4218
4219 sub move_email
4220 {
4221     my ($self) = @_;
4222
4223     my ($to, $subject, $content) = (CGI::param('email'),
4224                                     CGI::param('subject'),
4225                                     CGI::param('content'));
4226     $to =~ s/[^\w\d\.\@<>,]//;
4227     $subject =~ s/[^\w\d\.\[\]]/ /;
4228
4229     open(MAIL, "|mail -s '$subject' '$to'") ;
4230     print MAIL $content;
4231     close(MAIL);
4232
4233     print "Mail sent";
4234 }
4235
4236 sub restore
4237 {
4238     my ($self) = @_;
4239
4240     my $arg = $self->get_form('jobid', 'client');
4241
4242     print CGI::header('text/brestore');
4243     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4244     print "client=$arg->{client}\n" if ($arg->{client});
4245     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4246     print "\n";
4247 }
4248
4249 # TODO : move this to Bweb::Autochanger ?
4250 # TODO : make this internal to not eject tape ?
4251 use Bconsole;
4252
4253
4254 sub display_files
4255 {
4256     my ($self) = @_ ;
4257     $self->can_do('r_view_job');
4258
4259     my $arg = $self->get_form(qw/limit offset jobid/);
4260     if (!$arg->{jobid}) {
4261         return $self->error("Can't get jobid");
4262     }
4263
4264     $self->display({
4265         title => "Content of JobId $arg->{jobid}  ",
4266         name => "list files jobid=$arg->{jobid}",
4267         notail => 1,
4268         id => $cur_id++,
4269     }, "command.tpl");
4270
4271     my $b = new Bconsole(pref => $self->{info},timeout => 60);
4272     $b->connect();
4273     $b->log_stdout(1);
4274     $b->send_cmd("list files jobid=$arg->{jobid} limit=$arg->{limit}"); # TODO: add offset
4275
4276     $self->display({
4277         nohead => 1,
4278     }, "command.tpl");
4279 }
4280
4281 sub ach_get
4282 {
4283     my ($self, $name) = @_;
4284
4285     unless ($name) {
4286         return $self->error("Can't get your autochanger name ach");
4287     }
4288
4289     unless ($self->{info}->{ach_list}) {
4290         return $self->error("Could not find any autochanger");
4291     }
4292
4293     my $a = $self->{info}->{ach_list}->{$name};
4294
4295     unless ($a) {
4296         $self->error("Can't get your autochanger $name from your ach_list");
4297         return undef;
4298     }
4299
4300     $a->{bweb}  = $self;
4301     $a->{debug} = $self->{debug};
4302
4303     return $a;
4304 }
4305
4306 sub ach_register
4307 {
4308     my ($self, $ach) = @_;
4309     $self->can_do('r_configure');
4310
4311     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4312
4313     $self->{info}->save();
4314
4315     return 1;
4316 }
4317
4318 sub ach_edit
4319 {
4320     my ($self) = @_;
4321     $self->can_do('r_configure');
4322
4323     my $arg = $self->get_form('ach');
4324     if (!$arg->{ach}
4325         or !$self->{info}->{ach_list}
4326         or !$self->{info}->{ach_list}->{$arg->{ach}})
4327     {
4328         return $self->error("Can't get autochanger name");
4329     }
4330
4331     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4332
4333     my $i=0;
4334     $ach->{drives} =
4335         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4336
4337     my $b = $self->get_bconsole();
4338
4339     my @storages = $b->list_storage() ;
4340
4341     $ach->{devices} = [ map { { name => $_ } } @storages ];
4342
4343     $self->display($ach, "ach_add.tpl");
4344     delete $ach->{drives};
4345     delete $ach->{devices};
4346     return 1;
4347 }
4348
4349 sub ach_del
4350 {
4351     my ($self) = @_;
4352     $self->can_do('r_configure');
4353
4354     my $arg = $self->get_form('ach');
4355
4356     if (!$arg->{ach}
4357         or !$self->{info}->{ach_list}
4358         or !$self->{info}->{ach_list}->{$arg->{ach}})
4359     {
4360         return $self->error("Can't get autochanger name");
4361     }
4362
4363     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4364
4365     $self->{info}->save();
4366     $self->{info}->view();
4367 }
4368
4369 sub ach_add
4370 {
4371     my ($self) = @_;
4372     $self->can_do('r_configure');
4373
4374     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4375
4376     my $b = $self->get_bconsole();
4377     my @storages = $b->list_storage() ;
4378
4379     unless ($arg->{ach}) {
4380         $arg->{devices} = [ map { { name => $_ } } @storages ];
4381         return $self->display($arg, "ach_add.tpl");
4382     }
4383
4384     my @drives ;
4385     foreach my $drive (CGI::param('drives'))
4386     {
4387         unless (grep(/^$drive$/,@storages)) {
4388             return $self->error("Can't find $drive in storage list");
4389         }
4390
4391         my $index = CGI::param("index_$drive");
4392         unless (defined $index and $index =~ /^(\d+)$/) {
4393             return $self->error("Can't get $drive index");
4394         }
4395
4396         $drives[$index] = $drive;
4397     }
4398
4399     unless (@drives) {
4400         return $self->error("Can't get drives from Autochanger");
4401     }
4402
4403     my $a = new Bweb::Autochanger(name   => $arg->{ach},
4404                                   precmd => $arg->{precmd},
4405                                   drive_name => \@drives,
4406                                   device => $arg->{device},
4407                                   mtxcmd => $arg->{mtxcmd});
4408
4409     $self->ach_register($a) ;
4410
4411     $self->{info}->view();
4412 }
4413
4414 sub delete
4415 {
4416     my ($self) = @_;
4417     $self->can_do('r_delete_job');
4418
4419     my $arg = $self->get_form('jobid');
4420
4421     if ($arg->{jobid}) {
4422         my $b = $self->get_bconsole();
4423         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4424
4425         $self->display({
4426             content => $ret,
4427             title => "Delete a job ",
4428             name => "delete jobid=$arg->{jobid}",
4429             id => $cur_id++,
4430         }, "command.tpl");
4431     }
4432 }
4433
4434 sub do_update_media
4435 {
4436     my ($self) = @_ ;
4437     $self->can_do('r_media_mgnt');
4438
4439     my $arg = $self->get_form(qw/media volstatus inchanger pool
4440                                  slot volretention voluseduration
4441                                  maxvoljobs maxvolfiles maxvolbytes
4442                                  qcomment poolrecycle enabled
4443                               /);
4444
4445     unless ($arg->{media}) {
4446         return $self->error("Can't find media selection");
4447     }
4448
4449     my $update = "update volume=$arg->{media} ";
4450
4451     if ($arg->{volstatus}) {
4452         $update .= " volstatus=$arg->{volstatus} ";
4453     }
4454
4455     if ($arg->{inchanger}) {
4456         $update .= " inchanger=yes " ;
4457         if ($arg->{slot}) {
4458             $update .= " slot=$arg->{slot} ";
4459         }
4460     } else {
4461         $update .= " slot=0 inchanger=no ";
4462     }
4463
4464     if ($arg->{enabled}) {
4465         $update .= " enabled=$arg->{enabled} ";
4466     }
4467
4468     if ($arg->{pool}) {
4469         $update .= " pool=$arg->{pool} " ;
4470     }
4471
4472     if (defined $arg->{volretention}) {
4473         $update .= " volretention=\"$arg->{volretention}\" " ;
4474     }
4475
4476     if (defined $arg->{voluseduration}) {
4477         $update .= " voluse=\"$arg->{voluseduration}\" " ;
4478     }
4479
4480     if (defined $arg->{maxvoljobs}) {
4481         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4482     }
4483
4484     if (defined $arg->{maxvolfiles}) {
4485         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4486     }
4487
4488     if (defined $arg->{maxvolbytes}) {
4489         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4490     }
4491
4492     if (defined $arg->{poolrecycle}) {
4493         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4494     }
4495
4496     my $b = $self->get_bconsole();
4497
4498     $self->display({
4499         content => $b->send_cmd($update),
4500         title => "Update a volume ",
4501         name => $update,
4502         id => $cur_id++,
4503         hide_output => 1,
4504     }, "command.tpl");
4505
4506
4507     my @q;
4508     my $media = $self->dbh_quote($arg->{media});
4509
4510     my $loc = CGI::param('location') || '';
4511     if ($loc) {
4512         $loc = $self->dbh_quote($loc); # is checked by db
4513         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4514     }
4515     if (!$arg->{qcomment}) {
4516         $arg->{qcomment} = "''";
4517     }
4518     push @q, "Comment=$arg->{qcomment}";
4519
4520
4521     my $query = "
4522 UPDATE Media
4523    SET " . join (',', @q) . "
4524  WHERE Media.VolumeName = $media
4525 ";
4526     $self->dbh_do($query);
4527
4528     $self->update_media();
4529 }
4530
4531 sub update_slots
4532 {
4533     my ($self) = @_;
4534     $self->can_do('r_autochanger_mgnt');
4535
4536     my $ach = CGI::param('ach') ;
4537     $ach = $self->ach_get($ach);
4538     unless ($ach) {
4539         return $self->error("Bad autochanger name");
4540     }
4541
4542     $self->display({
4543         title => "Scanning autochanger content ",
4544         name => "update slots",
4545         notail => 1,
4546         id => $cur_id++,
4547     }, "command.tpl");
4548     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4549     $b->update_slots($ach->{name});
4550
4551     $self->display({
4552         nohead => 1,
4553     }, "command.tpl");
4554 }
4555
4556 sub get_job_log
4557 {
4558     my ($self) = @_;
4559     $self->can_do('r_view_log');
4560
4561     my $arg = $self->get_form('jobid', 'limit', 'offset');
4562     unless ($arg->{jobid}) {
4563         return $self->error("Can't get jobid");
4564     }
4565
4566     if ($arg->{limit} == 100) {
4567         $arg->{limit} = 1000;
4568     }
4569     # get security filter
4570     my $filter = $self->get_client_filter();
4571
4572     my $query = "
4573 SELECT Job.Name as name, Client.Name as clientname
4574  FROM  Job INNER JOIN Client USING (ClientId) $filter
4575  WHERE JobId = $arg->{jobid}
4576 ";
4577
4578     my $row = $self->dbh_selectrow_hashref($query);
4579
4580     unless ($row) {
4581         return $self->error("Can't find $arg->{jobid} in catalog");
4582     }
4583
4584     # display only Error and Warning messages
4585     $filter = '';
4586     if (CGI::param('error')) {
4587         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4588     }
4589
4590     my $logtext;
4591     if (CGI::param('time') || $self->{info}->{display_log_time}) {
4592         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4593     } else {
4594         $logtext = 'LogText';
4595     }
4596
4597     $query = "
4598 SELECT count(1) AS nbline,
4599        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt, id
4600   FROM  (
4601     SELECT 1 AS id, Time, LogText
4602     FROM Log
4603    WHERE ( Log.JobId = $arg->{jobid}
4604       OR (Log.JobId = 0
4605           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4606           AND Time <= (SELECT COALESCE(EndTime,$self->{sql}->{NOW})
4607                          FROM Job WHERE JobId=$arg->{jobid})
4608        ) ) $filter
4609  ORDER BY LogId
4610  LIMIT $arg->{limit}
4611  OFFSET $arg->{offset}
4612  ) AS temp
4613  GROUP BY id
4614
4615 ";
4616
4617     my $log = $self->dbh_selectrow_hashref($query);
4618     unless ($log) {
4619         return $self->error("Can't get log for jobid $arg->{jobid}, check that
4620 your 'Messages' resources include 'catalog = all' and you loaded Bweb SQL
4621 functions in your Catalog.");
4622     }
4623     $log->{logtxt} =~ s/\0//g;
4624     $self->display({ lines=> $log->{logtxt},
4625                      nbline => $log->{nbline},
4626                      jobid => $arg->{jobid},
4627                      name  => $row->{name},
4628                      client => $row->{clientname},
4629                      offset => $arg->{offset},
4630                      limit  => $arg->{limit},
4631                  }, 'display_log.tpl');
4632 }
4633
4634 sub cancel_future_job
4635 {
4636     my ($self) = @_;
4637     $self->can_do('r_cancel_job');
4638
4639     my $arg = $self->get_form(qw/job pool level client when/);
4640
4641     if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4642          or !$arg->{client} or !$arg->{when})
4643     {
4644         return $self->error("Can't get enough information to mark this job as canceled");
4645     }
4646
4647     $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4648     my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4649
4650     if ($jobtable =~ /^Job$/i) {
4651         return $self->error("Can add records only in history table");
4652     }
4653     my $jname = "$arg->{job}.$arg->{when}";
4654     $jname =~ s/\s/_/g;
4655
4656     my $found = $self->dbh_selectrow_hashref("
4657 SELECT 1
4658   FROM $jobtable
4659  WHERE JobId = 0
4660    AND Job = '$jname'
4661    AND Name = '$arg->{job}'
4662 ");
4663     if ($found) {
4664         return $self->error("$jname is already in history table");
4665     }
4666
4667         $self->dbh_do("
4668 INSERT INTO $jobtable
4669   (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4670    RealEndTime, ClientId, PoolId)
4671  VALUES
4672   (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4673    '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4674    (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4675    (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4676   )
4677 ");
4678     $self->display({ Filter => "Dummy record for $jname",
4679                      ID => 1,
4680                      Jobs =>
4681                          [{ jobid => 0,
4682                             client => $arg->{client},
4683                             jobname => $arg->{job},
4684                             pool => $arg->{pool},
4685                             level => $arg->{level},
4686                             starttime => $arg->{when},
4687                             duration => '00:00:00',
4688                             jobfiles => 0,
4689                             jobbytes => 0,
4690                             joberrors => 0,
4691                             jobstatus => 'A',
4692                      }]
4693                    },
4694                    "display_job.tpl");
4695 }
4696
4697 sub add_media
4698 {
4699     my ($self) = @_ ;
4700     $self->can_do('r_media_mgnt');
4701     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4702     my $b = $self->get_bconsole();
4703
4704     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4705         CGI::param(offset => 0);
4706         $arg = $self->get_form('db_pools');
4707         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4708         $self->display($arg, 'add_media.tpl');
4709         return 1;
4710     }
4711     $b->connect();
4712     $b->send("add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n");
4713     if ($arg->{nb} > 0) {
4714         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4715         $b->send("$arg->{nb}\n");
4716         $b->send("$arg->{media}\n");
4717         $b->send("$arg->{offset}\n");
4718
4719     } else {
4720         $b->send("0\n");
4721         $b->send("$arg->{media}\n");
4722     }
4723
4724     $b->expect_it('-re','^[*]');
4725
4726     CGI::param('media', '');
4727     CGI::param('re_media', $arg->{media});
4728     $self->display_media();
4729 }
4730
4731 sub label_barcodes
4732 {
4733     my ($self) = @_ ;
4734     $self->can_do('r_autochanger_mgnt');
4735
4736     my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4737
4738     unless ($arg->{ach}) {
4739         return $self->error("Can't find autochanger name");
4740     }
4741
4742     my $a = $self->ach_get($arg->{ach});
4743     unless ($a) {
4744         return $self->error("Can't find autochanger name in configuration");
4745     }
4746
4747     my $storage = $a->get_drive_name($arg->{drive});
4748     unless ($storage) {
4749         return $self->error("Can't get your drive name");
4750     }
4751
4752     my $slots = '';
4753     my $slots_sql = '';
4754     my $t = 300 ;
4755     if ($arg->{slots}) {
4756         $slots = join(",", @{ $arg->{slots} });
4757         $slots_sql = " AND Slot IN ($slots) ";
4758         $t += 60*scalar( @{ $arg->{slots} }) ;
4759     }
4760     my $pool = $arg->{pool} || 'Scratch';
4761     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4762     print "<h1>This command can take long time, be patient...</h1>";
4763     print "<pre>" ;
4764     $b->label_barcodes(storage => $storage,
4765                        drive => $arg->{drive},
4766                        pool  => $pool,
4767                        slots => $slots) ;
4768     $b->close();
4769     print "</pre>";
4770
4771     $self->dbh_do("
4772   UPDATE Media
4773        SET LocationId =   (SELECT LocationId
4774                              FROM Location
4775                             WHERE Location = '$arg->{ach}')
4776
4777      WHERE (LocationId = 0 OR LocationId IS NULL)
4778        $slots_sql
4779 ");
4780
4781 }
4782
4783 sub purge
4784 {
4785     my ($self) = @_;
4786     $self->can_do('r_purge');
4787
4788     my @volume = CGI::param('media');
4789
4790     unless (@volume) {
4791         return $self->error("Can't get media selection");
4792     }
4793
4794     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4795
4796     foreach my $v (@volume) {
4797         $self->display({
4798             content => $b->purge_volume($v),
4799             title => "Purge media",
4800             name => "purge volume=$v",
4801             id => $cur_id++,
4802         }, "command.tpl");
4803     }
4804     $b->close();
4805 }
4806
4807 sub prune
4808 {
4809     my ($self) = @_;
4810     $self->can_do('r_prune');
4811
4812     my @volume = CGI::param('media');
4813     unless (@volume) {
4814         return $self->error("Can't get media selection");
4815     }
4816
4817     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4818
4819     foreach my $v (@volume) {
4820         $self->display({
4821             content => $b->prune_volume($v),
4822             title => "Prune volume",
4823             name => "prune volume=$v",
4824             id => $cur_id++,
4825         }, "command.tpl");
4826     }
4827     $b->close();
4828 }
4829
4830 sub cancel_job
4831 {
4832     my ($self) = @_;
4833     $self->can_do('r_cancel_job');
4834
4835     my $arg = $self->get_form('jobid');
4836     unless ($arg->{jobid}) {
4837         return $self->error("Can't get jobid");
4838     }
4839
4840     my $b = $self->get_bconsole();
4841     $self->display({
4842         content => $b->cancel($arg->{jobid}),
4843         title => "Cancel job",
4844         name => "cancel jobid=$arg->{jobid}",
4845         id => $cur_id++,
4846     }, "command.tpl");
4847 }
4848
4849 sub fileset_view
4850 {
4851     # Warning, we display current fileset
4852     my ($self) = @_;
4853
4854     my $arg = $self->get_form('fileset');
4855
4856     if ($arg->{fileset}) {
4857         my $b = $self->get_bconsole();
4858         my $ret = $b->get_fileset($arg->{fileset});
4859         $self->display({ fileset => $arg->{fileset},
4860                          %$ret,
4861                      }, "fileset_view.tpl");
4862     } else {
4863         $self->error("Can't get fileset name");
4864     }
4865 }
4866
4867 sub director_show_sched
4868 {
4869     my ($self) = @_ ;
4870     $self->can_do('r_view_job');
4871     my $arg = $self->get_form('days');
4872
4873     my $b = $self->get_bconsole();
4874     my $ret = $b->director_get_sched( $arg->{days} );
4875
4876     $self->display({
4877         id => $cur_id++,
4878         list => $ret,
4879     }, "scheduled_job.tpl");
4880 }
4881
4882 sub enable_disable_job
4883 {
4884     my ($self, $what) = @_ ;
4885     $self->can_do('r_run_job');
4886
4887     my $arg = $self->get_form('job');
4888     if (!$arg->{job}) {
4889         return $self->error("Can't find job name");
4890     }
4891
4892     my $b = $self->get_bconsole();
4893
4894     my $cmd;
4895     if ($what) {
4896         $cmd = "enable";
4897     } else {
4898         $cmd = "disable";
4899     }
4900
4901     $self->display({
4902         content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4903         title => "$cmd $arg->{job}",
4904         name => "$cmd job=\"$arg->{job}\"",
4905         id => $cur_id++,
4906     }, "command.tpl");
4907 }
4908
4909 sub get_bconsole
4910 {
4911     my ($self) = @_;
4912     return new Bconsole(pref => $self->{info});
4913 }
4914
4915 sub cmd_storage
4916 {
4917     my ($self) = @_;
4918     $self->can_do('r_storage_mgnt');
4919     my $arg = $self->get_form(qw/storage storage_cmd drive slot/);
4920     my $b = $self->get_bconsole();
4921
4922     if ($arg->{storage} and $arg->{storage_cmd}) {
4923         my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive} slot=$arg->{slot}";
4924         my $ret = $b->send_cmd($cmd);
4925
4926         $self->display({
4927             content => $ret,
4928             title => "Storage ",
4929             name => $cmd,
4930             id => $cur_id++,
4931         }, "command.tpl");
4932     } else {
4933         my $storages= [ map { { name => $_ } } $b->list_storage()];
4934         $self->display({ storage => $storages}, "cmd_storage.tpl");
4935     }
4936 }
4937
4938 sub run_job_select
4939 {
4940     my ($self) = @_;
4941     $self->can_do('r_run_job');
4942
4943     my $b = $self->get_bconsole();
4944
4945     my $joblist = [ map { { name => $_ } } $b->list_backup() ];
4946
4947     $self->display({ Jobs => $joblist }, "run_job.tpl");
4948 }
4949
4950 sub run_parse_job
4951 {
4952     my ($self, $ouput) = @_;
4953
4954     my %arg;
4955     $self->debug($ouput);
4956     foreach my $l (split(/\r?\n/, $ouput)) {
4957         $self->debug($l);
4958         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4959             $arg{$1} = $2;
4960             $l = $3
4961                 if ($3) ;
4962         }
4963
4964         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4965             %arg = (%arg, @l);
4966         }
4967     }
4968
4969     my %lowcase ;
4970     foreach my $k (keys %arg) {
4971         $lowcase{lc($k)} = $arg{$k} ;
4972     }
4973     $self->debug(\%lowcase);
4974     return \%lowcase;
4975 }
4976
4977 sub run_job_mod
4978 {
4979     my ($self) = @_;
4980     $self->can_do('r_run_job');
4981
4982     my $b = $self->get_bconsole();
4983     my $arg = $self->get_form(qw/pool level client fileset storage media job/);
4984
4985     if (!$arg->{job}) {
4986         return $self->error("Can't get job name");
4987     }
4988
4989     # we take informations from director, and we overwrite with user wish
4990     my $info = $b->send_cmd("show job=\"$arg->{job}\"");
4991     my $attr = $self->run_parse_job($info);
4992
4993     if (!$arg->{pool} and $arg->{media}) {
4994         my $r = $self->dbh_selectrow_hashref("
4995 SELECT Pool.Name AS name
4996   FROM Media JOIN Pool USING (PoolId)
4997  WHERE Media.VolumeName = '$arg->{media}'
4998    AND Pool.Name != 'Scratch'
4999 ");
5000         if ($r) {
5001             $arg->{pool} = $r->{name};
5002         }
5003     }
5004
5005     my %job_opt = (%$attr, %$arg);
5006
5007     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
5008
5009     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
5010     my $clients = [ map { { name => $_ } }$b->list_client()];
5011     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
5012     my $storages= [ map { { name => $_ } }$b->list_storage()];
5013
5014     $self->display({
5015         jobs     => $jobs,
5016         pools    => $pools,
5017         clients  => $clients,
5018         filesets => $filesets,
5019         storages => $storages,
5020         %job_opt,
5021     }, "run_job_mod.tpl");
5022 }
5023
5024 sub run_job
5025 {
5026     my ($self) = @_;
5027     $self->can_do('r_run_job');
5028
5029     my $b = $self->get_bconsole();
5030
5031     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
5032
5033     $self->display({
5034         jobs     => $jobs,
5035     }, "run_job.tpl");
5036 }
5037
5038 sub run_job_now
5039 {
5040     my ($self) = @_;
5041     $self->can_do('r_run_job');
5042
5043     my $b = $self->get_bconsole();
5044
5045     # TODO: check input (don't use pool, level)
5046
5047     my $arg = $self->get_form(qw/pool level client priority when
5048                                  fileset job storage/);
5049     if (!$arg->{job}) {
5050         return $self->error("Can't get your job name");
5051     }
5052
5053     my $jobid = $b->run(job => $arg->{job},
5054                         client => $arg->{client},
5055                         priority => $arg->{priority},
5056                         level => $arg->{level},
5057                         storage => $arg->{storage},
5058                         pool => $arg->{pool},
5059                         fileset => $arg->{fileset},
5060                         when => $arg->{when},
5061                         );
5062
5063     print $b->{error};
5064
5065     print "<br>You can follow job (jobid=$jobid) execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a><script type='text/javascript' language='JavaScript'>setTimeout(function() { window.location='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'},2000);</script>";
5066 }
5067
5068 sub display_next_job
5069 {
5070     my ($self) = @_;
5071
5072     my $arg = $self->get_form(qw/job begin end/);
5073     if (!$arg->{job}) {
5074         return $self->error("Can't get job name");
5075     }
5076
5077     my $b = $self->get_bconsole();
5078
5079     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5080     my $attr = $self->run_parse_job($job);
5081
5082     if (!$attr->{schedule}) {
5083         return $self->error("Can't get $arg->{job} schedule");
5084     }
5085     my $jpool=$attr->{pool} || '';
5086
5087     my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5088                                 begin => $arg->{begin}, end => $arg->{end});
5089
5090     my $ss = $sched->get_scheds($attr->{schedule});
5091     my @ret;
5092
5093     foreach my $s (@$ss) {
5094         my $level = $sched->get_level($s);
5095         my $pool  = $sched->get_pool($s) || $jpool;
5096         my $evt = $sched->get_event($s);
5097         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5098     }
5099
5100     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5101 }
5102
5103 # permit to verify for higher level backup
5104 # we attempt a Increment, we made a Full, that ok
5105 # TODO: Pool may have change
5106 sub get_higher_level
5107 {
5108     my ($self, $level) = @_;
5109     if ($level eq 'F') {
5110         return "'F'";
5111     } elsif ($level eq 'D') {
5112         return "'F', 'D'";
5113     } elsif ($level eq 'I') {
5114         return "'F', 'D', 'I'";
5115     }
5116     return "''";
5117 }
5118
5119 # check jobs against their schedule
5120 sub check_job
5121 {
5122     my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5123     return undef if (!$self->can_view_client($client));
5124
5125     my $sch = $sched->get_scheds($schedname);
5126     return undef if (!$sch);
5127
5128     my @ret;
5129     foreach my $s (@$sch) {
5130         my $pool;
5131         if ($type eq 'B') {     # we take the pool only for backup job
5132             $pool = $sched->get_pool($s) || $job_pool;
5133         }
5134         my $level = $sched->get_level($s);
5135         my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5136         $l = $self->get_higher_level($l);
5137         my $evts = $sched->get_event($s);
5138         my $end = $sched->{end}; # this backup must have start before the next one
5139         foreach my $evt (reverse @$evts) {
5140             my $all = $self->dbh_selectrow_hashref("
5141  SELECT 1
5142    FROM Job
5143    JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5144   WHERE Job.StartTime >= '$evt'
5145     AND Job.StartTime <  '$end'
5146     AND Job.Name = '$job'
5147     AND Job.Type = '$type'
5148     AND Job.JobStatus IN ('T', 'W')
5149     AND Job.Level IN ($l)
5150 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5151     AND Client.Name = '$client'
5152  LIMIT 1
5153 ");
5154             if ($all) {
5155 #               print "ok $job ";
5156             } else {
5157                 push @{$self->{tmp}}, {date => $evt, level => $level,
5158                                        type => 'Backup', name => $job,
5159                                        pool => $pool, volume => $pool,
5160                                        client => $client};
5161             }
5162             $end = $evt;
5163         }
5164     }
5165 }
5166
5167 sub display_missing_job
5168 {
5169     my ($self) = @_;
5170     my $arg = $self->get_form(qw/begin end age/);
5171
5172     if (!$arg->{begin}) { # TODO: change this
5173         $arg->{begin} = strftime('%F %T', localtime($btime - $arg->{age}));
5174     }
5175     if (!$arg->{end}) {
5176         $arg->{end} = strftime('%F %T', localtime($btime));
5177     }
5178     $self->{tmp} = [];          # check_job use this for result
5179
5180     my $bconsole = $self->get_bconsole();
5181
5182     my $sched = new Bweb::Sched(bconsole => $bconsole,
5183                                 begin => $arg->{begin},
5184                                 end => $arg->{end});
5185
5186     my $job = $bconsole->send_cmd("show job");
5187     my ($jname, $jsched, $jclient, $jpool, $jtype);
5188     foreach my $j (split(/\r?\n/, $job)) {
5189         if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5190             if ($jname and $jsched) {
5191                 $self->check_job($sched, $jsched, $jname,
5192                                  $jpool, $jclient, $jtype);
5193             }
5194             $jname = $1;
5195             $jtype = chr($2);
5196             $jclient = $jpool = $jsched = undef;
5197         } elsif ($j =~ /Client: name=(.+?) address=/i) {
5198             $jclient = $1;
5199         } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5200             $jpool = $1;
5201         } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5202             $jsched = $1;
5203         }
5204     }
5205     $self->display({
5206         id => $cur_id++,
5207         title => "Missing Jobs (from $arg->{begin} to $arg->{end})",
5208         list => $self->{tmp},
5209         wiki_url => $self->{info}->{wiki_url},
5210         missing_mode => 1,
5211     }, "scheduled_job.tpl");
5212
5213     delete $self->{tmp};
5214 }
5215
5216 1;