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

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