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