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         EndTime         AS endtime,
1932         Pool.Name       AS poolname,
1933         JobFiles        AS jobfiles,
1934         JobBytes        AS jobbytes,
1935         JobStatus       AS jobstatus,
1936      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1937                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1938                         AS duration,
1939
1940         JobErrors       AS joberrors
1941
1942  FROM Client,
1943       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1944           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1945  WHERE Client.ClientId=Job.ClientId
1946    AND Job.JobStatus != 'R'
1947  $where
1948  $limit
1949 ";
1950
1951     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1952
1953     $self->display({ Filter => $label,
1954                      ID => $cur_id++,
1955                      Jobs =>
1956                            [
1957                              sort { $a->{jobid} <=>  $b->{jobid} }
1958                                         values %$all
1959                              ],
1960                    },
1961                    "display_job.tpl");
1962 }
1963
1964 # display job informations
1965 sub display_job_zoom
1966 {
1967     my ($self, $jobid) = @_ ;
1968
1969     $jobid = $self->dbh_quote($jobid);
1970
1971     my $query="
1972 SELECT DISTINCT Job.JobId       AS jobid,
1973                 Client.Name     AS client,
1974                 Job.Name        AS jobname,
1975                 FileSet.FileSet AS fileset,
1976                 Level           AS level,
1977                 Pool.Name       AS poolname,
1978                 StartTime       AS starttime,
1979                 JobFiles        AS jobfiles,
1980                 JobBytes        AS jobbytes,
1981                 JobStatus       AS jobstatus,
1982                 JobErrors       AS joberrors,
1983                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1984                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1985
1986  FROM Client,
1987       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1988           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1989  WHERE Client.ClientId=Job.ClientId
1990  AND Job.JobId = $jobid
1991 ";
1992
1993     my $row = $self->dbh_selectrow_hashref($query) ;
1994
1995     # display all volumes associate with this job
1996     $query="
1997 SELECT Media.VolumeName as volumename
1998 FROM Job,Media,JobMedia
1999 WHERE Job.JobId = $jobid
2000  AND JobMedia.JobId=Job.JobId
2001  AND JobMedia.MediaId=Media.MediaId
2002 ";
2003
2004     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2005
2006     $row->{volumes} = [ values %$all ] ;
2007
2008     $self->display($row, "display_job_zoom.tpl");
2009 }
2010
2011 sub display_media
2012 {
2013     my ($self) = @_ ;
2014
2015     my ($where, %elt) = $self->get_param('pools',
2016                                          'mediatypes',
2017                                          'volstatus',
2018                                          'locations');
2019
2020     my $arg = $self->get_form('jmedias', 'qre_media');
2021
2022     if ($arg->{jmedias}) {
2023         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2024     }
2025     if ($arg->{qre_media}) {
2026         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2027     }
2028
2029     my $query="
2030 SELECT Media.VolumeName  AS volumename,
2031        Media.VolBytes    AS volbytes,
2032        Media.VolStatus   AS volstatus,
2033        Media.MediaType   AS mediatype,
2034        Media.InChanger   AS online,
2035        Media.LastWritten AS lastwritten,
2036        Location.Location AS location,
2037        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2038        Pool.Name         AS poolname,
2039        $self->{sql}->{FROM_UNIXTIME}(
2040           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2041         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2042        ) AS expire
2043 FROM      Pool, Media
2044 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2045 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2046                   Media.MediaType     AS MediaType
2047            FROM Media
2048           WHERE Media.VolStatus = 'Full'
2049           GROUP BY Media.MediaType
2050            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2051
2052 WHERE Media.PoolId=Pool.PoolId
2053 $where
2054 ";
2055
2056     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2057
2058     $self->display({ ID => $cur_id++,
2059                      Pool => $elt{pool},
2060                      Location => $elt{location},
2061                      Medias => [ values %$all ]
2062                    },
2063                    "display_media.tpl");
2064 }
2065
2066 sub display_medias
2067 {
2068     my ($self) = @_ ;
2069
2070     my $pool = $self->get_form('db_pools');
2071
2072     foreach my $name (@{ $pool->{db_pools} }) {
2073         CGI::param('pool', $name->{name});
2074         $self->display_media();
2075     }
2076 }
2077
2078 sub display_media_zoom
2079 {
2080     my ($self) = @_ ;
2081
2082     my $medias = $self->get_form('jmedias');
2083
2084     unless ($medias->{jmedias}) {
2085         return $self->error("Can't get media selection");
2086     }
2087
2088     my $query="
2089 SELECT InChanger     AS online,
2090        VolBytes      AS nb_bytes,
2091        VolumeName    AS volumename,
2092        VolStatus     AS volstatus,
2093        VolMounts     AS nb_mounts,
2094        Media.VolUseDuration   AS voluseduration,
2095        Media.MaxVolJobs AS maxvoljobs,
2096        Media.MaxVolFiles AS maxvolfiles,
2097        Media.MaxVolBytes AS maxvolbytes,
2098        VolErrors     AS nb_errors,
2099        Pool.Name     AS poolname,
2100        Location.Location AS location,
2101        Media.Recycle AS recycle,
2102        Media.VolRetention AS volretention,
2103        Media.LastWritten  AS lastwritten,
2104        Media.VolReadTime/1000000  AS volreadtime,
2105        Media.VolWriteTime/1000000 AS volwritetime,
2106        Media.RecycleCount AS recyclecount,
2107        Media.Comment      AS comment,
2108        $self->{sql}->{FROM_UNIXTIME}(
2109           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2110         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2111        ) AS expire
2112  FROM Pool,
2113       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2114  WHERE Pool.PoolId = Media.PoolId
2115  AND VolumeName IN ($medias->{jmedias})
2116 ";
2117
2118     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2119
2120     foreach my $media (values %$all) {
2121         my $mq = $self->dbh_quote($media->{volumename});
2122
2123         $query = "
2124 SELECT DISTINCT Job.JobId AS jobid,
2125                 Job.Name  AS name,
2126                 Job.StartTime AS starttime,
2127                 Job.Type  AS type,
2128                 Job.Level AS level,
2129                 Job.JobFiles AS files,
2130                 Job.JobBytes AS bytes,
2131                 Job.jobstatus AS status
2132  FROM Media,JobMedia,Job
2133  WHERE Media.VolumeName=$mq
2134  AND Media.MediaId=JobMedia.MediaId
2135  AND JobMedia.JobId=Job.JobId
2136 ";
2137
2138         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2139
2140         $query = "
2141 SELECT LocationLog.Date    AS date,
2142        Location.Location   AS location,
2143        LocationLog.Comment AS comment
2144  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2145  WHERE Media.MediaId = LocationLog.MediaId
2146    AND Media.VolumeName = $mq
2147 ";
2148
2149         my $logtxt = '';
2150         my $log = $self->dbh_selectall_arrayref($query) ;
2151         if ($log) {
2152             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2153         }
2154
2155         $self->display({ jobs => [ values %$jobs ],
2156                          LocationLog => $logtxt,
2157                          %$media },
2158                        "display_media_zoom.tpl");
2159     }
2160 }
2161
2162 sub location_edit
2163 {
2164     my ($self) = @_ ;
2165
2166     my $loc = $self->get_form('qlocation');
2167     unless ($loc->{qlocation}) {
2168         return $self->error("Can't get location");
2169     }
2170
2171     my $query = "
2172 SELECT Location.Location AS location,
2173        Location.Cost   AS cost,
2174        Location.Enabled AS enabled
2175 FROM Location
2176 WHERE Location.Location = $loc->{qlocation}
2177 ";
2178
2179     my $row = $self->dbh_selectrow_hashref($query);
2180
2181     $self->display({ ID => $cur_id++,
2182                      %$row }, "location_edit.tpl") ;
2183
2184 }
2185
2186 sub location_save
2187 {
2188     my ($self) = @_ ;
2189
2190     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2191     unless ($arg->{qlocation}) {
2192         return $self->error("Can't get location");
2193     }
2194     unless ($arg->{qnewlocation}) {
2195         return $self->error("Can't get new location name");
2196     }
2197     unless ($arg->{cost}) {
2198         return $self->error("Can't get new cost");
2199     }
2200
2201     my $enabled = CGI::param('enabled') || '';
2202     $enabled = $enabled?1:0;
2203
2204     my $query = "
2205 UPDATE Location SET Cost     = $arg->{cost},
2206                     Location = $arg->{qnewlocation},
2207                     Enabled   = $enabled
2208 WHERE Location.Location = $arg->{qlocation}
2209 ";
2210
2211     $self->dbh_do($query);
2212
2213     $self->display_location();
2214 }
2215
2216 sub location_del
2217 {
2218     my ($self) = @_ ;
2219     my $arg = $self->get_form(qw/qlocation/) ;
2220
2221     unless ($arg->{qlocation}) {
2222         return $self->error("Can't get location");
2223     }
2224
2225     my $query = "
2226 SELECT count(Media.MediaId) AS nb
2227   FROM Media INNER JOIN Location USING (LocationID)
2228 WHERE Location = $arg->{qlocation}
2229 ";
2230
2231     my $res = $self->dbh_selectrow_hashref($query);
2232
2233     if ($res->{nb}) {
2234         return $self->error("Sorry, the location must be empty");
2235     }
2236
2237     $query = "
2238 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2239 ";
2240
2241     $self->dbh_do($query);
2242
2243     $self->display_location();
2244 }
2245
2246
2247 sub location_add
2248 {
2249     my ($self) = @_ ;
2250     my $arg = $self->get_form(qw/qlocation cost/) ;
2251
2252     unless ($arg->{qlocation}) {
2253         $self->display({}, "location_add.tpl");
2254         return 1;
2255     }
2256     unless ($arg->{cost}) {
2257         return $self->error("Can't get new cost");
2258     }
2259
2260     my $enabled = CGI::param('enabled') || '';
2261     $enabled = $enabled?1:0;
2262
2263     my $query = "
2264 INSERT INTO Location (Location, Cost, Enabled)
2265        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2266 ";
2267
2268     $self->dbh_do($query);
2269
2270     $self->display_location();
2271 }
2272
2273 sub display_location
2274 {
2275     my ($self) = @_ ;
2276
2277     my $query = "
2278 SELECT Location.Location AS location,
2279        Location.Cost     AS cost,
2280        Location.Enabled  AS enabled,
2281        (SELECT count(Media.MediaId)
2282          FROM Media
2283         WHERE Media.LocationId = Location.LocationId
2284        ) AS volnum
2285 FROM Location
2286 ";
2287
2288     my $location = $self->dbh_selectall_hashref($query, 'location');
2289
2290     $self->display({ ID => $cur_id++,
2291                      Locations => [ values %$location ] },
2292                    "display_location.tpl");
2293 }
2294
2295 sub update_location
2296 {
2297     my ($self) = @_ ;
2298
2299     my $medias = $self->get_selected_media_location();
2300     unless ($medias) {
2301         return ;
2302     }
2303
2304     my $arg = $self->get_form('db_locations', 'qnewlocation');
2305
2306     $self->display({ email  => $self->{info}->{email_media},
2307                      %$arg,
2308                      medias => [ values %$medias ],
2309                    },
2310                    "update_location.tpl");
2311 }
2312
2313 sub get_media_max_size
2314 {
2315     my ($self, $type) = @_;
2316     my $query =
2317 "SELECT avg(VolBytes) AS size
2318   FROM Media
2319  WHERE Media.VolStatus = 'Full'
2320    AND Media.MediaType = '$type'
2321 ";
2322
2323     my $res = $self->selectrow_hashref($query);
2324
2325     if ($res) {
2326         return $res->{size};
2327     } else {
2328         return 0;
2329     }
2330 }
2331
2332 sub update_media
2333 {
2334     my ($self) = @_ ;
2335
2336     my $media = $self->get_form('qmedia');
2337
2338     unless ($media->{qmedia}) {
2339         return $self->error("Can't get media");
2340     }
2341
2342     my $query = "
2343 SELECT Media.Slot         AS slot,
2344        PoolMedia.Name     AS poolname,
2345        Media.VolStatus    AS volstatus,
2346        Media.InChanger    AS inchanger,
2347        Location.Location  AS location,
2348        Media.VolumeName   AS volumename,
2349        Media.MaxVolBytes  AS maxvolbytes,
2350        Media.MaxVolJobs   AS maxvoljobs,
2351        Media.MaxVolFiles  AS maxvolfiles,
2352        Media.VolUseDuration AS voluseduration,
2353        Media.VolRetention AS volretention,
2354        Media.Comment      AS comment,
2355        PoolRecycle.Name   AS poolrecycle
2356
2357 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2358            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2359            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2360
2361 WHERE Media.VolumeName = $media->{qmedia}
2362 ";
2363
2364     my $row = $self->dbh_selectrow_hashref($query);
2365     $row->{volretention} = human_sec($row->{volretention});
2366     $row->{voluseduration} = human_sec($row->{voluseduration});
2367
2368     my $elt = $self->get_form(qw/db_pools db_locations/);
2369
2370     $self->display({
2371         %$elt,
2372         %$row,
2373     }, "update_media.tpl");
2374 }
2375
2376 sub save_location
2377 {
2378     my ($self) = @_ ;
2379
2380     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2381
2382     unless ($arg->{jmedias}) {
2383         return $self->error("Can't get selected media");
2384     }
2385
2386     unless ($arg->{qnewlocation}) {
2387         return $self->error("Can't get new location");
2388     }
2389
2390     my $query = "
2391  UPDATE Media
2392      SET LocationId = (SELECT LocationId
2393                        FROM Location
2394                        WHERE Location = $arg->{qnewlocation})
2395      WHERE Media.VolumeName IN ($arg->{jmedias})
2396 ";
2397
2398     my $nb = $self->dbh_do($query);
2399
2400     print "$nb media updated, you may have to update your autochanger.";
2401
2402     $self->display_media();
2403 }
2404
2405 sub change_location
2406 {
2407     my ($self) = @_ ;
2408
2409     my $medias = $self->get_selected_media_location();
2410     unless ($medias) {
2411         return $self->error("Can't get media selection");
2412     }
2413     my $newloc = CGI::param('newlocation');
2414
2415     my $user = CGI::param('user') || 'unknow';
2416     my $comm = CGI::param('comment') || '';
2417     $comm = $self->dbh_quote("$user: $comm");
2418
2419     my $query;
2420
2421     foreach my $media (keys %$medias) {
2422         $query = "
2423 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2424  VALUES(
2425        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2426        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2427        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2428       )
2429 ";
2430         $self->dbh_do($query);
2431         $self->debug($query);
2432     }
2433
2434     my $q = new CGI;
2435     $q->param('action', 'update_location');
2436     my $url = $q->url(-full => 1, -query=>1);
2437
2438     $self->display({ email  => $self->{info}->{email_media},
2439                      url => $url,
2440                      newlocation => $newloc,
2441                      # [ { volumename => 'vol1' }, { volumename => 'vol2'\81 },..]
2442                      medias => [ values %$medias ],
2443                    },
2444                    "change_location.tpl");
2445
2446 }
2447
2448 sub display_client_stats
2449 {
2450     my ($self, %arg) = @_ ;
2451
2452     my $client = $self->dbh_quote($arg{clientname});
2453     my ($limit, $label) = $self->get_limit(%arg);
2454
2455     my $query = "
2456 SELECT
2457     count(Job.JobId)     AS nb_jobs,
2458     sum(Job.JobBytes)    AS nb_bytes,
2459     sum(Job.JobErrors)   AS nb_err,
2460     sum(Job.JobFiles)    AS nb_files,
2461     Client.Name          AS clientname
2462 FROM Job INNER JOIN Client USING (ClientId)
2463 WHERE
2464     Client.Name = $client
2465     $limit
2466 GROUP BY Client.Name
2467 ";
2468
2469     my $row = $self->dbh_selectrow_hashref($query);
2470
2471     $row->{ID} = $cur_id++;
2472     $row->{label} = $label;
2473
2474     $self->display($row, "display_client_stats.tpl");
2475 }
2476
2477 # poolname can be undef
2478 sub display_pool
2479 {
2480     my ($self, $poolname) = @_ ;
2481     my $whereA = '';
2482     my $whereW = '';
2483
2484     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2485     if ($arg->{jmediatypes}) {
2486         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2487         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
2488     }
2489
2490 # TODO : afficher les tailles et les dates
2491
2492     my $query = "
2493 SELECT subq.volmax        AS volmax,
2494        subq.volnum        AS volnum,
2495        subq.voltotal      AS voltotal,
2496        Pool.Name          AS name,
2497        Pool.Recycle       AS recycle,
2498        Pool.VolRetention  AS volretention,
2499        Pool.VolUseDuration AS voluseduration,
2500        Pool.MaxVolJobs    AS maxvoljobs,
2501        Pool.MaxVolFiles   AS maxvolfiles,
2502        Pool.MaxVolBytes   AS maxvolbytes,
2503        subq.PoolId        AS PoolId
2504 FROM
2505   (
2506     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2507            count(Media.MediaId)  AS volnum,
2508            sum(Media.VolBytes)   AS voltotal,
2509            Media.PoolId          AS PoolId,
2510            Media.MediaType       AS MediaType
2511     FROM Media
2512     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2513                       Media.MediaType     AS MediaType
2514                FROM Media
2515               WHERE Media.VolStatus = 'Full'
2516               GROUP BY Media.MediaType
2517                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2518     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2519   ) AS subq
2520 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2521 $whereW
2522 ";
2523
2524     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2525
2526     $query = "
2527 SELECT Pool.Name AS name,
2528        sum(VolBytes) AS size
2529 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2530 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
2531        $whereA
2532 GROUP BY Pool.Name;
2533 ";
2534     my $empty = $self->dbh_selectall_hashref($query, 'name');
2535
2536     foreach my $p (values %$all) {
2537         if ($p->{volmax} > 0) { # mysql returns 0.0000
2538             # we remove Recycled/Purged media from pool usage
2539             if (defined $empty->{$p->{name}}) {
2540                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2541             }
2542             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2543         } else {
2544             $p->{poolusage} = 0;
2545         }
2546
2547         $query = "
2548   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2549     FROM Media
2550    WHERE PoolId=$p->{poolid}
2551          $whereA
2552 GROUP BY VolStatus
2553 ";
2554         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2555         foreach my $t (values %$content) {
2556             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2557         }
2558     }
2559
2560     $self->debug($all);
2561     $self->display({ ID => $cur_id++,
2562                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2563                      Pools => [ values %$all ]},
2564                    "display_pool.tpl");
2565 }
2566
2567 sub display_running_job
2568 {
2569     my ($self) = @_;
2570
2571     my $arg = $self->get_form('client', 'jobid');
2572
2573     if (!$arg->{client} and $arg->{jobid}) {
2574
2575         my $query = "
2576 SELECT Client.Name AS name
2577 FROM Job INNER JOIN Client USING (ClientId)
2578 WHERE Job.JobId = $arg->{jobid}
2579 ";
2580
2581         my $row = $self->dbh_selectrow_hashref($query);
2582
2583         if ($row) {
2584             $arg->{client} = $row->{name};
2585             CGI::param('client', $arg->{client});
2586         }
2587     }
2588
2589     if ($arg->{client}) {
2590         my $cli = new Bweb::Client(name => $arg->{client});
2591         $cli->display_running_job($self->{info}, $arg->{jobid});
2592         if ($arg->{jobid}) {
2593             $self->get_job_log();
2594         }
2595     } else {
2596         $self->error("Can't get client or jobid");
2597     }
2598 }
2599
2600 sub display_running_jobs
2601 {
2602     my ($self, $display_action) = @_;
2603
2604     my $query = "
2605 SELECT Job.JobId AS jobid,
2606        Job.Name  AS jobname,
2607        Job.Level     AS level,
2608        Job.StartTime AS starttime,
2609        Job.JobFiles  AS jobfiles,
2610        Job.JobBytes  AS jobbytes,
2611        Job.JobStatus AS jobstatus,
2612 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2613                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2614          AS duration,
2615        Client.Name AS clientname
2616 FROM Job INNER JOIN Client USING (ClientId)
2617 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2618 ";
2619     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2620
2621     $self->display({ ID => $cur_id++,
2622                      display_action => $display_action,
2623                      Jobs => [ values %$all ]},
2624                    "running_job.tpl") ;
2625 }
2626
2627 # return the autochanger list to update
2628 sub eject_media
2629 {
2630     my ($self) = @_;
2631     my %ret;
2632     my $arg = $self->get_form('jmedias');
2633
2634     unless ($arg->{jmedias}) {
2635         return $self->error("Can't get media selection");
2636     }
2637
2638     my $query = "
2639 SELECT Media.VolumeName  AS volumename,
2640        Storage.Name      AS storage,
2641        Location.Location AS location,
2642        Media.Slot        AS slot
2643 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2644            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2645 WHERE Media.VolumeName IN ($arg->{jmedias})
2646   AND Media.InChanger = 1
2647 ";
2648
2649     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2650
2651     foreach my $vol (values %$all) {
2652         my $a = $self->ach_get($vol->{location});
2653         next unless ($a) ;
2654         $ret{$vol->{location}} = 1;
2655
2656         unless ($a->{have_status}) {
2657             $a->status();
2658             $a->{have_status} = 1;
2659         }
2660
2661         print "eject $vol->{volumename} from $vol->{storage} : ";
2662         if ($a->send_to_io($vol->{slot})) {
2663             print "<img src='/bweb/T.png' alt='ok'><br/>";
2664         } else {
2665             print "<img src='/bweb/E.png' alt='err'><br/>";
2666         }
2667     }
2668     return keys %ret;
2669 }
2670
2671 sub move_email
2672 {
2673     my ($self) = @_;
2674
2675     my ($to, $subject, $content) = (CGI::param('email'),
2676                                     CGI::param('subject'),
2677                                     CGI::param('content'));
2678     $to =~ s/[^\w\d\.\@<>,]//;
2679     $subject =~ s/[^\w\d\.\[\]]/ /;
2680
2681     open(MAIL, "|mail -s '$subject' '$to'") ;
2682     print MAIL $content;
2683     close(MAIL);
2684
2685     print "Mail sent";
2686 }
2687
2688 sub restore
2689 {
2690     my ($self) = @_;
2691
2692     my $arg = $self->get_form('jobid', 'client');
2693
2694     print CGI::header('text/brestore');
2695     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2696     print "client=$arg->{client}\n" if ($arg->{client});
2697     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2698     print "\n";
2699 }
2700
2701 # TODO : move this to Bweb::Autochanger ?
2702 # TODO : make this internal to not eject tape ?
2703 use Bconsole;
2704
2705
2706 sub ach_get
2707 {
2708     my ($self, $name) = @_;
2709
2710     unless ($name) {
2711         return $self->error("Can't get your autochanger name ach");
2712     }
2713
2714     unless ($self->{info}->{ach_list}) {
2715         return $self->error("Could not find any autochanger");
2716     }
2717
2718     my $a = $self->{info}->{ach_list}->{$name};
2719
2720     unless ($a) {
2721         $self->error("Can't get your autochanger $name from your ach_list");
2722         return undef;
2723     }
2724
2725     $a->{bweb}  = $self;
2726     $a->{debug} = $self->{debug};
2727
2728     return $a;
2729 }
2730
2731 sub ach_register
2732 {
2733     my ($self, $ach) = @_;
2734
2735     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2736
2737     $self->{info}->save();
2738
2739     return 1;
2740 }
2741
2742 sub ach_edit
2743 {
2744     my ($self) = @_;
2745     my $arg = $self->get_form('ach');
2746     if (!$arg->{ach}
2747         or !$self->{info}->{ach_list}
2748         or !$self->{info}->{ach_list}->{$arg->{ach}})
2749     {
2750         return $self->error("Can't get autochanger name");
2751     }
2752
2753     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2754
2755     my $i=0;
2756     $ach->{drives} =
2757         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2758
2759     my $b = $self->get_bconsole();
2760
2761     my @storages = $b->list_storage() ;
2762
2763     $ach->{devices} = [ map { { name => $_ } } @storages ];
2764
2765     $self->display($ach, "ach_add.tpl");
2766     delete $ach->{drives};
2767     delete $ach->{devices};
2768     return 1;
2769 }
2770
2771 sub ach_del
2772 {
2773     my ($self) = @_;
2774     my $arg = $self->get_form('ach');
2775
2776     if (!$arg->{ach}
2777         or !$self->{info}->{ach_list}
2778         or !$self->{info}->{ach_list}->{$arg->{ach}})
2779     {
2780         return $self->error("Can't get autochanger name");
2781     }
2782
2783     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2784
2785     $self->{info}->save();
2786     $self->{info}->view();
2787 }
2788
2789 sub ach_add
2790 {
2791     my ($self) = @_;
2792     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2793
2794     my $b = $self->get_bconsole();
2795     my @storages = $b->list_storage() ;
2796
2797     unless ($arg->{ach}) {
2798         $arg->{devices} = [ map { { name => $_ } } @storages ];
2799         return $self->display($arg, "ach_add.tpl");
2800     }
2801
2802     my @drives ;
2803     foreach my $drive (CGI::param('drives'))
2804     {
2805         unless (grep(/^$drive$/,@storages)) {
2806             return $self->error("Can't find $drive in storage list");
2807         }
2808
2809         my $index = CGI::param("index_$drive");
2810         unless (defined $index and $index =~ /^(\d+)$/) {
2811             return $self->error("Can't get $drive index");
2812         }
2813
2814         $drives[$index] = $drive;
2815     }
2816
2817     unless (@drives) {
2818         return $self->error("Can't get drives from Autochanger");
2819     }
2820
2821     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2822                                   precmd => $arg->{precmd},
2823                                   drive_name => \@drives,
2824                                   device => $arg->{device},
2825                                   mtxcmd => $arg->{mtxcmd});
2826
2827     $self->ach_register($a) ;
2828
2829     $self->{info}->view();
2830 }
2831
2832 sub delete
2833 {
2834     my ($self) = @_;
2835     my $arg = $self->get_form('jobid');
2836
2837     if ($arg->{jobid}) {
2838         my $b = $self->get_bconsole();
2839         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2840
2841         $self->display({
2842             content => $ret,
2843             title => "Delete a job ",
2844             name => "delete jobid=$arg->{jobid}",
2845         }, "command.tpl");
2846     }
2847 }
2848
2849 sub do_update_media
2850 {
2851     my ($self) = @_ ;
2852
2853     my $arg = $self->get_form(qw/media volstatus inchanger pool
2854                                  slot volretention voluseduration
2855                                  maxvoljobs maxvolfiles maxvolbytes
2856                                  qcomment poolrecycle
2857                               /);
2858
2859     unless ($arg->{media}) {
2860         return $self->error("Can't find media selection");
2861     }
2862
2863     my $update = "update volume=$arg->{media} ";
2864
2865     if ($arg->{volstatus}) {
2866         $update .= " volstatus=$arg->{volstatus} ";
2867     }
2868
2869     if ($arg->{inchanger}) {
2870         $update .= " inchanger=yes " ;
2871         if ($arg->{slot}) {
2872             $update .= " slot=$arg->{slot} ";
2873         }
2874     } else {
2875         $update .= " slot=0 inchanger=no ";
2876     }
2877
2878     if ($arg->{pool}) {
2879         $update .= " pool=$arg->{pool} " ;
2880     }
2881
2882     if (defined $arg->{volretention}) {
2883         $update .= " volretention=\"$arg->{volretention}\" " ;
2884     }
2885
2886     if (defined $arg->{voluseduration}) {
2887         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2888     }
2889
2890     if (defined $arg->{maxvoljobs}) {
2891         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2892     }
2893
2894     if (defined $arg->{maxvolfiles}) {
2895         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2896     }
2897
2898     if (defined $arg->{maxvolbytes}) {
2899         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2900     }
2901
2902     my $b = $self->get_bconsole();
2903
2904     $self->display({
2905         content => $b->send_cmd($update),
2906         title => "Update a volume ",
2907         name => $update,
2908     }, "command.tpl");
2909
2910
2911     my @q;
2912     my $media = $self->dbh_quote($arg->{media});
2913
2914     my $loc = CGI::param('location') || '';
2915     if ($loc) {
2916         $loc = $self->dbh_quote($loc); # is checked by db
2917         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2918     }
2919     if ($arg->{poolrecycle}) {
2920         push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2921     }
2922     if (!$arg->{qcomment}) {
2923         $arg->{qcomment} = "''";
2924     }
2925     push @q, "Comment=$arg->{qcomment}";
2926
2927
2928     my $query = "
2929 UPDATE Media
2930    SET " . join (',', @q) . "
2931  WHERE Media.VolumeName = $media
2932 ";
2933     $self->dbh_do($query);
2934
2935     $self->update_media();
2936 }
2937
2938 sub update_slots
2939 {
2940     my ($self) = @_;
2941
2942     my $ach = CGI::param('ach') ;
2943     $ach = $self->ach_get($ach);
2944     unless ($ach) {
2945         return $self->error("Bad autochanger name");
2946     }
2947
2948     print "<pre>";
2949     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2950     $b->update_slots($ach->{name});
2951     print "</pre>\n"
2952 }
2953
2954 sub get_job_log
2955 {
2956     my ($self) = @_;
2957
2958     my $arg = $self->get_form('jobid');
2959     unless ($arg->{jobid}) {
2960         return $self->error("Can't get jobid");
2961     }
2962
2963     my $t = CGI::param('time') || '';
2964
2965     my $query = "
2966 SELECT Job.Name as name, Client.Name as clientname
2967  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2968  WHERE JobId = $arg->{jobid}
2969 ";
2970
2971     my $row = $self->dbh_selectrow_hashref($query);
2972
2973     unless ($row) {
2974         return $self->error("Can't find $arg->{jobid} in catalog");
2975     }
2976
2977     $query = "
2978 SELECT Time AS time, LogText AS log
2979   FROM  Log
2980  WHERE Log.JobId = $arg->{jobid}
2981     OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2982                       AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2983        )
2984  ORDER BY LogId;
2985 ";
2986
2987     my $log = $self->dbh_selectall_arrayref($query);
2988     unless ($log) {
2989         return $self->error("Can't get log for jobid $arg->{jobid}");
2990     }
2991
2992     my $logtxt;
2993     if ($t) {
2994         # log contains \n
2995         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2996     } else {
2997         $logtxt = join("", map { $_->[1] } @$log ) ;
2998     }
2999
3000     $self->display({ lines=> $logtxt,
3001                      jobid => $arg->{jobid},
3002                      name  => $row->{name},
3003                      client => $row->{clientname},
3004                  }, 'display_log.tpl');
3005 }
3006
3007
3008 sub label_barcodes
3009 {
3010     my ($self) = @_ ;
3011
3012     my $arg = $self->get_form('ach', 'slots', 'drive');
3013
3014     unless ($arg->{ach}) {
3015         return $self->error("Can't find autochanger name");
3016     }
3017
3018     my $a = $self->ach_get($arg->{ach});
3019     unless ($a) {
3020         return $self->error("Can't find autochanger name in configuration");
3021     }
3022
3023     my $storage = $a->get_drive_name($arg->{drive});
3024     unless ($storage) {
3025         return $self->error("Can't get your drive name");
3026     }
3027
3028     my $slots = '';
3029     my $t = 300 ;
3030     if ($arg->{slots}) {
3031         $slots = join(",", @{ $arg->{slots} });
3032         $t += 60*scalar( @{ $arg->{slots} }) ;
3033     }
3034
3035     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3036     print "<h1>This command can take long time, be patient...</h1>";
3037     print "<pre>" ;
3038     $b->label_barcodes(storage => $storage,
3039                        drive => $arg->{drive},
3040                        pool  => 'Scratch',
3041                        slots => $slots) ;
3042     $b->close();
3043     print "</pre>";
3044
3045     $self->dbh_do("
3046   UPDATE Media
3047        SET LocationId =   (SELECT LocationId
3048                              FROM Location
3049                             WHERE Location = '$arg->{ach}'),
3050
3051            RecyclePoolId = PoolId
3052
3053      WHERE Media.PoolId = (SELECT PoolId
3054                              FROM Pool
3055                             WHERE Name = 'Scratch')
3056        AND (LocationId = 0 OR LocationId IS NULL)
3057 ");
3058
3059 }
3060
3061 sub purge
3062 {
3063     my ($self) = @_;
3064
3065     my @volume = CGI::param('media');
3066
3067     unless (@volume) {
3068         return $self->error("Can't get media selection");
3069     }
3070
3071     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3072
3073     $self->display({
3074         content => $b->purge_volume(@volume),
3075         title => "Purge media",
3076         name => "purge volume=" . join(' volume=', @volume),
3077     }, "command.tpl");
3078     $b->close();
3079 }
3080
3081 sub prune
3082 {
3083     my ($self) = @_;
3084
3085     my @volume = CGI::param('media');
3086     unless (@volume) {
3087         return $self->error("Can't get media selection");
3088     }
3089
3090     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3091
3092     $self->display({
3093         content => $b->prune_volume(@volume),
3094         title => "Prune media",
3095         name => "prune volume=" . join(' volume=', @volume),
3096     }, "command.tpl");
3097
3098     $b->close();
3099 }
3100
3101 sub cancel_job
3102 {
3103     my ($self) = @_;
3104
3105     my $arg = $self->get_form('jobid');
3106     unless ($arg->{jobid}) {
3107         return $self->error("Can't get jobid");
3108     }
3109
3110     my $b = $self->get_bconsole();
3111     $self->display({
3112         content => $b->cancel($arg->{jobid}),
3113         title => "Cancel job",
3114         name => "cancel jobid=$arg->{jobid}",
3115     }, "command.tpl");
3116 }
3117
3118 sub fileset_view
3119 {
3120     # Warning, we display current fileset
3121     my ($self) = @_;
3122
3123     my $arg = $self->get_form('fileset');
3124
3125     if ($arg->{fileset}) {
3126         my $b = $self->get_bconsole();
3127         my $ret = $b->get_fileset($arg->{fileset});
3128         $self->display({ fileset => $arg->{fileset},
3129                          %$ret,
3130                      }, "fileset_view.tpl");
3131     } else {
3132         $self->error("Can't get fileset name");
3133     }
3134 }
3135
3136 sub director_show_sched
3137 {
3138     my ($self) = @_ ;
3139
3140     my $arg = $self->get_form('days');
3141
3142     my $b = $self->get_bconsole();
3143     my $ret = $b->director_get_sched( $arg->{days} );
3144
3145     $self->display({
3146         id => $cur_id++,
3147         list => $ret,
3148     }, "scheduled_job.tpl");
3149 }
3150
3151 sub enable_disable_job
3152 {
3153     my ($self, $what) = @_ ;
3154
3155     my $name = CGI::param('job') || '';
3156     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3157         return $self->error("Can't find job name");
3158     }
3159
3160     my $b = $self->get_bconsole();
3161
3162     my $cmd;
3163     if ($what) {
3164         $cmd = "enable";
3165     } else {
3166         $cmd = "disable";
3167     }
3168
3169     $self->display({
3170         content => $b->send_cmd("$cmd job=\"$name\""),
3171         title => "$cmd $name",
3172         name => "$cmd job=\"$name\"",
3173     }, "command.tpl");
3174 }
3175
3176 sub get_bconsole
3177 {
3178     my ($self) = @_;
3179     return new Bconsole(pref => $self->{info});
3180 }
3181
3182 sub run_job_select
3183 {
3184     my ($self) = @_;
3185     my $b = $self->get_bconsole();
3186
3187     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3188
3189     $self->display({ Jobs => $joblist }, "run_job.tpl");
3190 }
3191
3192 sub run_parse_job
3193 {
3194     my ($self, $ouput) = @_;
3195
3196     my %arg;
3197     foreach my $l (split(/\r\n/, $ouput)) {
3198         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3199             $arg{$1} = $2;
3200             $l = $3
3201                 if ($3) ;
3202         }
3203
3204         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3205             %arg = (%arg, @l);
3206         }
3207     }
3208
3209     my %lowcase ;
3210     foreach my $k (keys %arg) {
3211         $lowcase{lc($k)} = $arg{$k} ;
3212     }
3213
3214     return \%lowcase;
3215 }
3216
3217 sub run_job_mod
3218 {
3219     my ($self) = @_;
3220     my $b = $self->get_bconsole();
3221
3222     my $job = CGI::param('job') || '';
3223
3224     my $info = $b->send_cmd("show job=\"$job\"");
3225     my $attr = $self->run_parse_job($info);
3226
3227     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3228
3229     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3230     my $clients = [ map { { name => $_ } }$b->list_client()];
3231     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3232     my $storages= [ map { { name => $_ } }$b->list_storage()];
3233
3234     $self->display({
3235         jobs     => $jobs,
3236         pools    => $pools,
3237         clients  => $clients,
3238         filesets => $filesets,
3239         storages => $storages,
3240         %$attr,
3241     }, "run_job_mod.tpl");
3242 }
3243
3244 sub run_job
3245 {
3246     my ($self) = @_;
3247     my $b = $self->get_bconsole();
3248
3249     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3250
3251     $self->display({
3252         jobs     => $jobs,
3253     }, "run_job.tpl");
3254 }
3255
3256 sub run_job_now
3257 {
3258     my ($self) = @_;
3259     my $b = $self->get_bconsole();
3260
3261     # TODO: check input (don't use pool, level)
3262
3263     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3264     my $job = CGI::param('job') || '';
3265     my $storage = CGI::param('storage') || '';
3266
3267     my $jobid = $b->run(job => $job,
3268                         client => $arg->{client},
3269                         priority => $arg->{priority},
3270                         level => $arg->{level},
3271                         storage => $storage,
3272                         pool => $arg->{pool},
3273                         when => $arg->{when},
3274                         );
3275
3276     print $jobid, $b->{error};
3277
3278     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3279 }
3280
3281 1;