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