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