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

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