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               CONCAT_SEP => "",
1062           },
1063           mysql => {
1064               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1065               FROM_UNIXTIME => 'FROM_UNIXTIME',
1066               SEC_TO_INT => '',
1067               TO_SEC => '',
1068               SEC_TO_TIME => 'SEC_TO_TIME',
1069               MATCH => " REGEXP ",
1070               STARTTIME_DAY  => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1071               STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1072               STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1073               STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1074               STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1075               STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1076               STARTTIME_PWEEK => " DATE_FORMAT(StartTime, '%v') ",
1077               # with mysql < 5, you have to play with the ugly SHOW command
1078               DB_SIZE => " SELECT 0 ",
1079               # works only with mysql 5
1080               # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1081               CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1082               CONCAT_SEP => " SEPARATOR '' ",
1083           },
1084          );
1085
1086 sub dbh_is_mysql
1087 {
1088     my ($self) = @_;
1089     return $self->{info}->{dbi} =~ /dbi:mysql/i;
1090 }
1091
1092 sub dbh_disconnect
1093 {
1094     my ($self) = @_;
1095     if ($self->{dbh}) {
1096        $self->{dbh}->disconnect();
1097        undef $self->{dbh};
1098     }
1099 }
1100
1101 sub dbh_selectall_arrayref
1102 {
1103     my ($self, $query) = @_;
1104     $self->connect_db();
1105     $self->debug($query);
1106     return $self->{dbh}->selectall_arrayref($query);
1107 }
1108
1109 sub dbh_join
1110 {
1111     my ($self, @what) = @_;
1112     return join(',', $self->dbh_quote(@what)) ;
1113 }
1114
1115 sub dbh_quote
1116 {
1117     my ($self, @what) = @_;
1118
1119     $self->connect_db();
1120     if (wantarray) {
1121         return map { $self->{dbh}->quote($_) } @what;
1122     } else {
1123         return $self->{dbh}->quote($what[0]) ;
1124     }
1125 }
1126
1127 sub dbh_do
1128 {
1129     my ($self, $query) = @_ ;
1130     $self->connect_db();
1131     $self->debug($query);
1132     return $self->{dbh}->do($query);
1133 }
1134
1135 sub dbh_selectall_hashref
1136 {
1137     my ($self, $query, $join) = @_;
1138
1139     $self->connect_db();
1140     $self->debug($query);
1141     return $self->{dbh}->selectall_hashref($query, $join) ;
1142 }
1143
1144 sub dbh_selectrow_hashref
1145 {
1146     my ($self, $query) = @_;
1147
1148     $self->connect_db();
1149     $self->debug($query);
1150     return $self->{dbh}->selectrow_hashref($query) ;
1151 }
1152
1153 sub dbh_strcat
1154 {
1155     my ($self, @what) = @_;
1156     if ($self->dbh_is_mysql()) {
1157         return 'CONCAT(' . join(',', @what) . ')' ;
1158     } else {
1159         return join(' || ', @what);
1160     }
1161 }
1162
1163 sub dbh_prepare
1164 {
1165     my ($self, $query) = @_;
1166     $self->debug($query, up => 1);
1167     return $self->{dbh}->prepare($query);
1168 }
1169
1170 # display Mb/Gb/Kb
1171 sub human_size
1172 {
1173     my @unit = qw(B KB MB GB TB);
1174     my $val = shift || 0;
1175     my $i=0;
1176     my $format = '%i %s';
1177     while ($val / 1024 > 1) {
1178         $i++;
1179         $val /= 1024;
1180     }
1181     $format = ($i>0)?'%0.1f %s':'%i %s';
1182     return sprintf($format, $val, $unit[$i]);
1183 }
1184
1185 # display Day, Hour, Year
1186 sub human_sec
1187 {
1188     use integer;
1189
1190     my $val = shift;
1191     $val /= 60;                 # sec -> min
1192
1193     if ($val / 60 <= 1) {
1194         return "$val mins";
1195     }
1196
1197     $val /= 60;                 # min -> hour
1198     if ($val / 24 <= 1) {
1199         return "$val hours";
1200     }
1201
1202     $val /= 24;                 # hour -> day
1203     if ($val / 365 < 2) {
1204         return "$val days";
1205     }
1206
1207     $val /= 365 ;               # day -> year
1208
1209     return "$val years";
1210 }
1211
1212 # display Enabled
1213 sub human_enabled
1214 {
1215     my $val = shift || 0;
1216
1217     if ($val eq '1' or $val eq "yes") {
1218         return "yes";
1219     } elsif ($val eq '2' or $val eq "archived") {
1220         return "archived";
1221     } else {
1222         return  "no";
1223     }
1224 }
1225
1226 # display Enabled
1227 sub from_human_enabled
1228 {
1229     my $val = shift || 0;
1230
1231     if ($val == 1 or $val eq "yes") {
1232         return 1;
1233     } elsif ($val == 2 or $val eq "archived") {
1234         return 2;
1235     } else {
1236         return  0;
1237     }
1238 }
1239
1240 # get Day, Hour, Year
1241 sub from_human_sec
1242 {
1243     use integer;
1244
1245     my $val = shift;
1246     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1247         return 0;
1248     }
1249
1250     my %times = ( m   => 60,
1251                   h   => 60*60,
1252                   d   => 60*60*24,
1253                   m   => 60*60*24*31,
1254                   y   => 60*60*24*365,
1255                   );
1256     my $mult = $times{$2} || 0;
1257
1258     return $1 * $mult;
1259 }
1260
1261
1262 sub connect_db
1263 {
1264     my ($self) = @_;
1265
1266     unless ($self->{dbh}) {
1267
1268         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1269                                     $self->{info}->{user},
1270                                     $self->{info}->{password});
1271
1272         $self->error("Can't connect to your database:\n$DBI::errstr\n")
1273             unless ($self->{dbh});
1274
1275         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1276
1277         if ($self->dbh_is_mysql()) {
1278             $self->{dbh}->do("SET group_concat_max_len=1000000");
1279         } else {
1280             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1281         }
1282     }
1283 }
1284
1285 sub new
1286 {
1287     my ($class, %arg) = @_;
1288     my $self = bless ({
1289         dbh => undef,           # connect_db();
1290         info => {
1291             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1292             user  => 'bacula',
1293             password => 'test',
1294         },
1295     },$class) ;
1296
1297     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1298
1299     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1300         $self->{sql} = $sql_func{$1};
1301     }
1302
1303     $self->{loginname} = CGI::remote_user();
1304     $self->{debug} = $self->{info}->{debug};
1305     $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1306
1307     return $self;
1308 }
1309
1310 sub display_begin
1311 {
1312     my ($self) = @_;
1313     $self->display($self->{info}, "begin.tpl");
1314 }
1315
1316 sub display_end
1317 {
1318     my ($self) = @_;
1319     $self->display($self->{info}, "end.tpl");
1320 }
1321
1322 sub display_clients
1323 {
1324     my ($self) = @_;
1325     my $where='';       # by default
1326
1327     my $arg = $self->get_form("client", "qre_client",
1328                               "jclient_groups", "qnotingroup");
1329
1330     if ($arg->{qre_client}) {
1331         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1332     } elsif ($arg->{client}) {
1333         $where = "WHERE Name = '$arg->{client}' ";
1334     } elsif ($arg->{jclient_groups}) {
1335         # $filter could already contains client_group_member
1336         $where = "
1337  JOIN client_group_member USING (ClientId)
1338  JOIN client_group USING (client_group_id)
1339  WHERE client_group_name IN ($arg->{jclient_groups}) ";
1340     } elsif ($arg->{qnotingroup}) {
1341         $where =   "
1342   WHERE NOT EXISTS
1343    (SELECT 1 FROM client_group_member
1344      WHERE Client.ClientId = client_group_member.ClientId
1345    )
1346 ";
1347     }
1348
1349     my $query = "
1350 SELECT Name   AS name,
1351        Uname  AS uname,
1352        AutoPrune AS autoprune,
1353        FileRetention AS fileretention,
1354        JobRetention  AS jobretention
1355 FROM Client " . $self->get_client_filter() .
1356 $where ;
1357
1358     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1359
1360     my $dsp = { ID => $cur_id++,
1361                 clients => [ values %$all] };
1362
1363     $self->display($dsp, "client_list.tpl") ;
1364 }
1365
1366 sub get_limit
1367 {
1368     my ($self, %arg) = @_;
1369
1370     my $limit = '';
1371     my $label = '';
1372
1373     if ($arg{age}) {
1374         $limit =
1375   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1376          >
1377        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1378          -
1379          $self->{sql}->{TO_SEC}($arg{age})
1380        )" ;
1381
1382         $label = "last " . human_sec($arg{age});
1383     }
1384
1385     if ($arg{groupby}) {
1386         $limit .= " GROUP BY $arg{groupby} ";
1387     }
1388
1389     if ($arg{order}) {
1390         $limit .= " ORDER BY $arg{order} ";
1391     }
1392
1393     if ($arg{limit}) {
1394         $limit .= " LIMIT $arg{limit} ";
1395         $label .= " limited to $arg{limit}";
1396     }
1397
1398     if ($arg{offset}) {
1399         $limit .= " OFFSET $arg{offset} ";
1400         $label .= " with $arg{offset} offset ";
1401     }
1402
1403     unless ($label) {
1404         $label = 'no filter';
1405     }
1406
1407     return ($limit, $label);
1408 }
1409
1410 =head1 FUNCTION
1411
1412     $bweb->get_form(...) - Get useful stuff
1413
1414 =head2 DESCRIPTION
1415
1416     This function get and check parameters against regexp.
1417
1418     If word begin with 'q', the return will be quoted or join quoted
1419     if it's end with 's'.
1420
1421
1422 =head2 EXAMPLE
1423
1424     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1425
1426     { jobid    => 12,
1427       qclient  => 'plume-fd',
1428       qpools   => "'plume-fd', 'test-fd', '...'",
1429     }
1430
1431 =cut
1432
1433 sub get_form
1434 {
1435     my ($self, @what) = @_;
1436     my %what = map { $_ => 1 } @what;
1437     my %ret;
1438
1439     my %opt_i = (
1440                  limit  => 100,
1441                  cost   =>  10,
1442                  offset =>   0,
1443                  width  => 640,
1444                  height => 480,
1445                  jobid  =>   0,
1446                  slot   =>   0,
1447                  drive  =>   0,
1448                  priority => 10,
1449                  age    => 60*60*24*7,
1450                  days   => 1,
1451                  maxvoljobs  => 0,
1452                  maxvolbytes => 0,
1453                  maxvolfiles => 0,
1454                  filenameid => 0,
1455                  pathid => 0,
1456                  );
1457
1458     my %opt_ss =(               # string with space
1459                  job     => 1,
1460                  storage => 1,
1461                  );
1462     my %opt_s = (               # default to ''
1463                  ach    => 1,
1464                  status => 1,
1465                  volstatus => 1,
1466                  inchanger => 1,
1467                  client => 1,
1468                  level  => 1,
1469                  pool   => 1,
1470                  media  => 1,
1471                  ach    => 1,
1472                  jobtype=> 1,
1473                  graph  => 1,
1474                  gtype  => 1,
1475                  type   => 1,
1476                  poolrecycle => 1,
1477                  replace => 1,
1478                  expired => 1,
1479                  enabled => 1,
1480                  username => 1,
1481                  rolename => 1,
1482                  );
1483     my %opt_p = (               # option with path
1484                  fileset=> 1,
1485                  mtxcmd => 1,
1486                  precmd => 1,
1487                  device => 1,
1488                  where  => 1,
1489                  );
1490     my %opt_r = (regexwhere => 1);
1491
1492     my %opt_d = (               # option with date
1493                  voluseduration=> 1,
1494                  volretention => 1,
1495                 );
1496
1497     foreach my $i (@what) {
1498         if (exists $opt_i{$i}) {# integer param
1499             my $value = CGI::param($i) || $opt_i{$i} ;
1500             if ($value =~ /^(\d+)$/) {
1501                 $ret{$i} = $1;
1502             }
1503         } elsif ($opt_s{$i}) {  # simple string param
1504             my $value = CGI::param($i) || '';
1505             if ($value =~ /^([\w\d\.-]+)$/) {
1506                 $ret{$i} = $1;
1507             }
1508         } elsif ($opt_ss{$i}) { # simple string param (with space)
1509             my $value = CGI::param($i) || '';
1510             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1511                 $ret{$i} = $1;
1512             }
1513         } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1514             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1515             if (@value) {
1516                 $ret{$i} = $self->dbh_join(@value) ;
1517             }
1518
1519         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1520             my $value = CGI::param($1) ;
1521             if ($value) {
1522                 $ret{$i} = $self->dbh_quote($value);
1523             }
1524
1525         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1526             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1527                                            grep { ! /^\s*$/ } CGI::param($1) ];
1528         } elsif (exists $opt_p{$i}) {
1529             my $value = CGI::param($i) || '';
1530             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1531                 $ret{$i} = $1;
1532             }
1533         } elsif (exists $opt_r{$i}) {
1534             my $value = CGI::param($i) || '';
1535             if ($value =~ /^([^'"']+)$/) {
1536                 $ret{$i} = $1;
1537             }
1538         } elsif (exists $opt_d{$i}) {
1539             my $value = CGI::param($i) || '';
1540             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1541                 $ret{$i} = $1;
1542             }
1543         }
1544     }
1545
1546     if ($what{slots}) {
1547         foreach my $s (CGI::param('slot')) {
1548             if ($s =~ /^(\d+)$/) {
1549                 push @{$ret{slots}}, $s;
1550             }
1551         }
1552     }
1553
1554     if ($what{when}) {
1555         my $when = CGI::param('when') || '';
1556         if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1557             $ret{when} = $1;
1558         }
1559     }
1560
1561     if ($what{db_clients}) {
1562         my $filter='';
1563         if ($what{filter}) {
1564             # get security filter only if asked
1565             $filter = $self->get_client_filter();
1566         }
1567
1568         my $query = "
1569 SELECT Client.Name as clientname
1570   FROM Client $filter
1571 ";
1572
1573         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1574         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1575                               values %$clients] ;
1576     }
1577
1578     if ($what{db_client_groups}) {
1579         my $filter='';
1580         if ($what{filter}) {
1581             # get security filter only if asked
1582             $filter = $self->get_client_group_filter();
1583         }
1584
1585         my $query = "
1586 SELECT client_group_name AS name
1587   FROM client_group $filter
1588 ";
1589
1590         my $grps = $self->dbh_selectall_hashref($query, 'name');
1591         $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1592                                   values %$grps] ;
1593     }
1594
1595     if ($what{db_usernames}) {
1596         my $query = "
1597 SELECT username
1598   FROM bweb_user
1599 ";
1600
1601         my $users = $self->dbh_selectall_hashref($query, 'username');
1602         $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1603                                   values %$users] ;
1604     }
1605
1606     if ($what{db_roles}) {
1607         my $query = "
1608 SELECT rolename
1609   FROM bweb_role
1610 ";
1611
1612         my $r = $self->dbh_selectall_hashref($query, 'rolename');
1613         $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1614                                   values %$r] ;
1615     }
1616
1617     if ($what{db_mediatypes}) {
1618         my $query = "
1619 SELECT MediaType as mediatype
1620   FROM MediaType
1621 ";
1622
1623         my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1624         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1625                                   values %$media] ;
1626     }
1627
1628     if ($what{db_locations}) {
1629         my $query = "
1630 SELECT Location as location, Cost as cost
1631   FROM Location
1632 ";
1633         my $loc = $self->dbh_selectall_hashref($query, 'location');
1634         $ret{db_locations} = [ sort { $a->{location}
1635                                       cmp
1636                                       $b->{location}
1637                                   } values %$loc ];
1638     }
1639
1640     if ($what{db_pools}) {
1641         my $query = "SELECT Name as name FROM Pool";
1642
1643         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1644         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1645     }
1646
1647     if ($what{db_filesets}) {
1648         my $query = "
1649 SELECT FileSet.FileSet AS fileset
1650   FROM FileSet
1651 ";
1652
1653         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1654
1655         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1656                                values %$filesets] ;
1657     }
1658
1659     if ($what{db_jobnames}) {
1660         my $filter='';
1661         if ($what{filter}) {
1662             $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1663         }
1664         my $query = "
1665 SELECT DISTINCT Job.Name AS jobname
1666   FROM Job $filter
1667 ";
1668
1669         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1670
1671         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1672                                values %$jobnames] ;
1673     }
1674
1675     if ($what{db_devices}) {
1676         my $query = "
1677 SELECT Device.Name AS name
1678   FROM Device
1679 ";
1680
1681         my $devices = $self->dbh_selectall_hashref($query, 'name');
1682
1683         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1684                                values %$devices] ;
1685     }
1686
1687     return \%ret;
1688 }
1689
1690 sub display_graph
1691 {
1692     my ($self) = @_;
1693
1694     my $fields = $self->get_form(qw/age level status clients filesets
1695                                     graph gtype type filter db_clients
1696                                     limit db_filesets width height
1697                                     qclients qfilesets qjobnames db_jobnames/);
1698
1699
1700     my $url = CGI::url(-full => 0,
1701                        -base => 0,
1702                        -query => 1);
1703     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1704
1705 # this organisation is to keep user choice between 2 click
1706 # TODO : fileset and client selection doesn't work
1707
1708     $self->display({
1709         url => $url,
1710         %$fields,
1711     }, "graph.tpl")
1712
1713 }
1714
1715 sub get_selected_media_location
1716 {
1717     my ($self) = @_ ;
1718
1719     my $media = $self->get_form('jmedias');
1720
1721     unless ($media->{jmedias}) {
1722         return undef;
1723     }
1724
1725     my $query = "
1726 SELECT Media.VolumeName AS volumename, Location.Location AS location
1727 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1728 WHERE Media.VolumeName IN ($media->{jmedias})
1729 ";
1730
1731     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1732
1733     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1734     #               ..
1735     #             }
1736     # }
1737     return $all;
1738 }
1739
1740 sub move_media
1741 {
1742     my ($self, $in) = @_ ;
1743
1744     my $media = $self->get_selected_media_location();
1745
1746     unless ($media) {
1747         return ;
1748     }
1749
1750     my $elt = $self->get_form('db_locations');
1751
1752     $self->display({ ID => $cur_id++,
1753                      enabled => human_enabled($in),
1754                      %$elt,     # db_locations
1755                      media => [
1756             sort { $a->{volumename} cmp $b->{volumename} } values %$media
1757                                ],
1758                      },
1759                    "move_media.tpl");
1760 }
1761
1762 sub help_extern
1763 {
1764     my ($self) = @_ ;
1765
1766     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1767     $self->debug($elt);
1768     $self->display($elt, "help_extern.tpl");
1769 }
1770
1771 sub help_extern_compute
1772 {
1773     my ($self) = @_;
1774
1775     my $number = CGI::param('limit') || '' ;
1776     unless ($number =~ /^(\d+)$/) {
1777         return $self->error("Bad arg number : $number ");
1778     }
1779
1780     my ($sql, undef) = $self->get_param('pools',
1781                                         'locations', 'mediatypes');
1782
1783     my $query = "
1784 SELECT Media.VolumeName  AS volumename,
1785        Media.VolStatus   AS volstatus,
1786        Media.LastWritten AS lastwritten,
1787        Media.MediaType   AS mediatype,
1788        Media.VolMounts   AS volmounts,
1789        Pool.Name         AS name,
1790        Media.Recycle     AS recycle,
1791        $self->{sql}->{FROM_UNIXTIME}(
1792           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1793         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1794        ) AS expire
1795 FROM Media
1796  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
1797  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
1798
1799 WHERE Media.InChanger = 1
1800   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1801   $sql
1802 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1803 LIMIT $number
1804 " ;
1805
1806     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1807
1808     $self->display({ Media => [ values %$all ] },
1809                    "help_extern_compute.tpl");
1810 }
1811
1812 sub help_intern
1813 {
1814     my ($self) = @_ ;
1815
1816     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1817     $self->display($param, "help_intern.tpl");
1818 }
1819
1820 sub help_intern_compute
1821 {
1822     my ($self) = @_;
1823
1824     my $number = CGI::param('limit') || '' ;
1825     unless ($number =~ /^(\d+)$/) {
1826         return $self->error("Bad arg number : $number ");
1827     }
1828
1829     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1830
1831     if (CGI::param('expired')) {
1832         $sql = "
1833 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1834        + $self->{sql}->{TO_SEC}(Media.VolRetention)
1835     ) < NOW()
1836  " . $sql ;
1837     }
1838
1839     my $query = "
1840 SELECT Media.VolumeName  AS volumename,
1841        Media.VolStatus   AS volstatus,
1842        Media.LastWritten AS lastwritten,
1843        Media.MediaType   AS mediatype,
1844        Media.VolMounts   AS volmounts,
1845        Pool.Name         AS name,
1846        $self->{sql}->{FROM_UNIXTIME}(
1847           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1848         + $self->{sql}->{TO_SEC}(Media.VolRetention)
1849        ) AS expire
1850 FROM Media
1851  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1852  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
1853
1854 WHERE Media.InChanger <> 1
1855   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1856   AND Media.Recycle = 1
1857   $sql
1858 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1859 LIMIT $number
1860 " ;
1861
1862     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1863
1864     $self->display({ Media => [ values %$all ] },
1865                    "help_intern_compute.tpl");
1866
1867 }
1868
1869 sub display_general
1870 {
1871     my ($self, %arg) = @_ ;
1872
1873     my ($limit, $label) = $self->get_limit(%arg);
1874
1875     my $query = "
1876 SELECT
1877     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
1878     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
1879     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
1880     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
1881     ($self->{sql}->{DB_SIZE})                 AS db_size,
1882     (SELECT count(Job.JobId)
1883       FROM Job
1884       WHERE Job.JobStatus IN ('E','e','f','A')
1885       $limit
1886     )                                         AS nb_err,
1887     (SELECT count(Client.ClientId) FROM Client) AS nb_client
1888 ";
1889
1890     my $row = $self->dbh_selectrow_hashref($query) ;
1891
1892     $row->{nb_bytes} = human_size($row->{nb_bytes});
1893
1894     $row->{db_size} = human_size($row->{db_size});
1895     $row->{label} = $label;
1896
1897     $self->display($row, "general.tpl");
1898 }
1899
1900 sub get_param
1901 {
1902     my ($self, @what) = @_ ;
1903     my %elt = map { $_ => 1 } @what;
1904     my %ret;
1905
1906     my $limit = '';
1907
1908     if ($elt{clients}) {
1909         my @clients = grep { ! /^\s*$/ } CGI::param('client');
1910         if (@clients) {
1911             $ret{clients} = \@clients;
1912             my $str = $self->dbh_join(@clients);
1913             $limit .= "AND Client.Name IN ($str) ";
1914         }
1915     }
1916
1917     if ($elt{client_groups}) {
1918         my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1919         if (@clients) {
1920             $ret{client_groups} = \@clients;
1921             my $str = $self->dbh_join(@clients);
1922             $limit .= "AND client_group_name IN ($str) ";
1923         }
1924     }
1925
1926     if ($elt{filesets}) {
1927         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1928         if (@filesets) {
1929             $ret{filesets} = \@filesets;
1930             my $str = $self->dbh_join(@filesets);
1931             $limit .= "AND FileSet.FileSet IN ($str) ";
1932         }
1933     }
1934
1935     if ($elt{mediatypes}) {
1936         my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
1937         if (@media) {
1938             $ret{mediatypes} = \@media;
1939             my $str = $self->dbh_join(@media);
1940             $limit .= "AND Media.MediaType IN ($str) ";
1941         }
1942     }
1943
1944     if ($elt{client}) {
1945         my $client = CGI::param('client');
1946         $ret{client} = $client;
1947         $client = $self->dbh_join($client);
1948         $limit .= "AND Client.Name = $client ";
1949     }
1950
1951     if ($elt{level}) {
1952         my $level = CGI::param('level') || '';
1953         if ($level =~ /^(\w)$/) {
1954             $ret{level} = $1;
1955             $limit .= "AND Job.Level = '$1' ";
1956         }
1957     }
1958
1959     if ($elt{jobid}) {
1960         my $jobid = CGI::param('jobid') || '';
1961
1962         if ($jobid =~ /^(\d+)$/) {
1963             $ret{jobid} = $1;
1964             $limit .= "AND Job.JobId = '$1' ";
1965         }
1966     }
1967
1968     if ($elt{status}) {
1969         my $status = CGI::param('status') || '';
1970         if ($status =~ /^(\w)$/) {
1971             $ret{status} = $1;
1972             if ($1 eq 'f') {
1973                 $limit .= "AND Job.JobStatus IN ('f','E') ";
1974             } elsif ($1 eq 'W') {
1975                 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1976             } else {
1977                 $limit .= "AND Job.JobStatus = '$1' ";
1978             }
1979         }
1980     }
1981
1982     if ($elt{volstatus}) {
1983         my $status = CGI::param('volstatus') || '';
1984         if ($status =~ /^(\w+)$/) {
1985             $ret{status} = $1;
1986             $limit .= "AND Media.VolStatus = '$1' ";
1987         }
1988     }
1989
1990     if ($elt{locations}) {
1991         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1992         if (@location) {
1993             $ret{locations} = \@location;
1994             my $str = $self->dbh_join(@location);
1995             $limit .= "AND Location.Location IN ($str) ";
1996         }
1997     }
1998
1999     if ($elt{pools}) {
2000         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2001         if (@pool) {
2002             $ret{pools} = \@pool;
2003             my $str = $self->dbh_join(@pool);
2004             $limit .= "AND Pool.Name IN ($str) ";
2005         }
2006     }
2007
2008     if ($elt{location}) {
2009         my $location = CGI::param('location') || '';
2010         if ($location) {
2011             $ret{location} = $location;
2012             $location = $self->dbh_quote($location);
2013             $limit .= "AND Location.Location = $location ";
2014         }
2015     }
2016
2017     if ($elt{pool}) {
2018         my $pool = CGI::param('pool') || '';
2019         if ($pool) {
2020             $ret{pool} = $pool;
2021             $pool = $self->dbh_quote($pool);
2022             $limit .= "AND Pool.Name = $pool ";
2023         }
2024     }
2025
2026     if ($elt{jobtype}) {
2027         my $jobtype = CGI::param('jobtype') || '';
2028         if ($jobtype =~ /^(\w)$/) {
2029             $ret{jobtype} = $1;
2030             $limit .= "AND Job.Type = '$1' ";
2031         }
2032     }
2033
2034     return ($limit, %ret);
2035 }
2036
2037 =head1
2038
2039     get last backup
2040
2041 =cut
2042
2043 sub display_job
2044 {
2045     my ($self, %arg) = @_ ;
2046     $self->can_do('r_view_job');
2047
2048     $arg{order} = ' Job.JobId DESC ';
2049
2050     my ($limit, $label) = $self->get_limit(%arg);
2051     my ($where, undef) = $self->get_param('clients',
2052                                           'client_groups',
2053                                           'level',
2054                                           'filesets',
2055                                           'jobtype',
2056                                           'pools',
2057                                           'jobid',
2058                                           'status');
2059     my $cgq='';
2060     if (CGI::param('client_group')) {
2061         $cgq .= "
2062 JOIN client_group_member USING (ClientId)
2063 JOIN client_group USING (client_group_id)
2064 ";
2065     }
2066     my $filter = $self->get_client_filter();
2067
2068     my $query="
2069 SELECT  Job.JobId       AS jobid,
2070         Client.Name     AS client,
2071         FileSet.FileSet AS fileset,
2072         Job.Name        AS jobname,
2073         Level           AS level,
2074         StartTime       AS starttime,
2075         EndTime         AS endtime,
2076         Pool.Name       AS poolname,
2077         JobFiles        AS jobfiles,
2078         JobBytes        AS jobbytes,
2079         JobStatus       AS jobstatus,
2080      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2081                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2082                         AS duration,
2083
2084         JobErrors       AS joberrors
2085
2086  FROM Client $filter $cgq,
2087       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2088           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2089  WHERE Client.ClientId=Job.ClientId
2090    AND Job.JobStatus NOT IN ('R', 'C')
2091  $where
2092  $limit
2093 ";
2094
2095     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2096
2097     $self->display({ Filter => $label,
2098                      ID => $cur_id++,
2099                      Jobs =>
2100                            [
2101                              sort { $a->{jobid} <=>  $b->{jobid} }
2102                                         values %$all
2103                              ],
2104                    },
2105                    "display_job.tpl");
2106 }
2107
2108 # display job informations
2109 sub display_job_zoom
2110 {
2111     my ($self, $jobid) = @_ ;
2112     $self->can_do('r_view_job');
2113
2114     $jobid = $self->dbh_quote($jobid);
2115
2116     # get security filter
2117     my $filter = $self->get_client_filter();
2118
2119     my $query="
2120 SELECT DISTINCT Job.JobId       AS jobid,
2121                 Client.Name     AS client,
2122                 Job.Name        AS jobname,
2123                 FileSet.FileSet AS fileset,
2124                 Level           AS level,
2125                 Pool.Name       AS poolname,
2126                 StartTime       AS starttime,
2127                 JobFiles        AS jobfiles,
2128                 JobBytes        AS jobbytes,
2129                 JobStatus       AS jobstatus,
2130                 JobErrors       AS joberrors,
2131                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2132                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2133
2134  FROM Client $filter,
2135       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2136           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2137  WHERE Client.ClientId=Job.ClientId
2138  AND Job.JobId = $jobid
2139 ";
2140
2141     my $row = $self->dbh_selectrow_hashref($query) ;
2142
2143     # display all volumes associate with this job
2144     $query="
2145 SELECT Media.VolumeName as volumename
2146 FROM Job,Media,JobMedia
2147 WHERE Job.JobId = $jobid
2148  AND JobMedia.JobId=Job.JobId
2149  AND JobMedia.MediaId=Media.MediaId
2150 ";
2151
2152     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2153
2154     $row->{volumes} = [ values %$all ] ;
2155
2156     $self->display($row, "display_job_zoom.tpl");
2157 }
2158
2159 sub display_job_group
2160 {
2161     my ($self, %arg) = @_;
2162     $self->can_do('r_view_job');
2163
2164     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2165
2166     my ($where, undef) = $self->get_param('client_groups',
2167                                           'level',
2168                                           'pools');
2169     my $filter = $self->get_client_group_filter();
2170     my $query =
2171 "
2172 SELECT client_group_name AS client_group_name,
2173        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2174        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2175        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2176        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2177        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2178        COALESCE(jobok.duration, '0:0:0') AS duration
2179
2180 FROM client_group $filter LEFT JOIN (
2181     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2182            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2183            SUM(JobErrors) AS joberrors,
2184            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2185                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2186                         AS duration
2187
2188     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2189              JOIN client_group USING (client_group_id)
2190
2191     WHERE JobStatus = 'T'
2192     $where
2193     $limit
2194 ) AS jobok USING (client_group_name) LEFT JOIN
2195
2196 (
2197     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2198            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2199            SUM(JobErrors) AS joberrors
2200     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2201              JOIN client_group USING (client_group_id)
2202
2203     WHERE JobStatus IN ('f','E', 'A')
2204     $where
2205     $limit
2206 ) AS joberr USING (client_group_name)
2207
2208     ";
2209
2210     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2211
2212     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2213
2214     $self->debug($rep);
2215     $self->display($rep, "display_job_group.tpl");
2216 }
2217
2218 sub display_media
2219 {
2220     my ($self, %arg) = @_ ;
2221
2222     my ($limit, $label) = $self->get_limit(%arg);
2223     my ($where, %elt) = $self->get_param('pools',
2224                                          'mediatypes',
2225                                          'volstatus',
2226                                          'locations');
2227
2228     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2229
2230     if ($arg->{jmedias}) {
2231         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2232     }
2233     if ($arg->{qre_media}) {
2234         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2235     }
2236     if ($arg->{expired}) {
2237         $where = "
2238         AND VolStatus = 'Full'
2239         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2240                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2241             ) < NOW()  " . $where ;
2242     }
2243
2244     my $query="
2245 SELECT Media.VolumeName  AS volumename,
2246        Media.VolBytes    AS volbytes,
2247        Media.VolStatus   AS volstatus,
2248        Media.MediaType   AS mediatype,
2249        Media.InChanger   AS online,
2250        Media.LastWritten AS lastwritten,
2251        Location.Location AS location,
2252        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2253        Pool.Name         AS poolname,
2254        $self->{sql}->{FROM_UNIXTIME}(
2255           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2256         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2257        ) AS expire
2258 FROM      Pool, Media
2259 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2260 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2261                   Media.MediaType     AS MediaType
2262            FROM Media
2263           WHERE Media.VolStatus = 'Full'
2264           GROUP BY Media.MediaType
2265            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2266
2267 WHERE Media.PoolId=Pool.PoolId
2268 $where
2269 $limit
2270 ";
2271
2272     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2273
2274     $self->display({ ID => $cur_id++,
2275                      Pool => $elt{pool},
2276                      Location => $elt{location},
2277                      Media => [ values %$all ],
2278                    },
2279                    "display_media.tpl");
2280 }
2281
2282 sub display_allmedia
2283 {
2284     my ($self) = @_ ;
2285
2286     my $pool = $self->get_form('db_pools');
2287
2288     foreach my $name (@{ $pool->{db_pools} }) {
2289         CGI::param('pool', $name->{name});
2290         $self->display_media();
2291     }
2292 }
2293
2294 sub display_media_zoom
2295 {
2296     my ($self) = @_ ;
2297
2298     my $media = $self->get_form('jmedias');
2299
2300     unless ($media->{jmedias}) {
2301         return $self->error("Can't get media selection");
2302     }
2303
2304     my $query="
2305 SELECT InChanger     AS online,
2306        Media.Enabled AS enabled,
2307        VolBytes      AS nb_bytes,
2308        VolumeName    AS volumename,
2309        VolStatus     AS volstatus,
2310        VolMounts     AS nb_mounts,
2311        Media.VolUseDuration   AS voluseduration,
2312        Media.MaxVolJobs AS maxvoljobs,
2313        Media.MaxVolFiles AS maxvolfiles,
2314        Media.MaxVolBytes AS maxvolbytes,
2315        VolErrors     AS nb_errors,
2316        Pool.Name     AS poolname,
2317        Location.Location AS location,
2318        Media.Recycle AS recycle,
2319        Media.VolRetention AS volretention,
2320        Media.LastWritten  AS lastwritten,
2321        Media.VolReadTime/1000000  AS volreadtime,
2322        Media.VolWriteTime/1000000 AS volwritetime,
2323        Media.RecycleCount AS recyclecount,
2324        Media.Comment      AS comment,
2325        $self->{sql}->{FROM_UNIXTIME}(
2326           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2327         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2328        ) AS expire
2329  FROM Pool,
2330       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2331  WHERE Pool.PoolId = Media.PoolId
2332  AND VolumeName IN ($media->{jmedias})
2333 ";
2334
2335     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2336
2337     foreach my $media (values %$all) {
2338         my $mq = $self->dbh_quote($media->{volumename});
2339
2340         $query = "
2341 SELECT DISTINCT Job.JobId AS jobid,
2342                 Job.Name  AS name,
2343                 Job.StartTime AS starttime,
2344                 Job.Type  AS type,
2345                 Job.Level AS level,
2346                 Job.JobFiles AS files,
2347                 Job.JobBytes AS bytes,
2348                 Job.jobstatus AS status
2349  FROM Media,JobMedia,Job
2350  WHERE Media.VolumeName=$mq
2351  AND Media.MediaId=JobMedia.MediaId
2352  AND JobMedia.JobId=Job.JobId
2353 ";
2354
2355         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2356
2357         $query = "
2358 SELECT LocationLog.Date    AS date,
2359        Location.Location   AS location,
2360        LocationLog.Comment AS comment
2361  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2362  WHERE Media.MediaId = LocationLog.MediaId
2363    AND Media.VolumeName = $mq
2364 ";
2365
2366         my $logtxt = '';
2367         my $log = $self->dbh_selectall_arrayref($query) ;
2368         if ($log) {
2369             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2370         }
2371
2372         $self->display({ jobs => [ values %$jobs ],
2373                          LocationLog => $logtxt,
2374                          %$media },
2375                        "display_media_zoom.tpl");
2376     }
2377 }
2378
2379 sub location_edit
2380 {
2381     my ($self) = @_ ;
2382     $self->can_do('r_location_mgnt');
2383
2384     my $loc = $self->get_form('qlocation');
2385     unless ($loc->{qlocation}) {
2386         return $self->error("Can't get location");
2387     }
2388
2389     my $query = "
2390 SELECT Location.Location AS location,
2391        Location.Cost   AS cost,
2392        Location.Enabled AS enabled
2393 FROM Location
2394 WHERE Location.Location = $loc->{qlocation}
2395 ";
2396
2397     my $row = $self->dbh_selectrow_hashref($query);
2398     $row->{enabled} = human_enabled($row->{enabled});
2399     $self->display({ ID => $cur_id++,
2400                      %$row }, "location_edit.tpl") ;
2401 }
2402
2403 sub location_save
2404 {
2405     my ($self) = @_ ;
2406     $self->can_do('r_location_mgnt');
2407
2408     my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2409     unless ($arg->{qlocation}) {
2410         return $self->error("Can't get location");
2411     }
2412     unless ($arg->{qnewlocation}) {
2413         return $self->error("Can't get new location name");
2414     }
2415     unless ($arg->{cost}) {
2416         return $self->error("Can't get new cost");
2417     }
2418
2419     my $enabled = from_human_enabled($arg->{enabled});
2420
2421     my $query = "
2422 UPDATE Location SET Cost     = $arg->{cost},
2423                     Location = $arg->{qnewlocation},
2424                     Enabled   = $enabled
2425 WHERE Location.Location = $arg->{qlocation}
2426 ";
2427
2428     $self->dbh_do($query);
2429
2430     $self->location_display();
2431 }
2432
2433 sub location_del
2434 {
2435     my ($self) = @_ ;
2436     $self->can_do('r_location_mgnt');
2437
2438     my $arg = $self->get_form(qw/qlocation/) ;
2439
2440     unless ($arg->{qlocation}) {
2441         return $self->error("Can't get location");
2442     }
2443
2444     my $query = "
2445 SELECT count(Media.MediaId) AS nb
2446   FROM Media INNER JOIN Location USING (LocationID)
2447 WHERE Location = $arg->{qlocation}
2448 ";
2449
2450     my $res = $self->dbh_selectrow_hashref($query);
2451
2452     if ($res->{nb}) {
2453         return $self->error("Sorry, the location must be empty");
2454     }
2455
2456     $query = "
2457 DELETE FROM Location WHERE Location = $arg->{qlocation}
2458 ";
2459
2460     $self->dbh_do($query);
2461
2462     $self->location_display();
2463 }
2464
2465 sub location_add
2466 {
2467     my ($self) = @_ ;
2468     $self->can_do('r_location_mgnt');
2469
2470     my $arg = $self->get_form(qw/qlocation cost/) ;
2471
2472     unless ($arg->{qlocation}) {
2473         $self->display({}, "location_add.tpl");
2474         return 1;
2475     }
2476     unless ($arg->{cost}) {
2477         return $self->error("Can't get new cost");
2478     }
2479
2480     my $enabled = CGI::param('enabled') || '';
2481     $enabled = $enabled?1:0;
2482
2483     my $query = "
2484 INSERT INTO Location (Location, Cost, Enabled)
2485        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2486 ";
2487
2488     $self->dbh_do($query);
2489
2490     $self->location_display();
2491 }
2492
2493 sub location_display
2494 {
2495     my ($self) = @_ ;
2496
2497     my $query = "
2498 SELECT Location.Location AS location,
2499        Location.Cost     AS cost,
2500        Location.Enabled  AS enabled,
2501        (SELECT count(Media.MediaId)
2502          FROM Media
2503         WHERE Media.LocationId = Location.LocationId
2504        ) AS volnum
2505 FROM Location
2506 ";
2507
2508     my $location = $self->dbh_selectall_hashref($query, 'location');
2509
2510     $self->display({ ID => $cur_id++,
2511                      Locations => [ values %$location ] },
2512                    "display_location.tpl");
2513 }
2514
2515 sub update_location
2516 {
2517     my ($self) = @_ ;
2518
2519     my $media = $self->get_selected_media_location();
2520     unless ($media) {
2521         return ;
2522     }
2523
2524     my $arg = $self->get_form('db_locations', 'qnewlocation');
2525
2526     $self->display({ email  => $self->{info}->{email_media},
2527                      %$arg,
2528                      media => [ values %$media ],
2529                    },
2530                    "update_location.tpl");
2531 }
2532
2533 ###########################################################
2534
2535 sub groups_edit
2536 {
2537     my ($self) = @_;
2538     $self->can_do('r_group_mgnt');
2539
2540     my $grp = $self->get_form(qw/qclient_group db_clients/);
2541
2542     unless ($grp->{qclient_group}) {
2543         $self->display({ ID => $cur_id++,
2544                          client_group => "''",
2545                          %$grp,
2546                      }, "groups_edit.tpl");
2547         return;
2548     }
2549
2550     my $query = "
2551 SELECT Name AS name
2552   FROM Client JOIN client_group_member using (clientid)
2553               JOIN client_group using (client_group_id)
2554 WHERE client_group_name = $grp->{qclient_group}
2555 ";
2556
2557     my $row = $self->dbh_selectall_hashref($query, "name");
2558     $self->debug($row);
2559     $self->display({ ID => $cur_id++,
2560                      client_group => $grp->{qclient_group},
2561                      %$grp,
2562                      client_group_member => [ values %$row]},
2563                    "groups_edit.tpl");
2564 }
2565
2566 sub groups_save
2567 {
2568     my ($self) = @_;
2569     $self->can_do('r_group_mgnt');
2570
2571     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2572
2573     if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2574         my $query = "
2575 INSERT INTO client_group (client_group_name)
2576 VALUES ($arg->{qnewgroup})
2577 ";
2578         $self->dbh_do($query);
2579         $arg->{qclient_group} = $arg->{qnewgroup};
2580     }
2581
2582     unless ($arg->{qclient_group}) {
2583         return $self->error("Can't get groups");
2584     }
2585
2586     $self->{dbh}->begin_work();
2587
2588     my $query = "
2589 DELETE FROM client_group_member
2590       WHERE client_group_id IN
2591            (SELECT client_group_id
2592               FROM client_group
2593              WHERE client_group_name = $arg->{qclient_group})
2594 ";
2595     $self->dbh_do($query);
2596
2597     $query = "
2598     INSERT INTO client_group_member (clientid, client_group_id)
2599        (SELECT  Clientid,
2600                 (SELECT client_group_id
2601                    FROM client_group
2602                   WHERE client_group_name = $arg->{qclient_group})
2603           FROM Client WHERE Name IN ($arg->{jclients})
2604        )
2605 ";
2606     $self->dbh_do($query);
2607
2608     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2609         $query = "
2610 UPDATE client_group
2611    SET client_group_name = $arg->{qnewgroup}
2612  WHERE client_group_name = $arg->{qclient_group}
2613 ";
2614
2615         $self->dbh_do($query);
2616     }
2617
2618     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2619
2620     $self->display_groups();
2621 }
2622
2623 sub groups_del
2624 {
2625     my ($self) = @_;
2626     $self->can_do('r_group_mgnt');
2627
2628     my $arg = $self->get_form(qw/qclient_group/);
2629
2630     unless ($arg->{qclient_group}) {
2631         return $self->error("Can't get groups");
2632     }
2633
2634     $self->{dbh}->begin_work();
2635
2636     my $query = "
2637 DELETE FROM client_group_member
2638       WHERE client_group_id IN
2639            (SELECT client_group_id
2640               FROM client_group
2641              WHERE client_group_name = $arg->{qclient_group});
2642
2643 DELETE FROM bweb_client_group_acl
2644       WHERE client_group_id IN
2645            (SELECT client_group_id
2646               FROM client_group
2647              WHERE client_group_name = $arg->{qclient_group});
2648
2649 DELETE FROM client_group
2650       WHERE client_group_name = $arg->{qclient_group};
2651 ";
2652     $self->dbh_do($query);
2653
2654     $self->{dbh}->commit();
2655
2656     $self->display_groups();
2657 }
2658
2659 sub display_groups
2660 {
2661     my ($self) = @_;
2662
2663     my $arg = $self->get_form(qw/db_client_groups/) ;
2664
2665     if ($self->{dbh}->errstr) {
2666         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2667     }
2668
2669     $self->debug($arg);
2670
2671     $self->display({ ID => $cur_id++,
2672                      %$arg},
2673                    "display_groups.tpl");
2674 }
2675
2676 ###########################################################
2677
2678 sub get_roles
2679 {
2680     my ($self) = @_;
2681     if (not $self->{info}->{enable_security}) {
2682         return 1;
2683     }
2684     # admin is a special user that can do everything
2685     if ($self->{loginname} eq 'admin') {
2686         return 1;
2687     }
2688     if (!$self->{loginname}) {
2689         return 0;
2690     }
2691     # already fill
2692     if (defined $self->{security}) {
2693         return 1;
2694     }
2695     $self->{security} = {};
2696     my $u = $self->dbh_quote($self->{loginname});
2697
2698     my $query = "
2699  SELECT use_acl, rolename
2700   FROM bweb_user
2701        JOIN bweb_role_member USING (userid)
2702        JOIN bweb_role USING (roleid)
2703  WHERE username = $u
2704 ";
2705     my $rows = $self->dbh_selectall_arrayref($query);
2706     # do cache with this role
2707     if (!$rows) {
2708         return 0;
2709     }
2710     foreach my $r (@$rows) {
2711         $self->{security}->{$r->[1]}=1;
2712     }
2713
2714     $self->{security}->{use_acl} = $rows->[0]->[0];
2715     return 1;
2716 }
2717
2718 # TODO: avoir un mode qui coupe le programme avec une page d'erreur
2719 # we can also get all security and fill {security} hash
2720 sub can_do
2721 {
2722     my ($self, $action) = @_;
2723     # is security enabled in configuration ?
2724     if (not $self->{info}->{enable_security}) {
2725         return 1;
2726     }
2727     # admin is a special user that can do everything
2728     if ($self->{loginname} eq 'admin') {
2729         return 1;
2730     }
2731     # must be logged
2732     if (!$self->{loginname}) {
2733         $self->error("Can't do $action, your are not logged. " .
2734                      "Check security with your administrator");
2735         $self->display_end();
2736         exit (0);
2737     }
2738     $self->get_roles();
2739     if (!$self->{security}->{$action}) {
2740         $self->error("$self->{loginname} sorry, but this action ($action) " .
2741                      "is not permited. " .
2742                      "Check security with your administrator");
2743         $self->display_end();
2744         exit (0);
2745     }
2746     return 1;
2747 }
2748
2749 sub use_filter
2750 {
2751     my ($self) = @_;
2752
2753     if (!$self->{info}->{enable_security} or
2754         !$self->{info}->{enable_security_acl})
2755     {
2756         return 0 ;
2757     }
2758
2759     if ($self->get_roles()) {
2760         return $self->{security}->{use_acl};
2761     } else {
2762         return 0;
2763     }
2764 }
2765
2766 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
2767 sub get_client_filter
2768 {
2769     my ($self, $login) = @_;
2770     my $u;
2771     if ($login) {
2772         $u = $self->dbh_quote($login);
2773     } elsif ($self->use_filter()) {
2774         $u = $self->dbh_quote($self->{loginname});
2775     } else {
2776         return '';
2777     }
2778     return "
2779  JOIN (SELECT ClientId FROM client_group_member
2780    JOIN client_group USING (client_group_id)
2781    JOIN bweb_client_group_acl USING (client_group_id)
2782    JOIN bweb_user USING (userid)
2783    WHERE bweb_user.username = $u
2784  ) AS filter USING (ClientId)";
2785 }
2786
2787 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
2788 sub get_client_group_filter
2789 {
2790     my ($self, $login) = @_;
2791     my $u;
2792     if ($login) {
2793         $u = $self->dbh_quote($login);
2794     } elsif ($self->use_filter()) {
2795         $u = $self->dbh_quote($self->{loginname});
2796     } else {
2797         return '';
2798     }
2799     return "
2800  JOIN (SELECT client_group_id
2801          FROM bweb_client_group_acl
2802          JOIN bweb_user USING (userid)
2803    WHERE bweb_user.username = $u
2804  ) AS filter USING (client_group_id)";
2805 }
2806
2807 # role and username have to be quoted before
2808 # role and username can be a quoted list
2809 sub revoke
2810 {
2811     my ($self, $role, $username) = @_;
2812     $self->can_do("r_user_mgnt");
2813
2814     my $nb = $self->dbh_do("
2815  DELETE FROM bweb_role_member
2816        WHERE roleid = (SELECT roleid FROM bweb_role
2817                         WHERE rolename IN ($role))
2818          AND userid = (SELECT userid FROM bweb_user
2819                         WHERE username IN ($username))");
2820     return $nb;
2821 }
2822
2823 # role and username have to be quoted before
2824 # role and username can be a quoted list
2825 sub grant
2826 {
2827     my ($self, $role, $username) = @_;
2828     $self->can_do("r_user_mgnt");
2829
2830     my $nb = $self->dbh_do("
2831    INSERT INTO bweb_role_member (roleid, userid)
2832      SELECT roleid, userid FROM bweb_role, bweb_user
2833       WHERE rolename IN ($role)
2834         AND username IN ($username)
2835      ");
2836     return $nb;
2837 }
2838
2839 # role and username have to be quoted before
2840 # role and username can be a quoted list
2841 sub grant_like
2842 {
2843     my ($self, $copy, $user) = @_;
2844     $self->can_do("r_user_mgnt");
2845
2846     my $nb = $self->dbh_do("
2847   INSERT INTO bweb_role_member (roleid, userid)
2848    SELECT roleid, a.userid
2849      FROM bweb_user AS a, bweb_role_member
2850      JOIN bweb_user USING (userid)
2851     WHERE bweb_user.username = $copy
2852       AND a.username = $user");
2853     return $nb;
2854 }
2855
2856 # username can be a join quoted list of usernames
2857 sub revoke_all
2858 {
2859     my ($self, $username) = @_;
2860     $self->can_do("r_user_mgnt");
2861
2862     $self->dbh_do("
2863    DELETE FROM bweb_role_member
2864          WHERE userid IN (
2865            SELECT userid
2866              FROM bweb_user
2867             WHERE username in ($username))");
2868     $self->dbh_do("
2869 DELETE FROM bweb_client_group_acl
2870  WHERE userid IN (
2871   SELECT userid
2872     FROM bweb_user
2873    WHERE username IN ($username))");
2874
2875 }
2876
2877 sub users_del
2878 {
2879     my ($self) = @_;
2880     $self->can_do("r_user_mgnt");
2881
2882     my $arg = $self->get_form(qw/jusernames/);
2883
2884     unless ($arg->{jusernames}) {
2885         return $self->error("Can't get user");
2886     }
2887
2888     $self->{dbh}->begin_work();
2889     {
2890         $self->revoke_all($arg->{jusernames});
2891         $self->dbh_do("
2892 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
2893     }
2894     $self->{dbh}->commit();
2895
2896     $self->display_users();
2897 }
2898
2899 sub users_add
2900 {
2901     my ($self) = @_;
2902     $self->can_do("r_user_mgnt");
2903
2904     # we don't quote username directly to check that it is conform
2905     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate qcopy_username jclient_groups/) ;
2906
2907     if (not $arg->{qcreate}) {
2908         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
2909         $self->display($arg, "display_user.tpl");
2910         return 1;
2911     }
2912
2913     my $u = $self->dbh_quote($arg->{username});
2914
2915     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
2916
2917     if (!$arg->{qpasswd}) {
2918         $arg->{qpasswd} = "''";
2919     }
2920     if (!$arg->{qcomment}) {
2921         $arg->{qcomment} = "''";
2922     }
2923
2924     # will fail if user already exists
2925     # UPDATE with mysql dbi does not return if update is ok
2926     ($self->dbh_do("
2927   UPDATE bweb_user
2928      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
2929          use_acl=$arg->{use_acl}
2930    WHERE username = $u")
2931 #     and (! $self->dbh_is_mysql() )
2932      ) and
2933     $self->dbh_do("
2934   INSERT INTO bweb_user (username, passwd, use_acl, comment)
2935         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl}, $arg->{qcomment})");
2936
2937     $self->{dbh}->begin_work();
2938     {
2939         $self->revoke_all($u);
2940
2941         if ($arg->{qcopy_username}) {
2942             $self->grant_like($arg->{qcopy_username}, $u);
2943         } else {
2944             $self->grant($arg->{jrolenames}, $u);
2945         }
2946
2947         if ($arg->{jclient_groups}) {
2948             $self->dbh_do("
2949 INSERT INTO bweb_client_group_acl (client_group_id, userid)
2950  SELECT client_group_id, userid
2951    FROM client_group, bweb_user
2952   WHERE client_group_name IN ($arg->{jclient_groups})
2953     AND username = $u
2954 ");
2955         }
2956     }
2957     $self->{dbh}->commit();
2958
2959     $self->display_users();
2960 }
2961
2962 # TODO: we miss a matrix with all user/roles
2963 sub display_users
2964 {
2965     my ($self) = @_;
2966     $self->can_do("r_user_mgnt");
2967
2968     my $arg = $self->get_form(qw/db_usernames/) ;
2969
2970     if ($self->{dbh}->errstr) {
2971         return $self->error("Can't use users with bweb, read INSTALL to enable them");
2972     }
2973
2974     $self->display({ ID => $cur_id++,
2975                      %$arg},
2976                    "display_users.tpl");
2977 }
2978
2979 sub display_user
2980 {
2981     my ($self) = @_;
2982     $self->can_do("r_user_mgnt");
2983
2984     my $arg = $self->get_form('username');
2985     my $user = $self->dbh_quote($arg->{username});
2986
2987     my $userp = $self->dbh_selectrow_hashref("
2988    SELECT username, passwd, comment, use_acl
2989      FROM bweb_user
2990     WHERE username = $user
2991 ");
2992     if (!$userp) {
2993         return $self->error("Can't find $user in catalog");
2994     }
2995     my $filter = $self->get_client_group_filter($arg->{username});
2996     my $scg = $self->dbh_selectall_hashref("
2997  SELECT client_group_name AS name
2998    FROM client_group $filter
2999 ", 'name');
3000
3001 #  rolename  | userid
3002 #------------+--------
3003 # cancel_job |
3004 # restore    |
3005 # run_job    |      1
3006
3007     my $role = $self->dbh_selectall_hashref("
3008 SELECT rolename, temp.userid
3009      FROM bweb_role
3010      LEFT JOIN (SELECT roleid, userid
3011                   FROM bweb_user JOIN bweb_role_member USING (userid)
3012                  WHERE username = $user) AS temp USING (roleid)
3013 ORDER BY rolename
3014 ", 'rolename');
3015
3016     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3017
3018     $self->display({
3019         db_usernames => $arg->{db_usernames},
3020         username => $userp->{username},
3021         comment => $userp->{comment},
3022         passwd => $userp->{passwd},
3023         use_acl => $userp->{use_acl},
3024         db_client_groups => $arg->{db_client_groups},
3025         client_group => [ values %$scg ],
3026         db_roles => [ values %$role],
3027     }, "display_user.tpl");
3028 }
3029
3030
3031 ###########################################################
3032
3033 sub get_media_max_size
3034 {
3035     my ($self, $type) = @_;
3036     my $query =
3037 "SELECT avg(VolBytes) AS size
3038   FROM Media
3039  WHERE Media.VolStatus = 'Full'
3040    AND Media.MediaType = '$type'
3041 ";
3042
3043     my $res = $self->selectrow_hashref($query);
3044
3045     if ($res) {
3046         return $res->{size};
3047     } else {
3048         return 0;
3049     }
3050 }
3051
3052 sub update_media
3053 {
3054     my ($self) = @_ ;
3055
3056     my $media = $self->get_form('qmedia');
3057
3058     unless ($media->{qmedia}) {
3059         return $self->error("Can't get media");
3060     }
3061
3062     my $query = "
3063 SELECT Media.Slot         AS slot,
3064        PoolMedia.Name     AS poolname,
3065        Media.VolStatus    AS volstatus,
3066        Media.InChanger    AS inchanger,
3067        Location.Location  AS location,
3068        Media.VolumeName   AS volumename,
3069        Media.MaxVolBytes  AS maxvolbytes,
3070        Media.MaxVolJobs   AS maxvoljobs,
3071        Media.MaxVolFiles  AS maxvolfiles,
3072        Media.VolUseDuration AS voluseduration,
3073        Media.VolRetention AS volretention,
3074        Media.Comment      AS comment,
3075        PoolRecycle.Name   AS poolrecycle,
3076        Media.Enabled      AS enabled
3077
3078 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3079            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3080            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3081
3082 WHERE Media.VolumeName = $media->{qmedia}
3083 ";
3084
3085     my $row = $self->dbh_selectrow_hashref($query);
3086     $row->{volretention} = human_sec($row->{volretention});
3087     $row->{voluseduration} = human_sec($row->{voluseduration});
3088     $row->{enabled} = human_enabled($row->{enabled});
3089
3090     my $elt = $self->get_form(qw/db_pools db_locations/);
3091
3092     $self->display({
3093         %$elt,
3094         %$row,
3095     }, "update_media.tpl");
3096 }
3097
3098 sub save_location
3099 {
3100     my ($self) = @_ ;
3101     $self->can_do('r_media_mgnt');
3102
3103     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3104
3105     unless ($arg->{jmedias}) {
3106         return $self->error("Can't get selected media");
3107     }
3108
3109     unless ($arg->{qnewlocation}) {
3110         return $self->error("Can't get new location");
3111     }
3112
3113     my $query = "
3114  UPDATE Media
3115      SET LocationId = (SELECT LocationId
3116                        FROM Location
3117                        WHERE Location = $arg->{qnewlocation})
3118      WHERE Media.VolumeName IN ($arg->{jmedias})
3119 ";
3120
3121     my $nb = $self->dbh_do($query);
3122
3123     print "$nb media updated, you may have to update your autochanger.";
3124
3125     $self->display_media();
3126 }
3127
3128 sub location_change
3129 {
3130     my ($self) = @_ ;
3131     $self->can_do('r_media_mgnt');
3132
3133     my $media = $self->get_selected_media_location();
3134     unless ($media) {
3135         return $self->error("Can't get media selection");
3136     }
3137     my $newloc = CGI::param('newlocation');
3138
3139     my $user = CGI::param('user') || 'unknown';
3140     my $comm = CGI::param('comment') || '';
3141     $comm = $self->dbh_quote("$user: $comm");
3142
3143     my $arg = $self->get_form('enabled');
3144     my $en = human_enabled($arg->{enabled});
3145     my $b = $self->get_bconsole();
3146
3147     my $query;
3148     foreach my $vol (keys %$media) {
3149         $query = "
3150 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
3151  VALUES(
3152        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$vol'),
3153        (SELECT LocationId FROM Location WHERE Location = '$media->{$vol}->{location}'),
3154        (SELECT VolStatus FROM Media WHERE VolumeName = '$vol')
3155       )
3156 ";
3157         $self->dbh_do($query);
3158         $self->debug($query);
3159         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3160     }
3161     $b->close();
3162
3163     my $q = new CGI;
3164     $q->param('action', 'update_location');
3165     my $url = $q->url(-full => 1, -query=>1);
3166
3167     $self->display({ email  => $self->{info}->{email_media},
3168                      url => $url,
3169                      newlocation => $newloc,
3170                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3171                      media => [ values %$media ],
3172                    },
3173                    "change_location.tpl");
3174
3175 }
3176
3177 sub display_client_stats
3178 {
3179     my ($self, %arg) = @_ ;
3180     $self->can_do('r_view_stats');
3181
3182     my $client = $self->dbh_quote($arg{clientname});
3183     # get security filter
3184     my $filter = $self->get_client_filter();
3185
3186     my ($limit, $label) = $self->get_limit(%arg);
3187     my $query = "
3188 SELECT
3189     count(Job.JobId)     AS nb_jobs,
3190     sum(Job.JobBytes)    AS nb_bytes,
3191     sum(Job.JobErrors)   AS nb_err,
3192     sum(Job.JobFiles)    AS nb_files,
3193     Client.Name          AS clientname
3194 FROM Job JOIN Client USING (ClientId) $filter
3195 WHERE
3196     Client.Name = $client
3197     $limit
3198 GROUP BY Client.Name
3199 ";
3200
3201     my $row = $self->dbh_selectrow_hashref($query);
3202
3203     $row->{ID} = $cur_id++;
3204     $row->{label} = $label;
3205     $row->{grapharg} = "client";
3206
3207     $self->display($row, "display_client_stats.tpl");
3208 }
3209
3210
3211 sub display_group_stats
3212 {
3213     my ($self, %arg) = @_ ;
3214
3215     my $carg = $self->get_form(qw/qclient_group/);
3216
3217     unless ($carg->{qclient_group}) {
3218         return $self->error("Can't get group");
3219     }
3220
3221     my ($limit, $label) = $self->get_limit(%arg);
3222
3223     my $query = "
3224 SELECT
3225     count(Job.JobId)     AS nb_jobs,
3226     sum(Job.JobBytes)    AS nb_bytes,
3227     sum(Job.JobErrors)   AS nb_err,
3228     sum(Job.JobFiles)    AS nb_files,
3229     client_group.client_group_name  AS clientname
3230 FROM Job JOIN Client USING (ClientId)
3231          JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3232          JOIN client_group USING (client_group_id)
3233 WHERE
3234     client_group.client_group_name = $carg->{qclient_group}
3235     $limit
3236 GROUP BY client_group.client_group_name
3237 ";
3238
3239     my $row = $self->dbh_selectrow_hashref($query);
3240
3241     $row->{ID} = $cur_id++;
3242     $row->{label} = $label;
3243     $row->{grapharg} = "client_group";
3244
3245     $self->display($row, "display_client_stats.tpl");
3246 }
3247
3248 # poolname can be undef
3249 sub display_pool
3250 {
3251     my ($self, $poolname) = @_ ;
3252     my $whereA = '';
3253     my $whereW = '';
3254
3255     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3256     if ($arg->{jmediatypes}) {
3257         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3258         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3259     }
3260
3261 # TODO : afficher les tailles et les dates
3262
3263     my $query = "
3264 SELECT subq.volmax        AS volmax,
3265        subq.volnum        AS volnum,
3266        subq.voltotal      AS voltotal,
3267        Pool.Name          AS name,
3268        Pool.Recycle       AS recycle,
3269        Pool.VolRetention  AS volretention,
3270        Pool.VolUseDuration AS voluseduration,
3271        Pool.MaxVolJobs    AS maxvoljobs,
3272        Pool.MaxVolFiles   AS maxvolfiles,
3273        Pool.MaxVolBytes   AS maxvolbytes,
3274        subq.PoolId        AS PoolId,
3275        subq.MediaType     AS mediatype,
3276        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3277 FROM
3278   (
3279     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3280            count(Media.MediaId)  AS volnum,
3281            sum(Media.VolBytes)   AS voltotal,
3282            Media.PoolId          AS PoolId,
3283            Media.MediaType       AS MediaType
3284     FROM Media
3285     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3286                       Media.MediaType     AS MediaType
3287                FROM Media
3288               WHERE Media.VolStatus = 'Full'
3289               GROUP BY Media.MediaType
3290                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3291     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3292   ) AS subq
3293 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3294 $whereW
3295 ";
3296
3297     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3298
3299     $query = "
3300 SELECT Pool.Name AS name,
3301        sum(VolBytes) AS size
3302 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3303 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3304        $whereA
3305 GROUP BY Pool.Name;
3306 ";
3307     my $empty = $self->dbh_selectall_hashref($query, 'name');
3308
3309     foreach my $p (values %$all) {
3310         if ($p->{volmax} > 0) { # mysql returns 0.0000
3311             # we remove Recycled/Purged media from pool usage
3312             if (defined $empty->{$p->{name}}) {
3313                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3314             }
3315             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3316         } else {
3317             $p->{poolusage} = 0;
3318         }
3319
3320         $query = "
3321   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3322     FROM Media
3323    WHERE PoolId=$p->{poolid}
3324      AND Media.MediaType = '$p->{mediatype}'
3325          $whereA
3326 GROUP BY VolStatus
3327 ";
3328         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3329         foreach my $t (values %$content) {
3330             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3331         }
3332     }
3333
3334     $self->debug($all);
3335     $self->display({ ID => $cur_id++,
3336                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3337                      Pools => [ values %$all ]},
3338                    "display_pool.tpl");
3339 }
3340
3341 sub display_running_job
3342 {
3343     my ($self) = @_;
3344     $self->can_do('r_view_running_job');
3345
3346     my $arg = $self->get_form('client', 'jobid');
3347
3348     if (!$arg->{client} and $arg->{jobid}) {
3349         # get security filter
3350         my $filter = $self->get_client_filter();
3351
3352         my $query = "
3353 SELECT Client.Name AS name
3354 FROM Job INNER JOIN Client USING (ClientId) $filter
3355 WHERE Job.JobId = $arg->{jobid}
3356 ";
3357
3358         my $row = $self->dbh_selectrow_hashref($query);
3359
3360         if ($row) {
3361             $arg->{client} = $row->{name};
3362             CGI::param('client', $arg->{client});
3363         }
3364     }
3365
3366     if ($arg->{client}) {
3367         my $cli = new Bweb::Client(name => $arg->{client});
3368         $cli->display_running_job($self->{info}, $arg->{jobid});
3369         if ($arg->{jobid}) {
3370             $self->get_job_log();
3371         }
3372     } else {
3373         $self->error("Can't get client or jobid");
3374     }
3375 }
3376
3377 sub display_running_jobs
3378 {
3379     my ($self, $display_action) = @_;
3380     $self->can_do('r_view_running_job');
3381
3382     # get security filter
3383     my $filter = $self->get_client_filter();
3384
3385     my $query = "
3386 SELECT Job.JobId AS jobid,
3387        Job.Name  AS jobname,
3388        Job.Level     AS level,
3389        Job.StartTime AS starttime,
3390        Job.JobFiles  AS jobfiles,
3391        Job.JobBytes  AS jobbytes,
3392        Job.JobStatus AS jobstatus,
3393 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3394                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3395          AS duration,
3396        Client.Name AS clientname
3397 FROM Job INNER JOIN Client USING (ClientId) $filter
3398 WHERE
3399   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3400 ";
3401     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3402
3403     $self->display({ ID => $cur_id++,
3404                      display_action => $display_action,
3405                      Jobs => [ values %$all ]},
3406                    "running_job.tpl") ;
3407 }
3408
3409 # return the autochanger list to update
3410 sub eject_media
3411 {
3412     my ($self) = @_;
3413     $self->can_do('r_media_mgnt');
3414
3415     my %ret;
3416     my $arg = $self->get_form('jmedias');
3417
3418     unless ($arg->{jmedias}) {
3419         return $self->error("Can't get media selection");
3420     }
3421
3422     my $query = "
3423 SELECT Media.VolumeName  AS volumename,
3424        Storage.Name      AS storage,
3425        Location.Location AS location,
3426        Media.Slot        AS slot
3427 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
3428            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3429 WHERE Media.VolumeName IN ($arg->{jmedias})
3430   AND Media.InChanger = 1
3431 ";
3432
3433     my $all = $self->dbh_selectall_hashref($query, 'volumename');
3434
3435     foreach my $vol (values %$all) {
3436         my $a = $self->ach_get($vol->{location});
3437         next unless ($a) ;
3438         $ret{$vol->{location}} = 1;
3439
3440         unless ($a->{have_status}) {
3441             $a->status();
3442             $a->{have_status} = 1;
3443         }
3444         # TODO: set enabled
3445         print "eject $vol->{volumename} from $vol->{storage} : ";
3446         if ($a->send_to_io($vol->{slot})) {
3447             print "<img src='/bweb/T.png' alt='ok'><br/>";
3448         } else {
3449             print "<img src='/bweb/E.png' alt='err'><br/>";
3450         }
3451     }
3452     return keys %ret;
3453 }
3454
3455 sub move_email
3456 {
3457     my ($self) = @_;
3458
3459     my ($to, $subject, $content) = (CGI::param('email'),
3460                                     CGI::param('subject'),
3461                                     CGI::param('content'));
3462     $to =~ s/[^\w\d\.\@<>,]//;
3463     $subject =~ s/[^\w\d\.\[\]]/ /;
3464
3465     open(MAIL, "|mail -s '$subject' '$to'") ;
3466     print MAIL $content;
3467     close(MAIL);
3468
3469     print "Mail sent";
3470 }
3471
3472 sub restore
3473 {
3474     my ($self) = @_;
3475
3476     my $arg = $self->get_form('jobid', 'client');
3477
3478     print CGI::header('text/brestore');
3479     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3480     print "client=$arg->{client}\n" if ($arg->{client});
3481     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3482     print "\n";
3483 }
3484
3485 # TODO : move this to Bweb::Autochanger ?
3486 # TODO : make this internal to not eject tape ?
3487 use Bconsole;
3488
3489
3490 sub ach_get
3491 {
3492     my ($self, $name) = @_;
3493
3494     unless ($name) {
3495         return $self->error("Can't get your autochanger name ach");
3496     }
3497
3498     unless ($self->{info}->{ach_list}) {
3499         return $self->error("Could not find any autochanger");
3500     }
3501
3502     my $a = $self->{info}->{ach_list}->{$name};
3503
3504     unless ($a) {
3505         $self->error("Can't get your autochanger $name from your ach_list");
3506         return undef;
3507     }
3508
3509     $a->{bweb}  = $self;
3510     $a->{debug} = $self->{debug};
3511
3512     return $a;
3513 }
3514
3515 sub ach_register
3516 {
3517     my ($self, $ach) = @_;
3518     $self->can_do('r_configure');
3519
3520     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3521
3522     $self->{info}->save();
3523
3524     return 1;
3525 }
3526
3527 sub ach_edit
3528 {
3529     my ($self) = @_;
3530     $self->can_do('r_configure');
3531
3532     my $arg = $self->get_form('ach');
3533     if (!$arg->{ach}
3534         or !$self->{info}->{ach_list}
3535         or !$self->{info}->{ach_list}->{$arg->{ach}})
3536     {
3537         return $self->error("Can't get autochanger name");
3538     }
3539
3540     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3541
3542     my $i=0;
3543     $ach->{drives} =
3544         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3545
3546     my $b = $self->get_bconsole();
3547
3548     my @storages = $b->list_storage() ;
3549
3550     $ach->{devices} = [ map { { name => $_ } } @storages ];
3551
3552     $self->display($ach, "ach_add.tpl");
3553     delete $ach->{drives};
3554     delete $ach->{devices};
3555     return 1;
3556 }
3557
3558 sub ach_del
3559 {
3560     my ($self) = @_;
3561     $self->can_do('r_configure');
3562
3563     my $arg = $self->get_form('ach');
3564
3565     if (!$arg->{ach}
3566         or !$self->{info}->{ach_list}
3567         or !$self->{info}->{ach_list}->{$arg->{ach}})
3568     {
3569         return $self->error("Can't get autochanger name");
3570     }
3571
3572     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3573
3574     $self->{info}->save();
3575     $self->{info}->view();
3576 }
3577
3578 sub ach_add
3579 {
3580     my ($self) = @_;
3581     $self->can_do('r_configure');
3582
3583     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3584
3585     my $b = $self->get_bconsole();
3586     my @storages = $b->list_storage() ;
3587
3588     unless ($arg->{ach}) {
3589         $arg->{devices} = [ map { { name => $_ } } @storages ];
3590         return $self->display($arg, "ach_add.tpl");
3591     }
3592
3593     my @drives ;
3594     foreach my $drive (CGI::param('drives'))
3595     {
3596         unless (grep(/^$drive$/,@storages)) {
3597             return $self->error("Can't find $drive in storage list");
3598         }
3599
3600         my $index = CGI::param("index_$drive");
3601         unless (defined $index and $index =~ /^(\d+)$/) {
3602             return $self->error("Can't get $drive index");
3603         }
3604
3605         $drives[$index] = $drive;
3606     }
3607
3608     unless (@drives) {
3609         return $self->error("Can't get drives from Autochanger");
3610     }
3611
3612     my $a = new Bweb::Autochanger(name   => $arg->{ach},
3613                                   precmd => $arg->{precmd},
3614                                   drive_name => \@drives,
3615                                   device => $arg->{device},
3616                                   mtxcmd => $arg->{mtxcmd});
3617
3618     $self->ach_register($a) ;
3619
3620     $self->{info}->view();
3621 }
3622
3623 sub delete
3624 {
3625     my ($self) = @_;
3626     $self->can_do('r_delete_job');
3627
3628     my $arg = $self->get_form('jobid');
3629
3630     if ($arg->{jobid}) {
3631         my $b = $self->get_bconsole();
3632         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3633
3634         $self->display({
3635             content => $ret,
3636             title => "Delete a job ",
3637             name => "delete jobid=$arg->{jobid}",
3638         }, "command.tpl");
3639     }
3640 }
3641
3642 sub do_update_media
3643 {
3644     my ($self) = @_ ;
3645     $self->can_do('r_media_mgnt');
3646
3647     my $arg = $self->get_form(qw/media volstatus inchanger pool
3648                                  slot volretention voluseduration
3649                                  maxvoljobs maxvolfiles maxvolbytes
3650                                  qcomment poolrecycle enabled
3651                               /);
3652
3653     unless ($arg->{media}) {
3654         return $self->error("Can't find media selection");
3655     }
3656
3657     my $update = "update volume=$arg->{media} ";
3658
3659     if ($arg->{volstatus}) {
3660         $update .= " volstatus=$arg->{volstatus} ";
3661     }
3662
3663     if ($arg->{inchanger}) {
3664         $update .= " inchanger=yes " ;
3665         if ($arg->{slot}) {
3666             $update .= " slot=$arg->{slot} ";
3667         }
3668     } else {
3669         $update .= " slot=0 inchanger=no ";
3670     }
3671
3672     if ($arg->{enabled}) {
3673         $update .= " enabled=$arg->{enabled} ";
3674     }
3675
3676     if ($arg->{pool}) {
3677         $update .= " pool=$arg->{pool} " ;
3678     }
3679
3680     if (defined $arg->{volretention}) {
3681         $update .= " volretention=\"$arg->{volretention}\" " ;
3682     }
3683
3684     if (defined $arg->{voluseduration}) {
3685         $update .= " voluse=\"$arg->{voluseduration}\" " ;
3686     }
3687
3688     if (defined $arg->{maxvoljobs}) {
3689         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3690     }
3691
3692     if (defined $arg->{maxvolfiles}) {
3693         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3694     }
3695
3696     if (defined $arg->{maxvolbytes}) {
3697         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3698     }
3699
3700     if (defined $arg->{poolrecycle}) {
3701         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3702     }
3703
3704     my $b = $self->get_bconsole();
3705
3706     $self->display({
3707         content => $b->send_cmd($update),
3708         title => "Update a volume ",
3709         name => $update,
3710     }, "command.tpl");
3711
3712
3713     my @q;
3714     my $media = $self->dbh_quote($arg->{media});
3715
3716     my $loc = CGI::param('location') || '';
3717     if ($loc) {
3718         $loc = $self->dbh_quote($loc); # is checked by db
3719         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3720     }
3721     if (!$arg->{qcomment}) {
3722         $arg->{qcomment} = "''";
3723     }
3724     push @q, "Comment=$arg->{qcomment}";
3725
3726
3727     my $query = "
3728 UPDATE Media
3729    SET " . join (',', @q) . "
3730  WHERE Media.VolumeName = $media
3731 ";
3732     $self->dbh_do($query);
3733
3734     $self->update_media();
3735 }
3736
3737 sub update_slots
3738 {
3739     my ($self) = @_;
3740     $self->can_do('r_autochanger_mgnt');
3741
3742     my $ach = CGI::param('ach') ;
3743     $ach = $self->ach_get($ach);
3744     unless ($ach) {
3745         return $self->error("Bad autochanger name");
3746     }
3747
3748     print "<pre>";
3749     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3750     $b->update_slots($ach->{name});
3751     print "</pre>\n"
3752 }
3753
3754 sub get_job_log
3755 {
3756     my ($self) = @_;
3757     $self->can_do('r_view_log');
3758
3759     my $arg = $self->get_form('jobid', 'limit', 'offset');
3760     unless ($arg->{jobid}) {
3761         return $self->error("Can't get jobid");
3762     }
3763
3764     if ($arg->{limit} == 100) {
3765         $arg->{limit} = 1000;
3766     }
3767     # get security filter
3768     my $filter = $self->get_client_filter();
3769
3770     my $query = "
3771 SELECT Job.Name as name, Client.Name as clientname
3772  FROM  Job INNER JOIN Client USING (ClientId) $filter
3773  WHERE JobId = $arg->{jobid}
3774 ";
3775
3776     my $row = $self->dbh_selectrow_hashref($query);
3777
3778     unless ($row) {
3779         return $self->error("Can't find $arg->{jobid} in catalog");
3780     }
3781
3782     # display only Error and Warning messages
3783     $filter = '';
3784     if (CGI::param('error')) {
3785         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning' ";
3786     }
3787
3788     my $logtext;
3789     if (CGI::param('time') || $self->{info}->{display_log_time}) {
3790         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
3791     } else {
3792         $logtext = 'LogText';
3793     }
3794
3795     $query = "
3796 SELECT count(1) AS nbline, JobId AS jobid,
3797        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
3798   FROM  (
3799     SELECT JobId, Time, LogText
3800     FROM Log
3801    WHERE ( Log.JobId = $arg->{jobid}
3802       OR (Log.JobId = 0
3803           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3804           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3805        ) ) $filter
3806  ORDER BY LogId
3807  LIMIT $arg->{limit}
3808  OFFSET $arg->{offset}
3809  ) AS temp
3810  GROUP BY JobId
3811
3812 ";
3813
3814     my $log = $self->dbh_selectrow_hashref($query);
3815     unless ($log) {
3816         return $self->error("Can't get log for jobid $arg->{jobid}");
3817     }
3818
3819     $self->display({ lines=> $log->{logtxt},
3820                      nbline => $log->{nbline},
3821                      jobid => $arg->{jobid},
3822                      name  => $row->{name},
3823                      client => $row->{clientname},
3824                      offset => $arg->{offset},
3825                      limit  => $arg->{limit},
3826                  }, 'display_log.tpl');
3827 }
3828
3829 sub label_barcodes
3830 {
3831     my ($self) = @_ ;
3832     $self->can_do('r_autochanger_mgnt');
3833
3834     my $arg = $self->get_form('ach', 'slots', 'drive');
3835
3836     unless ($arg->{ach}) {
3837         return $self->error("Can't find autochanger name");
3838     }
3839
3840     my $a = $self->ach_get($arg->{ach});
3841     unless ($a) {
3842         return $self->error("Can't find autochanger name in configuration");
3843     }
3844
3845     my $storage = $a->get_drive_name($arg->{drive});
3846     unless ($storage) {
3847         return $self->error("Can't get your drive name");
3848     }
3849
3850     my $slots = '';
3851     my $slots_sql = '';
3852     my $t = 300 ;
3853     if ($arg->{slots}) {
3854         $slots = join(",", @{ $arg->{slots} });
3855         $slots_sql = " AND Slot IN ($slots) ";
3856         $t += 60*scalar( @{ $arg->{slots} }) ;
3857     }
3858
3859     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3860     print "<h1>This command can take long time, be patient...</h1>";
3861     print "<pre>" ;
3862     $b->label_barcodes(storage => $storage,
3863                        drive => $arg->{drive},
3864                        pool  => 'Scratch',
3865                        slots => $slots) ;
3866     $b->close();
3867     print "</pre>";
3868
3869     $self->dbh_do("
3870   UPDATE Media
3871        SET LocationId =   (SELECT LocationId
3872                              FROM Location
3873                             WHERE Location = '$arg->{ach}')
3874
3875      WHERE (LocationId = 0 OR LocationId IS NULL)
3876        $slots_sql
3877 ");
3878
3879 }
3880
3881 sub purge
3882 {
3883     my ($self) = @_;
3884     $self->can_do('r_purge');
3885
3886     my @volume = CGI::param('media');
3887
3888     unless (@volume) {
3889         return $self->error("Can't get media selection");
3890     }
3891
3892     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3893
3894     foreach my $v (@volume) {
3895         $self->display({
3896             content => $b->purge_volume($v),
3897             title => "Purge media",
3898             name => "purge volume=$v",
3899         }, "command.tpl");
3900     }
3901     $b->close();
3902 }
3903
3904 sub prune
3905 {
3906     my ($self) = @_;
3907     $self->can_do('r_prune');
3908
3909     my @volume = CGI::param('media');
3910     unless (@volume) {
3911         return $self->error("Can't get media selection");
3912     }
3913
3914     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3915
3916     foreach my $v (@volume) {
3917         $self->display({
3918             content => $b->prune_volume($v),
3919             title => "Prune volume",
3920             name => "prune volume=$v",
3921         }, "command.tpl");
3922     }
3923     $b->close();
3924 }
3925
3926 sub cancel_job
3927 {
3928     my ($self) = @_;
3929     $self->can_do('r_cancel_job');
3930
3931     my $arg = $self->get_form('jobid');
3932     unless ($arg->{jobid}) {
3933         return $self->error("Can't get jobid");
3934     }
3935
3936     my $b = $self->get_bconsole();
3937     $self->display({
3938         content => $b->cancel($arg->{jobid}),
3939         title => "Cancel job",
3940         name => "cancel jobid=$arg->{jobid}",
3941     }, "command.tpl");
3942 }
3943
3944 sub fileset_view
3945 {
3946     # Warning, we display current fileset
3947     my ($self) = @_;
3948
3949     my $arg = $self->get_form('fileset');
3950
3951     if ($arg->{fileset}) {
3952         my $b = $self->get_bconsole();
3953         my $ret = $b->get_fileset($arg->{fileset});
3954         $self->display({ fileset => $arg->{fileset},
3955                          %$ret,
3956                      }, "fileset_view.tpl");
3957     } else {
3958         $self->error("Can't get fileset name");
3959     }
3960 }
3961
3962 sub director_show_sched
3963 {
3964     my ($self) = @_ ;
3965
3966     my $arg = $self->get_form('days');
3967
3968     my $b = $self->get_bconsole();
3969     my $ret = $b->director_get_sched( $arg->{days} );
3970
3971     $self->display({
3972         id => $cur_id++,
3973         list => $ret,
3974     }, "scheduled_job.tpl");
3975 }
3976
3977 sub enable_disable_job
3978 {
3979     my ($self, $what) = @_ ;
3980     $self->can_do('r_run_job');
3981
3982     my $name = CGI::param('job') || '';
3983     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3984         return $self->error("Can't find job name");
3985     }
3986
3987     my $b = $self->get_bconsole();
3988
3989     my $cmd;
3990     if ($what) {
3991         $cmd = "enable";
3992     } else {
3993         $cmd = "disable";
3994     }
3995
3996     $self->display({
3997         content => $b->send_cmd("$cmd job=\"$name\""),
3998         title => "$cmd $name",
3999         name => "$cmd job=\"$name\"",
4000     }, "command.tpl");
4001 }
4002
4003 sub get_bconsole
4004 {
4005     my ($self) = @_;
4006     return new Bconsole(pref => $self->{info});
4007 }
4008
4009 sub run_job_select
4010 {
4011     my ($self) = @_;
4012     $self->can_do('r_run_job');
4013
4014     my $b = $self->get_bconsole();
4015
4016     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4017
4018     $self->display({ Jobs => $joblist }, "run_job.tpl");
4019 }
4020
4021 sub run_parse_job
4022 {
4023     my ($self, $ouput) = @_;
4024
4025     my %arg;
4026     foreach my $l (split(/\r\n/, $ouput)) {
4027         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4028             $arg{$1} = $2;
4029             $l = $3
4030                 if ($3) ;
4031         }
4032
4033         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4034             %arg = (%arg, @l);
4035         }
4036     }
4037
4038     my %lowcase ;
4039     foreach my $k (keys %arg) {
4040         $lowcase{lc($k)} = $arg{$k} ;
4041     }
4042
4043     return \%lowcase;
4044 }
4045
4046 sub run_job_mod
4047 {
4048     my ($self) = @_;
4049     $self->can_do('r_run_job');
4050
4051     my $b = $self->get_bconsole();
4052
4053     my $job = CGI::param('job') || '';
4054
4055     # we take informations from director, and we overwrite with user wish
4056     my $info = $b->send_cmd("show job=\"$job\"");
4057     my $attr = $self->run_parse_job($info);
4058
4059     my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
4060     my %job_opt = (%$attr, %$arg);
4061
4062     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4063
4064     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4065     my $clients = [ map { { name => $_ } }$b->list_client()];
4066     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4067     my $storages= [ map { { name => $_ } }$b->list_storage()];
4068
4069     $self->display({
4070         jobs     => $jobs,
4071         pools    => $pools,
4072         clients  => $clients,
4073         filesets => $filesets,
4074         storages => $storages,
4075         %job_opt,
4076     }, "run_job_mod.tpl");
4077 }
4078
4079 sub run_job
4080 {
4081     my ($self) = @_;
4082     $self->can_do('r_run_job');
4083
4084     my $b = $self->get_bconsole();
4085
4086     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4087
4088     $self->display({
4089         jobs     => $jobs,
4090     }, "run_job.tpl");
4091 }
4092
4093 sub run_job_now
4094 {
4095     my ($self) = @_;
4096     $self->can_do('r_run_job');
4097
4098     my $b = $self->get_bconsole();
4099
4100     # TODO: check input (don't use pool, level)
4101
4102     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4103     my $job = CGI::param('job') || '';
4104     my $storage = CGI::param('storage') || '';
4105
4106     my $jobid = $b->run(job => $job,
4107                         client => $arg->{client},
4108                         priority => $arg->{priority},
4109                         level => $arg->{level},
4110                         storage => $storage,
4111                         pool => $arg->{pool},
4112                         fileset => $arg->{fileset},
4113                         when => $arg->{when},
4114                         );
4115
4116     print $jobid, $b->{error};
4117
4118     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
4119 }
4120
4121 1;