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