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

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