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

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