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