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