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