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