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

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