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

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