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 ($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
 956                 push @{ $param }, $all->{$vol};
 957
 958             } else {            # empty or no label
 959                 push @{ $param }, {realslot => $slot,
 960                                    volstatus => 'Unknow',
 961                                    volumename => $self->{slot}->[$slot]} ;
 962             }
 963         } else {                # empty
 964             push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
 965         }
 966     }
 967
 968     my $i=0; my $drives = [] ;
 969     foreach my $d (@{ $self->{drive} }) {
 970         $drives->[$i] = { index => $i,
 971                           load  => $self->{drive}->[$i],
 972                           name  => $self->{drive_name}->[$i],
 973                       };
 974         $i++;
 975     }
 976
 977     $bweb->display({ Name   => $self->{name},
 978                      nb_drive => $self->{info}->{drive},
 979                      nb_io => $self->{info}->{io},
 980                      Drives => $drives,
 981                      Slots  => $param,
 982                      Update => scalar(@to_update) },
 983                    'ach_content.tpl');
 984
 985 }
 986
 987 1;
 988
 989
 990 ################################################################
 991
 992 package Bweb;
 993
 994 use base q/Bweb::Gui/;
 995
 996 =head1 PACKAGE
 997
 998     Bweb - main Bweb package
 999
1000 =head2
1001
1002     this package is use to compute and display informations
1003
1004 =cut
1005
1006 use DBI;
1007 use POSIX qw/strftime/;
1008
1009 our $cur_id=0;
1010
1011 =head1 VARIABLE
1012
1013     %sql_func - hash to make query mysql/postgresql compliant
1014
1015 =cut
1016
1017 our %sql_func = (
1018           Pg => {
1019               UNIX_TIMESTAMP => '',
1020               FROM_UNIXTIME => '',
1021               TO_SEC => " interval '1 second' * ",
1022               SEC_TO_INT => "SEC_TO_INT",
1023               SEC_TO_TIME => '',
1024               MATCH => " ~ ",
1025               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1026               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1027               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1028               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1029               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1030               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1031           },
1032           mysql => {
1033               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1034               FROM_UNIXTIME => 'FROM_UNIXTIME',
1035               SEC_TO_INT => '',
1036               TO_SEC => '',
1037               SEC_TO_TIME => 'SEC_TO_TIME',
1038               MATCH => " REGEXP ",
1039               STARTTIME_DAY  => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1040               STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1041               STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1042               STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1043               STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1044               STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1045           },
1046          );
1047
1048 sub dbh_selectall_arrayref
1049 {
1050     my ($self, $query) = @_;
1051     $self->connect_db();
1052     $self->debug($query);
1053     return $self->{dbh}->selectall_arrayref($query);
1054 }
1055
1056 sub dbh_join
1057 {
1058     my ($self, @what) = @_;
1059     return join(',', $self->dbh_quote(@what)) ;
1060 }
1061
1062 sub dbh_quote
1063 {
1064     my ($self, @what) = @_;
1065
1066     $self->connect_db();
1067     if (wantarray) {
1068         return map { $self->{dbh}->quote($_) } @what;
1069     } else {
1070         return $self->{dbh}->quote($what[0]) ;
1071     }
1072 }
1073
1074 sub dbh_do
1075 {
1076     my ($self, $query) = @_ ;
1077     $self->connect_db();
1078     $self->debug($query);
1079     return $self->{dbh}->do($query);
1080 }
1081
1082 sub dbh_selectall_hashref
1083 {
1084     my ($self, $query, $join) = @_;
1085
1086     $self->connect_db();
1087     $self->debug($query);
1088     return $self->{dbh}->selectall_hashref($query, $join) ;
1089 }
1090
1091 sub dbh_selectrow_hashref
1092 {
1093     my ($self, $query) = @_;
1094
1095     $self->connect_db();
1096     $self->debug($query);
1097     return $self->{dbh}->selectrow_hashref($query) ;
1098 }
1099
1100 # display Mb/Gb/Kb
1101 sub human_size
1102 {
1103     my @unit = qw(b Kb Mb Gb Tb);
1104     my $val = shift || 0;
1105     my $i=0;
1106     my $format = '%i %s';
1107     while ($val / 1024 > 1) {
1108         $i++;
1109         $val /= 1024;
1110     }
1111     $format = ($i>0)?'%0.1f %s':'%i %s';
1112     return sprintf($format, $val, $unit[$i]);
1113 }
1114
1115 # display Day, Hour, Year
1116 sub human_sec
1117 {
1118     use integer;
1119
1120     my $val = shift;
1121     $val /= 60;                 # sec -> min
1122
1123     if ($val / 60 <= 1) {
1124         return "$val mins";
1125     }
1126
1127     $val /= 60;                 # min -> hour
1128     if ($val / 24 <= 1) {
1129         return "$val hours";
1130     }
1131
1132     $val /= 24;                 # hour -> day
1133     if ($val / 365 < 2) {
1134         return "$val days";
1135     }
1136
1137     $val /= 365 ;               # day -> year
1138
1139     return "$val years";
1140 }
1141
1142 # get Day, Hour, Year
1143 sub from_human_sec
1144 {
1145     use integer;
1146
1147     my $val = shift;
1148     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1149         return 0;
1150     }
1151
1152     my %times = ( m   => 60,
1153                   h   => 60*60,
1154                   d   => 60*60*24,
1155                   m   => 60*60*24*31,
1156                   y   => 60*60*24*365,
1157                   );
1158     my $mult = $times{$2} || 0;
1159
1160     return $1 * $mult;
1161 }
1162
1163
1164 sub connect_db
1165 {
1166     my ($self) = @_;
1167
1168     unless ($self->{dbh}) {
1169         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1170                                     $self->{info}->{user},
1171                                     $self->{info}->{password});
1172
1173         print "Can't connect to your database, see error log\n"
1174             unless ($self->{dbh});
1175
1176         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1177     }
1178 }
1179
1180 sub new
1181 {
1182     my ($class, %arg) = @_;
1183     my $self = bless {
1184         dbh => undef,           # connect_db();
1185         info => {
1186             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1187             user  => 'bacula',
1188             password => 'test',
1189         },
1190     } ;
1191
1192     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1193
1194     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1195         $self->{sql} = $sql_func{$1};
1196     }
1197
1198     $self->{debug} = $self->{info}->{debug};
1199     $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1200
1201     return $self;
1202 }
1203
1204 sub display_begin
1205 {
1206     my ($self) = @_;
1207     $self->display($self->{info}, "begin.tpl");
1208 }
1209
1210 sub display_end
1211 {
1212     my ($self) = @_;
1213     $self->display($self->{info}, "end.tpl");
1214 }
1215
1216 sub display_clients
1217 {
1218     my ($self) = @_;
1219
1220     my $where='';
1221     my $arg = $self->get_form("client", "qre_client");
1222
1223     if ($arg->{qre_client}) {
1224         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1225     } elsif ($arg->{client}) {
1226         $where = "WHERE Name = '$arg->{client}' ";
1227     }
1228
1229     my $query = "
1230 SELECT Name   AS name,
1231        Uname  AS uname,
1232        AutoPrune AS autoprune,
1233        FileRetention AS fileretention,
1234        JobRetention  AS jobretention
1235 FROM Client
1236 $where
1237 ";
1238
1239     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1240
1241     my $dsp = { ID => $cur_id++,
1242                 clients => [ values %$all] };
1243
1244     $self->display($dsp, "client_list.tpl") ;
1245 }
1246
1247 sub get_limit
1248 {
1249     my ($self, %arg) = @_;
1250
1251     my $limit = '';
1252     my $label = '';
1253
1254     if ($arg{age}) {
1255         $limit =
1256   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1257          >
1258        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1259          -
1260          $self->{sql}->{TO_SEC}($arg{age})
1261        )" ;
1262
1263         $label = "last " . human_sec($arg{age});
1264     }
1265
1266     if ($arg{groupby}) {
1267         $limit .= " GROUP BY $arg{groupby} ";
1268     }
1269
1270     if ($arg{order}) {
1271         $limit .= " ORDER BY $arg{order} ";
1272     }
1273
1274     if ($arg{limit}) {
1275         $limit .= " LIMIT $arg{limit} ";
1276         $label .= " limited to $arg{limit}";
1277     }
1278
1279     if ($arg{offset}) {
1280         $limit .= " OFFSET $arg{offset} ";
1281         $label .= " with $arg{offset} offset ";
1282     }
1283
1284     unless ($label) {
1285         $label = 'no filter';
1286     }
1287
1288     return ($limit, $label);
1289 }
1290
1291 =head1 FUNCTION
1292
1293     $bweb->get_form(...) - Get useful stuff
1294
1295 =head2 DESCRIPTION
1296
1297     This function get and check parameters against regexp.
1298
1299     If word begin with 'q', the return will be quoted or join quoted
1300     if it's end with 's'.
1301
1302
1303 =head2 EXAMPLE
1304
1305     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1306
1307     { jobid    => 12,
1308       qclient  => 'plume-fd',
1309       qpools   => "'plume-fd', 'test-fd', '...'",
1310     }
1311
1312 =cut
1313
1314 sub get_form
1315 {
1316     my ($self, @what) = @_;
1317     my %what = map { $_ => 1 } @what;
1318     my %ret;
1319
1320     my %opt_i = (
1321                  limit  => 100,
1322                  cost   =>  10,
1323                  offset =>   0,
1324                  width  => 640,
1325                  height => 480,
1326                  jobid  =>   0,
1327                  slot   =>   0,
1328                  drive  =>   0,
1329                  priority => 10,
1330                  age    => 60*60*24*7,
1331                  days   => 1,
1332                  );
1333
1334     my %opt_s = (               # default to ''
1335                  ach    => 1,
1336                  status => 1,
1337                  client => 1,
1338                  level  => 1,
1339                  pool   => 1,
1340                  media  => 1,
1341                  ach    => 1,
1342                  jobtype=> 1,
1343                  graph  => 1,
1344                  gtype  => 1,
1345                  type   => 1,
1346                  );
1347     my %opt_p = (               # option with path
1348                  fileset=> 1,
1349                  mtxcmd => 1,
1350                  precmd => 1,
1351                  device => 1,
1352                  );
1353
1354     foreach my $i (@what) {
1355         if (exists $opt_i{$i}) {# integer param
1356             my $value = CGI::param($i) || $opt_i{$i} ;
1357             if ($value =~ /^(\d+)$/) {
1358                 $ret{$i} = $1;
1359             }
1360         } elsif ($opt_s{$i}) {  # simple string param
1361             my $value = CGI::param($i) || '';
1362             if ($value =~ /^([\w\d\.-]+)$/) {
1363                 $ret{$i} = $1;
1364             }
1365
1366         } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1367             my @value = CGI::param($1) ;
1368             if (@value) {
1369                 $ret{$i} = $self->dbh_join(@value) ;
1370             }
1371
1372         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1373             my $value = CGI::param($1) ;
1374             if ($value) {
1375                 $ret{$i} = $self->dbh_quote($value);
1376             }
1377
1378         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1379             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1380                                   CGI::param($1) ];
1381         } elsif (exists $opt_p{$i}) {
1382             my $value = CGI::param($i) || '';
1383             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1384                 $ret{$i} = $1;
1385             }
1386         }
1387     }
1388
1389     if ($what{slots}) {
1390         foreach my $s (CGI::param('slot')) {
1391             if ($s =~ /^(\d+)$/) {
1392                 push @{$ret{slots}}, $s;
1393             }
1394         }
1395     }
1396
1397     if ($what{db_clients}) {
1398         my $query = "
1399 SELECT Client.Name as clientname
1400 FROM Client
1401 ";
1402
1403         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1404         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1405                               values %$clients] ;
1406     }
1407
1408     if ($what{db_mediatypes}) {
1409         my $query = "
1410 SELECT MediaType as mediatype
1411 FROM MediaType
1412 ";
1413
1414         my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1415         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1416                                   values %$medias] ;
1417     }
1418
1419     if ($what{db_locations}) {
1420         my $query = "
1421 SELECT Location as location, Cost as cost FROM Location
1422 ";
1423         my $loc = $self->dbh_selectall_hashref($query, 'location');
1424         $ret{db_locations} = [ sort { $a->{location}
1425                                       cmp
1426                                       $b->{location}
1427                                   } values %$loc ];
1428     }
1429
1430     if ($what{db_pools}) {
1431         my $query = "SELECT Name as name FROM Pool";
1432
1433         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1434         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1435     }
1436
1437     if ($what{db_filesets}) {
1438         my $query = "
1439 SELECT FileSet.FileSet AS fileset
1440 FROM FileSet
1441 ";
1442
1443         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1444
1445         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1446                                values %$filesets] ;
1447     }
1448
1449     if ($what{db_jobnames}) {
1450         my $query = "
1451 SELECT DISTINCT Job.Name AS jobname
1452 FROM Job
1453 ";
1454
1455         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1456
1457         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1458                                values %$jobnames] ;
1459     }
1460
1461     if ($what{db_devices}) {
1462         my $query = "
1463 SELECT Device.Name AS name
1464 FROM Device
1465 ";
1466
1467         my $devices = $self->dbh_selectall_hashref($query, 'name');
1468
1469         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1470                                values %$devices] ;
1471     }
1472
1473     return \%ret;
1474 }
1475
1476 sub display_graph
1477 {
1478     my ($self) = @_;
1479
1480     my $fields = $self->get_form(qw/age level status clients filesets
1481                                     graph gtype type
1482                                     db_clients limit db_filesets width height
1483                                     qclients qfilesets qjobnames db_jobnames/);
1484
1485
1486     my $url = CGI::url(-full => 0,
1487                        -base => 0,
1488                        -query => 1);
1489     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1490
1491 # this organisation is to keep user choice between 2 click
1492 # TODO : fileset and client selection doesn't work
1493
1494     $self->display({
1495         url => $url,
1496         %$fields,
1497     }, "graph.tpl")
1498
1499 }
1500
1501 sub display_client_job
1502 {
1503     my ($self, %arg) = @_ ;
1504
1505     $arg{order} = ' Job.JobId DESC ';
1506     my ($limit, $label) = $self->get_limit(%arg);
1507
1508     my $clientname = $self->dbh_quote($arg{clientname});
1509
1510     my $query="
1511 SELECT DISTINCT Job.JobId       AS jobid,
1512                 Job.Name        AS jobname,
1513                 FileSet.FileSet AS fileset,
1514                 Level           AS level,
1515                 StartTime       AS starttime,
1516                 JobFiles        AS jobfiles,
1517                 JobBytes        AS jobbytes,
1518                 JobStatus       AS jobstatus,
1519                 JobErrors       AS joberrors
1520
1521  FROM Client,Job,FileSet
1522  WHERE Client.Name=$clientname
1523  AND Client.ClientId=Job.ClientId
1524  AND Job.FileSetId=FileSet.FileSetId
1525  $limit
1526 ";
1527
1528     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1529
1530     $self->display({ clientname => $arg{clientname},
1531                      Filter => $label,
1532                      ID => $cur_id++,
1533                      Jobs => [ values %$all ],
1534                    },
1535                    "display_client_job.tpl") ;
1536 }
1537
1538 sub get_selected_media_location
1539 {
1540     my ($self) = @_ ;
1541
1542     my $medias = $self->get_form('jmedias');
1543
1544     unless ($medias->{jmedias}) {
1545         return undef;
1546     }
1547
1548     my $query = "
1549 SELECT Media.VolumeName AS volumename, Location.Location AS location
1550 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1551 WHERE Media.VolumeName IN ($medias->{jmedias})
1552 ";
1553
1554     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1555
1556     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1557     #               ..
1558     #             }
1559     # }
1560     return $all;
1561 }
1562
1563 sub move_media
1564 {
1565     my ($self) = @_ ;
1566
1567     my $medias = $self->get_selected_media_location();
1568
1569     unless ($medias) {
1570         return ;
1571     }
1572
1573     my $elt = $self->get_form('db_locations');
1574
1575     $self->display({ ID => $cur_id++,
1576                      %$elt,     # db_locations
1577                      medias => [
1578             sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1579                                ],
1580                      },
1581                    "move_media.tpl");
1582 }
1583
1584 sub help_extern
1585 {
1586     my ($self) = @_ ;
1587
1588     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1589     $self->debug($elt);
1590     $self->display($elt, "help_extern.tpl");
1591 }
1592
1593 sub help_extern_compute
1594 {
1595     my ($self) = @_;
1596
1597     my $number = CGI::param('limit') || '' ;
1598     unless ($number =~ /^(\d+)$/) {
1599         return $self->error("Bad arg number : $number ");
1600     }
1601
1602     my ($sql, undef) = $self->get_param('pools',
1603                                         'locations', 'mediatypes');
1604
1605     my $query = "
1606 SELECT Media.VolumeName  AS volumename,
1607        Media.VolStatus   AS volstatus,
1608        Media.LastWritten AS lastwritten,
1609        Media.MediaType   AS mediatype,
1610        Media.VolMounts   AS volmounts,
1611        Pool.Name         AS name,
1612        Media.Recycle     AS recycle,
1613        $self->{sql}->{FROM_UNIXTIME}(
1614           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1615         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1616        ) AS expire
1617 FROM Media
1618  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1619  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1620
1621 WHERE Media.InChanger = 1
1622   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1623   $sql
1624 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1625 LIMIT $number
1626 " ;
1627
1628     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1629
1630     $self->display({ Medias => [ values %$all ] },
1631                    "help_extern_compute.tpl");
1632 }
1633
1634 sub help_intern
1635 {
1636     my ($self) = @_ ;
1637
1638     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1639     $self->display($param, "help_intern.tpl");
1640 }
1641
1642 sub help_intern_compute
1643 {
1644     my ($self) = @_;
1645
1646     my $number = CGI::param('limit') || '' ;
1647     unless ($number =~ /^(\d+)$/) {
1648         return $self->error("Bad arg number : $number ");
1649     }
1650
1651     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1652
1653     if (CGI::param('expired')) {
1654         $sql = "
1655 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1656        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1657     ) < NOW()
1658  " . $sql ;
1659     }
1660
1661     my $query = "
1662 SELECT Media.VolumeName  AS volumename,
1663        Media.VolStatus   AS volstatus,
1664        Media.LastWritten AS lastwritten,
1665        Media.MediaType   AS mediatype,
1666        Media.VolMounts   AS volmounts,
1667        Pool.Name         AS name,
1668        $self->{sql}->{FROM_UNIXTIME}(
1669           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1670         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1671        ) AS expire
1672 FROM Media
1673  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1674  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1675
1676 WHERE Media.InChanger <> 1
1677   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1678   AND Media.Recycle = 1
1679   $sql
1680 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1681 LIMIT $number
1682 " ;
1683
1684     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1685
1686     $self->display({ Medias => [ values %$all ] },
1687                    "help_intern_compute.tpl");
1688
1689 }
1690
1691 sub display_general
1692 {
1693     my ($self, %arg) = @_ ;
1694
1695     my ($limit, $label) = $self->get_limit(%arg);
1696
1697     my $query = "
1698 SELECT
1699     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1700     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1701     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1702     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1703     (SELECT count(Job.JobId)
1704       FROM Job
1705       WHERE Job.JobStatus IN ('E','e','f','A')
1706       $limit
1707     )                                         AS nb_err,
1708     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1709 ";
1710
1711     my $row = $self->dbh_selectrow_hashref($query) ;
1712
1713     $row->{nb_bytes} = human_size($row->{nb_bytes});
1714
1715     $row->{db_size} = '???';
1716     $row->{label} = $label;
1717
1718     $self->display($row, "general.tpl");
1719 }
1720
1721 sub get_param
1722 {
1723     my ($self, @what) = @_ ;
1724     my %elt = map { $_ => 1 } @what;
1725     my %ret;
1726
1727     my $limit = '';
1728
1729     if ($elt{clients}) {
1730         my @clients = CGI::param('client');
1731         if (@clients) {
1732             $ret{clients} = \@clients;
1733             my $str = $self->dbh_join(@clients);
1734             $limit .= "AND Client.Name IN ($str) ";
1735         }
1736     }
1737
1738     if ($elt{filesets}) {
1739         my @filesets = CGI::param('fileset');
1740         if (@filesets) {
1741             $ret{filesets} = \@filesets;
1742             my $str = $self->dbh_join(@filesets);
1743             $limit .= "AND FileSet.FileSet IN ($str) ";
1744         }
1745     }
1746
1747     if ($elt{mediatypes}) {
1748         my @medias = CGI::param('mediatype');
1749         if (@medias) {
1750             $ret{mediatypes} = \@medias;
1751             my $str = $self->dbh_join(@medias);
1752             $limit .= "AND Media.MediaType IN ($str) ";
1753         }
1754     }
1755
1756     if ($elt{client}) {
1757         my $client = CGI::param('client');
1758         $ret{client} = $client;
1759         $client = $self->dbh_join($client);
1760         $limit .= "AND Client.Name = $client ";
1761     }
1762
1763     if ($elt{level}) {
1764         my $level = CGI::param('level') || '';
1765         if ($level =~ /^(\w)$/) {
1766             $ret{level} = $1;
1767             $limit .= "AND Job.Level = '$1' ";
1768         }
1769     }
1770
1771     if ($elt{jobid}) {
1772         my $jobid = CGI::param('jobid') || '';
1773
1774         if ($jobid =~ /^(\d+)$/) {
1775             $ret{jobid} = $1;
1776             $limit .= "AND Job.JobId = '$1' ";
1777         }
1778     }
1779
1780     if ($elt{status}) {
1781         my $status = CGI::param('status') || '';
1782         if ($status =~ /^(\w)$/) {
1783             $ret{status} = $1;
1784             if ($1 eq 'f') {
1785                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1786             } else {
1787                 $limit .= "AND Job.JobStatus = '$1' ";
1788             }
1789         }
1790     }
1791
1792     if ($elt{locations}) {
1793         my @location = CGI::param('location') ;
1794         if (@location) {
1795             $ret{locations} = \@location;
1796             my $str = $self->dbh_join(@location);
1797             $limit .= "AND Location.Location IN ($str) ";
1798         }
1799     }
1800
1801     if ($elt{pools}) {
1802         my @pool = CGI::param('pool') ;
1803         if (@pool) {
1804             $ret{pools} = \@pool;
1805             my $str = $self->dbh_join(@pool);
1806             $limit .= "AND Pool.Name IN ($str) ";
1807         }
1808     }
1809
1810     if ($elt{location}) {
1811         my $location = CGI::param('location') || '';
1812         if ($location) {
1813             $ret{location} = $location;
1814             $location = $self->dbh_quote($location);
1815             $limit .= "AND Location.Location = $location ";
1816         }
1817     }
1818
1819     if ($elt{pool}) {
1820         my $pool = CGI::param('pool') || '';
1821         if ($pool) {
1822             $ret{pool} = $pool;
1823             $pool = $self->dbh_quote($pool);
1824             $limit .= "AND Pool.Name = $pool ";
1825         }
1826     }
1827
1828     if ($elt{jobtype}) {
1829         my $jobtype = CGI::param('jobtype') || '';
1830         if ($jobtype =~ /^(\w)$/) {
1831             $ret{jobtype} = $1;
1832             $limit .= "AND Job.Type = '$1' ";
1833         }
1834     }
1835
1836     return ($limit, %ret);
1837 }
1838
1839 =head1
1840
1841     get last backup
1842
1843 =cut
1844
1845 sub display_job
1846 {
1847     my ($self, %arg) = @_ ;
1848
1849     $arg{order} = ' Job.JobId DESC ';
1850
1851     my ($limit, $label) = $self->get_limit(%arg);
1852     my ($where, undef) = $self->get_param('clients',
1853                                           'level',
1854                                           'filesets',
1855                                           'jobtype',
1856                                           'jobid',
1857                                           'status');
1858
1859     my $query="
1860 SELECT  Job.JobId       AS jobid,
1861         Client.Name     AS client,
1862         FileSet.FileSet AS fileset,
1863         Job.Name        AS jobname,
1864         Level           AS level,
1865         StartTime       AS starttime,
1866         Pool.Name       AS poolname,
1867         JobFiles        AS jobfiles,
1868         JobBytes        AS jobbytes,
1869         JobStatus       AS jobstatus,
1870      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1871                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1872                         AS duration,
1873
1874         JobErrors       AS joberrors
1875
1876  FROM Client,
1877       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
1878           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
1879  WHERE Client.ClientId=Job.ClientId
1880    AND Job.JobStatus != 'R'
1881  $where
1882  $limit
1883 ";
1884
1885     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1886
1887     $self->display({ Filter => $label,
1888                      ID => $cur_id++,
1889                      Jobs =>
1890                            [
1891                              sort { $a->{jobid} <=>  $b->{jobid} }
1892                                         values %$all
1893                              ],
1894                    },
1895                    "display_job.tpl");
1896 }
1897
1898 # display job informations
1899 sub display_job_zoom
1900 {
1901     my ($self, $jobid) = @_ ;
1902
1903     $jobid = $self->dbh_quote($jobid);
1904
1905     my $query="
1906 SELECT DISTINCT Job.JobId       AS jobid,
1907                 Client.Name     AS client,
1908                 Job.Name        AS jobname,
1909                 FileSet.FileSet AS fileset,
1910                 Level           AS level,
1911                 Pool.Name       AS poolname,
1912                 StartTime       AS starttime,
1913                 JobFiles        AS jobfiles,
1914                 JobBytes        AS jobbytes,
1915                 JobStatus       AS jobstatus,
1916                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1917                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1918
1919  FROM Client,
1920       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1921           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
1922  WHERE Client.ClientId=Job.ClientId
1923  AND Job.JobId = $jobid
1924 ";
1925
1926     my $row = $self->dbh_selectrow_hashref($query) ;
1927
1928     # display all volumes associate with this job
1929     $query="
1930 SELECT Media.VolumeName as volumename
1931 FROM Job,Media,JobMedia
1932 WHERE Job.JobId = $jobid
1933  AND JobMedia.JobId=Job.JobId
1934  AND JobMedia.MediaId=Media.MediaId
1935 ";
1936
1937     my $all = $self->dbh_selectall_hashref($query, 'volumename');
1938
1939     $row->{volumes} = [ values %$all ] ;
1940
1941     $self->display($row, "display_job_zoom.tpl");
1942 }
1943
1944 sub display_media
1945 {
1946     my ($self) = @_ ;
1947
1948     my ($where, %elt) = $self->get_param('pool',
1949                                          'location');
1950
1951     my $arg = $self->get_form('jmedias', 'qre_media');
1952
1953     if ($arg->{jmedias}) {
1954         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1955     }
1956     if ($arg->{qre_media}) {
1957         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1958     }
1959
1960     my $query="
1961 SELECT Media.VolumeName  AS volumename,
1962        Media.VolBytes    AS volbytes,
1963        Media.VolStatus   AS volstatus,
1964        Media.MediaType   AS mediatype,
1965        Media.InChanger   AS online,
1966        Media.LastWritten AS lastwritten,
1967        Location.Location AS location,
1968        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
1969        Pool.Name         AS poolname,
1970        $self->{sql}->{FROM_UNIXTIME}(
1971           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1972         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1973        ) AS expire
1974 FROM      Pool, Media
1975 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1976 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1977                   Media.MediaType     AS MediaType
1978            FROM Media
1979           WHERE Media.VolStatus = 'Full'
1980           GROUP BY Media.MediaType
1981            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
1982
1983 WHERE Media.PoolId=Pool.PoolId
1984 $where
1985 ";
1986
1987     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1988
1989     $self->display({ ID => $cur_id++,
1990                      Pool => $elt{pool},
1991                      Location => $elt{location},
1992                      Medias => [ values %$all ]
1993                    },
1994                    "display_media.tpl");
1995 }
1996
1997 sub display_medias
1998 {
1999     my ($self) = @_ ;
2000
2001     my $pool = $self->get_form('db_pools');
2002
2003     foreach my $name (@{ $pool->{db_pools} }) {
2004         CGI::param('pool', $name->{name});
2005         $self->display_media();
2006     }
2007 }
2008
2009 sub display_media_zoom
2010 {
2011     my ($self) = @_ ;
2012
2013     my $medias = $self->get_form('jmedias');
2014
2015     unless ($medias->{jmedias}) {
2016         return $self->error("Can't get media selection");
2017     }
2018
2019     my $query="
2020 SELECT InChanger     AS online,
2021        VolBytes      AS nb_bytes,
2022        VolumeName    AS volumename,
2023        VolStatus     AS volstatus,
2024        VolMounts     AS nb_mounts,
2025        Media.VolUseDuration   AS voluseduration,
2026        Media.MaxVolJobs AS maxvoljobs,
2027        Media.MaxVolFiles AS maxvolfiles,
2028        Media.MaxVolBytes AS maxvolbytes,
2029        VolErrors     AS nb_errors,
2030        Pool.Name     AS poolname,
2031        Location.Location AS location,
2032        Media.Recycle AS recycle,
2033        Media.VolRetention AS volretention,
2034        Media.LastWritten  AS lastwritten,
2035        Media.VolReadTime/1000000  AS volreadtime,
2036        Media.VolWriteTime/1000000 AS volwritetime,
2037        $self->{sql}->{FROM_UNIXTIME}(
2038           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2039         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2040        ) AS expire
2041  FROM Pool,
2042       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2043  WHERE Pool.PoolId = Media.PoolId
2044  AND VolumeName IN ($medias->{jmedias})
2045 ";
2046
2047     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2048
2049     foreach my $media (values %$all) {
2050         my $mq = $self->dbh_quote($media->{volumename});
2051
2052         $query = "
2053 SELECT DISTINCT Job.JobId AS jobid,
2054                 Job.Name  AS name,
2055                 Job.StartTime AS starttime,
2056                 Job.Type  AS type,
2057                 Job.Level AS level,
2058                 Job.JobFiles AS files,
2059                 Job.JobBytes AS bytes,
2060                 Job.jobstatus AS status
2061  FROM Media,JobMedia,Job
2062  WHERE Media.VolumeName=$mq
2063  AND Media.MediaId=JobMedia.MediaId
2064  AND JobMedia.JobId=Job.JobId
2065 ";
2066
2067         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2068
2069         $query = "
2070 SELECT LocationLog.Date    AS date,
2071        Location.Location   AS location,
2072        LocationLog.Comment AS comment
2073  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2074  WHERE Media.MediaId = LocationLog.MediaId
2075    AND Media.VolumeName = $mq
2076 ";
2077
2078         my $logtxt = '';
2079         my $log = $self->dbh_selectall_arrayref($query) ;
2080         if ($log) {
2081             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2082         }
2083
2084         $self->display({ jobs => [ values %$jobs ],
2085                          LocationLog => $logtxt,
2086                          %$media },
2087                        "display_media_zoom.tpl");
2088     }
2089 }
2090
2091 sub location_edit
2092 {
2093     my ($self) = @_ ;
2094
2095     my $loc = $self->get_form('qlocation');
2096     unless ($loc->{qlocation}) {
2097         return $self->error("Can't get location");
2098     }
2099
2100     my $query = "
2101 SELECT Location.Location AS location,
2102        Location.Cost   AS cost,
2103        Location.Enabled AS enabled
2104 FROM Location
2105 WHERE Location.Location = $loc->{qlocation}
2106 ";
2107
2108     my $row = $self->dbh_selectrow_hashref($query);
2109
2110     $self->display({ ID => $cur_id++,
2111                      %$row }, "location_edit.tpl") ;
2112
2113 }
2114
2115 sub location_save
2116 {
2117     my ($self) = @_ ;
2118
2119     my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2120     unless ($arg->{qlocation}) {
2121         return $self->error("Can't get location");
2122     }
2123     unless ($arg->{qnewlocation}) {
2124         return $self->error("Can't get new location name");
2125     }
2126     unless ($arg->{cost}) {
2127         return $self->error("Can't get new cost");
2128     }
2129
2130     my $enabled = CGI::param('enabled') || '';
2131     $enabled = $enabled?1:0;
2132
2133     my $query = "
2134 UPDATE Location SET Cost     = $arg->{cost},
2135                     Location = $arg->{qnewlocation},
2136                     Enabled   = $enabled
2137 WHERE Location.Location = $arg->{qlocation}
2138 ";
2139
2140     $self->dbh_do($query);
2141
2142     $self->display_location();
2143 }
2144
2145 sub location_del
2146 {
2147     my ($self) = @_ ;
2148     my $arg = $self->get_form(qw/qlocation/) ;
2149
2150     unless ($arg->{qlocation}) {
2151         return $self->error("Can't get location");
2152     }
2153
2154     my $query = "
2155 SELECT count(Media.MediaId) AS nb
2156   FROM Media INNER JOIN Location USING (LocationID)
2157 WHERE Location = $arg->{qlocation}
2158 ";
2159
2160     my $res = $self->dbh_selectrow_hashref($query);
2161
2162     if ($res->{nb}) {
2163         return $self->error("Sorry, the location must be empty");
2164     }
2165
2166     $query = "
2167 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2168 ";
2169
2170     $self->dbh_do($query);
2171
2172     $self->display_location();
2173 }
2174
2175
2176 sub location_add
2177 {
2178     my ($self) = @_ ;
2179     my $arg = $self->get_form(qw/qlocation cost/) ;
2180
2181     unless ($arg->{qlocation}) {
2182         $self->display({}, "location_add.tpl");
2183         return 1;
2184     }
2185     unless ($arg->{cost}) {
2186         return $self->error("Can't get new cost");
2187     }
2188
2189     my $enabled = CGI::param('enabled') || '';
2190     $enabled = $enabled?1:0;
2191
2192     my $query = "
2193 INSERT INTO Location (Location, Cost, Enabled)
2194        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2195 ";
2196
2197     $self->dbh_do($query);
2198
2199     $self->display_location();
2200 }
2201
2202 sub display_location
2203 {
2204     my ($self) = @_ ;
2205
2206     my $query = "
2207 SELECT Location.Location AS location,
2208        Location.Cost     AS cost,
2209        Location.Enabled  AS enabled,
2210        (SELECT count(Media.MediaId)
2211          FROM Media
2212         WHERE Media.LocationId = Location.LocationId
2213        ) AS volnum
2214 FROM Location
2215 ";
2216
2217     my $location = $self->dbh_selectall_hashref($query, 'location');
2218
2219     $self->display({ ID => $cur_id++,
2220                      Locations => [ values %$location ] },
2221                    "display_location.tpl");
2222 }
2223
2224 sub update_location
2225 {
2226     my ($self) = @_ ;
2227
2228     my $medias = $self->get_selected_media_location();
2229     unless ($medias) {
2230         return ;
2231     }
2232
2233     my $arg = $self->get_form('db_locations', 'qnewlocation');
2234
2235     $self->display({ email  => $self->{info}->{email_media},
2236                      %$arg,
2237                      medias => [ values %$medias ],
2238                    },
2239                    "update_location.tpl");
2240 }
2241
2242 sub get_media_max_size
2243 {
2244     my ($self, $type) = @_;
2245     my $query =
2246 "SELECT avg(VolBytes) AS size
2247   FROM Media
2248  WHERE Media.VolStatus = 'Full'
2249    AND Media.MediaType = '$type'
2250 ";
2251
2252     my $res = $self->selectrow_hashref($query);
2253
2254     if ($res) {
2255         return $res->{size};
2256     } else {
2257         return 0;
2258     }
2259 }
2260
2261 sub do_update_media
2262 {
2263     my ($self) = @_ ;
2264
2265     my $media = CGI::param('media');
2266     unless ($media) {
2267         return $self->error("Can't find media selection");
2268     }
2269
2270     $media = $self->dbh_quote($media);
2271
2272     my $update = '';
2273
2274     my $volstatus = CGI::param('volstatus') || '';
2275     $volstatus = $self->dbh_quote($volstatus); # is checked by db
2276     $update .= " VolStatus=$volstatus, ";
2277
2278     my $inchanger = CGI::param('inchanger') || '';
2279     if ($inchanger) {
2280         $update .= " InChanger=1, " ;
2281         my $slot = CGI::param('slot') || '';
2282         if ($slot =~ /^(\d+)$/) {
2283             $update .= " Slot=$1, ";
2284         } else {
2285             $update .= " Slot=0, ";
2286         }
2287     } else {
2288         $update .= " Slot=0, InChanger=0, ";
2289     }
2290
2291     my $pool = CGI::param('pool') || '';
2292     $pool = $self->dbh_quote($pool); # is checked by db
2293     $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2294
2295     my $volretention = CGI::param('volretention') || '';
2296     $volretention = from_human_sec($volretention);
2297     unless ($volretention) {
2298         return $self->error("Can't get volume retention");
2299     }
2300
2301     $update .= " VolRetention = $volretention, ";
2302
2303     my $loc = CGI::param('location') || '';
2304     $loc = $self->dbh_quote($loc); # is checked by db
2305     $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2306
2307     my $usedu = CGI::param('voluseduration') || '0';
2308     $usedu = from_human_sec($usedu);
2309     $update .= " VolUseDuration=$usedu, ";
2310
2311     my $maxj = CGI::param('maxvoljobs') || '0';
2312     unless ($maxj =~ /^(\d+)$/) {
2313         return $self->error("Can't get max jobs");
2314     }
2315     $update .= " MaxVolJobs=$1, " ;
2316
2317     my $maxf = CGI::param('maxvolfiles') || '0';
2318     unless ($maxj =~ /^(\d+)$/) {
2319         return $self->error("Can't get max files");
2320     }
2321     $update .= " MaxVolFiles=$1, " ;
2322
2323     my $maxb = CGI::param('maxvolbytes') || '0';
2324     unless ($maxb =~ /^(\d+)$/) {
2325         return $self->error("Can't get max bytes");
2326     }
2327     $update .= " MaxVolBytes=$1 " ;
2328
2329     my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2330
2331     if ($row) {
2332         print "Update Ok\n";
2333         $self->update_media();
2334     }
2335 }
2336
2337 sub update_media
2338 {
2339     my ($self) = @_ ;
2340
2341     my $media = $self->get_form('qmedia');
2342
2343     unless ($media->{qmedia}) {
2344         return $self->error("Can't get media");
2345     }
2346
2347     my $query = "
2348 SELECT Media.Slot         AS slot,
2349        Pool.Name          AS poolname,
2350        Media.VolStatus    AS volstatus,
2351        Media.InChanger    AS inchanger,
2352        Location.Location  AS location,
2353        Media.VolumeName   AS volumename,
2354        Media.MaxVolBytes  AS maxvolbytes,
2355        Media.MaxVolJobs   AS maxvoljobs,
2356        Media.MaxVolFiles  AS maxvolfiles,
2357        Media.VolUseDuration AS voluseduration,
2358        Media.VolRetention AS volretention
2359
2360 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2361            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2362
2363 WHERE Media.VolumeName = $media->{qmedia}
2364 ";
2365
2366     my $row = $self->dbh_selectrow_hashref($query);
2367     $row->{volretention} = human_sec($row->{volretention});
2368     $row->{voluseduration} = human_sec($row->{voluseduration});
2369
2370     my $elt = $self->get_form(qw/db_pools db_locations/);
2371
2372     $self->display({
2373         %$elt,
2374         %$row,
2375     }, "update_media.tpl");
2376 }
2377
2378 sub save_location
2379 {
2380     my ($self) = @_ ;
2381
2382     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2383
2384     unless ($arg->{jmedias}) {
2385         return $self->error("Can't get selected media");
2386     }
2387
2388     unless ($arg->{qnewlocation}) {
2389         return $self->error("Can't get new location");
2390     }
2391
2392     my $query = "
2393  UPDATE Media
2394      SET LocationId = (SELECT LocationId
2395                        FROM Location
2396                        WHERE Location = $arg->{qnewlocation})
2397      WHERE Media.VolumeName IN ($arg->{jmedias})
2398 ";
2399
2400     my $nb = $self->dbh_do($query);
2401
2402     print "$nb media updated, you may have to update your autochanger.";
2403
2404     $self->display_media();
2405 }
2406
2407 sub change_location
2408 {
2409     my ($self) = @_ ;
2410
2411     my $medias = $self->get_selected_media_location();
2412     unless ($medias) {
2413         return $self->error("Can't get media selection");
2414     }
2415     my $newloc = CGI::param('newlocation');
2416
2417     my $user = CGI::param('user') || 'unknow';
2418     my $comm = CGI::param('comment') || '';
2419     $comm = $self->dbh_quote("$user: $comm");
2420
2421     my $query;
2422
2423     foreach my $media (keys %$medias) {
2424         $query = "
2425 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2426  VALUES(
2427        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2428        (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2429        (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2430       )
2431 ";
2432         $self->dbh_do($query);
2433         $self->debug($query);
2434     }
2435
2436     my $q = new CGI;
2437     $q->param('action', 'update_location');
2438     my $url = $q->url(-full => 1, -query=>1);
2439
2440     $self->display({ email  => $self->{info}->{email_media},
2441                      url => $url,
2442                      newlocation => $newloc,
2443                      # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2444                      medias => [ values %$medias ],
2445                    },
2446                    "change_location.tpl");
2447
2448 }
2449
2450 sub display_client_stats
2451 {
2452     my ($self, %arg) = @_ ;
2453
2454     my $client = $self->dbh_quote($arg{clientname});
2455     my ($limit, $label) = $self->get_limit(%arg);
2456
2457     my $query = "
2458 SELECT
2459     count(Job.JobId)     AS nb_jobs,
2460     sum(Job.JobBytes)    AS nb_bytes,
2461     sum(Job.JobErrors)   AS nb_err,
2462     sum(Job.JobFiles)    AS nb_files,
2463     Client.Name          AS clientname
2464 FROM Job INNER JOIN Client USING (ClientId)
2465 WHERE
2466     Client.Name = $client
2467     $limit
2468 GROUP BY Client.Name
2469 ";
2470
2471     my $row = $self->dbh_selectrow_hashref($query);
2472
2473     $row->{ID} = $cur_id++;
2474     $row->{label} = $label;
2475
2476     $self->display($row, "display_client_stats.tpl");
2477 }
2478
2479 # poolname can be undef
2480 sub display_pool
2481 {
2482     my ($self, $poolname) = @_ ;
2483
2484 # TODO : afficher les tailles et les dates
2485
2486     my $query = "
2487 SELECT subq.volmax        AS volmax,
2488        subq.volnum        AS volnum,
2489        subq.voltotal      AS voltotal,
2490        Pool.Name          AS name,
2491        Pool.Recycle       AS recycle,
2492        Pool.VolRetention  AS volretention,
2493        Pool.VolUseDuration AS voluseduration,
2494        Pool.MaxVolJobs    AS maxvoljobs,
2495        Pool.MaxVolFiles   AS maxvolfiles,
2496        Pool.MaxVolBytes   AS maxvolbytes,
2497        subq.PoolId        AS PoolId
2498 FROM
2499   (
2500     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2501            count(Media.MediaId)  AS volnum,
2502            sum(Media.VolBytes)   AS voltotal,
2503            Media.PoolId          AS PoolId,
2504            Media.MediaType       AS MediaType
2505     FROM Media
2506     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2507                       Media.MediaType     AS MediaType
2508                FROM Media
2509               WHERE Media.VolStatus = 'Full'
2510               GROUP BY Media.MediaType
2511                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2512     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2513   ) AS subq
2514 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2515 ";
2516
2517     my $all = $self->dbh_selectall_hashref($query, 'name') ;
2518
2519     foreach my $p (values %$all) {
2520         if ($p->{volmax}) {
2521             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2522         } else {
2523             $p->{poolusage} = 0;
2524         }
2525
2526         $query = "
2527   SELECT VolStatus AS volstatus, count(MediaId) AS nb
2528     FROM Media
2529    WHERE PoolId=$p->{poolid}
2530 GROUP BY VolStatus
2531 ";
2532         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2533         foreach my $t (values %$content) {
2534             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2535         }
2536     }
2537
2538     $self->debug($all);
2539     $self->display({ ID => $cur_id++,
2540                      Pools => [ values %$all ]},
2541                    "display_pool.tpl");
2542 }
2543
2544 sub display_running_job
2545 {
2546     my ($self) = @_;
2547
2548     my $arg = $self->get_form('client', 'jobid');
2549
2550     if (!$arg->{client} and $arg->{jobid}) {
2551
2552         my $query = "
2553 SELECT Client.Name AS name
2554 FROM Job INNER JOIN Client USING (ClientId)
2555 WHERE Job.JobId = $arg->{jobid}
2556 ";
2557
2558         my $row = $self->dbh_selectrow_hashref($query);
2559
2560         if ($row) {
2561             $arg->{client} = $row->{name};
2562             CGI::param('client', $arg->{client});
2563         }
2564     }
2565
2566     if ($arg->{client}) {
2567         my $cli = new Bweb::Client(name => $arg->{client});
2568         $cli->display_running_job($self->{info}, $arg->{jobid});
2569         if ($arg->{jobid}) {
2570             $self->get_job_log();
2571         }
2572     } else {
2573         $self->error("Can't get client or jobid");
2574     }
2575 }
2576
2577 sub display_running_jobs
2578 {
2579     my ($self, $display_action) = @_;
2580
2581     my $query = "
2582 SELECT Job.JobId AS jobid,
2583        Job.Name  AS jobname,
2584        Job.Level     AS level,
2585        Job.StartTime AS starttime,
2586        Job.JobFiles  AS jobfiles,
2587        Job.JobBytes  AS jobbytes,
2588        Job.JobStatus AS jobstatus,
2589 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2590                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2591          AS duration,
2592        Client.Name AS clientname
2593 FROM Job INNER JOIN Client USING (ClientId)
2594 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2595 ";
2596     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2597
2598     $self->display({ ID => $cur_id++,
2599                      display_action => $display_action,
2600                      Jobs => [ values %$all ]},
2601                    "running_job.tpl") ;
2602 }
2603
2604 sub eject_media
2605 {
2606     my ($self) = @_;
2607     my $arg = $self->get_form('jmedias');
2608
2609     unless ($arg->{jmedias}) {
2610         return $self->error("Can't get media selection");
2611     }
2612
2613     my $query = "
2614 SELECT Media.VolumeName  AS volumename,
2615        Storage.Name      AS storage,
2616        Location.Location AS location,
2617        Media.Slot        AS slot
2618 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
2619            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2620 WHERE Media.VolumeName IN ($arg->{jmedias})
2621   AND Media.InChanger = 1
2622 ";
2623
2624     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2625
2626     foreach my $vol (values %$all) {
2627         my $a = $self->ach_get($vol->{location});
2628         next unless ($a) ;
2629
2630         unless ($a->{have_status}) {
2631             $a->status();
2632             $a->{have_status} = 1;
2633         }
2634
2635         print "eject $vol->{volumename} from $vol->{storage} : ";
2636         if ($a->send_to_io($vol->{slot})) {
2637             print "ok</br>";
2638         } else {
2639             print "err</br>";
2640         }
2641     }
2642 }
2643
2644 sub move_email
2645 {
2646     my ($self) = @_;
2647
2648     my ($to, $subject, $content) = (CGI::param('email'),
2649                                     CGI::param('subject'),
2650                                     CGI::param('content'));
2651     $to =~ s/[^\w\d\.\@<>,]//;
2652     $subject =~ s/[^\w\d\.\[\]]/ /;
2653
2654     open(MAIL, "|mail -s '$subject' '$to'") ;
2655     print MAIL $content;
2656     close(MAIL);
2657
2658     print "Mail sent";
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 = $self->get_bconsole();
2732
2733     my @storages = $b->list_storage() ;
2734
2735     $ach->{devices} = [ map { { name => $_ } } @storages ];
2736
2737     $self->display($ach, "ach_add.tpl");
2738     delete $ach->{drives};
2739     delete $ach->{devices};
2740     return 1;
2741 }
2742
2743 sub ach_del
2744 {
2745     my ($self) = @_;
2746     my $arg = $self->get_form('ach');
2747
2748     if (!$arg->{ach}
2749         or !$self->{info}->{ach_list}
2750         or !$self->{info}->{ach_list}->{$arg->{ach}})
2751     {
2752         return $self->error("Can't get autochanger name");
2753     }
2754
2755     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2756
2757     $self->{info}->save();
2758     $self->{info}->view();
2759 }
2760
2761 sub ach_add
2762 {
2763     my ($self) = @_;
2764     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2765
2766     my $b = $self->get_bconsole();
2767     my @storages = $b->list_storage() ;
2768
2769     unless ($arg->{ach}) {
2770         $arg->{devices} = [ map { { name => $_ } } @storages ];
2771         return $self->display($arg, "ach_add.tpl");
2772     }
2773
2774     my @drives ;
2775     foreach my $drive (CGI::param('drives'))
2776     {
2777         unless (grep(/^$drive$/,@storages)) {
2778             return $self->error("Can't find $drive in storage list");
2779         }
2780
2781         my $index = CGI::param("index_$drive");
2782         unless (defined $index and $index =~ /^(\d+)$/) {
2783             return $self->error("Can't get $drive index");
2784         }
2785
2786         $drives[$index] = $drive;
2787     }
2788
2789     unless (@drives) {
2790         return $self->error("Can't get drives from Autochanger");
2791     }
2792
2793     my $a = new Bweb::Autochanger(name   => $arg->{ach},
2794                                   precmd => $arg->{precmd},
2795                                   drive_name => \@drives,
2796                                   device => $arg->{device},
2797                                   mtxcmd => $arg->{mtxcmd});
2798
2799     $self->ach_register($a) ;
2800
2801     $self->{info}->view();
2802 }
2803
2804 sub delete
2805 {
2806     my ($self) = @_;
2807     my $arg = $self->get_form('jobid');
2808
2809     if ($arg->{jobid}) {
2810         my $b = $self->get_bconsole();
2811         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2812
2813         $self->display({
2814             content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2815             title => "Delete a job ",
2816             name => "delete jobid=$arg->{jobid}",
2817         }, "command.tpl");
2818     }
2819 }
2820
2821 sub update_slots
2822 {
2823     my ($self) = @_;
2824
2825     my $ach = CGI::param('ach') ;
2826     unless ($ach =~ /^([\w\d\.-]+)$/) {
2827         return $self->error("Bad autochanger name");
2828     }
2829
2830     print "<pre>";
2831     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2832     $b->update_slots($ach);
2833     print "</pre>\n"
2834 }
2835
2836 sub get_job_log
2837 {
2838     my ($self) = @_;
2839
2840     my $arg = $self->get_form('jobid');
2841     unless ($arg->{jobid}) {
2842         return $self->error("Can't get jobid");
2843     }
2844
2845     my $t = CGI::param('time') || '';
2846
2847     my $query = "
2848 SELECT Job.Name as name, Client.Name as clientname
2849  FROM  Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2850  WHERE JobId = $arg->{jobid}
2851 ";
2852
2853     my $row = $self->dbh_selectrow_hashref($query);
2854
2855     unless ($row) {
2856         return $self->error("Can't find $arg->{jobid} in catalog");
2857     }
2858
2859     $query = "
2860 SELECT Time AS time, LogText AS log
2861  FROM  Log
2862  WHERE JobId = $arg->{jobid}
2863  ORDER BY Time
2864 ";
2865     my $log = $self->dbh_selectall_arrayref($query);
2866     unless ($log) {
2867         return $self->error("Can't get log for jobid $arg->{jobid}");
2868     }
2869
2870     my $logtxt;
2871     if ($t) {
2872         # log contains \n
2873         $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2874     } else {
2875         $logtxt = join("", map { $_->[1] } @$log ) ;
2876     }
2877
2878     $self->display({ lines=> $logtxt,
2879                      jobid => $arg->{jobid},
2880                      name  => $row->{name},
2881                      client => $row->{clientname},
2882                  }, 'display_log.tpl');
2883 }
2884
2885
2886 sub label_barcodes
2887 {
2888     my ($self) = @_ ;
2889
2890     my $arg = $self->get_form('ach', 'slots', 'drive');
2891
2892     unless ($arg->{ach}) {
2893         return $self->error("Can't find autochanger name");
2894     }
2895
2896     my $slots = '';
2897     my $t = 300 ;
2898     if ($arg->{slots}) {
2899         $slots = join(",", @{ $arg->{slots} });
2900         $t += 60*scalar( @{ $arg->{slots} }) ;
2901     }
2902
2903     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2904     print "<h1>This command can take long time, be patient...</h1>";
2905     print "<pre>" ;
2906     $b->label_barcodes(storage => $arg->{ach},
2907                        drive => $arg->{drive},
2908                        pool  => 'Scratch',
2909                        slots => $slots) ;
2910     $b->close();
2911     print "</pre>";
2912 }
2913
2914 sub purge
2915 {
2916     my ($self) = @_;
2917
2918     my @volume = CGI::param('media');
2919
2920     unless (@volume) {
2921         return $self->error("Can't get media selection");
2922     }
2923
2924     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2925
2926     $self->display({
2927         content => $b->purge_volume(@volume),
2928         title => "Purge media",
2929         name => "purge volume=" . join(' volume=', @volume),
2930     }, "command.tpl");
2931     $b->close();
2932 }
2933
2934 sub prune
2935 {
2936     my ($self) = @_;
2937
2938     my @volume = CGI::param('media');
2939     unless (@volume) {
2940         return $self->error("Can't get media selection");
2941     }
2942
2943     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2944
2945     $self->display({
2946         content => $b->prune_volume(@volume),
2947         title => "Prune media",
2948         name => "prune volume=" . join(' volume=', @volume),
2949     }, "command.tpl");
2950
2951     $b->close();
2952 }
2953
2954 sub cancel_job
2955 {
2956     my ($self) = @_;
2957
2958     my $arg = $self->get_form('jobid');
2959     unless ($arg->{jobid}) {
2960         return $self->error("Can't get jobid");
2961     }
2962
2963     my $b = $self->get_bconsole();
2964     $self->display({
2965         content => $b->cancel($arg->{jobid}),
2966         title => "Cancel job",
2967         name => "cancel jobid=$arg->{jobid}",
2968     }, "command.tpl");
2969 }
2970
2971 sub fileset_view
2972 {
2973     # Warning, we display current fileset
2974     my ($self) = @_;
2975
2976     my $arg = $self->get_form('fileset');
2977
2978     if ($arg->{fileset}) {
2979         my $b = $self->get_bconsole();
2980         my $ret = $b->get_fileset($arg->{fileset});
2981         $self->display({ fileset => $arg->{fileset},
2982                          %$ret,
2983                      }, "fileset_view.tpl");
2984     } else {
2985         $self->error("Can't get fileset name");
2986     }
2987 }
2988
2989 sub director_show_sched
2990 {
2991     my ($self) = @_ ;
2992
2993     my $arg = $self->get_form('days');
2994
2995     my $b = $self->get_bconsole();
2996     my $ret = $b->director_get_sched( $arg->{days} );
2997
2998     $self->display({
2999         id => $cur_id++,
3000         list => $ret,
3001     }, "scheduled_job.tpl");
3002 }
3003
3004 sub enable_disable_job
3005 {
3006     my ($self, $what) = @_ ;
3007
3008     my $name = CGI::param('job') || '';
3009     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3010         return $self->error("Can't find job name");
3011     }
3012
3013     my $b = $self->get_bconsole();
3014
3015     my $cmd;
3016     if ($what) {
3017         $cmd = "enable";
3018     } else {
3019         $cmd = "disable";
3020     }
3021
3022     $self->display({
3023         content => $b->send_cmd("$cmd job=\"$name\""),
3024         title => "$cmd $name",
3025         name => "$cmd job=\"$name\"",
3026     }, "command.tpl");
3027 }
3028
3029 sub get_bconsole
3030 {
3031     my ($self) = @_;
3032     return new Bconsole(pref => $self->{info});
3033 }
3034
3035 sub run_job_select
3036 {
3037     my ($self) = @_;
3038     my $b = $self->get_bconsole();
3039
3040     my $joblist = [ map { { name => $_ } } $b->list_job() ];
3041
3042     $self->display({ Jobs => $joblist }, "run_job.tpl");
3043 }
3044
3045 sub run_parse_job
3046 {
3047     my ($self, $ouput) = @_;
3048
3049     my %arg;
3050     foreach my $l (split(/\r\n/, $ouput)) {
3051         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3052             $arg{$1} = $2;
3053             $l = $3
3054                 if ($3) ;
3055         }
3056
3057         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3058             %arg = (%arg, @l);
3059         }
3060     }
3061
3062     my %lowcase ;
3063     foreach my $k (keys %arg) {
3064         $lowcase{lc($k)} = $arg{$k} ;
3065     }
3066
3067     return \%lowcase;
3068 }
3069
3070 sub run_job_mod
3071 {
3072     my ($self) = @_;
3073     my $b = $self->get_bconsole();
3074
3075     my $job = CGI::param('job') || '';
3076
3077     my $info = $b->send_cmd("show job=\"$job\"");
3078     my $attr = $self->run_parse_job($info);
3079
3080     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3081
3082     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
3083     my $clients = [ map { { name => $_ } }$b->list_client()];
3084     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3085     my $storages= [ map { { name => $_ } }$b->list_storage()];
3086
3087     $self->display({
3088         jobs     => $jobs,
3089         pools    => $pools,
3090         clients  => $clients,
3091         filesets => $filesets,
3092         storages => $storages,
3093         %$attr,
3094     }, "run_job_mod.tpl");
3095 }
3096
3097 sub run_job
3098 {
3099     my ($self) = @_;
3100     my $b = $self->get_bconsole();
3101
3102     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
3103
3104     $self->display({
3105         jobs     => $jobs,
3106     }, "run_job.tpl");
3107 }
3108
3109 sub run_job_now
3110 {
3111     my ($self) = @_;
3112     my $b = $self->get_bconsole();
3113
3114     # TODO: check input (don't use pool, level)
3115
3116     my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3117     my $job = CGI::param('job') || '';
3118     my $storage = CGI::param('storage') || '';
3119
3120     my $jobid = $b->run(job => $job,
3121                         client => $arg->{client},
3122                         priority => $arg->{priority},
3123                         level => $arg->{level},
3124                         storage => $storage,
3125                         pool => $arg->{pool},
3126                         );
3127
3128     print $jobid, $b->{error};
3129
3130     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
3131 }
3132
3133 1;