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

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