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

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