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