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{db_clients}) {
1440         my $query = "
1441 SELECT Client.Name as clientname
1442 FROM Client
1443 ";
1444
1445         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1446         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1447                               values %$clients] ;
1448     }
1449
1450     if ($what{db_mediatypes}) {
1451         my $query = "
1452 SELECT MediaType as mediatype
1453 FROM MediaType
1454 ";
1455
1456         my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1457         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1458                                   values %$medias] ;
1459     }
1460
1461     if ($what{db_locations}) {
1462         my $query = "
1463 SELECT Location as location, Cost as cost FROM Location
1464 ";
1465         my $loc = $self->dbh_selectall_hashref($query, 'location');
1466         $ret{db_locations} = [ sort { $a->{location}
1467                                       cmp
1468                                       $b->{location}
1469                                   } values %$loc ];
1470     }
1471
1472     if ($what{db_pools}) {
1473         my $query = "SELECT Name as name FROM Pool";
1474
1475         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1476         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1477     }
1478
1479     if ($what{db_filesets}) {
1480         my $query = "
1481 SELECT FileSet.FileSet AS fileset
1482 FROM FileSet
1483 ";
1484
1485         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1486
1487         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1488                                values %$filesets] ;
1489     }
1490
1491     if ($what{db_jobnames}) {
1492         my $query = "
1493 SELECT DISTINCT Job.Name AS jobname
1494 FROM Job
1495 ";
1496
1497         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1498
1499         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1500                                values %$jobnames] ;
1501     }
1502
1503     if ($what{db_devices}) {
1504         my $query = "
1505 SELECT Device.Name AS name
1506 FROM Device
1507 ";
1508
1509         my $devices = $self->dbh_selectall_hashref($query, 'name');
1510
1511         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1512                                values %$devices] ;
1513     }
1514
1515     return \%ret;
1516 }
1517
1518 sub display_graph
1519 {
1520     my ($self) = @_;
1521
1522     my $fields = $self->get_form(qw/age level status clients filesets
1523                                     graph gtype type
1524                                     db_clients limit db_filesets width height
1525                                     qclients qfilesets qjobnames db_jobnames/);
1526
1527
1528     my $url = CGI::url(-full => 0,
1529                        -base => 0,
1530                        -query => 1);
1531     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1532
1533 # this organisation is to keep user choice between 2 click
1534 # TODO : fileset and client selection doesn't work
1535
1536     $self->display({
1537         url => $url,
1538         %$fields,
1539     }, "graph.tpl")
1540
1541 }
1542
1543 sub display_client_job
1544 {
1545     my ($self, %arg) = @_ ;
1546
1547     $arg{order} = ' Job.JobId DESC ';
1548     my ($limit, $label) = $self->get_limit(%arg);
1549
1550     my $clientname = $self->dbh_quote($arg{clientname});
1551
1552     my $query="
1553 SELECT DISTINCT Job.JobId       AS jobid,
1554                 Job.Name        AS jobname,
1555                 FileSet.FileSet AS fileset,
1556                 Level           AS level,
1557                 StartTime       AS starttime,
1558                 JobFiles        AS jobfiles,
1559                 JobBytes        AS jobbytes,
1560                 JobStatus       AS jobstatus,
1561                 JobErrors       AS joberrors
1562
1563  FROM Client,Job,FileSet
1564  WHERE Client.Name=$clientname
1565  AND Client.ClientId=Job.ClientId
1566  AND Job.FileSetId=FileSet.FileSetId
1567  $limit
1568 ";
1569
1570     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1571
1572     $self->display({ clientname => $arg{clientname},
1573                      Filter => $label,
1574                      ID => $cur_id++,
1575                      Jobs => [ values %$all ],
1576                    },
1577                    "display_client_job.tpl") ;
1578 }
1579
1580 sub get_selected_media_location
1581 {
1582     my ($self) = @_ ;
1583
1584     my $medias = $self->get_form('jmedias');
1585
1586     unless ($medias->{jmedias}) {
1587         return undef;
1588     }
1589
1590     my $query = "
1591 SELECT Media.VolumeName AS volumename, Location.Location AS location
1592 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1593 WHERE Media.VolumeName IN ($medias->{jmedias})
1594 ";
1595
1596     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1597
1598     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1599     #               ..
1600     #             }
1601     # }
1602     return $all;
1603 }
1604
1605 sub move_media
1606 {
1607     my ($self) = @_ ;
1608
1609     my $medias = $self->get_selected_media_location();
1610
1611     unless ($medias) {
1612         return ;
1613     }
1614
1615     my $elt = $self->get_form('db_locations');
1616
1617     $self->display({ ID => $cur_id++,
1618                      %$elt,     # db_locations
1619                      medias => [
1620             sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1621                                ],
1622                      },
1623                    "move_media.tpl");
1624 }
1625
1626 sub help_extern
1627 {
1628     my ($self) = @_ ;
1629
1630     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1631     $self->debug($elt);
1632     $self->display($elt, "help_extern.tpl");
1633 }
1634
1635 sub help_extern_compute
1636 {
1637     my ($self) = @_;
1638
1639     my $number = CGI::param('limit') || '' ;
1640     unless ($number =~ /^(\d+)$/) {
1641         return $self->error("Bad arg number : $number ");
1642     }
1643
1644     my ($sql, undef) = $self->get_param('pools',
1645                                         'locations', 'mediatypes');
1646
1647     my $query = "
1648 SELECT Media.VolumeName  AS volumename,
1649        Media.VolStatus   AS volstatus,
1650        Media.LastWritten AS lastwritten,
1651        Media.MediaType   AS mediatype,
1652        Media.VolMounts   AS volmounts,
1653        Pool.Name         AS name,
1654        Media.Recycle     AS recycle,
1655        $self->{sql}->{FROM_UNIXTIME}(
1656           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1657         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1658        ) AS expire
1659 FROM Media
1660  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1661  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1662
1663 WHERE Media.InChanger = 1
1664   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1665   $sql
1666 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1667 LIMIT $number
1668 " ;
1669
1670     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1671
1672     $self->display({ Medias => [ values %$all ] },
1673                    "help_extern_compute.tpl");
1674 }
1675
1676 sub help_intern
1677 {
1678     my ($self) = @_ ;
1679
1680     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1681     $self->display($param, "help_intern.tpl");
1682 }
1683
1684 sub help_intern_compute
1685 {
1686     my ($self) = @_;
1687
1688     my $number = CGI::param('limit') || '' ;
1689     unless ($number =~ /^(\d+)$/) {
1690         return $self->error("Bad arg number : $number ");
1691     }
1692
1693     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1694
1695     if (CGI::param('expired')) {
1696         $sql = "
1697 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1698        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1699     ) < NOW()
1700  " . $sql ;
1701     }
1702
1703     my $query = "
1704 SELECT Media.VolumeName  AS volumename,
1705        Media.VolStatus   AS volstatus,
1706        Media.LastWritten AS lastwritten,
1707        Media.MediaType   AS mediatype,
1708        Media.VolMounts   AS volmounts,
1709        Pool.Name         AS name,
1710        $self->{sql}->{FROM_UNIXTIME}(
1711           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1712         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1713        ) AS expire
1714 FROM Media
1715  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1716  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1717
1718 WHERE Media.InChanger <> 1
1719   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1720   AND Media.Recycle = 1
1721   $sql
1722 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1723 LIMIT $number
1724 " ;
1725
1726     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1727
1728     $self->display({ Medias => [ values %$all ] },
1729                    "help_intern_compute.tpl");
1730
1731 }
1732
1733 sub display_general
1734 {
1735     my ($self, %arg) = @_ ;
1736
1737     my ($limit, $label) = $self->get_limit(%arg);
1738
1739     my $query = "
1740 SELECT
1741     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1742     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1743     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1744     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1745     (SELECT count(Job.JobId)
1746       FROM Job
1747       WHERE Job.JobStatus IN ('E','e','f','A')
1748       $limit
1749     )                                         AS nb_err,
1750     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1751 ";
1752
1753     my $row = $self->dbh_selectrow_hashref($query) ;
1754
1755     $row->{nb_bytes} = human_size($row->{nb_bytes});
1756
1757     $row->{db_size} = '???';
1758     $row->{label} = $label;
1759
1760     $self->display($row, "general.tpl");
1761 }
1762
1763 sub get_param
1764 {
1765     my ($self, @what) = @_ ;
1766     my %elt = map { $_ => 1 } @what;
1767     my %ret;
1768
1769     my $limit = '';
1770
1771     if ($elt{clients}) {
1772         my @clients = grep { ! /^\s*$/ } CGI::param('client');
1773         if (@clients) {
1774             $ret{clients} = \@clients;
1775             my $str = $self->dbh_join(@clients);
1776             $limit .= "AND Client.Name IN ($str) ";
1777         }
1778     }
1779
1780     if ($elt{filesets}) {
1781         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1782         if (@filesets) {
1783             $ret{filesets} = \@filesets;
1784             my $str = $self->dbh_join(@filesets);
1785             $limit .= "AND FileSet.FileSet IN ($str) ";
1786         }
1787     }
1788
1789     if ($elt{mediatypes}) {
1790         my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1791         if (@medias) {
1792             $ret{mediatypes} = \@medias;
1793             my $str = $self->dbh_join(@medias);
1794             $limit .= "AND Media.MediaType IN ($str) ";
1795         }
1796     }
1797
1798     if ($elt{client}) {
1799         my $client = CGI::param('client');
1800         $ret{client} = $client;
1801         $client = $self->dbh_join($client);
1802         $limit .= "AND Client.Name = $client ";
1803     }
1804
1805     if ($elt{level}) {
1806         my $level = CGI::param('level') || '';
1807         if ($level =~ /^(\w)$/) {
1808             $ret{level} = $1;
1809             $limit .= "AND Job.Level = '$1' ";
1810         }
1811     }
1812
1813     if ($elt{jobid}) {
1814         my $jobid = CGI::param('jobid') || '';
1815
1816         if ($jobid =~ /^(\d+)$/) {
1817             $ret{jobid} = $1;
1818             $limit .= "AND Job.JobId = '$1' ";
1819         }
1820     }
1821
1822     if ($elt{status}) {
1823         my $status = CGI::param('status') || '';
1824         if ($status =~ /^(\w)$/) {
1825             $ret{status} = $1;
1826             if ($1 eq 'f') {
1827                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1828             } else {
1829                 $limit .= "AND Job.JobStatus = '$1' ";
1830             }
1831         }
1832     }
1833
1834     if ($elt{volstatus}) {
1835         my $status = CGI::param('volstatus') || '';
1836         if ($status =~ /^(\w)$/) {
1837             $ret{status} = $1;
1838             $limit .= "AND Media.VolStatus = '$1' ";
1839         }
1840     }
1841
1842     if ($elt{locations}) {
1843         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1844         if (@location) {
1845             $ret{locations} = \@location;
1846             my $str = $self->dbh_join(@location);
1847             $limit .= "AND Location.Location IN ($str) ";
1848         }
1849     }
1850
1851     if ($elt{pools}) {
1852         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1853         if (@pool) {
1854             $ret{pools} = \@pool;
1855             my $str = $self->dbh_join(@pool);
1856             $limit .= "AND Pool.Name IN ($str) ";
1857         }
1858     }
1859
1860     if ($elt{location}) {
1861         my $location = CGI::param('location') || '';
1862         if ($location) {
1863             $ret{location} = $location;
1864             $location = $self->dbh_quote($location);
1865             $limit .= "AND Location.Location = $location ";
1866         }
1867     }
1868
1869     if ($elt{pool}) {
1870         my $pool = CGI::param('pool') || '';
1871         if ($pool) {
1872             $ret{pool} = $pool;
1873             $pool = $self->dbh_quote($pool);
1874             $limit .= "AND Pool.Name = $pool ";
1875         }
1876     }
1877
1878     if ($elt{jobtype}) {
1879         my $jobtype = CGI::param('jobtype') || '';
1880         if ($jobtype =~ /^(\w)$/) {
1881             $ret{jobtype} = $1;
1882             $limit .= "AND Job.Type = '$1' ";
1883         }
1884     }
1885
1886     return ($limit, %ret);
1887 }
1888
1889 =head1
1890
1891     get last backup
1892
1893 =cut
1894
1895 sub display_job
1896 {
1897     my ($self, %arg) = @_ ;
1898
1899     $arg{order} = ' Job.JobId DESC ';
1900
1901     my ($limit, $label) = $self->get_limit(%arg);
1902     my ($where, undef) = $self->get_param('clients',
1903                                           'level',
1904                                           'filesets',
1905                                           'jobtype',
1906                                           'jobid',
1907                                           'status');
1908
1909     my $query="
1910 SELECT  Job.JobId       AS jobid,
1911         Client.Name     AS client,
1912         FileSet.FileSet AS fileset,
1913         Job.Name        AS jobname,
1914         Level           AS level,
1915         StartTime       AS starttime,
1916         Pool.Name       AS poolname,
1917         JobFiles        AS jobfiles,
1918         JobBytes        AS jobbytes,
1919         JobStatus       AS jobstatus,
1920      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1921                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1922                         AS duration,
1923
1924         JobErrors       AS joberrors
1925
1926  FROM Client,
1927       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1928           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1929  WHERE Client.ClientId=Job.ClientId
1930    AND Job.JobStatus != 'R'
1931  $where
1932  $limit
1933 ";
1934
1935     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1936
1937     $self->display({ Filter => $label,
1938                      ID => $cur_id++,
1939                      Jobs =>
1940                            [
1941                              sort { $a->{jobid} <=>  $b->{jobid} }
1942                                         values %$all
1943                              ],
1944                    },
1945                    "display_job.tpl");
1946 }
1947
1948 # display job informations
1949 sub display_job_zoom
1950 {
1951     my ($self, $jobid) = @_ ;
1952
1953     $jobid = $self->dbh_quote($jobid);
1954
1955     my $query="
1956 SELECT DISTINCT Job.JobId       AS jobid,
1957                 Client.Name     AS client,
1958                 Job.Name        AS jobname,
1959                 FileSet.FileSet AS fileset,
1960                 Level           AS level,
1961                 Pool.Name       AS poolname,
1962                 StartTime       AS starttime,
1963                 JobFiles        AS jobfiles,
1964                 JobBytes        AS jobbytes,
1965                 JobStatus       AS jobstatus,
1966                 JobErrors       AS joberrors,
1967                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1968                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1969
1970  FROM Client,
1971       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1972           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1973  WHERE Client.ClientId=Job.ClientId
1974  AND Job.JobId = $jobid
1975 ";
1976
1977     my $row = $self->dbh_selectrow_hashref($query) ;
1978
1979     # display all volumes associate with this job
1980     $query="
1981 SELECT Media.VolumeName as volumename
1982 FROM Job,Media,JobMedia
1983 WHERE Job.JobId = $jobid
1984  AND JobMedia.JobId=Job.JobId
1985  AND JobMedia.MediaId=Media.MediaId
1986 ";
1987
1988     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1989
1990     $row->{volumes} = [ values %$all ] ;
1991
1992     $self->display($row, "display_job_zoom.tpl");
1993 }
1994
1995 sub display_media
1996 {
1997     my ($self) = @_ ;
1998
1999     my ($where, %elt) = $self->get_param('pools',
2000                                          'mediatypes',
2001                                          'volstatus',
2002                                          'locations');
2003
2004     my $arg = $self->get_form('jmedias', 'qre_media');
2005
2006     if ($arg->{jmedias}) {
2007         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2008     }
2009     if ($arg->{qre_media}) {
2010         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2011     }
2012
2013     my $query="
2014 SELECT Media.VolumeName  AS volumename,
2015        Media.VolBytes    AS volbytes,
2016        Media.VolStatus   AS volstatus,
2017        Media.MediaType   AS mediatype,
2018        Media.InChanger   AS online,
2019        Media.LastWritten AS lastwritten,
2020        Location.Location AS location,
2021        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2022        Pool.Name         AS poolname,
2023        $self->{sql}->{FROM_UNIXTIME}(
2024           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2025         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2026        ) AS expire
2027 FROM      Pool, Media
2028 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2029 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2030                   Media.MediaType     AS MediaType
2031            FROM Media
2032           WHERE Media.VolStatus = 'Full'
2033           GROUP BY Media.MediaType
2034            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2035
2036 WHERE Media.PoolId=Pool.PoolId
2037 $where
2038 ";
2039
2040     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2041
2042     $self->display({ ID => $cur_id++,
2043                      Pool => $elt{pool},
2044                      Location => $elt{location},
2045                      Medias => [ values %$all ]
2046                    },
2047                    "display_media.tpl");
2048 }
2049
2050 sub display_medias
2051 {
2052     my ($self) = @_ ;
2053
2054     my $pool = $self->get_form('db_pools');
2055
2056     foreach my $name (@{ $pool->{db_pools} }) {
2057         CGI::param('pool', $name->{name});
2058         $self->display_media();
2059     }
2060 }
2061
2062 sub display_media_zoom
2063 {
2064     my ($self) = @_ ;
2065
2066     my $medias = $self->get_form('jmedias');
2067
2068     unless ($medias->{jmedias}) {
2069         return $self->error("Can't get media selection");
2070     }
2071
2072     my $query="
2073 SELECT InChanger     AS online,
2074        VolBytes      AS nb_bytes,
2075        VolumeName    AS volumename,
2076        VolStatus     AS volstatus,
2077        VolMounts     AS nb_mounts,
2078        Media.VolUseDuration   AS voluseduration,
2079        Media.MaxVolJobs AS maxvoljobs,
2080        Media.MaxVolFiles AS maxvolfiles,
2081        Media.MaxVolBytes AS maxvolbytes,
2082        VolErrors     AS nb_errors,
2083        Pool.Name     AS poolname,
2084        Location.Location AS location,
2085        Media.Recycle AS recycle,
2086        Media.VolRetention AS volretention,
2087        Media.LastWritten  AS lastwritten,
2088        Media.VolReadTime/1000000  AS volreadtime,
2089        Media.VolWriteTime/1000000 AS volwritetime,
2090        Media.RecycleCount AS recyclecount,
2091        Media.Comment      AS comment,
2092        $self->{sql}->{FROM_UNIXTIME}(
2093           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2094         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2095        ) AS expire
2096  FROM Pool,
2097       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2098  WHERE Pool.PoolId = Media.PoolId
2099  AND VolumeName IN ($medias->{jmedias})
2100 ";
2101
2102     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2103
2104     foreach my $media (values %$all) {
2105         my $mq = $self->dbh_quote($media->{volumename});
2106
2107         $query = "
2108 SELECT DISTINCT Job.JobId AS jobid,
2109                 Job.Name  AS name,
2110                 Job.StartTime AS starttime,
2111                 Job.Type  AS type,
2112                 Job.Level AS level,
2113                 Job.JobFiles AS files,
2114                 Job.JobBytes AS bytes,
2115                 Job.jobstatus AS status
2116  FROM Media,JobMedia,Job
2117  WHERE Media.VolumeName=$mq
2118  AND Media.MediaId=JobMedia.MediaId
2119  AND JobMedia.JobId=Job.JobId
2120 ";
2121
2122         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2123
2124         $query = "
2125 SELECT LocationLog.Date    AS date,
2126        Location.Location   AS location,
2127        LocationLog.Comment AS comment
2128  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2129  WHERE Media.MediaId = LocationLog.MediaId
2130    AND Media.VolumeName = $mq
2131 ";
2132
2133         my $logtxt = '';
2134         my $log = $self->dbh_selectall_arrayref($query) ;
2135         if ($log) {
2136             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2137         }
2138
2139         $self->display({ jobs => [ values %$jobs ],
2140                          LocationLog => $logtxt,
2141                          %$media },
2142                        "display_media_zoom.tpl");
2143     }
2144 }
2145
2146 sub location_edit
2147 {
2148     my ($self) = @_ ;
2149
2150     my $loc = $self->get_form('qlocation');
2151     unless ($loc->{qlocation}) {
2152         return $self->error("Can't get location");
2153     }
2154
2155     my $query = "
2156 SELECT Location.Location AS location,
2157        Location.Cost   AS cost,
2158        Location.Enabled AS enabled
2159 FROM Location
2160 WHERE Location.Location = $loc->{qlocation}
2161 ";
2162
2163     my $row = $self->dbh_selectrow_hashref($query);
2164
2165     $self->display({ ID => $cur_id++,
2166                      %$row }, "location_edit.tpl") ;
2167
2168 }
2169
2170 sub location_save
2171 {
2172     my ($self) = @_ ;
2173
2174     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2175     unless ($arg->{qlocation}) {
2176         return $self->error("Can't get location");
2177     }
2178     unless ($arg->{qnewlocation}) {
2179         return $self->error("Can't get new location name");
2180     }
2181     unless ($arg->{cost}) {
2182         return $self->error("Can't get new cost");
2183     }
2184
2185     my $enabled = CGI::param('enabled') || '';
2186     $enabled = $enabled?1:0;
2187
2188     my $query = "
2189 UPDATE Location SET Cost     = $arg->{cost},
2190                     Location = $arg->{qnewlocation},
2191                     Enabled   = $enabled
2192 WHERE Location.Location = $arg->{qlocation}
2193 ";
2194
2195     $self->dbh_do($query);
2196
2197     $self->display_location();
2198 }
2199
2200 sub location_del
2201 {
2202     my ($self) = @_ ;
2203     my $arg = $self->get_form(qw/qlocation/) ;
2204
2205     unless ($arg->{qlocation}) {
2206         return $self->error("Can't get location");
2207     }
2208
2209     my $query = "
2210 SELECT count(Media.MediaId) AS nb
2211   FROM Media INNER JOIN Location USING (LocationID)
2212 WHERE Location = $arg->{qlocation}
2213 ";
2214
2215     my $res = $self->dbh_selectrow_hashref($query);
2216
2217     if ($res->{nb}) {
2218         return $self->error("Sorry, the location must be empty");
2219     }
2220
2221     $query = "
2222 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2223 ";
2224
2225     $self->dbh_do($query);
2226
2227     $self->display_location();
2228 }
2229
2230
2231 sub location_add
2232 {
2233     my ($self) = @_ ;
2234     my $arg = $self->get_form(qw/qlocation cost/) ;
2235
2236     unless ($arg->{qlocation}) {
2237         $self->display({}, "location_add.tpl");
2238         return 1;
2239     }
2240     unless ($arg->{cost}) {
2241         return $self->error("Can't get new cost");
2242     }
2243
2244     my $enabled = CGI::param('enabled') || '';
2245     $enabled = $enabled?1:0;
2246
2247     my $query = "
2248 INSERT INTO Location (Location, Cost, Enabled)
2249        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2250 ";
2251
2252     $self->dbh_do($query);
2253
2254     $self->display_location();
2255 }
2256
2257 sub display_location
2258 {
2259     my ($self) = @_ ;
2260
2261     my $query = "
2262 SELECT Location.Location AS location,
2263        Location.Cost     AS cost,
2264        Location.Enabled  AS enabled,
2265        (SELECT count(Media.MediaId)
2266          FROM Media
2267         WHERE Media.LocationId = Location.LocationId
2268        ) AS volnum
2269 FROM Location
2270 ";
2271
2272     my $location = $self->dbh_selectall_hashref($query, 'location');
2273
2274     $self->display({ ID => $cur_id++,
2275                      Locations => [ values %$location ] },
2276                    "display_location.tpl");
2277 }
2278
2279 sub update_location
2280 {
2281     my ($self) = @_ ;
2282
2283     my $medias = $self->get_selected_media_location();
2284     unless ($medias) {
2285         return ;
2286     }
2287
2288     my $arg = $self->get_form('db_locations', 'qnewlocation');
2289
2290     $self->display({ email  => $self->{info}->{email_media},
2291                      %$arg,
2292                      medias => [ values %$medias ],
2293                    },
2294                    "update_location.tpl");
2295 }
2296
2297 sub get_media_max_size
2298 {
2299     my ($self, $type) = @_;
2300     my $query =
2301 "SELECT avg(VolBytes) AS size
2302   FROM Media
2303  WHERE Media.VolStatus = 'Full'
2304    AND Media.MediaType = '$type'
2305 ";
2306
2307     my $res = $self->selectrow_hashref($query);
2308
2309     if ($res) {
2310         return $res->{size};
2311     } else {
2312         return 0;
2313     }
2314 }
2315
2316 sub update_media
2317 {
2318     my ($self) = @_ ;
2319
2320     my $media = $self->get_form('qmedia');
2321
2322     unless ($media->{qmedia}) {
2323         return $self->error("Can't get media");
2324     }
2325
2326     my $query = "
2327 SELECT Media.Slot         AS slot,
2328        PoolMedia.Name     AS poolname,
2329        Media.VolStatus    AS volstatus,
2330        Media.InChanger    AS inchanger,
2331        Location.Location  AS location,
2332        Media.VolumeName   AS volumename,
2333        Media.MaxVolBytes  AS maxvolbytes,
2334        Media.MaxVolJobs   AS maxvoljobs,
2335        Media.MaxVolFiles  AS maxvolfiles,
2336        Media.VolUseDuration AS voluseduration,
2337        Media.VolRetention AS volretention,
2338        Media.Comment      AS comment,
2339        PoolRecycle.Name   AS poolrecycle
2340
2341 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2342            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2343            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2344
2345 WHERE Media.VolumeName = $media->{qmedia}
2346 ";
2347
2348     my $row = $self->dbh_selectrow_hashref($query);
2349     $row->{volretention} = human_sec($row->{volretention});
2350     $row->{voluseduration} = human_sec($row->{voluseduration});
2351
2352     my $elt = $self->get_form(qw/db_pools db_locations/);
2353
2354     $self->display({
2355         %$elt,
2356         %$row,
2357     }, "update_media.tpl");
2358 }
2359
2360 sub save_location
2361 {
2362     my ($self) = @_ ;
2363
2364     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2365
2366     unless ($arg->{jmedias}) {
2367         return $self->error("Can't get selected media");
2368     }
2369
2370     unless ($arg->{qnewlocation}) {
2371         return $self->error("Can't get new location");
2372     }
2373
2374     my $query = "
2375  UPDATE Media
2376      SET LocationId = (SELECT LocationId
2377                        FROM Location
2378                        WHERE Location = $arg->{qnewlocation})
2379      WHERE Media.VolumeName IN ($arg->{jmedias})
2380 ";
2381
2382     my $nb = $self->dbh_do($query);
2383
2384     print "$nb media updated, you may have to update your autochanger.";
2385
2386     $self->display_media();
2387 }
2388
2389 sub change_location
2390 {
2391     my ($self) = @_ ;
2392
2393     my $medias = $self->get_selected_media_location();
2394     unless ($medias) {
2395         return $self->error("Can't get media selection");
2396     }
2397     my $newloc = CGI::param('newlocation');
2398
2399     my $user = CGI::param('user') || 'unknow';
2400     my $comm = CGI::param('comment') || '';
2401     $comm = $self->dbh_quote("$user: $comm");
2402
2403     my $query;
2404
2405     foreach my $media (keys %$medias) {
2406         $query = "
2407 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2408  VALUES(
2409        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2410        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2411        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2412       )
2413 ";
2414         $self->dbh_do($query);
2415         $self->debug($query);
2416     }
2417
2418     my $q = new CGI;
2419     $q->param('action', 'update_location');
2420     my $url = $q->url(-full => 1, -query=>1);
2421
2422     $self->display({ email  => $self->{info}->{email_media},
2423                      url => $url,
2424                      newlocation => $newloc,
2425                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2426                      medias => [ values %$medias ],
2427                    },
2428                    "change_location.tpl");
2429
2430 }
2431
2432 sub display_client_stats
2433 {
2434     my ($self, %arg) = @_ ;
2435
2436     my $client = $self->dbh_quote($arg{clientname});
2437     my ($limit, $label) = $self->get_limit(%arg);
2438
2439     my $query = "
2440 SELECT
2441     count(Job.JobId)     AS nb_jobs,
2442     sum(Job.JobBytes)    AS nb_bytes,
2443     sum(Job.JobErrors)   AS nb_err,
2444     sum(Job.JobFiles)    AS nb_files,
2445     Client.Name          AS clientname
2446 FROM Job INNER JOIN Client USING (ClientId)
2447 WHERE
2448     Client.Name = $client
2449     $limit
2450 GROUP BY Client.Name
2451 ";
2452
2453     my $row = $self->dbh_selectrow_hashref($query);
2454
2455     $row->{ID} = $cur_id++;
2456     $row->{label} = $label;
2457
2458     $self->display($row, "display_client_stats.tpl");
2459 }
2460
2461 # poolname can be undef
2462 sub display_pool
2463 {
2464     my ($self, $poolname) = @_ ;
2465     my $whereA = '';
2466     my $whereW = '';
2467
2468     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2469     if ($arg->{jmediatypes}) {
2470         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2471         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
2472     }
2473
2474 # TODO : afficher les tailles et les dates
2475
2476     my $query = "
2477 SELECT subq.volmax        AS volmax,
2478        subq.volnum        AS volnum,
2479        subq.voltotal      AS voltotal,
2480        Pool.Name          AS name,
2481        Pool.Recycle       AS recycle,
2482        Pool.VolRetention  AS volretention,
2483        Pool.VolUseDuration AS voluseduration,
2484        Pool.MaxVolJobs    AS maxvoljobs,
2485        Pool.MaxVolFiles   AS maxvolfiles,
2486        Pool.MaxVolBytes   AS maxvolbytes,
2487        subq.PoolId        AS PoolId
2488 FROM
2489   (
2490     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2491            count(Media.MediaId)  AS volnum,
2492            sum(Media.VolBytes)   AS voltotal,
2493            Media.PoolId          AS PoolId,
2494            Media.MediaType       AS MediaType
2495     FROM Media
2496     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2497                       Media.MediaType     AS MediaType
2498                FROM Media
2499               WHERE Media.VolStatus = 'Full'
2500               GROUP BY Media.MediaType
2501                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2502     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2503   ) AS subq
2504 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2505 $whereW
2506 ";
2507
2508     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2509
2510     $query = "
2511 SELECT Pool.Name AS name,
2512        sum(VolBytes) AS size
2513 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2514 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
2515        $whereA
2516 GROUP BY Pool.Name;
2517 ";
2518     my $empty = $self->dbh_selectall_hashref($query, 'name');
2519
2520     foreach my $p (values %$all) {
2521         if ($p->{volmax} > 0) { # mysql returns 0.0000
2522             # we remove Recycled/Purged media from pool usage
2523             if (defined $empty->{$p->{name}}) {
2524                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2525             }
2526             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2527         } else {
2528             $p->{poolusage} = 0;
2529         }
2530
2531         $query = "
2532   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2533     FROM Media
2534    WHERE PoolId=$p->{poolid}
2535          $whereA
2536 GROUP BY VolStatus
2537 ";
2538         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2539         foreach my $t (values %$content) {
2540             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2541         }
2542     }
2543
2544     $self->debug($all);
2545     $self->display({ ID => $cur_id++,
2546                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2547                      Pools => [ values %$all ]},
2548                    "display_pool.tpl");
2549 }
2550
2551 sub display_running_job
2552 {
2553     my ($self) = @_;
2554
2555     my $arg = $self->get_form('client', 'jobid');
2556
2557     if (!$arg->{client} and $arg->{jobid}) {
2558
2559         my $query = "
2560 SELECT Client.Name AS name
2561 FROM Job INNER JOIN Client USING (ClientId)
2562 WHERE Job.JobId = $arg->{jobid}
2563 ";
2564
2565         my $row = $self->dbh_selectrow_hashref($query);
2566
2567         if ($row) {
2568             $arg->{client} = $row->{name};
2569             CGI::param('client', $arg->{client});
2570         }
2571     }
2572
2573     if ($arg->{client}) {
2574         my $cli = new Bweb::Client(name => $arg->{client});
2575         $cli->display_running_job($self->{info}, $arg->{jobid});
2576         if ($arg->{jobid}) {
2577             $self->get_job_log();
2578         }
2579     } else {
2580         $self->error("Can't get client or jobid");
2581     }
2582 }
2583
2584 sub display_running_jobs
2585 {
2586     my ($self, $display_action) = @_;
2587
2588     my $query = "
2589 SELECT Job.JobId AS jobid,
2590        Job.Name  AS jobname,
2591        Job.Level     AS level,
2592        Job.StartTime AS starttime,
2593        Job.JobFiles  AS jobfiles,
2594        Job.JobBytes  AS jobbytes,
2595        Job.JobStatus AS jobstatus,
2596 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2597                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2598          AS duration,
2599        Client.Name AS clientname
2600 FROM Job INNER JOIN Client USING (ClientId)
2601 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2602 ";
2603     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2604
2605     $self->display({ ID => $cur_id++,
2606                      display_action => $display_action,
2607                      Jobs => [ values %$all ]},
2608                    "running_job.tpl") ;
2609 }
2610
2611 sub eject_media
2612 {
2613     my ($self) = @_;
2614     my $arg = $self->get_form('jmedias');
2615
2616     unless ($arg->{jmedias}) {
2617         return $self->error("Can't get media selection");
2618     }
2619
2620     my $query = "
2621 SELECT Media.VolumeName  AS volumename,
2622        Storage.Name      AS storage,
2623        Location.Location AS location,
2624        Media.Slot        AS slot
2625 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2626            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2627 WHERE Media.VolumeName IN ($arg->{jmedias})
2628   AND Media.InChanger = 1
2629 ";
2630
2631     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2632
2633     foreach my $vol (values %$all) {
2634         my $a = $self->ach_get($vol->{location});
2635         next unless ($a) ;
2636
2637         unless ($a->{have_status}) {
2638             $a->status();
2639             $a->{have_status} = 1;
2640         }
2641
2642         print "eject $vol->{volumename} from $vol->{storage} : ";
2643         if ($a->send_to_io($vol->{slot})) {
2644             print "ok</br>";
2645         } else {
2646             print "err</br>";
2647         }
2648     }
2649 }
2650
2651 sub move_email
2652 {
2653     my ($self) = @_;
2654
2655     my ($to, $subject, $content) = (CGI::param('email'),
2656                                     CGI::param('subject'),
2657                                     CGI::param('content'));
2658     $to =~ s/[^\w\d\.\@<>,]//;
2659     $subject =~ s/[^\w\d\.\[\]]/ /;
2660
2661     open(MAIL, "|mail -s '$subject' '$to'") ;
2662     print MAIL $content;
2663     close(MAIL);
2664
2665     print "Mail sent";
2666 }
2667
2668 sub restore
2669 {
2670     my ($self) = @_;
2671
2672     my $arg = $self->get_form('jobid', 'client');
2673
2674     print CGI::header('text/brestore');
2675     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2676     print "client=$arg->{client}\n" if ($arg->{client});
2677     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2678     print "\n";
2679 }
2680
2681 # TODO : move this to Bweb::Autochanger ?
2682 # TODO : make this internal to not eject tape ?
2683 use Bconsole;
2684
2685
2686 sub ach_get
2687 {
2688     my ($self, $name) = @_;
2689
2690     unless ($name) {
2691         return $self->error("Can't get your autochanger name ach");
2692     }
2693
2694     unless ($self->{info}->{ach_list}) {
2695         return $self->error("Could not find any autochanger");
2696     }
2697
2698     my $a = $self->{info}->{ach_list}->{$name};
2699
2700     unless ($a) {
2701         $self->error("Can't get your autochanger $name from your ach_list");
2702         return undef;
2703     }
2704
2705     $a->{bweb} = $self;
2706
2707     return $a;
2708 }
2709
2710 sub ach_register
2711 {
2712     my ($self, $ach) = @_;
2713
2714     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2715
2716     $self->{info}->save();
2717
2718     return 1;
2719 }
2720
2721 sub ach_edit
2722 {
2723     my ($self) = @_;
2724     my $arg = $self->get_form('ach');
2725     if (!$arg->{ach}
2726         or !$self->{info}->{ach_list}
2727         or !$self->{info}->{ach_list}->{$arg->{ach}})
2728     {
2729         return $self->error("Can't get autochanger name");
2730     }
2731
2732     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2733
2734     my $i=0;
2735     $ach->{drives} =
2736         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2737
2738     my $b = $self->get_bconsole();
2739
2740     my @storages = $b->list_storage() ;
2741
2742     $ach->{devices} = [ map { { name => $_ } } @storages ];
2743
2744     $self->display($ach, "ach_add.tpl");
2745     delete $ach->{drives};
2746     delete $ach->{devices};
2747     return 1;
2748 }
2749
2750 sub ach_del
2751 {
2752     my ($self) = @_;
2753     my $arg = $self->get_form('ach');
2754
2755     if (!$arg->{ach}
2756         or !$self->{info}->{ach_list}
2757         or !$self->{info}->{ach_list}->{$arg->{ach}})
2758     {
2759         return $self->error("Can't get autochanger name");
2760     }
2761
2762     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2763
2764     $self->{info}->save();
2765     $self->{info}->view();
2766 }
2767
2768 sub ach_add
2769 {
2770     my ($self) = @_;
2771     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2772
2773     my $b = $self->get_bconsole();
2774     my @storages = $b->list_storage() ;
2775
2776     unless ($arg->{ach}) {
2777         $arg->{devices} = [ map { { name => $_ } } @storages ];
2778         return $self->display($arg, "ach_add.tpl");
2779     }
2780
2781     my @drives ;
2782     foreach my $drive (CGI::param('drives'))
2783     {
2784         unless (grep(/^$drive$/,@storages)) {
2785             return $self->error("Can't find $drive in storage list");
2786         }
2787
2788         my $index = CGI::param("index_$drive");
2789         unless (defined $index and $index =~ /^(\d+)$/) {
2790             return $self->error("Can't get $drive index");
2791         }
2792
2793         $drives[$index] = $drive;
2794     }
2795
2796     unless (@drives) {
2797         return $self->error("Can't get drives from Autochanger");
2798     }
2799
2800     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2801                                   precmd => $arg->{precmd},
2802                                   drive_name => \@drives,
2803                                   device => $arg->{device},
2804                                   mtxcmd => $arg->{mtxcmd});
2805
2806     $self->ach_register($a) ;
2807
2808     $self->{info}->view();
2809 }
2810
2811 sub delete
2812 {
2813     my ($self) = @_;
2814     my $arg = $self->get_form('jobid');
2815
2816     if ($arg->{jobid}) {
2817         my $b = $self->get_bconsole();
2818         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2819
2820         $self->display({
2821             content => $ret,
2822             title => "Delete a job ",
2823             name => "delete jobid=$arg->{jobid}",
2824         }, "command.tpl");
2825     }
2826 }
2827
2828 sub do_update_media
2829 {
2830     my ($self) = @_ ;
2831
2832     my $arg = $self->get_form(qw/media volstatus inchanger pool
2833                                  slot volretention voluseduration
2834                                  maxvoljobs maxvolfiles maxvolbytes
2835                                  qcomment poolrecycle
2836                               /);
2837
2838     unless ($arg->{media}) {
2839         return $self->error("Can't find media selection");
2840     }
2841
2842     my $update = "update volume=$arg->{media} ";
2843
2844     if ($arg->{volstatus}) {
2845         $update .= " volstatus=$arg->{volstatus} ";
2846     }
2847
2848     if ($arg->{inchanger}) {
2849         $update .= " inchanger=yes " ;
2850         if ($arg->{slot}) {
2851             $update .= " slot=$arg->{slot} ";
2852         }
2853     } else {
2854         $update .= " slot=0 inchanger=no ";
2855     }
2856
2857     if ($arg->{pool}) {
2858         $update .= " pool=$arg->{pool} " ;
2859     }
2860
2861     $arg->{volretention} ||= 0 ;
2862     if ($arg->{volretention}) {
2863         $update .= " volretention=\"$arg->{volretention}\" " ;
2864     }
2865
2866     $arg->{voluseduration} ||= 0 ;
2867     if ($arg->{voluseduration}) {
2868         $update .= " voluse=\"$arg->{voluseduration}\" " ;
2869     }
2870
2871     $arg->{maxvoljobs} ||= 0;
2872     if ($arg->{maxvoljobs}) {
2873         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2874     }
2875
2876     $arg->{maxvolfiles} ||= 0;
2877     if ($arg->{maxvolfiles}) {
2878         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2879     }
2880
2881     $arg->{maxvolbytes} ||= 0;
2882     if ($arg->{maxvolbytes}) {
2883         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2884     }
2885
2886     my $b = $self->get_bconsole();
2887
2888     $self->display({
2889         content => $b->send_cmd($update),
2890         title => "Update a volume ",
2891         name => $update,
2892     }, "command.tpl");
2893
2894
2895     my @q;
2896     my $media = $self->dbh_quote($arg->{media});
2897
2898     my $loc = CGI::param('location') || '';
2899     if ($loc) {
2900         $loc = $self->dbh_quote($loc); # is checked by db
2901         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2902     }
2903     if ($arg->{poolrecycle}) {
2904         push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2905     }
2906     if (!$arg->{qcomment}) {
2907         $arg->{qcomment} = "''";
2908     }
2909     push @q, "Comment=$arg->{qcomment}";
2910
2911
2912     my $query = "
2913 UPDATE Media
2914    SET " . join (',', @q) . "
2915  WHERE Media.VolumeName = $media
2916 ";
2917     $self->dbh_do($query);
2918
2919     $self->update_media();
2920 }
2921
2922 sub update_slots
2923 {
2924     my ($self) = @_;
2925
2926     my $ach = CGI::param('ach') ;
2927     $ach = $self->ach_get($ach);
2928     unless ($ach) {
2929         return $self->error("Bad autochanger name");
2930     }
2931
2932     print "<pre>";
2933     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2934     $b->update_slots($ach->{name});
2935     print "</pre>\n"
2936 }
2937
2938 sub get_job_log
2939 {
2940     my ($self) = @_;
2941
2942     my $arg = $self->get_form('jobid');
2943     unless ($arg->{jobid}) {
2944         return $self->error("Can't get jobid");
2945     }
2946
2947     my $t = CGI::param('time') || '';
2948
2949     my $query = "
2950 SELECT Job.Name as name, Client.Name as clientname
2951  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2952  WHERE JobId = $arg->{jobid}
2953 ";
2954
2955     my $row = $self->dbh_selectrow_hashref($query);
2956
2957     unless ($row) {
2958         return $self->error("Can't find $arg->{jobid} in catalog");
2959     }
2960
2961     $query = "
2962 SELECT Time AS time, LogText AS log
2963   FROM  Log
2964  WHERE Log.JobId = $arg->{jobid}
2965     OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2966                       AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2967        )
2968  ORDER BY LogId;
2969 ";
2970
2971     my $log = $self->dbh_selectall_arrayref($query);
2972     unless ($log) {
2973         return $self->error("Can't get log for jobid $arg->{jobid}");
2974     }
2975
2976     my $logtxt;
2977     if ($t) {
2978         # log contains \n
2979         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2980     } else {
2981         $logtxt = join("", map { $_->[1] } @$log ) ;
2982     }
2983
2984     $self->display({ lines=> $logtxt,
2985                      jobid => $arg->{jobid},
2986                      name  => $row->{name},
2987                      client => $row->{clientname},
2988                  }, 'display_log.tpl');
2989 }
2990
2991
2992 sub label_barcodes
2993 {
2994     my ($self) = @_ ;
2995
2996     my $arg = $self->get_form('ach', 'slots', 'drive');
2997
2998     unless ($arg->{ach}) {
2999         return $self->error("Can't find autochanger name");
3000     }
3001
3002     my $slots = '';
3003     my $t = 300 ;
3004     if ($arg->{slots}) {
3005         $slots = join(",", @{ $arg->{slots} });
3006         $t += 60*scalar( @{ $arg->{slots} }) ;
3007     }
3008
3009     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3010     print "<h1>This command can take long time, be patient...</h1>";
3011     print "<pre>" ;
3012     $b->label_barcodes(storage => $arg->{ach},
3013                        drive => $arg->{drive},
3014                        pool  => 'Scratch',
3015                        slots => $slots) ;
3016     $b->close();
3017     print "</pre>";
3018 }
3019
3020 sub purge
3021 {
3022     my ($self) = @_;
3023
3024     my @volume = CGI::param('media');
3025
3026     unless (@volume) {
3027         return $self->error("Can't get media selection");
3028     }
3029
3030     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3031
3032     $self->display({
3033         content => $b->purge_volume(@volume),
3034         title => "Purge media",
3035         name => "purge volume=" . join(' volume=', @volume),
3036     }, "command.tpl");
3037     $b->close();
3038 }
3039
3040 sub prune
3041 {
3042     my ($self) = @_;
3043
3044     my @volume = CGI::param('media');
3045     unless (@volume) {
3046         return $self->error("Can't get media selection");
3047     }
3048
3049     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3050
3051     $self->display({
3052         content => $b->prune_volume(@volume),
3053         title => "Prune media",
3054         name => "prune volume=" . join(' volume=', @volume),
3055     }, "command.tpl");
3056
3057     $b->close();
3058 }
3059
3060 sub cancel_job
3061 {
3062     my ($self) = @_;
3063
3064     my $arg = $self->get_form('jobid');
3065     unless ($arg->{jobid}) {
3066         return $self->error("Can't get jobid");
3067     }
3068
3069     my $b = $self->get_bconsole();
3070     $self->display({
3071         content => $b->cancel($arg->{jobid}),
3072         title => "Cancel job",
3073         name => "cancel jobid=$arg->{jobid}",
3074     }, "command.tpl");
3075 }
3076
3077 sub fileset_view
3078 {
3079     # Warning, we display current fileset
3080     my ($self) = @_;
3081
3082     my $arg = $self->get_form('fileset');
3083
3084     if ($arg->{fileset}) {
3085         my $b = $self->get_bconsole();
3086         my $ret = $b->get_fileset($arg->{fileset});
3087         $self->display({ fileset => $arg->{fileset},
3088                          %$ret,
3089                      }, "fileset_view.tpl");
3090     } else {
3091         $self->error("Can't get fileset name");
3092     }
3093 }
3094
3095 sub director_show_sched
3096 {
3097     my ($self) = @_ ;
3098
3099     my $arg = $self->get_form('days');
3100
3101     my $b = $self->get_bconsole();
3102     my $ret = $b->director_get_sched( $arg->{days} );
3103
3104     $self->display({
3105         id => $cur_id++,
3106         list => $ret,
3107     }, "scheduled_job.tpl");
3108 }
3109
3110 sub enable_disable_job
3111 {
3112     my ($self, $what) = @_ ;
3113
3114     my $name = CGI::param('job') || '';
3115     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3116         return $self->error("Can't find job name");
3117     }
3118
3119     my $b = $self->get_bconsole();
3120
3121     my $cmd;
3122     if ($what) {
3123         $cmd = "enable";
3124     } else {
3125         $cmd = "disable";
3126     }
3127
3128     $self->display({
3129         content => $b->send_cmd("$cmd job=\"$name\""),
3130         title => "$cmd $name",
3131         name => "$cmd job=\"$name\"",
3132     }, "command.tpl");
3133 }
3134
3135 sub get_bconsole
3136 {
3137     my ($self) = @_;
3138     return new Bconsole(pref => $self->{info});
3139 }
3140
3141 sub run_job_select
3142 {
3143     my ($self) = @_;
3144     my $b = $self->get_bconsole();
3145
3146     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3147
3148     $self->display({ Jobs => $joblist }, "run_job.tpl");
3149 }
3150
3151 sub run_parse_job
3152 {
3153     my ($self, $ouput) = @_;
3154
3155     my %arg;
3156     foreach my $l (split(/\r\n/, $ouput)) {
3157         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3158             $arg{$1} = $2;
3159             $l = $3
3160                 if ($3) ;
3161         }
3162
3163         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3164             %arg = (%arg, @l);
3165         }
3166     }
3167
3168     my %lowcase ;
3169     foreach my $k (keys %arg) {
3170         $lowcase{lc($k)} = $arg{$k} ;
3171     }
3172
3173     return \%lowcase;
3174 }
3175
3176 sub run_job_mod
3177 {
3178     my ($self) = @_;
3179     my $b = $self->get_bconsole();
3180
3181     my $job = CGI::param('job') || '';
3182
3183     my $info = $b->send_cmd("show job=\"$job\"");
3184     my $attr = $self->run_parse_job($info);
3185
3186     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3187
3188     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3189     my $clients = [ map { { name => $_ } }$b->list_client()];
3190     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3191     my $storages= [ map { { name => $_ } }$b->list_storage()];
3192
3193     $self->display({
3194         jobs     => $jobs,
3195         pools    => $pools,
3196         clients  => $clients,
3197         filesets => $filesets,
3198         storages => $storages,
3199         %$attr,
3200     }, "run_job_mod.tpl");
3201 }
3202
3203 sub run_job
3204 {
3205     my ($self) = @_;
3206     my $b = $self->get_bconsole();
3207
3208     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3209
3210     $self->display({
3211         jobs     => $jobs,
3212     }, "run_job.tpl");
3213 }
3214
3215 sub run_job_now
3216 {
3217     my ($self) = @_;
3218     my $b = $self->get_bconsole();
3219
3220     # TODO: check input (don't use pool, level)
3221
3222     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3223     my $job = CGI::param('job') || '';
3224     my $storage = CGI::param('storage') || '';
3225
3226     my $jobid = $b->run(job => $job,
3227                         client => $arg->{client},
3228                         priority => $arg->{priority},
3229                         level => $arg->{level},
3230                         storage => $storage,
3231                         pool => $arg->{pool},
3232                         );
3233
3234     print $jobid, $b->{error};
3235
3236     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3237 }
3238
3239 1;