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}");
4620     }
4621     $log->{logtxt} =~ s/\0//g;
4622     $self->display({ lines=> $log->{logtxt},
4623                      nbline => $log->{nbline},
4624                      jobid => $arg->{jobid},
4625                      name  => $row->{name},
4626                      client => $row->{clientname},
4627                      offset => $arg->{offset},
4628                      limit  => $arg->{limit},
4629                  }, 'display_log.tpl');
4630 }
4631
4632 sub cancel_future_job
4633 {
4634     my ($self) = @_;
4635     $self->can_do('r_cancel_job');
4636
4637     my $arg = $self->get_form(qw/job pool level client when/);
4638
4639     if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4640          or !$arg->{client} or !$arg->{when})
4641     {
4642         return $self->error("Can't get enough information to mark this job as canceled");
4643     }
4644
4645     $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4646     my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4647
4648     if ($jobtable =~ /^Job$/i) {
4649         return $self->error("Can add records only in history table");
4650     }
4651     my $jname = "$arg->{job}.$arg->{when}";
4652     $jname =~ s/\s/_/g;
4653
4654     my $found = $self->dbh_selectrow_hashref("
4655 SELECT 1
4656   FROM $jobtable
4657  WHERE JobId = 0
4658    AND Job = '$jname'
4659    AND Name = '$arg->{job}'
4660 ");
4661     if ($found) {
4662         return $self->error("$jname is already in history table");
4663     }
4664
4665         $self->dbh_do("
4666 INSERT INTO $jobtable
4667   (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4668    RealEndTime, ClientId, PoolId)
4669  VALUES
4670   (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4671    '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4672    (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4673    (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4674   )
4675 ");
4676     $self->display({ Filter => "Dummy record for $jname",
4677                      ID => 1,
4678                      Jobs =>
4679                          [{ jobid => 0,
4680                             client => $arg->{client},
4681                             jobname => $arg->{job},
4682                             pool => $arg->{pool},
4683                             level => $arg->{level},
4684                             starttime => $arg->{when},
4685                             duration => '00:00:00',
4686                             jobfiles => 0,
4687                             jobbytes => 0,
4688                             joberrors => 0,
4689                             jobstatus => 'A',
4690                      }]
4691                    },
4692                    "display_job.tpl");
4693 }
4694
4695 sub add_media
4696 {
4697     my ($self) = @_ ;
4698     $self->can_do('r_media_mgnt');
4699     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4700     my $b = $self->get_bconsole();
4701
4702     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4703         CGI::param(offset => 0);
4704         $arg = $self->get_form('db_pools');
4705         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4706         $self->display($arg, 'add_media.tpl');
4707         return 1;
4708     }
4709     $b->connect();
4710     $b->send("add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n");
4711     if ($arg->{nb} > 0) {
4712         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4713         $b->send("$arg->{nb}\n");
4714         $b->send("$arg->{media}\n");
4715         $b->send("$arg->{offset}\n");
4716
4717     } else {
4718         $b->send("0\n");
4719         $b->send("$arg->{media}\n");
4720     }
4721
4722     $b->expect_it('-re','^[*]');
4723
4724     CGI::param('media', '');
4725     CGI::param('re_media', $arg->{media});
4726     $self->display_media();
4727 }
4728
4729 sub label_barcodes
4730 {
4731     my ($self) = @_ ;
4732     $self->can_do('r_autochanger_mgnt');
4733
4734     my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4735
4736     unless ($arg->{ach}) {
4737         return $self->error("Can't find autochanger name");
4738     }
4739
4740     my $a = $self->ach_get($arg->{ach});
4741     unless ($a) {
4742         return $self->error("Can't find autochanger name in configuration");
4743     }
4744
4745     my $storage = $a->get_drive_name($arg->{drive});
4746     unless ($storage) {
4747         return $self->error("Can't get your drive name");
4748     }
4749
4750     my $slots = '';
4751     my $slots_sql = '';
4752     my $t = 300 ;
4753     if ($arg->{slots}) {
4754         $slots = join(",", @{ $arg->{slots} });
4755         $slots_sql = " AND Slot IN ($slots) ";
4756         $t += 60*scalar( @{ $arg->{slots} }) ;
4757     }
4758     my $pool = $arg->{pool} || 'Scratch';
4759     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4760     print "<h1>This command can take long time, be patient...</h1>";
4761     print "<pre>" ;
4762     $b->label_barcodes(storage => $storage,
4763                        drive => $arg->{drive},
4764                        pool  => $pool,
4765                        slots => $slots) ;
4766     $b->close();
4767     print "</pre>";
4768
4769     $self->dbh_do("
4770   UPDATE Media
4771        SET LocationId =   (SELECT LocationId
4772                              FROM Location
4773                             WHERE Location = '$arg->{ach}')
4774
4775      WHERE (LocationId = 0 OR LocationId IS NULL)
4776        $slots_sql
4777 ");
4778
4779 }
4780
4781 sub purge
4782 {
4783     my ($self) = @_;
4784     $self->can_do('r_purge');
4785
4786     my @volume = CGI::param('media');
4787
4788     unless (@volume) {
4789         return $self->error("Can't get media selection");
4790     }
4791
4792     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4793
4794     foreach my $v (@volume) {
4795         $self->display({
4796             content => $b->purge_volume($v),
4797             title => "Purge media",
4798             name => "purge volume=$v",
4799             id => $cur_id++,
4800         }, "command.tpl");
4801     }
4802     $b->close();
4803 }
4804
4805 sub prune
4806 {
4807     my ($self) = @_;
4808     $self->can_do('r_prune');
4809
4810     my @volume = CGI::param('media');
4811     unless (@volume) {
4812         return $self->error("Can't get media selection");
4813     }
4814
4815     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4816
4817     foreach my $v (@volume) {
4818         $self->display({
4819             content => $b->prune_volume($v),
4820             title => "Prune volume",
4821             name => "prune volume=$v",
4822             id => $cur_id++,
4823         }, "command.tpl");
4824     }
4825     $b->close();
4826 }
4827
4828 sub cancel_job
4829 {
4830     my ($self) = @_;
4831     $self->can_do('r_cancel_job');
4832
4833     my $arg = $self->get_form('jobid');
4834     unless ($arg->{jobid}) {
4835         return $self->error("Can't get jobid");
4836     }
4837
4838     my $b = $self->get_bconsole();
4839     $self->display({
4840         content => $b->cancel($arg->{jobid}),
4841         title => "Cancel job",
4842         name => "cancel jobid=$arg->{jobid}",
4843         id => $cur_id++,
4844     }, "command.tpl");
4845 }
4846
4847 sub fileset_view
4848 {
4849     # Warning, we display current fileset
4850     my ($self) = @_;
4851
4852     my $arg = $self->get_form('fileset');
4853
4854     if ($arg->{fileset}) {
4855         my $b = $self->get_bconsole();
4856         my $ret = $b->get_fileset($arg->{fileset});
4857         $self->display({ fileset => $arg->{fileset},
4858                          %$ret,
4859                      }, "fileset_view.tpl");
4860     } else {
4861         $self->error("Can't get fileset name");
4862     }
4863 }
4864
4865 sub director_show_sched
4866 {
4867     my ($self) = @_ ;
4868     $self->can_do('r_view_job');
4869     my $arg = $self->get_form('days');
4870
4871     my $b = $self->get_bconsole();
4872     my $ret = $b->director_get_sched( $arg->{days} );
4873
4874     $self->display({
4875         id => $cur_id++,
4876         list => $ret,
4877     }, "scheduled_job.tpl");
4878 }
4879
4880 sub enable_disable_job
4881 {
4882     my ($self, $what) = @_ ;
4883     $self->can_do('r_run_job');
4884
4885     my $arg = $self->get_form('job');
4886     if (!$arg->{job}) {
4887         return $self->error("Can't find job name");
4888     }
4889
4890     my $b = $self->get_bconsole();
4891
4892     my $cmd;
4893     if ($what) {
4894         $cmd = "enable";
4895     } else {
4896         $cmd = "disable";
4897     }
4898
4899     $self->display({
4900         content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4901         title => "$cmd $arg->{job}",
4902         name => "$cmd job=\"$arg->{job}\"",
4903         id => $cur_id++,
4904     }, "command.tpl");
4905 }
4906
4907 sub get_bconsole
4908 {
4909     my ($self) = @_;
4910     return new Bconsole(pref => $self->{info});
4911 }
4912
4913 sub cmd_storage
4914 {
4915     my ($self) = @_;
4916     $self->can_do('r_storage_mgnt');
4917     my $arg = $self->get_form(qw/storage storage_cmd drive slot/);
4918     my $b = $self->get_bconsole();
4919
4920     if ($arg->{storage} and $arg->{storage_cmd}) {
4921         my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive} slot=$arg->{slot}";
4922         my $ret = $b->send_cmd($cmd);
4923
4924         $self->display({
4925             content => $ret,
4926             title => "Storage ",
4927             name => $cmd,
4928             id => $cur_id++,
4929         }, "command.tpl");
4930     } else {
4931         my $storages= [ map { { name => $_ } } $b->list_storage()];
4932         $self->display({ storage => $storages}, "cmd_storage.tpl");
4933     }
4934 }
4935
4936 sub run_job_select
4937 {
4938     my ($self) = @_;
4939     $self->can_do('r_run_job');
4940
4941     my $b = $self->get_bconsole();
4942
4943     my $joblist = [ map { { name => $_ } } $b->list_backup() ];
4944
4945     $self->display({ Jobs => $joblist }, "run_job.tpl");
4946 }
4947
4948 sub run_parse_job
4949 {
4950     my ($self, $ouput) = @_;
4951
4952     my %arg;
4953     $self->debug($ouput);
4954     foreach my $l (split(/\r?\n/, $ouput)) {
4955         $self->debug($l);
4956         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4957             $arg{$1} = $2;
4958             $l = $3
4959                 if ($3) ;
4960         }
4961
4962         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4963             %arg = (%arg, @l);
4964         }
4965     }
4966
4967     my %lowcase ;
4968     foreach my $k (keys %arg) {
4969         $lowcase{lc($k)} = $arg{$k} ;
4970     }
4971     $self->debug(\%lowcase);
4972     return \%lowcase;
4973 }
4974
4975 sub run_job_mod
4976 {
4977     my ($self) = @_;
4978     $self->can_do('r_run_job');
4979
4980     my $b = $self->get_bconsole();
4981     my $arg = $self->get_form(qw/pool level client fileset storage media job/);
4982
4983     if (!$arg->{job}) {
4984         return $self->error("Can't get job name");
4985     }
4986
4987     # we take informations from director, and we overwrite with user wish
4988     my $info = $b->send_cmd("show job=\"$arg->{job}\"");
4989     my $attr = $self->run_parse_job($info);
4990
4991     if (!$arg->{pool} and $arg->{media}) {
4992         my $r = $self->dbh_selectrow_hashref("
4993 SELECT Pool.Name AS name
4994   FROM Media JOIN Pool USING (PoolId)
4995  WHERE Media.VolumeName = '$arg->{media}'
4996    AND Pool.Name != 'Scratch'
4997 ");
4998         if ($r) {
4999             $arg->{pool} = $r->{name};
5000         }
5001     }
5002
5003     my %job_opt = (%$attr, %$arg);
5004
5005     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
5006
5007     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
5008     my $clients = [ map { { name => $_ } }$b->list_client()];
5009     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
5010     my $storages= [ map { { name => $_ } }$b->list_storage()];
5011
5012     $self->display({
5013         jobs     => $jobs,
5014         pools    => $pools,
5015         clients  => $clients,
5016         filesets => $filesets,
5017         storages => $storages,
5018         %job_opt,
5019     }, "run_job_mod.tpl");
5020 }
5021
5022 sub run_job
5023 {
5024     my ($self) = @_;
5025     $self->can_do('r_run_job');
5026
5027     my $b = $self->get_bconsole();
5028
5029     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
5030
5031     $self->display({
5032         jobs     => $jobs,
5033     }, "run_job.tpl");
5034 }
5035
5036 sub run_job_now
5037 {
5038     my ($self) = @_;
5039     $self->can_do('r_run_job');
5040
5041     my $b = $self->get_bconsole();
5042
5043     # TODO: check input (don't use pool, level)
5044
5045     my $arg = $self->get_form(qw/pool level client priority when
5046                                  fileset job storage/);
5047     if (!$arg->{job}) {
5048         return $self->error("Can't get your job name");
5049     }
5050
5051     my $jobid = $b->run(job => $arg->{job},
5052                         client => $arg->{client},
5053                         priority => $arg->{priority},
5054                         level => $arg->{level},
5055                         storage => $arg->{storage},
5056                         pool => $arg->{pool},
5057                         fileset => $arg->{fileset},
5058                         when => $arg->{when},
5059                         );
5060
5061     print $b->{error};
5062
5063     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>";
5064 }
5065
5066 sub display_next_job
5067 {
5068     my ($self) = @_;
5069
5070     my $arg = $self->get_form(qw/job begin end/);
5071     if (!$arg->{job}) {
5072         return $self->error("Can't get job name");
5073     }
5074
5075     my $b = $self->get_bconsole();
5076
5077     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5078     my $attr = $self->run_parse_job($job);
5079
5080     if (!$attr->{schedule}) {
5081         return $self->error("Can't get $arg->{job} schedule");
5082     }
5083     my $jpool=$attr->{pool} || '';
5084
5085     my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5086                                 begin => $arg->{begin}, end => $arg->{end});
5087
5088     my $ss = $sched->get_scheds($attr->{schedule});
5089     my @ret;
5090
5091     foreach my $s (@$ss) {
5092         my $level = $sched->get_level($s);
5093         my $pool  = $sched->get_pool($s) || $jpool;
5094         my $evt = $sched->get_event($s);
5095         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5096     }
5097
5098     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5099 }
5100
5101 # permit to verify for higher level backup
5102 # we attempt a Increment, we made a Full, that ok
5103 # TODO: Pool may have change
5104 sub get_higher_level
5105 {
5106     my ($self, $level) = @_;
5107     if ($level eq 'F') {
5108         return "'F'";
5109     } elsif ($level eq 'D') {
5110         return "'F', 'D'";
5111     } elsif ($level eq 'I') {
5112         return "'F', 'D', 'I'";
5113     }
5114     return "''";
5115 }
5116
5117 # check jobs against their schedule
5118 sub check_job
5119 {
5120     my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5121     return undef if (!$self->can_view_client($client));
5122
5123     my $sch = $sched->get_scheds($schedname);
5124     return undef if (!$sch);
5125
5126     my @ret;
5127     foreach my $s (@$sch) {
5128         my $pool;
5129         if ($type eq 'B') {     # we take the pool only for backup job
5130             $pool = $sched->get_pool($s) || $job_pool;
5131         }
5132         my $level = $sched->get_level($s);
5133         my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5134         $l = $self->get_higher_level($l);
5135         my $evts = $sched->get_event($s);
5136         my $end = $sched->{end}; # this backup must have start before the next one
5137         foreach my $evt (reverse @$evts) {
5138             my $all = $self->dbh_selectrow_hashref("
5139  SELECT 1
5140    FROM Job
5141    JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5142   WHERE Job.StartTime >= '$evt'
5143     AND Job.StartTime <  '$end'
5144     AND Job.Name = '$job'
5145     AND Job.Type = '$type'
5146     AND Job.JobStatus IN ('T', 'W')
5147     AND Job.Level IN ($l)
5148 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5149     AND Client.Name = '$client'
5150  LIMIT 1
5151 ");
5152             if ($all) {
5153 #               print "ok $job ";
5154             } else {
5155                 push @{$self->{tmp}}, {date => $evt, level => $level,
5156                                        type => 'Backup', name => $job,
5157                                        pool => $pool, volume => $pool,
5158                                        client => $client};
5159             }
5160             $end = $evt;
5161         }
5162     }
5163 }
5164
5165 sub display_missing_job
5166 {
5167     my ($self) = @_;
5168     my $arg = $self->get_form(qw/begin end age/);
5169
5170     if (!$arg->{begin}) { # TODO: change this
5171         $arg->{begin} = strftime('%F %T', localtime($btime - $arg->{age}));
5172     }
5173     if (!$arg->{end}) {
5174         $arg->{end} = strftime('%F %T', localtime($btime));
5175     }
5176     $self->{tmp} = [];          # check_job use this for result
5177
5178     my $bconsole = $self->get_bconsole();
5179
5180     my $sched = new Bweb::Sched(bconsole => $bconsole,
5181                                 begin => $arg->{begin},
5182                                 end => $arg->{end});
5183
5184     my $job = $bconsole->send_cmd("show job");
5185     my ($jname, $jsched, $jclient, $jpool, $jtype);
5186     foreach my $j (split(/\r?\n/, $job)) {
5187         if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5188             if ($jname and $jsched) {
5189                 $self->check_job($sched, $jsched, $jname,
5190                                  $jpool, $jclient, $jtype);
5191             }
5192             $jname = $1;
5193             $jtype = chr($2);
5194             $jclient = $jpool = $jsched = undef;
5195         } elsif ($j =~ /Client: name=(.+?) address=/i) {
5196             $jclient = $1;
5197         } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5198             $jpool = $1;
5199         } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5200             $jsched = $1;
5201         }
5202     }
5203     $self->display({
5204         id => $cur_id++,
5205         title => "Missing Jobs (from $arg->{begin} to $arg->{end})",
5206         list => $self->{tmp},
5207         wiki_url => $self->{info}->{wiki_url},
5208         missing_mode => 1,
5209     }, "scheduled_job.tpl");
5210
5211     delete $self->{tmp};
5212 }
5213
5214 1;