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

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