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     print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
 864     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
 865
 866     if ($? == 0) {
 867         my $content = $self->get_slot($src);
 868         print "$content ($src) => $dst<br/>";
 869         $self->{slot}->[$src] = 'empty';
 870         $self->set_slot($dst, $content);
 871         return 1;
 872     } else {
 873         $self->{error} = $out;
 874         return 0;
 875     }
 876 }
 877
 878 sub get_drive_name
 879 {
 880     my ($self, $index) = @_;
 881     return $self->{drive_name}->[$index];
 882 }
 883
 884 # TODO : do a tapeinfo request to get informations
 885 sub tapeinfo
 886 {
 887     my ($self) = @_;
 888 }
 889
 890 sub clear_io
 891 {
 892     my ($self) = @_;
 893
 894     for my $slot (@{$self->{io}})
 895     {
 896         if ($self->is_slot_loaded($slot)) {
 897             print "$slot is currently loaded\n";
 898             next;
 899         }
 900
 901         if ($self->slot_is_full($slot))
 902         {
 903             my $free = $self->slot_get_first_free() ;
 904             print "want to move $slot to $free\n";
 905
 906             if ($free) {
 907                 $self->transfer($slot, $free) || print "$self->{error}\n";
 908
 909             } else {
 910                 $self->{error} = "E : Can't find free slot";
 911             }
 912         }
 913     }
 914 }
 915
 916 # TODO : this is with mtx status output,
 917 # we can do an other function from bacula view (with StorageId)
 918 sub display_content
 919 {
 920     my ($self) = @_;
 921     my $bweb = $self->{bweb};
 922
 923     # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
 924     my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
 925
 926     my $query="
 927 SELECT Media.VolumeName  AS volumename,
 928        Media.VolStatus   AS volstatus,
 929        Media.LastWritten AS lastwritten,
 930        Media.VolBytes    AS volbytes,
 931        Media.MediaType   AS mediatype,
 932        Media.Slot        AS slot,
 933        Media.InChanger   AS inchanger,
 934        Pool.Name         AS name,
 935        $bweb->{sql}->{FROM_UNIXTIME}(
 936           $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
 937         + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
 938        ) AS expire
 939 FROM Media
 940  INNER JOIN Pool USING (PoolId)
 941
 942 WHERE Media.VolumeName IN ($media_list)
 943 ";
 944
 945     my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
 946
 947     # TODO : verify slot and bacula slot
 948     my $param = [];
 949     my @to_update;
 950
 951     for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
 952
 953         if ($self->slot_is_full($slot)) {
 954
 955             my $vol = $self->{slot}->[$slot];
 956             if (defined $all->{$vol}) {    # TODO : autochanger without barcodes
 957
 958                 my $bslot = $all->{$vol}->{slot} ;
 959                 my $inchanger = $all->{$vol}->{inchanger};
 960
 961                 # if bacula slot or inchanger flag is bad, we display a message
 962                 if ($bslot != $slot or !$inchanger) {
 963                     push @to_update, $slot;
 964                 }
 965
 966                 $all->{$vol}->{realslot} = $slot;
 967
 968                 push @{ $param }, $all->{$vol};
 969
 970             } else {            # empty or no label
 971                 push @{ $param }, {realslot => $slot,
 972                                    volstatus => 'Unknow',
 973                                    volumename => $self->{slot}->[$slot]} ;
 974             }
 975         } else {                # empty
 976             push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
 977         }
 978     }
 979
 980     my $i=0; my $drives = [] ;
 981     foreach my $d (@{ $self->{drive} }) {
 982         $drives->[$i] = { index => $i,
 983                           load  => $self->{drive}->[$i],
 984                           name  => $self->{drive_name}->[$i],
 985                       };
 986         $i++;
 987     }
 988
 989     $bweb->display({ Name   => $self->{name},
 990                      nb_drive => $self->{info}->{drive},
 991                      nb_io => $self->{info}->{io},
 992                      Drives => $drives,
 993                      Slots  => $param,
 994                      Update => scalar(@to_update) },
 995                    'ach_content.tpl');
 996
 997 }
 998
 999 1;
1000
1001
1002 ################################################################
1003
1004 package Bweb;
1005
1006 use base q/Bweb::Gui/;
1007
1008 =head1 PACKAGE
1009
1010     Bweb - main Bweb package
1011
1012 =head2
1013
1014     this package is use to compute and display informations
1015
1016 =cut
1017
1018 use DBI;
1019 use POSIX qw/strftime/;
1020
1021 our $config_file='/etc/bacula/bweb.conf';
1022
1023 our $cur_id=0;
1024
1025 =head1 VARIABLE
1026
1027     %sql_func - hash to make query mysql/postgresql compliant
1028
1029 =cut
1030
1031 our %sql_func = (
1032           Pg => {
1033               UNIX_TIMESTAMP => '',
1034               FROM_UNIXTIME => '',
1035               TO_SEC => " interval '1 second' * ",
1036               SEC_TO_INT => "SEC_TO_INT",
1037               SEC_TO_TIME => '',
1038               MATCH => " ~ ",
1039               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1040               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1041               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1042               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1043               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1044               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1045           },
1046           mysql => {
1047               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1048               FROM_UNIXTIME => 'FROM_UNIXTIME',
1049               SEC_TO_INT => '',
1050               TO_SEC => '',
1051               SEC_TO_TIME => 'SEC_TO_TIME',
1052               MATCH => " REGEXP ",
1053               STARTTIME_DAY  => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1054               STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1055               STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1056               STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1057               STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1058               STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1059           },
1060          );
1061
1062 sub dbh_selectall_arrayref
1063 {
1064     my ($self, $query) = @_;
1065     $self->connect_db();
1066     $self->debug($query);
1067     return $self->{dbh}->selectall_arrayref($query);
1068 }
1069
1070 sub dbh_join
1071 {
1072     my ($self, @what) = @_;
1073     return join(',', $self->dbh_quote(@what)) ;
1074 }
1075
1076 sub dbh_quote
1077 {
1078     my ($self, @what) = @_;
1079
1080     $self->connect_db();
1081     if (wantarray) {
1082         return map { $self->{dbh}->quote($_) } @what;
1083     } else {
1084         return $self->{dbh}->quote($what[0]) ;
1085     }
1086 }
1087
1088 sub dbh_do
1089 {
1090     my ($self, $query) = @_ ;
1091     $self->connect_db();
1092     $self->debug($query);
1093     return $self->{dbh}->do($query);
1094 }
1095
1096 sub dbh_selectall_hashref
1097 {
1098     my ($self, $query, $join) = @_;
1099
1100     $self->connect_db();
1101     $self->debug($query);
1102     return $self->{dbh}->selectall_hashref($query, $join) ;
1103 }
1104
1105 sub dbh_selectrow_hashref
1106 {
1107     my ($self, $query) = @_;
1108
1109     $self->connect_db();
1110     $self->debug($query);
1111     return $self->{dbh}->selectrow_hashref($query) ;
1112 }
1113
1114 # display Mb/Gb/Kb
1115 sub human_size
1116 {
1117     my @unit = qw(b Kb Mb Gb Tb);
1118     my $val = shift || 0;
1119     my $i=0;
1120     my $format = '%i %s';
1121     while ($val / 1024 > 1) {
1122         $i++;
1123         $val /= 1024;
1124     }
1125     $format = ($i>0)?'%0.1f %s':'%i %s';
1126     return sprintf($format, $val, $unit[$i]);
1127 }
1128
1129 # display Day, Hour, Year
1130 sub human_sec
1131 {
1132     use integer;
1133
1134     my $val = shift;
1135     $val /= 60;                 # sec -> min
1136
1137     if ($val / 60 <= 1) {
1138         return "$val mins";
1139     }
1140
1141     $val /= 60;                 # min -> hour
1142     if ($val / 24 <= 1) {
1143         return "$val hours";
1144     }
1145
1146     $val /= 24;                 # hour -> day
1147     if ($val / 365 < 2) {
1148         return "$val days";
1149     }
1150
1151     $val /= 365 ;               # day -> year
1152
1153     return "$val years";
1154 }
1155
1156 # get Day, Hour, Year
1157 sub from_human_sec
1158 {
1159     use integer;
1160
1161     my $val = shift;
1162     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1163         return 0;
1164     }
1165
1166     my %times = ( m   => 60,
1167                   h   => 60*60,
1168                   d   => 60*60*24,
1169                   m   => 60*60*24*31,
1170                   y   => 60*60*24*365,
1171                   );
1172     my $mult = $times{$2} || 0;
1173
1174     return $1 * $mult;
1175 }
1176
1177
1178 sub connect_db
1179 {
1180     my ($self) = @_;
1181
1182     unless ($self->{dbh}) {
1183         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1184                                     $self->{info}->{user},
1185                                     $self->{info}->{password});
1186
1187         $self->error("Can't connect to your database:\n$DBI::errstr\n")
1188             unless ($self->{dbh});
1189
1190         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1191
1192         if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1193             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1194         }
1195     }
1196 }
1197
1198 sub new
1199 {
1200     my ($class, %arg) = @_;
1201     my $self = bless {
1202         dbh => undef,           # connect_db();
1203         info => {
1204             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1205             user  => 'bacula',
1206             password => 'test',
1207         },
1208     } ;
1209
1210     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1211
1212     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1213         $self->{sql} = $sql_func{$1};
1214     }
1215
1216     $self->{debug} = $self->{info}->{debug};
1217     $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1218
1219     return $self;
1220 }
1221
1222 sub display_begin
1223 {
1224     my ($self) = @_;
1225     $self->display($self->{info}, "begin.tpl");
1226 }
1227
1228 sub display_end
1229 {
1230     my ($self) = @_;
1231     $self->display($self->{info}, "end.tpl");
1232 }
1233
1234 sub display_clients
1235 {
1236     my ($self) = @_;
1237
1238     my $where='';
1239     my $arg = $self->get_form("client", "qre_client");
1240
1241     if ($arg->{qre_client}) {
1242         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1243     } elsif ($arg->{client}) {
1244         $where = "WHERE Name = '$arg->{client}' ";
1245     }
1246
1247     my $query = "
1248 SELECT Name   AS name,
1249        Uname  AS uname,
1250        AutoPrune AS autoprune,
1251        FileRetention AS fileretention,
1252        JobRetention  AS jobretention
1253 FROM Client
1254 $where
1255 ";
1256
1257     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1258
1259     my $dsp = { ID => $cur_id++,
1260                 clients => [ values %$all] };
1261
1262     $self->display($dsp, "client_list.tpl") ;
1263 }
1264
1265 sub get_limit
1266 {
1267     my ($self, %arg) = @_;
1268
1269     my $limit = '';
1270     my $label = '';
1271
1272     if ($arg{age}) {
1273         $limit =
1274   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1275          >
1276        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1277          -
1278          $self->{sql}->{TO_SEC}($arg{age})
1279        )" ;
1280
1281         $label = "last " . human_sec($arg{age});
1282     }
1283
1284     if ($arg{groupby}) {
1285         $limit .= " GROUP BY $arg{groupby} ";
1286     }
1287
1288     if ($arg{order}) {
1289         $limit .= " ORDER BY $arg{order} ";
1290     }
1291
1292     if ($arg{limit}) {
1293         $limit .= " LIMIT $arg{limit} ";
1294         $label .= " limited to $arg{limit}";
1295     }
1296
1297     if ($arg{offset}) {
1298         $limit .= " OFFSET $arg{offset} ";
1299         $label .= " with $arg{offset} offset ";
1300     }
1301
1302     unless ($label) {
1303         $label = 'no filter';
1304     }
1305
1306     return ($limit, $label);
1307 }
1308
1309 =head1 FUNCTION
1310
1311     $bweb->get_form(...) - Get useful stuff
1312
1313 =head2 DESCRIPTION
1314
1315     This function get and check parameters against regexp.
1316
1317     If word begin with 'q', the return will be quoted or join quoted
1318     if it's end with 's'.
1319
1320
1321 =head2 EXAMPLE
1322
1323     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1324
1325     { jobid    => 12,
1326       qclient  => 'plume-fd',
1327       qpools   => "'plume-fd', 'test-fd', '...'",
1328     }
1329
1330 =cut
1331
1332 sub get_form
1333 {
1334     my ($self, @what) = @_;
1335     my %what = map { $_ => 1 } @what;
1336     my %ret;
1337
1338     my %opt_i = (
1339                  limit  => 100,
1340                  cost   =>  10,
1341                  offset =>   0,
1342                  width  => 640,
1343                  height => 480,
1344                  jobid  =>   0,
1345                  slot   =>   0,
1346                  drive  =>   0,
1347                  priority => 10,
1348                  age    => 60*60*24*7,
1349                  days   => 1,
1350                  maxvoljobs  => 0,
1351                  maxvolbytes => 0,
1352                  maxvolfiles => 0,
1353                  );
1354
1355     my %opt_ss =(               # string with space
1356                  job     => 1,
1357                  storage => 1,
1358                  );
1359     my %opt_s = (               # default to ''
1360                  ach    => 1,
1361                  status => 1,
1362                  volstatus => 1,
1363                  inchanger => 1,
1364                  client => 1,
1365                  level  => 1,
1366                  pool   => 1,
1367                  media  => 1,
1368                  ach    => 1,
1369                  jobtype=> 1,
1370                  graph  => 1,
1371                  gtype  => 1,
1372                  type   => 1,
1373                  poolrecycle => 1,
1374                  replace => 1,
1375                  );
1376     my %opt_p = (               # option with path
1377                  fileset=> 1,
1378                  mtxcmd => 1,
1379                  precmd => 1,
1380                  device => 1,
1381                  where  => 1,
1382                  );
1383
1384     my %opt_d = (               # option with date
1385                  voluseduration=> 1,
1386                  volretention => 1,
1387                 );
1388
1389     foreach my $i (@what) {
1390         if (exists $opt_i{$i}) {# integer param
1391             my $value = CGI::param($i) || $opt_i{$i} ;
1392             if ($value =~ /^(\d+)$/) {
1393                 $ret{$i} = $1;
1394             }
1395         } elsif ($opt_s{$i}) {  # simple string param
1396             my $value = CGI::param($i) || '';
1397             if ($value =~ /^([\w\d\.-]+)$/) {
1398                 $ret{$i} = $1;
1399             }
1400         } elsif ($opt_ss{$i}) { # simple string param (with space)
1401             my $value = CGI::param($i) || '';
1402             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1403                 $ret{$i} = $1;
1404             }
1405         } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1406             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1407             if (@value) {
1408                 $ret{$i} = $self->dbh_join(@value) ;
1409             }
1410
1411         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1412             my $value = CGI::param($1) ;
1413             if ($value) {
1414                 $ret{$i} = $self->dbh_quote($value);
1415             }
1416
1417         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1418             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1419                                            grep { ! /^\s*$/ } CGI::param($1) ];
1420         } elsif (exists $opt_p{$i}) {
1421             my $value = CGI::param($i) || '';
1422             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1423                 $ret{$i} = $1;
1424             }
1425         } elsif (exists $opt_d{$i}) {
1426             my $value = CGI::param($i) || '';
1427             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1428                 $ret{$i} = $1;
1429             }
1430         }
1431     }
1432
1433     if ($what{slots}) {
1434         foreach my $s (CGI::param('slot')) {
1435             if ($s =~ /^(\d+)$/) {
1436                 push @{$ret{slots}}, $s;
1437             }
1438         }
1439     }
1440
1441     if ($what{when}) {
1442         my $when = CGI::param('when') || '';
1443         if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1444             $ret{when} = $1;
1445         }
1446     }
1447
1448     if ($what{db_clients}) {
1449         my $query = "
1450 SELECT Client.Name as clientname
1451 FROM Client
1452 ";
1453
1454         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1455         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1456                               values %$clients] ;
1457     }
1458
1459     if ($what{db_mediatypes}) {
1460         my $query = "
1461 SELECT MediaType as mediatype
1462 FROM MediaType
1463 ";
1464
1465         my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1466         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1467                                   values %$medias] ;
1468     }
1469
1470     if ($what{db_locations}) {
1471         my $query = "
1472 SELECT Location as location, Cost as cost FROM Location
1473 ";
1474         my $loc = $self->dbh_selectall_hashref($query, 'location');
1475         $ret{db_locations} = [ sort { $a->{location}
1476                                       cmp
1477                                       $b->{location}
1478                                   } values %$loc ];
1479     }
1480
1481     if ($what{db_pools}) {
1482         my $query = "SELECT Name as name FROM Pool";
1483
1484         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1485         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1486     }
1487
1488     if ($what{db_filesets}) {
1489         my $query = "
1490 SELECT FileSet.FileSet AS fileset
1491 FROM FileSet
1492 ";
1493
1494         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1495
1496         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1497                                values %$filesets] ;
1498     }
1499
1500     if ($what{db_jobnames}) {
1501         my $query = "
1502 SELECT DISTINCT Job.Name AS jobname
1503 FROM Job
1504 ";
1505
1506         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1507
1508         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1509                                values %$jobnames] ;
1510     }
1511
1512     if ($what{db_devices}) {
1513         my $query = "
1514 SELECT Device.Name AS name
1515 FROM Device
1516 ";
1517
1518         my $devices = $self->dbh_selectall_hashref($query, 'name');
1519
1520         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1521                                values %$devices] ;
1522     }
1523
1524     return \%ret;
1525 }
1526
1527 sub display_graph
1528 {
1529     my ($self) = @_;
1530
1531     my $fields = $self->get_form(qw/age level status clients filesets
1532                                     graph gtype type
1533                                     db_clients limit db_filesets width height
1534                                     qclients qfilesets qjobnames db_jobnames/);
1535
1536
1537     my $url = CGI::url(-full => 0,
1538                        -base => 0,
1539                        -query => 1);
1540     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1541
1542 # this organisation is to keep user choice between 2 click
1543 # TODO : fileset and client selection doesn't work
1544
1545     $self->display({
1546         url => $url,
1547         %$fields,
1548     }, "graph.tpl")
1549
1550 }
1551
1552 sub display_client_job
1553 {
1554     my ($self, %arg) = @_ ;
1555
1556     $arg{order} = ' Job.JobId DESC ';
1557     my ($limit, $label) = $self->get_limit(%arg);
1558
1559     my $clientname = $self->dbh_quote($arg{clientname});
1560
1561     my $query="
1562 SELECT DISTINCT Job.JobId       AS jobid,
1563                 Job.Name        AS jobname,
1564                 FileSet.FileSet AS fileset,
1565                 Level           AS level,
1566                 StartTime       AS starttime,
1567                 JobFiles        AS jobfiles,
1568                 JobBytes        AS jobbytes,
1569                 JobStatus       AS jobstatus,
1570                 JobErrors       AS joberrors
1571
1572  FROM Client,Job,FileSet
1573  WHERE Client.Name=$clientname
1574  AND Client.ClientId=Job.ClientId
1575  AND Job.FileSetId=FileSet.FileSetId
1576  $limit
1577 ";
1578
1579     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1580
1581     $self->display({ clientname => $arg{clientname},
1582                      Filter => $label,
1583                      ID => $cur_id++,
1584                      Jobs => [ values %$all ],
1585                    },
1586                    "display_client_job.tpl") ;
1587 }
1588
1589 sub get_selected_media_location
1590 {
1591     my ($self) = @_ ;
1592
1593     my $medias = $self->get_form('jmedias');
1594
1595     unless ($medias->{jmedias}) {
1596         return undef;
1597     }
1598
1599     my $query = "
1600 SELECT Media.VolumeName AS volumename, Location.Location AS location
1601 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1602 WHERE Media.VolumeName IN ($medias->{jmedias})
1603 ";
1604
1605     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1606
1607     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1608     #               ..
1609     #             }
1610     # }
1611     return $all;
1612 }
1613
1614 sub move_media
1615 {
1616     my ($self) = @_ ;
1617
1618     my $medias = $self->get_selected_media_location();
1619
1620     unless ($medias) {
1621         return ;
1622     }
1623
1624     my $elt = $self->get_form('db_locations');
1625
1626     $self->display({ ID => $cur_id++,
1627                      %$elt,     # db_locations
1628                      medias => [
1629             sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1630                                ],
1631                      },
1632                    "move_media.tpl");
1633 }
1634
1635 sub help_extern
1636 {
1637     my ($self) = @_ ;
1638
1639     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1640     $self->debug($elt);
1641     $self->display($elt, "help_extern.tpl");
1642 }
1643
1644 sub help_extern_compute
1645 {
1646     my ($self) = @_;
1647
1648     my $number = CGI::param('limit') || '' ;
1649     unless ($number =~ /^(\d+)$/) {
1650         return $self->error("Bad arg number : $number ");
1651     }
1652
1653     my ($sql, undef) = $self->get_param('pools',
1654                                         'locations', 'mediatypes');
1655
1656     my $query = "
1657 SELECT Media.VolumeName  AS volumename,
1658        Media.VolStatus   AS volstatus,
1659        Media.LastWritten AS lastwritten,
1660        Media.MediaType   AS mediatype,
1661        Media.VolMounts   AS volmounts,
1662        Pool.Name         AS name,
1663        Media.Recycle     AS recycle,
1664        $self->{sql}->{FROM_UNIXTIME}(
1665           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1666         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1667        ) AS expire
1668 FROM Media
1669  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1670  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1671
1672 WHERE Media.InChanger = 1
1673   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1674   $sql
1675 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1676 LIMIT $number
1677 " ;
1678
1679     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1680
1681     $self->display({ Medias => [ values %$all ] },
1682                    "help_extern_compute.tpl");
1683 }
1684
1685 sub help_intern
1686 {
1687     my ($self) = @_ ;
1688
1689     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1690     $self->display($param, "help_intern.tpl");
1691 }
1692
1693 sub help_intern_compute
1694 {
1695     my ($self) = @_;
1696
1697     my $number = CGI::param('limit') || '' ;
1698     unless ($number =~ /^(\d+)$/) {
1699         return $self->error("Bad arg number : $number ");
1700     }
1701
1702     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1703
1704     if (CGI::param('expired')) {
1705         $sql = "
1706 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1707        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1708     ) < NOW()
1709  " . $sql ;
1710     }
1711
1712     my $query = "
1713 SELECT Media.VolumeName  AS volumename,
1714        Media.VolStatus   AS volstatus,
1715        Media.LastWritten AS lastwritten,
1716        Media.MediaType   AS mediatype,
1717        Media.VolMounts   AS volmounts,
1718        Pool.Name         AS name,
1719        $self->{sql}->{FROM_UNIXTIME}(
1720           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1721         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1722        ) AS expire
1723 FROM Media
1724  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1725  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1726
1727 WHERE Media.InChanger <> 1
1728   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1729   AND Media.Recycle = 1
1730   $sql
1731 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1732 LIMIT $number
1733 " ;
1734
1735     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1736
1737     $self->display({ Medias => [ values %$all ] },
1738                    "help_intern_compute.tpl");
1739
1740 }
1741
1742 sub display_general
1743 {
1744     my ($self, %arg) = @_ ;
1745
1746     my ($limit, $label) = $self->get_limit(%arg);
1747
1748     my $query = "
1749 SELECT
1750     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1751     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1752     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1753     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1754     (SELECT count(Job.JobId)
1755       FROM Job
1756       WHERE Job.JobStatus IN ('E','e','f','A')
1757       $limit
1758     )                                         AS nb_err,
1759     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1760 ";
1761
1762     my $row = $self->dbh_selectrow_hashref($query) ;
1763
1764     $row->{nb_bytes} = human_size($row->{nb_bytes});
1765
1766     $row->{db_size} = '???';
1767     $row->{label} = $label;
1768
1769     $self->display($row, "general.tpl");
1770 }
1771
1772 sub get_param
1773 {
1774     my ($self, @what) = @_ ;
1775     my %elt = map { $_ => 1 } @what;
1776     my %ret;
1777
1778     my $limit = '';
1779
1780     if ($elt{clients}) {
1781         my @clients = grep { ! /^\s*$/ } CGI::param('client');
1782         if (@clients) {
1783             $ret{clients} = \@clients;
1784             my $str = $self->dbh_join(@clients);
1785             $limit .= "AND Client.Name IN ($str) ";
1786         }
1787     }
1788
1789     if ($elt{filesets}) {
1790         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1791         if (@filesets) {
1792             $ret{filesets} = \@filesets;
1793             my $str = $self->dbh_join(@filesets);
1794             $limit .= "AND FileSet.FileSet IN ($str) ";
1795         }
1796     }
1797
1798     if ($elt{mediatypes}) {
1799         my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1800         if (@medias) {
1801             $ret{mediatypes} = \@medias;
1802             my $str = $self->dbh_join(@medias);
1803             $limit .= "AND Media.MediaType IN ($str) ";
1804         }
1805     }
1806
1807     if ($elt{client}) {
1808         my $client = CGI::param('client');
1809         $ret{client} = $client;
1810         $client = $self->dbh_join($client);
1811         $limit .= "AND Client.Name = $client ";
1812     }
1813
1814     if ($elt{level}) {
1815         my $level = CGI::param('level') || '';
1816         if ($level =~ /^(\w)$/) {
1817             $ret{level} = $1;
1818             $limit .= "AND Job.Level = '$1' ";
1819         }
1820     }
1821
1822     if ($elt{jobid}) {
1823         my $jobid = CGI::param('jobid') || '';
1824
1825         if ($jobid =~ /^(\d+)$/) {
1826             $ret{jobid} = $1;
1827             $limit .= "AND Job.JobId = '$1' ";
1828         }
1829     }
1830
1831     if ($elt{status}) {
1832         my $status = CGI::param('status') || '';
1833         if ($status =~ /^(\w)$/) {
1834             $ret{status} = $1;
1835             if ($1 eq 'f') {
1836                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1837             } else {
1838                 $limit .= "AND Job.JobStatus = '$1' ";
1839             }
1840         }
1841     }
1842
1843     if ($elt{volstatus}) {
1844         my $status = CGI::param('volstatus') || '';
1845         if ($status =~ /^(\w+)$/) {
1846             $ret{status} = $1;
1847             $limit .= "AND Media.VolStatus = '$1' ";
1848         }
1849     }
1850
1851     if ($elt{locations}) {
1852         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1853         if (@location) {
1854             $ret{locations} = \@location;
1855             my $str = $self->dbh_join(@location);
1856             $limit .= "AND Location.Location IN ($str) ";
1857         }
1858     }
1859
1860     if ($elt{pools}) {
1861         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1862         if (@pool) {
1863             $ret{pools} = \@pool;
1864             my $str = $self->dbh_join(@pool);
1865             $limit .= "AND Pool.Name IN ($str) ";
1866         }
1867     }
1868
1869     if ($elt{location}) {
1870         my $location = CGI::param('location') || '';
1871         if ($location) {
1872             $ret{location} = $location;
1873             $location = $self->dbh_quote($location);
1874             $limit .= "AND Location.Location = $location ";
1875         }
1876     }
1877
1878     if ($elt{pool}) {
1879         my $pool = CGI::param('pool') || '';
1880         if ($pool) {
1881             $ret{pool} = $pool;
1882             $pool = $self->dbh_quote($pool);
1883             $limit .= "AND Pool.Name = $pool ";
1884         }
1885     }
1886
1887     if ($elt{jobtype}) {
1888         my $jobtype = CGI::param('jobtype') || '';
1889         if ($jobtype =~ /^(\w)$/) {
1890             $ret{jobtype} = $1;
1891             $limit .= "AND Job.Type = '$1' ";
1892         }
1893     }
1894
1895     return ($limit, %ret);
1896 }
1897
1898 =head1
1899
1900     get last backup
1901
1902 =cut
1903
1904 sub display_job
1905 {
1906     my ($self, %arg) = @_ ;
1907
1908     $arg{order} = ' Job.JobId DESC ';
1909
1910     my ($limit, $label) = $self->get_limit(%arg);
1911     my ($where, undef) = $self->get_param('clients',
1912                                           'level',
1913                                           'filesets',
1914                                           'jobtype',
1915                                           'pools',
1916                                           'jobid',
1917                                           'status');
1918
1919     my $query="
1920 SELECT  Job.JobId       AS jobid,
1921         Client.Name     AS client,
1922         FileSet.FileSet AS fileset,
1923         Job.Name        AS jobname,
1924         Level           AS level,
1925         StartTime       AS starttime,
1926         Pool.Name       AS poolname,
1927         JobFiles        AS jobfiles,
1928         JobBytes        AS jobbytes,
1929         JobStatus       AS jobstatus,
1930      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1931                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1932                         AS duration,
1933
1934         JobErrors       AS joberrors
1935
1936  FROM Client,
1937       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1938           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1939  WHERE Client.ClientId=Job.ClientId
1940    AND Job.JobStatus != 'R'
1941  $where
1942  $limit
1943 ";
1944
1945     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1946
1947     $self->display({ Filter => $label,
1948                      ID => $cur_id++,
1949                      Jobs =>
1950                            [
1951                              sort { $a->{jobid} <=>  $b->{jobid} }
1952                                         values %$all
1953                              ],
1954                    },
1955                    "display_job.tpl");
1956 }
1957
1958 # display job informations
1959 sub display_job_zoom
1960 {
1961     my ($self, $jobid) = @_ ;
1962
1963     $jobid = $self->dbh_quote($jobid);
1964
1965     my $query="
1966 SELECT DISTINCT Job.JobId       AS jobid,
1967                 Client.Name     AS client,
1968                 Job.Name        AS jobname,
1969                 FileSet.FileSet AS fileset,
1970                 Level           AS level,
1971                 Pool.Name       AS poolname,
1972                 StartTime       AS starttime,
1973                 JobFiles        AS jobfiles,
1974                 JobBytes        AS jobbytes,
1975                 JobStatus       AS jobstatus,
1976                 JobErrors       AS joberrors,
1977                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1978                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1979
1980  FROM Client,
1981       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1982           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1983  WHERE Client.ClientId=Job.ClientId
1984  AND Job.JobId = $jobid
1985 ";
1986
1987     my $row = $self->dbh_selectrow_hashref($query) ;
1988
1989     # display all volumes associate with this job
1990     $query="
1991 SELECT Media.VolumeName as volumename
1992 FROM Job,Media,JobMedia
1993 WHERE Job.JobId = $jobid
1994  AND JobMedia.JobId=Job.JobId
1995  AND JobMedia.MediaId=Media.MediaId
1996 ";
1997
1998     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1999
2000     $row->{volumes} = [ values %$all ] ;
2001
2002     $self->display($row, "display_job_zoom.tpl");
2003 }
2004
2005 sub display_media
2006 {
2007     my ($self) = @_ ;
2008
2009     my ($where, %elt) = $self->get_param('pools',
2010                                          'mediatypes',
2011                                          'volstatus',
2012                                          'locations');
2013
2014     my $arg = $self->get_form('jmedias', 'qre_media');
2015
2016     if ($arg->{jmedias}) {
2017         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2018     }
2019     if ($arg->{qre_media}) {
2020         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2021     }
2022
2023     my $query="
2024 SELECT Media.VolumeName  AS volumename,
2025        Media.VolBytes    AS volbytes,
2026        Media.VolStatus   AS volstatus,
2027        Media.MediaType   AS mediatype,
2028        Media.InChanger   AS online,
2029        Media.LastWritten AS lastwritten,
2030        Location.Location AS location,
2031        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2032        Pool.Name         AS poolname,
2033        $self->{sql}->{FROM_UNIXTIME}(
2034           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2035         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2036        ) AS expire
2037 FROM      Pool, Media
2038 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2039 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2040                   Media.MediaType     AS MediaType
2041            FROM Media
2042           WHERE Media.VolStatus = 'Full'
2043           GROUP BY Media.MediaType
2044            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2045
2046 WHERE Media.PoolId=Pool.PoolId
2047 $where
2048 ";
2049
2050     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2051
2052     $self->display({ ID => $cur_id++,
2053                      Pool => $elt{pool},
2054                      Location => $elt{location},
2055                      Medias => [ values %$all ]
2056                    },
2057                    "display_media.tpl");
2058 }
2059
2060 sub display_medias
2061 {
2062     my ($self) = @_ ;
2063
2064     my $pool = $self->get_form('db_pools');
2065
2066     foreach my $name (@{ $pool->{db_pools} }) {
2067         CGI::param('pool', $name->{name});
2068         $self->display_media();
2069     }
2070 }
2071
2072 sub display_media_zoom
2073 {
2074     my ($self) = @_ ;
2075
2076     my $medias = $self->get_form('jmedias');
2077
2078     unless ($medias->{jmedias}) {
2079         return $self->error("Can't get media selection");
2080     }
2081
2082     my $query="
2083 SELECT InChanger     AS online,
2084        VolBytes      AS nb_bytes,
2085        VolumeName    AS volumename,
2086        VolStatus     AS volstatus,
2087        VolMounts     AS nb_mounts,
2088        Media.VolUseDuration   AS voluseduration,
2089        Media.MaxVolJobs AS maxvoljobs,
2090        Media.MaxVolFiles AS maxvolfiles,
2091        Media.MaxVolBytes AS maxvolbytes,
2092        VolErrors     AS nb_errors,
2093        Pool.Name     AS poolname,
2094        Location.Location AS location,
2095        Media.Recycle AS recycle,
2096        Media.VolRetention AS volretention,
2097        Media.LastWritten  AS lastwritten,
2098        Media.VolReadTime/1000000  AS volreadtime,
2099        Media.VolWriteTime/1000000 AS volwritetime,
2100        Media.RecycleCount AS recyclecount,
2101        Media.Comment      AS comment,
2102        $self->{sql}->{FROM_UNIXTIME}(
2103           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2104         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2105        ) AS expire
2106  FROM Pool,
2107       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2108  WHERE Pool.PoolId = Media.PoolId
2109  AND VolumeName IN ($medias->{jmedias})
2110 ";
2111
2112     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2113
2114     foreach my $media (values %$all) {
2115         my $mq = $self->dbh_quote($media->{volumename});
2116
2117         $query = "
2118 SELECT DISTINCT Job.JobId AS jobid,
2119                 Job.Name  AS name,
2120                 Job.StartTime AS starttime,
2121                 Job.Type  AS type,
2122                 Job.Level AS level,
2123                 Job.JobFiles AS files,
2124                 Job.JobBytes AS bytes,
2125                 Job.jobstatus AS status
2126  FROM Media,JobMedia,Job
2127  WHERE Media.VolumeName=$mq
2128  AND Media.MediaId=JobMedia.MediaId
2129  AND JobMedia.JobId=Job.JobId
2130 ";
2131
2132         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2133
2134         $query = "
2135 SELECT LocationLog.Date    AS date,
2136        Location.Location   AS location,
2137        LocationLog.Comment AS comment
2138  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2139  WHERE Media.MediaId = LocationLog.MediaId
2140    AND Media.VolumeName = $mq
2141 ";
2142
2143         my $logtxt = '';
2144         my $log = $self->dbh_selectall_arrayref($query) ;
2145         if ($log) {
2146             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2147         }
2148
2149         $self->display({ jobs => [ values %$jobs ],
2150                          LocationLog => $logtxt,
2151                          %$media },
2152                        "display_media_zoom.tpl");
2153     }
2154 }
2155
2156 sub location_edit
2157 {
2158     my ($self) = @_ ;
2159
2160     my $loc = $self->get_form('qlocation');
2161     unless ($loc->{qlocation}) {
2162         return $self->error("Can't get location");
2163     }
2164
2165     my $query = "
2166 SELECT Location.Location AS location,
2167        Location.Cost   AS cost,
2168        Location.Enabled AS enabled
2169 FROM Location
2170 WHERE Location.Location = $loc->{qlocation}
2171 ";
2172
2173     my $row = $self->dbh_selectrow_hashref($query);
2174
2175     $self->display({ ID => $cur_id++,
2176                      %$row }, "location_edit.tpl") ;
2177
2178 }
2179
2180 sub location_save
2181 {
2182     my ($self) = @_ ;
2183
2184     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2185     unless ($arg->{qlocation}) {
2186         return $self->error("Can't get location");
2187     }
2188     unless ($arg->{qnewlocation}) {
2189         return $self->error("Can't get new location name");
2190     }
2191     unless ($arg->{cost}) {
2192         return $self->error("Can't get new cost");
2193     }
2194
2195     my $enabled = CGI::param('enabled') || '';
2196     $enabled = $enabled?1:0;
2197
2198     my $query = "
2199 UPDATE Location SET Cost     = $arg->{cost},
2200                     Location = $arg->{qnewlocation},
2201                     Enabled   = $enabled
2202 WHERE Location.Location = $arg->{qlocation}
2203 ";
2204
2205     $self->dbh_do($query);
2206
2207     $self->display_location();
2208 }
2209
2210 sub location_del
2211 {
2212     my ($self) = @_ ;
2213     my $arg = $self->get_form(qw/qlocation/) ;
2214
2215     unless ($arg->{qlocation}) {
2216         return $self->error("Can't get location");
2217     }
2218
2219     my $query = "
2220 SELECT count(Media.MediaId) AS nb
2221   FROM Media INNER JOIN Location USING (LocationID)
2222 WHERE Location = $arg->{qlocation}
2223 ";
2224
2225     my $res = $self->dbh_selectrow_hashref($query);
2226
2227     if ($res->{nb}) {
2228         return $self->error("Sorry, the location must be empty");
2229     }
2230
2231     $query = "
2232 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2233 ";
2234
2235     $self->dbh_do($query);
2236
2237     $self->display_location();
2238 }
2239
2240
2241 sub location_add
2242 {
2243     my ($self) = @_ ;
2244     my $arg = $self->get_form(qw/qlocation cost/) ;
2245
2246     unless ($arg->{qlocation}) {
2247         $self->display({}, "location_add.tpl");
2248         return 1;
2249     }
2250     unless ($arg->{cost}) {
2251         return $self->error("Can't get new cost");
2252     }
2253
2254     my $enabled = CGI::param('enabled') || '';
2255     $enabled = $enabled?1:0;
2256
2257     my $query = "
2258 INSERT INTO Location (Location, Cost, Enabled)
2259        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2260 ";
2261
2262     $self->dbh_do($query);
2263
2264     $self->display_location();
2265 }
2266
2267 sub display_location
2268 {
2269     my ($self) = @_ ;
2270
2271     my $query = "
2272 SELECT Location.Location AS location,
2273        Location.Cost     AS cost,
2274        Location.Enabled  AS enabled,
2275        (SELECT count(Media.MediaId)
2276          FROM Media
2277         WHERE Media.LocationId = Location.LocationId
2278        ) AS volnum
2279 FROM Location
2280 ";
2281
2282     my $location = $self->dbh_selectall_hashref($query, 'location');
2283
2284     $self->display({ ID => $cur_id++,
2285                      Locations => [ values %$location ] },
2286                    "display_location.tpl");
2287 }
2288
2289 sub update_location
2290 {
2291     my ($self) = @_ ;
2292
2293     my $medias = $self->get_selected_media_location();
2294     unless ($medias) {
2295         return ;
2296     }
2297
2298     my $arg = $self->get_form('db_locations', 'qnewlocation');
2299
2300     $self->display({ email  => $self->{info}->{email_media},
2301                      %$arg,
2302                      medias => [ values %$medias ],
2303                    },
2304                    "update_location.tpl");
2305 }
2306
2307 sub get_media_max_size
2308 {
2309     my ($self, $type) = @_;
2310     my $query =
2311 "SELECT avg(VolBytes) AS size
2312   FROM Media
2313  WHERE Media.VolStatus = 'Full'
2314    AND Media.MediaType = '$type'
2315 ";
2316
2317     my $res = $self->selectrow_hashref($query);
2318
2319     if ($res) {
2320         return $res->{size};
2321     } else {
2322         return 0;
2323     }
2324 }
2325
2326 sub update_media
2327 {
2328     my ($self) = @_ ;
2329
2330     my $media = $self->get_form('qmedia');
2331
2332     unless ($media->{qmedia}) {
2333         return $self->error("Can't get media");
2334     }
2335
2336     my $query = "
2337 SELECT Media.Slot         AS slot,
2338        PoolMedia.Name     AS poolname,
2339        Media.VolStatus    AS volstatus,
2340        Media.InChanger    AS inchanger,
2341        Location.Location  AS location,
2342        Media.VolumeName   AS volumename,
2343        Media.MaxVolBytes  AS maxvolbytes,
2344        Media.MaxVolJobs   AS maxvoljobs,
2345        Media.MaxVolFiles  AS maxvolfiles,
2346        Media.VolUseDuration AS voluseduration,
2347        Media.VolRetention AS volretention,
2348        Media.Comment      AS comment,
2349        PoolRecycle.Name   AS poolrecycle
2350
2351 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2352            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2353            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2354
2355 WHERE Media.VolumeName = $media->{qmedia}
2356 ";
2357
2358     my $row = $self->dbh_selectrow_hashref($query);
2359     $row->{volretention} = human_sec($row->{volretention});
2360     $row->{voluseduration} = human_sec($row->{voluseduration});
2361
2362     my $elt = $self->get_form(qw/db_pools db_locations/);
2363
2364     $self->display({
2365         %$elt,
2366         %$row,
2367     }, "update_media.tpl");
2368 }
2369
2370 sub save_location
2371 {
2372     my ($self) = @_ ;
2373
2374     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2375
2376     unless ($arg->{jmedias}) {
2377         return $self->error("Can't get selected media");
2378     }
2379
2380     unless ($arg->{qnewlocation}) {
2381         return $self->error("Can't get new location");
2382     }
2383
2384     my $query = "
2385  UPDATE Media
2386      SET LocationId = (SELECT LocationId
2387                        FROM Location
2388                        WHERE Location = $arg->{qnewlocation})
2389      WHERE Media.VolumeName IN ($arg->{jmedias})
2390 ";
2391
2392     my $nb = $self->dbh_do($query);
2393
2394     print "$nb media updated, you may have to update your autochanger.";
2395
2396     $self->display_media();
2397 }
2398
2399 sub change_location
2400 {
2401     my ($self) = @_ ;
2402
2403     my $medias = $self->get_selected_media_location();
2404     unless ($medias) {
2405         return $self->error("Can't get media selection");
2406     }
2407     my $newloc = CGI::param('newlocation');
2408
2409     my $user = CGI::param('user') || 'unknow';
2410     my $comm = CGI::param('comment') || '';
2411     $comm = $self->dbh_quote("$user: $comm");
2412
2413     my $query;
2414
2415     foreach my $media (keys %$medias) {
2416         $query = "
2417 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2418  VALUES(
2419        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2420        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2421        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2422       )
2423 ";
2424         $self->dbh_do($query);
2425         $self->debug($query);
2426     }
2427
2428     my $q = new CGI;
2429     $q->param('action', 'update_location');
2430     my $url = $q->url(-full => 1, -query=>1);
2431
2432     $self->display({ email  => $self->{info}->{email_media},
2433                      url => $url,
2434                      newlocation => $newloc,
2435                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2436                      medias => [ values %$medias ],
2437                    },
2438                    "change_location.tpl");
2439
2440 }
2441
2442 sub display_client_stats
2443 {
2444     my ($self, %arg) = @_ ;
2445
2446     my $client = $self->dbh_quote($arg{clientname});
2447     my ($limit, $label) = $self->get_limit(%arg);
2448
2449     my $query = "
2450 SELECT
2451     count(Job.JobId)     AS nb_jobs,
2452     sum(Job.JobBytes)    AS nb_bytes,
2453     sum(Job.JobErrors)   AS nb_err,
2454     sum(Job.JobFiles)    AS nb_files,
2455     Client.Name          AS clientname
2456 FROM Job INNER JOIN Client USING (ClientId)
2457 WHERE
2458     Client.Name = $client
2459     $limit
2460 GROUP BY Client.Name
2461 ";
2462
2463     my $row = $self->dbh_selectrow_hashref($query);
2464
2465     $row->{ID} = $cur_id++;
2466     $row->{label} = $label;
2467
2468     $self->display($row, "display_client_stats.tpl");
2469 }
2470
2471 # poolname can be undef
2472 sub display_pool
2473 {
2474     my ($self, $poolname) = @_ ;
2475     my $whereA = '';
2476     my $whereW = '';
2477
2478     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2479     if ($arg->{jmediatypes}) {
2480         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2481         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
2482     }
2483
2484 # TODO : afficher les tailles et les dates
2485
2486     my $query = "
2487 SELECT subq.volmax        AS volmax,
2488        subq.volnum        AS volnum,
2489        subq.voltotal      AS voltotal,
2490        Pool.Name          AS name,
2491        Pool.Recycle       AS recycle,
2492        Pool.VolRetention  AS volretention,
2493        Pool.VolUseDuration AS voluseduration,
2494        Pool.MaxVolJobs    AS maxvoljobs,
2495        Pool.MaxVolFiles   AS maxvolfiles,
2496        Pool.MaxVolBytes   AS maxvolbytes,
2497        subq.PoolId        AS PoolId
2498 FROM
2499   (
2500     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2501            count(Media.MediaId)  AS volnum,
2502            sum(Media.VolBytes)   AS voltotal,
2503            Media.PoolId          AS PoolId,
2504            Media.MediaType       AS MediaType
2505     FROM Media
2506     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2507                       Media.MediaType     AS MediaType
2508                FROM Media
2509               WHERE Media.VolStatus = 'Full'
2510               GROUP BY Media.MediaType
2511                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2512     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2513   ) AS subq
2514 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2515 $whereW
2516 ";
2517
2518     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2519
2520     $query = "
2521 SELECT Pool.Name AS name,
2522        sum(VolBytes) AS size
2523 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2524 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
2525        $whereA
2526 GROUP BY Pool.Name;
2527 ";
2528     my $empty = $self->dbh_selectall_hashref($query, 'name');
2529
2530     foreach my $p (values %$all) {
2531         if ($p->{volmax} > 0) { # mysql returns 0.0000
2532             # we remove Recycled/Purged media from pool usage
2533             if (defined $empty->{$p->{name}}) {
2534                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2535             }
2536             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2537         } else {
2538             $p->{poolusage} = 0;
2539         }
2540
2541         $query = "
2542   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2543     FROM Media
2544    WHERE PoolId=$p->{poolid}
2545          $whereA
2546 GROUP BY VolStatus
2547 ";
2548         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2549         foreach my $t (values %$content) {
2550             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2551         }
2552     }
2553
2554     $self->debug($all);
2555     $self->display({ ID => $cur_id++,
2556                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2557                      Pools => [ values %$all ]},
2558                    "display_pool.tpl");
2559 }
2560
2561 sub display_running_job
2562 {
2563     my ($self) = @_;
2564
2565     my $arg = $self->get_form('client', 'jobid');
2566
2567     if (!$arg->{client} and $arg->{jobid}) {
2568
2569         my $query = "
2570 SELECT Client.Name AS name
2571 FROM Job INNER JOIN Client USING (ClientId)
2572 WHERE Job.JobId = $arg->{jobid}
2573 ";
2574
2575         my $row = $self->dbh_selectrow_hashref($query);
2576
2577         if ($row) {
2578             $arg->{client} = $row->{name};
2579             CGI::param('client', $arg->{client});
2580         }
2581     }
2582
2583     if ($arg->{client}) {
2584         my $cli = new Bweb::Client(name => $arg->{client});
2585         $cli->display_running_job($self->{info}, $arg->{jobid});
2586         if ($arg->{jobid}) {
2587             $self->get_job_log();
2588         }
2589     } else {
2590         $self->error("Can't get client or jobid");
2591     }
2592 }
2593
2594 sub display_running_jobs
2595 {
2596     my ($self, $display_action) = @_;
2597
2598     my $query = "
2599 SELECT Job.JobId AS jobid,
2600        Job.Name  AS jobname,
2601        Job.Level     AS level,
2602        Job.StartTime AS starttime,
2603        Job.JobFiles  AS jobfiles,
2604        Job.JobBytes  AS jobbytes,
2605        Job.JobStatus AS jobstatus,
2606 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2607                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2608          AS duration,
2609        Client.Name AS clientname
2610 FROM Job INNER JOIN Client USING (ClientId)
2611 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2612 ";
2613     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2614
2615     $self->display({ ID => $cur_id++,
2616                      display_action => $display_action,
2617                      Jobs => [ values %$all ]},
2618                    "running_job.tpl") ;
2619 }
2620
2621 # return the autochanger list to update
2622 sub eject_media
2623 {
2624     my ($self) = @_;
2625     my %ret;
2626     my $arg = $self->get_form('jmedias');
2627
2628     unless ($arg->{jmedias}) {
2629         return $self->error("Can't get media selection");
2630     }
2631
2632     my $query = "
2633 SELECT Media.VolumeName  AS volumename,
2634        Storage.Name      AS storage,
2635        Location.Location AS location,
2636        Media.Slot        AS slot
2637 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2638            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2639 WHERE Media.VolumeName IN ($arg->{jmedias})
2640   AND Media.InChanger = 1
2641 ";
2642
2643     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2644
2645     foreach my $vol (values %$all) {
2646         my $a = $self->ach_get($vol->{location});
2647         next unless ($a) ;
2648         $ret{$vol->{location}} = 1;
2649
2650         unless ($a->{have_status}) {
2651             $a->status();
2652             $a->{have_status} = 1;
2653         }
2654
2655         print "eject $vol->{volumename} from $vol->{storage} : ";
2656         if ($a->send_to_io($vol->{slot})) {
2657             print "ok</br>";
2658         } else {
2659             print "err</br>";
2660         }
2661     }
2662     return keys %ret;
2663 }
2664
2665 sub move_email
2666 {
2667     my ($self) = @_;
2668
2669     my ($to, $subject, $content) = (CGI::param('email'),
2670                                     CGI::param('subject'),
2671                                     CGI::param('content'));
2672     $to =~ s/[^\w\d\.\@<>,]//;
2673     $subject =~ s/[^\w\d\.\[\]]/ /;
2674
2675     open(MAIL, "|mail -s '$subject' '$to'") ;
2676     print MAIL $content;
2677     close(MAIL);
2678
2679     print "Mail sent";
2680 }
2681
2682 sub restore
2683 {
2684     my ($self) = @_;
2685
2686     my $arg = $self->get_form('jobid', 'client');
2687
2688     print CGI::header('text/brestore');
2689     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2690     print "client=$arg->{client}\n" if ($arg->{client});
2691     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2692     print "\n";
2693 }
2694
2695 # TODO : move this to Bweb::Autochanger ?
2696 # TODO : make this internal to not eject tape ?
2697 use Bconsole;
2698
2699
2700 sub ach_get
2701 {
2702     my ($self, $name) = @_;
2703
2704     unless ($name) {
2705         return $self->error("Can't get your autochanger name ach");
2706     }
2707
2708     unless ($self->{info}->{ach_list}) {
2709         return $self->error("Could not find any autochanger");
2710     }
2711
2712     my $a = $self->{info}->{ach_list}->{$name};
2713
2714     unless ($a) {
2715         $self->error("Can't get your autochanger $name from your ach_list");
2716         return undef;
2717     }
2718
2719     $a->{bweb} = $self;
2720
2721     return $a;
2722 }
2723
2724 sub ach_register
2725 {
2726     my ($self, $ach) = @_;
2727
2728     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2729
2730     $self->{info}->save();
2731
2732     return 1;
2733 }
2734
2735 sub ach_edit
2736 {
2737     my ($self) = @_;
2738     my $arg = $self->get_form('ach');
2739     if (!$arg->{ach}
2740         or !$self->{info}->{ach_list}
2741         or !$self->{info}->{ach_list}->{$arg->{ach}})
2742     {
2743         return $self->error("Can't get autochanger name");
2744     }
2745
2746     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2747
2748     my $i=0;
2749     $ach->{drives} =
2750         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2751
2752     my $b = $self->get_bconsole();
2753
2754     my @storages = $b->list_storage() ;
2755
2756     $ach->{devices} = [ map { { name => $_ } } @storages ];
2757
2758     $self->display($ach, "ach_add.tpl");
2759     delete $ach->{drives};
2760     delete $ach->{devices};
2761     return 1;
2762 }
2763
2764 sub ach_del
2765 {
2766     my ($self) = @_;
2767     my $arg = $self->get_form('ach');
2768
2769     if (!$arg->{ach}
2770         or !$self->{info}->{ach_list}
2771         or !$self->{info}->{ach_list}->{$arg->{ach}})
2772     {
2773         return $self->error("Can't get autochanger name");
2774     }
2775
2776     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2777
2778     $self->{info}->save();
2779     $self->{info}->view();
2780 }
2781
2782 sub ach_add
2783 {
2784     my ($self) = @_;
2785     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2786
2787     my $b = $self->get_bconsole();
2788     my @storages = $b->list_storage() ;
2789
2790     unless ($arg->{ach}) {
2791         $arg->{devices} = [ map { { name => $_ } } @storages ];
2792         return $self->display($arg, "ach_add.tpl");
2793     }
2794
2795     my @drives ;
2796     foreach my $drive (CGI::param('drives'))
2797     {
2798         unless (grep(/^$drive$/,@storages)) {
2799             return $self->error("Can't find $drive in storage list");
2800         }
2801
2802         my $index = CGI::param("index_$drive");
2803         unless (defined $index and $index =~ /^(\d+)$/) {
2804             return $self->error("Can't get $drive index");
2805         }
2806
2807         $drives[$index] = $drive;
2808     }
2809
2810     unless (@drives) {
2811         return $self->error("Can't get drives from Autochanger");
2812     }
2813
2814     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2815                                   precmd => $arg->{precmd},
2816                                   drive_name => \@drives,
2817                                   device => $arg->{device},
2818                                   mtxcmd => $arg->{mtxcmd});
2819
2820     $self->ach_register($a) ;
2821
2822     $self->{info}->view();
2823 }
2824
2825 sub delete
2826 {
2827     my ($self) = @_;
2828     my $arg = $self->get_form('jobid');
2829
2830     if ($arg->{jobid}) {
2831         my $b = $self->get_bconsole();
2832         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2833
2834         $self->display({
2835             content => $ret,
2836             title => "Delete a job ",
2837             name => "delete jobid=$arg->{jobid}",
2838         }, "command.tpl");
2839     }
2840 }
2841
2842 sub do_update_media
2843 {
2844     my ($self) = @_ ;
2845
2846     my $arg = $self->get_form(qw/media volstatus inchanger pool
2847                                  slot volretention voluseduration
2848                                  maxvoljobs maxvolfiles maxvolbytes
2849                                  qcomment poolrecycle
2850                               /);
2851
2852     unless ($arg->{media}) {
2853         return $self->error("Can't find media selection");
2854     }
2855
2856     my $update = "update volume=$arg->{media} ";
2857
2858     if ($arg->{volstatus}) {
2859         $update .= " volstatus=$arg->{volstatus} ";
2860     }
2861
2862     if ($arg->{inchanger}) {
2863         $update .= " inchanger=yes " ;
2864         if ($arg->{slot}) {
2865             $update .= " slot=$arg->{slot} ";
2866         }
2867     } else {
2868         $update .= " slot=0 inchanger=no ";
2869     }
2870
2871     if ($arg->{pool}) {
2872         $update .= " pool=$arg->{pool} " ;
2873     }
2874
2875     if (defined $arg->{volretention}) {
2876         $update .= " volretention=\"$arg->{volretention}\" " ;
2877     }
2878
2879     if (defined $arg->{voluseduration}) {
2880         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2881     }
2882
2883     if (defined $arg->{maxvoljobs}) {
2884         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2885     }
2886
2887     if (defined $arg->{maxvolfiles}) {
2888         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2889     }
2890
2891     if (defined $arg->{maxvolbytes}) {
2892         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2893     }
2894
2895     my $b = $self->get_bconsole();
2896
2897     $self->display({
2898         content => $b->send_cmd($update),
2899         title => "Update a volume ",
2900         name => $update,
2901     }, "command.tpl");
2902
2903
2904     my @q;
2905     my $media = $self->dbh_quote($arg->{media});
2906
2907     my $loc = CGI::param('location') || '';
2908     if ($loc) {
2909         $loc = $self->dbh_quote($loc); # is checked by db
2910         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2911     }
2912     if ($arg->{poolrecycle}) {
2913         push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2914     }
2915     if (!$arg->{qcomment}) {
2916         $arg->{qcomment} = "''";
2917     }
2918     push @q, "Comment=$arg->{qcomment}";
2919
2920
2921     my $query = "
2922 UPDATE Media
2923    SET " . join (',', @q) . "
2924  WHERE Media.VolumeName = $media
2925 ";
2926     $self->dbh_do($query);
2927
2928     $self->update_media();
2929 }
2930
2931 sub update_slots
2932 {
2933     my ($self) = @_;
2934
2935     my $ach = CGI::param('ach') ;
2936     $ach = $self->ach_get($ach);
2937     unless ($ach) {
2938         return $self->error("Bad autochanger name");
2939     }
2940
2941     print "<pre>";
2942     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2943     $b->update_slots($ach->{name});
2944     print "</pre>\n"
2945 }
2946
2947 sub get_job_log
2948 {
2949     my ($self) = @_;
2950
2951     my $arg = $self->get_form('jobid');
2952     unless ($arg->{jobid}) {
2953         return $self->error("Can't get jobid");
2954     }
2955
2956     my $t = CGI::param('time') || '';
2957
2958     my $query = "
2959 SELECT Job.Name as name, Client.Name as clientname
2960  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2961  WHERE JobId = $arg->{jobid}
2962 ";
2963
2964     my $row = $self->dbh_selectrow_hashref($query);
2965
2966     unless ($row) {
2967         return $self->error("Can't find $arg->{jobid} in catalog");
2968     }
2969
2970     $query = "
2971 SELECT Time AS time, LogText AS log
2972   FROM  Log
2973  WHERE Log.JobId = $arg->{jobid}
2974     OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2975                       AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2976        )
2977  ORDER BY LogId;
2978 ";
2979
2980     my $log = $self->dbh_selectall_arrayref($query);
2981     unless ($log) {
2982         return $self->error("Can't get log for jobid $arg->{jobid}");
2983     }
2984
2985     my $logtxt;
2986     if ($t) {
2987         # log contains \n
2988         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2989     } else {
2990         $logtxt = join("", map { $_->[1] } @$log ) ;
2991     }
2992
2993     $self->display({ lines=> $logtxt,
2994                      jobid => $arg->{jobid},
2995                      name  => $row->{name},
2996                      client => $row->{clientname},
2997                  }, 'display_log.tpl');
2998 }
2999
3000
3001 sub label_barcodes
3002 {
3003     my ($self) = @_ ;
3004
3005     my $arg = $self->get_form('ach', 'slots', 'drive');
3006
3007     unless ($arg->{ach}) {
3008         return $self->error("Can't find autochanger name");
3009     }
3010
3011     my $a = $self->ach_get($arg->{ach});
3012     unless ($a) {
3013         return $self->error("Can't find autochanger name in configuration");
3014     }
3015
3016     my $storage = $a->get_drive_name($arg->{drive});
3017     unless ($storage) {
3018         return $self->error("Can't get your drive name");
3019     }
3020
3021     my $slots = '';
3022     my $t = 300 ;
3023     if ($arg->{slots}) {
3024         $slots = join(",", @{ $arg->{slots} });
3025         $t += 60*scalar( @{ $arg->{slots} }) ;
3026     }
3027
3028     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3029     print "<h1>This command can take long time, be patient...</h1>";
3030     print "<pre>" ;
3031     $b->label_barcodes(storage => $storage,
3032                        drive => $arg->{drive},
3033                        pool  => 'Scratch',
3034                        slots => $slots) ;
3035     $b->close();
3036     print "</pre>";
3037
3038     $self->dbh_do("
3039   UPDATE Media
3040        SET LocationId =   (SELECT LocationId
3041                              FROM Location
3042                             WHERE Location = '$arg->{ach}'),
3043
3044            RecyclePoolId = PoolId
3045
3046      WHERE Media.PoolId = (SELECT PoolId
3047                              FROM Pool
3048                             WHERE Name = 'Scratch')
3049        AND (LocationId = 0 OR LocationId IS NULL)
3050 ");
3051
3052 }
3053
3054 sub purge
3055 {
3056     my ($self) = @_;
3057
3058     my @volume = CGI::param('media');
3059
3060     unless (@volume) {
3061         return $self->error("Can't get media selection");
3062     }
3063
3064     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3065
3066     $self->display({
3067         content => $b->purge_volume(@volume),
3068         title => "Purge media",
3069         name => "purge volume=" . join(' volume=', @volume),
3070     }, "command.tpl");
3071     $b->close();
3072 }
3073
3074 sub prune
3075 {
3076     my ($self) = @_;
3077
3078     my @volume = CGI::param('media');
3079     unless (@volume) {
3080         return $self->error("Can't get media selection");
3081     }
3082
3083     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3084
3085     $self->display({
3086         content => $b->prune_volume(@volume),
3087         title => "Prune media",
3088         name => "prune volume=" . join(' volume=', @volume),
3089     }, "command.tpl");
3090
3091     $b->close();
3092 }
3093
3094 sub cancel_job
3095 {
3096     my ($self) = @_;
3097
3098     my $arg = $self->get_form('jobid');
3099     unless ($arg->{jobid}) {
3100         return $self->error("Can't get jobid");
3101     }
3102
3103     my $b = $self->get_bconsole();
3104     $self->display({
3105         content => $b->cancel($arg->{jobid}),
3106         title => "Cancel job",
3107         name => "cancel jobid=$arg->{jobid}",
3108     }, "command.tpl");
3109 }
3110
3111 sub fileset_view
3112 {
3113     # Warning, we display current fileset
3114     my ($self) = @_;
3115
3116     my $arg = $self->get_form('fileset');
3117
3118     if ($arg->{fileset}) {
3119         my $b = $self->get_bconsole();
3120         my $ret = $b->get_fileset($arg->{fileset});
3121         $self->display({ fileset => $arg->{fileset},
3122                          %$ret,
3123                      }, "fileset_view.tpl");
3124     } else {
3125         $self->error("Can't get fileset name");
3126     }
3127 }
3128
3129 sub director_show_sched
3130 {
3131     my ($self) = @_ ;
3132
3133     my $arg = $self->get_form('days');
3134
3135     my $b = $self->get_bconsole();
3136     my $ret = $b->director_get_sched( $arg->{days} );
3137
3138     $self->display({
3139         id => $cur_id++,
3140         list => $ret,
3141     }, "scheduled_job.tpl");
3142 }
3143
3144 sub enable_disable_job
3145 {
3146     my ($self, $what) = @_ ;
3147
3148     my $name = CGI::param('job') || '';
3149     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3150         return $self->error("Can't find job name");
3151     }
3152
3153     my $b = $self->get_bconsole();
3154
3155     my $cmd;
3156     if ($what) {
3157         $cmd = "enable";
3158     } else {
3159         $cmd = "disable";
3160     }
3161
3162     $self->display({
3163         content => $b->send_cmd("$cmd job=\"$name\""),
3164         title => "$cmd $name",
3165         name => "$cmd job=\"$name\"",
3166     }, "command.tpl");
3167 }
3168
3169 sub get_bconsole
3170 {
3171     my ($self) = @_;
3172     return new Bconsole(pref => $self->{info});
3173 }
3174
3175 sub run_job_select
3176 {
3177     my ($self) = @_;
3178     my $b = $self->get_bconsole();
3179
3180     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3181
3182     $self->display({ Jobs => $joblist }, "run_job.tpl");
3183 }
3184
3185 sub run_parse_job
3186 {
3187     my ($self, $ouput) = @_;
3188
3189     my %arg;
3190     foreach my $l (split(/\r\n/, $ouput)) {
3191         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3192             $arg{$1} = $2;
3193             $l = $3
3194                 if ($3) ;
3195         }
3196
3197         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3198             %arg = (%arg, @l);
3199         }
3200     }
3201
3202     my %lowcase ;
3203     foreach my $k (keys %arg) {
3204         $lowcase{lc($k)} = $arg{$k} ;
3205     }
3206
3207     return \%lowcase;
3208 }
3209
3210 sub run_job_mod
3211 {
3212     my ($self) = @_;
3213     my $b = $self->get_bconsole();
3214
3215     my $job = CGI::param('job') || '';
3216
3217     my $info = $b->send_cmd("show job=\"$job\"");
3218     my $attr = $self->run_parse_job($info);
3219
3220     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3221
3222     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3223     my $clients = [ map { { name => $_ } }$b->list_client()];
3224     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3225     my $storages= [ map { { name => $_ } }$b->list_storage()];
3226
3227     $self->display({
3228         jobs     => $jobs,
3229         pools    => $pools,
3230         clients  => $clients,
3231         filesets => $filesets,
3232         storages => $storages,
3233         %$attr,
3234     }, "run_job_mod.tpl");
3235 }
3236
3237 sub run_job
3238 {
3239     my ($self) = @_;
3240     my $b = $self->get_bconsole();
3241
3242     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3243
3244     $self->display({
3245         jobs     => $jobs,
3246     }, "run_job.tpl");
3247 }
3248
3249 sub run_job_now
3250 {
3251     my ($self) = @_;
3252     my $b = $self->get_bconsole();
3253
3254     # TODO: check input (don't use pool, level)
3255
3256     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3257     my $job = CGI::param('job') || '';
3258     my $storage = CGI::param('storage') || '';
3259
3260     my $jobid = $b->run(job => $job,
3261                         client => $arg->{client},
3262                         priority => $arg->{priority},
3263                         level => $arg->{level},
3264                         storage => $storage,
3265                         pool => $arg->{pool},
3266                         when => $arg->{when},
3267                         );
3268
3269     print $jobid, $b->{error};
3270
3271     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3272 }
3273
3274 1;