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