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

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