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 => 'SDLT-1-2',
 478                                   precmd => 'sudo',
 479                                   drive_name => ['SDLT-1', 'SDLT-2'],
 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 "$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst\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         JobErrors       AS joberrors
1806
1807  FROM Client,
1808       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1809           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1810  WHERE Client.ClientId=Job.ClientId
1811  $where
1812  $limit
1813 ";
1814
1815     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1816
1817     foreach (values %$all) {
1818         $_->{jobbytes} = human_size($_->{jobbytes}) ;
1819     }
1820
1821     $self->display({ Filter => $label,
1822                      ID => $cur_id++,
1823                      Jobs =>
1824                            [
1825                              sort { $a->{jobid} <=>  $b->{jobid} }
1826                                         values %$all
1827                              ],
1828                    },
1829                    "display_job.tpl");
1830 }
1831
1832 # display job informations
1833 sub display_job_zoom
1834 {
1835     my ($self, $jobid) = @_ ;
1836
1837     $jobid = $self->dbh_quote($jobid);
1838
1839     my $query="
1840 SELECT DISTINCT Job.JobId       AS jobid,
1841                 Client.Name     AS client,
1842                 Job.Name        AS jobname,
1843                 FileSet.FileSet AS fileset,
1844                 Level           AS level,
1845                 Pool.Name       AS poolname,
1846                 StartTime       AS starttime,
1847                 JobFiles        AS jobfiles,
1848                 JobBytes        AS jobbytes,
1849                 JobStatus       AS jobstatus,
1850                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1851                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1852
1853  FROM Client,
1854       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1855           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1856  WHERE Client.ClientId=Job.ClientId
1857  AND Job.JobId = $jobid
1858 ";
1859
1860     my $row = $self->dbh_selectrow_hashref($query) ;
1861
1862     $row->{jobbytes} = human_size($row->{jobbytes}) ;
1863
1864     # display all volumes associate with this job
1865     $query="
1866 SELECT Media.VolumeName as volumename
1867 FROM Job,Media,JobMedia
1868 WHERE Job.JobId = $jobid
1869  AND JobMedia.JobId=Job.JobId
1870  AND JobMedia.MediaId=Media.MediaId
1871 ";
1872
1873     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1874
1875     $row->{volumes} = [ values %$all ] ;
1876
1877     $self->display($row, "display_job_zoom.tpl");
1878 }
1879
1880 sub display_media
1881 {
1882     my ($self) = @_ ;
1883
1884     my ($where, %elt) = $self->get_param('pool',
1885                                          'location');
1886
1887     my $query="
1888 SELECT Media.VolumeName AS volumename,
1889        Media.VolBytes   AS volbytes,
1890        Media.VolStatus  AS volstatus,
1891        Media.MediaType  AS mediatype,
1892        Media.InChanger  AS online,
1893        Media.LastWritten AS lastwritten,
1894        Location.Location AS location,
1895        Pool.Name         AS poolname,
1896        $self->{sql}->{FROM_UNIXTIME}(
1897           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1898         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1899        ) AS expire
1900 FROM Pool, Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1901 WHERE Media.PoolId=Pool.PoolId
1902 $where
1903 ";
1904
1905     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1906     foreach (values %$all) {
1907         $_->{volbytes} = human_size($_->{volbytes}) ;
1908     }
1909
1910     $self->display({ ID => $cur_id++,
1911                      Pool => $elt{pool},
1912                      Location => $elt{location},
1913                      Medias => [ values %$all ]
1914                    },
1915                    "display_media.tpl");
1916 }
1917
1918 sub display_medias
1919 {
1920     my ($self) = @_ ;
1921
1922     my $pool = $self->get_form('db_pools');
1923
1924     foreach my $name (@{ $pool->{db_pools} }) {
1925         CGI::param('pool', $name->{name});
1926         $self->display_media();
1927     }
1928 }
1929
1930 sub display_media_zoom
1931 {
1932     my ($self) = @_ ;
1933
1934     my $medias = $self->get_form('jmedias');
1935
1936     unless ($medias->{jmedias}) {
1937         return $self->error("Can't get media selection");
1938     }
1939
1940     my $query="
1941 SELECT InChanger     AS online,
1942        VolBytes      AS nb_bytes,
1943        VolumeName    AS volumename,
1944        VolStatus     AS volstatus,
1945        VolMounts     AS nb_mounts,
1946        Media.VolUseDuration   AS voluseduration,
1947        Media.MaxVolJobs AS maxvoljobs,
1948        Media.MaxVolFiles AS maxvolfiles,
1949        Media.MaxVolBytes AS maxvolbytes,
1950        VolErrors     AS nb_errors,
1951        Pool.Name     AS poolname,
1952        Location.Location AS location,
1953        Media.Recycle AS recycle,
1954        Media.VolRetention AS volretention,
1955        Media.LastWritten  AS lastwritten,
1956        $self->{sql}->{FROM_UNIXTIME}(
1957           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1958         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1959        ) AS expire
1960  FROM Job,Pool,
1961       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1962  WHERE Pool.PoolId = Media.PoolId
1963  AND VolumeName IN ($medias->{jmedias})
1964 ";
1965
1966     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1967
1968     foreach my $media (values %$all) {
1969         $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
1970         $media->{voluseduration} = human_sec($media->{voluseduration});
1971         $media->{volretention} = human_sec($media->{volretention});
1972         my $mq = $self->dbh_quote($media->{volumename});
1973
1974         $query = "
1975 SELECT DISTINCT Job.JobId AS jobid,
1976                 Job.Name  AS name,
1977                 Job.StartTime AS starttime,
1978                 Job.Type  AS type,
1979                 Job.Level AS level,
1980                 Job.JobFiles AS files,
1981                 Job.JobBytes AS bytes,
1982                 Job.jobstatus AS status
1983  FROM Media,JobMedia,Job
1984  WHERE Media.VolumeName=$mq
1985  AND Media.MediaId=JobMedia.MediaId
1986  AND JobMedia.JobId=Job.JobId
1987 ";
1988
1989         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
1990
1991         foreach (values %$jobs) {
1992             $_->{bytes} = human_size($_->{bytes}) ;
1993         }
1994
1995         $self->display({ jobs => [ values %$jobs ],
1996                          %$media },
1997                        "display_media_zoom.tpl");
1998     }
1999 }
2000
2001 sub location_edit
2002 {
2003     my ($self) = @_ ;
2004
2005     my $loc = $self->get_form('qlocation');
2006     unless ($loc->{qlocation}) {
2007         return $self->error("Can't get location");
2008     }
2009
2010     my $query = "
2011 SELECT Location.Location AS location,
2012        Location.Cost   AS cost,
2013        Location.Enabled AS enabled
2014 FROM Location
2015 WHERE Location.Location = $loc->{qlocation}
2016 ";
2017
2018     my $row = $self->dbh_selectrow_hashref($query);
2019
2020     $self->display({ ID => $cur_id++,
2021                      %$row }, "location_edit.tpl") ;
2022
2023 }
2024
2025 sub location_save
2026 {
2027     my ($self) = @_ ;
2028
2029     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2030     unless ($arg->{qlocation}) {
2031         return $self->error("Can't get location");
2032     }
2033     unless ($arg->{qnewlocation}) {
2034         return $self->error("Can't get new location name");
2035     }
2036     unless ($arg->{cost}) {
2037         return $self->error("Can't get new cost");
2038     }
2039
2040     my $enabled = CGI::param('enabled') || '';
2041     $enabled = $enabled?1:0;
2042
2043     my $query = "
2044 UPDATE Location SET Cost     = $arg->{cost},
2045                     Location = $arg->{qnewlocation},
2046                     Enabled   = $enabled
2047 WHERE Location.Location = $arg->{qlocation}
2048 ";
2049
2050     $self->dbh_do($query);
2051
2052     $self->display_location();
2053 }
2054
2055 sub location_add
2056 {
2057     my ($self) = @_ ;
2058     my $arg = $self->get_form(qw/qlocation cost/) ;
2059
2060     unless ($arg->{qlocation}) {
2061         $self->display({}, "location_add.tpl");
2062         return 1;
2063     }
2064     unless ($arg->{cost}) {
2065         return $self->error("Can't get new cost");
2066     }
2067
2068     my $enabled = CGI::param('enabled') || '';
2069     $enabled = $enabled?1:0;
2070
2071     my $query = "
2072 INSERT INTO Location (Location, Cost, Enabled)
2073        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2074 ";
2075
2076     $self->dbh_do($query);
2077
2078     $self->display_location();
2079 }
2080
2081 sub display_location
2082 {
2083     my ($self) = @_ ;
2084
2085     my $query = "
2086 SELECT Location.Location AS location,
2087        Location.Cost     AS cost,
2088        Location.Enabled  AS enabled,
2089        (SELECT count(Media.MediaId)
2090          FROM Media
2091         WHERE Media.LocationId = Location.LocationId
2092        ) AS volnum
2093 FROM Location
2094 ";
2095
2096     my $location = $self->dbh_selectall_hashref($query, 'location');
2097
2098     $self->display({ ID => $cur_id++,
2099                      Locations => [ values %$location ] },
2100                    "display_location.tpl");
2101 }
2102
2103 sub update_location
2104 {
2105     my ($self) = @_ ;
2106
2107     my $medias = $self->get_selected_media_location();
2108     unless ($medias) {
2109         return ;
2110     }
2111
2112     my $arg = $self->get_form('db_locations', 'qnewlocation');
2113
2114     $self->display({ email  => $self->{info}->{email_media},
2115                      %$arg,
2116                      medias => [ values %$medias ],
2117                    },
2118                    "update_location.tpl");
2119 }
2120
2121 sub do_update_media
2122 {
2123     my ($self) = @_ ;
2124
2125     my $media = CGI::param('media');
2126     unless ($media) {
2127         return $self->error("Can't find media selection");
2128     }
2129
2130     $media = $self->dbh_quote($media);
2131
2132     my $update = '';
2133
2134     my $volstatus = CGI::param('volstatus') || '';
2135     $volstatus = $self->dbh_quote($volstatus); # is checked by db
2136     $update .= " VolStatus=$volstatus, ";
2137
2138     my $inchanger = CGI::param('inchanger') || '';
2139     if ($inchanger) {
2140         $update .= " InChanger=1, " ;
2141         my $slot = CGI::param('slot') || '';
2142         if ($slot =~ /^(\d+)$/) {
2143             $update .= " Slot=$1, ";
2144         } else {
2145             $update .= " Slot=0, ";
2146         }
2147     } else {
2148         $update = " Slot=0, InChanger=0, ";
2149     }
2150
2151     my $pool = CGI::param('pool') || '';
2152     $pool = $self->dbh_quote($pool); # is checked by db
2153     $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2154
2155     my $volretention = CGI::param('volretention') || '';
2156     $volretention = from_human_sec($volretention);
2157     unless ($volretention) {
2158         return $self->error("Can't get volume retention");
2159     }
2160
2161     $update .= " VolRetention = $volretention, ";
2162
2163     my $loc = CGI::param('location') || '';
2164     $loc = $self->dbh_quote($loc); # is checked by db
2165     $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2166
2167     my $usedu = CGI::param('voluseduration') || '0';
2168     $usedu = from_human_sec($usedu);
2169     $update .= " VolUseDuration=$usedu, ";
2170
2171     my $maxj = CGI::param('maxvoljobs') || '0';
2172     unless ($maxj =~ /^(\d+)$/) {
2173         return $self->error("Can't get max jobs");
2174     }
2175     $update .= " MaxVolJobs=$1, " ;
2176
2177     my $maxf = CGI::param('maxvolfiles') || '0';
2178     unless ($maxj =~ /^(\d+)$/) {
2179         return $self->error("Can't get max files");
2180     }
2181     $update .= " MaxVolFiles=$1, " ;
2182
2183     my $maxb = CGI::param('maxvolbytes') || '0';
2184     unless ($maxb =~ /^(\d+)$/) {
2185         return $self->error("Can't get max bytes");
2186     }
2187     $update .= " MaxVolBytes=$1 " ;
2188
2189     my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2190
2191     if ($row) {
2192         print "Update Ok\n";
2193         $self->update_media();
2194     }
2195 }
2196
2197 sub update_media
2198 {
2199     my ($self) = @_ ;
2200
2201     my $media = $self->get_form('qmedia');
2202
2203     unless ($media->{qmedia}) {
2204         return $self->error("Can't get media");
2205     }
2206
2207     my $query = "
2208 SELECT Media.Slot         AS slot,
2209        Pool.Name          AS poolname,
2210        Media.VolStatus    AS volstatus,
2211        Media.InChanger    AS inchanger,
2212        Location.Location  AS location,
2213        Media.VolumeName   AS volumename,
2214        Media.MaxVolBytes  AS maxvolbytes,
2215        Media.MaxVolJobs   AS maxvoljobs,
2216        Media.MaxVolFiles  AS maxvolfiles,
2217        Media.VolUseDuration AS voluseduration,
2218        Media.VolRetention AS volretention
2219
2220 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2221            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2222
2223 WHERE Media.VolumeName = $media->{qmedia}
2224 ";
2225
2226     my $row = $self->dbh_selectrow_hashref($query);
2227     $row->{volretention} = human_sec($row->{volretention});
2228     $row->{voluseduration} = human_sec($row->{voluseduration});
2229
2230     my $elt = $self->get_form(qw/db_pools db_locations/);
2231
2232     $self->display({
2233         %$elt,
2234         %$row,
2235     },
2236                    "update_media.tpl");
2237 }
2238
2239 sub save_location
2240 {
2241     my ($self) = @_ ;
2242
2243     my $medias = $self->get_selected_media();
2244
2245     unless ($medias) {
2246         return 0;
2247     }
2248
2249     my $loc = $self->get_form('qnewlocation');
2250     unless ($loc->{qnewlocation}) {
2251         return $self->error("Can't get new location");
2252     }
2253
2254     my $query = "
2255  UPDATE Media
2256      SET LocationId = (SELECT LocationId
2257                        FROM Location
2258                        WHERE Location = $loc->{qnewlocation})
2259      WHERE Media.VolumeName IN ($medias)
2260 ";
2261
2262     my $nb = $self->dbh_do($query);
2263
2264     print "$nb media updated";
2265 }
2266
2267 sub change_location
2268 {
2269     my ($self) = @_ ;
2270
2271     my $medias = $self->get_selected_media_location();
2272     unless ($medias) {
2273         return $self->error("Can't get media selection");
2274     }
2275     my $newloc = CGI::param('newlocation');
2276
2277     my $user = CGI::param('user') || 'unknow';
2278     my $comm = CGI::param('comment') || '';
2279     $comm = $self->dbh_quote("$user: $comm");
2280
2281     my $query;
2282
2283     foreach my $media (keys %$medias) {
2284         $query = "
2285 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2286  VALUES(
2287        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2288        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2289        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2290       )
2291 ";
2292
2293         $self->debug($query);
2294     }
2295
2296     my $q = new CGI;
2297     $q->param('action', 'update_location');
2298     my $url = $q->url(-full => 1, -query=>1);
2299
2300     $self->display({ email  => $self->{info}->{email_media},
2301                      url => $url,
2302                      newlocation => $newloc,
2303                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2304                      medias => [ values %$medias ],
2305                    },
2306                    "change_location.tpl");
2307
2308 }
2309
2310 sub display_client_stats
2311 {
2312     my ($self, %arg) = @_ ;
2313
2314     my $client = $self->dbh_quote($arg{clientname});
2315     my ($limit, $label) = $self->get_limit(%arg);
2316
2317     my $query = "
2318 SELECT
2319     count(Job.JobId)     AS nb_jobs,
2320     sum(Job.JobBytes)    AS nb_bytes,
2321     sum(Job.JobErrors)   AS nb_err,
2322     sum(Job.JobFiles)    AS nb_files,
2323     Client.Name          AS clientname
2324 FROM Job INNER JOIN Client USING (ClientId)
2325 WHERE
2326     Client.Name = $client
2327     $limit
2328 GROUP BY Client.Name
2329 ";
2330
2331     my $row = $self->dbh_selectrow_hashref($query);
2332
2333     $row->{ID} = $cur_id++;
2334     $row->{label} = $label;
2335     $row->{nb_bytes}    = human_size($row->{nb_bytes}) ;
2336
2337     $self->display($row, "display_client_stats.tpl");
2338 }
2339
2340 # poolname can be undef
2341 sub display_pool
2342 {
2343     my ($self, $poolname) = @_ ;
2344
2345 # TODO : afficher les tailles et les dates
2346
2347     my $query = "
2348 SELECT Pool.Name     AS name,
2349        Pool.Recycle  AS recycle,
2350        Pool.VolRetention AS volretention,
2351        Pool.VolUseDuration AS voluseduration,
2352        Pool.MaxVolJobs AS maxvoljobs,
2353        Pool.MaxVolFiles AS maxvolfiles,
2354        Pool.MaxVolBytes AS maxvolbytes,
2355       (SELECT count(Media.MediaId)
2356          FROM Media
2357         WHERE Media.PoolId = Pool.PoolId
2358       ) AS volnum
2359  FROM Pool
2360 ";
2361
2362     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2363     foreach (values %$all) {
2364         $_->{maxvolbytes}    = human_size($_->{maxvolbytes}) ;
2365         $_->{volretention}   = human_sec($_->{volretention}) ;
2366         $_->{voluseduration} = human_sec($_->{voluseduration}) ;
2367     }
2368
2369     $self->display({ ID => $cur_id++,
2370                      Pools => [ values %$all ]},
2371                    "display_pool.tpl");
2372 }
2373
2374 sub display_running_job
2375 {
2376     my ($self) = @_;
2377
2378     my $arg = $self->get_form('client', 'jobid');
2379
2380     if (!$arg->{client} and $arg->{jobid}) {
2381
2382         my $query = "
2383 SELECT Client.Name AS name
2384 FROM Job INNER JOIN Client USING (ClientId)
2385 WHERE Job.JobId = $arg->{jobid}
2386 ";
2387
2388         my $row = $self->dbh_selectrow_hashref($query);
2389
2390         if ($row) {
2391             $arg->{client} = $row->{name};
2392             CGI::param('client', $arg->{client});
2393         }
2394     }
2395
2396     if ($arg->{client}) {
2397         my $cli = new Bweb::Client(name => $arg->{client});
2398         $cli->display_running_job($self->{info}, $arg->{jobid});
2399         if ($arg->{jobid}) {
2400             $self->get_job_log();
2401         }
2402     } else {
2403         $self->error("Can't get client or jobid");
2404     }
2405 }
2406
2407 sub display_running_jobs
2408 {
2409     my ($self, $display_action) = @_;
2410
2411     my $query = "
2412 SELECT Job.JobId AS jobid,
2413        Job.Name  AS jobname,
2414        Job.Level     AS level,
2415        Job.StartTime AS starttime,
2416        Job.JobFiles  AS jobfiles,
2417        Job.JobBytes  AS jobbytes,
2418        Job.JobStatus AS jobstatus,
2419 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2420                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2421          AS duration,
2422        Client.Name AS clientname
2423 FROM Job INNER JOIN Client USING (ClientId)
2424 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2425 ";
2426     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2427
2428     $self->display({ ID => $cur_id++,
2429                      display_action => $display_action,
2430                      Jobs => [ values %$all ]},
2431                    "running_job.tpl") ;
2432 }
2433
2434 sub eject_media
2435 {
2436     my ($self) = @_;
2437     my $arg = $self->get_form('jmedias', 'slots', 'ach');
2438
2439     unless ($arg->{jmedias}) {
2440         return $self->error("Can't get media selection");
2441     }
2442
2443     my $query = "
2444 SELECT Media.VolumeName  AS volumename,
2445        Storage.Name      AS storage,
2446        Location.Location AS location,
2447        Media.Slot        AS slot
2448 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2449            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2450 WHERE Media.VolumeName IN ($arg->{jmedias})
2451   AND Media.InChanger = 1
2452 ";
2453
2454     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2455
2456     my $a = Bweb::Autochanger::get('SDLT-1-2', $self);
2457
2458     $a->status();
2459     foreach my $vol (values %$all) {
2460         print "eject $vol->{volumename} from $vol->{storage} : ";
2461         if ($a->send_to_io($vol->{slot})) {
2462             print "ok</br>";
2463         } else {
2464             print "err</br>";
2465         }
2466     }
2467 }
2468
2469 sub restore
2470 {
2471     my ($self) = @_;
2472
2473     my $arg = $self->get_form('jobid', 'client');
2474
2475     print CGI::header('text/brestore');
2476     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2477     print "client=$arg->{client}\n" if ($arg->{client});
2478     print "\n";
2479 }
2480
2481 # TODO : move this to Bweb::Autochanger ?
2482 # TODO : make this internal to not eject tape ?
2483 use Bconsole;
2484
2485 sub delete
2486 {
2487     my ($self) = @_;
2488     my $arg = $self->get_form('jobid');
2489
2490     my $b = new Bconsole(pref => $self->{info});
2491
2492     if ($arg->{jobid}) {
2493         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2494         $self->display({
2495             content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2496             title => "Delete a job ",
2497             name => "delete jobid=$arg->{jobid}",
2498         }, "command.tpl");
2499     }
2500 }
2501
2502 sub update_slots
2503 {
2504     my ($self) = @_;
2505
2506     my $ach = CGI::param('ach') ;
2507     unless ($ach =~ /^([\w\d\.-]+)$/) {
2508         return $self->error("Bad autochanger name");
2509     }
2510
2511     my $b = new Bconsole(pref => $self->{info});
2512     print "<pre>" . $b->update_slots($ach) . "</pre>";
2513 }
2514
2515 sub get_job_log
2516 {
2517     my ($self) = @_;
2518
2519     my $arg = $self->get_form('jobid');
2520     unless ($arg->{jobid}) {
2521         return $self->error("Can't get jobid");
2522     }
2523
2524     my $t = CGI::param('time') || '';
2525
2526     my $query = "
2527 SELECT Job.Name as name, Client.Name as clientname
2528  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2529  WHERE JobId = $arg->{jobid}
2530 ";
2531
2532     my $row = $self->dbh_selectrow_hashref($query);
2533
2534     unless ($row) {
2535         return $self->error("Can't find $arg->{jobid} in catalog");
2536     }
2537
2538
2539     $query = "
2540 SELECT Time AS time, LogText AS log
2541  FROM  Log
2542  WHERE JobId = $arg->{jobid}
2543 ";
2544     my $log = $self->dbh_selectall_arrayref($query);
2545     unless ($log) {
2546         return $self->error("Can't get log for jobid $arg->{jobid}");
2547     }
2548
2549     if ($t) {
2550         # log contains \n
2551         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2552     } else {
2553         $logtxt = join("", map { $_->[1] } @$log ) ;
2554     }
2555
2556     $self->display({ lines=> $logtxt,
2557                      jobid => $arg->{jobid},
2558                      name  => $row->{name},
2559                      client => $row->{clientname},
2560                  }, 'display_log.tpl');
2561 }
2562
2563
2564 sub label_barcodes
2565 {
2566     my ($self) = @_ ;
2567
2568     my $arg = $self->get_form('ach', 'slots', 'drive');
2569
2570     unless ($arg->{ach}) {
2571         return $self->error("Can't find autochanger name");
2572     }
2573
2574     my $slots = '';
2575     if ($arg->{slots}) {
2576         $slots = join(",", @{ $arg->{slots} });
2577     }
2578
2579     my $t = 60*scalar( @{ $arg->{slots} });
2580     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2581     print "<h1>This command can take long time, be patient...</h1>";
2582     print "<pre>" ;
2583     $b->label_barcodes(storage => $arg->{ach},
2584                        drive => $arg->{drive},
2585                        pool  => 'Scratch',
2586                        slots => $slots) ;
2587     print "</pre>";
2588 }
2589
2590 sub purge
2591 {
2592     my ($self) = @_;
2593
2594     my @volume = CGI::param('media');
2595
2596     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2597
2598     $self->display({
2599         content => $b->purge_volume(@volume),
2600         title => "Purge media",
2601         name => "purge volume=" . join(' volume=', @volume),
2602     }, "command.tpl");
2603 }
2604
2605 sub prune
2606 {
2607     my ($self) = @_;
2608
2609     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2610
2611     my @volume = CGI::param('media');
2612     $self->display({
2613         content => $b->prune_volume(@volume),
2614         title => "Prune media",
2615         name => "prune volume=" . join(' volume=', @volume),
2616     }, "command.tpl");
2617 }
2618
2619 sub cancel_job
2620 {
2621     my ($self) = @_;
2622
2623     my $arg = $self->get_form('jobid');
2624     unless ($arg->{jobid}) {
2625         return $self->error('Bad jobid');
2626     }
2627
2628     my $b = new Bconsole(pref => $self->{info});
2629     $self->display({
2630         content => $b->cancel($arg->{jobid}),
2631         title => "Cancel job",
2632         name => "cancel jobid=$arg->{jobid}",
2633     }, "command.tpl");
2634 }
2635
2636 sub director_show_sched
2637 {
2638     my ($self) = @_ ;
2639
2640     my $arg = $self->get_form('days');
2641
2642     my $b = new Bconsole(pref => $self->{info}) ;
2643
2644     my $ret = $b->director_get_sched( $arg->{days} );
2645
2646     $self->display({
2647         id => $cur_id++,
2648         list => $ret,
2649     }, "scheduled_job.tpl");
2650 }
2651
2652 sub enable_disable_job
2653 {
2654     my ($self, $what) = @_ ;
2655
2656     my $name = CGI::param('job') || '';
2657     unless ($name =~ /^[\w\d\.\-\s]+$/) {
2658         return $self->error("Can't find job name");
2659     }
2660
2661     my $b = new Bconsole(pref => $self->{info}) ;
2662
2663     my $cmd;
2664     if ($what) {
2665         $cmd = "enable";
2666     } else {
2667         $cmd = "disable";
2668     }
2669
2670     $self->display({
2671         content => $b->send_cmd("$cmd job=\"$name\""),
2672         title => "$cmd $name",
2673         name => "$cmd job=\"$name\"",
2674     }, "command.tpl");
2675 }
2676
2677 sub run_job_select
2678 {
2679     my ($self) = @_;
2680     $b = new Bconsole(pref => $self->{info});
2681
2682     my $joblist = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".job")) ];
2683
2684     $self->display({ Jobs => $joblist }, "run_job.tpl");
2685 }
2686
2687 sub run_parse_job
2688 {
2689     my ($self, $ouput) = @_;
2690
2691     my %arg;
2692     foreach my $l (split(/\r\n/, $ouput)) {
2693         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
2694             $arg{$1} = $2;
2695             $l = $3
2696                 if ($3) ;
2697         }
2698
2699         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
2700             %arg = (%arg, @l);
2701         }
2702     }
2703
2704     my %lowcase ;
2705     foreach my $k (keys %arg) {
2706         $lowcase{lc($k)} = $arg{$k} ;
2707     }
2708
2709     return \%lowcase;
2710 }
2711
2712 sub run_job_mod
2713 {
2714     my ($self) = @_;
2715     $b = new Bconsole(pref => $self->{info});
2716
2717     my $job = CGI::param('job') || '';
2718
2719     my $info = $b->send_cmd("show job=\"$job\"");
2720     my $attr = $self->run_parse_job($info);
2721
2722     my $jobs   = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2723
2724     my $pools  = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".pool")) ];
2725     my $clients = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".client")) ];
2726     my $filesets= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".fileset")) ];
2727     my $storages= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".storage")) ];
2728
2729     $self->display({
2730         jobs     => $jobs,
2731         pools    => $pools,
2732         clients  => $clients,
2733         filesets => $filesets,
2734         storages => $storages,
2735         %$attr,
2736     }, "run_job_mod.tpl");
2737 }
2738
2739 sub run_job
2740 {
2741     my ($self) = @_;
2742     $b = new Bconsole(pref => $self->{info});
2743
2744     my $jobs   = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2745
2746     $self->display({
2747         jobs     => $jobs,
2748     }, "run_job.tpl");
2749 }
2750
2751 sub run_job_now
2752 {
2753     my ($self) = @_;
2754     $b = new Bconsole(pref => $self->{info});
2755
2756     # TODO: check input (don't use pool, level)
2757
2758     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
2759     my $job = CGI::param('job') || '';
2760     my $storage = CGI::param('storage') || '';
2761
2762     my $jobid = $b->run(job => $job,
2763                         client => $arg->{client},
2764                         priority => $arg->{priority},
2765                         level => $arg->{level},
2766                         storage => $storage,
2767                         pool => $arg->{pool},
2768                         );
2769
2770     print $jobid, $b->{error};
2771
2772     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
2773 }
2774
2775 1;