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