git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/Bweb.pm

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