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