1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2006-2010 Free Software Foundation Europe e.V.
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 This program is Free Software; you can redistribute it and/or
15 modify it under the terms of version three of the GNU Affero General Public
16 License as published by the Free Software Foundation and included
19 This program is distributed in the hope that it will be useful, but
20 WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 Affero General Public License for more details.
24 You should have received a copy of the GNU Affero General Public License
25 along with this program; if not, write to the Free Software
26 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 Bacula® is a registered trademark of Kern Sibbald.
30 The licensor of Bacula is the Free Software Foundation Europe
31 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
32 Switzerland, email:ftf@fsfeurope.org.
40 Bweb::Gui - Base package for all Bweb object
44 This package define base fonction like new, display, etc..
49 our $template_dir='/usr/share/bweb/tpl';
53 new - creation a of new Bweb object
57 This function take an hash of argument and place them
60 IE : $obj = new Obj(name => 'test', age => '10');
62 $obj->{name} eq 'test' and $obj->{age} eq 10
68 my ($class, %arg) = @_;
73 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
80 my ($self, $what) = @_;
84 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
86 print "<pre>$what</pre>";
93 my ($self, $what) = @_;
95 my $old = $self->{debug};
98 $self->{debug} = $old;
103 error - display an error to the user
107 this function set $self->{error} with arg, display a message with
108 error.tpl and return 0
113 return $self->error("Can't use this file");
120 my ($self, $what) = @_;
121 $self->{error} = $what;
122 $self->display($self, 'error.tpl');
128 display - display an html page with HTML::Template
132 this function is use to render all html codes. it takes an
133 ref hash as arg in which all param are usable in template.
135 it will use user template_dir then global template_dir
136 to search the template file.
138 hash keys are not sensitive. See HTML::Template for more
139 explanations about the hash ref. (it's can be quiet hard to understand)
143 $ref = { name => 'me', age => 26 };
144 $self->display($ref, "people.tpl");
150 my ($self, $hash, $tpl) = @_ ;
151 my $dir = $self->{template_dir} || $template_dir;
152 my $lang = $self->{lang} || 'en';
153 my $template = HTML::Template->new(filename => $tpl,
154 path =>["$dir/$lang",
157 die_on_bad_params => 0,
158 case_sensitive => 0);
160 foreach my $var (qw/limit offset/) {
162 unless ($hash->{$var}) {
163 my $value = CGI::param($var) || '';
165 if ($value =~ /^(\d+)$/) {
166 $template->param($var, $1) ;
171 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
172 $template->param('loginname', CGI::remote_user());
174 $template->param($hash);
175 print $template->output();
179 ################################################################
181 package Bweb::Config;
183 use base q/Bweb::Gui/;
187 Bweb::Config - read, write, display, modify configuration
191 this package is used for manage configuration
195 $conf = new Bweb::Config(config_file => '/path/to/conf');
206 =head1 PACKAGE VARIABLE
208 %k_re - hash of all acceptable option.
212 this variable permit to check all option with a regexp.
216 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
217 user => qr/^([\w\d\.-]+)$/i,
218 password => qr/^(.*)$/,
219 fv_write_path => qr!^([/\w\d\.-]*)$!,
220 template_dir => qr!^([/\w\d\.-]+)$!,
221 debug => qr/^(on)?$/,
222 lang => qr/^(\w\w)?$/,
223 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
224 graph_font => qr!^([/\w\d\.-]+.ttf)?$!,
225 bconsole => qr!^(.+)?$!,
226 syslog_file => qr!^(.+)?$!,
227 log_dir => qr!^(.+)?$!,
228 wiki_url => qr!(.*)$!,
229 stat_job_table => qr!^(\w*)$!,
230 display_log_time => qr!^(on)?$!,
231 enable_security => qr/^(on)?$/,
232 enable_security_acl => qr/^(on)?$/,
233 default_age => qr/^((?:\d+(?:[ywdhms]\s*?)?)+)\s*$/,
238 load - load config_file
242 this function load the specified config_file.
250 unless (open(FP, $self->{config_file}))
252 return $self->error("can't load config_file $self->{config_file} : $!");
254 my $f=''; my $tmpbuffer;
255 while(read FP,$tmpbuffer,4096)
263 no strict; # I have no idea of the contents of the file
270 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 $self->{default_age} = '7d';
276 foreach my $k (keys %$VAR1) {
277 $self->{$k} = $VAR1->{$k};
285 load_old - load old configuration format
293 unless (open(FP, $self->{config_file}))
295 return $self->error("$self->{config_file} : $!");
298 while (my $line = <FP>)
301 my ($k, $v) = split(/\s*=\s*/, $line, 2);
313 save - save the current configuration to config_file
321 if ($self->{ach_list}) {
322 # shortcut for display_begin
323 $self->{achs} = [ map {{ name => $_ }}
324 keys %{$self->{ach_list}}
328 unless (open(FP, ">$self->{config_file}"))
330 return $self->error("$self->{config_file} : $!\n" .
331 "You must add this to your config file\n"
332 . Data::Dumper::Dumper($self));
335 print FP Data::Dumper::Dumper($self);
343 edit, view, modify - html form ouput
351 $self->display($self, "config_edit.tpl");
357 $self->display($self, "config_view.tpl");
365 # we need to reset checkbox first
367 $self->{display_log_time} = 0;
368 $self->{enable_security} = 0;
369 $self->{enable_security_acl} = 0;
371 foreach my $k (CGI::param())
373 next unless (exists $k_re{$k}) ;
374 my $val = CGI::param($k);
375 if ($val =~ $k_re{$k}) {
378 $self->{error} .= "bad parameter : $k = [$val]";
384 if ($self->{error}) { # an error as occured
385 $self->display($self, 'error.tpl');
393 ################################################################
395 package Bweb::Client;
397 use base q/Bweb::Gui/;
401 Bweb::Client - Bacula FD
405 this package is use to do all Client operations like, parse status etc...
409 $client = new Bweb::Client(name => 'zog-fd');
410 $client->status(); # do a 'status client=zog-fd'
416 display_running_job - Html display of a running job
420 this function is used to display information about a current job
424 sub display_running_job
426 my ($self, $bweb, $jobid, $infos) = @_ ;
427 my $status = $self->status($bweb->{info});
430 if ($status->{$jobid}) {
431 $status = $status->{$jobid};
432 $status->{last_jobbytes} = $infos->{jobbytes};
433 $status->{last_jobfiles} = $infos->{jobfiles};
434 $status->{corr_jobbytes} = $infos->{corr_jobbytes};
435 $status->{corr_jobfiles} = $infos->{corr_jobfiles};
436 $status->{jobbytes}=$status->{Bytes};
437 $status->{jobbytes} =~ s![^\d]!!g;
438 $status->{jobfiles}=$status->{'Files Examined'};
439 $status->{jobfiles} =~ s/,//g;
440 $bweb->display($status, "client_job_status.tpl");
443 for my $id (keys %$status) {
444 $bweb->display($status->{$id}, "client_job_status.tpl");
451 $client = new Bweb::Client(name => 'plume-fd');
453 $client->status($bweb);
457 dirty hack to parse "status client=xxx-fd"
461 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
462 Backup Job started: 06-jun-06 17:22
463 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
464 Files Examined=10,697
465 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
471 JobName => Full_plume.2006-06-06_17.22.23,
474 Bytes => 194,484,132,
484 my ($self, $conf) = @_ ;
486 if (defined $self->{cur_jobs}) {
487 return $self->{cur_jobs} ;
491 my $b = new Bconsole(pref => $conf);
492 my $ret = $b->send_cmd("st client=$self->{name}");
496 for my $r (split(/\n/, $ret)) {
498 $r =~ s/(^\s+|\s+$)//g;
499 if ($r =~ /JobId (\d+) Job (\S+)/) {
501 $arg->{$jobid} = { @param, JobId => $jobid } ;
505 @param = ( JobName => $2 );
507 } elsif ($r =~ /=.+=/) {
508 push @param, split(/\s+|\s*=\s*/, $r) ;
510 } elsif ($r =~ /=/) { # one per line
511 push @param, split(/\s*=\s*/, $r) ;
513 } elsif ($r =~ /:/) { # one per line
514 push @param, split(/\s*:\s*/, $r, 2) ;
518 if ($jobid and @param) {
519 $arg->{$jobid} = { @param,
521 Client => $self->{name},
525 $self->{cur_jobs} = $arg ;
531 ################################################################
533 package Bweb::Autochanger;
535 use base q/Bweb::Gui/;
539 Bweb::Autochanger - Object to manage Autochanger
543 this package will parse the mtx output and manage drives.
547 $auto = new Bweb::Autochanger(precmd => 'sudo');
549 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
553 $auto->slot_is_full(10);
554 $auto->transfer(10, 11);
560 my ($class, %arg) = @_;
563 name => '', # autochanger name
564 label => {}, # where are volume { label1 => 40, label2 => drive0 }
565 drive => [], # drive use [ 'media1', 'empty', ..]
566 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
567 io => [], # io slot number list [ 41, 42, 43...]
568 info => {slot => 0, # informations (slot, drive, io)
572 mtxcmd => '/usr/sbin/mtx',
574 device => '/dev/changer',
575 precmd => '', # ssh command
576 bweb => undef, # link to bacula web object (use for display)
579 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
586 status - parse the output of mtx status
590 this function will launch mtx status and parse the output. it will
591 give a perlish view of the autochanger content.
593 it uses ssh if the autochanger is on a other host.
600 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
602 # TODO : reset all infos
603 $self->{info}->{drive} = 0;
604 $self->{info}->{slot} = 0;
605 $self->{info}->{io} = 0;
607 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
610 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
611 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
612 #Data Transfer Element 1:Empty
613 # Storage Element 1:Empty
614 # Storage Element 2:Full :VolumeTag=000002
615 # Storage Element 3:Empty
616 # Storage Element 4:Full :VolumeTag=000004
617 # Storage Element 5:Full :VolumeTag=000001
618 # Storage Element 6:Full :VolumeTag=000003
619 # Storage Element 7:Empty
620 # Storage Element 41 IMPORT/EXPORT:Empty
621 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
626 # Storage Element 7:Empty
627 # Storage Element 2:Full :VolumeTag=000002
628 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d.-]+))?/){
631 $self->set_empty_slot($1);
633 $self->set_slot($1, $4);
636 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d.-]+))?)?/) {
639 $self->set_empty_drive($1);
641 $self->set_drive($1, $4, $6);
644 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w.-]+))?/)
647 $self->set_empty_io($1);
649 $self->set_io($1, $4);
652 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
654 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
655 $self->{info}->{drive} = $1;
656 $self->{info}->{slot} = $2;
657 if ($l =~ /(\d+)\s+Import/) {
658 $self->{info}->{io} = $1 ;
660 $self->{info}->{io} = 0;
665 $self->debug($self) ;
670 my ($self, $slot) = @_;
673 if ($self->{slot}->[$slot] eq 'loaded') {
677 my $label = $self->{slot}->[$slot] ;
679 return $self->is_media_loaded($label);
684 my ($self, $drive, $slot) = @_;
686 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
687 return 0 if ($self->slot_is_full($slot)) ;
689 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
692 my $content = $self->get_slot($slot);
693 print "content = $content<br/> $drive => $slot<br/>";
694 $self->set_empty_drive($drive);
695 $self->set_slot($slot, $content);
698 $self->{error} = $out;
703 # TODO: load/unload have to use mtx script from bacula
706 my ($self, $drive, $slot) = @_;
708 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
709 return 0 unless ($self->slot_is_full($slot)) ;
711 print "Loading drive $drive with slot $slot<br/>\n";
712 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
715 my $content = $self->get_slot($slot);
716 print "content = $content<br/> $slot => $drive<br/>";
717 $self->set_drive($drive, $slot, $content);
720 $self->{error} = $out;
728 my ($self, $media) = @_;
730 unless ($self->{label}->{$media}) {
734 if ($self->{label}->{$media} =~ /drive\d+/) {
744 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
749 my ($self, $slot, $tag) = @_;
750 $self->{slot}->[$slot] = $tag || 'full';
751 push @{ $self->{io} }, $slot;
754 $self->{label}->{$tag} = $slot;
760 my ($self, $slot) = @_;
762 push @{ $self->{io} }, $slot;
764 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
765 $self->{slot}->[$slot] = 'empty';
771 my ($self, $slot) = @_;
772 return $self->{slot}->[$slot];
777 my ($self, $slot, $tag) = @_;
778 $self->{slot}->[$slot] = $tag || 'full';
781 $self->{label}->{$tag} = $slot;
787 my ($self, $slot) = @_;
789 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
790 $self->{slot}->[$slot] = 'empty';
796 my ($self, $drive) = @_;
797 $self->{drive}->[$drive] = 'empty';
802 my ($self, $drive, $slot, $tag) = @_;
803 $self->{drive}->[$drive] = $tag || $slot;
804 $self->{drive_slot}->[$drive] = $slot;
806 $self->{slot}->[$slot] = $tag || 'loaded';
809 $self->{label}->{$tag} = "drive$drive";
815 my ($self, $slot) = @_;
817 # slot don't exists => full
818 if (not defined $self->{slot}->[$slot]) {
822 if ($self->{slot}->[$slot] eq 'empty') {
825 return 1; # vol, full, loaded
828 sub slot_get_first_free
831 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
832 return $slot unless ($self->slot_is_full($slot));
836 sub io_get_first_free
840 foreach my $slot (@{ $self->{io} }) {
841 return $slot unless ($self->slot_is_full($slot));
848 my ($self, $media) = @_;
850 return $self->{label}->{$media} ;
855 my ($self, $media) = @_;
857 return defined $self->{label}->{$media} ;
862 my ($self, $slot) = @_;
864 unless ($self->slot_is_full($slot)) {
865 print "Autochanger $self->{name} slot $slot is empty<br>\n";
870 if ($self->is_slot_loaded($slot)) {
873 print "Autochanger $self->{name} $slot is currently in use<br>\n";
877 # autochanger must have I/O
878 unless ($self->have_io()) {
879 print "Autochanger $self->{name} don't have I/O, you can take media yourself<br>\n";
883 my $dst = $self->io_get_first_free();
886 print "Autochanger $self->{name} mailbox is full, you must empty I/O first<br>\n";
890 $self->transfer($slot, $dst);
895 my ($self, $src, $dst) = @_ ;
896 if ($self->{debug}) {
897 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
899 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
902 my $content = $self->get_slot($src);
903 $self->{slot}->[$src] = 'empty';
904 $self->set_slot($dst, $content);
907 $self->{error} = $out;
914 my ($self, $index) = @_;
915 return $self->{drive_name}->[$index];
918 # TODO : do a tapeinfo request to get informations
928 print "<table><tr>\n";
929 for my $slot (@{$self->{io}})
931 if ($self->is_slot_loaded($slot)) {
932 print "<td></td><td>Slot $slot is currently loaded</td></tr>\n";
936 if ($self->slot_is_full($slot))
938 my $free = $self->slot_get_first_free() ;
939 print "</tr><tr><td>move slot $slot to $free :</td>";
942 if ($self->transfer($slot, $free)) {
943 print "<td><img src='/bweb/T.png' alt='ok'></td>\n";
945 print "<td><img src='/bweb/E.png' alt='ok' title='$self->{error}'></td>\n";
949 $self->{error} = "<td><img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'></td>\n";
953 print "</tr></table>\n";
956 # TODO : this is with mtx status output,
957 # we can do an other function from bacula view (with StorageId)
961 my $bweb = $self->{bweb};
963 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
964 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
967 SELECT Media.VolumeName AS volumename,
968 Media.VolStatus AS volstatus,
969 Media.LastWritten AS lastwritten,
970 Media.VolBytes AS volbytes,
971 Media.MediaType AS mediatype,
973 Media.InChanger AS inchanger,
975 $bweb->{sql}->{FROM_UNIXTIME}(
976 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
977 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
980 INNER JOIN Pool USING (PoolId)
982 WHERE Media.VolumeName IN ($media_list)
985 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
987 # TODO : verify slot and bacula slot
991 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
993 if ($self->slot_is_full($slot)) {
995 my $vol = $self->{slot}->[$slot];
996 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
998 my $bslot = $all->{$vol}->{slot} ;
999 my $inchanger = $all->{$vol}->{inchanger};
1001 # if bacula slot or inchanger flag is bad, we display a message
1002 if ($bslot != $slot or !$inchanger) {
1003 push @to_update, $slot;
1006 $all->{$vol}->{realslot} = $slot;
1008 push @{ $param }, $all->{$vol};
1010 } else { # empty or no label
1011 push @{ $param }, {realslot => $slot,
1012 volstatus => 'Unknown',
1013 volumename => $self->{slot}->[$slot]} ;
1016 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
1020 my $i=0; my $drives = [] ;
1021 foreach my $d (@{ $self->{drive} }) {
1022 $drives->[$i] = { index => $i,
1023 load => $self->{drive}->[$i],
1024 name => $self->{drive_name}->[$i],
1029 $bweb->display({ Name => $self->{name},
1030 nb_drive => $self->{info}->{drive},
1031 nb_io => $self->{info}->{io},
1034 Update => scalar(@to_update) },
1041 ################################################################
1043 package Bweb::Sched;
1044 use base q/Bweb::Gui/;
1048 Bweb::Sched() - Bweb package that parse show schedule ouput
1050 new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1054 my $b = $bweb->get_bconsole();
1055 my $s = $b->send_cmd("show schedule");
1056 my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1057 $sched->parse_scheds(split(/\r?\n/, $s));
1068 'level' => 'Differential',
1075 my ($class, @arg) = @_;
1076 my $self = $class->SUPER::new(@arg);
1078 # we compare the current schedule date with begin and end
1079 # in a float form ex: 20071212.1243 > 20070101
1080 if ($self->{begin} and $self->{end}) {
1081 ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1082 $self->{fbegin} =~ s/(-|:)//g; $self->{fbegin} =~ s/ /./;
1083 $self->{fend} =~ s/(-|:)//g; $self->{fend} =~ s/ /./;
1086 bless($self,$class);
1088 if ($self->{bconsole}) {
1089 my $sel = $self->{name}?"=\"$self->{name}\"":'';
1090 my $b = $self->{bconsole};
1091 my $out = $b->send_cmd("show schedule$sel");
1092 $self->parse_scheds(split(/\r?\n/, $out));
1093 undef $self->{bconsole}; # useless now
1099 # cleanup and add a schedule
1102 my ($self, $name, $info) = @_;
1103 # bacula uses dates that start from 0, we start from 1
1104 foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1107 $info->{event} = [ $self->get_events($info, $self->{format}) ];
1109 foreach my $i (qw/hour mday month wday wom woy mins/) {
1113 push @{$self->{schedules}->{$name}}, $info;
1116 # return the name of all schedules
1119 my ($self, $name) = @_;
1121 return keys %{ $self->{schedules} };
1124 # return an array of all schedule
1127 my ($self, $sched) = @_;
1128 return $self->{schedules}->{$sched};
1131 # return an ref array of all events
1132 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1135 my ($self, $sched) = @_;
1136 return $sched->{event};
1139 # return the pool name
1142 my ($self, $sched) = @_;
1143 return $sched->{pool} || '';
1146 # return the level name (Incremental, Differential, Full)
1149 my ($self, $sched) = @_;
1150 return $sched->{level};
1153 # parse bacula sched bitmap
1156 my ($self, @output) = @_;
1163 foreach my $ligne (@output) {
1164 if ($ligne =~ /Schedule: name=(.+)/) {
1165 if ($name and $elt) {
1166 $elt->{level} = $run;
1167 $self->add_sched($name, $elt);
1172 elsif ($ligne =~ /Run Level=(.+)/) {
1173 if ($name and $elt) {
1174 $elt->{level} = $run;
1175 $self->add_sched($name, $elt);
1180 elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1181 # All theses lines have the same format
1183 my ($k,$v) = ($1,$2);
1184 # we get all values (0 1 4 9)
1185 $elt->{$k}=[split (/\s/,$v)];
1187 # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1188 elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1189 my ($k,$v) = ($1,$2);
1190 foreach my $e (split (/\s/,$v)) {
1194 elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1199 if ($name and $elt) {
1200 $elt->{level} = $run;
1201 $self->add_sched($name, $elt);
1205 use Date::Calc qw(:all);
1207 # read bacula schedule bitmap and get $format date string
1211 my ($self, $s,$format) = @_;
1212 my $year = $self->{year} || ((localtime($Bweb::btime))[5] + 1900);
1213 $format = $format || '%u-%02u-%02u %02u:%02u';
1215 foreach my $m (@{$s->{month}}) # mois de l'annee
1217 foreach my $md (@{$s->{mday}}) # jour du mois
1219 # print " m=$m md=$md\n";
1220 # we check if this day exists (31 fev)
1221 next if (!check_date($year,$m,$md));
1222 # print " check_date ok\n";
1224 my $w = ($md-1)/7; # we use the same thing than bacula
1225 next if (! $s->{wom}->[$w]);
1226 # print " wom ok\n";
1228 # on recupere le jour de la semaine
1229 my $wd = Day_of_Week($year,$m,$md);
1231 my ($w1,undef) = Week_of_Year($year,$m,$wd);
1232 next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1233 # print " woy ok\n";
1235 $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1236 next if (! $s->{wday}->[$wd]);
1237 # print " wday ok\n";
1239 foreach my $h (@{$s->{hour}}) # hour of the day
1241 foreach my $min (@{$s->{mins}}) # minute
1243 if ($self->{fbegin}) {
1245 my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1246 $year,$m,$md,$h,$min);
1247 next if ($d < $self->{fbegin} or $d > $self->{fend});
1249 push @ret, sprintf($format, $year,$m,$md,$h,$min);
1258 ################################################################
1262 use base q/Bweb::Gui/;
1266 Bweb - main Bweb package
1270 this package is use to compute and display informations
1275 use POSIX qw/strftime/;
1277 our $config_file= '/etc/bacula/bweb.conf';
1279 if ($ENV{BWEBCONF} && -f $ENV{BWEBCONF}) {
1280 $config_file = $ENV{BWEBCONF};
1287 %sql_func - hash to make query mysql/postgresql compliant
1293 UNIX_TIMESTAMP => '',
1294 FROM_UNIXTIME => '',
1295 TO_SEC => " interval '1 second' * ",
1296 SEC_TO_INT => "SEC_TO_INT",
1299 STARTTIME_SEC => " date_trunc('sec', Job.StartTime) ",
1300 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1301 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1302 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1303 STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1304 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1305 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1306 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1307 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1308 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1309 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1312 #NOW => "TIMESTAMP '2010-07-15 00:00:00' "
1315 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1316 FROM_UNIXTIME => 'FROM_UNIXTIME',
1319 SEC_TO_TIME => 'SEC_TO_TIME',
1320 MATCH => " REGEXP ",
1321 STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1322 STARTTIME_DAY => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1323 STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1324 STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1325 STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1326 STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1327 STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1328 STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1329 STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1330 # with mysql < 5, you have to play with the ugly SHOW command
1331 #DB_SIZE => " SELECT 0 ",
1332 # works only with mysql 5
1333 DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1334 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1335 CONCAT_SEP => " SEPARATOR '' ",
1340 use Exporter 'import';
1341 our @EXPORT_OK = qw($btime);
1343 #our $btime = 1279144800;
1349 return $self->{info}->{dbi} =~ /dbi:mysql/i;
1356 $self->{dbh}->disconnect();
1361 sub dbh_selectall_arrayref
1363 my ($self, $query) = @_;
1364 $self->connect_db();
1365 $self->debug($query);
1366 return $self->{dbh}->selectall_arrayref($query);
1371 my ($self, @what) = @_;
1372 return join(',', $self->dbh_quote(@what)) ;
1377 my ($self, @what) = @_;
1379 $self->connect_db();
1381 return map { $self->{dbh}->quote($_) } @what;
1383 return $self->{dbh}->quote($what[0]) ;
1389 my ($self, $query) = @_ ;
1390 $self->connect_db();
1391 $self->debug($query);
1392 return $self->{dbh}->do($query);
1395 sub dbh_selectall_hashref
1397 my ($self, $query, $join) = @_;
1399 $self->connect_db();
1400 $self->debug($query);
1401 return $self->{dbh}->selectall_hashref($query, $join) ;
1404 sub dbh_selectrow_hashref
1406 my ($self, $query) = @_;
1408 $self->connect_db();
1409 $self->debug($query);
1410 return $self->{dbh}->selectrow_hashref($query) ;
1415 my ($self, @what) = @_;
1416 if ($self->dbh_is_mysql()) {
1417 return 'CONCAT(' . join(',', @what) . ')' ;
1419 return join(' || ', @what);
1425 my ($self, $query) = @_;
1426 $self->debug($query, up => 1);
1427 return $self->{dbh}->prepare($query);
1433 my @unit = qw(B KB MB GB TB);
1434 my $val = shift || 0;
1436 my $format = '%i %s';
1437 while ($val / 1024 > 1) {
1441 $format = ($i>0)?'%0.1f %s':'%i %s';
1442 return sprintf($format, $val, $unit[$i]);
1449 if ($val =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) {
1464 # display Day, Hour, Year
1470 $val /= 60; # sec -> min
1472 if ($val / 60 <= 1) {
1476 $val /= 60; # min -> hour
1477 if ($val / 24 <= 1) {
1478 return "$val hours";
1481 $val /= 24; # hour -> day
1482 if ($val / 365 < 2) {
1486 $val /= 365 ; # day -> year
1488 return "$val years";
1494 my $val = shift || 0;
1496 if ($val eq '1' or $val eq "yes") {
1498 } elsif ($val eq '2' or $val eq "archived") {
1506 sub from_human_enabled
1508 my $val = shift || 0;
1510 if ($val eq '1' or $val eq "yes") {
1512 } elsif ($val eq '2' or $val eq "archived") {
1519 # get Day, Hour, Year
1525 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1529 my %times = ( m => 60,
1535 my $mult = $times{$2} || 0;
1540 # get long term statistic table
1544 my $ret = $self->{info}->{stat_job_table} || 'JobHisto';
1545 if ($ret !~ m/^job$/i) {
1546 $ret = "(SELECT * FROM Job UNION SELECT * FROM $ret)";
1555 unless ($self->{dbh}) {
1557 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1558 $self->{info}->{user},
1559 $self->{info}->{password});
1561 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1562 unless ($self->{dbh});
1564 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1566 if ($self->dbh_is_mysql()) {
1567 $self->{dbh}->do("SET group_concat_max_len=1000000");
1569 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1576 my ($class, %arg) = @_;
1578 dbh => undef, # connect_db();
1580 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1586 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1588 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1589 $self->{sql} = $sql_func{$1};
1592 $self->{loginname} = CGI::remote_user();
1593 $self->{debug} = $self->{info}->{debug};
1594 $self->{lang} = $self->{info}->{lang};
1595 $self->{template_dir} = $self->{info}->{template_dir};
1603 if ($self->{info}->{enable_security}) {
1604 $self->get_roles(); # get lang
1606 $self->display($self->{info}, "begin.tpl");
1612 $self->display($self->{info}, "end.tpl");
1618 my $arg = $self->get_form("qclient");
1619 my $f1 = $self->get_client_group_filter();
1620 my $f2 = $self->get_client_filter();
1622 # client_group_name | here
1623 #-------------------+-----
1628 SELECT client_group_name, max(here) AS here FROM (
1629 SELECT client_group_name, 1 AS here
1631 JOIN client_group_member USING (client_group_id)
1632 JOIN Client USING (ClientId) $f2
1633 WHERE Name = $arg->{qclient}
1635 SELECT client_group_name, 0
1636 FROM client_group $f1
1638 GROUP by client_group_name";
1640 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
1642 $self->display({ client_group => [ values %$all ], %$arg }, "client_edit.tpl");
1648 my $where=''; # by default
1650 my $arg = $self->get_form("client", "qre_client",
1651 "jclient_groups", "qnotingroup");
1653 if ($arg->{qre_client}) {
1654 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1655 } elsif ($arg->{client}) {
1656 $where = "WHERE Name = '$arg->{client}' ";
1657 } elsif ($arg->{jclient_groups}) {
1658 # $filter could already contains client_group_member
1660 JOIN client_group_member USING (ClientId)
1661 JOIN client_group USING (client_group_id)
1662 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1663 } elsif ($arg->{qnotingroup}) {
1666 (SELECT 1 FROM client_group_member
1667 WHERE Client.ClientId = client_group_member.ClientId
1673 SELECT Name AS name,
1675 AutoPrune AS autoprune,
1676 FileRetention AS fileretention,
1677 JobRetention AS jobretention
1678 FROM Client " . $self->get_client_filter() .
1681 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1683 my $dsp = { ID => $cur_id++,
1684 clients => [ values %$all] };
1686 $self->display($dsp, "client_list.tpl") ;
1691 my ($self, %arg) = @_;
1695 my $sql = $self->{sql};
1697 if ($arg{since} and $arg{age}) {
1698 my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1699 my $d = strftime('%Y-%m-%d %H:%M:%S', localtime($btime + $arg{age}));
1701 AND StartTime > '$arg{since}'
1702 AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1704 $label .= "since $arg{since} and during " . human_sec($arg{age});
1706 } elsif ($arg{age}) {
1707 my $d = strftime('%Y-%m-%d %H:%M:%S', localtime($btime - $arg{age}));
1708 $limit .= "AND EndTime > '$d' " ;
1710 $label = "last " . human_sec($arg{age});
1713 if ($arg{groupby}) {
1714 $limit .= " GROUP BY $arg{groupby} ";
1718 $limit .= " ORDER BY $arg{order} ";
1722 $limit .= " LIMIT $arg{limit} ";
1723 $label .= " limited to $arg{limit}";
1727 $limit .= " OFFSET $arg{offset} ";
1728 $label .= " with $arg{offset} offset ";
1732 $label = 'no filter';
1735 return ($limit, $label);
1740 $bweb->get_form(...) - Get useful stuff
1744 This function get and check parameters against regexp.
1746 If word begin with 'q', the return will be quoted or join quoted
1747 if it's end with 's'.
1752 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1755 qclient => 'plume-fd',
1756 qpools => "'plume-fd', 'test-fd', '...'",
1763 my ($self, @what) = @_;
1764 my %what = map { $_ => 1 } @what;
1778 age => $self->{info}->{default_age},
1788 my %opt_ss =( # string with space
1792 my %opt_s = ( # default to ''
1814 my %opt_p = ( # option with path
1821 my %opt_r = (regexwhere => 1);
1822 my %opt_d = ( # option with date
1826 my %opt_t = (when => 2, # option with time
1827 begin => 1, # 1 hh:min are optionnal
1828 end => 1, # 2 hh:min are required
1831 foreach my $i (@what) {
1832 if (exists $opt_i{$i}) {# integer param
1833 my $value = CGI::param($i) || $opt_i{$i} ;
1834 if ($value =~ /^(\d+)$/) {
1836 } elsif ($i eq 'age' && # can have unit
1837 $value =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) # 2y1h2m34s
1839 $ret{$i} = human_sec_unit($value);
1841 } elsif ($opt_s{$i}) { # simple string param
1842 my $value = CGI::param($i) || '';
1843 if ($value =~ /^([\w\d\.-]+)$/) {
1846 } elsif ($opt_ss{$i}) { # simple string param (with space)
1847 my $value = CGI::param($i) || '';
1848 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1851 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1852 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1854 $ret{$i} = $self->dbh_join(@value) ;
1857 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1858 my $value = CGI::param($1) ;
1860 $ret{$i} = $self->dbh_quote($value);
1863 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1864 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1865 grep { ! /^\s*$/ } CGI::param($1) ];
1866 } elsif (exists $opt_p{$i}) {
1867 my $value = CGI::param($i) || '';
1868 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1871 } elsif (exists $opt_r{$i}) {
1872 my $value = CGI::param($i) || '';
1873 if ($value =~ /^([^'"']+)$/) {
1876 } elsif (exists $opt_d{$i}) {
1877 my $value = CGI::param($i) || '';
1878 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1881 } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1882 my $when = CGI::param($i) || '';
1883 if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}(:\d{2})?)?)/) {
1884 if ($opt_t{$i} == 1 or defined $2) {
1891 if ($what{storage_cmd}) {
1892 if (!grep {/^\Q$ret{storage_cmd}\E$/} ('mount', 'umount', 'release','status')) {
1893 delete $ret{storage_cmd};
1898 foreach my $s (CGI::param('slot')) {
1899 if ($s =~ /^(\d+)$/) {
1900 push @{$ret{slots}}, $s;
1906 my $age = $ret{age} || human_sec_unit($opt_i{age});
1907 my $since = CGI::param('since') || strftime('%F %T', localtime($btime - $age));
1908 if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1914 my $lang = CGI::param('lang') || 'en';
1915 if ($lang =~ /^(\w\w)$/) {
1920 if ($what{db_clients}) {
1922 if ($what{filter}) {
1923 # get security filter only if asked
1924 $filter = $self->get_client_filter();
1928 SELECT Client.Name as clientname
1932 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1933 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1937 if ($what{db_client_groups}) {
1939 if ($what{filter}) {
1940 # get security filter only if asked
1941 $filter = $self->get_client_group_filter();
1945 SELECT client_group_name AS name, comment AS comment
1946 FROM client_group $filter
1948 my $grps = $self->dbh_selectall_hashref($query, 'name');
1949 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1953 if ($what{db_usernames}) {
1955 SELECT username, comment
1958 my $users = $self->dbh_selectall_hashref($query, 'username');
1959 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1963 if ($what{db_roles}) {
1965 SELECT rolename, comment
1968 my $r = $self->dbh_selectall_hashref($query, 'rolename');
1969 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1973 if ($what{db_mediatypes}) {
1975 SELECT MediaType as mediatype
1978 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1979 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1983 if ($what{db_locations}) {
1985 SELECT Location as location, Cost as cost
1988 my $loc = $self->dbh_selectall_hashref($query, 'location');
1989 $ret{db_locations} = [ sort { $a->{location}
1995 if ($what{db_pools}) {
1996 my $query = "SELECT Name as name FROM Pool";
1998 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1999 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
2002 if ($what{db_filesets}) {
2004 SELECT FileSet.FileSet AS fileset
2007 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
2009 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
2010 values %$filesets] ;
2013 if ($what{db_jobnames}) {
2015 if ($what{filter}) {
2016 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
2019 SELECT DISTINCT Job.Name AS jobname
2022 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
2024 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
2025 values %$jobnames] ;
2028 if ($what{db_devices}) {
2030 SELECT Device.Name AS name
2033 my $devices = $self->dbh_selectall_hashref($query, 'name');
2035 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
2045 $self->can_do('r_view_stat');
2046 my $fields = $self->get_form(qw/age level status clients filesets
2047 graph gtype type filter db_clients
2048 limit db_filesets width height
2049 qclients qfilesets qjobnames db_jobnames/);
2051 my $url = CGI::url(-full => 0,
2054 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
2056 # this organisation is to keep user choice between 2 click
2057 # TODO : fileset and client selection doesn't work
2064 if ($fields->{gtype} and $fields->{gtype} eq 'balloon') {
2065 system("./bgraph.pl");
2069 sub get_selected_media_location
2073 my $media = $self->get_form('jmedias');
2075 unless ($media->{jmedias}) {
2080 SELECT Media.VolumeName AS volumename, Location.Location AS location
2081 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2082 WHERE Media.VolumeName IN ($media->{jmedias})
2085 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2087 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
2096 my ($self, $in) = @_ ;
2097 $self->can_do('r_media_mgnt');
2098 my $media = $self->get_selected_media_location();
2104 my $elt = $self->get_form('db_locations');
2106 $self->display({ ID => $cur_id++,
2107 enabled => human_enabled($in),
2108 %$elt, # db_locations
2110 sort { $a->{volumename} cmp $b->{volumename} } values %$media
2119 $self->can_do('r_media_mgnt');
2121 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2123 $self->display($elt, "help_extern.tpl");
2126 sub help_extern_compute
2129 $self->can_do('r_media_mgnt');
2131 my $number = CGI::param('limit') || '' ;
2132 unless ($number =~ /^(\d+)$/) {
2133 return $self->error("Bad arg number : $number ");
2136 my ($sql, undef) = $self->get_param('pools',
2137 'locations', 'mediatypes');
2140 SELECT Media.VolumeName AS volumename,
2141 Media.VolStatus AS volstatus,
2142 Media.LastWritten AS lastwritten,
2143 Media.MediaType AS mediatype,
2144 Media.VolMounts AS volmounts,
2146 Media.Recycle AS recycle,
2147 $self->{sql}->{FROM_UNIXTIME}(
2148 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2149 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2152 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2153 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2155 WHERE Media.InChanger = 1
2156 AND Media.VolStatus IN ('Disabled', 'Error', 'Full', 'Used')
2158 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2162 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2164 $self->display({ Media => [ values %$all ] },
2165 "help_extern_compute.tpl");
2171 $self->can_do('r_media_mgnt');
2173 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2174 $self->display($param, "help_intern.tpl");
2177 sub help_intern_compute
2180 $self->can_do('r_media_mgnt');
2182 my $number = CGI::param('limit') || '' ;
2183 unless ($number =~ /^(\d+)$/) {
2184 return $self->error("Bad arg number : $number ");
2187 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2189 if (CGI::param('expired')) {
2190 # we take only expired volumes or purged/recycle ones
2193 ( ($self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2194 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2195 ) < $self->{sql}->{NOW}
2197 Media.VolStatus IN ('Purged', 'Recycle')
2204 SELECT Media.VolumeName AS volumename,
2205 Media.VolStatus AS volstatus,
2206 Media.LastWritten AS lastwritten,
2207 Media.MediaType AS mediatype,
2208 Media.VolMounts AS volmounts,
2210 $self->{sql}->{FROM_UNIXTIME}(
2211 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2212 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2215 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2216 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
2218 WHERE Media.InChanger <> 1
2219 AND Media.VolStatus IN ('Purged', 'Full', 'Append', 'Recycle')
2220 AND Media.Recycle = 1
2222 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2226 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2228 $self->display({ Media => [ values %$all ] },
2229 "help_intern_compute.tpl");
2235 my ($self, %arg) = @_ ;
2237 my ($limit, $label) = $self->get_limit(%arg);
2238 my $filter = $self->get_client_filter();
2239 $filter = $filter? " JOIN Client USING (ClientId) $filter " : '';
2242 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
2243 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
2244 (SELECT count(Job.JobId) FROM Job) AS nb_job,
2245 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
2246 ($self->{sql}->{DB_SIZE}) AS db_size,
2247 (SELECT count(Job.JobId)
2249 WHERE Job.JobStatus IN ('E','e','f','A')
2252 (SELECT count(Client.ClientId) FROM Client) AS nb_client
2255 my $row = $self->dbh_selectrow_hashref($query) ;
2257 $row->{nb_bytes} = human_size($row->{nb_bytes});
2259 $row->{db_size} = human_size($row->{db_size});
2260 $row->{label} = $label;
2261 $row->{age} = $arg{age};
2263 $self->display($row, "general.tpl");
2268 my ($self, @what) = @_ ;
2269 my %elt = map { $_ => 1 } @what;
2274 if ($elt{clients}) {
2275 my @clients = grep { ! /^\s*$/ } CGI::param('client');
2277 $ret{clients} = \@clients;
2278 my $str = $self->dbh_join(@clients);
2279 $limit .= "AND Client.Name IN ($str) ";
2283 if ($elt{client_groups}) {
2284 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2286 $ret{client_groups} = \@clients;
2287 my $str = $self->dbh_join(@clients);
2288 $limit .= "AND client_group_name IN ($str) ";
2292 if ($elt{filesets}) {
2293 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2295 $ret{filesets} = \@filesets;
2296 my $str = $self->dbh_join(@filesets);
2297 $limit .= "AND FileSet.FileSet IN ($str) ";
2301 if ($elt{mediatypes}) {
2302 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2304 $ret{mediatypes} = \@media;
2305 my $str = $self->dbh_join(@media);
2306 $limit .= "AND Media.MediaType IN ($str) ";
2311 my $client = CGI::param('client');
2313 $ret{client} = $client;
2314 $client = $self->dbh_quote($client);
2315 $limit .= "AND Client.Name = $client ";
2320 my $level = CGI::param('level') || '';
2321 if ($level =~ /^(\w)$/) {
2323 $limit .= "AND Job.Level = '$1' ";
2328 my $jobid = CGI::param('jobid') || '';
2330 if ($jobid =~ /^(\d+)$/) {
2332 $limit .= "AND Job.JobId = '$1' ";
2337 my $status = CGI::param('status') || '';
2338 if ($status =~ /^(\w)$/) {
2341 $limit .= "AND Job.JobStatus IN ('E','e','f','A') ";
2342 } elsif ($1 eq 'W') {
2343 $limit .= "AND Job.JobStatus IN ('T', 'W') OR Job.JobErrors > 0 ";
2345 $limit .= "AND Job.JobStatus = '$1' ";
2350 if ($elt{volstatus}) {
2351 my $status = CGI::param('volstatus') || '';
2352 if ($status =~ /^(\w+)$/) {
2354 $limit .= "AND Media.VolStatus = '$1' ";
2358 if ($elt{locations}) {
2359 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2361 $ret{locations} = \@location;
2362 my $str = $self->dbh_join(@location);
2363 $limit .= "AND Location.Location IN ($str) ";
2368 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2370 $ret{pools} = \@pool;
2371 my $str = $self->dbh_join(@pool);
2372 $limit .= "AND Pool.Name IN ($str) ";
2376 if ($elt{location}) {
2377 my $location = CGI::param('location') || '';
2379 $ret{location} = $location;
2380 $location = $self->dbh_quote($location);
2381 $limit .= "AND Location.Location = $location ";
2386 my $pool = CGI::param('pool') || '';
2389 $pool = $self->dbh_quote($pool);
2390 $limit .= "AND Pool.Name = $pool ";
2394 if ($elt{jobtype}) {
2395 my $jobtype = CGI::param('jobtype') || '';
2396 if ($jobtype =~ /^(\w)$/) {
2398 $limit .= "AND Job.Type = '$1' ";
2402 return ($limit, %ret);
2413 my ($self, %arg) = @_ ;
2414 return if $self->cant_do('r_view_job');
2416 $arg{order} = ' Job.JobId DESC ';
2418 my ($limit, $label) = $self->get_limit(%arg);
2419 my ($where, undef) = $self->get_param('clients',
2428 if (CGI::param('client_group')) {
2430 JOIN client_group_member USING (ClientId)
2431 JOIN client_group USING (client_group_id)
2434 my $filter = $self->get_client_filter();
2437 SELECT Job.JobId AS jobid,
2438 Client.Name AS client,
2439 FileSet.FileSet AS fileset,
2440 Job.Name AS jobname,
2442 StartTime AS starttime,
2444 Pool.Name AS poolname,
2445 JobFiles AS jobfiles,
2446 JobBytes AS jobbytes,
2447 JobStatus AS jobstatus,
2449 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2450 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2453 JobErrors AS joberrors
2455 FROM Client $filter $cgq,
2456 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2457 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2458 WHERE Client.ClientId=Job.ClientId
2459 AND Job.JobStatus NOT IN ('R', 'C')
2464 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2466 $self->display({ Filter => $label,
2470 sort { $a->{jobid} <=> $b->{jobid} }
2477 # display job informations
2478 sub display_job_zoom
2480 my ($self, $jobid) = @_ ;
2481 $self->can_do('r_view_job');
2483 $jobid = $self->dbh_quote($jobid);
2485 # get security filter
2486 my $filter = $self->get_client_filter();
2489 SELECT DISTINCT Job.JobId AS jobid,
2490 Client.Name AS client,
2491 Job.Name AS jobname,
2492 FileSet.FileSet AS fileset,
2494 Pool.Name AS poolname,
2495 StartTime AS starttime,
2496 JobFiles AS jobfiles,
2497 JobBytes AS jobbytes,
2498 JobStatus AS jobstatus,
2499 JobErrors AS joberrors,
2501 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2502 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2504 FROM Client $filter,
2505 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2506 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2507 WHERE Client.ClientId=Job.ClientId
2508 AND Job.JobId = $jobid
2511 my $row = $self->dbh_selectrow_hashref($query) ;
2513 # display all volumes associate with this job
2515 SELECT Media.VolumeName as volumename
2516 FROM Job,Media,JobMedia
2517 WHERE Job.JobId = $jobid
2518 AND JobMedia.JobId=Job.JobId
2519 AND JobMedia.MediaId=Media.MediaId
2522 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2524 $row->{volumes} = [ values %$all ] ;
2525 $row->{wiki_url} = $self->{info}->{wiki_url};
2527 $self->display($row, "display_job_zoom.tpl");
2530 sub display_job_group
2532 my ($self, %arg) = @_;
2533 $self->can_do('r_view_job');
2535 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2537 my ($where, undef) = $self->get_param('client_groups',
2540 my $filter = $self->get_client_group_filter();
2543 SELECT client_group_name AS client_group_name,
2544 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2545 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2546 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2547 COALESCE(jobok.nbjobs,0) AS nbjobok,
2548 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2549 COALESCE(jobok.duration, '0:0:0') AS duration
2551 FROM client_group $filter LEFT JOIN (
2552 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2553 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2554 SUM(JobErrors) AS joberrors,
2555 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2556 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2559 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2560 JOIN client_group USING (client_group_id)
2562 WHERE Type IN ('B', 'R') AND JobStatus IN ('T', 'W')
2565 ) AS jobok USING (client_group_name) LEFT JOIN
2568 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2569 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2570 SUM(JobErrors) AS joberrors
2571 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2572 JOIN client_group USING (client_group_id)
2574 WHERE Type IN ('B', 'R') AND JobStatus IN ('f','E', 'A')
2577 ) AS joberr USING (client_group_name)
2581 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2583 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2586 $self->display($rep, "display_job_group.tpl");
2591 my ($self, %arg) = @_ ;
2592 $self->can_do('r_view_media');
2594 my ($limit, $label) = $self->get_limit(%arg);
2595 my ($where, %elt) = $self->get_param('pools',
2600 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2602 if ($arg->{jmedias}) {
2603 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2605 if ($arg->{qre_media}) {
2606 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2608 if ($arg->{expired}) {
2610 AND VolStatus IN ('Full', 'Used')
2611 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2612 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2613 ) < $self->{sql}->{NOW} " . $where ;
2617 SELECT Media.VolumeName AS volumename,
2618 Media.VolBytes AS volbytes,
2619 Media.VolStatus AS volstatus,
2620 Media.MediaType AS mediatype,
2621 Media.InChanger AS online,
2622 Media.LastWritten AS lastwritten,
2623 Location.Location AS location,
2624 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2625 Pool.Name AS poolname,
2626 $self->{sql}->{FROM_UNIXTIME}(
2627 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2628 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2631 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2632 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2633 Media.MediaType AS MediaType
2635 WHERE Media.VolStatus = 'Full'
2636 GROUP BY Media.MediaType
2637 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2639 WHERE Media.PoolId=Pool.PoolId
2644 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2646 $self->display({ ID => $cur_id++,
2648 Location => $elt{location},
2649 Media => [ values %$all ],
2651 "display_media.tpl");
2654 sub display_allmedia
2658 my $pool = $self->get_form('db_pools');
2660 foreach my $name (@{ $pool->{db_pools} }) {
2661 CGI::param('pool', $name->{name});
2662 $self->display_media();
2666 sub display_media_zoom
2670 my $media = $self->get_form('jmedias');
2672 unless ($media->{jmedias}) {
2673 return $self->error("Can't get media selection");
2677 SELECT InChanger AS online,
2678 Media.Enabled AS enabled,
2679 VolBytes AS nb_bytes,
2680 VolumeName AS volumename,
2681 VolStatus AS volstatus,
2682 VolMounts AS nb_mounts,
2683 Media.VolUseDuration AS voluseduration,
2684 Media.MaxVolJobs AS maxvoljobs,
2685 Media.MaxVolFiles AS maxvolfiles,
2686 Media.MaxVolBytes AS maxvolbytes,
2687 VolErrors AS nb_errors,
2688 Pool.Name AS poolname,
2689 Location.Location AS location,
2690 Media.Recycle AS recycle,
2691 Media.VolRetention AS volretention,
2692 Media.LastWritten AS lastwritten,
2693 Media.VolReadTime/1000000 AS volreadtime,
2694 Media.VolWriteTime/1000000 AS volwritetime,
2695 Media.RecycleCount AS recyclecount,
2696 Media.Comment AS comment,
2697 $self->{sql}->{FROM_UNIXTIME}(
2698 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2699 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2702 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2703 WHERE Pool.PoolId = Media.PoolId
2704 AND VolumeName IN ($media->{jmedias})
2707 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2709 foreach my $media (values %$all) {
2710 my $mq = $self->dbh_quote($media->{volumename});
2713 SELECT DISTINCT Job.JobId AS jobid,
2715 Job.StartTime AS starttime,
2718 Job.JobFiles AS files,
2719 Job.JobBytes AS bytes,
2720 Job.jobstatus AS status
2721 FROM Media,JobMedia,Job
2722 WHERE Media.VolumeName=$mq
2723 AND Media.MediaId=JobMedia.MediaId
2724 AND JobMedia.JobId=Job.JobId
2727 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2730 SELECT LocationLog.Date AS date,
2731 Location.Location AS location,
2732 LocationLog.Comment AS comment
2733 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2734 WHERE Media.MediaId = LocationLog.MediaId
2735 AND Media.VolumeName = $mq
2739 my $log = $self->dbh_selectall_arrayref($query) ;
2741 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2744 $self->display({ jobs => [ values %$jobs ],
2745 LocationLog => $logtxt,
2747 "display_media_zoom.tpl");
2754 $self->can_do('r_location_mgnt');
2756 my $loc = $self->get_form('qlocation');
2757 unless ($loc->{qlocation}) {
2758 return $self->error("Can't get location");
2762 SELECT Location.Location AS location,
2763 Location.Cost AS cost,
2764 Location.Enabled AS enabled
2766 WHERE Location.Location = $loc->{qlocation}
2769 my $row = $self->dbh_selectrow_hashref($query);
2770 $row->{enabled} = human_enabled($row->{enabled});
2771 $self->display({ ID => $cur_id++,
2772 %$row }, "location_edit.tpl") ;
2778 $self->can_do('r_location_mgnt');
2780 my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2781 unless ($arg->{qlocation}) {
2782 return $self->error("Can't get location");
2784 unless ($arg->{qnewlocation}) {
2785 return $self->error("Can't get new location name");
2787 unless ($arg->{cost}) {
2788 return $self->error("Can't get new cost");
2791 my $enabled = from_human_enabled($arg->{enabled});
2794 UPDATE Location SET Cost = $arg->{cost},
2795 Location = $arg->{qnewlocation},
2797 WHERE Location.Location = $arg->{qlocation}
2800 $self->dbh_do($query);
2802 $self->location_display();
2808 $self->can_do('r_location_mgnt');
2810 my $arg = $self->get_form(qw/qlocation/) ;
2812 unless ($arg->{qlocation}) {
2813 return $self->error("Can't get location");
2817 SELECT count(Media.MediaId) AS nb
2818 FROM Media INNER JOIN Location USING (LocationID)
2819 WHERE Location = $arg->{qlocation}
2822 my $res = $self->dbh_selectrow_hashref($query);
2825 return $self->error("Sorry, the location must be empty");
2829 DELETE FROM Location WHERE Location = $arg->{qlocation}
2832 $self->dbh_do($query);
2834 $self->location_display();
2840 $self->can_do('r_location_mgnt');
2842 my $arg = $self->get_form(qw/qlocation cost/) ;
2844 unless ($arg->{qlocation}) {
2845 $self->display({}, "location_add.tpl");
2848 unless ($arg->{cost}) {
2849 return $self->error("Can't get new cost");
2852 my $enabled = CGI::param('enabled') || '';
2853 $enabled = from_human_enabled($enabled);
2856 INSERT INTO Location (Location, Cost, Enabled)
2857 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2860 $self->dbh_do($query);
2862 $self->location_display();
2865 sub location_display
2870 SELECT Location.Location AS location,
2871 Location.Cost AS cost,
2872 Location.Enabled AS enabled,
2873 (SELECT count(Media.MediaId)
2875 WHERE Media.LocationId = Location.LocationId
2880 my $location = $self->dbh_selectall_hashref($query, 'location');
2882 $self->display({ ID => $cur_id++,
2883 Locations => [ values %$location ] },
2884 "display_location.tpl");
2891 my $media = $self->get_selected_media_location();
2896 my $arg = $self->get_form('db_locations', 'qnewlocation');
2898 $self->display({ email => $self->{info}->{email_media},
2900 media => [ values %$media ],
2902 "update_location.tpl");
2905 ###########################################################
2910 my $arg = $self->get_form(qw/jclient_groups qclient/);
2912 unless ($arg->{qclient}) {
2913 return $self->error("Can't get client name");
2916 $self->can_do('r_group_mgnt');
2918 my $f1 = $self->get_client_filter();
2919 my $f2 = $self->get_client_group_filter();
2921 $self->{dbh}->begin_work();
2924 DELETE FROM client_group_member
2928 WHERE Client.Name = $arg->{qclient})
2930 $self->dbh_do($query);
2932 if ($arg->{jclient_groups}) {
2934 INSERT INTO client_group_member (client_group_id, ClientId)
2935 (SELECT client_group_id, (SELECT ClientId
2937 WHERE Name = $arg->{qclient})
2938 FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
2941 $self->dbh_do($query);
2944 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2946 $self->display_clients();
2952 my $grp = $self->get_form(qw/qclient_group db_clients/);
2954 unless ($grp->{qclient_group}) {
2955 $self->can_do('r_group_mgnt');
2956 $self->display({ ID => $cur_id++,
2957 client_group => "''",
2959 }, "groups_edit.tpl");
2963 unless ($self->cant_do('r_group_mgnt')) {
2964 $self->can_do('r_view_group');
2969 FROM Client JOIN client_group_member using (ClientId)
2970 JOIN client_group using (client_group_id)
2971 WHERE client_group_name = $grp->{qclient_group}
2974 my $row = $self->dbh_selectall_hashref($query, "name");
2976 $self->display({ ID => $cur_id++,
2977 client_group => $grp->{qclient_group},
2979 client_group_member => [ values %$row]},
2986 $self->can_do('r_group_mgnt');
2988 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
2989 if (!$arg->{qcomment}) {
2990 $arg->{qcomment} = "''";
2993 if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2995 INSERT INTO client_group (client_group_name, comment)
2996 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
2998 $self->dbh_do($query);
2999 $arg->{qclient_group} = $arg->{qnewgroup};
3002 unless ($arg->{qclient_group}) {
3003 return $self->error("Can't get groups");
3006 $self->{dbh}->begin_work();
3009 DELETE FROM client_group_member
3010 WHERE client_group_id IN
3011 (SELECT client_group_id
3013 WHERE client_group_name = $arg->{qclient_group})
3015 $self->dbh_do($query);
3017 if ($arg->{jclients}) {
3019 INSERT INTO client_group_member (ClientId, client_group_id)
3021 (SELECT client_group_id
3023 WHERE client_group_name = $arg->{qclient_group})
3024 FROM Client WHERE Name IN ($arg->{jclients})
3027 $self->dbh_do($query);
3029 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
3032 SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
3033 WHERE client_group_name = $arg->{qclient_group}
3036 $self->dbh_do($query);
3039 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
3041 $self->display_groups();
3047 $self->can_do('r_group_mgnt');
3049 my $arg = $self->get_form(qw/qclient_group/);
3051 unless ($arg->{qclient_group}) {
3052 return $self->error("Can't get groups");
3055 $self->{dbh}->begin_work();
3058 DELETE FROM client_group_member
3059 WHERE client_group_id IN
3060 (SELECT client_group_id
3062 WHERE client_group_name = $arg->{qclient_group})");
3065 DELETE FROM bweb_client_group_acl
3066 WHERE client_group_id IN
3067 (SELECT client_group_id
3069 WHERE client_group_name = $arg->{qclient_group})");
3072 DELETE FROM client_group
3073 WHERE client_group_name = $arg->{qclient_group}");
3075 $self->{dbh}->commit();
3076 $self->display_groups();
3084 if ($self->cant_do('r_group_mgnt')) {
3085 $arg = $self->get_form(qw/db_client_groups filter/) ;
3087 $arg = $self->get_form(qw/db_client_groups/) ;
3090 if ($self->{dbh}->errstr) {
3091 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3096 $self->display({ ID => $cur_id++,
3098 "display_groups.tpl");
3101 ###########################################################
3106 if (not $self->{info}->{enable_security}) {
3109 if (!$self->{loginname}) {
3110 $self->error("Can't get your login name");
3111 $self->display_end();
3114 # admin is a special user that can do everything
3115 if ($self->{loginname} eq 'admin') {
3119 if (defined $self->{security}) {
3122 $self->{security} = {};
3123 my $u = $self->dbh_quote($self->{loginname});
3126 SELECT use_acl, rolename, tpl
3128 JOIN bweb_role_member USING (userid)
3129 JOIN bweb_role USING (roleid)
3132 my $rows = $self->dbh_selectall_arrayref($query);
3133 # do cache with this role
3134 if (!$rows or !scalar(@$rows)) {
3135 $self->error("Can't get $self->{loginname}'s roles");
3136 $self->display_end();
3139 foreach my $r (@$rows) {
3140 $self->{security}->{$r->[1]}=1;
3142 $self->{security}->{use_acl} = $rows->[0]->[0];
3143 if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3151 my ($self, $client) = @_;
3153 my $filter = $self->get_client_filter();
3157 my $cont = $self->dbh_selectrow_hashref("
3160 WHERE Name = '$client'
3162 return defined $cont;
3167 my ($self, $action) = @_;
3168 # is security enabled in configuration ?
3169 if (not $self->{info}->{enable_security}) {
3172 # admin is a special user that can do everything
3173 if ($self->{loginname} eq 'admin') {
3177 if (!$self->{loginname}) {
3178 $self->{error} = "Can't do $action, your are not logged. " .
3179 "Check security with your administrator";
3182 if (!$self->get_roles()) {
3185 if (!$self->{security}->{$action}) {
3187 "$self->{loginname} sorry, but this action ($action) " .
3188 "is not permited. " .
3189 "Check security with your administrator";
3195 # make like an assert (program die)
3198 my ($self, $action) = @_;
3199 if ($self->cant_do($action)) {
3200 $self->error($self->{error});
3201 $self->display_end();
3211 if (!$self->{info}->{enable_security} or
3212 !$self->{info}->{enable_security_acl})
3217 if ($self->get_roles()) {
3218 return $self->{security}->{use_acl};
3224 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3225 sub get_client_filter
3227 my ($self, $login) = @_;
3230 $u = $self->dbh_quote($login);
3231 } elsif ($self->use_filter()) {
3232 $u = $self->dbh_quote($self->{loginname});
3237 JOIN (SELECT ClientId FROM client_group_member
3238 JOIN client_group USING (client_group_id)
3239 JOIN bweb_client_group_acl USING (client_group_id)
3240 JOIN bweb_user USING (userid)
3241 WHERE bweb_user.username = $u
3242 ) AS filter USING (ClientId)";
3245 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3246 sub get_client_group_filter
3248 my ($self, $login) = @_;
3251 $u = $self->dbh_quote($login);
3252 } elsif ($self->use_filter()) {
3253 $u = $self->dbh_quote($self->{loginname});
3258 JOIN (SELECT client_group_id
3259 FROM bweb_client_group_acl
3260 JOIN bweb_user USING (userid)
3261 WHERE bweb_user.username = $u
3262 ) AS filter USING (client_group_id)";
3265 # role and username have to be quoted before
3266 # role and username can be a quoted list
3269 my ($self, $role, $username) = @_;
3270 $self->can_do("r_user_mgnt");
3272 my $nb = $self->dbh_do("
3273 DELETE FROM bweb_role_member
3274 WHERE roleid = (SELECT roleid FROM bweb_role
3275 WHERE rolename IN ($role))
3276 AND userid = (SELECT userid FROM bweb_user
3277 WHERE username IN ($username))");
3281 # role and username have to be quoted before
3282 # role and username can be a quoted list
3285 my ($self, $role, $username) = @_;
3286 $self->can_do("r_user_mgnt");
3288 my $nb = $self->dbh_do("
3289 INSERT INTO bweb_role_member (roleid, userid)
3290 SELECT roleid, userid FROM bweb_role, bweb_user
3291 WHERE rolename IN ($role)
3292 AND username IN ($username)
3297 # role and username have to be quoted before
3298 # role and username can be a quoted list
3301 my ($self, $copy, $user) = @_;
3302 $self->can_do("r_user_mgnt");
3304 my $nb = $self->dbh_do("
3305 INSERT INTO bweb_role_member (roleid, userid)
3306 SELECT roleid, a.userid
3307 FROM bweb_user AS a, bweb_role_member
3308 JOIN bweb_user USING (userid)
3309 WHERE bweb_user.username = $copy
3310 AND a.username = $user");
3314 # username can be a join quoted list of usernames
3317 my ($self, $username) = @_;
3318 $self->can_do("r_user_mgnt");
3321 DELETE FROM bweb_role_member
3325 WHERE username in ($username))");
3327 DELETE FROM bweb_client_group_acl
3331 WHERE username IN ($username))");
3338 $self->can_do("r_user_mgnt");
3340 my $arg = $self->get_form(qw/jusernames/);
3342 unless ($arg->{jusernames}) {
3343 return $self->error("Can't get user");
3346 $self->{dbh}->begin_work();
3348 $self->revoke_all($arg->{jusernames});
3350 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3352 $self->{dbh}->commit();
3354 $self->display_users();
3360 $self->can_do("r_user_mgnt");
3362 # we don't quote username directly to check that it is conform
3363 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3364 lang qcopy_username jclient_groups/) ;
3366 if (not $arg->{qcreate}) {
3367 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3368 $self->display($arg, "display_user.tpl");
3372 my $u = $self->dbh_quote($arg->{username});
3374 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3376 if (!$arg->{qpasswd}) {
3377 $arg->{qpasswd} = "''";
3379 if (!$arg->{qcomment}) {
3380 $arg->{qcomment} = "''";
3383 # will fail if user already exists
3384 # UPDATE with mysql dbi does not return if update is ok
3387 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3388 use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3389 WHERE username = $u")
3390 # and (! $self->dbh_is_mysql() )
3393 INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3394 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3395 $arg->{qcomment}, '$arg->{lang}')");
3397 $self->{dbh}->begin_work();
3399 $self->revoke_all($u);
3401 if ($arg->{qcopy_username}) {
3402 $self->grant_like($arg->{qcopy_username}, $u);
3404 $self->grant($arg->{jrolenames}, $u);
3407 if ($arg->{jclient_groups}) {
3409 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3410 SELECT client_group_id, userid
3411 FROM client_group, bweb_user
3412 WHERE client_group_name IN ($arg->{jclient_groups})
3417 $self->{dbh}->commit();
3419 $self->display_users();
3422 # TODO: we miss a matrix with all user/roles
3426 $self->can_do("r_user_mgnt");
3428 my $arg = $self->get_form(qw/db_usernames/) ;
3430 if ($self->{dbh}->errstr) {
3431 return $self->error("Can't use users with bweb, read INSTALL to enable them");
3434 $self->display({ ID => $cur_id++,
3436 "display_users.tpl");
3442 $self->can_do("r_user_mgnt");
3444 my $arg = $self->get_form('username');
3445 my $user = $self->dbh_quote($arg->{username});
3447 my $userp = $self->dbh_selectrow_hashref("
3448 SELECT username, passwd, comment, use_acl, tpl
3450 WHERE username = $user
3453 return $self->error("Can't find $user in catalog");
3455 my $filter = $self->get_client_group_filter($arg->{username});
3456 my $scg = $self->dbh_selectall_hashref("
3457 SELECT client_group_name AS name
3458 FROM client_group $filter
3462 #------------+--------
3467 my $role = $self->dbh_selectall_hashref("
3468 SELECT rolename, max(here) AS userid FROM (
3469 SELECT rolename, 1 AS here
3471 JOIN bweb_role_member USING (userid)
3472 JOIN bweb_role USING (roleid)
3473 WHERE username = $user
3478 GROUP by rolename", 'rolename');
3480 $arg = $self->get_form(qw/db_usernames db_client_groups/);
3483 db_usernames => $arg->{db_usernames},
3484 username => $userp->{username},
3485 comment => $userp->{comment},
3486 passwd => $userp->{passwd},
3487 lang => $userp->{tpl},
3488 use_acl => $userp->{use_acl},
3489 db_client_groups => $arg->{db_client_groups},
3490 client_group => [ values %$scg ],
3491 db_roles => [ values %$role],
3492 }, "display_user.tpl");
3496 ###########################################################
3498 sub get_media_max_size
3500 my ($self, $type) = @_;
3502 "SELECT avg(VolBytes) AS size
3504 WHERE Media.VolStatus = 'Full'
3505 AND Media.MediaType = '$type'
3508 my $res = $self->selectrow_hashref($query);
3511 return $res->{size};
3521 my $media = $self->get_form('qmedia');
3523 unless ($media->{qmedia}) {
3524 return $self->error("Can't get media");
3528 SELECT Media.Slot AS slot,
3529 PoolMedia.Name AS poolname,
3530 Media.VolStatus AS volstatus,
3531 Media.InChanger AS inchanger,
3532 Location.Location AS location,
3533 Media.VolumeName AS volumename,
3534 Media.MaxVolBytes AS maxvolbytes,
3535 Media.MaxVolJobs AS maxvoljobs,
3536 Media.MaxVolFiles AS maxvolfiles,
3537 Media.VolUseDuration AS voluseduration,
3538 Media.VolRetention AS volretention,
3539 Media.Comment AS comment,
3540 PoolRecycle.Name AS poolrecycle,
3541 Media.Enabled AS enabled
3543 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3544 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3545 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3547 WHERE Media.VolumeName = $media->{qmedia}
3550 my $row = $self->dbh_selectrow_hashref($query);
3551 $row->{volretention} = human_sec($row->{volretention});
3552 $row->{voluseduration} = human_sec($row->{voluseduration});
3553 $row->{enabled} = human_enabled($row->{enabled});
3555 my $elt = $self->get_form(qw/db_pools db_locations/);
3560 }, "update_media.tpl");
3566 $self->can_do('r_media_mgnt');
3568 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3570 unless ($arg->{jmedias}) {
3571 return $self->error("Can't get selected media");
3574 unless ($arg->{qnewlocation}) {
3575 return $self->error("Can't get new location");
3580 SET LocationId = (SELECT LocationId
3582 WHERE Location = $arg->{qnewlocation})
3583 WHERE Media.VolumeName IN ($arg->{jmedias})
3586 my $nb = $self->dbh_do($query);
3588 print "$nb media updated, you may have to update your autochanger.";
3590 $self->display_media();
3596 $self->can_do('r_media_mgnt');
3598 my $media = $self->get_selected_media_location();
3600 return $self->error("Can't get media selection");
3602 my $newloc = CGI::param('newlocation');
3604 my $user = CGI::param('user') || 'unknown';
3605 my $comm = CGI::param('comment') || '';
3606 $comm = $self->dbh_quote("$user: $comm");
3608 my $arg = $self->get_form('enabled');
3609 my $en = from_human_enabled($arg->{enabled});
3610 my $b = $self->get_bconsole();
3613 foreach my $vol (keys %$media) {
3615 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3616 SELECT $self->{sql}->{NOW}, $comm, Media.MediaId, Location.LocationId,
3618 FROM Media, Location
3619 WHERE Media.VolumeName = '$vol'
3620 AND Location.Location = '$media->{$vol}->{location}'
3622 $self->dbh_do($query);
3623 $self->debug($query);
3624 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3629 $q->param('action', 'update_location');
3630 my $url = $q->url(-full => 1, -query=>1);
3632 $self->display({ email => $self->{info}->{email_media},
3634 newlocation => $newloc,
3635 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3636 media => [ values %$media ],
3638 "change_location.tpl");
3642 sub display_client_stats
3644 my ($self, %arg) = @_ ;
3645 $self->can_do('r_view_stat');
3647 my $client = $self->dbh_quote($arg{clientname});
3648 # get security filter
3649 my $filter = $self->get_client_filter();
3651 my ($limit, $label) = $self->get_limit(%arg);
3654 count(Job.JobId) AS nb_jobs,
3655 sum(Job.JobBytes) AS nb_bytes,
3656 sum(Job.JobErrors) AS nb_err,
3657 sum(Job.JobFiles) AS nb_files,
3658 Client.Name AS clientname
3659 FROM Job JOIN Client USING (ClientId) $filter
3661 Client.Name = $client
3663 GROUP BY Client.Name
3666 my $row = $self->dbh_selectrow_hashref($query);
3668 $row->{ID} = $cur_id++;
3669 $row->{label} = $label;
3670 $row->{grapharg} = "client";
3671 $row->{age} = $arg{age};
3673 $self->display($row, "display_client_stats.tpl");
3677 sub _display_group_stats
3679 my ($self, %arg) = @_ ;
3681 my $carg = $self->get_form(qw/qclient_group/);
3683 unless ($carg->{qclient_group}) {
3684 return $self->error("Can't get group");
3686 my $jobt = $self->get_stat_table();
3687 my ($limit, $label) = $self->get_limit(%arg);
3691 count(Job.JobId) AS nb_jobs,
3692 sum(Job.JobBytes) AS nb_bytes,
3693 sum(Job.JobErrors) AS nb_err,
3694 sum(Job.JobFiles) AS nb_files,
3695 client_group.client_group_name AS clientname
3697 JOIN Client USING (ClientId)
3698 JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3699 JOIN client_group USING (client_group_id)
3701 client_group.client_group_name = $carg->{qclient_group}
3703 GROUP BY client_group.client_group_name
3706 my $row = $self->dbh_selectrow_hashref($query);
3708 $row->{ID} = $cur_id++;
3709 $row->{label} = $label;
3710 $row->{grapharg} = "client_group";
3712 $self->display($row, "display_client_stats.tpl");
3715 # [ name, num, value, joberrors, nb_job ] =>
3717 # [ { name => 'ALL',
3718 # events => [ { num => 1, label => '2007-01',
3719 # value => 'T', title => 10 },
3720 # { num => 2, label => '2007-02',
3721 # value => 'R', title => 11 },
3724 # { name => 'Other',
3728 sub make_overview_tab
3730 my ($self, $q) = @_;
3731 my $ret = $self->dbh_selectall_arrayref($q);
3735 for my $elt (@$ret) {
3736 if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3737 push @items, { name => $cur_name, events => $events};
3740 $cur_name = $elt->[0];
3742 { num => $elt->[1], status => $elt->[2],
3743 joberrors => $elt->[3], title => "$elt->[4] jobs", date => $elt->[5]};
3745 push @items, { name => $cur_name, events => $events};
3749 sub get_time_overview
3751 my ($self, $arg) = @_; # want since et age from get_form();
3752 my $type = $arg->{type} || 'day';
3753 if ($type =~ /^(day|week|hour|month)$/) {
3759 my $jobt = $self->get_stat_table();
3760 my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1, 2, 3, 4
3761 $stime1 =~ s/Job.StartTime/date/;
3762 my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3764 my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3765 'age' => $arg->{age});
3766 return ($stime1, $stime2, $limit, $label, $jobt);
3769 # lu ma me je ve sa di
3770 # groupe1 v v x w v v v overview
3771 # |-- s1 v v v v v v v overview_zoom
3772 # |-- s2 v v x v v v v
3773 # `-- s3 v v v w v v v
3774 sub display_overview_zoom
3777 $self->can_do('r_view_stat');
3779 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3780 $arg->{type} = $arg->{type} || 'day';
3782 if (!$arg->{jclient_groups}) {
3783 return $self->error("Can't get client_group selection");
3785 my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3786 my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3788 my $filter = $self->get_client_filter();
3790 SELECT name, $stime1 AS num,
3791 JobStatus AS value, joberrors, nb_job, date
3793 SELECT $stime2 AS date,
3794 Client.Name AS name,
3795 MAX(severity) AS severity,
3797 SUM(JobErrors) AS joberrors
3799 JOIN client_group_member USING (ClientId)
3800 JOIN client_group USING (client_group_id)
3801 JOIN Client USING (ClientId) $filter
3802 JOIN Status USING (JobStatus)
3803 WHERE client_group_name IN ($arg->{jclient_groups})
3804 AND JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3806 GROUP BY Client.Name, date
3807 ) AS sub JOIN Status USING (severity)
3810 my $items = $self->make_overview_tab($q);
3811 $self->display({label => $label,
3812 type => $arg->{type},
3813 action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3814 items => $items}, "overview.tpl");
3817 sub display_overview
3820 $self->can_do('r_view_stat');
3822 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3823 $arg->{type} = $arg->{type} || 'day';
3824 my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3825 my $filter3 = $self->get_client_group_filter();
3826 my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3829 SELECT name, $stime1 AS num,
3830 JobStatus AS value, joberrors, nb_job, date
3832 SELECT $stime2 AS date,
3833 client_group_name AS name,
3834 MAX(severity) AS severity,
3836 SUM(JobErrors) AS joberrors
3838 JOIN client_group_member USING (ClientId)
3839 JOIN client_group USING (client_group_id) $filter3
3840 JOIN Status USING (JobStatus)
3841 WHERE JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3843 GROUP BY client_group_name, date
3844 ) AS sub JOIN Status USING (severity)
3847 my $items = $self->make_overview_tab($q);
3848 $self->display({label=>$label,
3849 type => $arg->{type},
3850 action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3851 items => $items}, "overview.tpl");
3855 # poolname can be undef
3858 my ($self, $poolname) = @_ ;
3859 $self->can_do('r_view_media');
3864 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3865 if ($arg->{jmediatypes}) {
3866 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3867 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3870 # TODO : afficher les tailles et les dates
3873 SELECT subq.volmax AS volmax,
3874 subq.volnum AS volnum,
3875 subq.voltotal AS voltotal,
3877 Pool.Recycle AS recycle,
3878 Pool.VolRetention AS volretention,
3879 Pool.VolUseDuration AS voluseduration,
3880 Pool.MaxVolJobs AS maxvoljobs,
3881 Pool.MaxVolFiles AS maxvolfiles,
3882 Pool.MaxVolBytes AS maxvolbytes,
3883 subq.PoolId AS PoolId,
3884 subq.MediaType AS mediatype,
3885 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3888 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3889 count(Media.MediaId) AS volnum,
3890 sum(Media.VolBytes) AS voltotal,
3891 Media.PoolId AS PoolId,
3892 Media.MediaType AS MediaType
3894 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3895 Media.MediaType AS MediaType
3897 WHERE Media.VolStatus = 'Full'
3898 GROUP BY Media.MediaType
3899 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3900 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3902 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3906 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3909 SELECT Pool.Name AS name,
3910 sum(VolBytes) AS size
3911 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3912 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3916 my $empty = $self->dbh_selectall_hashref($query, 'name');
3918 foreach my $p (values %$all) {
3919 if ($p->{volmax} > 0) { # mysql returns 0.0000
3920 # we remove Recycled/Purged media from pool usage
3921 if (defined $empty->{$p->{name}}) {
3922 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3924 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3926 $p->{poolusage} = 0;
3930 SELECT VolStatus AS volstatus, count(MediaId) AS nb
3932 WHERE PoolId=$p->{poolid}
3933 AND Media.MediaType = '$p->{mediatype}'
3937 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3938 foreach my $t (values %$content) {
3939 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3944 $self->display({ ID => $cur_id++,
3945 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3946 Pools => [ values %$all ]},
3947 "display_pool.tpl");
3950 # With this function, we get an estimation of next jobfiles/jobbytes count
3951 sub get_estimate_query
3953 my ($self, $mode, $job, $level) = @_;
3954 # get security filter
3955 my $filter = $self->get_client_filter();
3959 if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
3961 SELECT jobname AS jobname,
3962 0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
3963 COUNT(1) AS nb_jobbytes ";
3965 # postgresql have functions that permit to handle lineal regression
3967 # REGR_SLOPE(Y,X) = get x
3968 # REGR_INTERCEPT(Y,X) = get b
3969 # and we need y when x=now()
3970 # CORR gives the correlation
3971 # (TODO: display progress bar only if CORR > 0.8)
3974 SELECT temp.jobname AS jobname,
3975 COALESCE(CORR(jobbytes,jobtdate),0) AS corr_jobbytes,
3976 ($now*REGR_SLOPE(jobbytes,jobtdate)
3977 + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
3978 COUNT(1) AS nb_jobbytes ";
3980 # if it's a differential, we need to compare since the last full
3982 # F D D D F D D D F I I I I D I I I
3984 # | # # # # # # | # #
3985 # | # # # # # # # # | # # # # # # # # #
3986 # +----------------- +-------------------
3988 if ($level eq 'D') {
3990 AND Job.StartTime > (
3993 WHERE Job.Name = '$job'
3995 AND Job.JobStatus IN ('T', 'W')
3996 ORDER BY Job.StartTime DESC LIMIT 1
4003 SELECT Job.Name AS jobname,
4004 JobBytes AS jobbytes,
4005 JobTDate AS jobtdate
4006 FROM Job INNER JOIN Client USING (ClientId) $filter
4007 WHERE Job.Name = '$job'
4008 AND Job.Level = '$level'
4009 AND Job.JobStatus IN ('T', 'W')
4011 ORDER BY StartTime DESC
4013 ) AS temp GROUP BY temp.jobname
4016 if ($mode eq 'jobfiles') {
4017 $query =~ s/jobbytes/jobfiles/g;
4018 $query =~ s/JobBytes/JobFiles/g;
4023 sub display_running_job
4026 return if $self->cant_do('r_view_running_job');
4028 my $arg = $self->get_form('jobid');
4030 return $self->error("Can't get jobid") unless ($arg->{jobid});
4032 # get security filter
4033 my $filter = $self->get_client_filter();
4036 SELECT Client.Name AS name, Job.Name AS jobname,
4037 Job.Level AS level, Type AS type, JobStatus AS jobstatus
4038 FROM Job INNER JOIN Client USING (ClientId) $filter
4039 WHERE Job.JobId = $arg->{jobid}
4042 my $row = $self->dbh_selectrow_hashref($query);
4045 $arg->{client} = $row->{name};
4047 return $self->error("Can't get client");
4050 my $status = $row->{jobstatus};
4052 if ($status =~ /[TfAaEWD]/) {
4053 $self->display_job_zoom($arg->{jobid});
4054 $self->get_job_log();
4058 if ($row->{type} eq 'B') {
4059 # for jobfiles, we use only last Full backup. status client= returns
4060 # all files that have been checked
4061 my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
4062 my $query2 = $self->get_estimate_query('jobbytes',
4063 $row->{jobname}, $row->{level});
4065 # LEFT JOIN because we always have a previous Full
4067 SELECT corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
4068 FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
4070 $row = $self->dbh_selectrow_hashref($query);
4073 $row->{jobbytes} = $row->{jobfiles} = 0;
4076 if ($status =~ /[RBSmMsjlL]/) {
4077 my $cli = new Bweb::Client(name => $arg->{client});
4078 $cli->display_running_job($self, $arg->{jobid}, $row);
4080 if ($arg->{jobid}) {
4081 $self->get_job_log();
4085 sub display_running_jobs
4087 my ($self, $display_action) = @_;
4088 return if $self->cant_do('r_view_running_job');
4090 # get security filter
4091 my $filter = $self->get_client_filter();
4094 SELECT Job.JobId AS jobid,
4095 Job.Name AS jobname,
4097 Job.StartTime AS starttime,
4098 Job.JobFiles AS jobfiles,
4099 Job.JobBytes AS jobbytes,
4100 Job.JobStatus AS jobstatus,
4101 $self->{sql}->{SEC_TO_TIME}($self->{sql}->{UNIX_TIMESTAMP}($self->{sql}->{NOW})
4102 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4104 Client.Name AS clientname
4105 FROM Job INNER JOIN Client USING (ClientId) $filter
4107 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4109 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4111 $self->display({ ID => $cur_id++,
4112 display_action => $display_action,
4113 Jobs => [ values %$all ]},
4114 "running_job.tpl") ;
4117 sub display_group_stats
4120 my $arg = $self->get_form('age', 'since');
4121 return if $self->cant_do('r_view_stat');
4123 my $filter = $self->get_client_group_filter();
4125 my $jobt = $self->get_stat_table();
4127 my ($limit, $label) = $self->get_limit(%$arg);
4128 my ($where, undef) = $self->get_param('client_groups', 'level');
4131 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_err, nb_resto
4134 SELECT sum(JobBytes) AS nb_byte,
4135 sum(JobFiles) AS nb_file,
4136 count(1) AS nb_job, client_group_name
4137 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4138 JOIN client_group USING (client_group_id) $filter
4139 WHERE JobStatus IN ('T', 'W') AND Type IN ('M', 'B', 'g')
4141 GROUP BY client_group_name ORDER BY client_group_name
4145 SELECT count(1) AS nb_err, client_group_name
4146 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4147 JOIN client_group USING (client_group_id)
4148 WHERE JobStatus IN ('E','e','f','A') AND Type = 'B'
4150 GROUP BY client_group_name ORDER BY client_group_name
4152 ) AS T3 USING (client_group_name) LEFT JOIN (
4154 SELECT count(1) AS nb_resto, client_group_name
4155 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4156 JOIN client_group USING (client_group_id)
4157 WHERE JobStatus IN ('T','W') AND Type = 'R'
4159 GROUP BY client_group_name ORDER BY client_group_name
4161 ) AS T2 USING (client_group_name)
4163 $self->debug($query);
4164 my $all = $self->dbh_selectall_hashref($query, 'name') ;
4167 $self->display({ ID => $cur_id++,
4169 Stats => [ values %$all ]},
4170 "display_stats.tpl") ;
4173 # return the autochanger list to update
4177 $self->can_do('r_media_mgnt');
4180 my $arg = $self->get_form('jmedias');
4182 unless ($arg->{jmedias}) {
4183 return $self->error("Can't get media selection");
4187 SELECT Media.VolumeName AS volumename,
4188 Storage.Name AS storage,
4189 Location.Location AS location,
4191 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
4192 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
4193 WHERE Media.VolumeName IN ($arg->{jmedias})
4194 AND Media.InChanger = 1
4197 my $all = $self->dbh_selectall_hashref($query, 'volumename');
4199 foreach my $vol (values %$all) {
4200 my $a = $self->ach_get($vol->{location});
4202 $ret{$vol->{location}} = 1;
4204 unless ($a->{have_status}) {
4206 $a->{have_status} = 1;
4209 print "eject $vol->{volumename} from $vol->{storage} : ";
4210 if ($a->send_to_io($vol->{slot})) {
4211 print "<img src='/bweb/T.png' alt='ok'><br/>";
4213 print "<img src='/bweb/E.png' alt='err'><br/>";
4223 my ($to, $subject, $content) = (CGI::param('email'),
4224 CGI::param('subject'),
4225 CGI::param('content'));
4226 $to =~ s/[^\w\d\.\@<>,]//;
4227 $subject =~ s/[^\w\d\.\[\]]/ /;
4229 open(MAIL, "|mail -s '$subject' '$to'") ;
4230 print MAIL $content;
4240 my $arg = $self->get_form('jobid', 'client');
4242 print CGI::header('text/brestore');
4243 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4244 print "client=$arg->{client}\n" if ($arg->{client});
4245 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4249 # TODO : move this to Bweb::Autochanger ?
4250 # TODO : make this internal to not eject tape ?
4257 $self->can_do('r_view_job');
4259 my $arg = $self->get_form(qw/limit offset jobid/);
4260 if (!$arg->{jobid}) {
4261 return $self->error("Can't get jobid");
4265 title => "Content of JobId $arg->{jobid} ",
4266 name => "list files jobid=$arg->{jobid}",
4271 my $b = new Bconsole(pref => $self->{info},timeout => 60);
4274 $b->send_cmd("list files jobid=$arg->{jobid} limit=$arg->{limit}"); # TODO: add offset
4283 my ($self, $name) = @_;
4286 return $self->error("Can't get your autochanger name ach");
4289 unless ($self->{info}->{ach_list}) {
4290 return $self->error("Could not find any autochanger");
4293 my $a = $self->{info}->{ach_list}->{$name};
4296 $self->error("Can't get your autochanger $name from your ach_list");
4301 $a->{debug} = $self->{debug};
4308 my ($self, $ach) = @_;
4309 $self->can_do('r_configure');
4311 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4313 $self->{info}->save();
4321 $self->can_do('r_configure');
4323 my $arg = $self->get_form('ach');
4325 or !$self->{info}->{ach_list}
4326 or !$self->{info}->{ach_list}->{$arg->{ach}})
4328 return $self->error("Can't get autochanger name");
4331 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4335 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4337 my $b = $self->get_bconsole();
4339 my @storages = $b->list_storage() ;
4341 $ach->{devices} = [ map { { name => $_ } } @storages ];
4343 $self->display($ach, "ach_add.tpl");
4344 delete $ach->{drives};
4345 delete $ach->{devices};
4352 $self->can_do('r_configure');
4354 my $arg = $self->get_form('ach');
4357 or !$self->{info}->{ach_list}
4358 or !$self->{info}->{ach_list}->{$arg->{ach}})
4360 return $self->error("Can't get autochanger name");
4363 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4365 $self->{info}->save();
4366 $self->{info}->view();
4372 $self->can_do('r_configure');
4374 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4376 my $b = $self->get_bconsole();
4377 my @storages = $b->list_storage() ;
4379 unless ($arg->{ach}) {
4380 $arg->{devices} = [ map { { name => $_ } } @storages ];
4381 return $self->display($arg, "ach_add.tpl");
4385 foreach my $drive (CGI::param('drives'))
4387 unless (grep(/^$drive$/,@storages)) {
4388 return $self->error("Can't find $drive in storage list");
4391 my $index = CGI::param("index_$drive");
4392 unless (defined $index and $index =~ /^(\d+)$/) {
4393 return $self->error("Can't get $drive index");
4396 $drives[$index] = $drive;
4400 return $self->error("Can't get drives from Autochanger");
4403 my $a = new Bweb::Autochanger(name => $arg->{ach},
4404 precmd => $arg->{precmd},
4405 drive_name => \@drives,
4406 device => $arg->{device},
4407 mtxcmd => $arg->{mtxcmd});
4409 $self->ach_register($a) ;
4411 $self->{info}->view();
4417 $self->can_do('r_delete_job');
4419 my $arg = $self->get_form('jobid');
4421 if ($arg->{jobid}) {
4422 my $b = $self->get_bconsole();
4423 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4427 title => "Delete a job ",
4428 name => "delete jobid=$arg->{jobid}",
4437 $self->can_do('r_media_mgnt');
4439 my $arg = $self->get_form(qw/media volstatus inchanger pool
4440 slot volretention voluseduration
4441 maxvoljobs maxvolfiles maxvolbytes
4442 qcomment poolrecycle enabled
4445 unless ($arg->{media}) {
4446 return $self->error("Can't find media selection");
4449 my $update = "update volume=$arg->{media} ";
4451 if ($arg->{volstatus}) {
4452 $update .= " volstatus=$arg->{volstatus} ";
4455 if ($arg->{inchanger}) {
4456 $update .= " inchanger=yes " ;
4458 $update .= " slot=$arg->{slot} ";
4461 $update .= " slot=0 inchanger=no ";
4464 if ($arg->{enabled}) {
4465 $update .= " enabled=$arg->{enabled} ";
4469 $update .= " pool=$arg->{pool} " ;
4472 if (defined $arg->{volretention}) {
4473 $update .= " volretention=\"$arg->{volretention}\" " ;
4476 if (defined $arg->{voluseduration}) {
4477 $update .= " voluse=\"$arg->{voluseduration}\" " ;
4480 if (defined $arg->{maxvoljobs}) {
4481 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4484 if (defined $arg->{maxvolfiles}) {
4485 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4488 if (defined $arg->{maxvolbytes}) {
4489 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4492 if (defined $arg->{poolrecycle}) {
4493 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4496 my $b = $self->get_bconsole();
4499 content => $b->send_cmd($update),
4500 title => "Update a volume ",
4508 my $media = $self->dbh_quote($arg->{media});
4510 my $loc = CGI::param('location') || '';
4512 $loc = $self->dbh_quote($loc); # is checked by db
4513 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4515 if (!$arg->{qcomment}) {
4516 $arg->{qcomment} = "''";
4518 push @q, "Comment=$arg->{qcomment}";
4523 SET " . join (',', @q) . "
4524 WHERE Media.VolumeName = $media
4526 $self->dbh_do($query);
4528 $self->update_media();
4534 $self->can_do('r_autochanger_mgnt');
4536 my $ach = CGI::param('ach') ;
4537 $ach = $self->ach_get($ach);
4539 return $self->error("Bad autochanger name");
4543 title => "Scanning autochanger content ",
4544 name => "update slots",
4548 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4549 $b->update_slots($ach->{name});
4559 $self->can_do('r_view_log');
4561 my $arg = $self->get_form('jobid', 'limit', 'offset');
4562 unless ($arg->{jobid}) {
4563 return $self->error("Can't get jobid");
4566 if ($arg->{limit} == 100) {
4567 $arg->{limit} = 1000;
4569 # get security filter
4570 my $filter = $self->get_client_filter();
4573 SELECT Job.Name as name, Client.Name as clientname
4574 FROM Job INNER JOIN Client USING (ClientId) $filter
4575 WHERE JobId = $arg->{jobid}
4578 my $row = $self->dbh_selectrow_hashref($query);
4581 return $self->error("Can't find $arg->{jobid} in catalog");
4584 # display only Error and Warning messages
4586 if (CGI::param('error')) {
4587 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4591 if (CGI::param('time') || $self->{info}->{display_log_time}) {
4592 $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4594 $logtext = 'LogText';
4598 SELECT count(1) AS nbline,
4599 GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt, id
4601 SELECT 1 AS id, Time, LogText
4603 WHERE ( Log.JobId = $arg->{jobid}
4605 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4606 AND Time <= (SELECT COALESCE(EndTime,$self->{sql}->{NOW})
4607 FROM Job WHERE JobId=$arg->{jobid})
4611 OFFSET $arg->{offset}
4617 my $log = $self->dbh_selectrow_hashref($query);
4619 return $self->error("Can't get log for jobid $arg->{jobid}, check that
4620 your 'Messages' resources include 'catalog = all' and you loaded Bweb SQL
4621 functions in your Catalog.");
4623 $log->{logtxt} =~ s/\0//g;
4624 $self->display({ lines=> $log->{logtxt},
4625 nbline => $log->{nbline},
4626 jobid => $arg->{jobid},
4627 name => $row->{name},
4628 client => $row->{clientname},
4629 offset => $arg->{offset},
4630 limit => $arg->{limit},
4631 }, 'display_log.tpl');
4634 sub cancel_future_job
4637 $self->can_do('r_cancel_job');
4639 my $arg = $self->get_form(qw/job pool level client when/);
4641 if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4642 or !$arg->{client} or !$arg->{when})
4644 return $self->error("Can't get enough information to mark this job as canceled");
4647 $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4648 my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4650 if ($jobtable =~ /^Job$/i) {
4651 return $self->error("Can add records only in history table");
4653 my $jname = "$arg->{job}.$arg->{when}";
4656 my $found = $self->dbh_selectrow_hashref("
4661 AND Name = '$arg->{job}'
4664 return $self->error("$jname is already in history table");
4668 INSERT INTO $jobtable
4669 (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4670 RealEndTime, ClientId, PoolId)
4672 (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4673 '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4674 (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4675 (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4678 $self->display({ Filter => "Dummy record for $jname",
4682 client => $arg->{client},
4683 jobname => $arg->{job},
4684 pool => $arg->{pool},
4685 level => $arg->{level},
4686 starttime => $arg->{when},
4687 duration => '00:00:00',
4700 $self->can_do('r_media_mgnt');
4701 my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4702 my $b = $self->get_bconsole();
4704 if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4705 CGI::param(offset => 0);
4706 $arg = $self->get_form('db_pools');
4707 $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4708 $self->display($arg, 'add_media.tpl');
4712 $b->send("add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n");
4713 if ($arg->{nb} > 0) {
4714 $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4715 $b->send("$arg->{nb}\n");
4716 $b->send("$arg->{media}\n");
4717 $b->send("$arg->{offset}\n");
4721 $b->send("$arg->{media}\n");
4724 $b->expect_it('-re','^[*]');
4726 CGI::param('media', '');
4727 CGI::param('re_media', $arg->{media});
4728 $self->display_media();
4734 $self->can_do('r_autochanger_mgnt');
4736 my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4738 unless ($arg->{ach}) {
4739 return $self->error("Can't find autochanger name");
4742 my $a = $self->ach_get($arg->{ach});
4744 return $self->error("Can't find autochanger name in configuration");
4747 my $storage = $a->get_drive_name($arg->{drive});
4749 return $self->error("Can't get your drive name");
4755 if ($arg->{slots}) {
4756 $slots = join(",", @{ $arg->{slots} });
4757 $slots_sql = " AND Slot IN ($slots) ";
4758 $t += 60*scalar( @{ $arg->{slots} }) ;
4760 my $pool = $arg->{pool} || 'Scratch';
4761 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4762 print "<h1>This command can take long time, be patient...</h1>";
4764 $b->label_barcodes(storage => $storage,
4765 drive => $arg->{drive},
4773 SET LocationId = (SELECT LocationId
4775 WHERE Location = '$arg->{ach}')
4777 WHERE (LocationId = 0 OR LocationId IS NULL)
4786 $self->can_do('r_purge');
4788 my @volume = CGI::param('media');
4791 return $self->error("Can't get media selection");
4794 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4796 foreach my $v (@volume) {
4798 content => $b->purge_volume($v),
4799 title => "Purge media",
4800 name => "purge volume=$v",
4810 $self->can_do('r_prune');
4812 my @volume = CGI::param('media');
4814 return $self->error("Can't get media selection");
4817 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4819 foreach my $v (@volume) {
4821 content => $b->prune_volume($v),
4822 title => "Prune volume",
4823 name => "prune volume=$v",
4833 $self->can_do('r_cancel_job');
4835 my $arg = $self->get_form('jobid');
4836 unless ($arg->{jobid}) {
4837 return $self->error("Can't get jobid");
4840 my $b = $self->get_bconsole();
4842 content => $b->cancel($arg->{jobid}),
4843 title => "Cancel job",
4844 name => "cancel jobid=$arg->{jobid}",
4851 # Warning, we display current fileset
4854 my $arg = $self->get_form('fileset');
4856 if ($arg->{fileset}) {
4857 my $b = $self->get_bconsole();
4858 my $ret = $b->get_fileset($arg->{fileset});
4859 $self->display({ fileset => $arg->{fileset},
4861 }, "fileset_view.tpl");
4863 $self->error("Can't get fileset name");
4867 sub director_show_sched
4870 $self->can_do('r_view_job');
4871 my $arg = $self->get_form('days');
4873 my $b = $self->get_bconsole();
4874 my $ret = $b->director_get_sched( $arg->{days} );
4879 }, "scheduled_job.tpl");
4882 sub enable_disable_job
4884 my ($self, $what) = @_ ;
4885 $self->can_do('r_run_job');
4887 my $arg = $self->get_form('job');
4889 return $self->error("Can't find job name");
4892 my $b = $self->get_bconsole();
4902 content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4903 title => "$cmd $arg->{job}",
4904 name => "$cmd job=\"$arg->{job}\"",
4912 return new Bconsole(pref => $self->{info});
4918 $self->can_do('r_storage_mgnt');
4919 my $arg = $self->get_form(qw/storage storage_cmd drive slot/);
4920 my $b = $self->get_bconsole();
4922 if ($arg->{storage} and $arg->{storage_cmd}) {
4923 my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive} slot=$arg->{slot}";
4924 my $ret = $b->send_cmd($cmd);
4928 title => "Storage ",
4933 my $storages= [ map { { name => $_ } } $b->list_storage()];
4934 $self->display({ storage => $storages}, "cmd_storage.tpl");
4941 $self->can_do('r_run_job');
4943 my $b = $self->get_bconsole();
4945 my $joblist = [ map { { name => $_ } } $b->list_backup() ];
4947 $self->display({ Jobs => $joblist }, "run_job.tpl");
4952 my ($self, $ouput) = @_;
4955 $self->debug($ouput);
4956 foreach my $l (split(/\r?\n/, $ouput)) {
4958 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4964 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4970 foreach my $k (keys %arg) {
4971 $lowcase{lc($k)} = $arg{$k} ;
4973 $self->debug(\%lowcase);
4980 $self->can_do('r_run_job');
4982 my $b = $self->get_bconsole();
4983 my $arg = $self->get_form(qw/pool level client fileset storage media job/);
4986 return $self->error("Can't get job name");
4989 # we take informations from director, and we overwrite with user wish
4990 my $info = $b->send_cmd("show job=\"$arg->{job}\"");
4991 my $attr = $self->run_parse_job($info);
4993 if (!$arg->{pool} and $arg->{media}) {
4994 my $r = $self->dbh_selectrow_hashref("
4995 SELECT Pool.Name AS name
4996 FROM Media JOIN Pool USING (PoolId)
4997 WHERE Media.VolumeName = '$arg->{media}'
4998 AND Pool.Name != 'Scratch'
5001 $arg->{pool} = $r->{name};
5005 my %job_opt = (%$attr, %$arg);
5007 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
5009 my $pools = [ map { { name => $_ } } $b->list_pool() ];
5010 my $clients = [ map { { name => $_ } }$b->list_client()];
5011 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
5012 my $storages= [ map { { name => $_ } }$b->list_storage()];
5017 clients => $clients,
5018 filesets => $filesets,
5019 storages => $storages,
5021 }, "run_job_mod.tpl");
5027 $self->can_do('r_run_job');
5029 my $b = $self->get_bconsole();
5031 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
5041 $self->can_do('r_run_job');
5043 my $b = $self->get_bconsole();
5045 # TODO: check input (don't use pool, level)
5047 my $arg = $self->get_form(qw/pool level client priority when
5048 fileset job storage/);
5050 return $self->error("Can't get your job name");
5053 my $jobid = $b->run(job => $arg->{job},
5054 client => $arg->{client},
5055 priority => $arg->{priority},
5056 level => $arg->{level},
5057 storage => $arg->{storage},
5058 pool => $arg->{pool},
5059 fileset => $arg->{fileset},
5060 when => $arg->{when},
5065 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>";
5068 sub display_next_job
5072 my $arg = $self->get_form(qw/job begin end/);
5074 return $self->error("Can't get job name");
5077 my $b = $self->get_bconsole();
5079 my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5080 my $attr = $self->run_parse_job($job);
5082 if (!$attr->{schedule}) {
5083 return $self->error("Can't get $arg->{job} schedule");
5085 my $jpool=$attr->{pool} || '';
5087 my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5088 begin => $arg->{begin}, end => $arg->{end});
5090 my $ss = $sched->get_scheds($attr->{schedule});
5093 foreach my $s (@$ss) {
5094 my $level = $sched->get_level($s);
5095 my $pool = $sched->get_pool($s) || $jpool;
5096 my $evt = $sched->get_event($s);
5097 push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5100 print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5103 # permit to verify for higher level backup
5104 # we attempt a Increment, we made a Full, that ok
5105 # TODO: Pool may have change
5106 sub get_higher_level
5108 my ($self, $level) = @_;
5109 if ($level eq 'F') {
5111 } elsif ($level eq 'D') {
5113 } elsif ($level eq 'I') {
5114 return "'F', 'D', 'I'";
5119 # check jobs against their schedule
5122 my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5123 return undef if (!$self->can_view_client($client));
5125 my $sch = $sched->get_scheds($schedname);
5126 return undef if (!$sch);
5129 foreach my $s (@$sch) {
5131 if ($type eq 'B') { # we take the pool only for backup job
5132 $pool = $sched->get_pool($s) || $job_pool;
5134 my $level = $sched->get_level($s);
5135 my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5136 $l = $self->get_higher_level($l);
5137 my $evts = $sched->get_event($s);
5138 my $end = $sched->{end}; # this backup must have start before the next one
5139 foreach my $evt (reverse @$evts) {
5140 my $all = $self->dbh_selectrow_hashref("
5143 JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5144 WHERE Job.StartTime >= '$evt'
5145 AND Job.StartTime < '$end'
5146 AND Job.Name = '$job'
5147 AND Job.Type = '$type'
5148 AND Job.JobStatus IN ('T', 'W')
5149 AND Job.Level IN ($l)
5150 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5151 AND Client.Name = '$client'
5157 push @{$self->{tmp}}, {date => $evt, level => $level,
5158 type => 'Backup', name => $job,
5159 pool => $pool, volume => $pool,
5167 sub display_missing_job
5170 my $arg = $self->get_form(qw/begin end age/);
5172 if (!$arg->{begin}) { # TODO: change this
5173 $arg->{begin} = strftime('%F %T', localtime($btime - $arg->{age}));
5176 $arg->{end} = strftime('%F %T', localtime($btime));
5178 $self->{tmp} = []; # check_job use this for result
5180 my $bconsole = $self->get_bconsole();
5182 my $sched = new Bweb::Sched(bconsole => $bconsole,
5183 begin => $arg->{begin},
5184 end => $arg->{end});
5186 my $job = $bconsole->send_cmd("show job");
5187 my ($jname, $jsched, $jclient, $jpool, $jtype);
5188 foreach my $j (split(/\r?\n/, $job)) {
5189 if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5190 if ($jname and $jsched) {
5191 $self->check_job($sched, $jsched, $jname,
5192 $jpool, $jclient, $jtype);
5196 $jclient = $jpool = $jsched = undef;
5197 } elsif ($j =~ /Client: name=(.+?) address=/i) {
5199 } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5201 } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5207 title => "Missing Jobs (from $arg->{begin} to $arg->{end})",
5208 list => $self->{tmp},
5209 wiki_url => $self->{info}->{wiki_url},
5211 }, "scheduled_job.tpl");
5213 delete $self->{tmp};