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

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