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