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