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 sub eject_media
2622 {
2623     my ($self) = @_;
2624     my $arg = $self->get_form('jmedias');
2625
2626     unless ($arg->{jmedias}) {
2627         return $self->error("Can't get media selection");
2628     }
2629
2630     my $query = "
2631 SELECT Media.VolumeName  AS volumename,
2632        Storage.Name      AS storage,
2633        Location.Location AS location,
2634        Media.Slot        AS slot
2635 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2636            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2637 WHERE Media.VolumeName IN ($arg->{jmedias})
2638   AND Media.InChanger = 1
2639 ";
2640
2641     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2642
2643     foreach my $vol (values %$all) {
2644         my $a = $self->ach_get($vol->{location});
2645         next unless ($a) ;
2646
2647         unless ($a->{have_status}) {
2648             $a->status();
2649             $a->{have_status} = 1;
2650         }
2651
2652         print "eject $vol->{volumename} from $vol->{storage} : ";
2653         if ($a->send_to_io($vol->{slot})) {
2654             print "ok</br>";
2655         } else {
2656             print "err</br>";
2657         }
2658     }
2659 }
2660
2661 sub move_email
2662 {
2663     my ($self) = @_;
2664
2665     my ($to, $subject, $content) = (CGI::param('email'),
2666                                     CGI::param('subject'),
2667                                     CGI::param('content'));
2668     $to =~ s/[^\w\d\.\@<>,]//;
2669     $subject =~ s/[^\w\d\.\[\]]/ /;
2670
2671     open(MAIL, "|mail -s '$subject' '$to'") ;
2672     print MAIL $content;
2673     close(MAIL);
2674
2675     print "Mail sent";
2676 }
2677
2678 sub restore
2679 {
2680     my ($self) = @_;
2681
2682     my $arg = $self->get_form('jobid', 'client');
2683
2684     print CGI::header('text/brestore');
2685     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2686     print "client=$arg->{client}\n" if ($arg->{client});
2687     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2688     print "\n";
2689 }
2690
2691 # TODO : move this to Bweb::Autochanger ?
2692 # TODO : make this internal to not eject tape ?
2693 use Bconsole;
2694
2695
2696 sub ach_get
2697 {
2698     my ($self, $name) = @_;
2699
2700     unless ($name) {
2701         return $self->error("Can't get your autochanger name ach");
2702     }
2703
2704     unless ($self->{info}->{ach_list}) {
2705         return $self->error("Could not find any autochanger");
2706     }
2707
2708     my $a = $self->{info}->{ach_list}->{$name};
2709
2710     unless ($a) {
2711         $self->error("Can't get your autochanger $name from your ach_list");
2712         return undef;
2713     }
2714
2715     $a->{bweb} = $self;
2716
2717     return $a;
2718 }
2719
2720 sub ach_register
2721 {
2722     my ($self, $ach) = @_;
2723
2724     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2725
2726     $self->{info}->save();
2727
2728     return 1;
2729 }
2730
2731 sub ach_edit
2732 {
2733     my ($self) = @_;
2734     my $arg = $self->get_form('ach');
2735     if (!$arg->{ach}
2736         or !$self->{info}->{ach_list}
2737         or !$self->{info}->{ach_list}->{$arg->{ach}})
2738     {
2739         return $self->error("Can't get autochanger name");
2740     }
2741
2742     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2743
2744     my $i=0;
2745     $ach->{drives} =
2746         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2747
2748     my $b = $self->get_bconsole();
2749
2750     my @storages = $b->list_storage() ;
2751
2752     $ach->{devices} = [ map { { name => $_ } } @storages ];
2753
2754     $self->display($ach, "ach_add.tpl");
2755     delete $ach->{drives};
2756     delete $ach->{devices};
2757     return 1;
2758 }
2759
2760 sub ach_del
2761 {
2762     my ($self) = @_;
2763     my $arg = $self->get_form('ach');
2764
2765     if (!$arg->{ach}
2766         or !$self->{info}->{ach_list}
2767         or !$self->{info}->{ach_list}->{$arg->{ach}})
2768     {
2769         return $self->error("Can't get autochanger name");
2770     }
2771
2772     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2773
2774     $self->{info}->save();
2775     $self->{info}->view();
2776 }
2777
2778 sub ach_add
2779 {
2780     my ($self) = @_;
2781     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2782
2783     my $b = $self->get_bconsole();
2784     my @storages = $b->list_storage() ;
2785
2786     unless ($arg->{ach}) {
2787         $arg->{devices} = [ map { { name => $_ } } @storages ];
2788         return $self->display($arg, "ach_add.tpl");
2789     }
2790
2791     my @drives ;
2792     foreach my $drive (CGI::param('drives'))
2793     {
2794         unless (grep(/^$drive$/,@storages)) {
2795             return $self->error("Can't find $drive in storage list");
2796         }
2797
2798         my $index = CGI::param("index_$drive");
2799         unless (defined $index and $index =~ /^(\d+)$/) {
2800             return $self->error("Can't get $drive index");
2801         }
2802
2803         $drives[$index] = $drive;
2804     }
2805
2806     unless (@drives) {
2807         return $self->error("Can't get drives from Autochanger");
2808     }
2809
2810     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2811                                   precmd => $arg->{precmd},
2812                                   drive_name => \@drives,
2813                                   device => $arg->{device},
2814                                   mtxcmd => $arg->{mtxcmd});
2815
2816     $self->ach_register($a) ;
2817
2818     $self->{info}->view();
2819 }
2820
2821 sub delete
2822 {
2823     my ($self) = @_;
2824     my $arg = $self->get_form('jobid');
2825
2826     if ($arg->{jobid}) {
2827         my $b = $self->get_bconsole();
2828         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2829
2830         $self->display({
2831             content => $ret,
2832             title => "Delete a job ",
2833             name => "delete jobid=$arg->{jobid}",
2834         }, "command.tpl");
2835     }
2836 }
2837
2838 sub do_update_media
2839 {
2840     my ($self) = @_ ;
2841
2842     my $arg = $self->get_form(qw/media volstatus inchanger pool
2843                                  slot volretention voluseduration
2844                                  maxvoljobs maxvolfiles maxvolbytes
2845                                  qcomment poolrecycle
2846                               /);
2847
2848     unless ($arg->{media}) {
2849         return $self->error("Can't find media selection");
2850     }
2851
2852     my $update = "update volume=$arg->{media} ";
2853
2854     if ($arg->{volstatus}) {
2855         $update .= " volstatus=$arg->{volstatus} ";
2856     }
2857
2858     if ($arg->{inchanger}) {
2859         $update .= " inchanger=yes " ;
2860         if ($arg->{slot}) {
2861             $update .= " slot=$arg->{slot} ";
2862         }
2863     } else {
2864         $update .= " slot=0 inchanger=no ";
2865     }
2866
2867     if ($arg->{pool}) {
2868         $update .= " pool=$arg->{pool} " ;
2869     }
2870
2871     $arg->{volretention} ||= 0 ;
2872     if ($arg->{volretention}) {
2873         $update .= " volretention=\"$arg->{volretention}\" " ;
2874     }
2875
2876     $arg->{voluseduration} ||= 0 ;
2877     if ($arg->{voluseduration}) {
2878         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2879     }
2880
2881     $arg->{maxvoljobs} ||= 0;
2882     if ($arg->{maxvoljobs}) {
2883         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2884     }
2885
2886     $arg->{maxvolfiles} ||= 0;
2887     if ($arg->{maxvolfiles}) {
2888         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2889     }
2890
2891     $arg->{maxvolbytes} ||= 0;
2892     if ($arg->{maxvolbytes}) {
2893         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2894     }
2895
2896     my $b = $self->get_bconsole();
2897
2898     $self->display({
2899         content => $b->send_cmd($update),
2900         title => "Update a volume ",
2901         name => $update,
2902     }, "command.tpl");
2903
2904
2905     my @q;
2906     my $media = $self->dbh_quote($arg->{media});
2907
2908     my $loc = CGI::param('location') || '';
2909     if ($loc) {
2910         $loc = $self->dbh_quote($loc); # is checked by db
2911         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2912     }
2913     if ($arg->{poolrecycle}) {
2914         push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2915     }
2916     if (!$arg->{qcomment}) {
2917         $arg->{qcomment} = "''";
2918     }
2919     push @q, "Comment=$arg->{qcomment}";
2920
2921
2922     my $query = "
2923 UPDATE Media
2924    SET " . join (',', @q) . "
2925  WHERE Media.VolumeName = $media
2926 ";
2927     $self->dbh_do($query);
2928
2929     $self->update_media();
2930 }
2931
2932 sub update_slots
2933 {
2934     my ($self) = @_;
2935
2936     my $ach = CGI::param('ach') ;
2937     $ach = $self->ach_get($ach);
2938     unless ($ach) {
2939         return $self->error("Bad autochanger name");
2940     }
2941
2942     print "<pre>";
2943     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2944     $b->update_slots($ach->{name});
2945     print "</pre>\n"
2946 }
2947
2948 sub get_job_log
2949 {
2950     my ($self) = @_;
2951
2952     my $arg = $self->get_form('jobid');
2953     unless ($arg->{jobid}) {
2954         return $self->error("Can't get jobid");
2955     }
2956
2957     my $t = CGI::param('time') || '';
2958
2959     my $query = "
2960 SELECT Job.Name as name, Client.Name as clientname
2961  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2962  WHERE JobId = $arg->{jobid}
2963 ";
2964
2965     my $row = $self->dbh_selectrow_hashref($query);
2966
2967     unless ($row) {
2968         return $self->error("Can't find $arg->{jobid} in catalog");
2969     }
2970
2971     $query = "
2972 SELECT Time AS time, LogText AS log
2973   FROM  Log
2974  WHERE Log.JobId = $arg->{jobid}
2975     OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2976                       AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2977        )
2978  ORDER BY LogId;
2979 ";
2980
2981     my $log = $self->dbh_selectall_arrayref($query);
2982     unless ($log) {
2983         return $self->error("Can't get log for jobid $arg->{jobid}");
2984     }
2985
2986     my $logtxt;
2987     if ($t) {
2988         # log contains \n
2989         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2990     } else {
2991         $logtxt = join("", map { $_->[1] } @$log ) ;
2992     }
2993
2994     $self->display({ lines=> $logtxt,
2995                      jobid => $arg->{jobid},
2996                      name  => $row->{name},
2997                      client => $row->{clientname},
2998                  }, 'display_log.tpl');
2999 }
3000
3001
3002 sub label_barcodes
3003 {
3004     my ($self) = @_ ;
3005
3006     my $arg = $self->get_form('ach', 'slots', 'drive');
3007
3008     unless ($arg->{ach}) {
3009         return $self->error("Can't find autochanger name");
3010     }
3011
3012     my $slots = '';
3013     my $t = 300 ;
3014     if ($arg->{slots}) {
3015         $slots = join(",", @{ $arg->{slots} });
3016         $t += 60*scalar( @{ $arg->{slots} }) ;
3017     }
3018
3019     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3020     print "<h1>This command can take long time, be patient...</h1>";
3021     print "<pre>" ;
3022     $b->label_barcodes(storage => $arg->{ach},
3023                        drive => $arg->{drive},
3024                        pool  => 'Scratch',
3025                        slots => $slots) ;
3026     $b->close();
3027     print "</pre>";
3028 }
3029
3030 sub purge
3031 {
3032     my ($self) = @_;
3033
3034     my @volume = CGI::param('media');
3035
3036     unless (@volume) {
3037         return $self->error("Can't get media selection");
3038     }
3039
3040     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3041
3042     $self->display({
3043         content => $b->purge_volume(@volume),
3044         title => "Purge media",
3045         name => "purge volume=" . join(' volume=', @volume),
3046     }, "command.tpl");
3047     $b->close();
3048 }
3049
3050 sub prune
3051 {
3052     my ($self) = @_;
3053
3054     my @volume = CGI::param('media');
3055     unless (@volume) {
3056         return $self->error("Can't get media selection");
3057     }
3058
3059     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3060
3061     $self->display({
3062         content => $b->prune_volume(@volume),
3063         title => "Prune media",
3064         name => "prune volume=" . join(' volume=', @volume),
3065     }, "command.tpl");
3066
3067     $b->close();
3068 }
3069
3070 sub cancel_job
3071 {
3072     my ($self) = @_;
3073
3074     my $arg = $self->get_form('jobid');
3075     unless ($arg->{jobid}) {
3076         return $self->error("Can't get jobid");
3077     }
3078
3079     my $b = $self->get_bconsole();
3080     $self->display({
3081         content => $b->cancel($arg->{jobid}),
3082         title => "Cancel job",
3083         name => "cancel jobid=$arg->{jobid}",
3084     }, "command.tpl");
3085 }
3086
3087 sub fileset_view
3088 {
3089     # Warning, we display current fileset
3090     my ($self) = @_;
3091
3092     my $arg = $self->get_form('fileset');
3093
3094     if ($arg->{fileset}) {
3095         my $b = $self->get_bconsole();
3096         my $ret = $b->get_fileset($arg->{fileset});
3097         $self->display({ fileset => $arg->{fileset},
3098                          %$ret,
3099                      }, "fileset_view.tpl");
3100     } else {
3101         $self->error("Can't get fileset name");
3102     }
3103 }
3104
3105 sub director_show_sched
3106 {
3107     my ($self) = @_ ;
3108
3109     my $arg = $self->get_form('days');
3110
3111     my $b = $self->get_bconsole();
3112     my $ret = $b->director_get_sched( $arg->{days} );
3113
3114     $self->display({
3115         id => $cur_id++,
3116         list => $ret,
3117     }, "scheduled_job.tpl");
3118 }
3119
3120 sub enable_disable_job
3121 {
3122     my ($self, $what) = @_ ;
3123
3124     my $name = CGI::param('job') || '';
3125     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3126         return $self->error("Can't find job name");
3127     }
3128
3129     my $b = $self->get_bconsole();
3130
3131     my $cmd;
3132     if ($what) {
3133         $cmd = "enable";
3134     } else {
3135         $cmd = "disable";
3136     }
3137
3138     $self->display({
3139         content => $b->send_cmd("$cmd job=\"$name\""),
3140         title => "$cmd $name",
3141         name => "$cmd job=\"$name\"",
3142     }, "command.tpl");
3143 }
3144
3145 sub get_bconsole
3146 {
3147     my ($self) = @_;
3148     return new Bconsole(pref => $self->{info});
3149 }
3150
3151 sub run_job_select
3152 {
3153     my ($self) = @_;
3154     my $b = $self->get_bconsole();
3155
3156     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3157
3158     $self->display({ Jobs => $joblist }, "run_job.tpl");
3159 }
3160
3161 sub run_parse_job
3162 {
3163     my ($self, $ouput) = @_;
3164
3165     my %arg;
3166     foreach my $l (split(/\r\n/, $ouput)) {
3167         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3168             $arg{$1} = $2;
3169             $l = $3
3170                 if ($3) ;
3171         }
3172
3173         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3174             %arg = (%arg, @l);
3175         }
3176     }
3177
3178     my %lowcase ;
3179     foreach my $k (keys %arg) {
3180         $lowcase{lc($k)} = $arg{$k} ;
3181     }
3182
3183     return \%lowcase;
3184 }
3185
3186 sub run_job_mod
3187 {
3188     my ($self) = @_;
3189     my $b = $self->get_bconsole();
3190
3191     my $job = CGI::param('job') || '';
3192
3193     my $info = $b->send_cmd("show job=\"$job\"");
3194     my $attr = $self->run_parse_job($info);
3195
3196     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3197
3198     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3199     my $clients = [ map { { name => $_ } }$b->list_client()];
3200     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3201     my $storages= [ map { { name => $_ } }$b->list_storage()];
3202
3203     $self->display({
3204         jobs     => $jobs,
3205         pools    => $pools,
3206         clients  => $clients,
3207         filesets => $filesets,
3208         storages => $storages,
3209         %$attr,
3210     }, "run_job_mod.tpl");
3211 }
3212
3213 sub run_job
3214 {
3215     my ($self) = @_;
3216     my $b = $self->get_bconsole();
3217
3218     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3219
3220     $self->display({
3221         jobs     => $jobs,
3222     }, "run_job.tpl");
3223 }
3224
3225 sub run_job_now
3226 {
3227     my ($self) = @_;
3228     my $b = $self->get_bconsole();
3229
3230     # TODO: check input (don't use pool, level)
3231
3232     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3233     my $job = CGI::param('job') || '';
3234     my $storage = CGI::param('storage') || '';
3235
3236     my $jobid = $b->run(job => $job,
3237                         client => $arg->{client},
3238                         priority => $arg->{priority},
3239                         level => $arg->{level},
3240                         storage => $storage,
3241                         pool => $arg->{pool},
3242                         when => $arg->{when},
3243                         );
3244
3245     print $jobid, $b->{error};
3246
3247     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3248 }
3249
3250 1;