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