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();
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 # cleanup and add a schedule
1052 sub add_sched
1053 {
1054     my ($self, $name, $info) = @_;
1055     # bacula uses dates that start from 0, we start from 1
1056     foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1057
1058     # get events
1059     $info->{event} = [ $self->get_events($info, $self->{format}) ];
1060
1061     foreach my $i (qw/hour mday month wday wom woy mins/) {
1062         delete $info->{$i};
1063     }
1064
1065     push @{$self->{schedules}->{$name}}, $info;
1066 }
1067
1068 # return the name of all schedules
1069 sub list_scheds
1070 {
1071     my ($self, $name) = @_;
1072     my %ret;
1073     return keys %{ $self->{schedules} };
1074 }
1075
1076 # return an array of all schedule
1077 sub get_scheds
1078 {
1079     my ($self, $sched) = @_;
1080     return $self->{schedules}->{$sched};
1081 }
1082
1083 # return an ref array of all events
1084 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1085 sub get_event
1086 {
1087     my ($self, $sched) = @_;
1088     return $sched->{event};
1089 }
1090
1091 # return the pool name
1092 sub get_pool
1093 {
1094     my ($self, $sched) = @_;
1095     return $sched->{pool} || '';
1096 }
1097
1098 # return the level name (Incremental, Differential, Full)
1099 sub get_level
1100 {
1101     my ($self, $sched) = @_;
1102     return $sched->{level};
1103 }
1104
1105 # parse bacula sched bitmap
1106 sub parse_scheds
1107 {
1108     my ($self, @output) = @_;
1109
1110     my $run;
1111     my $name;
1112     my $schedule;
1113     my $elt;
1114
1115     foreach my $ligne (@output) {
1116         if ($ligne =~ /Schedule: name=(.+)/) {
1117             if ($name and $elt) {
1118                 $elt->{level} = $run;
1119                 $self->add_sched($name, $elt);
1120                 $elt=undef;
1121             }
1122             $name = $1;
1123         }
1124         elsif ($ligne =~ /Run Level=(.+)/) {
1125             if ($name and $elt) {
1126                 $elt->{level} = $run;
1127                 $self->add_sched($name, $elt);
1128                 $elt=undef;
1129             }
1130             $run = $1;
1131         }
1132         elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1133             # All theses lines have the same format
1134
1135             my ($k,$v) = ($1,$2);
1136             # we get all values (0 1 4 9)
1137             $elt->{$k}=[split (/\s/,$v)];
1138         }
1139         # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1140         elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1141             my ($k,$v) = ($1,$2);
1142             foreach my $e (split (/\s/,$v)) {
1143                 $elt->{$k}->[$e]=1;
1144             }
1145         }
1146         elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1147             $elt->{pool} = $1;
1148         }
1149     }
1150
1151     if ($name and $elt) {
1152         $elt->{level} = $run;
1153         $self->add_sched($name, $elt);
1154     }
1155 }
1156
1157 use Date::Calc qw(:all);
1158
1159 # read bacula schedule bitmap and get $format date string
1160 sub get_events
1161 {
1162     use integer;
1163     my ($self, $s,$format) = @_;
1164     my $year = $self->{year} || ((localtime)[5] + 1900);
1165     $format = $format || '%u-%02u-%02u %02u:%02u';
1166     my @ret;
1167     foreach my $m (@{$s->{month}})              # mois de l'annee
1168     {
1169         foreach my $md (@{$s->{mday}})  # jour du mois
1170         {
1171 #           print "  m=$m md=$md\n";
1172             # we check if this day exists (31 fev)
1173             next if (!check_date($year,$m,$md));
1174 #           print "    check_date ok\n";
1175
1176             my $w = ($md-1)/7; # we use the same thing than bacula
1177             next if (! $s->{wom}->[$w]);
1178 #           print "      wom ok\n";
1179
1180             # on recupere le jour de la semaine
1181             my $wd = Day_of_Week($year,$m,$md);
1182
1183             my ($w1,undef) = Week_of_Year($year,$m,$wd);
1184             next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1185 #           print "        woy ok\n";
1186
1187             $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1188             next if (! $s->{wday}->[$wd]);
1189 #           print "          wday ok\n";
1190
1191             foreach my $h (@{$s->{hour}}) # hour of the day
1192             {
1193                 foreach my $min (@{$s->{mins}}) # minute
1194                 {
1195                     push @ret, sprintf($format, $year,$m,$md,$h,$min);
1196                 }
1197             }
1198         }
1199     }
1200     return @ret;
1201 }
1202
1203 ################################################################
1204
1205 package Bweb;
1206
1207 use base q/Bweb::Gui/;
1208
1209 =head1 PACKAGE
1210
1211     Bweb - main Bweb package
1212
1213 =head2
1214
1215     this package is use to compute and display informations
1216
1217 =cut
1218
1219 use DBI;
1220 use POSIX qw/strftime/;
1221
1222 our $config_file='/etc/bacula/bweb.conf';
1223
1224 our $cur_id=0;
1225
1226 =head1 VARIABLE
1227
1228     %sql_func - hash to make query mysql/postgresql compliant
1229
1230 =cut
1231
1232 our %sql_func = (
1233           Pg => {
1234               UNIX_TIMESTAMP => '',
1235               FROM_UNIXTIME => '',
1236               TO_SEC => " interval '1 second' * ",
1237               SEC_TO_INT => "SEC_TO_INT",
1238               SEC_TO_TIME => '',
1239               MATCH => " ~* ",
1240               STARTTIME_SEC  => " date_trunc('sec', Job.StartTime) ",
1241               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1242               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1243               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1244               STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1245               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1246               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1247               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1248               STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1249               DB_SIZE => " SELECT pg_database_size(current_database()) ",
1250               CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1251               CONCAT_SEP => "",
1252           },
1253           mysql => {
1254               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1255               FROM_UNIXTIME => 'FROM_UNIXTIME',
1256               SEC_TO_INT => '',
1257               TO_SEC => '',
1258               SEC_TO_TIME => 'SEC_TO_TIME',
1259               MATCH => " REGEXP ",
1260               STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1261               STARTTIME_DAY  => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1262               STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1263               STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1264               STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1265               STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1266               STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1267               STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1268               STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1269               # with mysql < 5, you have to play with the ugly SHOW command
1270               DB_SIZE => " SELECT 0 ",
1271               # works only with mysql 5
1272               # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1273               CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1274               CONCAT_SEP => " SEPARATOR '' ",
1275           },
1276          );
1277
1278 sub dbh_is_mysql
1279 {
1280     my ($self) = @_;
1281     return $self->{info}->{dbi} =~ /dbi:mysql/i;
1282 }
1283
1284 sub dbh_disconnect
1285 {
1286     my ($self) = @_;
1287     if ($self->{dbh}) {
1288        $self->{dbh}->disconnect();
1289        undef $self->{dbh};
1290     }
1291 }
1292
1293 sub dbh_selectall_arrayref
1294 {
1295     my ($self, $query) = @_;
1296     $self->connect_db();
1297     $self->debug($query);
1298     return $self->{dbh}->selectall_arrayref($query);
1299 }
1300
1301 sub dbh_join
1302 {
1303     my ($self, @what) = @_;
1304     return join(',', $self->dbh_quote(@what)) ;
1305 }
1306
1307 sub dbh_quote
1308 {
1309     my ($self, @what) = @_;
1310
1311     $self->connect_db();
1312     if (wantarray) {
1313         return map { $self->{dbh}->quote($_) } @what;
1314     } else {
1315         return $self->{dbh}->quote($what[0]) ;
1316     }
1317 }
1318
1319 sub dbh_do
1320 {
1321     my ($self, $query) = @_ ;
1322     $self->connect_db();
1323     $self->debug($query);
1324     return $self->{dbh}->do($query);
1325 }
1326
1327 sub dbh_selectall_hashref
1328 {
1329     my ($self, $query, $join) = @_;
1330
1331     $self->connect_db();
1332     $self->debug($query);
1333     return $self->{dbh}->selectall_hashref($query, $join) ;
1334 }
1335
1336 sub dbh_selectrow_hashref
1337 {
1338     my ($self, $query) = @_;
1339
1340     $self->connect_db();
1341     $self->debug($query);
1342     return $self->{dbh}->selectrow_hashref($query) ;
1343 }
1344
1345 sub dbh_strcat
1346 {
1347     my ($self, @what) = @_;
1348     if ($self->dbh_is_mysql()) {
1349         return 'CONCAT(' . join(',', @what) . ')' ;
1350     } else {
1351         return join(' || ', @what);
1352     }
1353 }
1354
1355 sub dbh_prepare
1356 {
1357     my ($self, $query) = @_;
1358     $self->debug($query, up => 1);
1359     return $self->{dbh}->prepare($query);
1360 }
1361
1362 # display Mb/Gb/Kb
1363 sub human_size
1364 {
1365     my @unit = qw(B KB MB GB TB);
1366     my $val = shift || 0;
1367     my $i=0;
1368     my $format = '%i %s';
1369     while ($val / 1024 > 1) {
1370         $i++;
1371         $val /= 1024;
1372     }
1373     $format = ($i>0)?'%0.1f %s':'%i %s';
1374     return sprintf($format, $val, $unit[$i]);
1375 }
1376
1377 # display Day, Hour, Year
1378 sub human_sec
1379 {
1380     use integer;
1381
1382     my $val = shift;
1383     $val /= 60;                 # sec -> min
1384
1385     if ($val / 60 <= 1) {
1386         return "$val mins";
1387     }
1388
1389     $val /= 60;                 # min -> hour
1390     if ($val / 24 <= 1) {
1391         return "$val hours";
1392     }
1393
1394     $val /= 24;                 # hour -> day
1395     if ($val / 365 < 2) {
1396         return "$val days";
1397     }
1398
1399     $val /= 365 ;               # day -> year
1400
1401     return "$val years";
1402 }
1403
1404 # display Enabled
1405 sub human_enabled
1406 {
1407     my $val = shift || 0;
1408
1409     if ($val eq '1' or $val eq "yes") {
1410         return "yes";
1411     } elsif ($val eq '2' or $val eq "archived") {
1412         return "archived";
1413     } else {
1414         return  "no";
1415     }
1416 }
1417
1418 # display Enabled
1419 sub from_human_enabled
1420 {
1421     my $val = shift || 0;
1422
1423     if ($val eq '1' or $val eq "yes") {
1424         return 1;
1425     } elsif ($val eq '2' or $val eq "archived") {
1426         return 2;
1427     } else {
1428         return  0;
1429     }
1430 }
1431
1432 # get Day, Hour, Year
1433 sub from_human_sec
1434 {
1435     use integer;
1436
1437     my $val = shift;
1438     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1439         return 0;
1440     }
1441
1442     my %times = ( m   => 60,
1443                   h   => 60*60,
1444                   d   => 60*60*24,
1445                   m   => 60*60*24*31,
1446                   y   => 60*60*24*365,
1447                   );
1448     my $mult = $times{$2} || 0;
1449
1450     return $1 * $mult;
1451 }
1452
1453
1454 sub connect_db
1455 {
1456     my ($self) = @_;
1457
1458     unless ($self->{dbh}) {
1459
1460         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1461                                     $self->{info}->{user},
1462                                     $self->{info}->{password});
1463
1464         $self->error("Can't connect to your database:\n$DBI::errstr\n")
1465             unless ($self->{dbh});
1466
1467         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1468
1469         if ($self->dbh_is_mysql()) {
1470             $self->{dbh}->do("SET group_concat_max_len=1000000");
1471         } else {
1472             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1473         }
1474     }
1475 }
1476
1477 sub new
1478 {
1479     my ($class, %arg) = @_;
1480     my $self = bless ({
1481         dbh => undef,           # connect_db();
1482         info => {
1483             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1484             user  => 'bacula',
1485             password => 'test',
1486         },
1487     },$class) ;
1488
1489     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1490
1491     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1492         $self->{sql} = $sql_func{$1};
1493     }
1494
1495     $self->{loginname} = CGI::remote_user();
1496     $self->{debug} = $self->{info}->{debug};
1497     $self->{lang} = $self->{info}->{lang};
1498     $self->{template_dir} = $self->{info}->{template_dir};
1499
1500     return $self;
1501 }
1502
1503 sub display_begin
1504 {
1505     my ($self) = @_;
1506     if ($self->{info}->{enable_security}) {
1507         $self->get_roles();     # get lang
1508     }
1509     $self->display($self->{info}, "begin.tpl");
1510 }
1511
1512 sub display_end
1513 {
1514     my ($self) = @_;
1515     $self->display($self->{info}, "end.tpl");
1516 }
1517
1518 sub display_clients
1519 {
1520     my ($self) = @_;
1521     my $where='';       # by default
1522
1523     my $arg = $self->get_form("client", "qre_client",
1524                               "jclient_groups", "qnotingroup");
1525
1526     if ($arg->{qre_client}) {
1527         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1528     } elsif ($arg->{client}) {
1529         $where = "WHERE Name = '$arg->{client}' ";
1530     } elsif ($arg->{jclient_groups}) {
1531         # $filter could already contains client_group_member
1532         $where = "
1533  JOIN client_group_member USING (ClientId)
1534  JOIN client_group USING (client_group_id)
1535  WHERE client_group_name IN ($arg->{jclient_groups}) ";
1536     } elsif ($arg->{qnotingroup}) {
1537         $where =   "
1538   WHERE NOT EXISTS
1539    (SELECT 1 FROM client_group_member
1540      WHERE Client.ClientId = client_group_member.ClientId
1541    )
1542 ";
1543     }
1544
1545     my $query = "
1546 SELECT Name   AS name,
1547        Uname  AS uname,
1548        AutoPrune AS autoprune,
1549        FileRetention AS fileretention,
1550        JobRetention  AS jobretention
1551 FROM Client " . $self->get_client_filter() .
1552 $where ;
1553
1554     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1555
1556     my $dsp = { ID => $cur_id++,
1557                 clients => [ values %$all] };
1558
1559     $self->display($dsp, "client_list.tpl") ;
1560 }
1561
1562 sub get_limit
1563 {
1564     my ($self, %arg) = @_;
1565
1566     my $limit = '';
1567     my $label = '';
1568
1569     if ($arg{since} and $arg{age}) {
1570         my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1571         $limit .= "
1572  AND $self->{sql}->{UNIX_TIMESTAMP}(StartTime) > $now
1573  AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1574         $label .= "since $arg{since} and during " . human_sec($arg{age});
1575
1576     } elsif ($arg{age}) {
1577         $limit .=
1578   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1579          >
1580        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1581          -
1582          $self->{sql}->{TO_SEC}($arg{age})
1583        )" ;
1584
1585         $label = "last " . human_sec($arg{age});
1586     }
1587
1588     if ($arg{groupby}) {
1589         $limit .= " GROUP BY $arg{groupby} ";
1590     }
1591
1592     if ($arg{order}) {
1593         $limit .= " ORDER BY $arg{order} ";
1594     }
1595
1596     if ($arg{limit}) {
1597         $limit .= " LIMIT $arg{limit} ";
1598         $label .= " limited to $arg{limit}";
1599     }
1600
1601     if ($arg{offset}) {
1602         $limit .= " OFFSET $arg{offset} ";
1603         $label .= " with $arg{offset} offset ";
1604     }
1605
1606     unless ($label) {
1607         $label = 'no filter';
1608     }
1609
1610     return ($limit, $label);
1611 }
1612
1613 =head1 FUNCTION
1614
1615     $bweb->get_form(...) - Get useful stuff
1616
1617 =head2 DESCRIPTION
1618
1619     This function get and check parameters against regexp.
1620
1621     If word begin with 'q', the return will be quoted or join quoted
1622     if it's end with 's'.
1623
1624
1625 =head2 EXAMPLE
1626
1627     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1628
1629     { jobid    => 12,
1630       qclient  => 'plume-fd',
1631       qpools   => "'plume-fd', 'test-fd', '...'",
1632     }
1633
1634 =cut
1635
1636 sub get_form
1637 {
1638     my ($self, @what) = @_;
1639     my %what = map { $_ => 1 } @what;
1640     my %ret;
1641
1642     my %opt_i = (
1643                  limit  => 100,
1644                  cost   =>  10,
1645                  offset =>   0,
1646                  width  => 640,
1647                  height => 480,
1648                  jobid  =>   0,
1649                  slot   =>   0,
1650                  drive  =>   0,
1651                  priority => 10,
1652                  age    => 60*60*24*7,
1653                  days   => 1,
1654                  maxvoljobs  => 0,
1655                  maxvolbytes => 0,
1656                  maxvolfiles => 0,
1657                  filenameid => 0,
1658                  pathid => 0,
1659                  nb => 0,
1660                  );
1661
1662     my %opt_ss =(               # string with space
1663                  job     => 1,
1664                  storage => 1,
1665                  );
1666     my %opt_s = (               # default to ''
1667                  ach    => 1,
1668                  status => 1,
1669                  volstatus => 1,
1670                  inchanger => 1,
1671                  client => 1,
1672                  level  => 1,
1673                  pool   => 1,
1674                  media  => 1,
1675                  ach    => 1,
1676                  jobtype=> 1,
1677                  graph  => 1,
1678                  gtype  => 1,
1679                  type   => 1,
1680                  poolrecycle => 1,
1681                  replace => 1,
1682                  expired => 1,
1683                  enabled => 1,
1684                  username => 1,
1685                  rolename => 1,
1686                  );
1687     my %opt_p = (               # option with path
1688                  fileset=> 1,
1689                  mtxcmd => 1,
1690                  precmd => 1,
1691                  device => 1,
1692                  where  => 1,
1693                  );
1694     my %opt_r = (regexwhere => 1);
1695     my %opt_d = (               # option with date
1696                  voluseduration=> 1,
1697                  volretention => 1,
1698                 );
1699
1700     foreach my $i (@what) {
1701         if (exists $opt_i{$i}) {# integer param
1702             my $value = CGI::param($i) || $opt_i{$i} ;
1703             if ($value =~ /^(\d+)$/) {
1704                 $ret{$i} = $1;
1705             }
1706         } elsif ($opt_s{$i}) {  # simple string param
1707             my $value = CGI::param($i) || '';
1708             if ($value =~ /^([\w\d\.-]+)$/) {
1709                 $ret{$i} = $1;
1710             }
1711         } elsif ($opt_ss{$i}) { # simple string param (with space)
1712             my $value = CGI::param($i) || '';
1713             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1714                 $ret{$i} = $1;
1715             }
1716         } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1717             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1718             if (@value) {
1719                 $ret{$i} = $self->dbh_join(@value) ;
1720             }
1721
1722         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1723             my $value = CGI::param($1) ;
1724             if ($value) {
1725                 $ret{$i} = $self->dbh_quote($value);
1726             }
1727
1728         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1729             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1730                                            grep { ! /^\s*$/ } CGI::param($1) ];
1731         } elsif (exists $opt_p{$i}) {
1732             my $value = CGI::param($i) || '';
1733             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1734                 $ret{$i} = $1;
1735             }
1736         } elsif (exists $opt_r{$i}) {
1737             my $value = CGI::param($i) || '';
1738             if ($value =~ /^([^'"']+)$/) {
1739                 $ret{$i} = $1;
1740             }
1741         } elsif (exists $opt_d{$i}) {
1742             my $value = CGI::param($i) || '';
1743             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1744                 $ret{$i} = $1;
1745             }
1746         }
1747     }
1748
1749     if ($what{slots}) {
1750         foreach my $s (CGI::param('slot')) {
1751             if ($s =~ /^(\d+)$/) {
1752                 push @{$ret{slots}}, $s;
1753             }
1754         }
1755     }
1756
1757     if ($what{since}) {
1758         my $age = $ret{age} || $opt_i{age};
1759         my $since = CGI::param('since') || strftime('%F %T', localtime(time - $age));
1760         if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1761             $ret{since} = $1;
1762         }
1763     }
1764
1765     if ($what{when}) {
1766         my $when = CGI::param('when') || '';
1767         if ($when =~ /(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})/) {
1768             $ret{when} = $1;
1769         }
1770     }
1771
1772     if ($what{lang}) {
1773         my $lang = CGI::param('lang') || 'en';
1774         if ($lang =~ /^(\w\w)$/) {
1775             $ret{lang} = $1;
1776         }
1777     }
1778
1779     if ($what{db_clients}) {
1780         my $filter='';
1781         if ($what{filter}) {
1782             # get security filter only if asked
1783             $filter = $self->get_client_filter();
1784         }
1785
1786         my $query = "
1787 SELECT Client.Name as clientname
1788   FROM Client $filter
1789 ";
1790
1791         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1792         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1793                               values %$clients] ;
1794     }
1795
1796     if ($what{db_client_groups}) {
1797         my $filter='';
1798         if ($what{filter}) {
1799             # get security filter only if asked
1800             $filter = $self->get_client_group_filter();
1801         }
1802
1803         my $query = "
1804 SELECT client_group_name AS name
1805   FROM client_group $filter
1806 ";
1807         my $grps = $self->dbh_selectall_hashref($query, 'name');
1808         $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1809                                   values %$grps] ;
1810     }
1811
1812     if ($what{db_usernames}) {
1813         my $query = "
1814 SELECT username
1815   FROM bweb_user
1816 ";
1817         my $users = $self->dbh_selectall_hashref($query, 'username');
1818         $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1819                                   values %$users] ;
1820     }
1821
1822     if ($what{db_roles}) {
1823         my $query = "
1824 SELECT rolename
1825   FROM bweb_role
1826 ";
1827         my $r = $self->dbh_selectall_hashref($query, 'rolename');
1828         $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1829                                   values %$r] ;
1830     }
1831
1832     if ($what{db_mediatypes}) {
1833         my $query = "
1834 SELECT MediaType as mediatype
1835   FROM MediaType
1836 ";
1837         my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1838         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1839                                   values %$media] ;
1840     }
1841
1842     if ($what{db_locations}) {
1843         my $query = "
1844 SELECT Location as location, Cost as cost
1845   FROM Location
1846 ";
1847         my $loc = $self->dbh_selectall_hashref($query, 'location');
1848         $ret{db_locations} = [ sort { $a->{location}
1849                                       cmp
1850                                       $b->{location}
1851                                   } values %$loc ];
1852     }
1853
1854     if ($what{db_pools}) {
1855         my $query = "SELECT Name as name FROM Pool";
1856
1857         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1858         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1859     }
1860
1861     if ($what{db_filesets}) {
1862         my $query = "
1863 SELECT FileSet.FileSet AS fileset
1864   FROM FileSet
1865 ";
1866         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1867
1868         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1869                                values %$filesets] ;
1870     }
1871
1872     if ($what{db_jobnames}) {
1873         my $filter='';
1874         if ($what{filter}) {
1875             $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1876         }
1877         my $query = "
1878 SELECT DISTINCT Job.Name AS jobname
1879   FROM Job $filter
1880 ";
1881         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1882
1883         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1884                                values %$jobnames] ;
1885     }
1886
1887     if ($what{db_devices}) {
1888         my $query = "
1889 SELECT Device.Name AS name
1890   FROM Device
1891 ";
1892         my $devices = $self->dbh_selectall_hashref($query, 'name');
1893
1894         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1895                                values %$devices] ;
1896     }
1897
1898     return \%ret;
1899 }
1900
1901 sub display_graph
1902 {
1903     my ($self) = @_;
1904     $self->can_do('r_view_stat');
1905     my $fields = $self->get_form(qw/age level status clients filesets
1906                                     graph gtype type filter db_clients
1907                                     limit db_filesets width height
1908                                     qclients qfilesets qjobnames db_jobnames/);
1909
1910     my $url = CGI::url(-full => 0,
1911                       -base => 0,
1912                       -query => 1);
1913     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1914
1915 # this organisation is to keep user choice between 2 click
1916 # TODO : fileset and client selection doesn't work
1917
1918     $self->display({
1919         url => $url,
1920         %$fields,
1921     }, "graph.tpl");
1922
1923     if ($fields->{gtype} eq 'balloon') {
1924         system("./bgraph.pl");
1925     }
1926 }
1927
1928 sub get_selected_media_location
1929 {
1930     my ($self) = @_ ;
1931
1932     my $media = $self->get_form('jmedias');
1933
1934     unless ($media->{jmedias}) {
1935         return undef;
1936     }
1937
1938     my $query = "
1939 SELECT Media.VolumeName AS volumename, Location.Location AS location
1940 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1941 WHERE Media.VolumeName IN ($media->{jmedias})
1942 ";
1943
1944     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1945
1946     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1947     #               ..
1948     #             }
1949     # }
1950     return $all;
1951 }
1952
1953 sub move_media
1954 {
1955     my ($self, $in) = @_ ;
1956     $self->can_do('r_media_mgnt');
1957     my $media = $self->get_selected_media_location();
1958
1959     unless ($media) {
1960         return ;
1961     }
1962
1963     my $elt = $self->get_form('db_locations');
1964
1965     $self->display({ ID => $cur_id++,
1966                      enabled => human_enabled($in),
1967                      %$elt,     # db_locations
1968                      media => [
1969             sort { $a->{volumename} cmp $b->{volumename} } values %$media
1970                                ],
1971                      },
1972                    "move_media.tpl");
1973 }
1974
1975 sub help_extern
1976 {
1977     my ($self) = @_ ;
1978     $self->can_do('r_media_mgnt');
1979
1980     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1981     $self->debug($elt);
1982     $self->display($elt, "help_extern.tpl");
1983 }
1984
1985 sub help_extern_compute
1986 {
1987     my ($self) = @_;
1988     $self->can_do('r_media_mgnt');
1989
1990     my $number = CGI::param('limit') || '' ;
1991     unless ($number =~ /^(\d+)$/) {
1992         return $self->error("Bad arg number : $number ");
1993     }
1994
1995     my ($sql, undef) = $self->get_param('pools',
1996                                         'locations', 'mediatypes');
1997
1998     my $query = "
1999 SELECT Media.VolumeName  AS volumename,
2000        Media.VolStatus   AS volstatus,
2001        Media.LastWritten AS lastwritten,
2002        Media.MediaType   AS mediatype,
2003        Media.VolMounts   AS volmounts,
2004        Pool.Name         AS name,
2005        Media.Recycle     AS recycle,
2006        $self->{sql}->{FROM_UNIXTIME}(
2007           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2008         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2009        ) AS expire
2010 FROM Media
2011  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
2012  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2013
2014 WHERE Media.InChanger = 1
2015   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
2016   $sql
2017 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2018 LIMIT $number
2019 " ;
2020
2021     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2022
2023     $self->display({ Media => [ values %$all ] },
2024                    "help_extern_compute.tpl");
2025 }
2026
2027 sub help_intern
2028 {
2029     my ($self) = @_ ;
2030     $self->can_do('r_media_mgnt');
2031
2032     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2033     $self->display($param, "help_intern.tpl");
2034 }
2035
2036 sub help_intern_compute
2037 {
2038     my ($self) = @_;
2039     $self->can_do('r_media_mgnt');
2040
2041     my $number = CGI::param('limit') || '' ;
2042     unless ($number =~ /^(\d+)$/) {
2043         return $self->error("Bad arg number : $number ");
2044     }
2045
2046     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2047
2048     if (CGI::param('expired')) {
2049         $sql = "
2050 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2051        + $self->{sql}->{TO_SEC}(Media.VolRetention)
2052     ) < NOW()
2053  " . $sql ;
2054     }
2055
2056     my $query = "
2057 SELECT Media.VolumeName  AS volumename,
2058        Media.VolStatus   AS volstatus,
2059        Media.LastWritten AS lastwritten,
2060        Media.MediaType   AS mediatype,
2061        Media.VolMounts   AS volmounts,
2062        Pool.Name         AS name,
2063        $self->{sql}->{FROM_UNIXTIME}(
2064           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2065         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2066        ) AS expire
2067 FROM Media
2068  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2069  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
2070
2071 WHERE Media.InChanger <> 1
2072   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
2073   AND Media.Recycle = 1
2074   $sql
2075 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2076 LIMIT $number
2077 " ;
2078
2079     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2080
2081     $self->display({ Media => [ values %$all ] },
2082                    "help_intern_compute.tpl");
2083
2084 }
2085
2086 sub display_general
2087 {
2088     my ($self, %arg) = @_ ;
2089
2090     my ($limit, $label) = $self->get_limit(%arg);
2091
2092     my $query = "
2093 SELECT
2094     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
2095     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
2096     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
2097     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
2098     ($self->{sql}->{DB_SIZE})                 AS db_size,
2099     (SELECT count(Job.JobId)
2100       FROM Job
2101       WHERE Job.JobStatus IN ('E','e','f','A')
2102       $limit
2103     )                                         AS nb_err,
2104     (SELECT count(Client.ClientId) FROM Client) AS nb_client
2105 ";
2106
2107     my $row = $self->dbh_selectrow_hashref($query) ;
2108
2109     $row->{nb_bytes} = human_size($row->{nb_bytes});
2110
2111     $row->{db_size} = human_size($row->{db_size});
2112     $row->{label} = $label;
2113
2114     $self->display($row, "general.tpl");
2115 }
2116
2117 sub get_param
2118 {
2119     my ($self, @what) = @_ ;
2120     my %elt = map { $_ => 1 } @what;
2121     my %ret;
2122
2123     my $limit = '';
2124
2125     if ($elt{clients}) {
2126         my @clients = grep { ! /^\s*$/ } CGI::param('client');
2127         if (@clients) {
2128             $ret{clients} = \@clients;
2129             my $str = $self->dbh_join(@clients);
2130             $limit .= "AND Client.Name IN ($str) ";
2131         }
2132     }
2133
2134     if ($elt{client_groups}) {
2135         my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2136         if (@clients) {
2137             $ret{client_groups} = \@clients;
2138             my $str = $self->dbh_join(@clients);
2139             $limit .= "AND client_group_name IN ($str) ";
2140         }
2141     }
2142
2143     if ($elt{filesets}) {
2144         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2145         if (@filesets) {
2146             $ret{filesets} = \@filesets;
2147             my $str = $self->dbh_join(@filesets);
2148             $limit .= "AND FileSet.FileSet IN ($str) ";
2149         }
2150     }
2151
2152     if ($elt{mediatypes}) {
2153         my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2154         if (@media) {
2155             $ret{mediatypes} = \@media;
2156             my $str = $self->dbh_join(@media);
2157             $limit .= "AND Media.MediaType IN ($str) ";
2158         }
2159     }
2160
2161     if ($elt{client}) {
2162         my $client = CGI::param('client');
2163         $ret{client} = $client;
2164         $client = $self->dbh_join($client);
2165         $limit .= "AND Client.Name = $client ";
2166     }
2167
2168     if ($elt{level}) {
2169         my $level = CGI::param('level') || '';
2170         if ($level =~ /^(\w)$/) {
2171             $ret{level} = $1;
2172             $limit .= "AND Job.Level = '$1' ";
2173         }
2174     }
2175
2176     if ($elt{jobid}) {
2177         my $jobid = CGI::param('jobid') || '';
2178
2179         if ($jobid =~ /^(\d+)$/) {
2180             $ret{jobid} = $1;
2181             $limit .= "AND Job.JobId = '$1' ";
2182         }
2183     }
2184
2185     if ($elt{status}) {
2186         my $status = CGI::param('status') || '';
2187         if ($status =~ /^(\w)$/) {
2188             $ret{status} = $1;
2189             if ($1 eq 'f') {
2190                 $limit .= "AND Job.JobStatus IN ('f','E') ";
2191             } elsif ($1 eq 'W') {
2192                 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
2193             } else {
2194                 $limit .= "AND Job.JobStatus = '$1' ";
2195             }
2196         }
2197     }
2198
2199     if ($elt{volstatus}) {
2200         my $status = CGI::param('volstatus') || '';
2201         if ($status =~ /^(\w+)$/) {
2202             $ret{status} = $1;
2203             $limit .= "AND Media.VolStatus = '$1' ";
2204         }
2205     }
2206
2207     if ($elt{locations}) {
2208         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2209         if (@location) {
2210             $ret{locations} = \@location;
2211             my $str = $self->dbh_join(@location);
2212             $limit .= "AND Location.Location IN ($str) ";
2213         }
2214     }
2215
2216     if ($elt{pools}) {
2217         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2218         if (@pool) {
2219             $ret{pools} = \@pool;
2220             my $str = $self->dbh_join(@pool);
2221             $limit .= "AND Pool.Name IN ($str) ";
2222         }
2223     }
2224
2225     if ($elt{location}) {
2226         my $location = CGI::param('location') || '';
2227         if ($location) {
2228             $ret{location} = $location;
2229             $location = $self->dbh_quote($location);
2230             $limit .= "AND Location.Location = $location ";
2231         }
2232     }
2233
2234     if ($elt{pool}) {
2235         my $pool = CGI::param('pool') || '';
2236         if ($pool) {
2237             $ret{pool} = $pool;
2238             $pool = $self->dbh_quote($pool);
2239             $limit .= "AND Pool.Name = $pool ";
2240         }
2241     }
2242
2243     if ($elt{jobtype}) {
2244         my $jobtype = CGI::param('jobtype') || '';
2245         if ($jobtype =~ /^(\w)$/) {
2246             $ret{jobtype} = $1;
2247             $limit .= "AND Job.Type = '$1' ";
2248         }
2249     }
2250
2251     return ($limit, %ret);
2252 }
2253
2254 =head1
2255
2256     get last backup
2257
2258 =cut
2259
2260 sub display_job
2261 {
2262     my ($self, %arg) = @_ ;
2263     return if $self->cant_do('r_view_job');
2264
2265     $arg{order} = ' Job.JobId DESC ';
2266
2267     my ($limit, $label) = $self->get_limit(%arg);
2268     my ($where, undef) = $self->get_param('clients',
2269                                           'client_groups',
2270                                           'level',
2271                                           'filesets',
2272                                           'jobtype',
2273                                           'pools',
2274                                           'jobid',
2275                                           'status');
2276     my $cgq='';
2277     if (CGI::param('client_group')) {
2278         $cgq .= "
2279 JOIN client_group_member USING (ClientId)
2280 JOIN client_group USING (client_group_id)
2281 ";
2282     }
2283     my $filter = $self->get_client_filter();
2284
2285     my $query="
2286 SELECT  Job.JobId       AS jobid,
2287         Client.Name     AS client,
2288         FileSet.FileSet AS fileset,
2289         Job.Name        AS jobname,
2290         Level           AS level,
2291         StartTime       AS starttime,
2292         EndTime         AS endtime,
2293         Pool.Name       AS poolname,
2294         JobFiles        AS jobfiles,
2295         JobBytes        AS jobbytes,
2296         JobStatus       AS jobstatus,
2297      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2298                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2299                         AS duration,
2300
2301         JobErrors       AS joberrors
2302
2303  FROM Client $filter $cgq,
2304       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2305           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2306  WHERE Client.ClientId=Job.ClientId
2307    AND Job.JobStatus NOT IN ('R', 'C')
2308  $where
2309  $limit
2310 ";
2311
2312     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2313
2314     $self->display({ Filter => $label,
2315                      ID => $cur_id++,
2316                      Jobs =>
2317                            [
2318                              sort { $a->{jobid} <=>  $b->{jobid} }
2319                                         values %$all
2320                              ],
2321                    },
2322                    "display_job.tpl");
2323 }
2324
2325 # display job informations
2326 sub display_job_zoom
2327 {
2328     my ($self, $jobid) = @_ ;
2329     $self->can_do('r_view_job');
2330
2331     $jobid = $self->dbh_quote($jobid);
2332
2333     # get security filter
2334     my $filter = $self->get_client_filter();
2335
2336     my $query="
2337 SELECT DISTINCT Job.JobId       AS jobid,
2338                 Client.Name     AS client,
2339                 Job.Name        AS jobname,
2340                 FileSet.FileSet AS fileset,
2341                 Level           AS level,
2342                 Pool.Name       AS poolname,
2343                 StartTime       AS starttime,
2344                 JobFiles        AS jobfiles,
2345                 JobBytes        AS jobbytes,
2346                 JobStatus       AS jobstatus,
2347                 JobErrors       AS joberrors,
2348                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2349                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2350
2351  FROM Client $filter,
2352       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2353           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2354  WHERE Client.ClientId=Job.ClientId
2355  AND Job.JobId = $jobid
2356 ";
2357
2358     my $row = $self->dbh_selectrow_hashref($query) ;
2359
2360     # display all volumes associate with this job
2361     $query="
2362 SELECT Media.VolumeName as volumename
2363 FROM Job,Media,JobMedia
2364 WHERE Job.JobId = $jobid
2365  AND JobMedia.JobId=Job.JobId
2366  AND JobMedia.MediaId=Media.MediaId
2367 ";
2368
2369     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2370
2371     $row->{volumes} = [ values %$all ] ;
2372     $row->{wiki_url} = $self->{info}->{wiki_url};
2373
2374     $self->display($row, "display_job_zoom.tpl");
2375 }
2376
2377 sub display_job_group
2378 {
2379     my ($self, %arg) = @_;
2380     $self->can_do('r_view_job');
2381
2382     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2383
2384     my ($where, undef) = $self->get_param('client_groups',
2385                                           'level',
2386                                           'pools');
2387     my $filter = $self->get_client_group_filter();
2388     my $query =
2389 "
2390 SELECT client_group_name AS client_group_name,
2391        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2392        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2393        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2394        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2395        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2396        COALESCE(jobok.duration, '0:0:0') AS duration
2397
2398 FROM client_group $filter LEFT JOIN (
2399     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2400            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2401            SUM(JobErrors) AS joberrors,
2402            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2403                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2404                         AS duration
2405
2406     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2407              JOIN client_group USING (client_group_id)
2408
2409     WHERE JobStatus = 'T'
2410     $where
2411     $limit
2412 ) AS jobok USING (client_group_name) LEFT JOIN
2413
2414 (
2415     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2416            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2417            SUM(JobErrors) AS joberrors
2418     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2419              JOIN client_group USING (client_group_id)
2420
2421     WHERE JobStatus IN ('f','E', 'A')
2422     $where
2423     $limit
2424 ) AS joberr USING (client_group_name)
2425
2426     ";
2427
2428     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2429
2430     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2431
2432     $self->debug($rep);
2433     $self->display($rep, "display_job_group.tpl");
2434 }
2435
2436 sub display_media
2437 {
2438     my ($self, %arg) = @_ ;
2439     $self->can_do('r_view_media');
2440
2441     my ($limit, $label) = $self->get_limit(%arg);
2442     my ($where, %elt) = $self->get_param('pools',
2443                                          'mediatypes',
2444                                          'volstatus',
2445                                          'locations');
2446
2447     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2448
2449     if ($arg->{jmedias}) {
2450         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2451     }
2452     if ($arg->{qre_media}) {
2453         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2454     }
2455     if ($arg->{expired}) {
2456         $where = "
2457         AND VolStatus = 'Full'
2458         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2459                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2460             ) < NOW()  " . $where ;
2461     }
2462
2463     my $query="
2464 SELECT Media.VolumeName  AS volumename,
2465        Media.VolBytes    AS volbytes,
2466        Media.VolStatus   AS volstatus,
2467        Media.MediaType   AS mediatype,
2468        Media.InChanger   AS online,
2469        Media.LastWritten AS lastwritten,
2470        Location.Location AS location,
2471        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2472        Pool.Name         AS poolname,
2473        $self->{sql}->{FROM_UNIXTIME}(
2474           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2475         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2476        ) AS expire
2477 FROM      Pool, Media
2478 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2479 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2480                   Media.MediaType     AS MediaType
2481            FROM Media
2482           WHERE Media.VolStatus = 'Full'
2483           GROUP BY Media.MediaType
2484            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2485
2486 WHERE Media.PoolId=Pool.PoolId
2487 $where
2488 $limit
2489 ";
2490
2491     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2492
2493     $self->display({ ID => $cur_id++,
2494                      Pool => $elt{pool},
2495                      Location => $elt{location},
2496                      Media => [ values %$all ],
2497                    },
2498                    "display_media.tpl");
2499 }
2500
2501 sub display_allmedia
2502 {
2503     my ($self) = @_ ;
2504
2505     my $pool = $self->get_form('db_pools');
2506
2507     foreach my $name (@{ $pool->{db_pools} }) {
2508         CGI::param('pool', $name->{name});
2509         $self->display_media();
2510     }
2511 }
2512
2513 sub display_media_zoom
2514 {
2515     my ($self) = @_ ;
2516
2517     my $media = $self->get_form('jmedias');
2518
2519     unless ($media->{jmedias}) {
2520         return $self->error("Can't get media selection");
2521     }
2522
2523     my $query="
2524 SELECT InChanger     AS online,
2525        Media.Enabled AS enabled,
2526        VolBytes      AS nb_bytes,
2527        VolumeName    AS volumename,
2528        VolStatus     AS volstatus,
2529        VolMounts     AS nb_mounts,
2530        Media.VolUseDuration   AS voluseduration,
2531        Media.MaxVolJobs AS maxvoljobs,
2532        Media.MaxVolFiles AS maxvolfiles,
2533        Media.MaxVolBytes AS maxvolbytes,
2534        VolErrors     AS nb_errors,
2535        Pool.Name     AS poolname,
2536        Location.Location AS location,
2537        Media.Recycle AS recycle,
2538        Media.VolRetention AS volretention,
2539        Media.LastWritten  AS lastwritten,
2540        Media.VolReadTime/1000000  AS volreadtime,
2541        Media.VolWriteTime/1000000 AS volwritetime,
2542        Media.RecycleCount AS recyclecount,
2543        Media.Comment      AS comment,
2544        $self->{sql}->{FROM_UNIXTIME}(
2545           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2546         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2547        ) AS expire
2548  FROM Pool,
2549       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2550  WHERE Pool.PoolId = Media.PoolId
2551  AND VolumeName IN ($media->{jmedias})
2552 ";
2553
2554     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2555
2556     foreach my $media (values %$all) {
2557         my $mq = $self->dbh_quote($media->{volumename});
2558
2559         $query = "
2560 SELECT DISTINCT Job.JobId AS jobid,
2561                 Job.Name  AS name,
2562                 Job.StartTime AS starttime,
2563                 Job.Type  AS type,
2564                 Job.Level AS level,
2565                 Job.JobFiles AS files,
2566                 Job.JobBytes AS bytes,
2567                 Job.jobstatus AS status
2568  FROM Media,JobMedia,Job
2569  WHERE Media.VolumeName=$mq
2570  AND Media.MediaId=JobMedia.MediaId
2571  AND JobMedia.JobId=Job.JobId
2572 ";
2573
2574         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2575
2576         $query = "
2577 SELECT LocationLog.Date    AS date,
2578        Location.Location   AS location,
2579        LocationLog.Comment AS comment
2580  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2581  WHERE Media.MediaId = LocationLog.MediaId
2582    AND Media.VolumeName = $mq
2583 ";
2584
2585         my $logtxt = '';
2586         my $log = $self->dbh_selectall_arrayref($query) ;
2587         if ($log) {
2588             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2589         }
2590
2591         $self->display({ jobs => [ values %$jobs ],
2592                          LocationLog => $logtxt,
2593                          %$media },
2594                        "display_media_zoom.tpl");
2595     }
2596 }
2597
2598 sub location_edit
2599 {
2600     my ($self) = @_ ;
2601     $self->can_do('r_location_mgnt');
2602
2603     my $loc = $self->get_form('qlocation');
2604     unless ($loc->{qlocation}) {
2605         return $self->error("Can't get location");
2606     }
2607
2608     my $query = "
2609 SELECT Location.Location AS location,
2610        Location.Cost   AS cost,
2611        Location.Enabled AS enabled
2612 FROM Location
2613 WHERE Location.Location = $loc->{qlocation}
2614 ";
2615
2616     my $row = $self->dbh_selectrow_hashref($query);
2617     $row->{enabled} = human_enabled($row->{enabled});
2618     $self->display({ ID => $cur_id++,
2619                      %$row }, "location_edit.tpl") ;
2620 }
2621
2622 sub location_save
2623 {
2624     my ($self) = @_ ;
2625     $self->can_do('r_location_mgnt');
2626
2627     my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2628     unless ($arg->{qlocation}) {
2629         return $self->error("Can't get location");
2630     }
2631     unless ($arg->{qnewlocation}) {
2632         return $self->error("Can't get new location name");
2633     }
2634     unless ($arg->{cost}) {
2635         return $self->error("Can't get new cost");
2636     }
2637
2638     my $enabled = from_human_enabled($arg->{enabled});
2639
2640     my $query = "
2641 UPDATE Location SET Cost     = $arg->{cost},
2642                     Location = $arg->{qnewlocation},
2643                     Enabled   = $enabled
2644 WHERE Location.Location = $arg->{qlocation}
2645 ";
2646
2647     $self->dbh_do($query);
2648
2649     $self->location_display();
2650 }
2651
2652 sub location_del
2653 {
2654     my ($self) = @_ ;
2655     $self->can_do('r_location_mgnt');
2656
2657     my $arg = $self->get_form(qw/qlocation/) ;
2658
2659     unless ($arg->{qlocation}) {
2660         return $self->error("Can't get location");
2661     }
2662
2663     my $query = "
2664 SELECT count(Media.MediaId) AS nb
2665   FROM Media INNER JOIN Location USING (LocationID)
2666 WHERE Location = $arg->{qlocation}
2667 ";
2668
2669     my $res = $self->dbh_selectrow_hashref($query);
2670
2671     if ($res->{nb}) {
2672         return $self->error("Sorry, the location must be empty");
2673     }
2674
2675     $query = "
2676 DELETE FROM Location WHERE Location = $arg->{qlocation}
2677 ";
2678
2679     $self->dbh_do($query);
2680
2681     $self->location_display();
2682 }
2683
2684 sub location_add
2685 {
2686     my ($self) = @_ ;
2687     $self->can_do('r_location_mgnt');
2688
2689     my $arg = $self->get_form(qw/qlocation cost/) ;
2690
2691     unless ($arg->{qlocation}) {
2692         $self->display({}, "location_add.tpl");
2693         return 1;
2694     }
2695     unless ($arg->{cost}) {
2696         return $self->error("Can't get new cost");
2697     }
2698
2699     my $enabled = CGI::param('enabled') || '';
2700     $enabled = from_human_enabled($enabled);
2701
2702     my $query = "
2703 INSERT INTO Location (Location, Cost, Enabled)
2704        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2705 ";
2706
2707     $self->dbh_do($query);
2708
2709     $self->location_display();
2710 }
2711
2712 sub location_display
2713 {
2714     my ($self) = @_ ;
2715
2716     my $query = "
2717 SELECT Location.Location AS location,
2718        Location.Cost     AS cost,
2719        Location.Enabled  AS enabled,
2720        (SELECT count(Media.MediaId)
2721          FROM Media
2722         WHERE Media.LocationId = Location.LocationId
2723        ) AS volnum
2724 FROM Location
2725 ";
2726
2727     my $location = $self->dbh_selectall_hashref($query, 'location');
2728
2729     $self->display({ ID => $cur_id++,
2730                      Locations => [ values %$location ] },
2731                    "display_location.tpl");
2732 }
2733
2734 sub update_location
2735 {
2736     my ($self) = @_ ;
2737
2738     my $media = $self->get_selected_media_location();
2739     unless ($media) {
2740         return ;
2741     }
2742
2743     my $arg = $self->get_form('db_locations', 'qnewlocation');
2744
2745     $self->display({ email  => $self->{info}->{email_media},
2746                      %$arg,
2747                      media => [ values %$media ],
2748                    },
2749                    "update_location.tpl");
2750 }
2751
2752 ###########################################################
2753
2754 sub groups_edit
2755 {
2756     my ($self) = @_;
2757     $self->can_do('r_group_mgnt');
2758
2759     my $grp = $self->get_form(qw/qclient_group db_clients/);
2760
2761     unless ($grp->{qclient_group}) {
2762         $self->display({ ID => $cur_id++,
2763                          client_group => "''",
2764                          %$grp,
2765                      }, "groups_edit.tpl");
2766         return;
2767     }
2768
2769     my $query = "
2770 SELECT Name AS name
2771   FROM Client JOIN client_group_member using (clientid)
2772               JOIN client_group using (client_group_id)
2773 WHERE client_group_name = $grp->{qclient_group}
2774 ";
2775
2776     my $row = $self->dbh_selectall_hashref($query, "name");
2777     $self->debug($row);
2778     $self->display({ ID => $cur_id++,
2779                      client_group => $grp->{qclient_group},
2780                      %$grp,
2781                      client_group_member => [ values %$row]},
2782                    "groups_edit.tpl");
2783 }
2784
2785 sub groups_save
2786 {
2787     my ($self) = @_;
2788     $self->can_do('r_group_mgnt');
2789
2790     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2791
2792     if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2793         my $query = "
2794 INSERT INTO client_group (client_group_name)
2795 VALUES ($arg->{qnewgroup})
2796 ";
2797         $self->dbh_do($query);
2798         $arg->{qclient_group} = $arg->{qnewgroup};
2799     }
2800
2801     unless ($arg->{qclient_group}) {
2802         return $self->error("Can't get groups");
2803     }
2804
2805     $self->{dbh}->begin_work();
2806
2807     my $query = "
2808 DELETE FROM client_group_member
2809       WHERE client_group_id IN
2810            (SELECT client_group_id
2811               FROM client_group
2812              WHERE client_group_name = $arg->{qclient_group})
2813 ";
2814     $self->dbh_do($query);
2815
2816     if ($arg->{jclients}) {
2817         $query = "
2818     INSERT INTO client_group_member (clientid, client_group_id)
2819        (SELECT  Clientid,
2820                 (SELECT client_group_id
2821                    FROM client_group
2822                   WHERE client_group_name = $arg->{qclient_group})
2823           FROM Client WHERE Name IN ($arg->{jclients})
2824        )
2825 ";
2826         $self->dbh_do($query);
2827     }
2828     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2829         $query = "
2830 UPDATE client_group
2831    SET client_group_name = $arg->{qnewgroup}
2832  WHERE client_group_name = $arg->{qclient_group}
2833 ";
2834
2835         $self->dbh_do($query);
2836     }
2837
2838     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2839
2840     $self->display_groups();
2841 }
2842
2843 sub groups_del
2844 {
2845     my ($self) = @_;
2846     $self->can_do('r_group_mgnt');
2847
2848     my $arg = $self->get_form(qw/qclient_group/);
2849
2850     unless ($arg->{qclient_group}) {
2851         return $self->error("Can't get groups");
2852     }
2853
2854     $self->{dbh}->begin_work();
2855
2856     $self->dbh_do("
2857 DELETE FROM client_group_member
2858       WHERE client_group_id IN
2859            (SELECT client_group_id
2860               FROM client_group
2861              WHERE client_group_name = $arg->{qclient_group})");
2862
2863     $self->dbh_do("
2864 DELETE FROM bweb_client_group_acl
2865       WHERE client_group_id IN
2866            (SELECT client_group_id
2867               FROM client_group
2868              WHERE client_group_name = $arg->{qclient_group})");
2869
2870     $self->dbh_do("
2871 DELETE FROM client_group
2872       WHERE client_group_name = $arg->{qclient_group}");
2873
2874     $self->{dbh}->commit();
2875     $self->display_groups();
2876 }
2877
2878 sub display_groups
2879 {
2880     my ($self) = @_;
2881     my $arg;
2882
2883     if ($self->cant_do('r_group_mgnt')) {
2884         $arg = $self->get_form(qw/db_client_groups filter/) ;
2885     } else {
2886         $arg = $self->get_form(qw/db_client_groups/) ;
2887     }
2888
2889     if ($self->{dbh}->errstr) {
2890         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2891     }
2892
2893     $self->debug($arg);
2894
2895     $self->display({ ID => $cur_id++,
2896                      %$arg},
2897                    "display_groups.tpl");
2898 }
2899
2900 ###########################################################
2901
2902 sub get_roles
2903 {
2904     my ($self) = @_;
2905     if (not $self->{info}->{enable_security}) {
2906         return 1;
2907     }
2908     # admin is a special user that can do everything
2909     if ($self->{loginname} eq 'admin') {
2910         return 1;
2911     }
2912     if (!$self->{loginname}) {
2913         $self->error("Can't get your login name");
2914         $self->display_end();
2915         exit 0;
2916     }
2917     # already fill
2918     if (defined $self->{security}) {
2919         return 1;
2920     }
2921     $self->{security} = {};
2922     my $u = $self->dbh_quote($self->{loginname});
2923
2924     my $query = "
2925  SELECT use_acl, rolename, tpl
2926   FROM bweb_user
2927        JOIN bweb_role_member USING (userid)
2928        JOIN bweb_role USING (roleid)
2929  WHERE username = $u
2930 ";
2931     my $rows = $self->dbh_selectall_arrayref($query);
2932     # do cache with this role
2933     if (!$rows or !scalar(@$rows)) {
2934         $self->error("Can't get $self->{loginname}'s roles");
2935         $self->display_end();
2936         exit 0;
2937     }
2938     foreach my $r (@$rows) {
2939         $self->{security}->{$r->[1]}=1;
2940     }
2941     $self->{security}->{use_acl} = $rows->[0]->[0];
2942     if ($rows->[0]->[2] =~ /^(\w\w)$/) {
2943         $self->{lang} = $1;
2944     }
2945     return 1;
2946 }
2947
2948 sub cant_do
2949 {
2950     my ($self, $action) = @_;
2951     # is security enabled in configuration ?
2952     if (not $self->{info}->{enable_security}) {
2953         return 0
2954     }
2955     # admin is a special user that can do everything
2956     if ($self->{loginname} eq 'admin') {
2957         return 0;
2958     }
2959     # must be logged
2960     if (!$self->{loginname}) {
2961         $self->{error} = "Can't do $action, your are not logged. " .
2962             "Check security with your administrator";
2963         return 1;
2964     }
2965     if (!$self->get_roles()) {
2966         return 0;
2967     }
2968     if (!$self->{security}->{$action}) {
2969         $self->{error} =
2970             "$self->{loginname} sorry, but this action ($action) " .
2971             "is not permited. " .
2972             "Check security with your administrator";
2973         return 1;
2974     }
2975     return 0;
2976 }
2977
2978 # make like an assert (program die)
2979 sub can_do
2980 {
2981     my ($self, $action) = @_;
2982     if ($self->cant_do($action)) {
2983         $self->error($self->{error});
2984         $self->display_end();
2985         exit 0;
2986     }
2987     return 1;
2988 }
2989
2990 sub use_filter
2991 {
2992     my ($self) = @_;
2993
2994     if (!$self->{info}->{enable_security} or
2995         !$self->{info}->{enable_security_acl})
2996     {
2997         return 0 ;
2998     }
2999
3000     if ($self->get_roles()) {
3001         return $self->{security}->{use_acl};
3002     } else {
3003         return 1;
3004     }
3005 }
3006
3007 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3008 sub get_client_filter
3009 {
3010     my ($self, $login) = @_;
3011     my $u;
3012     if ($login) {
3013         $u = $self->dbh_quote($login);
3014     } elsif ($self->use_filter()) {
3015         $u = $self->dbh_quote($self->{loginname});
3016     } else {
3017         return '';
3018     }
3019     return "
3020  JOIN (SELECT ClientId FROM client_group_member
3021    JOIN client_group USING (client_group_id)
3022    JOIN bweb_client_group_acl USING (client_group_id)
3023    JOIN bweb_user USING (userid)
3024    WHERE bweb_user.username = $u
3025  ) AS filter USING (ClientId)";
3026 }
3027
3028 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3029 sub get_client_group_filter
3030 {
3031     my ($self, $login) = @_;
3032     my $u;
3033     if ($login) {
3034         $u = $self->dbh_quote($login);
3035     } elsif ($self->use_filter()) {
3036         $u = $self->dbh_quote($self->{loginname});
3037     } else {
3038         return '';
3039     }
3040     return "
3041  JOIN (SELECT client_group_id
3042          FROM bweb_client_group_acl
3043          JOIN bweb_user USING (userid)
3044    WHERE bweb_user.username = $u
3045  ) AS filter USING (client_group_id)";
3046 }
3047
3048 # role and username have to be quoted before
3049 # role and username can be a quoted list
3050 sub revoke
3051 {
3052     my ($self, $role, $username) = @_;
3053     $self->can_do("r_user_mgnt");
3054
3055     my $nb = $self->dbh_do("
3056  DELETE FROM bweb_role_member
3057        WHERE roleid = (SELECT roleid FROM bweb_role
3058                         WHERE rolename IN ($role))
3059          AND userid = (SELECT userid FROM bweb_user
3060                         WHERE username IN ($username))");
3061     return $nb;
3062 }
3063
3064 # role and username have to be quoted before
3065 # role and username can be a quoted list
3066 sub grant
3067 {
3068     my ($self, $role, $username) = @_;
3069     $self->can_do("r_user_mgnt");
3070
3071     my $nb = $self->dbh_do("
3072    INSERT INTO bweb_role_member (roleid, userid)
3073      SELECT roleid, userid FROM bweb_role, bweb_user
3074       WHERE rolename IN ($role)
3075         AND username IN ($username)
3076      ");
3077     return $nb;
3078 }
3079
3080 # role and username have to be quoted before
3081 # role and username can be a quoted list
3082 sub grant_like
3083 {
3084     my ($self, $copy, $user) = @_;
3085     $self->can_do("r_user_mgnt");
3086
3087     my $nb = $self->dbh_do("
3088   INSERT INTO bweb_role_member (roleid, userid)
3089    SELECT roleid, a.userid
3090      FROM bweb_user AS a, bweb_role_member
3091      JOIN bweb_user USING (userid)
3092     WHERE bweb_user.username = $copy
3093       AND a.username = $user");
3094     return $nb;
3095 }
3096
3097 # username can be a join quoted list of usernames
3098 sub revoke_all
3099 {
3100     my ($self, $username) = @_;
3101     $self->can_do("r_user_mgnt");
3102
3103     $self->dbh_do("
3104    DELETE FROM bweb_role_member
3105          WHERE userid IN (
3106            SELECT userid
3107              FROM bweb_user
3108             WHERE username in ($username))");
3109     $self->dbh_do("
3110 DELETE FROM bweb_client_group_acl
3111  WHERE userid IN (
3112   SELECT userid
3113     FROM bweb_user
3114    WHERE username IN ($username))");
3115
3116 }
3117
3118 sub users_del
3119 {
3120     my ($self) = @_;
3121     $self->can_do("r_user_mgnt");
3122
3123     my $arg = $self->get_form(qw/jusernames/);
3124
3125     unless ($arg->{jusernames}) {
3126         return $self->error("Can't get user");
3127     }
3128
3129     $self->{dbh}->begin_work();
3130     {
3131         $self->revoke_all($arg->{jusernames});
3132         $self->dbh_do("
3133 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3134     }
3135     $self->{dbh}->commit();
3136
3137     $self->display_users();
3138 }
3139
3140 sub users_add
3141 {
3142     my ($self) = @_;
3143     $self->can_do("r_user_mgnt");
3144
3145     # we don't quote username directly to check that it is conform
3146     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3147                                  lang qcopy_username jclient_groups/) ;
3148
3149     if (not $arg->{qcreate}) {
3150         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3151         $self->display($arg, "display_user.tpl");
3152         return 1;
3153     }
3154
3155     my $u = $self->dbh_quote($arg->{username});
3156
3157     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3158
3159     if (!$arg->{qpasswd}) {
3160         $arg->{qpasswd} = "''";
3161     }
3162     if (!$arg->{qcomment}) {
3163         $arg->{qcomment} = "''";
3164     }
3165
3166     # will fail if user already exists
3167     # UPDATE with mysql dbi does not return if update is ok
3168     ($self->dbh_do("
3169   UPDATE bweb_user
3170      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3171          use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3172    WHERE username = $u")
3173 #     and (! $self->dbh_is_mysql() )
3174      ) and
3175     $self->dbh_do("
3176   INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3177         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3178                 $arg->{qcomment}, '$arg->{lang}')");
3179
3180     $self->{dbh}->begin_work();
3181     {
3182         $self->revoke_all($u);
3183
3184         if ($arg->{qcopy_username}) {
3185             $self->grant_like($arg->{qcopy_username}, $u);
3186         } else {
3187             $self->grant($arg->{jrolenames}, $u);
3188         }
3189
3190         if ($arg->{jclient_groups}) {
3191             $self->dbh_do("
3192 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3193  SELECT client_group_id, userid
3194    FROM client_group, bweb_user
3195   WHERE client_group_name IN ($arg->{jclient_groups})
3196     AND username = $u
3197 ");
3198         }
3199     }
3200     $self->{dbh}->commit();
3201
3202     $self->display_users();
3203 }
3204
3205 # TODO: we miss a matrix with all user/roles
3206 sub display_users
3207 {
3208     my ($self) = @_;
3209     $self->can_do("r_user_mgnt");
3210
3211     my $arg = $self->get_form(qw/db_usernames/) ;
3212
3213     if ($self->{dbh}->errstr) {
3214         return $self->error("Can't use users with bweb, read INSTALL to enable them");
3215     }
3216
3217     $self->display({ ID => $cur_id++,
3218                      %$arg},
3219                    "display_users.tpl");
3220 }
3221
3222 sub display_user
3223 {
3224     my ($self) = @_;
3225     $self->can_do("r_user_mgnt");
3226
3227     my $arg = $self->get_form('username');
3228     my $user = $self->dbh_quote($arg->{username});
3229
3230     my $userp = $self->dbh_selectrow_hashref("
3231    SELECT username, passwd, comment, use_acl, tpl
3232      FROM bweb_user
3233     WHERE username = $user
3234 ");
3235     if (!$userp) {
3236         return $self->error("Can't find $user in catalog");
3237     }
3238     my $filter = $self->get_client_group_filter($arg->{username});
3239     my $scg = $self->dbh_selectall_hashref("
3240  SELECT client_group_name AS name
3241    FROM client_group $filter
3242 ", 'name');
3243
3244 #  rolename  | userid
3245 #------------+--------
3246 # cancel_job |
3247 # restore    |
3248 # run_job    |      1
3249
3250     my $role = $self->dbh_selectall_hashref("
3251 SELECT rolename, temp.userid
3252      FROM bweb_role
3253      LEFT JOIN (SELECT roleid, userid
3254                   FROM bweb_user JOIN bweb_role_member USING (userid)
3255                  WHERE username = $user) AS temp USING (roleid)
3256 ORDER BY rolename
3257 ", 'rolename');
3258
3259     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3260
3261     $self->display({
3262         db_usernames => $arg->{db_usernames},
3263         username => $userp->{username},
3264         comment => $userp->{comment},
3265         passwd => $userp->{passwd},
3266         lang => $userp->{lang},
3267         use_acl => $userp->{use_acl},
3268         db_client_groups => $arg->{db_client_groups},
3269         client_group => [ values %$scg ],
3270         db_roles => [ values %$role],
3271     }, "display_user.tpl");
3272 }
3273
3274
3275 ###########################################################
3276
3277 sub get_media_max_size
3278 {
3279     my ($self, $type) = @_;
3280     my $query =
3281 "SELECT avg(VolBytes) AS size
3282   FROM Media
3283  WHERE Media.VolStatus = 'Full'
3284    AND Media.MediaType = '$type'
3285 ";
3286
3287     my $res = $self->selectrow_hashref($query);
3288
3289     if ($res) {
3290         return $res->{size};
3291     } else {
3292         return 0;
3293     }
3294 }
3295
3296 sub update_media
3297 {
3298     my ($self) = @_ ;
3299
3300     my $media = $self->get_form('qmedia');
3301
3302     unless ($media->{qmedia}) {
3303         return $self->error("Can't get media");
3304     }
3305
3306     my $query = "
3307 SELECT Media.Slot         AS slot,
3308        PoolMedia.Name     AS poolname,
3309        Media.VolStatus    AS volstatus,
3310        Media.InChanger    AS inchanger,
3311        Location.Location  AS location,
3312        Media.VolumeName   AS volumename,
3313        Media.MaxVolBytes  AS maxvolbytes,
3314        Media.MaxVolJobs   AS maxvoljobs,
3315        Media.MaxVolFiles  AS maxvolfiles,
3316        Media.VolUseDuration AS voluseduration,
3317        Media.VolRetention AS volretention,
3318        Media.Comment      AS comment,
3319        PoolRecycle.Name   AS poolrecycle,
3320        Media.Enabled      AS enabled
3321
3322 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3323            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3324            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3325
3326 WHERE Media.VolumeName = $media->{qmedia}
3327 ";
3328
3329     my $row = $self->dbh_selectrow_hashref($query);
3330     $row->{volretention} = human_sec($row->{volretention});
3331     $row->{voluseduration} = human_sec($row->{voluseduration});
3332     $row->{enabled} = human_enabled($row->{enabled});
3333
3334     my $elt = $self->get_form(qw/db_pools db_locations/);
3335
3336     $self->display({
3337         %$elt,
3338         %$row,
3339     }, "update_media.tpl");
3340 }
3341
3342 sub save_location
3343 {
3344     my ($self) = @_ ;
3345     $self->can_do('r_media_mgnt');
3346
3347     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3348
3349     unless ($arg->{jmedias}) {
3350         return $self->error("Can't get selected media");
3351     }
3352
3353     unless ($arg->{qnewlocation}) {
3354         return $self->error("Can't get new location");
3355     }
3356
3357     my $query = "
3358  UPDATE Media
3359      SET LocationId = (SELECT LocationId
3360                        FROM Location
3361                        WHERE Location = $arg->{qnewlocation})
3362      WHERE Media.VolumeName IN ($arg->{jmedias})
3363 ";
3364
3365     my $nb = $self->dbh_do($query);
3366
3367     print "$nb media updated, you may have to update your autochanger.";
3368
3369     $self->display_media();
3370 }
3371
3372 sub location_change
3373 {
3374     my ($self) = @_ ;
3375     $self->can_do('r_media_mgnt');
3376
3377     my $media = $self->get_selected_media_location();
3378     unless ($media) {
3379         return $self->error("Can't get media selection");
3380     }
3381     my $newloc = CGI::param('newlocation');
3382
3383     my $user = CGI::param('user') || 'unknown';
3384     my $comm = CGI::param('comment') || '';
3385     $comm = $self->dbh_quote("$user: $comm");
3386
3387     my $arg = $self->get_form('enabled');
3388     my $en = from_human_enabled($arg->{enabled});
3389     my $b = $self->get_bconsole();
3390
3391     my $query;
3392     foreach my $vol (keys %$media) {
3393         $query = "
3394 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3395  SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3396    FROM Media, Location
3397   WHERE Media.VolumeName = '$vol'
3398     AND Location.Location = '$media->{$vol}->{location}'
3399 ";
3400         $self->dbh_do($query);
3401         $self->debug($query);
3402         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3403     }
3404     $b->close();
3405
3406     my $q = new CGI;
3407     $q->param('action', 'update_location');
3408     my $url = $q->url(-full => 1, -query=>1);
3409
3410     $self->display({ email  => $self->{info}->{email_media},
3411                      url => $url,
3412                      newlocation => $newloc,
3413                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3414                      media => [ values %$media ],
3415                    },
3416                    "change_location.tpl");
3417
3418 }
3419
3420 sub display_client_stats
3421 {
3422     my ($self, %arg) = @_ ;
3423     $self->can_do('r_view_stat');
3424
3425     my $client = $self->dbh_quote($arg{clientname});
3426     # get security filter
3427     my $filter = $self->get_client_filter();
3428
3429     my ($limit, $label) = $self->get_limit(%arg);
3430     my $query = "
3431 SELECT
3432     count(Job.JobId)     AS nb_jobs,
3433     sum(Job.JobBytes)    AS nb_bytes,
3434     sum(Job.JobErrors)   AS nb_err,
3435     sum(Job.JobFiles)    AS nb_files,
3436     Client.Name          AS clientname
3437 FROM Job JOIN Client USING (ClientId) $filter
3438 WHERE
3439     Client.Name = $client
3440     $limit
3441 GROUP BY Client.Name
3442 ";
3443
3444     my $row = $self->dbh_selectrow_hashref($query);
3445
3446     $row->{ID} = $cur_id++;
3447     $row->{label} = $label;
3448     $row->{grapharg} = "client";
3449
3450     $self->display($row, "display_client_stats.tpl");
3451 }
3452
3453
3454 sub display_group_stats
3455 {
3456     my ($self, %arg) = @_ ;
3457
3458     my $carg = $self->get_form(qw/qclient_group/);
3459
3460     unless ($carg->{qclient_group}) {
3461         return $self->error("Can't get group");
3462     }
3463
3464     my ($limit, $label) = $self->get_limit(%arg);
3465
3466     my $query = "
3467 SELECT
3468     count(Job.JobId)     AS nb_jobs,
3469     sum(Job.JobBytes)    AS nb_bytes,
3470     sum(Job.JobErrors)   AS nb_err,
3471     sum(Job.JobFiles)    AS nb_files,
3472     client_group.client_group_name  AS clientname
3473 FROM Job JOIN Client USING (ClientId)
3474          JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3475          JOIN client_group USING (client_group_id)
3476 WHERE
3477     client_group.client_group_name = $carg->{qclient_group}
3478     $limit
3479 GROUP BY client_group.client_group_name
3480 ";
3481
3482     my $row = $self->dbh_selectrow_hashref($query);
3483
3484     $row->{ID} = $cur_id++;
3485     $row->{label} = $label;
3486     $row->{grapharg} = "client_group";
3487
3488     $self->display($row, "display_client_stats.tpl");
3489 }
3490
3491 # [ name, num, value, joberrors, nb_job ] =>
3492 # {  items =>
3493 #      [ { name => 'ALL',
3494 #          events => [ { num => 1, label => '2007-01',
3495 #                        value => 'T', title => 10 },
3496 #                      { num => 2, label => '2007-02',
3497 #                        value => 'R', title => 11 },
3498 #                     ]
3499 #         },
3500 #         { name => 'Other',
3501 #            ...
3502 #       ]
3503 # };
3504 sub make_overview_tab
3505 {
3506     my ($self, $q) = @_;
3507     my $ret = $self->dbh_selectall_arrayref($q);
3508     my @items;
3509     my $events=[];
3510     my $cur_name='';
3511     for my $elt (@$ret) {
3512         if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3513             push @items, { name => $cur_name, events => $events};
3514             $events = [];
3515         }
3516         $cur_name = $elt->[0];
3517         push @$events,
3518           { num => $elt->[1], status => $elt->[2],
3519             joberrors => $elt->[3], title => "$elt->[4] jobs"};
3520     }
3521     push @items, { name => $cur_name, events => $events};
3522     return \@items;
3523 }
3524
3525 sub get_time_overview
3526 {
3527     my ($self, $arg) = @_; # want since et age from get_form();
3528     my $type = $arg->{type} || 'day';
3529     if ($type =~ /^(day|week|hour|month)$/) {
3530         $type = uc($1);
3531     } else {
3532         $arg->{type}='day';
3533         $type = 'DAY';
3534     }
3535     my $jobt = $self->{info}->{stat_job_table} || 'Job';
3536     my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3537     $stime1 =~ s/Job.StartTime/date/;
3538     my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3539
3540     my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3541                                            'age' => $arg->{age});
3542     return ($stime1, $stime2, $limit, $label, $jobt);
3543 }
3544
3545 #              lu ma me je ve sa di
3546 #  groupe1     v  v  x  w  v  v  v    overview
3547 #   |-- s1     v  v  v  v  v  v  v    overview_zoom
3548 #   |-- s2     v  v  x  v  v  v  v
3549 #   `-- s3     v  v  v  w  v  v  v
3550 sub display_overview_zoom
3551 {
3552     my ($self) = @_;
3553     $self->can_do('r_view_stat');
3554
3555     my $arg = $self->get_form(qw/jclient_groups age since type/);
3556
3557     if (!$arg->{jclient_groups}) {
3558         return $self->error("Can't get client_group selection");
3559     }
3560     my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3561     my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3562
3563     my $filter = $self->get_client_filter();
3564     my $q = "
3565 SELECT name, $stime1 AS num,
3566        JobStatus AS value, joberrors, nb_job
3567 FROM (
3568   SELECT $stime2        AS date,
3569          Client.Name    AS name,
3570          MAX(severity)  AS severity,
3571          COUNT(1)       AS nb_job,
3572          SUM(JobErrors) AS joberrors
3573     FROM $jobt AS Job
3574     JOIN client_group_member USING (ClientId)
3575     JOIN client_group        USING (client_group_id)
3576     JOIN Client              USING (ClientId)  $filter
3577     JOIN Status              USING (JobStatus)
3578    WHERE client_group_name IN ($arg->{jclient_groups})
3579          $limit $filter2
3580
3581    GROUP BY Client.Name, date
3582 ) AS sub JOIN Status USING (severity)
3583  ORDER BY name, date
3584 ";
3585     my $items = $self->make_overview_tab($q);
3586     $self->display({label => $label,
3587                     action => "job;since=$arg->{since};type=$arg->{type};age=$arg->{age};client=",
3588                     items => $items}, "overview.tpl");
3589 }
3590
3591 sub display_overview
3592 {
3593     my ($self) = @_ ;
3594     $self->can_do('r_view_stat');
3595
3596     my $arg = $self->get_form(qw/jclient_groups age since type/);
3597     my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3598     my $filter3 = $self->get_client_group_filter();
3599     my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3600
3601     my $q = "
3602 SELECT name, $stime1 AS num,
3603        JobStatus AS value, joberrors, nb_job
3604 FROM (
3605   SELECT $stime2        AS date,
3606          client_group_name AS name,
3607          MAX(severity)  AS severity,
3608          COUNT(1)       AS nb_job,
3609          SUM(JobErrors) AS joberrors
3610     FROM $jobt AS Job
3611     JOIN client_group_member USING (ClientId)
3612     JOIN client_group        USING (client_group_id) $filter3
3613     JOIN Status              USING (JobStatus)
3614    WHERE true $filter1 $filter2
3615    GROUP BY client_group_name, date
3616 ) AS sub JOIN Status USING (severity)
3617  ORDER BY name, date
3618 ";
3619     my $items = $self->make_overview_tab($q);
3620     $self->display({label=>$label,
3621                     action => "overview_zoom;since=$arg->{since};type=$arg->{type};age=$arg->{age};client_group=",
3622                     items => $items}, "overview.tpl");
3623
3624 }
3625
3626 # poolname can be undef
3627 sub display_pool
3628 {
3629     my ($self, $poolname) = @_ ;
3630     $self->can_do('r_view_media');
3631
3632     my $whereA = '';
3633     my $whereW = '';
3634
3635     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3636     if ($arg->{jmediatypes}) {
3637         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3638         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3639     }
3640
3641 # TODO : afficher les tailles et les dates
3642
3643     my $query = "
3644 SELECT subq.volmax        AS volmax,
3645        subq.volnum        AS volnum,
3646        subq.voltotal      AS voltotal,
3647        Pool.Name          AS name,
3648        Pool.Recycle       AS recycle,
3649        Pool.VolRetention  AS volretention,
3650        Pool.VolUseDuration AS voluseduration,
3651        Pool.MaxVolJobs    AS maxvoljobs,
3652        Pool.MaxVolFiles   AS maxvolfiles,
3653        Pool.MaxVolBytes   AS maxvolbytes,
3654        subq.PoolId        AS PoolId,
3655        subq.MediaType     AS mediatype,
3656        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3657 FROM
3658   (
3659     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3660            count(Media.MediaId)  AS volnum,
3661            sum(Media.VolBytes)   AS voltotal,
3662            Media.PoolId          AS PoolId,
3663            Media.MediaType       AS MediaType
3664     FROM Media
3665     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3666                       Media.MediaType     AS MediaType
3667                FROM Media
3668               WHERE Media.VolStatus = 'Full'
3669               GROUP BY Media.MediaType
3670                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3671     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3672   ) AS subq
3673 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3674 $whereW
3675 ";
3676
3677     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3678
3679     $query = "
3680 SELECT Pool.Name AS name,
3681        sum(VolBytes) AS size
3682 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3683 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3684        $whereA
3685 GROUP BY Pool.Name;
3686 ";
3687     my $empty = $self->dbh_selectall_hashref($query, 'name');
3688
3689     foreach my $p (values %$all) {
3690         if ($p->{volmax} > 0) { # mysql returns 0.0000
3691             # we remove Recycled/Purged media from pool usage
3692             if (defined $empty->{$p->{name}}) {
3693                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3694             }
3695             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3696         } else {
3697             $p->{poolusage} = 0;
3698         }
3699
3700         $query = "
3701   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3702     FROM Media
3703    WHERE PoolId=$p->{poolid}
3704      AND Media.MediaType = '$p->{mediatype}'
3705          $whereA
3706 GROUP BY VolStatus
3707 ";
3708         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3709         foreach my $t (values %$content) {
3710             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3711         }
3712     }
3713
3714     $self->debug($all);
3715     $self->display({ ID => $cur_id++,
3716                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3717                      Pools => [ values %$all ]},
3718                    "display_pool.tpl");
3719 }
3720
3721 sub display_running_job
3722 {
3723     my ($self) = @_;
3724     return if $self->cant_do('r_view_running_job');
3725
3726     my $arg = $self->get_form('client', 'jobid');
3727
3728     if (!$arg->{client} and $arg->{jobid}) {
3729         # get security filter
3730         my $filter = $self->get_client_filter();
3731
3732         my $query = "
3733 SELECT Client.Name AS name
3734 FROM Job INNER JOIN Client USING (ClientId) $filter
3735 WHERE Job.JobId = $arg->{jobid}
3736 ";
3737
3738         my $row = $self->dbh_selectrow_hashref($query);
3739
3740         if ($row) {
3741             $arg->{client} = $row->{name};
3742             CGI::param('client', $arg->{client});
3743         }
3744     }
3745
3746     if ($arg->{client}) {
3747         my $cli = new Bweb::Client(name => $arg->{client});
3748         $cli->display_running_job($self->{info}, $arg->{jobid});
3749         if ($arg->{jobid}) {
3750             $self->get_job_log();
3751         }
3752     } else {
3753         $self->error("Can't get client or jobid");
3754     }
3755 }
3756
3757 sub display_running_jobs
3758 {
3759     my ($self, $display_action) = @_;
3760     return if $self->cant_do('r_view_running_job');
3761
3762     # get security filter
3763     my $filter = $self->get_client_filter();
3764
3765     my $query = "
3766 SELECT Job.JobId AS jobid,
3767        Job.Name  AS jobname,
3768        Job.Level     AS level,
3769        Job.StartTime AS starttime,
3770        Job.JobFiles  AS jobfiles,
3771        Job.JobBytes  AS jobbytes,
3772        Job.JobStatus AS jobstatus,
3773 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3774                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3775          AS duration,
3776        Client.Name AS clientname
3777 FROM Job INNER JOIN Client USING (ClientId) $filter
3778 WHERE
3779   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3780 ";
3781     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3782
3783     $self->display({ ID => $cur_id++,
3784                      display_action => $display_action,
3785                      Jobs => [ values %$all ]},
3786                    "running_job.tpl") ;
3787 }
3788
3789 # return the autochanger list to update
3790 sub eject_media
3791 {
3792     my ($self) = @_;
3793     $self->can_do('r_media_mgnt');
3794
3795     my %ret;
3796     my $arg = $self->get_form('jmedias');
3797
3798     unless ($arg->{jmedias}) {
3799         return $self->error("Can't get media selection");
3800     }
3801
3802     my $query = "
3803 SELECT Media.VolumeName  AS volumename,
3804        Storage.Name      AS storage,
3805        Location.Location AS location,
3806        Media.Slot        AS slot
3807 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
3808            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3809 WHERE Media.VolumeName IN ($arg->{jmedias})
3810   AND Media.InChanger = 1
3811 ";
3812
3813     my $all = $self->dbh_selectall_hashref($query, 'volumename');
3814
3815     foreach my $vol (values %$all) {
3816         my $a = $self->ach_get($vol->{location});
3817         next unless ($a) ;
3818         $ret{$vol->{location}} = 1;
3819
3820         unless ($a->{have_status}) {
3821             $a->status();
3822             $a->{have_status} = 1;
3823         }
3824         # TODO: set enabled
3825         print "eject $vol->{volumename} from $vol->{storage} : ";
3826         if ($a->send_to_io($vol->{slot})) {
3827             print "<img src='/bweb/T.png' alt='ok'><br/>";
3828         } else {
3829             print "<img src='/bweb/E.png' alt='err'><br/>";
3830         }
3831     }
3832     return keys %ret;
3833 }
3834
3835 sub move_email
3836 {
3837     my ($self) = @_;
3838
3839     my ($to, $subject, $content) = (CGI::param('email'),
3840                                     CGI::param('subject'),
3841                                     CGI::param('content'));
3842     $to =~ s/[^\w\d\.\@<>,]//;
3843     $subject =~ s/[^\w\d\.\[\]]/ /;
3844
3845     open(MAIL, "|mail -s '$subject' '$to'") ;
3846     print MAIL $content;
3847     close(MAIL);
3848
3849     print "Mail sent";
3850 }
3851
3852 sub restore
3853 {
3854     my ($self) = @_;
3855
3856     my $arg = $self->get_form('jobid', 'client');
3857
3858     print CGI::header('text/brestore');
3859     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3860     print "client=$arg->{client}\n" if ($arg->{client});
3861     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3862     print "\n";
3863 }
3864
3865 # TODO : move this to Bweb::Autochanger ?
3866 # TODO : make this internal to not eject tape ?
3867 use Bconsole;
3868
3869
3870 sub ach_get
3871 {
3872     my ($self, $name) = @_;
3873
3874     unless ($name) {
3875         return $self->error("Can't get your autochanger name ach");
3876     }
3877
3878     unless ($self->{info}->{ach_list}) {
3879         return $self->error("Could not find any autochanger");
3880     }
3881
3882     my $a = $self->{info}->{ach_list}->{$name};
3883
3884     unless ($a) {
3885         $self->error("Can't get your autochanger $name from your ach_list");
3886         return undef;
3887     }
3888
3889     $a->{bweb}  = $self;
3890     $a->{debug} = $self->{debug};
3891
3892     return $a;
3893 }
3894
3895 sub ach_register
3896 {
3897     my ($self, $ach) = @_;
3898     $self->can_do('r_configure');
3899
3900     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3901
3902     $self->{info}->save();
3903
3904     return 1;
3905 }
3906
3907 sub ach_edit
3908 {
3909     my ($self) = @_;
3910     $self->can_do('r_configure');
3911
3912     my $arg = $self->get_form('ach');
3913     if (!$arg->{ach}
3914         or !$self->{info}->{ach_list}
3915         or !$self->{info}->{ach_list}->{$arg->{ach}})
3916     {
3917         return $self->error("Can't get autochanger name");
3918     }
3919
3920     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3921
3922     my $i=0;
3923     $ach->{drives} =
3924         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3925
3926     my $b = $self->get_bconsole();
3927
3928     my @storages = $b->list_storage() ;
3929
3930     $ach->{devices} = [ map { { name => $_ } } @storages ];
3931
3932     $self->display($ach, "ach_add.tpl");
3933     delete $ach->{drives};
3934     delete $ach->{devices};
3935     return 1;
3936 }
3937
3938 sub ach_del
3939 {
3940     my ($self) = @_;
3941     $self->can_do('r_configure');
3942
3943     my $arg = $self->get_form('ach');
3944
3945     if (!$arg->{ach}
3946         or !$self->{info}->{ach_list}
3947         or !$self->{info}->{ach_list}->{$arg->{ach}})
3948     {
3949         return $self->error("Can't get autochanger name");
3950     }
3951
3952     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3953
3954     $self->{info}->save();
3955     $self->{info}->view();
3956 }
3957
3958 sub ach_add
3959 {
3960     my ($self) = @_;
3961     $self->can_do('r_configure');
3962
3963     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3964
3965     my $b = $self->get_bconsole();
3966     my @storages = $b->list_storage() ;
3967
3968     unless ($arg->{ach}) {
3969         $arg->{devices} = [ map { { name => $_ } } @storages ];
3970         return $self->display($arg, "ach_add.tpl");
3971     }
3972
3973     my @drives ;
3974     foreach my $drive (CGI::param('drives'))
3975     {
3976         unless (grep(/^$drive$/,@storages)) {
3977             return $self->error("Can't find $drive in storage list");
3978         }
3979
3980         my $index = CGI::param("index_$drive");
3981         unless (defined $index and $index =~ /^(\d+)$/) {
3982             return $self->error("Can't get $drive index");
3983         }
3984
3985         $drives[$index] = $drive;
3986     }
3987
3988     unless (@drives) {
3989         return $self->error("Can't get drives from Autochanger");
3990     }
3991
3992     my $a = new Bweb::Autochanger(name   => $arg->{ach},
3993                                   precmd => $arg->{precmd},
3994                                   drive_name => \@drives,
3995                                   device => $arg->{device},
3996                                   mtxcmd => $arg->{mtxcmd});
3997
3998     $self->ach_register($a) ;
3999
4000     $self->{info}->view();
4001 }
4002
4003 sub delete
4004 {
4005     my ($self) = @_;
4006     $self->can_do('r_delete_job');
4007
4008     my $arg = $self->get_form('jobid');
4009
4010     if ($arg->{jobid}) {
4011         my $b = $self->get_bconsole();
4012         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4013
4014         $self->display({
4015             content => $ret,
4016             title => "Delete a job ",
4017             name => "delete jobid=$arg->{jobid}",
4018         }, "command.tpl");
4019     }
4020 }
4021
4022 sub do_update_media
4023 {
4024     my ($self) = @_ ;
4025     $self->can_do('r_media_mgnt');
4026
4027     my $arg = $self->get_form(qw/media volstatus inchanger pool
4028                                  slot volretention voluseduration
4029                                  maxvoljobs maxvolfiles maxvolbytes
4030                                  qcomment poolrecycle enabled
4031                               /);
4032
4033     unless ($arg->{media}) {
4034         return $self->error("Can't find media selection");
4035     }
4036
4037     my $update = "update volume=$arg->{media} ";
4038
4039     if ($arg->{volstatus}) {
4040         $update .= " volstatus=$arg->{volstatus} ";
4041     }
4042
4043     if ($arg->{inchanger}) {
4044         $update .= " inchanger=yes " ;
4045         if ($arg->{slot}) {
4046             $update .= " slot=$arg->{slot} ";
4047         }
4048     } else {
4049         $update .= " slot=0 inchanger=no ";
4050     }
4051
4052     if ($arg->{enabled}) {
4053         $update .= " enabled=$arg->{enabled} ";
4054     }
4055
4056     if ($arg->{pool}) {
4057         $update .= " pool=$arg->{pool} " ;
4058     }
4059
4060     if (defined $arg->{volretention}) {
4061         $update .= " volretention=\"$arg->{volretention}\" " ;
4062     }
4063
4064     if (defined $arg->{voluseduration}) {
4065         $update .= " voluse=\"$arg->{voluseduration}\" " ;
4066     }
4067
4068     if (defined $arg->{maxvoljobs}) {
4069         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4070     }
4071
4072     if (defined $arg->{maxvolfiles}) {
4073         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4074     }
4075
4076     if (defined $arg->{maxvolbytes}) {
4077         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4078     }
4079
4080     if (defined $arg->{poolrecycle}) {
4081         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4082     }
4083
4084     my $b = $self->get_bconsole();
4085
4086     $self->display({
4087         content => $b->send_cmd($update),
4088         title => "Update a volume ",
4089         name => $update,
4090     }, "command.tpl");
4091
4092
4093     my @q;
4094     my $media = $self->dbh_quote($arg->{media});
4095
4096     my $loc = CGI::param('location') || '';
4097     if ($loc) {
4098         $loc = $self->dbh_quote($loc); # is checked by db
4099         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4100     }
4101     if (!$arg->{qcomment}) {
4102         $arg->{qcomment} = "''";
4103     }
4104     push @q, "Comment=$arg->{qcomment}";
4105
4106
4107     my $query = "
4108 UPDATE Media
4109    SET " . join (',', @q) . "
4110  WHERE Media.VolumeName = $media
4111 ";
4112     $self->dbh_do($query);
4113
4114     $self->update_media();
4115 }
4116
4117 sub update_slots
4118 {
4119     my ($self) = @_;
4120     $self->can_do('r_autochanger_mgnt');
4121
4122     my $ach = CGI::param('ach') ;
4123     $ach = $self->ach_get($ach);
4124     unless ($ach) {
4125         return $self->error("Bad autochanger name");
4126     }
4127
4128     print "<pre>";
4129     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4130     $b->update_slots($ach->{name});
4131     print "</pre>\n"
4132 }
4133
4134 sub get_job_log
4135 {
4136     my ($self) = @_;
4137     $self->can_do('r_view_log');
4138
4139     my $arg = $self->get_form('jobid', 'limit', 'offset');
4140     unless ($arg->{jobid}) {
4141         return $self->error("Can't get jobid");
4142     }
4143
4144     if ($arg->{limit} == 100) {
4145         $arg->{limit} = 1000;
4146     }
4147     # get security filter
4148     my $filter = $self->get_client_filter();
4149
4150     my $query = "
4151 SELECT Job.Name as name, Client.Name as clientname
4152  FROM  Job INNER JOIN Client USING (ClientId) $filter
4153  WHERE JobId = $arg->{jobid}
4154 ";
4155
4156     my $row = $self->dbh_selectrow_hashref($query);
4157
4158     unless ($row) {
4159         return $self->error("Can't find $arg->{jobid} in catalog");
4160     }
4161
4162     # display only Error and Warning messages
4163     $filter = '';
4164     if (CGI::param('error')) {
4165         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4166     }
4167
4168     my $logtext;
4169     if (CGI::param('time') || $self->{info}->{display_log_time}) {
4170         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4171     } else {
4172         $logtext = 'LogText';
4173     }
4174
4175     $query = "
4176 SELECT count(1) AS nbline, JobId AS jobid,
4177        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
4178   FROM  (
4179     SELECT JobId, Time, LogText
4180     FROM Log
4181    WHERE ( Log.JobId = $arg->{jobid}
4182       OR (Log.JobId = 0
4183           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4184           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4185        ) ) $filter
4186  ORDER BY LogId
4187  LIMIT $arg->{limit}
4188  OFFSET $arg->{offset}
4189  ) AS temp
4190  GROUP BY JobId
4191
4192 ";
4193
4194     my $log = $self->dbh_selectrow_hashref($query);
4195     unless ($log) {
4196         return $self->error("Can't get log for jobid $arg->{jobid}");
4197     }
4198
4199     $self->display({ lines=> $log->{logtxt},
4200                      nbline => $log->{nbline},
4201                      jobid => $arg->{jobid},
4202                      name  => $row->{name},
4203                      client => $row->{clientname},
4204                      offset => $arg->{offset},
4205                      limit  => $arg->{limit},
4206                  }, 'display_log.tpl');
4207 }
4208
4209 sub add_media
4210 {
4211     my ($self) = @_ ;
4212     $self->can_do('r_media_mgnt');
4213     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4214     my $b = $self->get_bconsole();
4215
4216     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4217         CGI::param(offset => 0);
4218         $arg = $self->get_form('db_pools');
4219         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4220         $self->display($arg, 'add_media.tpl');
4221         return 1;
4222     }
4223
4224     my $cmd;
4225     if ($arg->{nb} > 0) {
4226         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4227         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4228     } else {
4229         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4230     }
4231     $b->connect();
4232     $b->send($cmd);
4233     $b->expect_it('*');
4234
4235     CGI::param('media', '');
4236     CGI::param('re_media', $arg->{media});
4237     $self->display_media();
4238 }
4239
4240 sub label_barcodes
4241 {
4242     my ($self) = @_ ;
4243     $self->can_do('r_autochanger_mgnt');
4244
4245     my $arg = $self->get_form('ach', 'slots', 'drive');
4246
4247     unless ($arg->{ach}) {
4248         return $self->error("Can't find autochanger name");
4249     }
4250
4251     my $a = $self->ach_get($arg->{ach});
4252     unless ($a) {
4253         return $self->error("Can't find autochanger name in configuration");
4254     }
4255
4256     my $storage = $a->get_drive_name($arg->{drive});
4257     unless ($storage) {
4258         return $self->error("Can't get your drive name");
4259     }
4260
4261     my $slots = '';
4262     my $slots_sql = '';
4263     my $t = 300 ;
4264     if ($arg->{slots}) {
4265         $slots = join(",", @{ $arg->{slots} });
4266         $slots_sql = " AND Slot IN ($slots) ";
4267         $t += 60*scalar( @{ $arg->{slots} }) ;
4268     }
4269
4270     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4271     print "<h1>This command can take long time, be patient...</h1>";
4272     print "<pre>" ;
4273     $b->label_barcodes(storage => $storage,
4274                        drive => $arg->{drive},
4275                        pool  => 'Scratch',
4276                        slots => $slots) ;
4277     $b->close();
4278     print "</pre>";
4279
4280     $self->dbh_do("
4281   UPDATE Media
4282        SET LocationId =   (SELECT LocationId
4283                              FROM Location
4284                             WHERE Location = '$arg->{ach}')
4285
4286      WHERE (LocationId = 0 OR LocationId IS NULL)
4287        $slots_sql
4288 ");
4289
4290 }
4291
4292 sub purge
4293 {
4294     my ($self) = @_;
4295     $self->can_do('r_purge');
4296
4297     my @volume = CGI::param('media');
4298
4299     unless (@volume) {
4300         return $self->error("Can't get media selection");
4301     }
4302
4303     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4304
4305     foreach my $v (@volume) {
4306         $self->display({
4307             content => $b->purge_volume($v),
4308             title => "Purge media",
4309             name => "purge volume=$v",
4310         }, "command.tpl");
4311     }
4312     $b->close();
4313 }
4314
4315 sub prune
4316 {
4317     my ($self) = @_;
4318     $self->can_do('r_prune');
4319
4320     my @volume = CGI::param('media');
4321     unless (@volume) {
4322         return $self->error("Can't get media selection");
4323     }
4324
4325     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4326
4327     foreach my $v (@volume) {
4328         $self->display({
4329             content => $b->prune_volume($v),
4330             title => "Prune volume",
4331             name => "prune volume=$v",
4332         }, "command.tpl");
4333     }
4334     $b->close();
4335 }
4336
4337 sub cancel_job
4338 {
4339     my ($self) = @_;
4340     $self->can_do('r_cancel_job');
4341
4342     my $arg = $self->get_form('jobid');
4343     unless ($arg->{jobid}) {
4344         return $self->error("Can't get jobid");
4345     }
4346
4347     my $b = $self->get_bconsole();
4348     $self->display({
4349         content => $b->cancel($arg->{jobid}),
4350         title => "Cancel job",
4351         name => "cancel jobid=$arg->{jobid}",
4352     }, "command.tpl");
4353 }
4354
4355 sub fileset_view
4356 {
4357     # Warning, we display current fileset
4358     my ($self) = @_;
4359
4360     my $arg = $self->get_form('fileset');
4361
4362     if ($arg->{fileset}) {
4363         my $b = $self->get_bconsole();
4364         my $ret = $b->get_fileset($arg->{fileset});
4365         $self->display({ fileset => $arg->{fileset},
4366                          %$ret,
4367                      }, "fileset_view.tpl");
4368     } else {
4369         $self->error("Can't get fileset name");
4370     }
4371 }
4372
4373 sub director_show_sched
4374 {
4375     my ($self) = @_ ;
4376     $self->can_do('r_view_job');
4377     my $arg = $self->get_form('days');
4378
4379     my $b = $self->get_bconsole();
4380     my $ret = $b->director_get_sched( $arg->{days} );
4381
4382     $self->display({
4383         id => $cur_id++,
4384         list => $ret,
4385     }, "scheduled_job.tpl");
4386 }
4387
4388 sub enable_disable_job
4389 {
4390     my ($self, $what) = @_ ;
4391     $self->can_do('r_run_job');
4392
4393     my $name = CGI::param('job') || '';
4394     unless ($name =~ /^[\w\d\.\-\s]+$/) {
4395         return $self->error("Can't find job name");
4396     }
4397
4398     my $b = $self->get_bconsole();
4399
4400     my $cmd;
4401     if ($what) {
4402         $cmd = "enable";
4403     } else {
4404         $cmd = "disable";
4405     }
4406
4407     $self->display({
4408         content => $b->send_cmd("$cmd job=\"$name\""),
4409         title => "$cmd $name",
4410         name => "$cmd job=\"$name\"",
4411     }, "command.tpl");
4412 }
4413
4414 sub get_bconsole
4415 {
4416     my ($self) = @_;
4417     return new Bconsole(pref => $self->{info});
4418 }
4419
4420 sub run_job_select
4421 {
4422     my ($self) = @_;
4423     $self->can_do('r_run_job');
4424
4425     my $b = $self->get_bconsole();
4426
4427     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4428
4429     $self->display({ Jobs => $joblist }, "run_job.tpl");
4430 }
4431
4432 sub run_parse_job
4433 {
4434     my ($self, $ouput) = @_;
4435
4436     my %arg;
4437     foreach my $l (split(/\r\n/, $ouput)) {
4438         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4439             $arg{$1} = $2;
4440             $l = $3
4441                 if ($3) ;
4442         }
4443
4444         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4445             %arg = (%arg, @l);
4446         }
4447     }
4448
4449     my %lowcase ;
4450     foreach my $k (keys %arg) {
4451         $lowcase{lc($k)} = $arg{$k} ;
4452     }
4453
4454     return \%lowcase;
4455 }
4456
4457 sub run_job_mod
4458 {
4459     my ($self) = @_;
4460     $self->can_do('r_run_job');
4461
4462     my $b = $self->get_bconsole();
4463
4464     my $job = CGI::param('job') || '';
4465
4466     # we take informations from director, and we overwrite with user wish
4467     my $info = $b->send_cmd("show job=\"$job\"");
4468     my $attr = $self->run_parse_job($info);
4469
4470     my $arg = $self->get_form(qw/pool level client fileset storage media/);
4471
4472     if (!$arg->{pool} and $arg->{media}) {
4473         my $r = $self->dbh_selectrow_hashref("
4474 SELECT Pool.Name AS name
4475   FROM Media JOIN Pool USING (PoolId)
4476  WHERE Media.VolumeName = '$arg->{media}'
4477    AND Pool.Name != 'Scratch'
4478 ");
4479         if ($r) {
4480             $arg->{pool} = $r->{name};
4481         }
4482     }
4483
4484     my %job_opt = (%$attr, %$arg);
4485
4486     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4487
4488     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4489     my $clients = [ map { { name => $_ } }$b->list_client()];
4490     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4491     my $storages= [ map { { name => $_ } }$b->list_storage()];
4492
4493     $self->display({
4494         jobs     => $jobs,
4495         pools    => $pools,
4496         clients  => $clients,
4497         filesets => $filesets,
4498         storages => $storages,
4499         %job_opt,
4500     }, "run_job_mod.tpl");
4501 }
4502
4503 sub run_job
4504 {
4505     my ($self) = @_;
4506     $self->can_do('r_run_job');
4507
4508     my $b = $self->get_bconsole();
4509
4510     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4511
4512     $self->display({
4513         jobs     => $jobs,
4514     }, "run_job.tpl");
4515 }
4516
4517 sub run_job_now
4518 {
4519     my ($self) = @_;
4520     $self->can_do('r_run_job');
4521
4522     my $b = $self->get_bconsole();
4523
4524     # TODO: check input (don't use pool, level)
4525
4526     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4527     my $job = CGI::param('job') || '';
4528     my $storage = CGI::param('storage') || '';
4529
4530     my $jobid = $b->run(job => $job,
4531                         client => $arg->{client},
4532                         priority => $arg->{priority},
4533                         level => $arg->{level},
4534                         storage => $storage,
4535                         pool => $arg->{pool},
4536                         fileset => $arg->{fileset},
4537                         when => $arg->{when},
4538                         );
4539
4540     print $b->{error};
4541
4542     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>";
4543 }
4544
4545 sub display_next_job
4546 {
4547     my ($self) = @_;
4548     my $arg = $self->get_form(qw/job/);
4549     if (!$arg->{job}) {
4550         return $self->error("Can't get job name");
4551     }
4552
4553     my $b = $self->get_bconsole();
4554
4555     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
4556     if ($job !~ /Schedule: name=([\w\d\-]+)/s) {
4557         return $self->error("Can't get $arg->{job} schedule");
4558     }
4559     my $jsched = $1;
4560     my $jpool='';
4561     if ($job =~ /Pool: name=([\w\d\-]+) PoolType=/) {
4562         $jpool = $1;
4563     }
4564
4565     my $out = $b->send_cmd("show schedule=\"$jsched\"");
4566     my $sched = new Bweb::Sched();
4567     $sched->parse_scheds(split(/\r?\n/, $out));
4568
4569     my $ss = $sched->get_scheds($jsched);
4570     my @ret;
4571
4572     foreach my $s (@$ss) {
4573         my $level = $sched->get_level($s);
4574         my $pool  = $sched->get_pool($s) || $jpool;
4575         my $evt = $sched->get_event($s);
4576         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
4577     }
4578
4579     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
4580 }
4581
4582 1;