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 John Walker.
  31    The licensor of Bacula is the Free Software Foundation Europe
  32    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  33    Switzerland, email:ftf@fsfeurope.org.
  34
  35 =head1 VERSION
  36
  37     $Id$
  38
  39 =cut
  40
  41 package Bweb::Gui;
  42
  43 =head1 PACKAGE
  44
  45     Bweb::Gui - Base package for all Bweb object
  46
  47 =head2 DESCRIPTION
  48
  49     This package define base fonction like new, display, etc..
  50
  51 =cut
  52
  53 use HTML::Template;
  54 our $template_dir='/usr/share/bweb/tpl';
  55
  56 =head1 FUNCTION
  57
  58     new - creation a of new Bweb object
  59
  60 =head2 DESCRIPTION
  61
  62     This function take an hash of argument and place them
  63     on bless ref
  64
  65     IE : $obj = new Obj(name => 'test', age => '10');
  66
  67          $obj->{name} eq 'test' and $obj->{age} eq 10
  68
  69 =cut
  70
  71 sub new
  72 {
  73     my ($class, %arg) = @_;
  74     my $self = bless {
  75         name => undef,
  76     }, $class;
  77
  78     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
  79
  80     return $self;
  81 }
  82
  83 sub debug
  84 {
  85     my ($self, $what) = @_;
  86
  87     if ($self->{debug}) {
  88         if (ref $what) {
  89             print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
  90         } else {
  91             print "<pre>$what</pre>";
  92         }
  93     }
  94 }
  95
  96 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'
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
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     if ($row->{type} eq 'B') {
4038         # for jobfiles, we use only last Full backup. status client= returns
4039         # all files that have been checked
4040         my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
4041         my $query2 = $self->get_estimate_query('jobbytes',
4042                                                $row->{jobname}, $row->{level});
4043
4044         # LEFT JOIN because we always have a previous Full
4045         $query = "
4046 SELECT  corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
4047   FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
4048 ";
4049         $row = $self->dbh_selectrow_hashref($query);
4050
4051         if (!$row) {
4052             $row->{jobbytes} = $row->{jobfiles} = 0;
4053         }
4054     }
4055     my $cli = new Bweb::Client(name => $arg->{client});
4056     $cli->display_running_job($self, $arg->{jobid}, $row);
4057     if ($arg->{jobid}) {
4058         $self->get_job_log();
4059     }
4060 }
4061
4062 sub display_running_jobs
4063 {
4064     my ($self, $display_action) = @_;
4065     return if $self->cant_do('r_view_running_job');
4066
4067     # get security filter
4068     my $filter = $self->get_client_filter();
4069
4070     my $query = "
4071 SELECT Job.JobId AS jobid,
4072        Job.Name  AS jobname,
4073        Job.Level     AS level,
4074        Job.StartTime AS starttime,
4075        Job.JobFiles  AS jobfiles,
4076        Job.JobBytes  AS jobbytes,
4077        Job.JobStatus AS jobstatus,
4078 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
4079                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4080          AS duration,
4081        Client.Name AS clientname
4082 FROM Job INNER JOIN Client USING (ClientId) $filter
4083 WHERE
4084   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4085 ";
4086     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4087
4088     $self->display({ ID => $cur_id++,
4089                      display_action => $display_action,
4090                      Jobs => [ values %$all ]},
4091                    "running_job.tpl") ;
4092 }
4093
4094 sub display_group_stats
4095 {
4096     my ($self) = @_;
4097     my $arg = $self->get_form('age', 'since');
4098     return if $self->cant_do('r_view_stat');
4099
4100     my $filter = $self->get_client_group_filter();
4101
4102     my $jobt = $self->get_stat_table();
4103
4104     my ($limit, $label) = $self->get_limit(%$arg);
4105     my ($where, undef) = $self->get_param('client_groups', 'level');
4106
4107     my $query = "
4108 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_err, nb_resto
4109   FROM (
4110
4111     SELECT sum(JobBytes) AS nb_byte,
4112            sum(JobFiles) AS nb_file,
4113            count(1) AS nb_job, client_group_name
4114       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4115       JOIN client_group USING (client_group_id) $filter
4116      WHERE JobStatus IN ('T', 'W') AND Type IN ('M', 'B', 'g')
4117            $where $limit
4118     GROUP BY client_group_name ORDER BY client_group_name
4119
4120   ) AS T1 LEFT JOIN (
4121
4122     SELECT count(1) AS nb_err, client_group_name
4123       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4124       JOIN client_group USING (client_group_id)
4125      WHERE JobStatus IN ('E','e','f','A') AND Type = 'B'
4126            $where $limit
4127     GROUP BY client_group_name ORDER BY client_group_name
4128
4129   ) AS T3 USING (client_group_name) LEFT JOIN (
4130
4131     SELECT count(1) AS nb_resto, client_group_name
4132       FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4133       JOIN client_group USING (client_group_id)
4134      WHERE JobStatus IN ('T','W') AND Type = 'R'
4135            $where $limit
4136     GROUP BY client_group_name ORDER BY client_group_name
4137
4138   ) AS T2 USING (client_group_name)
4139 ";
4140     $self->debug($query);
4141     my $all = $self->dbh_selectall_hashref($query, 'name') ;
4142     $self->debug($all);
4143
4144     $self->display({ ID => $cur_id++,
4145                      label => $label,
4146                      Stats => [ values %$all ]},
4147                    "display_stats.tpl") ;
4148 }
4149
4150 # return the autochanger list to update
4151 sub eject_media
4152 {
4153     my ($self) = @_;
4154     $self->can_do('r_media_mgnt');
4155
4156     my %ret;
4157     my $arg = $self->get_form('jmedias');
4158
4159     unless ($arg->{jmedias}) {
4160         return $self->error("Can't get media selection");
4161     }
4162
4163     my $query = "
4164 SELECT Media.VolumeName  AS volumename,
4165        Storage.Name      AS storage,
4166        Location.Location AS location,
4167        Media.Slot        AS slot
4168 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
4169            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
4170 WHERE Media.VolumeName IN ($arg->{jmedias})
4171   AND Media.InChanger = 1
4172 ";
4173
4174     my $all = $self->dbh_selectall_hashref($query, 'volumename');
4175
4176     foreach my $vol (values %$all) {
4177         my $a = $self->ach_get($vol->{location});
4178         next unless ($a) ;
4179         $ret{$vol->{location}} = 1;
4180
4181         unless ($a->{have_status}) {
4182             $a->status();
4183             $a->{have_status} = 1;
4184         }
4185         # TODO: set enabled
4186         print "eject $vol->{volumename} from $vol->{storage} : ";
4187         if ($a->send_to_io($vol->{slot})) {
4188             print "<img src='/bweb/T.png' alt='ok'><br/>";
4189         } else {
4190             print "<img src='/bweb/E.png' alt='err'><br/>";
4191         }
4192     }
4193     return keys %ret;
4194 }
4195
4196 sub move_email
4197 {
4198     my ($self) = @_;
4199
4200     my ($to, $subject, $content) = (CGI::param('email'),
4201                                     CGI::param('subject'),
4202                                     CGI::param('content'));
4203     $to =~ s/[^\w\d\.\@<>,]//;
4204     $subject =~ s/[^\w\d\.\[\]]/ /;
4205
4206     open(MAIL, "|mail -s '$subject' '$to'") ;
4207     print MAIL $content;
4208     close(MAIL);
4209
4210     print "Mail sent";
4211 }
4212
4213 sub restore
4214 {
4215     my ($self) = @_;
4216
4217     my $arg = $self->get_form('jobid', 'client');
4218
4219     print CGI::header('text/brestore');
4220     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4221     print "client=$arg->{client}\n" if ($arg->{client});
4222     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4223     print "\n";
4224 }
4225
4226 # TODO : move this to Bweb::Autochanger ?
4227 # TODO : make this internal to not eject tape ?
4228 use Bconsole;
4229
4230
4231 sub ach_get
4232 {
4233     my ($self, $name) = @_;
4234
4235     unless ($name) {
4236         return $self->error("Can't get your autochanger name ach");
4237     }
4238
4239     unless ($self->{info}->{ach_list}) {
4240         return $self->error("Could not find any autochanger");
4241     }
4242
4243     my $a = $self->{info}->{ach_list}->{$name};
4244
4245     unless ($a) {
4246         $self->error("Can't get your autochanger $name from your ach_list");
4247         return undef;
4248     }
4249
4250     $a->{bweb}  = $self;
4251     $a->{debug} = $self->{debug};
4252
4253     return $a;
4254 }
4255
4256 sub ach_register
4257 {
4258     my ($self, $ach) = @_;
4259     $self->can_do('r_configure');
4260
4261     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4262
4263     $self->{info}->save();
4264
4265     return 1;
4266 }
4267
4268 sub ach_edit
4269 {
4270     my ($self) = @_;
4271     $self->can_do('r_configure');
4272
4273     my $arg = $self->get_form('ach');
4274     if (!$arg->{ach}
4275         or !$self->{info}->{ach_list}
4276         or !$self->{info}->{ach_list}->{$arg->{ach}})
4277     {
4278         return $self->error("Can't get autochanger name");
4279     }
4280
4281     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4282
4283     my $i=0;
4284     $ach->{drives} =
4285         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4286
4287     my $b = $self->get_bconsole();
4288
4289     my @storages = $b->list_storage() ;
4290
4291     $ach->{devices} = [ map { { name => $_ } } @storages ];
4292
4293     $self->display($ach, "ach_add.tpl");
4294     delete $ach->{drives};
4295     delete $ach->{devices};
4296     return 1;
4297 }
4298
4299 sub ach_del
4300 {
4301     my ($self) = @_;
4302     $self->can_do('r_configure');
4303
4304     my $arg = $self->get_form('ach');
4305
4306     if (!$arg->{ach}
4307         or !$self->{info}->{ach_list}
4308         or !$self->{info}->{ach_list}->{$arg->{ach}})
4309     {
4310         return $self->error("Can't get autochanger name");
4311     }
4312
4313     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4314
4315     $self->{info}->save();
4316     $self->{info}->view();
4317 }
4318
4319 sub ach_add
4320 {
4321     my ($self) = @_;
4322     $self->can_do('r_configure');
4323
4324     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4325
4326     my $b = $self->get_bconsole();
4327     my @storages = $b->list_storage() ;
4328
4329     unless ($arg->{ach}) {
4330         $arg->{devices} = [ map { { name => $_ } } @storages ];
4331         return $self->display($arg, "ach_add.tpl");
4332     }
4333
4334     my @drives ;
4335     foreach my $drive (CGI::param('drives'))
4336     {
4337         unless (grep(/^$drive$/,@storages)) {
4338             return $self->error("Can't find $drive in storage list");
4339         }
4340
4341         my $index = CGI::param("index_$drive");
4342         unless (defined $index and $index =~ /^(\d+)$/) {
4343             return $self->error("Can't get $drive index");
4344         }
4345
4346         $drives[$index] = $drive;
4347     }
4348
4349     unless (@drives) {
4350         return $self->error("Can't get drives from Autochanger");
4351     }
4352
4353     my $a = new Bweb::Autochanger(name   => $arg->{ach},
4354                                   precmd => $arg->{precmd},
4355                                   drive_name => \@drives,
4356                                   device => $arg->{device},
4357                                   mtxcmd => $arg->{mtxcmd});
4358
4359     $self->ach_register($a) ;
4360
4361     $self->{info}->view();
4362 }
4363
4364 sub delete
4365 {
4366     my ($self) = @_;
4367     $self->can_do('r_delete_job');
4368
4369     my $arg = $self->get_form('jobid');
4370
4371     if ($arg->{jobid}) {
4372         my $b = $self->get_bconsole();
4373         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4374
4375         $self->display({
4376             content => $ret,
4377             title => "Delete a job ",
4378             name => "delete jobid=$arg->{jobid}",
4379             id => $cur_id++,
4380         }, "command.tpl");
4381     }
4382 }
4383
4384 sub do_update_media
4385 {
4386     my ($self) = @_ ;
4387     $self->can_do('r_media_mgnt');
4388
4389     my $arg = $self->get_form(qw/media volstatus inchanger pool
4390                                  slot volretention voluseduration
4391                                  maxvoljobs maxvolfiles maxvolbytes
4392                                  qcomment poolrecycle enabled
4393                               /);
4394
4395     unless ($arg->{media}) {
4396         return $self->error("Can't find media selection");
4397     }
4398
4399     my $update = "update volume=$arg->{media} ";
4400
4401     if ($arg->{volstatus}) {
4402         $update .= " volstatus=$arg->{volstatus} ";
4403     }
4404
4405     if ($arg->{inchanger}) {
4406         $update .= " inchanger=yes " ;
4407         if ($arg->{slot}) {
4408             $update .= " slot=$arg->{slot} ";
4409         }
4410     } else {
4411         $update .= " slot=0 inchanger=no ";
4412     }
4413
4414     if ($arg->{enabled}) {
4415         $update .= " enabled=$arg->{enabled} ";
4416     }
4417
4418     if ($arg->{pool}) {
4419         $update .= " pool=$arg->{pool} " ;
4420     }
4421
4422     if (defined $arg->{volretention}) {
4423         $update .= " volretention=\"$arg->{volretention}\" " ;
4424     }
4425
4426     if (defined $arg->{voluseduration}) {
4427         $update .= " voluse=\"$arg->{voluseduration}\" " ;
4428     }
4429
4430     if (defined $arg->{maxvoljobs}) {
4431         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4432     }
4433
4434     if (defined $arg->{maxvolfiles}) {
4435         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4436     }
4437
4438     if (defined $arg->{maxvolbytes}) {
4439         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4440     }
4441
4442     if (defined $arg->{poolrecycle}) {
4443         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4444     }
4445
4446     my $b = $self->get_bconsole();
4447
4448     $self->display({
4449         content => $b->send_cmd($update),
4450         title => "Update a volume ",
4451         name => $update,
4452         id => $cur_id++,
4453     }, "command.tpl");
4454
4455
4456     my @q;
4457     my $media = $self->dbh_quote($arg->{media});
4458
4459     my $loc = CGI::param('location') || '';
4460     if ($loc) {
4461         $loc = $self->dbh_quote($loc); # is checked by db
4462         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4463     }
4464     if (!$arg->{qcomment}) {
4465         $arg->{qcomment} = "''";
4466     }
4467     push @q, "Comment=$arg->{qcomment}";
4468
4469
4470     my $query = "
4471 UPDATE Media
4472    SET " . join (',', @q) . "
4473  WHERE Media.VolumeName = $media
4474 ";
4475     $self->dbh_do($query);
4476
4477     $self->update_media();
4478 }
4479
4480 sub update_slots
4481 {
4482     my ($self) = @_;
4483     $self->can_do('r_autochanger_mgnt');
4484
4485     my $ach = CGI::param('ach') ;
4486     $ach = $self->ach_get($ach);
4487     unless ($ach) {
4488         return $self->error("Bad autochanger name");
4489     }
4490
4491     $self->display({
4492         title => "Scanning autochanger content ",
4493         name => "update slots",
4494         notail => 1,
4495         id => $cur_id++,
4496     }, "command.tpl");
4497     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4498     $b->update_slots($ach->{name});
4499
4500     $self->display({
4501         nohead => 1,
4502     }, "command.tpl");
4503 }
4504
4505 sub get_job_log
4506 {
4507     my ($self) = @_;
4508     $self->can_do('r_view_log');
4509
4510     my $arg = $self->get_form('jobid', 'limit', 'offset');
4511     unless ($arg->{jobid}) {
4512         return $self->error("Can't get jobid");
4513     }
4514
4515     if ($arg->{limit} == 100) {
4516         $arg->{limit} = 1000;
4517     }
4518     # get security filter
4519     my $filter = $self->get_client_filter();
4520
4521     my $query = "
4522 SELECT Job.Name as name, Client.Name as clientname
4523  FROM  Job INNER JOIN Client USING (ClientId) $filter
4524  WHERE JobId = $arg->{jobid}
4525 ";
4526
4527     my $row = $self->dbh_selectrow_hashref($query);
4528
4529     unless ($row) {
4530         return $self->error("Can't find $arg->{jobid} in catalog");
4531     }
4532
4533     # display only Error and Warning messages
4534     $filter = '';
4535     if (CGI::param('error')) {
4536         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4537     }
4538
4539     my $logtext;
4540     if (CGI::param('time') || $self->{info}->{display_log_time}) {
4541         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4542     } else {
4543         $logtext = 'LogText';
4544     }
4545
4546     $query = "
4547 SELECT count(1) AS nbline,
4548        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt, id
4549   FROM  (
4550     SELECT 1 AS id, Time, LogText
4551     FROM Log
4552    WHERE ( Log.JobId = $arg->{jobid}
4553       OR (Log.JobId = 0
4554           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4555           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4556        ) ) $filter
4557  ORDER BY LogId
4558  LIMIT $arg->{limit}
4559  OFFSET $arg->{offset}
4560  ) AS temp
4561  GROUP BY id
4562
4563 ";
4564
4565     my $log = $self->dbh_selectrow_hashref($query);
4566     unless ($log) {
4567         return $self->error("Can't get log for jobid $arg->{jobid}");
4568     }
4569     $log->{logtxt} =~ s/\0//g;
4570     $self->display({ lines=> $log->{logtxt},
4571                      nbline => $log->{nbline},
4572                      jobid => $arg->{jobid},
4573                      name  => $row->{name},
4574                      client => $row->{clientname},
4575                      offset => $arg->{offset},
4576                      limit  => $arg->{limit},
4577                  }, 'display_log.tpl');
4578 }
4579
4580 sub cancel_future_job
4581 {
4582     my ($self) = @_;
4583     $self->can_do('r_cancel_job');
4584
4585     my $arg = $self->get_form(qw/job pool level client when/);
4586
4587     if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4588          or !$arg->{client} or !$arg->{when})
4589     {
4590         return $self->error("Can't get enough information to mark this job as canceled");
4591     }
4592
4593     $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4594     my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4595
4596     if ($jobtable =~ /^Job$/i) {
4597         return $self->error("Can add records only in history table");
4598     }
4599     my $jname = "$arg->{job}.$arg->{when}";
4600     $jname =~ s/\s/_/g;
4601
4602     my $found = $self->dbh_selectrow_hashref("
4603 SELECT 1
4604   FROM $jobtable
4605  WHERE JobId = 0
4606    AND Job = '$jname'
4607    AND Name = '$arg->{job}'
4608 ");
4609     if ($found) {
4610         return $self->error("$jname is already in history table");
4611     }
4612
4613         $self->dbh_do("
4614 INSERT INTO $jobtable
4615   (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4616    RealEndTime, ClientId, PoolId)
4617  VALUES
4618   (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4619    '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4620    (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4621    (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4622   )
4623 ");
4624     $self->display({ Filter => "Dummy record for $jname",
4625                      ID => 1,
4626                      Jobs =>
4627                          [{ jobid => 0,
4628                             client => $arg->{client},
4629                             jobname => $arg->{job},
4630                             pool => $arg->{pool},
4631                             level => $arg->{level},
4632                             starttime => $arg->{when},
4633                             duration => '00:00:00',
4634                             jobfiles => 0,
4635                             jobbytes => 0,
4636                             joberrors => 0,
4637                             jobstatus => 'A',
4638                      }]
4639                    },
4640                    "display_job.tpl");
4641 }
4642
4643 sub add_media
4644 {
4645     my ($self) = @_ ;
4646     $self->can_do('r_media_mgnt');
4647     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4648     my $b = $self->get_bconsole();
4649
4650     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4651         CGI::param(offset => 0);
4652         $arg = $self->get_form('db_pools');
4653         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4654         $self->display($arg, 'add_media.tpl');
4655         return 1;
4656     }
4657
4658     my $cmd;
4659     if ($arg->{nb} > 0) {
4660         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4661         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4662     } else {
4663         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4664     }
4665     $b->connect();
4666     $b->send($cmd);
4667     $b->expect_it('*');
4668
4669     CGI::param('media', '');
4670     CGI::param('re_media', $arg->{media});
4671     $self->display_media();
4672 }
4673
4674 sub label_barcodes
4675 {
4676     my ($self) = @_ ;
4677     $self->can_do('r_autochanger_mgnt');
4678
4679     my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4680
4681     unless ($arg->{ach}) {
4682         return $self->error("Can't find autochanger name");
4683     }
4684
4685     my $a = $self->ach_get($arg->{ach});
4686     unless ($a) {
4687         return $self->error("Can't find autochanger name in configuration");
4688     }
4689
4690     my $storage = $a->get_drive_name($arg->{drive});
4691     unless ($storage) {
4692         return $self->error("Can't get your drive name");
4693     }
4694
4695     my $slots = '';
4696     my $slots_sql = '';
4697     my $t = 300 ;
4698     if ($arg->{slots}) {
4699         $slots = join(",", @{ $arg->{slots} });
4700         $slots_sql = " AND Slot IN ($slots) ";
4701         $t += 60*scalar( @{ $arg->{slots} }) ;
4702     }
4703     my $pool = $arg->{pool} || 'Scratch';
4704     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4705     print "<h1>This command can take long time, be patient...</h1>";
4706     print "<pre>" ;
4707     $b->label_barcodes(storage => $storage,
4708                        drive => $arg->{drive},
4709                        pool  => $pool,
4710                        slots => $slots) ;
4711     $b->close();
4712     print "</pre>";
4713
4714     $self->dbh_do("
4715   UPDATE Media
4716        SET LocationId =   (SELECT LocationId
4717                              FROM Location
4718                             WHERE Location = '$arg->{ach}')
4719
4720      WHERE (LocationId = 0 OR LocationId IS NULL)
4721        $slots_sql
4722 ");
4723
4724 }
4725
4726 sub purge
4727 {
4728     my ($self) = @_;
4729     $self->can_do('r_purge');
4730
4731     my @volume = CGI::param('media');
4732
4733     unless (@volume) {
4734         return $self->error("Can't get media selection");
4735     }
4736
4737     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4738
4739     foreach my $v (@volume) {
4740         $self->display({
4741             content => $b->purge_volume($v),
4742             title => "Purge media",
4743             name => "purge volume=$v",
4744             id => $cur_id++,
4745         }, "command.tpl");
4746     }
4747     $b->close();
4748 }
4749
4750 sub prune
4751 {
4752     my ($self) = @_;
4753     $self->can_do('r_prune');
4754
4755     my @volume = CGI::param('media');
4756     unless (@volume) {
4757         return $self->error("Can't get media selection");
4758     }
4759
4760     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4761
4762     foreach my $v (@volume) {
4763         $self->display({
4764             content => $b->prune_volume($v),
4765             title => "Prune volume",
4766             name => "prune volume=$v",
4767             id => $cur_id++,
4768         }, "command.tpl");
4769     }
4770     $b->close();
4771 }
4772
4773 sub cancel_job
4774 {
4775     my ($self) = @_;
4776     $self->can_do('r_cancel_job');
4777
4778     my $arg = $self->get_form('jobid');
4779     unless ($arg->{jobid}) {
4780         return $self->error("Can't get jobid");
4781     }
4782
4783     my $b = $self->get_bconsole();
4784     $self->display({
4785         content => $b->cancel($arg->{jobid}),
4786         title => "Cancel job",
4787         name => "cancel jobid=$arg->{jobid}",
4788         id => $cur_id++,
4789     }, "command.tpl");
4790 }
4791
4792 sub fileset_view
4793 {
4794     # Warning, we display current fileset
4795     my ($self) = @_;
4796
4797     my $arg = $self->get_form('fileset');
4798
4799     if ($arg->{fileset}) {
4800         my $b = $self->get_bconsole();
4801         my $ret = $b->get_fileset($arg->{fileset});
4802         $self->display({ fileset => $arg->{fileset},
4803                          %$ret,
4804                      }, "fileset_view.tpl");
4805     } else {
4806         $self->error("Can't get fileset name");
4807     }
4808 }
4809
4810 sub director_show_sched
4811 {
4812     my ($self) = @_ ;
4813     $self->can_do('r_view_job');
4814     my $arg = $self->get_form('days');
4815
4816     my $b = $self->get_bconsole();
4817     my $ret = $b->director_get_sched( $arg->{days} );
4818
4819     $self->display({
4820         id => $cur_id++,
4821         list => $ret,
4822     }, "scheduled_job.tpl");
4823 }
4824
4825 sub enable_disable_job
4826 {
4827     my ($self, $what) = @_ ;
4828     $self->can_do('r_run_job');
4829
4830     my $arg = $self->get_form('job');
4831     if (!$arg->{job}) {
4832         return $self->error("Can't find job name");
4833     }
4834
4835     my $b = $self->get_bconsole();
4836
4837     my $cmd;
4838     if ($what) {
4839         $cmd = "enable";
4840     } else {
4841         $cmd = "disable";
4842     }
4843
4844     $self->display({
4845         content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4846         title => "$cmd $arg->{job}",
4847         name => "$cmd job=\"$arg->{job}\"",
4848         id => $cur_id++,
4849     }, "command.tpl");
4850 }
4851
4852 sub get_bconsole
4853 {
4854     my ($self) = @_;
4855     return new Bconsole(pref => $self->{info});
4856 }
4857
4858 sub cmd_storage
4859 {
4860     my ($self) = @_;
4861     $self->can_do('r_storage_mgnt');
4862     my $arg = $self->get_form(qw/storage storage_cmd drive/);
4863     my $b = $self->get_bconsole();
4864
4865     if ($arg->{storage} and $arg->{storage_cmd}) {
4866         my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive}";
4867         my $ret = $b->send_cmd($cmd);
4868
4869         $self->display({
4870             content => $ret,
4871             title => "Storage ",
4872             name => $cmd,
4873             id => $cur_id++,
4874         }, "command.tpl");
4875     } else {
4876         my $storages= [ map { { name => $_ } } $b->list_storage()];
4877         $self->display({ storage => $storages}, "cmd_storage.tpl");
4878     }
4879 }
4880
4881 sub run_job_select
4882 {
4883     my ($self) = @_;
4884     $self->can_do('r_run_job');
4885
4886     my $b = $self->get_bconsole();
4887
4888     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4889
4890     $self->display({ Jobs => $joblist }, "run_job.tpl");
4891 }
4892
4893 sub run_parse_job
4894 {
4895     my ($self, $ouput) = @_;
4896
4897     my %arg;
4898     $self->debug($ouput);
4899     foreach my $l (split(/\r?\n/, $ouput)) {
4900         $self->debug($l);
4901         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4902             $arg{$1} = $2;
4903             $l = $3
4904                 if ($3) ;
4905         }
4906
4907         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4908             %arg = (%arg, @l);
4909         }
4910     }
4911
4912     my %lowcase ;
4913     foreach my $k (keys %arg) {
4914         $lowcase{lc($k)} = $arg{$k} ;
4915     }
4916     $self->debug(\%lowcase);
4917     return \%lowcase;
4918 }
4919
4920 sub run_job_mod
4921 {
4922     my ($self) = @_;
4923     $self->can_do('r_run_job');
4924
4925     my $b = $self->get_bconsole();
4926     my $arg = $self->get_form(qw/pool level client fileset storage media job/);
4927
4928     if (!$arg->{job}) {
4929         return $self->error("Can't get job name");
4930     }
4931
4932     # we take informations from director, and we overwrite with user wish
4933     my $info = $b->send_cmd("show job=\"$arg->{job}\"");
4934     my $attr = $self->run_parse_job($info);
4935
4936     if (!$arg->{pool} and $arg->{media}) {
4937         my $r = $self->dbh_selectrow_hashref("
4938 SELECT Pool.Name AS name
4939   FROM Media JOIN Pool USING (PoolId)
4940  WHERE Media.VolumeName = '$arg->{media}'
4941    AND Pool.Name != 'Scratch'
4942 ");
4943         if ($r) {
4944             $arg->{pool} = $r->{name};
4945         }
4946     }
4947
4948     my %job_opt = (%$attr, %$arg);
4949
4950     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4951
4952     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4953     my $clients = [ map { { name => $_ } }$b->list_client()];
4954     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4955     my $storages= [ map { { name => $_ } }$b->list_storage()];
4956
4957     $self->display({
4958         jobs     => $jobs,
4959         pools    => $pools,
4960         clients  => $clients,
4961         filesets => $filesets,
4962         storages => $storages,
4963         %job_opt,
4964     }, "run_job_mod.tpl");
4965 }
4966
4967 sub run_job
4968 {
4969     my ($self) = @_;
4970     $self->can_do('r_run_job');
4971
4972     my $b = $self->get_bconsole();
4973
4974     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4975
4976     $self->display({
4977         jobs     => $jobs,
4978     }, "run_job.tpl");
4979 }
4980
4981 sub run_job_now
4982 {
4983     my ($self) = @_;
4984     $self->can_do('r_run_job');
4985
4986     my $b = $self->get_bconsole();
4987
4988     # TODO: check input (don't use pool, level)
4989
4990     my $arg = $self->get_form(qw/pool level client priority when
4991                                  fileset job storage/);
4992     if (!$arg->{job}) {
4993         return $self->error("Can't get your job name");
4994     }
4995
4996     my $jobid = $b->run(job => $arg->{job},
4997                         client => $arg->{client},
4998                         priority => $arg->{priority},
4999                         level => $arg->{level},
5000                         storage => $arg->{storage},
5001                         pool => $arg->{pool},
5002                         fileset => $arg->{fileset},
5003                         when => $arg->{when},
5004                         );
5005
5006     print $b->{error};
5007
5008     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>";
5009 }
5010
5011 sub display_next_job
5012 {
5013     my ($self) = @_;
5014
5015     my $arg = $self->get_form(qw/job begin end/);
5016     if (!$arg->{job}) {
5017         return $self->error("Can't get job name");
5018     }
5019
5020     my $b = $self->get_bconsole();
5021
5022     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5023     my $attr = $self->run_parse_job($job);
5024
5025     if (!$attr->{schedule}) {
5026         return $self->error("Can't get $arg->{job} schedule");
5027     }
5028     my $jpool=$attr->{pool} || '';
5029
5030     my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5031                                 begin => $arg->{begin}, end => $arg->{end});
5032
5033     my $ss = $sched->get_scheds($attr->{schedule});
5034     my @ret;
5035
5036     foreach my $s (@$ss) {
5037         my $level = $sched->get_level($s);
5038         my $pool  = $sched->get_pool($s) || $jpool;
5039         my $evt = $sched->get_event($s);
5040         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5041     }
5042
5043     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5044 }
5045
5046 # permit to verify for higher level backup
5047 # we attempt a Increment, we made a Full, that ok
5048 # TODO: Pool may have change
5049 sub get_higher_level
5050 {
5051     my ($self, $level) = @_;
5052     if ($level eq 'F') {
5053         return "'F'";
5054     } elsif ($level eq 'D') {
5055         return "'F', 'D'";
5056     } elsif ($level eq 'I') {
5057         return "'F', 'D', 'I'";
5058     }
5059     return "''";
5060 }
5061
5062 # check jobs against their schedule
5063 sub check_job
5064 {
5065     my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5066     return undef if (!$self->can_view_client($client));
5067
5068     my $sch = $sched->get_scheds($schedname);
5069     return undef if (!$sch);
5070
5071     my @ret;
5072     foreach my $s (@$sch) {
5073         my $pool;
5074         if ($type eq 'B') {     # we take the pool only for backup job
5075             $pool = $sched->get_pool($s) || $job_pool;
5076         }
5077         my $level = $sched->get_level($s);
5078         my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5079         $l = $self->get_higher_level($l);
5080         my $evts = $sched->get_event($s);
5081         my $end = $sched->{end}; # this backup must have start before the next one
5082         foreach my $evt (reverse @$evts) {
5083             my $all = $self->dbh_selectrow_hashref("
5084  SELECT 1
5085    FROM Job
5086    JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5087   WHERE Job.StartTime >= '$evt'
5088     AND Job.StartTime <  '$end'
5089     AND Job.Name = '$job'
5090     AND Job.Type = '$type'
5091     AND Job.JobStatus IN ('T', 'W')
5092     AND Job.Level IN ($l)
5093 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5094     AND Client.Name = '$client'
5095  LIMIT 1
5096 ");
5097             if ($all) {
5098 #               print "ok $job ";
5099             } else {
5100                 push @{$self->{tmp}}, {date => $evt, level => $level,
5101                                        type => 'Backup', name => $job,
5102                                        pool => $pool, volume => $pool,
5103                                        client => $client};
5104             }
5105             $end = $evt;
5106         }
5107     }
5108 }
5109
5110 sub display_missing_job
5111 {
5112     my ($self) = @_;
5113     my $arg = $self->get_form(qw/begin end age/);
5114
5115     if (!$arg->{begin}) { # TODO: change this
5116         $arg->{begin} = strftime('%F %T', localtime(time - $arg->{age}));
5117     }
5118     if (!$arg->{end}) {
5119         $arg->{end} = strftime('%F %T', localtime(time));
5120     }
5121     $self->{tmp} = [];          # check_job use this for result
5122
5123     my $bconsole = $self->get_bconsole();
5124
5125     my $sched = new Bweb::Sched(bconsole => $bconsole,
5126                                 begin => $arg->{begin},
5127                                 end => $arg->{end});
5128
5129     my $job = $bconsole->send_cmd("show job");
5130     my ($jname, $jsched, $jclient, $jpool, $jtype);
5131     foreach my $j (split(/\r?\n/, $job)) {
5132         if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5133             if ($jname and $jsched) {
5134                 $self->check_job($sched, $jsched, $jname,
5135                                  $jpool, $jclient, $jtype);
5136             }
5137             $jname = $1;
5138             $jtype = chr($2);
5139             $jclient = $jpool = $jsched = undef;
5140         } elsif ($j =~ /Client: name=(.+?) address=/i) {
5141             $jclient = $1;
5142         } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5143             $jpool = $1;
5144         } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5145             $jsched = $1;
5146         }
5147     }
5148     $self->display({
5149         id => $cur_id++,
5150         title => "Missing Job (since $arg->{begin} to $arg->{end})",
5151         list => $self->{tmp},
5152         wiki_url => $self->{info}->{wiki_url},
5153         missing_mode => 1,
5154     }, "scheduled_job.tpl");
5155
5156     delete $self->{tmp};
5157 }
5158
5159 1;