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