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