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