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