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