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

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