1 ################################################################
6 Copyright (C) 2006 Eric Bollengier
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
33 Bweb::Gui - Base package for all Bweb object
37 This package define base fonction like new, display, etc..
42 our $template_dir='/usr/share/bweb/tpl';
47 new - creation a of new Bweb object
51 This function take an hash of argument and place them
54 IE : $obj = new Obj(name => 'test', age => '10');
56 $obj->{name} eq 'test' and $obj->{age} eq 10
62 my ($class, %arg) = @_;
67 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
74 my ($self, $what) = @_;
78 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
80 print "<pre>$what</pre>";
87 error - display an error to the user
91 this function set $self->{error} with arg, display a message with
92 error.tpl and return 0
97 return $self->error("Can't use this file");
104 my ($self, $what) = @_;
105 $self->{error} = $what;
106 $self->display($self, 'error.tpl');
112 display - display an html page with HTML::Template
116 this function is use to render all html codes. it takes an
117 ref hash as arg in which all param are usable in template.
119 it will use global template_dir to search the template file.
121 hash keys are not sensitive. See HTML::Template for more
122 explanations about the hash ref. (it's can be quiet hard to understand)
126 $ref = { name => 'me', age => 26 };
127 $self->display($ref, "people.tpl");
133 my ($self, $hash, $tpl) = @_ ;
135 my $template = HTML::Template->new(filename => $tpl,
136 path =>[$template_dir],
137 die_on_bad_params => 0,
138 case_sensitive => 0);
140 foreach my $var (qw/limit offset/) {
142 unless ($hash->{$var}) {
143 my $value = CGI::param($var) || '';
145 if ($value =~ /^(\d+)$/) {
146 $template->param($var, $1) ;
151 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
152 $template->param('loginname', CGI::remote_user());
154 $template->param($hash);
155 print $template->output();
159 ################################################################
161 package Bweb::Config;
163 use base q/Bweb::Gui/;
167 Bweb::Config - read, write, display, modify configuration
171 this package is used for manage configuration
175 $conf = new Bweb::Config(config_file => '/path/to/conf');
186 =head1 PACKAGE VARIABLE
188 %k_re - hash of all acceptable option.
192 this variable permit to check all option with a regexp.
196 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
197 user => qr/^([\w\d\.-]+)$/i,
198 password => qr/^(.*)$/i,
199 template_dir => qr!^([/\w\d\.-]+)$!,
200 debug => qr/^(on)?$/,
201 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
202 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
203 bconsole => qr!^(.+)?$!,
204 syslog_file => qr!^(.+)?$!,
205 log_dir => qr!^(.+)?$!,
210 load - load config_file
214 this function load the specified config_file.
222 unless (open(FP, $self->{config_file}))
224 return $self->error("$self->{config_file} : $!");
226 my $f=''; my $tmpbuffer;
227 while(read FP,$tmpbuffer,4096)
235 no strict; # I have no idea of the contents of the file
242 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...") ;
245 foreach my $k (keys %$VAR1) {
246 $self->{$k} = $VAR1->{$k};
254 load_old - load old configuration format
262 unless (open(FP, $self->{config_file}))
264 return $self->error("$self->{config_file} : $!");
267 while (my $line = <FP>)
270 my ($k, $v) = split(/\s*=\s*/, $line, 2);
282 save - save the current configuration to config_file
290 if ($self->{ach_list}) {
291 # shortcut for display_begin
292 $self->{achs} = [ map {{ name => $_ }}
293 keys %{$self->{ach_list}}
297 unless (open(FP, ">$self->{config_file}"))
299 return $self->error("$self->{config_file} : $!\n" .
300 "You must add this to your config file\n"
301 . Data::Dumper::Dumper($self));
304 print FP Data::Dumper::Dumper($self);
312 edit, view, modify - html form ouput
320 $self->display($self, "config_edit.tpl");
326 $self->display($self, "config_view.tpl");
336 foreach my $k (CGI::param())
338 next unless (exists $k_re{$k}) ;
339 my $val = CGI::param($k);
340 if ($val =~ $k_re{$k}) {
343 $self->{error} .= "bad parameter : $k = [$val]";
349 if ($self->{error}) { # an error as occured
350 $self->display($self, 'error.tpl');
358 ################################################################
360 package Bweb::Client;
362 use base q/Bweb::Gui/;
366 Bweb::Client - Bacula FD
370 this package is use to do all Client operations like, parse status etc...
374 $client = new Bweb::Client(name => 'zog-fd');
375 $client->status(); # do a 'status client=zog-fd'
381 display_running_job - Html display of a running job
385 this function is used to display information about a current job
389 sub display_running_job
391 my ($self, $conf, $jobid) = @_ ;
393 my $status = $self->status($conf);
396 if ($status->{$jobid}) {
397 $self->display($status->{$jobid}, "client_job_status.tpl");
400 for my $id (keys %$status) {
401 $self->display($status->{$id}, "client_job_status.tpl");
408 $client = new Bweb::Client(name => 'plume-fd');
410 $client->status($bweb);
414 dirty hack to parse "status client=xxx-fd"
418 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
419 Backup Job started: 06-jun-06 17:22
420 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
421 Files Examined=10,697
422 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
428 JobName => Full_plume.2006-06-06_17.22.23,
431 Bytes => 194,484,132,
441 my ($self, $conf) = @_ ;
443 if (defined $self->{cur_jobs}) {
444 return $self->{cur_jobs} ;
448 my $b = new Bconsole(pref => $conf);
449 my $ret = $b->send_cmd("st client=$self->{name}");
453 for my $r (split(/\n/, $ret)) {
455 $r =~ s/(^\s+|\s+$)//g;
456 if ($r =~ /JobId (\d+) Job (\S+)/) {
458 $arg->{$jobid} = { @param, JobId => $jobid } ;
462 @param = ( JobName => $2 );
464 } elsif ($r =~ /=.+=/) {
465 push @param, split(/\s+|\s*=\s*/, $r) ;
467 } elsif ($r =~ /=/) { # one per line
468 push @param, split(/\s*=\s*/, $r) ;
470 } elsif ($r =~ /:/) { # one per line
471 push @param, split(/\s*:\s*/, $r, 2) ;
475 if ($jobid and @param) {
476 $arg->{$jobid} = { @param,
478 Client => $self->{name},
482 $self->{cur_jobs} = $arg ;
488 ################################################################
490 package Bweb::Autochanger;
492 use base q/Bweb::Gui/;
496 Bweb::Autochanger - Object to manage Autochanger
500 this package will parse the mtx output and manage drives.
504 $auto = new Bweb::Autochanger(precmd => 'sudo');
506 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
510 $auto->slot_is_full(10);
511 $auto->transfer(10, 11);
517 my ($class, %arg) = @_;
520 name => '', # autochanger name
521 label => {}, # where are volume { label1 => 40, label2 => drive0 }
522 drive => [], # drive use [ 'media1', 'empty', ..]
523 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
524 io => [], # io slot number list [ 41, 42, 43...]
525 info => {slot => 0, # informations (slot, drive, io)
529 mtxcmd => '/usr/sbin/mtx',
531 device => '/dev/changer',
532 precmd => '', # ssh command
533 bweb => undef, # link to bacula web object (use for display)
536 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
543 status - parse the output of mtx status
547 this function will launch mtx status and parse the output. it will
548 give a perlish view of the autochanger content.
550 it uses ssh if the autochanger is on a other host.
557 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
559 # TODO : reset all infos
560 $self->{info}->{drive} = 0;
561 $self->{info}->{slot} = 0;
562 $self->{info}->{io} = 0;
564 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
567 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
568 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
569 #Data Transfer Element 1:Empty
570 # Storage Element 1:Empty
571 # Storage Element 2:Full :VolumeTag=000002
572 # Storage Element 3:Empty
573 # Storage Element 4:Full :VolumeTag=000004
574 # Storage Element 5:Full :VolumeTag=000001
575 # Storage Element 6:Full :VolumeTag=000003
576 # Storage Element 7:Empty
577 # Storage Element 41 IMPORT/EXPORT:Empty
578 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
583 # Storage Element 7:Empty
584 # Storage Element 2:Full :VolumeTag=000002
585 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
588 $self->set_empty_slot($1);
590 $self->set_slot($1, $4);
593 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
596 $self->set_empty_drive($1);
598 $self->set_drive($1, $4, $6);
601 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
604 $self->set_empty_io($1);
606 $self->set_io($1, $4);
609 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
611 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
612 $self->{info}->{drive} = $1;
613 $self->{info}->{slot} = $2;
614 if ($l =~ /(\d+)\s+Import/) {
615 $self->{info}->{io} = $1 ;
617 $self->{info}->{io} = 0;
622 $self->debug($self) ;
627 my ($self, $slot) = @_;
630 if ($self->{slot}->[$slot] eq 'loaded') {
634 my $label = $self->{slot}->[$slot] ;
636 return $self->is_media_loaded($label);
641 my ($self, $drive, $slot) = @_;
643 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
644 return 0 if ($self->slot_is_full($slot)) ;
646 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
649 my $content = $self->get_slot($slot);
650 print "content = $content<br/> $drive => $slot<br/>";
651 $self->set_empty_drive($drive);
652 $self->set_slot($slot, $content);
655 $self->{error} = $out;
660 # TODO: load/unload have to use mtx script from bacula
663 my ($self, $drive, $slot) = @_;
665 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
666 return 0 unless ($self->slot_is_full($slot)) ;
668 print "Loading drive $drive with slot $slot<br/>\n";
669 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
672 my $content = $self->get_slot($slot);
673 print "content = $content<br/> $slot => $drive<br/>";
674 $self->set_drive($drive, $slot, $content);
677 $self->{error} = $out;
685 my ($self, $media) = @_;
687 unless ($self->{label}->{$media}) {
691 if ($self->{label}->{$media} =~ /drive\d+/) {
701 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
706 my ($self, $slot, $tag) = @_;
707 $self->{slot}->[$slot] = $tag || 'full';
708 push @{ $self->{io} }, $slot;
711 $self->{label}->{$tag} = $slot;
717 my ($self, $slot) = @_;
719 push @{ $self->{io} }, $slot;
721 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
722 $self->{slot}->[$slot] = 'empty';
728 my ($self, $slot) = @_;
729 return $self->{slot}->[$slot];
734 my ($self, $slot, $tag) = @_;
735 $self->{slot}->[$slot] = $tag || 'full';
738 $self->{label}->{$tag} = $slot;
744 my ($self, $slot) = @_;
746 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
747 $self->{slot}->[$slot] = 'empty';
753 my ($self, $drive) = @_;
754 $self->{drive}->[$drive] = 'empty';
759 my ($self, $drive, $slot, $tag) = @_;
760 $self->{drive}->[$drive] = $tag || $slot;
762 $self->{slot}->[$slot] = $tag || 'loaded';
765 $self->{label}->{$tag} = "drive$drive";
771 my ($self, $slot) = @_;
773 # slot don't exists => full
774 if (not defined $self->{slot}->[$slot]) {
778 if ($self->{slot}->[$slot] eq 'empty') {
781 return 1; # vol, full, loaded
784 sub slot_get_first_free
787 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
788 return $slot unless ($self->slot_is_full($slot));
792 sub io_get_first_free
796 foreach my $slot (@{ $self->{io} }) {
797 return $slot unless ($self->slot_is_full($slot));
804 my ($self, $media) = @_;
806 return $self->{label}->{$media} ;
811 my ($self, $media) = @_;
813 return defined $self->{label}->{$media} ;
818 my ($self, $slot) = @_;
820 unless ($self->slot_is_full($slot)) {
821 print "Autochanger $self->{name} slot $slot is empty\n";
826 if ($self->is_slot_loaded($slot)) {
829 print "Autochanger $self->{name} $slot is currently in use\n";
833 # autochanger must have I/O
834 unless ($self->have_io()) {
835 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
839 my $dst = $self->io_get_first_free();
842 print "Autochanger $self->{name} you must empty I/O first\n";
845 $self->transfer($slot, $dst);
850 my ($self, $src, $dst) = @_ ;
851 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
852 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
855 my $content = $self->get_slot($src);
856 print "content = $content<br/> $src => $dst<br/>";
857 $self->{slot}->[$src] = 'empty';
858 $self->set_slot($dst, $content);
861 $self->{error} = $out;
868 my ($self, $index) = @_;
869 return $self->{drive_name}->[$index];
872 # TODO : do a tapeinfo request to get informations
882 for my $slot (@{$self->{io}})
884 if ($self->is_slot_loaded($slot)) {
885 print "$slot is currently loaded\n";
889 if ($self->slot_is_full($slot))
891 my $free = $self->slot_get_first_free() ;
892 print "want to move $slot to $free\n";
895 $self->transfer($slot, $free) || print "$self->{error}\n";
898 $self->{error} = "E : Can't find free slot";
904 # TODO : this is with mtx status output,
905 # we can do an other function from bacula view (with StorageId)
909 my $bweb = $self->{bweb};
911 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
912 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
915 SELECT Media.VolumeName AS volumename,
916 Media.VolStatus AS volstatus,
917 Media.LastWritten AS lastwritten,
918 Media.VolBytes AS volbytes,
919 Media.MediaType AS mediatype,
921 Media.InChanger AS inchanger,
923 $bweb->{sql}->{FROM_UNIXTIME}(
924 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
925 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
928 INNER JOIN Pool USING (PoolId)
930 WHERE Media.VolumeName IN ($media_list)
933 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
935 # TODO : verify slot and bacula slot
939 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
941 if ($self->slot_is_full($slot)) {
943 my $vol = $self->{slot}->[$slot];
944 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
946 my $bslot = $all->{$vol}->{slot} ;
947 my $inchanger = $all->{$vol}->{inchanger};
949 # if bacula slot or inchanger flag is bad, we display a message
950 if ($bslot != $slot or !$inchanger) {
951 push @to_update, $slot;
954 $all->{$vol}->{realslot} = $slot;
955 $all->{$vol}->{volbytes} = Bweb::human_size($all->{$vol}->{volbytes}) ;
957 push @{ $param }, $all->{$vol};
959 } else { # empty or no label
960 push @{ $param }, {realslot => $slot,
961 volstatus => 'Unknow',
962 volumename => $self->{slot}->[$slot]} ;
965 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
969 my $i=0; my $drives = [] ;
970 foreach my $d (@{ $self->{drive} }) {
971 $drives->[$i] = { index => $i,
972 load => $self->{drive}->[$i],
973 name => $self->{drive_name}->[$i],
978 $bweb->display({ Name => $self->{name},
979 nb_drive => $self->{info}->{drive},
980 nb_io => $self->{info}->{io},
983 Update => scalar(@to_update) },
991 ################################################################
995 use base q/Bweb::Gui/;
999 Bweb - main Bweb package
1003 this package is use to compute and display informations
1008 use POSIX qw/strftime/;
1010 our $bpath="/usr/local/bacula";
1011 our $bconsole="$bpath/sbin/bconsole -c $bpath/etc/bconsole.conf";
1017 %sql_func - hash to make query mysql/postgresql compliant
1023 UNIX_TIMESTAMP => '',
1024 FROM_UNIXTIME => '',
1025 TO_SEC => " interval '1 second' * ",
1026 SEC_TO_INT => "SEC_TO_INT",
1031 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1032 FROM_UNIXTIME => 'FROM_UNIXTIME',
1035 SEC_TO_TIME => 'SEC_TO_TIME',
1036 MATCH => " REGEXP ",
1040 sub dbh_selectall_arrayref
1042 my ($self, $query) = @_;
1043 $self->connect_db();
1044 $self->debug($query);
1045 return $self->{dbh}->selectall_arrayref($query);
1050 my ($self, @what) = @_;
1051 return join(',', $self->dbh_quote(@what)) ;
1056 my ($self, @what) = @_;
1058 $self->connect_db();
1060 return map { $self->{dbh}->quote($_) } @what;
1062 return $self->{dbh}->quote($what[0]) ;
1068 my ($self, $query) = @_ ;
1069 $self->connect_db();
1070 $self->debug($query);
1071 return $self->{dbh}->do($query);
1074 sub dbh_selectall_hashref
1076 my ($self, $query, $join) = @_;
1078 $self->connect_db();
1079 $self->debug($query);
1080 return $self->{dbh}->selectall_hashref($query, $join) ;
1083 sub dbh_selectrow_hashref
1085 my ($self, $query) = @_;
1087 $self->connect_db();
1088 $self->debug($query);
1089 return $self->{dbh}->selectrow_hashref($query) ;
1095 my @unit = qw(b Kb Mb Gb Tb);
1096 my $val = shift || 0;
1098 my $format = '%i %s';
1099 while ($val / 1024 > 1) {
1103 $format = ($i>0)?'%0.1f %s':'%i %s';
1104 return sprintf($format, $val, $unit[$i]);
1107 # display Day, Hour, Year
1113 $val /= 60; # sec -> min
1115 if ($val / 60 <= 1) {
1119 $val /= 60; # min -> hour
1120 if ($val / 24 <= 1) {
1121 return "$val hours";
1124 $val /= 24; # hour -> day
1125 if ($val / 365 < 2) {
1129 $val /= 365 ; # day -> year
1131 return "$val years";
1134 # get Day, Hour, Year
1140 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1144 my %times = ( m => 60,
1150 my $mult = $times{$2} || 0;
1160 unless ($self->{dbh}) {
1161 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1162 $self->{info}->{user},
1163 $self->{info}->{password});
1165 print "Can't connect to your database, see error log\n"
1166 unless ($self->{dbh});
1168 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1174 my ($class, %arg) = @_;
1176 dbh => undef, # connect_db();
1178 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1184 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1186 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1187 $self->{sql} = $sql_func{$1};
1190 $self->{debug} = $self->{info}->{debug};
1191 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1199 $self->display($self->{info}, "begin.tpl");
1205 $self->display($self->{info}, "end.tpl");
1213 my $arg = $self->get_form("client", "qre_client");
1215 if ($arg->{qre_client}) {
1216 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1217 } elsif ($arg->{client}) {
1218 $where = "WHERE Name = '$arg->{client}' ";
1222 SELECT Name AS name,
1224 AutoPrune AS autoprune,
1225 FileRetention AS fileretention,
1226 JobRetention AS jobretention
1231 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1233 foreach (values %$all) {
1234 $_->{fileretention} = human_sec($_->{fileretention});
1235 $_->{jobretention} = human_sec($_->{jobretention});
1238 my $dsp = { ID => $cur_id++,
1239 clients => [ values %$all] };
1241 $self->display($dsp, "client_list.tpl") ;
1246 my ($self, %arg) = @_;
1253 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1255 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1257 $self->{sql}->{TO_SEC}($arg{age})
1260 $label = "last " . human_sec($arg{age});
1264 $limit .= " ORDER BY $arg{order} ";
1268 $limit .= " LIMIT $arg{limit} ";
1269 $label .= " limited to $arg{limit}";
1273 $limit .= " OFFSET $arg{offset} ";
1274 $label .= " with $arg{offset} offset ";
1278 $label = 'no filter';
1281 return ($limit, $label);
1286 $bweb->get_form(...) - Get useful stuff
1290 This function get and check parameters against regexp.
1292 If word begin with 'q', the return will be quoted or join quoted
1293 if it's end with 's'.
1298 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1301 qclient => 'plume-fd',
1302 qpools => "'plume-fd', 'test-fd', '...'",
1309 my ($self, @what) = @_;
1310 my %what = map { $_ => 1 } @what;
1327 my %opt_s = ( # default to ''
1337 my %opt_p = ( # option with path
1343 foreach my $i (@what) {
1344 if (exists $opt_i{$i}) {# integer param
1345 my $value = CGI::param($i) || $opt_i{$i} ;
1346 if ($value =~ /^(\d+)$/) {
1349 } elsif ($opt_s{$i}) { # simple string param
1350 my $value = CGI::param($i) || '';
1351 if ($value =~ /^([\w\d\.-]+)$/) {
1355 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1356 my @value = CGI::param($1) ;
1358 $ret{$i} = $self->dbh_join(@value) ;
1361 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1362 my $value = CGI::param($1) ;
1364 $ret{$i} = $self->dbh_quote($value);
1367 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1368 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1370 } elsif (exists $opt_p{$i}) {
1371 my $value = CGI::param($i) || '';
1372 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1379 foreach my $s (CGI::param('slot')) {
1380 if ($s =~ /^(\d+)$/) {
1381 push @{$ret{slots}}, $s;
1386 if ($what{db_clients}) {
1388 SELECT Client.Name as clientname
1392 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1393 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1397 if ($what{db_mediatypes}) {
1399 SELECT MediaType as mediatype
1403 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1404 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1408 if ($what{db_locations}) {
1410 SELECT Location as location, Cost as cost FROM Location
1412 my $loc = $self->dbh_selectall_hashref($query, 'location');
1413 $ret{db_locations} = [ sort { $a->{location}
1419 if ($what{db_pools}) {
1420 my $query = "SELECT Name as name FROM Pool";
1422 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1423 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1426 if ($what{db_filesets}) {
1428 SELECT FileSet.FileSet AS fileset
1432 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1434 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1435 values %$filesets] ;
1439 if ($what{db_jobnames}) {
1441 SELECT DISTINCT Job.Name AS jobname
1445 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1447 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1448 values %$jobnames] ;
1452 if ($what{db_devices}) {
1454 SELECT Device.Name AS name
1458 my $devices = $self->dbh_selectall_hashref($query, 'name');
1460 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1472 my $fields = $self->get_form(qw/age level status clients filesets
1473 db_clients limit db_filesets width height
1474 qclients qfilesets qjobnames db_jobnames/);
1477 my $url = CGI::url(-full => 0,
1480 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1482 my $type = CGI::param('graph') || '';
1483 if ($type =~ /^(\w+)$/) {
1484 $fields->{graph} = $1;
1487 my $gtype = CGI::param('gtype') || '';
1488 if ($gtype =~ /^(\w+)$/) {
1489 $fields->{gtype} = $1;
1492 # this organisation is to keep user choice between 2 click
1493 # TODO : fileset and client selection doesn't work
1502 sub display_client_job
1504 my ($self, %arg) = @_ ;
1506 $arg{order} = ' Job.JobId DESC ';
1507 my ($limit, $label) = $self->get_limit(%arg);
1509 my $clientname = $self->dbh_quote($arg{clientname});
1512 SELECT DISTINCT Job.JobId AS jobid,
1513 Job.Name AS jobname,
1514 FileSet.FileSet AS fileset,
1516 StartTime AS starttime,
1517 JobFiles AS jobfiles,
1518 JobBytes AS jobbytes,
1519 JobStatus AS jobstatus,
1520 JobErrors AS joberrors
1522 FROM Client,Job,FileSet
1523 WHERE Client.Name=$clientname
1524 AND Client.ClientId=Job.ClientId
1525 AND Job.FileSetId=FileSet.FileSetId
1529 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1531 foreach (values %$all) {
1532 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1535 $self->display({ clientname => $arg{clientname},
1538 Jobs => [ values %$all ],
1540 "display_client_job.tpl") ;
1543 sub get_selected_media_location
1547 my $medias = $self->get_form('jmedias');
1549 unless ($medias->{jmedias}) {
1554 SELECT Media.VolumeName AS volumename, Location.Location AS location
1555 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1556 WHERE Media.VolumeName IN ($medias->{jmedias})
1559 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1561 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1572 my $medias = $self->get_selected_media_location();
1578 my $elt = $self->get_form('db_locations');
1580 $self->display({ ID => $cur_id++,
1581 %$elt, # db_locations
1583 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1593 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1595 $self->display($elt, "help_extern.tpl");
1598 sub help_extern_compute
1602 my $number = CGI::param('limit') || '' ;
1603 unless ($number =~ /^(\d+)$/) {
1604 return $self->error("Bad arg number : $number ");
1607 my ($sql, undef) = $self->get_param('pools',
1608 'locations', 'mediatypes');
1611 SELECT Media.VolumeName AS volumename,
1612 Media.VolStatus AS volstatus,
1613 Media.LastWritten AS lastwritten,
1614 Media.MediaType AS mediatype,
1615 Media.VolMounts AS volmounts,
1617 Media.Recycle AS recycle,
1618 $self->{sql}->{FROM_UNIXTIME}(
1619 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1620 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1623 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1624 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1626 WHERE Media.InChanger = 1
1627 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1629 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1633 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1635 $self->display({ Medias => [ values %$all ] },
1636 "help_extern_compute.tpl");
1643 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1644 $self->display($param, "help_intern.tpl");
1647 sub help_intern_compute
1651 my $number = CGI::param('limit') || '' ;
1652 unless ($number =~ /^(\d+)$/) {
1653 return $self->error("Bad arg number : $number ");
1656 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1658 if (CGI::param('expired')) {
1660 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1661 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1667 SELECT Media.VolumeName AS volumename,
1668 Media.VolStatus AS volstatus,
1669 Media.LastWritten AS lastwritten,
1670 Media.MediaType AS mediatype,
1671 Media.VolMounts AS volmounts,
1673 $self->{sql}->{FROM_UNIXTIME}(
1674 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1675 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1678 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1679 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1681 WHERE Media.InChanger <> 1
1682 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1683 AND Media.Recycle = 1
1685 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1689 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1691 $self->display({ Medias => [ values %$all ] },
1692 "help_intern_compute.tpl");
1698 my ($self, %arg) = @_ ;
1700 my ($limit, $label) = $self->get_limit(%arg);
1704 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1705 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1706 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1707 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1708 (SELECT count(Job.JobId)
1710 WHERE Job.JobStatus IN ('E','e','f','A')
1713 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1716 my $row = $self->dbh_selectrow_hashref($query) ;
1718 $row->{nb_bytes} = human_size($row->{nb_bytes});
1720 $row->{db_size} = '???';
1721 $row->{label} = $label;
1723 $self->display($row, "general.tpl");
1728 my ($self, @what) = @_ ;
1729 my %elt = map { $_ => 1 } @what;
1734 if ($elt{clients}) {
1735 my @clients = CGI::param('client');
1737 $ret{clients} = \@clients;
1738 my $str = $self->dbh_join(@clients);
1739 $limit .= "AND Client.Name IN ($str) ";
1743 if ($elt{filesets}) {
1744 my @filesets = CGI::param('fileset');
1746 $ret{filesets} = \@filesets;
1747 my $str = $self->dbh_join(@filesets);
1748 $limit .= "AND FileSet.FileSet IN ($str) ";
1752 if ($elt{mediatypes}) {
1753 my @medias = CGI::param('mediatype');
1755 $ret{mediatypes} = \@medias;
1756 my $str = $self->dbh_join(@medias);
1757 $limit .= "AND Media.MediaType IN ($str) ";
1762 my $client = CGI::param('client');
1763 $ret{client} = $client;
1764 $client = $self->dbh_join($client);
1765 $limit .= "AND Client.Name = $client ";
1769 my $level = CGI::param('level') || '';
1770 if ($level =~ /^(\w)$/) {
1772 $limit .= "AND Job.Level = '$1' ";
1777 my $jobid = CGI::param('jobid') || '';
1779 if ($jobid =~ /^(\d+)$/) {
1781 $limit .= "AND Job.JobId = '$1' ";
1786 my $status = CGI::param('status') || '';
1787 if ($status =~ /^(\w)$/) {
1789 $limit .= "AND Job.JobStatus = '$1' ";
1793 if ($elt{locations}) {
1794 my @location = CGI::param('location') ;
1796 $ret{locations} = \@location;
1797 my $str = $self->dbh_join(@location);
1798 $limit .= "AND Location.Location IN ($str) ";
1803 my @pool = CGI::param('pool') ;
1805 $ret{pools} = \@pool;
1806 my $str = $self->dbh_join(@pool);
1807 $limit .= "AND Pool.Name IN ($str) ";
1811 if ($elt{location}) {
1812 my $location = CGI::param('location') || '';
1814 $ret{location} = $location;
1815 $location = $self->dbh_quote($location);
1816 $limit .= "AND Location.Location = $location ";
1821 my $pool = CGI::param('pool') || '';
1824 $pool = $self->dbh_quote($pool);
1825 $limit .= "AND Pool.Name = $pool ";
1829 if ($elt{jobtype}) {
1830 my $jobtype = CGI::param('jobtype') || '';
1831 if ($jobtype =~ /^(\w)$/) {
1833 $limit .= "AND Job.Type = '$1' ";
1837 return ($limit, %ret);
1844 SELECT DISTINCT Job.JobId AS jobid,
1845 Client.Name AS client,
1846 FileSet.FileSet AS fileset,
1847 Job.Name AS jobname,
1849 StartTime AS starttime,
1850 JobFiles AS jobfiles,
1851 JobBytes AS jobbytes,
1852 VolumeName AS volumename,
1853 JobStatus AS jobstatus,
1854 JobErrors AS joberrors
1856 FROM Client,Job,JobMedia,Media,FileSet
1857 WHERE Client.ClientId=Job.ClientId
1858 AND Job.FileSetId=FileSet.FileSetId
1859 AND JobMedia.JobId=Job.JobId
1860 AND JobMedia.MediaId=Media.MediaId
1867 my ($self, %arg) = @_ ;
1869 $arg{order} = ' Job.JobId DESC ';
1871 my ($limit, $label) = $self->get_limit(%arg);
1872 my ($where, undef) = $self->get_param('clients',
1880 SELECT Job.JobId AS jobid,
1881 Client.Name AS client,
1882 FileSet.FileSet AS fileset,
1883 Job.Name AS jobname,
1885 StartTime AS starttime,
1886 Pool.Name AS poolname,
1887 JobFiles AS jobfiles,
1888 JobBytes AS jobbytes,
1889 JobStatus AS jobstatus,
1890 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1891 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1894 JobErrors AS joberrors
1897 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1898 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1899 WHERE Client.ClientId=Job.ClientId
1900 AND Job.JobStatus != 'R'
1905 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1907 foreach (values %$all) {
1908 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1911 $self->display({ Filter => $label,
1915 sort { $a->{jobid} <=> $b->{jobid} }
1922 # display job informations
1923 sub display_job_zoom
1925 my ($self, $jobid) = @_ ;
1927 $jobid = $self->dbh_quote($jobid);
1930 SELECT DISTINCT Job.JobId AS jobid,
1931 Client.Name AS client,
1932 Job.Name AS jobname,
1933 FileSet.FileSet AS fileset,
1935 Pool.Name AS poolname,
1936 StartTime AS starttime,
1937 JobFiles AS jobfiles,
1938 JobBytes AS jobbytes,
1939 JobStatus AS jobstatus,
1940 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1941 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1944 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1945 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1946 WHERE Client.ClientId=Job.ClientId
1947 AND Job.JobId = $jobid
1950 my $row = $self->dbh_selectrow_hashref($query) ;
1952 $row->{jobbytes} = human_size($row->{jobbytes}) ;
1954 # display all volumes associate with this job
1956 SELECT Media.VolumeName as volumename
1957 FROM Job,Media,JobMedia
1958 WHERE Job.JobId = $jobid
1959 AND JobMedia.JobId=Job.JobId
1960 AND JobMedia.MediaId=Media.MediaId
1963 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1965 $row->{volumes} = [ values %$all ] ;
1967 $self->display($row, "display_job_zoom.tpl");
1974 my ($where, %elt) = $self->get_param('pool',
1977 my $arg = $self->get_form('jmedias', 'qre_media');
1979 if ($arg->{jmedias}) {
1980 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1982 if ($arg->{qre_media}) {
1983 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1987 SELECT Media.VolumeName AS volumename,
1988 Media.VolBytes AS volbytes,
1989 Media.VolStatus AS volstatus,
1990 Media.MediaType AS mediatype,
1991 Media.InChanger AS online,
1992 Media.LastWritten AS lastwritten,
1993 Location.Location AS location,
1994 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1995 Pool.Name AS poolname,
1996 $self->{sql}->{FROM_UNIXTIME}(
1997 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1998 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2001 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2002 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2003 Media.MediaType AS MediaType
2005 WHERE Media.VolStatus = 'Full'
2006 GROUP BY Media.MediaType
2007 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2009 WHERE Media.PoolId=Pool.PoolId
2013 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2014 foreach (values %$all) {
2015 $_->{volbytes} = human_size($_->{volbytes}) ;
2018 $self->display({ ID => $cur_id++,
2020 Location => $elt{location},
2021 Medias => [ values %$all ]
2023 "display_media.tpl");
2030 my $pool = $self->get_form('db_pools');
2032 foreach my $name (@{ $pool->{db_pools} }) {
2033 CGI::param('pool', $name->{name});
2034 $self->display_media();
2038 sub display_media_zoom
2042 my $medias = $self->get_form('jmedias');
2044 unless ($medias->{jmedias}) {
2045 return $self->error("Can't get media selection");
2049 SELECT InChanger AS online,
2050 VolBytes AS nb_bytes,
2051 VolumeName AS volumename,
2052 VolStatus AS volstatus,
2053 VolMounts AS nb_mounts,
2054 Media.VolUseDuration AS voluseduration,
2055 Media.MaxVolJobs AS maxvoljobs,
2056 Media.MaxVolFiles AS maxvolfiles,
2057 Media.MaxVolBytes AS maxvolbytes,
2058 VolErrors AS nb_errors,
2059 Pool.Name AS poolname,
2060 Location.Location AS location,
2061 Media.Recycle AS recycle,
2062 Media.VolRetention AS volretention,
2063 Media.LastWritten AS lastwritten,
2064 Media.VolReadTime/1000000 AS volreadtime,
2065 Media.VolWriteTime/1000000 AS volwritetime,
2066 $self->{sql}->{FROM_UNIXTIME}(
2067 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2068 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2071 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2072 WHERE Pool.PoolId = Media.PoolId
2073 AND VolumeName IN ($medias->{jmedias})
2076 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2078 foreach my $media (values %$all) {
2079 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
2080 $media->{voluseduration} = human_sec($media->{voluseduration});
2081 $media->{volretention} = human_sec($media->{volretention});
2082 $media->{volreadtime} = human_sec($media->{volreadtime});
2083 $media->{volwritetime} = human_sec($media->{volwritetime});
2084 my $mq = $self->dbh_quote($media->{volumename});
2087 SELECT DISTINCT Job.JobId AS jobid,
2089 Job.StartTime AS starttime,
2092 Job.JobFiles AS files,
2093 Job.JobBytes AS bytes,
2094 Job.jobstatus AS status
2095 FROM Media,JobMedia,Job
2096 WHERE Media.VolumeName=$mq
2097 AND Media.MediaId=JobMedia.MediaId
2098 AND JobMedia.JobId=Job.JobId
2101 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2103 foreach (values %$jobs) {
2104 $_->{bytes} = human_size($_->{bytes}) ;
2107 $self->display({ jobs => [ values %$jobs ],
2109 "display_media_zoom.tpl");
2117 my $loc = $self->get_form('qlocation');
2118 unless ($loc->{qlocation}) {
2119 return $self->error("Can't get location");
2123 SELECT Location.Location AS location,
2124 Location.Cost AS cost,
2125 Location.Enabled AS enabled
2127 WHERE Location.Location = $loc->{qlocation}
2130 my $row = $self->dbh_selectrow_hashref($query);
2132 $self->display({ ID => $cur_id++,
2133 %$row }, "location_edit.tpl") ;
2141 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2142 unless ($arg->{qlocation}) {
2143 return $self->error("Can't get location");
2145 unless ($arg->{qnewlocation}) {
2146 return $self->error("Can't get new location name");
2148 unless ($arg->{cost}) {
2149 return $self->error("Can't get new cost");
2152 my $enabled = CGI::param('enabled') || '';
2153 $enabled = $enabled?1:0;
2156 UPDATE Location SET Cost = $arg->{cost},
2157 Location = $arg->{qnewlocation},
2159 WHERE Location.Location = $arg->{qlocation}
2162 $self->dbh_do($query);
2164 $self->display_location();
2170 my $arg = $self->get_form(qw/qlocation cost/) ;
2172 unless ($arg->{qlocation}) {
2173 $self->display({}, "location_add.tpl");
2176 unless ($arg->{cost}) {
2177 return $self->error("Can't get new cost");
2180 my $enabled = CGI::param('enabled') || '';
2181 $enabled = $enabled?1:0;
2184 INSERT INTO Location (Location, Cost, Enabled)
2185 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2188 $self->dbh_do($query);
2190 $self->display_location();
2193 sub display_location
2198 SELECT Location.Location AS location,
2199 Location.Cost AS cost,
2200 Location.Enabled AS enabled,
2201 (SELECT count(Media.MediaId)
2203 WHERE Media.LocationId = Location.LocationId
2208 my $location = $self->dbh_selectall_hashref($query, 'location');
2210 $self->display({ ID => $cur_id++,
2211 Locations => [ values %$location ] },
2212 "display_location.tpl");
2219 my $medias = $self->get_selected_media_location();
2224 my $arg = $self->get_form('db_locations', 'qnewlocation');
2226 $self->display({ email => $self->{info}->{email_media},
2228 medias => [ values %$medias ],
2230 "update_location.tpl");
2233 sub get_media_max_size
2235 my ($self, $type) = @_;
2237 "SELECT avg(VolBytes) AS size
2239 WHERE Media.VolStatus = 'Full'
2240 AND Media.MediaType = '$type'
2243 my $res = $self->selectrow_hashref($query);
2246 return $res->{size};
2256 my $media = CGI::param('media');
2258 return $self->error("Can't find media selection");
2261 $media = $self->dbh_quote($media);
2265 my $volstatus = CGI::param('volstatus') || '';
2266 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2267 $update .= " VolStatus=$volstatus, ";
2269 my $inchanger = CGI::param('inchanger') || '';
2271 $update .= " InChanger=1, " ;
2272 my $slot = CGI::param('slot') || '';
2273 if ($slot =~ /^(\d+)$/) {
2274 $update .= " Slot=$1, ";
2276 $update .= " Slot=0, ";
2279 $update = " Slot=0, InChanger=0, ";
2282 my $pool = CGI::param('pool') || '';
2283 $pool = $self->dbh_quote($pool); # is checked by db
2284 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2286 my $volretention = CGI::param('volretention') || '';
2287 $volretention = from_human_sec($volretention);
2288 unless ($volretention) {
2289 return $self->error("Can't get volume retention");
2292 $update .= " VolRetention = $volretention, ";
2294 my $loc = CGI::param('location') || '';
2295 $loc = $self->dbh_quote($loc); # is checked by db
2296 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2298 my $usedu = CGI::param('voluseduration') || '0';
2299 $usedu = from_human_sec($usedu);
2300 $update .= " VolUseDuration=$usedu, ";
2302 my $maxj = CGI::param('maxvoljobs') || '0';
2303 unless ($maxj =~ /^(\d+)$/) {
2304 return $self->error("Can't get max jobs");
2306 $update .= " MaxVolJobs=$1, " ;
2308 my $maxf = CGI::param('maxvolfiles') || '0';
2309 unless ($maxj =~ /^(\d+)$/) {
2310 return $self->error("Can't get max files");
2312 $update .= " MaxVolFiles=$1, " ;
2314 my $maxb = CGI::param('maxvolbytes') || '0';
2315 unless ($maxb =~ /^(\d+)$/) {
2316 return $self->error("Can't get max bytes");
2318 $update .= " MaxVolBytes=$1 " ;
2320 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2323 print "Update Ok\n";
2324 $self->update_media();
2332 my $media = $self->get_form('qmedia');
2334 unless ($media->{qmedia}) {
2335 return $self->error("Can't get media");
2339 SELECT Media.Slot AS slot,
2340 Pool.Name AS poolname,
2341 Media.VolStatus AS volstatus,
2342 Media.InChanger AS inchanger,
2343 Location.Location AS location,
2344 Media.VolumeName AS volumename,
2345 Media.MaxVolBytes AS maxvolbytes,
2346 Media.MaxVolJobs AS maxvoljobs,
2347 Media.MaxVolFiles AS maxvolfiles,
2348 Media.VolUseDuration AS voluseduration,
2349 Media.VolRetention AS volretention
2351 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2352 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2354 WHERE Media.VolumeName = $media->{qmedia}
2357 my $row = $self->dbh_selectrow_hashref($query);
2358 $row->{volretention} = human_sec($row->{volretention});
2359 $row->{voluseduration} = human_sec($row->{voluseduration});
2361 my $elt = $self->get_form(qw/db_pools db_locations/);
2367 "update_media.tpl");
2374 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2376 unless ($arg->{jmedias}) {
2377 return $self->error("Can't get selected media");
2380 unless ($arg->{qnewlocation}) {
2381 return $self->error("Can't get new location");
2386 SET LocationId = (SELECT LocationId
2388 WHERE Location = $arg->{qnewlocation})
2389 WHERE Media.VolumeName IN ($arg->{jmedias})
2392 my $nb = $self->dbh_do($query);
2394 print "$nb media updated";
2401 my $medias = $self->get_selected_media_location();
2403 return $self->error("Can't get media selection");
2405 my $newloc = CGI::param('newlocation');
2407 my $user = CGI::param('user') || 'unknow';
2408 my $comm = CGI::param('comment') || '';
2409 $comm = $self->dbh_quote("$user: $comm");
2413 foreach my $media (keys %$medias) {
2415 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2417 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2418 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2419 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2422 $self->dbh_do($query);
2423 $self->debug($query);
2427 $q->param('action', 'update_location');
2428 my $url = $q->url(-full => 1, -query=>1);
2430 $self->display({ email => $self->{info}->{email_media},
2432 newlocation => $newloc,
2433 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2434 medias => [ values %$medias ],
2436 "change_location.tpl");
2440 sub display_client_stats
2442 my ($self, %arg) = @_ ;
2444 my $client = $self->dbh_quote($arg{clientname});
2445 my ($limit, $label) = $self->get_limit(%arg);
2449 count(Job.JobId) AS nb_jobs,
2450 sum(Job.JobBytes) AS nb_bytes,
2451 sum(Job.JobErrors) AS nb_err,
2452 sum(Job.JobFiles) AS nb_files,
2453 Client.Name AS clientname
2454 FROM Job INNER JOIN Client USING (ClientId)
2456 Client.Name = $client
2458 GROUP BY Client.Name
2461 my $row = $self->dbh_selectrow_hashref($query);
2463 $row->{ID} = $cur_id++;
2464 $row->{label} = $label;
2465 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2467 $self->display($row, "display_client_stats.tpl");
2470 # poolname can be undef
2473 my ($self, $poolname) = @_ ;
2475 # TODO : afficher les tailles et les dates
2478 SELECT sum(subq.volmax) AS volmax,
2479 sum(subq.volnum) AS volnum,
2480 sum(subq.voltotal) AS voltotal,
2482 Pool.Recycle AS recycle,
2483 Pool.VolRetention AS volretention,
2484 Pool.VolUseDuration AS voluseduration,
2485 Pool.MaxVolJobs AS maxvoljobs,
2486 Pool.MaxVolFiles AS maxvolfiles,
2487 Pool.MaxVolBytes AS maxvolbytes,
2488 subq.PoolId AS PoolId
2491 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2492 count(Media.MediaId) AS volnum,
2493 sum(Media.VolBytes) AS voltotal,
2494 Media.PoolId AS PoolId,
2495 Media.MediaType AS MediaType
2497 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2498 Media.MediaType AS MediaType
2500 WHERE Media.VolStatus = 'Full'
2501 GROUP BY Media.MediaType
2502 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2503 GROUP BY Media.MediaType, Media.PoolId
2505 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2506 GROUP BY subq.PoolId
2509 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2511 foreach my $p (values %$all) {
2512 $p->{maxvolbytes} = human_size($p->{maxvolbytes}) ;
2513 $p->{volretention} = human_sec($p->{volretention}) ;
2514 $p->{voluseduration} = human_sec($p->{voluseduration}) ;
2517 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2519 $p->{poolusage} = 0;
2523 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2525 WHERE PoolId=$p->{poolid}
2528 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2529 foreach my $t (values %$content) {
2530 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2535 $self->display({ ID => $cur_id++,
2536 Pools => [ values %$all ]},
2537 "display_pool.tpl");
2540 sub display_running_job
2544 my $arg = $self->get_form('client', 'jobid');
2546 if (!$arg->{client} and $arg->{jobid}) {
2549 SELECT Client.Name AS name
2550 FROM Job INNER JOIN Client USING (ClientId)
2551 WHERE Job.JobId = $arg->{jobid}
2554 my $row = $self->dbh_selectrow_hashref($query);
2557 $arg->{client} = $row->{name};
2558 CGI::param('client', $arg->{client});
2562 if ($arg->{client}) {
2563 my $cli = new Bweb::Client(name => $arg->{client});
2564 $cli->display_running_job($self->{info}, $arg->{jobid});
2565 if ($arg->{jobid}) {
2566 $self->get_job_log();
2569 $self->error("Can't get client or jobid");
2573 sub display_running_jobs
2575 my ($self, $display_action) = @_;
2578 SELECT Job.JobId AS jobid,
2579 Job.Name AS jobname,
2581 Job.StartTime AS starttime,
2582 Job.JobFiles AS jobfiles,
2583 Job.JobBytes AS jobbytes,
2584 Job.JobStatus AS jobstatus,
2585 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2586 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2588 Client.Name AS clientname
2589 FROM Job INNER JOIN Client USING (ClientId)
2590 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2592 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2594 $self->display({ ID => $cur_id++,
2595 display_action => $display_action,
2596 Jobs => [ values %$all ]},
2597 "running_job.tpl") ;
2603 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2605 unless ($arg->{jmedias}) {
2606 return $self->error("Can't get media selection");
2609 my $a = $self->ach_get($arg->{ach});
2615 SELECT Media.VolumeName AS volumename,
2616 Storage.Name AS storage,
2617 Location.Location AS location,
2619 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2620 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2621 WHERE Media.VolumeName IN ($arg->{jmedias})
2622 AND Media.InChanger = 1
2625 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2629 foreach my $vol (values %$all) {
2630 print "eject $vol->{volumename} from $vol->{storage} : ";
2631 if ($a->send_to_io($vol->{slot})) {
2643 my $arg = $self->get_form('jobid', 'client');
2645 print CGI::header('text/brestore');
2646 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2647 print "client=$arg->{client}\n" if ($arg->{client});
2648 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2652 # TODO : move this to Bweb::Autochanger ?
2653 # TODO : make this internal to not eject tape ?
2659 my ($self, $name) = @_;
2662 return $self->error("Can't get your autochanger name ach");
2665 unless ($self->{info}->{ach_list}) {
2666 return $self->error("Could not find any autochanger");
2669 my $a = $self->{info}->{ach_list}->{$name};
2672 $self->error("Can't get your autochanger $name from your ach_list");
2683 my ($self, $ach) = @_;
2685 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2687 $self->{info}->save();
2695 my $arg = $self->get_form('ach');
2697 or !$self->{info}->{ach_list}
2698 or !$self->{info}->{ach_list}->{$arg->{ach}})
2700 return $self->error("Can't get autochanger name");
2703 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2707 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2709 my $b = new Bconsole(pref => $self->{info});
2710 my @storages = $b->list_storage() ;
2712 $ach->{devices} = [ map { { name => $_ } } @storages ];
2714 $self->display($ach, "ach_add.tpl");
2715 delete $ach->{drives};
2716 delete $ach->{devices};
2723 my $arg = $self->get_form('ach');
2726 or !$self->{info}->{ach_list}
2727 or !$self->{info}->{ach_list}->{$arg->{ach}})
2729 return $self->error("Can't get autochanger name");
2732 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2734 $self->{info}->save();
2735 $self->{info}->view();
2741 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2743 my $b = new Bconsole(pref => $self->{info});
2744 my @storages = $b->list_storage() ;
2746 unless ($arg->{ach}) {
2747 $arg->{devices} = [ map { { name => $_ } } @storages ];
2748 return $self->display($arg, "ach_add.tpl");
2752 foreach my $drive (CGI::param('drives'))
2754 unless (grep(/^$drive$/,@storages)) {
2755 return $self->error("Can't find $drive in storage list");
2758 my $index = CGI::param("index_$drive");
2759 unless (defined $index and $index =~ /^(\d+)$/) {
2760 return $self->error("Can't get $drive index");
2763 $drives[$index] = $drive;
2767 return $self->error("Can't get drives from Autochanger");
2770 my $a = new Bweb::Autochanger(name => $arg->{ach},
2771 precmd => $arg->{precmd},
2772 drive_name => \@drives,
2773 device => $arg->{device},
2774 mtxcmd => $arg->{mtxcmd});
2776 $self->ach_register($a) ;
2778 $self->{info}->view();
2784 my $arg = $self->get_form('jobid');
2786 my $b = new Bconsole(pref => $self->{info});
2788 if ($arg->{jobid}) {
2789 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2791 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2792 title => "Delete a job ",
2793 name => "delete jobid=$arg->{jobid}",
2802 my $ach = CGI::param('ach') ;
2803 unless ($ach =~ /^([\w\d\.-]+)$/) {
2804 return $self->error("Bad autochanger name");
2807 my $b = new Bconsole(pref => $self->{info});
2808 print "<pre>" . $b->update_slots($ach) . "</pre>";
2815 my $arg = $self->get_form('jobid');
2816 unless ($arg->{jobid}) {
2817 return $self->error("Can't get jobid");
2820 my $t = CGI::param('time') || '';
2823 SELECT Job.Name as name, Client.Name as clientname
2824 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2825 WHERE JobId = $arg->{jobid}
2828 my $row = $self->dbh_selectrow_hashref($query);
2831 return $self->error("Can't find $arg->{jobid} in catalog");
2835 SELECT Time AS time, LogText AS log
2837 WHERE JobId = $arg->{jobid}
2840 my $log = $self->dbh_selectall_arrayref($query);
2842 return $self->error("Can't get log for jobid $arg->{jobid}");
2848 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2850 $logtxt = join("", map { $_->[1] } @$log ) ;
2853 $self->display({ lines=> $logtxt,
2854 jobid => $arg->{jobid},
2855 name => $row->{name},
2856 client => $row->{clientname},
2857 }, 'display_log.tpl');
2865 my $arg = $self->get_form('ach', 'slots', 'drive');
2867 unless ($arg->{ach}) {
2868 return $self->error("Can't find autochanger name");
2873 if ($arg->{slots}) {
2874 $slots = join(",", @{ $arg->{slots} });
2875 $t += 60*scalar( @{ $arg->{slots} }) ;
2878 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2879 print "<h1>This command can take long time, be patient...</h1>";
2881 $b->label_barcodes(storage => $arg->{ach},
2882 drive => $arg->{drive},
2892 my @volume = CGI::param('media');
2894 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2897 content => $b->purge_volume(@volume),
2898 title => "Purge media",
2899 name => "purge volume=" . join(' volume=', @volume),
2907 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2909 my @volume = CGI::param('media');
2911 content => $b->prune_volume(@volume),
2912 title => "Prune media",
2913 name => "prune volume=" . join(' volume=', @volume),
2921 my $arg = $self->get_form('jobid');
2922 unless ($arg->{jobid}) {
2923 return $self->error('Bad jobid');
2926 my $b = new Bconsole(pref => $self->{info});
2928 content => $b->cancel($arg->{jobid}),
2929 title => "Cancel job",
2930 name => "cancel jobid=$arg->{jobid}",
2934 sub director_show_sched
2938 my $arg = $self->get_form('days');
2940 my $b = new Bconsole(pref => $self->{info}) ;
2942 my $ret = $b->director_get_sched( $arg->{days} );
2947 }, "scheduled_job.tpl");
2950 sub enable_disable_job
2952 my ($self, $what) = @_ ;
2954 my $name = CGI::param('job') || '';
2955 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2956 return $self->error("Can't find job name");
2959 my $b = new Bconsole(pref => $self->{info}) ;
2969 content => $b->send_cmd("$cmd job=\"$name\""),
2970 title => "$cmd $name",
2971 name => "$cmd job=\"$name\"",
2978 $b = new Bconsole(pref => $self->{info});
2980 my $joblist = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".job")) ];
2982 $self->display({ Jobs => $joblist }, "run_job.tpl");
2987 my ($self, $ouput) = @_;
2990 foreach my $l (split(/\r\n/, $ouput)) {
2991 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
2997 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3003 foreach my $k (keys %arg) {
3004 $lowcase{lc($k)} = $arg{$k} ;
3013 $b = new Bconsole(pref => $self->{info});
3015 my $job = CGI::param('job') || '';
3017 my $info = $b->send_cmd("show job=\"$job\"");
3018 my $attr = $self->run_parse_job($info);
3020 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
3022 my $pools = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".pool")) ];
3023 my $clients = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".client")) ];
3024 my $filesets= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".fileset")) ];
3025 my $storages= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".storage")) ];
3030 clients => $clients,
3031 filesets => $filesets,
3032 storages => $storages,
3034 }, "run_job_mod.tpl");
3040 $b = new Bconsole(pref => $self->{info});
3042 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
3052 $b = new Bconsole(pref => $self->{info});
3054 # TODO: check input (don't use pool, level)
3056 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3057 my $job = CGI::param('job') || '';
3058 my $storage = CGI::param('storage') || '';
3060 my $jobid = $b->run(job => $job,
3061 client => $arg->{client},
3062 priority => $arg->{priority},
3063 level => $arg->{level},
3064 storage => $storage,
3065 pool => $arg->{pool},
3068 print $jobid, $b->{error};
3070 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";