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

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bweb - A Bacula web interface
   7    Bacula® - The Network Backup Solution
   8
   9    Copyright (C) 2000-2007 Free Software Foundation Europe e.V.
  10
  11    The main author of Bweb is Eric Bollengier.
  12    The main author of Bacula is Kern Sibbald, with contributions from
  13    many others, a complete list can be found in the file AUTHORS.
  14
  15    This program is Free Software; you can redistribute it and/or
  16    modify it under the terms of version two of the GNU General Public
  17    License as published by the Free Software Foundation plus additions
  18    that are listed in the file LICENSE.
  19
  20    This program is distributed in the hope that it will be useful, but
  21    WITHOUT ANY WARRANTY; without even the implied warranty of
  22    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  23    General Public License for more details.
  24
  25    You should have received a copy of the GNU General Public License
  26    along with this program; if not, write to the Free Software
  27    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  28    02110-1301, USA.
  29
  30    Bacula® is a registered trademark of John Walker.
  31    The licensor of Bacula is the Free Software Foundation Europe
  32    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  33    Switzerland, email:ftf@fsfeurope.org.
  34
  35 =head1 VERSION
  36
  37     $Id$
  38
  39 =cut
  40
  41 package Bweb::Gui;
  42
  43 =head1 PACKAGE
  44
  45     Bweb::Gui - Base package for all Bweb object
  46
  47 =head2 DESCRIPTION
  48
  49     This package define base fonction like new, display, etc..
  50
  51 =cut
  52
  53 use HTML::Template;
  54 our $template_dir='/usr/share/bweb/tpl';
  55
  56 =head1 FUNCTION
  57
  58     new - creation a of new Bweb object
  59
  60 =head2 DESCRIPTION
  61
  62     This function take an hash of argument and place them
  63     on bless ref
  64
  65     IE : $obj = new Obj(name => 'test', age => '10');
  66
  67          $obj->{name} eq 'test' and $obj->{age} eq 10
  68
  69 =cut
  70
  71 sub new
  72 {
  73     my ($class, %arg) = @_;
  74     my $self = bless {
  75         name => undef,
  76     }, $class;
  77
  78     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
  79
  80     return $self;
  81 }
  82
  83 sub debug
  84 {
  85     my ($self, $what) = @_;
  86
  87     if ($self->{debug}) {
  88         if (ref $what) {
  89             print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
  90         } else {
  91             print "<pre>$what</pre>";
  92         }
  93     }
  94 }
  95
  96 =head1 FUNCTION
  97
  98     error - display an error to the user
  99
 100 =head2 DESCRIPTION
 101
 102     this function set $self->{error} with arg, display a message with
 103     error.tpl and return 0
 104
 105 =head2 EXAMPLE
 106
 107     unless (...) {
 108         return $self->error("Can't use this file");
 109     }
 110
 111 =cut
 112
 113 sub error
 114 {
 115     my ($self, $what) = @_;
 116     $self->{error} = $what;
 117     $self->display($self, 'error.tpl');
 118     return 0;
 119 }
 120
 121 =head1 FUNCTION
 122
 123     display - display an html page with HTML::Template
 124
 125 =head2 DESCRIPTION
 126
 127     this function is use to render all html codes. it takes an
 128     ref hash as arg in which all param are usable in template.
 129
 130     it will use 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     my $where=' WHERE true ';   # by default
1299
1300     my $arg = $self->get_form("client", "qre_client",
1301                               "jclient_groups", "qnotingroup");
1302
1303     my ($filter, undef) = $self->get_param('username');
1304
1305     if ($arg->{qre_client}) {
1306         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1307     } elsif ($arg->{client}) {
1308         $where = "WHERE Name = '$arg->{client}' ";
1309     } elsif ($arg->{jclient_groups}) {
1310         # $filter could already contains client_group_member
1311         $where = ($filter?'':"
1312  JOIN client_group_member USING (ClientId)
1313  JOIN client_group USING (client_group_id)") .
1314
1315 " WHERE client_group_name IN ($arg->{jclient_groups}) ";
1316     } elsif ($arg->{qnotingroup}) {
1317         $where =   "
1318   WHERE NOT EXISTS
1319    (SELECT 1 FROM client_group_member
1320      WHERE Client.ClientId = client_group_member.ClientId
1321    )
1322 ";
1323     }
1324
1325     my $query = "
1326 SELECT Name   AS name,
1327        Uname  AS uname,
1328        AutoPrune AS autoprune,
1329        FileRetention AS fileretention,
1330        JobRetention  AS jobretention
1331 FROM Client " . $self->get_client_filter() .
1332 $where . $filter ;
1333
1334     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1335
1336     my $dsp = { ID => $cur_id++,
1337                 clients => [ values %$all] };
1338
1339     $self->display($dsp, "client_list.tpl") ;
1340 }
1341
1342 sub get_limit
1343 {
1344     my ($self, %arg) = @_;
1345
1346     my $limit = '';
1347     my $label = '';
1348
1349     if ($arg{age}) {
1350         $limit =
1351   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1352          >
1353        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1354          -
1355          $self->{sql}->{TO_SEC}($arg{age})
1356        )" ;
1357
1358         $label = "last " . human_sec($arg{age});
1359     }
1360
1361     if ($arg{groupby}) {
1362         $limit .= " GROUP BY $arg{groupby} ";
1363     }
1364
1365     if ($arg{order}) {
1366         $limit .= " ORDER BY $arg{order} ";
1367     }
1368
1369     if ($arg{limit}) {
1370         $limit .= " LIMIT $arg{limit} ";
1371         $label .= " limited to $arg{limit}";
1372     }
1373
1374     if ($arg{offset}) {
1375         $limit .= " OFFSET $arg{offset} ";
1376         $label .= " with $arg{offset} offset ";
1377     }
1378
1379     unless ($label) {
1380         $label = 'no filter';
1381     }
1382
1383     return ($limit, $label);
1384 }
1385
1386 =head1 FUNCTION
1387
1388     $bweb->get_form(...) - Get useful stuff
1389
1390 =head2 DESCRIPTION
1391
1392     This function get and check parameters against regexp.
1393
1394     If word begin with 'q', the return will be quoted or join quoted
1395     if it's end with 's'.
1396
1397
1398 =head2 EXAMPLE
1399
1400     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1401
1402     { jobid    => 12,
1403       qclient  => 'plume-fd',
1404       qpools   => "'plume-fd', 'test-fd', '...'",
1405     }
1406
1407 =cut
1408
1409 sub get_form
1410 {
1411     my ($self, @what) = @_;
1412     my %what = map { $_ => 1 } @what;
1413     my %ret;
1414
1415     my %opt_i = (
1416                  limit  => 100,
1417                  cost   =>  10,
1418                  offset =>   0,
1419                  width  => 640,
1420                  height => 480,
1421                  jobid  =>   0,
1422                  slot   =>   0,
1423                  drive  =>   0,
1424                  priority => 10,
1425                  age    => 60*60*24*7,
1426                  days   => 1,
1427                  maxvoljobs  => 0,
1428                  maxvolbytes => 0,
1429                  maxvolfiles => 0,
1430                  filenameid => 0,
1431                  pathid => 0,
1432                  );
1433
1434     my %opt_ss =(               # string with space
1435                  job     => 1,
1436                  storage => 1,
1437                  );
1438     my %opt_s = (               # default to ''
1439                  ach    => 1,
1440                  status => 1,
1441                  volstatus => 1,
1442                  inchanger => 1,
1443                  client => 1,
1444                  level  => 1,
1445                  pool   => 1,
1446                  media  => 1,
1447                  ach    => 1,
1448                  jobtype=> 1,
1449                  graph  => 1,
1450                  gtype  => 1,
1451                  type   => 1,
1452                  poolrecycle => 1,
1453                  replace => 1,
1454                  expired => 1,
1455                  enabled => 1,
1456                  username => 1,
1457                  rolename => 1,
1458                  );
1459     my %opt_p = (               # option with path
1460                  fileset=> 1,
1461                  mtxcmd => 1,
1462                  precmd => 1,
1463                  device => 1,
1464                  where  => 1,
1465                  );
1466     my %opt_r = (regexwhere => 1);
1467
1468     my %opt_d = (               # option with date
1469                  voluseduration=> 1,
1470                  volretention => 1,
1471                 );
1472
1473     foreach my $i (@what) {
1474         if (exists $opt_i{$i}) {# integer param
1475             my $value = CGI::param($i) || $opt_i{$i} ;
1476             if ($value =~ /^(\d+)$/) {
1477                 $ret{$i} = $1;
1478             }
1479         } elsif ($opt_s{$i}) {  # simple string param
1480             my $value = CGI::param($i) || '';
1481             if ($value =~ /^([\w\d\.-]+)$/) {
1482                 $ret{$i} = $1;
1483             }
1484         } elsif ($opt_ss{$i}) { # simple string param (with space)
1485             my $value = CGI::param($i) || '';
1486             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1487                 $ret{$i} = $1;
1488             }
1489         } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1490             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1491             if (@value) {
1492                 $ret{$i} = $self->dbh_join(@value) ;
1493             }
1494
1495         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1496             my $value = CGI::param($1) ;
1497             if ($value) {
1498                 $ret{$i} = $self->dbh_quote($value);
1499             }
1500
1501         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1502             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1503                                            grep { ! /^\s*$/ } CGI::param($1) ];
1504         } elsif (exists $opt_p{$i}) {
1505             my $value = CGI::param($i) || '';
1506             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1507                 $ret{$i} = $1;
1508             }
1509         } elsif (exists $opt_r{$i}) {
1510             my $value = CGI::param($i) || '';
1511             if ($value =~ /^([^'"']+)$/) {
1512                 $ret{$i} = $1;
1513             }
1514         } elsif (exists $opt_d{$i}) {
1515             my $value = CGI::param($i) || '';
1516             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1517                 $ret{$i} = $1;
1518             }
1519         }
1520     }
1521
1522     if ($what{slots}) {
1523         foreach my $s (CGI::param('slot')) {
1524             if ($s =~ /^(\d+)$/) {
1525                 push @{$ret{slots}}, $s;
1526             }
1527         }
1528     }
1529
1530     if ($what{when}) {
1531         my $when = CGI::param('when') || '';
1532         if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1533             $ret{when} = $1;
1534         }
1535     }
1536
1537     if ($what{db_clients}) {
1538         my $filter='';  my $filter_where='';
1539         if ($what{username}) {
1540             # get security filter only if asked
1541             $filter = $self->get_client_filter();
1542             ($filter_where, undef) = $self->get_param('username');
1543         }
1544
1545         my $query = "
1546 SELECT Client.Name as clientname
1547   FROM Client $filter WHERE true $filter_where
1548 ";
1549
1550         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1551         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1552                               values %$clients] ;
1553     }
1554
1555     if ($what{db_client_groups}) {
1556         my $query = "
1557 SELECT client_group_name AS name
1558   FROM client_group
1559 ";
1560
1561         my $grps = $self->dbh_selectall_hashref($query, 'name');
1562         $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1563                                   values %$grps] ;
1564     }
1565
1566     if ($what{db_usernames}) {
1567         my $query = "
1568 SELECT username
1569   FROM bweb_user
1570 ";
1571
1572         my $users = $self->dbh_selectall_hashref($query, 'username');
1573         $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1574                                   values %$users] ;
1575     }
1576
1577     if ($what{db_roles}) {
1578         my $query = "
1579 SELECT rolename
1580   FROM bweb_role
1581 ";
1582
1583         my $r = $self->dbh_selectall_hashref($query, 'rolename');
1584         $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1585                                   values %$r] ;
1586     }
1587
1588     if ($what{db_mediatypes}) {
1589         my $query = "
1590 SELECT MediaType as mediatype
1591   FROM MediaType
1592 ";
1593
1594         my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1595         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1596                                   values %$media] ;
1597     }
1598
1599     if ($what{db_locations}) {
1600         my $query = "
1601 SELECT Location as location, Cost as cost
1602   FROM Location
1603 ";
1604         my $loc = $self->dbh_selectall_hashref($query, 'location');
1605         $ret{db_locations} = [ sort { $a->{location}
1606                                       cmp
1607                                       $b->{location}
1608                                   } values %$loc ];
1609     }
1610
1611     if ($what{db_pools}) {
1612         my $query = "SELECT Name as name FROM Pool";
1613
1614         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1615         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1616     }
1617
1618     if ($what{db_filesets}) {
1619         my $query = "
1620 SELECT FileSet.FileSet AS fileset
1621   FROM FileSet
1622 ";
1623
1624         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1625
1626         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1627                                values %$filesets] ;
1628     }
1629
1630     if ($what{db_jobnames}) {
1631         my $query = "
1632 SELECT DISTINCT Job.Name AS jobname
1633   FROM Job
1634 ";
1635
1636         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1637
1638         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1639                                values %$jobnames] ;
1640     }
1641
1642     if ($what{db_devices}) {
1643         my $query = "
1644 SELECT Device.Name AS name
1645   FROM Device
1646 ";
1647
1648         my $devices = $self->dbh_selectall_hashref($query, 'name');
1649
1650         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1651                                values %$devices] ;
1652     }
1653
1654     return \%ret;
1655 }
1656
1657 sub display_graph
1658 {
1659     my ($self) = @_;
1660
1661     my $fields = $self->get_form(qw/age level status clients filesets
1662                                     graph gtype type
1663                                     db_clients limit db_filesets width height
1664                                     qclients qfilesets qjobnames db_jobnames/);
1665
1666
1667     my $url = CGI::url(-full => 0,
1668                        -base => 0,
1669                        -query => 1);
1670     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1671
1672 # this organisation is to keep user choice between 2 click
1673 # TODO : fileset and client selection doesn't work
1674
1675     $self->display({
1676         url => $url,
1677         %$fields,
1678     }, "graph.tpl")
1679
1680 }
1681
1682 sub get_selected_media_location
1683 {
1684     my ($self) = @_ ;
1685
1686     my $media = $self->get_form('jmedias');
1687
1688     unless ($media->{jmedias}) {
1689         return undef;
1690     }
1691
1692     my $query = "
1693 SELECT Media.VolumeName AS volumename, Location.Location AS location
1694 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1695 WHERE Media.VolumeName IN ($media->{jmedias})
1696 ";
1697
1698     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1699
1700     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1701     #               ..
1702     #             }
1703     # }
1704     return $all;
1705 }
1706
1707 sub move_media
1708 {
1709     my ($self, $in) = @_ ;
1710
1711     my $media = $self->get_selected_media_location();
1712
1713     unless ($media) {
1714         return ;
1715     }
1716
1717     my $elt = $self->get_form('db_locations');
1718
1719     $self->display({ ID => $cur_id++,
1720                      enabled => human_enabled($in),
1721                      %$elt,     # db_locations
1722                      media => [
1723             sort { $a->{volumename} cmp $b->{volumename} } values %$media
1724                                ],
1725                      },
1726                    "move_media.tpl");
1727 }
1728
1729 sub help_extern
1730 {
1731     my ($self) = @_ ;
1732
1733     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1734     $self->debug($elt);
1735     $self->display($elt, "help_extern.tpl");
1736 }
1737
1738 sub help_extern_compute
1739 {
1740     my ($self) = @_;
1741
1742     my $number = CGI::param('limit') || '' ;
1743     unless ($number =~ /^(\d+)$/) {
1744         return $self->error("Bad arg number : $number ");
1745     }
1746
1747     my ($sql, undef) = $self->get_param('pools',
1748                                         'locations', 'mediatypes');
1749
1750     my $query = "
1751 SELECT Media.VolumeName  AS volumename,
1752        Media.VolStatus   AS volstatus,
1753        Media.LastWritten AS lastwritten,
1754        Media.MediaType   AS mediatype,
1755        Media.VolMounts   AS volmounts,
1756        Pool.Name         AS name,
1757        Media.Recycle     AS recycle,
1758        $self->{sql}->{FROM_UNIXTIME}(
1759           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1760         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1761        ) AS expire
1762 FROM Media
1763  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1764  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1765
1766 WHERE Media.InChanger = 1
1767   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1768   $sql
1769 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1770 LIMIT $number
1771 " ;
1772
1773     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1774
1775     $self->display({ Media => [ values %$all ] },
1776                    "help_extern_compute.tpl");
1777 }
1778
1779 sub help_intern
1780 {
1781     my ($self) = @_ ;
1782
1783     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1784     $self->display($param, "help_intern.tpl");
1785 }
1786
1787 sub help_intern_compute
1788 {
1789     my ($self) = @_;
1790
1791     my $number = CGI::param('limit') || '' ;
1792     unless ($number =~ /^(\d+)$/) {
1793         return $self->error("Bad arg number : $number ");
1794     }
1795
1796     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1797
1798     if (CGI::param('expired')) {
1799         $sql = "
1800 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1801        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1802     ) < NOW()
1803  " . $sql ;
1804     }
1805
1806     my $query = "
1807 SELECT Media.VolumeName  AS volumename,
1808        Media.VolStatus   AS volstatus,
1809        Media.LastWritten AS lastwritten,
1810        Media.MediaType   AS mediatype,
1811        Media.VolMounts   AS volmounts,
1812        Pool.Name         AS name,
1813        $self->{sql}->{FROM_UNIXTIME}(
1814           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1815         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1816        ) AS expire
1817 FROM Media
1818  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1819  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1820
1821 WHERE Media.InChanger <> 1
1822   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1823   AND Media.Recycle = 1
1824   $sql
1825 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1826 LIMIT $number
1827 " ;
1828
1829     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1830
1831     $self->display({ Media => [ values %$all ] },
1832                    "help_intern_compute.tpl");
1833
1834 }
1835
1836 sub display_general
1837 {
1838     my ($self, %arg) = @_ ;
1839
1840     my ($limit, $label) = $self->get_limit(%arg);
1841
1842     my $query = "
1843 SELECT
1844     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1845     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1846     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1847     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1848     ($self->{sql}->{DB_SIZE})                 AS db_size,
1849     (SELECT count(Job.JobId)
1850       FROM Job
1851       WHERE Job.JobStatus IN ('E','e','f','A')
1852       $limit
1853     )                                         AS nb_err,
1854     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1855 ";
1856
1857     my $row = $self->dbh_selectrow_hashref($query) ;
1858
1859     $row->{nb_bytes} = human_size($row->{nb_bytes});
1860
1861     $row->{db_size} = human_size($row->{db_size});
1862     $row->{label} = $label;
1863
1864     $self->display($row, "general.tpl");
1865 }
1866
1867 sub get_param
1868 {
1869     my ($self, @what) = @_ ;
1870     my %elt = map { $_ => 1 } @what;
1871     my %ret;
1872
1873     my $limit = '';
1874
1875     if ($elt{clients}) {
1876         my @clients = grep { ! /^\s*$/ } CGI::param('client');
1877         if (@clients) {
1878             $ret{clients} = \@clients;
1879             my $str = $self->dbh_join(@clients);
1880             $limit .= "AND Client.Name IN ($str) ";
1881         }
1882     }
1883
1884     if ($elt{client_groups}) {
1885         my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1886         if (@clients) {
1887             $ret{client_groups} = \@clients;
1888             my $str = $self->dbh_join(@clients);
1889             $limit .= "AND client_group_name IN ($str) ";
1890         }
1891     }
1892
1893     if ($elt{filesets}) {
1894         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1895         if (@filesets) {
1896             $ret{filesets} = \@filesets;
1897             my $str = $self->dbh_join(@filesets);
1898             $limit .= "AND FileSet.FileSet IN ($str) ";
1899         }
1900     }
1901
1902     if ($elt{mediatypes}) {
1903         my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
1904         if (@media) {
1905             $ret{mediatypes} = \@media;
1906             my $str = $self->dbh_join(@media);
1907             $limit .= "AND Media.MediaType IN ($str) ";
1908         }
1909     }
1910
1911     if ($elt{client}) {
1912         my $client = CGI::param('client');
1913         $ret{client} = $client;
1914         $client = $self->dbh_join($client);
1915         $limit .= "AND Client.Name = $client ";
1916     }
1917
1918     if ($elt{level}) {
1919         my $level = CGI::param('level') || '';
1920         if ($level =~ /^(\w)$/) {
1921             $ret{level} = $1;
1922             $limit .= "AND Job.Level = '$1' ";
1923         }
1924     }
1925
1926     if ($elt{jobid}) {
1927         my $jobid = CGI::param('jobid') || '';
1928
1929         if ($jobid =~ /^(\d+)$/) {
1930             $ret{jobid} = $1;
1931             $limit .= "AND Job.JobId = '$1' ";
1932         }
1933     }
1934
1935     if ($elt{status}) {
1936         my $status = CGI::param('status') || '';
1937         if ($status =~ /^(\w)$/) {
1938             $ret{status} = $1;
1939             if ($1 eq 'f') {
1940                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1941             } elsif ($1 eq 'W') {
1942                 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1943             } else {
1944                 $limit .= "AND Job.JobStatus = '$1' ";
1945             }
1946         }
1947     }
1948
1949     if ($elt{volstatus}) {
1950         my $status = CGI::param('volstatus') || '';
1951         if ($status =~ /^(\w+)$/) {
1952             $ret{status} = $1;
1953             $limit .= "AND Media.VolStatus = '$1' ";
1954         }
1955     }
1956
1957     if ($elt{locations}) {
1958         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1959         if (@location) {
1960             $ret{locations} = \@location;
1961             my $str = $self->dbh_join(@location);
1962             $limit .= "AND Location.Location IN ($str) ";
1963         }
1964     }
1965
1966     if ($elt{pools}) {
1967         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1968         if (@pool) {
1969             $ret{pools} = \@pool;
1970             my $str = $self->dbh_join(@pool);
1971             $limit .= "AND Pool.Name IN ($str) ";
1972         }
1973     }
1974
1975     if ($elt{location}) {
1976         my $location = CGI::param('location') || '';
1977         if ($location) {
1978             $ret{location} = $location;
1979             $location = $self->dbh_quote($location);
1980             $limit .= "AND Location.Location = $location ";
1981         }
1982     }
1983
1984     if ($elt{pool}) {
1985         my $pool = CGI::param('pool') || '';
1986         if ($pool) {
1987             $ret{pool} = $pool;
1988             $pool = $self->dbh_quote($pool);
1989             $limit .= "AND Pool.Name = $pool ";
1990         }
1991     }
1992
1993     if ($elt{jobtype}) {
1994         my $jobtype = CGI::param('jobtype') || '';
1995         if ($jobtype =~ /^(\w)$/) {
1996             $ret{jobtype} = $1;
1997             $limit .= "AND Job.Type = '$1' ";
1998         }
1999     }
2000
2001     # fill this only when security is enabled
2002     if ($elt{username} and $self->{info}->{enable_security}) {
2003         if ($self->{loginname} ne 'admin') {
2004             my $u = $self->dbh_quote($self->{loginname});
2005             $ret{username}=$self->{loginname};
2006             $limit .= "AND bweb_user.username = $u ";
2007         }
2008     }
2009
2010     return ($limit, %ret);
2011 }
2012
2013 =head1
2014
2015     get last backup
2016
2017 =cut
2018
2019 sub display_job
2020 {
2021     my ($self, %arg) = @_ ;
2022
2023     $arg{order} = ' Job.JobId DESC ';
2024
2025     my ($limit, $label) = $self->get_limit(%arg);
2026     my ($where, undef) = $self->get_param('clients',
2027                                           'client_groups',
2028                                           'level',
2029                                           'filesets',
2030                                           'jobtype',
2031                                           'pools',
2032                                           'jobid',
2033                                           'username',
2034                                           'status');
2035     my $cgq='';
2036     if (CGI::param('client_group')) {
2037         $cgq .= "
2038 JOIN client_group_member USING (ClientId)
2039 JOIN client_group USING (client_group_id)
2040 ";
2041     }
2042     my $filter = $self->get_client_filter();
2043
2044     $cgq = ($filter)?$filter:$cgq;
2045
2046     my $query="
2047 SELECT  Job.JobId       AS jobid,
2048         Client.Name     AS client,
2049         FileSet.FileSet AS fileset,
2050         Job.Name        AS jobname,
2051         Level           AS level,
2052         StartTime       AS starttime,
2053         EndTime         AS endtime,
2054         Pool.Name       AS poolname,
2055         JobFiles        AS jobfiles,
2056         JobBytes        AS jobbytes,
2057         JobStatus       AS jobstatus,
2058      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2059                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2060                         AS duration,
2061
2062         JobErrors       AS joberrors
2063
2064  FROM Client $cgq,
2065       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2066           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2067  WHERE Client.ClientId=Job.ClientId
2068    AND Job.JobStatus NOT IN ('R', 'C')
2069  $where
2070  $limit
2071 ";
2072
2073     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2074
2075     $self->display({ Filter => $label,
2076                      ID => $cur_id++,
2077                      Jobs =>
2078                            [
2079                              sort { $a->{jobid} <=>  $b->{jobid} }
2080                                         values %$all
2081                              ],
2082                    },
2083                    "display_job.tpl");
2084 }
2085
2086 # display job informations
2087 sub display_job_zoom
2088 {
2089     my ($self, $jobid) = @_ ;
2090
2091     $jobid = $self->dbh_quote($jobid);
2092
2093     # get security filter
2094     my $filter = $self->get_client_filter();
2095     my ($filter_where, undef) = $self->get_param('username');
2096
2097     my $query="
2098 SELECT DISTINCT Job.JobId       AS jobid,
2099                 Client.Name     AS client,
2100                 Job.Name        AS jobname,
2101                 FileSet.FileSet AS fileset,
2102                 Level           AS level,
2103                 Pool.Name       AS poolname,
2104                 StartTime       AS starttime,
2105                 JobFiles        AS jobfiles,
2106                 JobBytes        AS jobbytes,
2107                 JobStatus       AS jobstatus,
2108                 JobErrors       AS joberrors,
2109                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2110                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2111
2112  FROM Client $filter,
2113       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2114           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2115  WHERE Client.ClientId=Job.ClientId
2116  AND Job.JobId = $jobid
2117  $filter_where
2118 ";
2119
2120     my $row = $self->dbh_selectrow_hashref($query) ;
2121
2122     # display all volumes associate with this job
2123     $query="
2124 SELECT Media.VolumeName as volumename
2125 FROM Job,Media,JobMedia
2126 WHERE Job.JobId = $jobid
2127  AND JobMedia.JobId=Job.JobId
2128  AND JobMedia.MediaId=Media.MediaId
2129 ";
2130
2131     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2132
2133     $row->{volumes} = [ values %$all ] ;
2134
2135     $self->display($row, "display_job_zoom.tpl");
2136 }
2137
2138 sub display_job_group
2139 {
2140     my ($self, %arg) = @_;
2141
2142     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2143
2144     my ($where, undef) = $self->get_param('client_groups',
2145                                           'level',
2146                                           'pools');
2147
2148     my $query =
2149 "
2150 SELECT client_group_name AS client_group_name,
2151        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2152        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2153        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2154        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2155        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2156        COALESCE(jobok.duration, '0:0:0') AS duration
2157
2158 FROM client_group LEFT JOIN (
2159     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2160            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2161            SUM(JobErrors) AS joberrors,
2162            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2163                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2164                         AS duration
2165
2166     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2167              JOIN client_group USING (client_group_id)
2168
2169     WHERE JobStatus = 'T'
2170     $where
2171     $limit
2172 ) AS jobok USING (client_group_name) LEFT JOIN
2173
2174 (
2175     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2176            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2177            SUM(JobErrors) AS joberrors
2178     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2179              JOIN client_group USING (client_group_id)
2180
2181     WHERE JobStatus IN ('f','E', 'A')
2182     $where
2183     $limit
2184 ) AS joberr USING (client_group_name)
2185
2186     ";
2187
2188     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2189
2190     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2191
2192     $self->debug($rep);
2193     $self->display($rep, "display_job_group.tpl");
2194 }
2195
2196 sub display_media
2197 {
2198     my ($self, %arg) = @_ ;
2199
2200     my ($limit, $label) = $self->get_limit(%arg);
2201     my ($where, %elt) = $self->get_param('pools',
2202                                          'mediatypes',
2203                                          'volstatus',
2204                                          'locations');
2205
2206     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2207
2208     if ($arg->{jmedias}) {
2209         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2210     }
2211     if ($arg->{qre_media}) {
2212         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2213     }
2214     if ($arg->{expired}) {
2215         $where = "
2216         AND VolStatus = 'Full'
2217         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2218                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2219             ) < NOW()  " . $where ;
2220     }
2221
2222     my $query="
2223 SELECT Media.VolumeName  AS volumename,
2224        Media.VolBytes    AS volbytes,
2225        Media.VolStatus   AS volstatus,
2226        Media.MediaType   AS mediatype,
2227        Media.InChanger   AS online,
2228        Media.LastWritten AS lastwritten,
2229        Location.Location AS location,
2230        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2231        Pool.Name         AS poolname,
2232        $self->{sql}->{FROM_UNIXTIME}(
2233           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2234         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2235        ) AS expire
2236 FROM      Pool, Media
2237 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2238 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2239                   Media.MediaType     AS MediaType
2240            FROM Media
2241           WHERE Media.VolStatus = 'Full'
2242           GROUP BY Media.MediaType
2243            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2244
2245 WHERE Media.PoolId=Pool.PoolId
2246 $where
2247 $limit
2248 ";
2249
2250     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2251
2252     $self->display({ ID => $cur_id++,
2253                      Pool => $elt{pool},
2254                      Location => $elt{location},
2255                      Media => [ values %$all ],
2256                    },
2257                    "display_media.tpl");
2258 }
2259
2260 sub display_allmedia
2261 {
2262     my ($self) = @_ ;
2263
2264     my $pool = $self->get_form('db_pools');
2265
2266     foreach my $name (@{ $pool->{db_pools} }) {
2267         CGI::param('pool', $name->{name});
2268         $self->display_media();
2269     }
2270 }
2271
2272 sub display_media_zoom
2273 {
2274     my ($self) = @_ ;
2275
2276     my $media = $self->get_form('jmedias');
2277
2278     unless ($media->{jmedias}) {
2279         return $self->error("Can't get media selection");
2280     }
2281
2282     my $query="
2283 SELECT InChanger     AS online,
2284        Media.Enabled AS enabled,
2285        VolBytes      AS nb_bytes,
2286        VolumeName    AS volumename,
2287        VolStatus     AS volstatus,
2288        VolMounts     AS nb_mounts,
2289        Media.VolUseDuration   AS voluseduration,
2290        Media.MaxVolJobs AS maxvoljobs,
2291        Media.MaxVolFiles AS maxvolfiles,
2292        Media.MaxVolBytes AS maxvolbytes,
2293        VolErrors     AS nb_errors,
2294        Pool.Name     AS poolname,
2295        Location.Location AS location,
2296        Media.Recycle AS recycle,
2297        Media.VolRetention AS volretention,
2298        Media.LastWritten  AS lastwritten,
2299        Media.VolReadTime/1000000  AS volreadtime,
2300        Media.VolWriteTime/1000000 AS volwritetime,
2301        Media.RecycleCount AS recyclecount,
2302        Media.Comment      AS comment,
2303        $self->{sql}->{FROM_UNIXTIME}(
2304           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2305         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2306        ) AS expire
2307  FROM Pool,
2308       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2309  WHERE Pool.PoolId = Media.PoolId
2310  AND VolumeName IN ($media->{jmedias})
2311 ";
2312
2313     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2314
2315     foreach my $media (values %$all) {
2316         my $mq = $self->dbh_quote($media->{volumename});
2317
2318         $query = "
2319 SELECT DISTINCT Job.JobId AS jobid,
2320                 Job.Name  AS name,
2321                 Job.StartTime AS starttime,
2322                 Job.Type  AS type,
2323                 Job.Level AS level,
2324                 Job.JobFiles AS files,
2325                 Job.JobBytes AS bytes,
2326                 Job.jobstatus AS status
2327  FROM Media,JobMedia,Job
2328  WHERE Media.VolumeName=$mq
2329  AND Media.MediaId=JobMedia.MediaId
2330  AND JobMedia.JobId=Job.JobId
2331 ";
2332
2333         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2334
2335         $query = "
2336 SELECT LocationLog.Date    AS date,
2337        Location.Location   AS location,
2338        LocationLog.Comment AS comment
2339  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2340  WHERE Media.MediaId = LocationLog.MediaId
2341    AND Media.VolumeName = $mq
2342 ";
2343
2344         my $logtxt = '';
2345         my $log = $self->dbh_selectall_arrayref($query) ;
2346         if ($log) {
2347             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2348         }
2349
2350         $self->display({ jobs => [ values %$jobs ],
2351                          LocationLog => $logtxt,
2352                          %$media },
2353                        "display_media_zoom.tpl");
2354     }
2355 }
2356
2357 sub location_edit
2358 {
2359     my ($self) = @_ ;
2360     $self->can_do('location_mgnt');
2361
2362     my $loc = $self->get_form('qlocation');
2363     unless ($loc->{qlocation}) {
2364         return $self->error("Can't get location");
2365     }
2366
2367     my $query = "
2368 SELECT Location.Location AS location,
2369        Location.Cost   AS cost,
2370        Location.Enabled AS enabled
2371 FROM Location
2372 WHERE Location.Location = $loc->{qlocation}
2373 ";
2374
2375     my $row = $self->dbh_selectrow_hashref($query);
2376
2377     $self->display({ ID => $cur_id++,
2378                      %$row }, "location_edit.tpl") ;
2379 }
2380
2381 sub location_save
2382 {
2383     my ($self) = @_ ;
2384     $self->can_do('location_mgnt');
2385
2386     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2387     unless ($arg->{qlocation}) {
2388         return $self->error("Can't get location");
2389     }
2390     unless ($arg->{qnewlocation}) {
2391         return $self->error("Can't get new location name");
2392     }
2393     unless ($arg->{cost}) {
2394         return $self->error("Can't get new cost");
2395     }
2396
2397     my $enabled = CGI::param('enabled') || '';
2398     $enabled = $enabled?1:0;
2399
2400     my $query = "
2401 UPDATE Location SET Cost     = $arg->{cost},
2402                     Location = $arg->{qnewlocation},
2403                     Enabled   = $enabled
2404 WHERE Location.Location = $arg->{qlocation}
2405 ";
2406
2407     $self->dbh_do($query);
2408
2409     $self->location_display();
2410 }
2411
2412 sub location_del
2413 {
2414     my ($self) = @_ ;
2415     $self->can_do('location_mgnt');
2416
2417     my $arg = $self->get_form(qw/qlocation/) ;
2418
2419     unless ($arg->{qlocation}) {
2420         return $self->error("Can't get location");
2421     }
2422
2423     my $query = "
2424 SELECT count(Media.MediaId) AS nb
2425   FROM Media INNER JOIN Location USING (LocationID)
2426 WHERE Location = $arg->{qlocation}
2427 ";
2428
2429     my $res = $self->dbh_selectrow_hashref($query);
2430
2431     if ($res->{nb}) {
2432         return $self->error("Sorry, the location must be empty");
2433     }
2434
2435     $query = "
2436 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2437 ";
2438
2439     $self->dbh_do($query);
2440
2441     $self->location_display();
2442 }
2443
2444 sub location_add
2445 {
2446     my ($self) = @_ ;
2447     $self->can_do('location_mgnt');
2448
2449     my $arg = $self->get_form(qw/qlocation cost/) ;
2450
2451     unless ($arg->{qlocation}) {
2452         $self->display({}, "location_add.tpl");
2453         return 1;
2454     }
2455     unless ($arg->{cost}) {
2456         return $self->error("Can't get new cost");
2457     }
2458
2459     my $enabled = CGI::param('enabled') || '';
2460     $enabled = $enabled?1:0;
2461
2462     my $query = "
2463 INSERT INTO Location (Location, Cost, Enabled)
2464        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2465 ";
2466
2467     $self->dbh_do($query);
2468
2469     $self->location_display();
2470 }
2471
2472 sub location_display
2473 {
2474     my ($self) = @_ ;
2475
2476     my $query = "
2477 SELECT Location.Location AS location,
2478        Location.Cost     AS cost,
2479        Location.Enabled  AS enabled,
2480        (SELECT count(Media.MediaId)
2481          FROM Media
2482         WHERE Media.LocationId = Location.LocationId
2483        ) AS volnum
2484 FROM Location
2485 ";
2486
2487     my $location = $self->dbh_selectall_hashref($query, 'location');
2488
2489     $self->display({ ID => $cur_id++,
2490                      Locations => [ values %$location ] },
2491                    "display_location.tpl");
2492 }
2493
2494 sub update_location
2495 {
2496     my ($self) = @_ ;
2497
2498     my $media = $self->get_selected_media_location();
2499     unless ($media) {
2500         return ;
2501     }
2502
2503     my $arg = $self->get_form('db_locations', 'qnewlocation');
2504
2505     $self->display({ email  => $self->{info}->{email_media},
2506                      %$arg,
2507                      media => [ values %$media ],
2508                    },
2509                    "update_location.tpl");
2510 }
2511
2512 ###########################################################
2513
2514 sub groups_edit
2515 {
2516     my ($self) = @_;
2517     $self->can_do('group_mgnt');
2518
2519     my $grp = $self->get_form(qw/qclient_group db_clients/);
2520
2521     unless ($grp->{qclient_group}) {
2522         return $self->error("Can't get group");
2523     }
2524
2525     my $query = "
2526 SELECT Name AS name
2527   FROM Client JOIN client_group_member using (clientid)
2528               JOIN client_group using (client_group_id)
2529 WHERE client_group_name = $grp->{qclient_group}
2530 ";
2531
2532     my $row = $self->dbh_selectall_hashref($query, "name");
2533     $self->debug($row);
2534     $self->display({ ID => $cur_id++,
2535                      client_group => $grp->{qclient_group},
2536                      %$grp,
2537                      client_group_member => [ values %$row]},
2538                    "groups_edit.tpl");
2539 }
2540
2541 sub groups_save
2542 {
2543     my ($self) = @_;
2544     $self->can_do('group_mgnt');
2545
2546     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2547     unless ($arg->{qclient_group}) {
2548         return $self->error("Can't get groups");
2549     }
2550
2551     $self->{dbh}->begin_work();
2552
2553     my $query = "
2554 DELETE FROM client_group_member
2555       WHERE client_group_id IN
2556            (SELECT client_group_id
2557               FROM client_group
2558              WHERE client_group_name = $arg->{qclient_group})
2559 ";
2560     $self->dbh_do($query);
2561
2562     $query = "
2563     INSERT INTO client_group_member (clientid, client_group_id)
2564        (SELECT  Clientid,
2565                 (SELECT client_group_id
2566                    FROM client_group
2567                   WHERE client_group_name = $arg->{qclient_group})
2568           FROM Client WHERE Name IN ($arg->{jclients})
2569        )
2570 ";
2571     $self->dbh_do($query);
2572
2573     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2574         $query = "
2575 UPDATE client_group
2576    SET client_group_name = $arg->{qnewgroup}
2577  WHERE client_group_name = $arg->{qclient_group}
2578 ";
2579
2580         $self->dbh_do($query);
2581     }
2582
2583     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2584
2585     $self->display_groups();
2586 }
2587
2588 sub groups_del
2589 {
2590     my ($self) = @_;
2591     $self->can_do('group_mgnt');
2592
2593     my $arg = $self->get_form(qw/qclient_group/);
2594
2595     unless ($arg->{qclient_group}) {
2596         return $self->error("Can't get groups");
2597     }
2598
2599     $self->{dbh}->begin_work();
2600
2601     my $query = "
2602 DELETE FROM client_group_member
2603       WHERE client_group_id IN
2604            (SELECT client_group_id
2605               FROM client_group
2606              WHERE client_group_name = $arg->{qclient_group});
2607
2608 DELETE FROM client_group
2609       WHERE client_group_name = $arg->{qclient_group};
2610 ";
2611     $self->dbh_do($query);
2612
2613     $self->{dbh}->commit();
2614
2615     $self->display_groups();
2616 }
2617
2618
2619 sub groups_add
2620 {
2621     my ($self) = @_;
2622     $self->can_do('group_mgnt');
2623
2624     my $arg = $self->get_form(qw/qclient_group/) ;
2625
2626     unless ($arg->{qclient_group}) {
2627         $self->display({}, "groups_add.tpl");
2628         return 1;
2629     }
2630
2631     my $query = "
2632 INSERT INTO client_group (client_group_name)
2633 VALUES ($arg->{qclient_group})
2634 ";
2635
2636     $self->dbh_do($query);
2637
2638     $self->display_groups();
2639 }
2640
2641 sub display_groups
2642 {
2643     my ($self) = @_;
2644
2645     my $arg = $self->get_form(qw/db_client_groups/) ;
2646
2647     if ($self->{dbh}->errstr) {
2648         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2649     }
2650
2651     $self->debug($arg);
2652
2653     $self->display({ ID => $cur_id++,
2654                      %$arg},
2655                    "display_groups.tpl");
2656 }
2657
2658 ###########################################################
2659
2660 # TODO: avoir un mode qui coupe le programme avec une page d'erreur
2661 # we can also get all security and fill {security} hash
2662 sub can_do
2663 {
2664     my ($self, $action) = @_;
2665     # is security enabled in configuration ?
2666     if (not $self->{info}->{enable_security}) {
2667         return 1;
2668     }
2669     # admin is a special user that can do everything
2670     if ($self->{loginname} eq 'admin') {
2671         return 1;
2672     }
2673     # must be logged
2674     if (!$self->{loginname}) {
2675         $self->error("Can't do $action, your are not logged. " .
2676                      "Check security with your administrator");
2677         $self->display_end();
2678         exit (0);
2679     }
2680     # already checked
2681     if ($self->{security}->{$action}) {
2682         return 1;
2683     }
2684     my ($u, $r) = ($self->dbh_quote($self->{loginname}),
2685                    $self->dbh_quote($action));
2686     my $query = "
2687  SELECT 1, username, rolename
2688   FROM bweb_user
2689        JOIN bweb_role_member USING (userid)
2690        JOIN bweb_role USING (roleid)
2691  WHERE username = $u
2692    AND rolename = $r
2693 ";
2694
2695     my $row = $self->dbh_selectrow_hashref($query);
2696     # do cache with this role
2697     if (!$row) {
2698         $self->error("$u sorry, but this action ($action) is not permited. " .
2699                      "Check security with your administrator");
2700         $self->display_end();
2701         exit (0);
2702     }
2703     $self->{security}->{$row->{rolename}} = 1;
2704     return 1;
2705 }
2706
2707 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
2708 sub get_client_filter
2709 {
2710     my ($self) = @_;
2711     if ($self->{info}->{enable_security}) {
2712         return "
2713  JOIN client_group_member USING (ClientId)
2714  JOIN client_group USING (client_group_id)
2715  JOIN bweb_client_group_acl USING (client_group_id)
2716  JOIN bweb_user USING (userid) ";
2717     } else {
2718         return '';
2719     }
2720 }
2721
2722 # role and username have to be quoted before
2723 # role and username can be a quoted list
2724 sub revoke
2725 {
2726     my ($self, $role, $username) = @_;
2727     $self->can_do("user_mgnt");
2728
2729     my $nb = $self->dbh_do("
2730  DELETE FROM bweb_role_member
2731        WHERE roleid = (SELECT roleid FROM bweb_role
2732                         WHERE rolename IN ($role))
2733          AND userid = (SELECT userid FROM bweb_user
2734                         WHERE username IN ($username))");
2735     return $nb;
2736 }
2737
2738 # role and username have to be quoted before
2739 # role and username can be a quoted list
2740 sub grant
2741 {
2742     my ($self, $role, $username) = @_;
2743     $self->can_do("user_mgnt");
2744
2745     my $nb = $self->dbh_do("
2746    INSERT INTO bweb_role_member (roleid, userid)
2747      SELECT roleid, userid FROM bweb_role, bweb_user
2748       WHERE rolename IN ($role)
2749         AND username IN ($username)
2750      ");
2751     return $nb;
2752 }
2753
2754 # role and username have to be quoted before
2755 # role and username can be a quoted list
2756 sub grant_like
2757 {
2758     my ($self, $copy, $user) = @_;
2759     $self->can_do("user_mgnt");
2760
2761     my $nb = $self->dbh_do("
2762   INSERT INTO bweb_role_member (roleid, userid)
2763    SELECT roleid, a.userid
2764      FROM bweb_user AS a, bweb_role_member
2765      JOIN bweb_user USING (userid)
2766     WHERE bweb_user.username = $copy
2767       AND a.username = $user");
2768     return $nb;
2769 }
2770
2771 # username can be a join quoted list of usernames
2772 sub revoke_all
2773 {
2774     my ($self, $username) = @_;
2775     $self->can_do("user_mgnt");
2776
2777     $self->dbh_do("
2778    DELETE FROM bweb_role_member
2779          WHERE userid IN (
2780            SELECT userid
2781              FROM bweb_user
2782             WHERE username in ($username)
2783 )");
2784 }
2785
2786 sub users_del
2787 {
2788     my ($self) = @_;
2789     $self->can_do("user_mgnt");
2790
2791     my $arg = $self->get_form(qw/jusernames/);
2792
2793     unless ($arg->{jusernames}) {
2794         return $self->error("Can't get user");
2795     }
2796
2797     $self->{dbh}->begin_work();
2798     {
2799         $self->revoke_all($arg->{jusernames});
2800         $self->dbh_do("DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
2801     }
2802     $self->{dbh}->commit();
2803
2804     $self->display_users();
2805 }
2806
2807 sub users_add
2808 {
2809     my ($self) = @_;
2810     $self->can_do("user_mgnt");
2811
2812     # we don't quote username directly to check that it is conform
2813     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate qcopy_username/) ;
2814
2815     if (not $arg->{qcreate}) {
2816         $arg = $self->get_form(qw/db_roles db_usernames/);
2817         $self->display($arg, "display_user.tpl");
2818         return 1;
2819     }
2820
2821     my $u = $self->dbh_quote($arg->{username});
2822
2823     if (!$arg->{qpasswd}) {
2824         $arg->{qpasswd} = "''";
2825     }
2826     if (!$arg->{qcomment}) {
2827         $arg->{qcomment} = "''";
2828     }
2829
2830     # will fail if user already exists
2831     $self->dbh_do("
2832   UPDATE bweb_user SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment}
2833    WHERE username = $u")
2834         or
2835     $self->dbh_do("
2836   INSERT INTO bweb_user (username, passwd, comment)
2837         VALUES ($u, $arg->{qpasswd}, $arg->{qcomment})");
2838
2839     $self->{dbh}->begin_work();
2840     {
2841         $self->revoke_all($u);
2842
2843         if ($arg->{qcopy_username}) {
2844             $self->grant_like($arg->{qcopy_username}, $u);
2845         } else {
2846             $self->grant($arg->{jrolenames}, $u);
2847         }
2848     }
2849     $self->{dbh}->commit();
2850
2851     $self->display_users();
2852 }
2853
2854 # TODO: we miss a matrix with all user/roles
2855 sub display_users
2856 {
2857     my ($self) = @_;
2858     $self->can_do("user_mgnt");
2859
2860     my $arg = $self->get_form(qw/db_usernames/) ;
2861
2862     if ($self->{dbh}->errstr) {
2863         return $self->error("Can't use users with bweb, read INSTALL to enable them");
2864     }
2865
2866     $self->display({ ID => $cur_id++,
2867                      %$arg},
2868                    "display_users.tpl");
2869 }
2870
2871 sub display_user
2872 {
2873     my ($self) = @_;
2874     $self->can_do("user_mgnt");
2875
2876     my $arg = $self->get_form(qw/username db_usernames/);
2877     my $user = $self->dbh_quote($arg->{username});
2878
2879     my $userp = $self->dbh_selectrow_hashref("
2880    SELECT username, passwd, comment
2881      FROM bweb_user
2882     WHERE username = $user
2883 ");
2884
2885     if (!$userp) {
2886         return $self->error("Can't find $user in catalog");
2887     }
2888
2889 #  rolename  | userid
2890 #------------+--------
2891 # cancel_job |
2892 # restore    |
2893 # run_job    |      1
2894
2895     my $role = $self->dbh_selectall_hashref("
2896 SELECT rolename, temp.userid
2897      FROM bweb_role
2898      LEFT JOIN (SELECT roleid, userid
2899                   FROM bweb_user JOIN bweb_role_member USING (userid)
2900                  WHERE username = $user) AS temp USING (roleid)
2901 ORDER BY rolename
2902 ", 'rolename');
2903
2904     $self->display({
2905         db_usernames => $arg->{db_usernames},
2906         username => $userp->{username},
2907         comment => $userp->{comment},
2908         passwd => $userp->{passwd},
2909         db_roles => [ values %$role],
2910     }, "display_user.tpl");
2911 }
2912
2913
2914 ###########################################################
2915
2916 sub get_media_max_size
2917 {
2918     my ($self, $type) = @_;
2919     my $query =
2920 "SELECT avg(VolBytes) AS size
2921   FROM Media
2922  WHERE Media.VolStatus = 'Full'
2923    AND Media.MediaType = '$type'
2924 ";
2925
2926     my $res = $self->selectrow_hashref($query);
2927
2928     if ($res) {
2929         return $res->{size};
2930     } else {
2931         return 0;
2932     }
2933 }
2934
2935 sub update_media
2936 {
2937     my ($self) = @_ ;
2938
2939     my $media = $self->get_form('qmedia');
2940
2941     unless ($media->{qmedia}) {
2942         return $self->error("Can't get media");
2943     }
2944
2945     my $query = "
2946 SELECT Media.Slot         AS slot,
2947        PoolMedia.Name     AS poolname,
2948        Media.VolStatus    AS volstatus,
2949        Media.InChanger    AS inchanger,
2950        Location.Location  AS location,
2951        Media.VolumeName   AS volumename,
2952        Media.MaxVolBytes  AS maxvolbytes,
2953        Media.MaxVolJobs   AS maxvoljobs,
2954        Media.MaxVolFiles  AS maxvolfiles,
2955        Media.VolUseDuration AS voluseduration,
2956        Media.VolRetention AS volretention,
2957        Media.Comment      AS comment,
2958        PoolRecycle.Name   AS poolrecycle,
2959        Media.Enabled      AS enabled
2960
2961 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2962            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2963            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2964
2965 WHERE Media.VolumeName = $media->{qmedia}
2966 ";
2967
2968     my $row = $self->dbh_selectrow_hashref($query);
2969     $row->{volretention} = human_sec($row->{volretention});
2970     $row->{voluseduration} = human_sec($row->{voluseduration});
2971     $row->{enabled} = human_enabled($row->{enabled});
2972
2973     my $elt = $self->get_form(qw/db_pools db_locations/);
2974
2975     $self->display({
2976         %$elt,
2977         %$row,
2978     }, "update_media.tpl");
2979 }
2980
2981 sub save_location
2982 {
2983     my ($self) = @_ ;
2984     $self->can_do('media_mgnt');
2985
2986     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2987
2988     unless ($arg->{jmedias}) {
2989         return $self->error("Can't get selected media");
2990     }
2991
2992     unless ($arg->{qnewlocation}) {
2993         return $self->error("Can't get new location");
2994     }
2995
2996     my $query = "
2997  UPDATE Media
2998      SET LocationId = (SELECT LocationId
2999                        FROM Location
3000                        WHERE Location = $arg->{qnewlocation})
3001      WHERE Media.VolumeName IN ($arg->{jmedias})
3002 ";
3003
3004     my $nb = $self->dbh_do($query);
3005
3006     print "$nb media updated, you may have to update your autochanger.";
3007
3008     $self->display_media();
3009 }
3010
3011 sub location_change
3012 {
3013     my ($self) = @_ ;
3014     $self->can_do('media_mgnt');
3015
3016     my $media = $self->get_selected_media_location();
3017     unless ($media) {
3018         return $self->error("Can't get media selection");
3019     }
3020     my $newloc = CGI::param('newlocation');
3021
3022     my $user = CGI::param('user') || 'unknown';
3023     my $comm = CGI::param('comment') || '';
3024     $comm = $self->dbh_quote("$user: $comm");
3025
3026     my $arg = $self->get_form('enabled');
3027     my $en = human_enabled($arg->{enabled});
3028     my $b = $self->get_bconsole();
3029
3030     my $query;
3031     foreach my $vol (keys %$media) {
3032         $query = "
3033 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
3034  VALUES(
3035        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$vol'),
3036        (SELECT LocationId FROM Location WHERE Location = '$media->{$vol}->{location}'),
3037        (SELECT VolStatus FROM Media WHERE VolumeName = '$vol')
3038       )
3039 ";
3040         $self->dbh_do($query);
3041         $self->debug($query);
3042         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3043     }
3044     $b->close();
3045
3046     my $q = new CGI;
3047     $q->param('action', 'update_location');
3048     my $url = $q->url(-full => 1, -query=>1);
3049
3050     $self->display({ email  => $self->{info}->{email_media},
3051                      url => $url,
3052                      newlocation => $newloc,
3053                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3054                      media => [ values %$media ],
3055                    },
3056                    "change_location.tpl");
3057
3058 }
3059
3060 sub display_client_stats
3061 {
3062     my ($self, %arg) = @_ ;
3063
3064     my $client = $self->dbh_quote($arg{clientname});
3065     # get security filter
3066     my $filter = $self->get_client_filter();
3067     my ($filter_where, undef) = $self->get_param('username');
3068     my ($limit, $label) = $self->get_limit(%arg);
3069     my $query = "
3070 SELECT
3071     count(Job.JobId)     AS nb_jobs,
3072     sum(Job.JobBytes)    AS nb_bytes,
3073     sum(Job.JobErrors)   AS nb_err,
3074     sum(Job.JobFiles)    AS nb_files,
3075     Client.Name          AS clientname
3076 FROM Job JOIN Client USING (ClientId) $filter
3077 WHERE
3078     Client.Name = $client
3079     $filter_where
3080     $limit
3081 GROUP BY Client.Name
3082 ";
3083
3084     my $row = $self->dbh_selectrow_hashref($query);
3085
3086     $row->{ID} = $cur_id++;
3087     $row->{label} = $label;
3088     $row->{grapharg} = "client";
3089
3090     $self->display($row, "display_client_stats.tpl");
3091 }
3092
3093
3094 sub display_group_stats
3095 {
3096     my ($self, %arg) = @_ ;
3097
3098     my $carg = $self->get_form(qw/qclient_group/);
3099
3100     unless ($carg->{qclient_group}) {
3101         return $self->error("Can't get group");
3102     }
3103
3104     my ($limit, $label) = $self->get_limit(%arg);
3105
3106     my $query = "
3107 SELECT
3108     count(Job.JobId)     AS nb_jobs,
3109     sum(Job.JobBytes)    AS nb_bytes,
3110     sum(Job.JobErrors)   AS nb_err,
3111     sum(Job.JobFiles)    AS nb_files,
3112     client_group.client_group_name  AS clientname
3113 FROM Job JOIN Client USING (ClientId)
3114          JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3115          JOIN client_group USING (client_group_id)
3116 WHERE
3117     client_group.client_group_name = $carg->{qclient_group}
3118     $limit
3119 GROUP BY client_group.client_group_name
3120 ";
3121
3122     my $row = $self->dbh_selectrow_hashref($query);
3123
3124     $row->{ID} = $cur_id++;
3125     $row->{label} = $label;
3126     $row->{grapharg} = "client_group";
3127
3128     $self->display($row, "display_client_stats.tpl");
3129 }
3130
3131 # poolname can be undef
3132 sub display_pool
3133 {
3134     my ($self, $poolname) = @_ ;
3135     my $whereA = '';
3136     my $whereW = '';
3137
3138     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3139     if ($arg->{jmediatypes}) {
3140         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3141         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3142     }
3143
3144 # TODO : afficher les tailles et les dates
3145
3146     my $query = "
3147 SELECT subq.volmax        AS volmax,
3148        subq.volnum        AS volnum,
3149        subq.voltotal      AS voltotal,
3150        Pool.Name          AS name,
3151        Pool.Recycle       AS recycle,
3152        Pool.VolRetention  AS volretention,
3153        Pool.VolUseDuration AS voluseduration,
3154        Pool.MaxVolJobs    AS maxvoljobs,
3155        Pool.MaxVolFiles   AS maxvolfiles,
3156        Pool.MaxVolBytes   AS maxvolbytes,
3157        subq.PoolId        AS PoolId,
3158        subq.MediaType     AS mediatype,
3159        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3160 FROM
3161   (
3162     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3163            count(Media.MediaId)  AS volnum,
3164            sum(Media.VolBytes)   AS voltotal,
3165            Media.PoolId          AS PoolId,
3166            Media.MediaType       AS MediaType
3167     FROM Media
3168     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3169                       Media.MediaType     AS MediaType
3170                FROM Media
3171               WHERE Media.VolStatus = 'Full'
3172               GROUP BY Media.MediaType
3173                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3174     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3175   ) AS subq
3176 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3177 $whereW
3178 ";
3179
3180     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3181
3182     $query = "
3183 SELECT Pool.Name AS name,
3184        sum(VolBytes) AS size
3185 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3186 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3187        $whereA
3188 GROUP BY Pool.Name;
3189 ";
3190     my $empty = $self->dbh_selectall_hashref($query, 'name');
3191
3192     foreach my $p (values %$all) {
3193         if ($p->{volmax} > 0) { # mysql returns 0.0000
3194             # we remove Recycled/Purged media from pool usage
3195             if (defined $empty->{$p->{name}}) {
3196                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3197             }
3198             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3199         } else {
3200             $p->{poolusage} = 0;
3201         }
3202
3203         $query = "
3204   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3205     FROM Media
3206    WHERE PoolId=$p->{poolid}
3207      AND Media.MediaType = '$p->{mediatype}'
3208          $whereA
3209 GROUP BY VolStatus
3210 ";
3211         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3212         foreach my $t (values %$content) {
3213             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3214         }
3215     }
3216
3217     $self->debug($all);
3218     $self->display({ ID => $cur_id++,
3219                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3220                      Pools => [ values %$all ]},
3221                    "display_pool.tpl");
3222 }
3223
3224 sub display_running_job
3225 {
3226     my ($self) = @_;
3227
3228     my $arg = $self->get_form('client', 'jobid');
3229
3230     if (!$arg->{client} and $arg->{jobid}) {
3231         # get security filter
3232         my $filter = $self->get_client_filter();
3233         my ($filter_where, undef) = $self->get_param('username');
3234
3235         my $query = "
3236 SELECT Client.Name AS name
3237 FROM Job INNER JOIN Client USING (ClientId) $filter
3238 WHERE Job.JobId = $arg->{jobid} $filter_where
3239 ";
3240
3241         my $row = $self->dbh_selectrow_hashref($query);
3242
3243         if ($row) {
3244             $arg->{client} = $row->{name};
3245             CGI::param('client', $arg->{client});
3246         }
3247     }
3248
3249     if ($arg->{client}) {
3250         my $cli = new Bweb::Client(name => $arg->{client});
3251         $cli->display_running_job($self->{info}, $arg->{jobid});
3252         if ($arg->{jobid}) {
3253             $self->get_job_log();
3254         }
3255     } else {
3256         $self->error("Can't get client or jobid");
3257     }
3258 }
3259
3260 sub display_running_jobs
3261 {
3262     my ($self, $display_action) = @_;
3263     # get security filter
3264     my $filter = $self->get_client_filter();
3265     my ($filter_where, undef) = $self->get_param('username');
3266
3267     my $query = "
3268 SELECT Job.JobId AS jobid,
3269        Job.Name  AS jobname,
3270        Job.Level     AS level,
3271        Job.StartTime AS starttime,
3272        Job.JobFiles  AS jobfiles,
3273        Job.JobBytes  AS jobbytes,
3274        Job.JobStatus AS jobstatus,
3275 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3276                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3277          AS duration,
3278        Client.Name AS clientname
3279 FROM Job INNER JOIN Client USING (ClientId) $filter
3280 WHERE
3281   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3282   $filter_where
3283 ";
3284     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3285
3286     $self->display({ ID => $cur_id++,
3287                      display_action => $display_action,
3288                      Jobs => [ values %$all ]},
3289                    "running_job.tpl") ;
3290 }
3291
3292 # return the autochanger list to update
3293 sub eject_media
3294 {
3295     my ($self) = @_;
3296     $self->can_do('media_mgnt');
3297
3298     my %ret;
3299     my $arg = $self->get_form('jmedias');
3300
3301     unless ($arg->{jmedias}) {
3302         return $self->error("Can't get media selection");
3303     }
3304
3305     my $query = "
3306 SELECT Media.VolumeName  AS volumename,
3307        Storage.Name      AS storage,
3308        Location.Location AS location,
3309        Media.Slot        AS slot
3310 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
3311            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3312 WHERE Media.VolumeName IN ($arg->{jmedias})
3313   AND Media.InChanger = 1
3314 ";
3315
3316     my $all = $self->dbh_selectall_hashref($query, 'volumename');
3317
3318     foreach my $vol (values %$all) {
3319         my $a = $self->ach_get($vol->{location});
3320         next unless ($a) ;
3321         $ret{$vol->{location}} = 1;
3322
3323         unless ($a->{have_status}) {
3324             $a->status();
3325             $a->{have_status} = 1;
3326         }
3327         # TODO: set enabled
3328         print "eject $vol->{volumename} from $vol->{storage} : ";
3329         if ($a->send_to_io($vol->{slot})) {
3330             print "<img src='/bweb/T.png' alt='ok'><br/>";
3331         } else {
3332             print "<img src='/bweb/E.png' alt='err'><br/>";
3333         }
3334     }
3335     return keys %ret;
3336 }
3337
3338 sub move_email
3339 {
3340     my ($self) = @_;
3341
3342     my ($to, $subject, $content) = (CGI::param('email'),
3343                                     CGI::param('subject'),
3344                                     CGI::param('content'));
3345     $to =~ s/[^\w\d\.\@<>,]//;
3346     $subject =~ s/[^\w\d\.\[\]]/ /;
3347
3348     open(MAIL, "|mail -s '$subject' '$to'") ;
3349     print MAIL $content;
3350     close(MAIL);
3351
3352     print "Mail sent";
3353 }
3354
3355 sub restore
3356 {
3357     my ($self) = @_;
3358
3359     my $arg = $self->get_form('jobid', 'client');
3360
3361     print CGI::header('text/brestore');
3362     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3363     print "client=$arg->{client}\n" if ($arg->{client});
3364     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3365     print "\n";
3366 }
3367
3368 # TODO : move this to Bweb::Autochanger ?
3369 # TODO : make this internal to not eject tape ?
3370 use Bconsole;
3371
3372
3373 sub ach_get
3374 {
3375     my ($self, $name) = @_;
3376
3377     unless ($name) {
3378         return $self->error("Can't get your autochanger name ach");
3379     }
3380
3381     unless ($self->{info}->{ach_list}) {
3382         return $self->error("Could not find any autochanger");
3383     }
3384
3385     my $a = $self->{info}->{ach_list}->{$name};
3386
3387     unless ($a) {
3388         $self->error("Can't get your autochanger $name from your ach_list");
3389         return undef;
3390     }
3391
3392     $a->{bweb}  = $self;
3393     $a->{debug} = $self->{debug};
3394
3395     return $a;
3396 }
3397
3398 sub ach_register
3399 {
3400     my ($self, $ach) = @_;
3401     $self->can_do('configure');
3402
3403     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3404
3405     $self->{info}->save();
3406
3407     return 1;
3408 }
3409
3410 sub ach_edit
3411 {
3412     my ($self) = @_;
3413     $self->can_do('configure');
3414
3415     my $arg = $self->get_form('ach');
3416     if (!$arg->{ach}
3417         or !$self->{info}->{ach_list}
3418         or !$self->{info}->{ach_list}->{$arg->{ach}})
3419     {
3420         return $self->error("Can't get autochanger name");
3421     }
3422
3423     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3424
3425     my $i=0;
3426     $ach->{drives} =
3427         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3428
3429     my $b = $self->get_bconsole();
3430
3431     my @storages = $b->list_storage() ;
3432
3433     $ach->{devices} = [ map { { name => $_ } } @storages ];
3434
3435     $self->display($ach, "ach_add.tpl");
3436     delete $ach->{drives};
3437     delete $ach->{devices};
3438     return 1;
3439 }
3440
3441 sub ach_del
3442 {
3443     my ($self) = @_;
3444     $self->can_do('configure');
3445
3446     my $arg = $self->get_form('ach');
3447
3448     if (!$arg->{ach}
3449         or !$self->{info}->{ach_list}
3450         or !$self->{info}->{ach_list}->{$arg->{ach}})
3451     {
3452         return $self->error("Can't get autochanger name");
3453     }
3454
3455     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3456
3457     $self->{info}->save();
3458     $self->{info}->view();
3459 }
3460
3461 sub ach_add
3462 {
3463     my ($self) = @_;
3464     $self->can_do('configure');
3465
3466     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3467
3468     my $b = $self->get_bconsole();
3469     my @storages = $b->list_storage() ;
3470
3471     unless ($arg->{ach}) {
3472         $arg->{devices} = [ map { { name => $_ } } @storages ];
3473         return $self->display($arg, "ach_add.tpl");
3474     }
3475
3476     my @drives ;
3477     foreach my $drive (CGI::param('drives'))
3478     {
3479         unless (grep(/^$drive$/,@storages)) {
3480             return $self->error("Can't find $drive in storage list");
3481         }
3482
3483         my $index = CGI::param("index_$drive");
3484         unless (defined $index and $index =~ /^(\d+)$/) {
3485             return $self->error("Can't get $drive index");
3486         }
3487
3488         $drives[$index] = $drive;
3489     }
3490
3491     unless (@drives) {
3492         return $self->error("Can't get drives from Autochanger");
3493     }
3494
3495     my $a = new Bweb::Autochanger(name   => $arg->{ach},
3496                                   precmd => $arg->{precmd},
3497                                   drive_name => \@drives,
3498                                   device => $arg->{device},
3499                                   mtxcmd => $arg->{mtxcmd});
3500
3501     $self->ach_register($a) ;
3502
3503     $self->{info}->view();
3504 }
3505
3506 sub delete
3507 {
3508     my ($self) = @_;
3509     $self->can_do('delete_job');
3510
3511     my $arg = $self->get_form('jobid');
3512
3513     if ($arg->{jobid}) {
3514         my $b = $self->get_bconsole();
3515         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3516
3517         $self->display({
3518             content => $ret,
3519             title => "Delete a job ",
3520             name => "delete jobid=$arg->{jobid}",
3521         }, "command.tpl");
3522     }
3523 }
3524
3525 sub do_update_media
3526 {
3527     my ($self) = @_ ;
3528     $self->can_do('media_mgnt');
3529
3530     my $arg = $self->get_form(qw/media volstatus inchanger pool
3531                                  slot volretention voluseduration
3532                                  maxvoljobs maxvolfiles maxvolbytes
3533                                  qcomment poolrecycle enabled
3534                               /);
3535
3536     unless ($arg->{media}) {
3537         return $self->error("Can't find media selection");
3538     }
3539
3540     my $update = "update volume=$arg->{media} ";
3541
3542     if ($arg->{volstatus}) {
3543         $update .= " volstatus=$arg->{volstatus} ";
3544     }
3545
3546     if ($arg->{inchanger}) {
3547         $update .= " inchanger=yes " ;
3548         if ($arg->{slot}) {
3549             $update .= " slot=$arg->{slot} ";
3550         }
3551     } else {
3552         $update .= " slot=0 inchanger=no ";
3553     }
3554
3555     if ($arg->{enabled}) {
3556         $update .= " enabled=$arg->{enabled} ";
3557     }
3558
3559     if ($arg->{pool}) {
3560         $update .= " pool=$arg->{pool} " ;
3561     }
3562
3563     if (defined $arg->{volretention}) {
3564         $update .= " volretention=\"$arg->{volretention}\" " ;
3565     }
3566
3567     if (defined $arg->{voluseduration}) {
3568         $update .= " voluse=\"$arg->{voluseduration}\" " ;
3569     }
3570
3571     if (defined $arg->{maxvoljobs}) {
3572         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3573     }
3574
3575     if (defined $arg->{maxvolfiles}) {
3576         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3577     }
3578
3579     if (defined $arg->{maxvolbytes}) {
3580         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3581     }
3582
3583     if (defined $arg->{poolrecycle}) {
3584         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3585     }
3586
3587     my $b = $self->get_bconsole();
3588
3589     $self->display({
3590         content => $b->send_cmd($update),
3591         title => "Update a volume ",
3592         name => $update,
3593     }, "command.tpl");
3594
3595
3596     my @q;
3597     my $media = $self->dbh_quote($arg->{media});
3598
3599     my $loc = CGI::param('location') || '';
3600     if ($loc) {
3601         $loc = $self->dbh_quote($loc); # is checked by db
3602         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3603     }
3604     if (!$arg->{qcomment}) {
3605         $arg->{qcomment} = "''";
3606     }
3607     push @q, "Comment=$arg->{qcomment}";
3608
3609
3610     my $query = "
3611 UPDATE Media
3612    SET " . join (',', @q) . "
3613  WHERE Media.VolumeName = $media
3614 ";
3615     $self->dbh_do($query);
3616
3617     $self->update_media();
3618 }
3619
3620 sub update_slots
3621 {
3622     my ($self) = @_;
3623     $self->can_do('autochanger_mgnt');
3624
3625     my $ach = CGI::param('ach') ;
3626     $ach = $self->ach_get($ach);
3627     unless ($ach) {
3628         return $self->error("Bad autochanger name");
3629     }
3630
3631     print "<pre>";
3632     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3633     $b->update_slots($ach->{name});
3634     print "</pre>\n"
3635 }
3636
3637 sub get_job_log
3638 {
3639     my ($self) = @_;
3640
3641     my $arg = $self->get_form('jobid', 'limit', 'offset');
3642     unless ($arg->{jobid}) {
3643         return $self->error("Can't get jobid");
3644     }
3645
3646     if ($arg->{limit} == 100) {
3647         $arg->{limit} = 1000;
3648     }
3649
3650     my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3651
3652     # display only Error and Warning messages
3653     my $filter = '';
3654     if (CGI::param('error')) {
3655         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning' ";
3656     }
3657
3658     # get security filter
3659     $filter .= $self->get_client_filter();
3660     my ($filter_where, undef) = $self->get_param('username');
3661
3662     my $query = "
3663 SELECT Job.Name as name, Client.Name as clientname
3664  FROM  Job INNER JOIN Client USING (ClientId) $filter
3665  WHERE JobId = $arg->{jobid} $filter_where
3666 ";
3667
3668     my $row = $self->dbh_selectrow_hashref($query);
3669
3670     unless ($row) {
3671         return $self->error("Can't find $arg->{jobid} in catalog");
3672     }
3673
3674     $query = "
3675 SELECT Time AS time, LogText AS log
3676   FROM  Log
3677  WHERE ( Log.JobId = $arg->{jobid}
3678     OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3679                       AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3680        )
3681        ) $filter
3682  ORDER BY LogId
3683  LIMIT $arg->{limit}
3684  OFFSET $arg->{offset}
3685 ";
3686
3687     my $log = $self->dbh_selectall_arrayref($query);
3688     unless ($log) {
3689         return $self->error("Can't get log for jobid $arg->{jobid}");
3690     }
3691
3692     my $logtxt;
3693     if ($t) {
3694         # log contains \n
3695         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3696     } else {
3697         $logtxt = join("", map { $_->[1] } @$log ) ;
3698     }
3699
3700     $self->display({ lines=> $logtxt,
3701                      jobid => $arg->{jobid},
3702                      name  => $row->{name},
3703                      client => $row->{clientname},
3704                      offset => $arg->{offset},
3705                      limit  => $arg->{limit},
3706                  }, 'display_log.tpl');
3707 }
3708
3709 sub label_barcodes
3710 {
3711     my ($self) = @_ ;
3712     $self->can_do('autochanger_mgnt');
3713
3714     my $arg = $self->get_form('ach', 'slots', 'drive');
3715
3716     unless ($arg->{ach}) {
3717         return $self->error("Can't find autochanger name");
3718     }
3719
3720     my $a = $self->ach_get($arg->{ach});
3721     unless ($a) {
3722         return $self->error("Can't find autochanger name in configuration");
3723     }
3724
3725     my $storage = $a->get_drive_name($arg->{drive});
3726     unless ($storage) {
3727         return $self->error("Can't get your drive name");
3728     }
3729
3730     my $slots = '';
3731     my $slots_sql = '';
3732     my $t = 300 ;
3733     if ($arg->{slots}) {
3734         $slots = join(",", @{ $arg->{slots} });
3735         $slots_sql = " AND Slot IN ($slots) ";
3736         $t += 60*scalar( @{ $arg->{slots} }) ;
3737     }
3738
3739     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3740     print "<h1>This command can take long time, be patient...</h1>";
3741     print "<pre>" ;
3742     $b->label_barcodes(storage => $storage,
3743                        drive => $arg->{drive},
3744                        pool  => 'Scratch',
3745                        slots => $slots) ;
3746     $b->close();
3747     print "</pre>";
3748
3749     $self->dbh_do("
3750   UPDATE Media
3751        SET LocationId =   (SELECT LocationId
3752                              FROM Location
3753                             WHERE Location = '$arg->{ach}')
3754
3755      WHERE (LocationId = 0 OR LocationId IS NULL)
3756        $slots_sql
3757 ");
3758
3759 }
3760
3761 sub purge
3762 {
3763     my ($self) = @_;
3764     $self->can_do('purge');
3765
3766     my @volume = CGI::param('media');
3767
3768     unless (@volume) {
3769         return $self->error("Can't get media selection");
3770     }
3771
3772     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3773
3774     foreach my $v (@volume) {
3775         $self->display({
3776             content => $b->purge_volume($v),
3777             title => "Purge media",
3778             name => "purge volume=$v",
3779         }, "command.tpl");
3780     }
3781     $b->close();
3782 }
3783
3784 sub prune
3785 {
3786     my ($self) = @_;
3787     $self->can_do('prune');
3788
3789     my @volume = CGI::param('media');
3790     unless (@volume) {
3791         return $self->error("Can't get media selection");
3792     }
3793
3794     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3795
3796     foreach my $v (@volume) {
3797         $self->display({
3798             content => $b->prune_volume($v),
3799             title => "Prune volume",
3800             name => "prune volume=$v",
3801         }, "command.tpl");
3802     }
3803     $b->close();
3804 }
3805
3806 sub cancel_job
3807 {
3808     my ($self) = @_;
3809     $self->can_do('cancel_job');
3810
3811     my $arg = $self->get_form('jobid');
3812     unless ($arg->{jobid}) {
3813         return $self->error("Can't get jobid");
3814     }
3815
3816     my $b = $self->get_bconsole();
3817     $self->display({
3818         content => $b->cancel($arg->{jobid}),
3819         title => "Cancel job",
3820         name => "cancel jobid=$arg->{jobid}",
3821     }, "command.tpl");
3822 }
3823
3824 sub fileset_view
3825 {
3826     # Warning, we display current fileset
3827     my ($self) = @_;
3828
3829     my $arg = $self->get_form('fileset');
3830
3831     if ($arg->{fileset}) {
3832         my $b = $self->get_bconsole();
3833         my $ret = $b->get_fileset($arg->{fileset});
3834         $self->display({ fileset => $arg->{fileset},
3835                          %$ret,
3836                      }, "fileset_view.tpl");
3837     } else {
3838         $self->error("Can't get fileset name");
3839     }
3840 }
3841
3842 sub director_show_sched
3843 {
3844     my ($self) = @_ ;
3845
3846     my $arg = $self->get_form('days');
3847
3848     my $b = $self->get_bconsole();
3849     my $ret = $b->director_get_sched( $arg->{days} );
3850
3851     $self->display({
3852         id => $cur_id++,
3853         list => $ret,
3854     }, "scheduled_job.tpl");
3855 }
3856
3857 sub enable_disable_job
3858 {
3859     my ($self, $what) = @_ ;
3860     $self->can_do('run_job');
3861
3862     my $name = CGI::param('job') || '';
3863     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3864         return $self->error("Can't find job name");
3865     }
3866
3867     my $b = $self->get_bconsole();
3868
3869     my $cmd;
3870     if ($what) {
3871         $cmd = "enable";
3872     } else {
3873         $cmd = "disable";
3874     }
3875
3876     $self->display({
3877         content => $b->send_cmd("$cmd job=\"$name\""),
3878         title => "$cmd $name",
3879         name => "$cmd job=\"$name\"",
3880     }, "command.tpl");
3881 }
3882
3883 sub get_bconsole
3884 {
3885     my ($self) = @_;
3886     return new Bconsole(pref => $self->{info});
3887 }
3888
3889 sub run_job_select
3890 {
3891     my ($self) = @_;
3892     $self->can_do('run_job');
3893
3894     my $b = $self->get_bconsole();
3895
3896     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3897
3898     $self->display({ Jobs => $joblist }, "run_job.tpl");
3899 }
3900
3901 sub run_parse_job
3902 {
3903     my ($self, $ouput) = @_;
3904
3905     my %arg;
3906     foreach my $l (split(/\r\n/, $ouput)) {
3907         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3908             $arg{$1} = $2;
3909             $l = $3
3910                 if ($3) ;
3911         }
3912
3913         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3914             %arg = (%arg, @l);
3915         }
3916     }
3917
3918     my %lowcase ;
3919     foreach my $k (keys %arg) {
3920         $lowcase{lc($k)} = $arg{$k} ;
3921     }
3922
3923     return \%lowcase;
3924 }
3925
3926 sub run_job_mod
3927 {
3928     my ($self) = @_;
3929     $self->can_do('run_job');
3930
3931     my $b = $self->get_bconsole();
3932
3933     my $job = CGI::param('job') || '';
3934
3935     # we take informations from director, and we overwrite with user wish
3936     my $info = $b->send_cmd("show job=\"$job\"");
3937     my $attr = $self->run_parse_job($info);
3938
3939     my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3940     my %job_opt = (%$attr, %$arg);
3941
3942     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3943
3944     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3945     my $clients = [ map { { name => $_ } }$b->list_client()];
3946     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3947     my $storages= [ map { { name => $_ } }$b->list_storage()];
3948
3949     $self->display({
3950         jobs     => $jobs,
3951         pools    => $pools,
3952         clients  => $clients,
3953         filesets => $filesets,
3954         storages => $storages,
3955         %job_opt,
3956     }, "run_job_mod.tpl");
3957 }
3958
3959 sub run_job
3960 {
3961     my ($self) = @_;
3962     $self->can_do('run_job');
3963
3964     my $b = $self->get_bconsole();
3965
3966     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3967
3968     $self->display({
3969         jobs     => $jobs,
3970     }, "run_job.tpl");
3971 }
3972
3973 sub run_job_now
3974 {
3975     my ($self) = @_;
3976     $self->can_do('run_job');
3977
3978     my $b = $self->get_bconsole();
3979
3980     # TODO: check input (don't use pool, level)
3981
3982     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3983     my $job = CGI::param('job') || '';
3984     my $storage = CGI::param('storage') || '';
3985
3986     my $jobid = $b->run(job => $job,
3987                         client => $arg->{client},
3988                         priority => $arg->{priority},
3989                         level => $arg->{level},
3990                         storage => $storage,
3991                         pool => $arg->{pool},
3992                         fileset => $arg->{fileset},
3993                         when => $arg->{when},
3994                         );
3995
3996     print $jobid, $b->{error};
3997
3998     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3999 }
4000
4001 1;