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