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