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/;
1014 %sql_func - hash to make query mysql/postgresql compliant
1020 UNIX_TIMESTAMP => '',
1021 FROM_UNIXTIME => '',
1022 TO_SEC => " interval '1 second' * ",
1023 SEC_TO_INT => "SEC_TO_INT",
1026 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1027 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1028 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1029 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1030 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1031 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1034 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1035 FROM_UNIXTIME => 'FROM_UNIXTIME',
1038 SEC_TO_TIME => 'SEC_TO_TIME',
1039 MATCH => " REGEXP ",
1040 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1041 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1042 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1043 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1044 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1045 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1049 sub dbh_selectall_arrayref
1051 my ($self, $query) = @_;
1052 $self->connect_db();
1053 $self->debug($query);
1054 return $self->{dbh}->selectall_arrayref($query);
1059 my ($self, @what) = @_;
1060 return join(',', $self->dbh_quote(@what)) ;
1065 my ($self, @what) = @_;
1067 $self->connect_db();
1069 return map { $self->{dbh}->quote($_) } @what;
1071 return $self->{dbh}->quote($what[0]) ;
1077 my ($self, $query) = @_ ;
1078 $self->connect_db();
1079 $self->debug($query);
1080 return $self->{dbh}->do($query);
1083 sub dbh_selectall_hashref
1085 my ($self, $query, $join) = @_;
1087 $self->connect_db();
1088 $self->debug($query);
1089 return $self->{dbh}->selectall_hashref($query, $join) ;
1092 sub dbh_selectrow_hashref
1094 my ($self, $query) = @_;
1096 $self->connect_db();
1097 $self->debug($query);
1098 return $self->{dbh}->selectrow_hashref($query) ;
1104 my @unit = qw(b Kb Mb Gb Tb);
1105 my $val = shift || 0;
1107 my $format = '%i %s';
1108 while ($val / 1024 > 1) {
1112 $format = ($i>0)?'%0.1f %s':'%i %s';
1113 return sprintf($format, $val, $unit[$i]);
1116 # display Day, Hour, Year
1122 $val /= 60; # sec -> min
1124 if ($val / 60 <= 1) {
1128 $val /= 60; # min -> hour
1129 if ($val / 24 <= 1) {
1130 return "$val hours";
1133 $val /= 24; # hour -> day
1134 if ($val / 365 < 2) {
1138 $val /= 365 ; # day -> year
1140 return "$val years";
1143 # get Day, Hour, Year
1149 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1153 my %times = ( m => 60,
1159 my $mult = $times{$2} || 0;
1169 unless ($self->{dbh}) {
1170 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1171 $self->{info}->{user},
1172 $self->{info}->{password});
1174 print "Can't connect to your database, see error log\n"
1175 unless ($self->{dbh});
1177 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1183 my ($class, %arg) = @_;
1185 dbh => undef, # connect_db();
1187 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1193 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1195 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1196 $self->{sql} = $sql_func{$1};
1199 $self->{debug} = $self->{info}->{debug};
1200 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1208 $self->display($self->{info}, "begin.tpl");
1214 $self->display($self->{info}, "end.tpl");
1222 my $arg = $self->get_form("client", "qre_client");
1224 if ($arg->{qre_client}) {
1225 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1226 } elsif ($arg->{client}) {
1227 $where = "WHERE Name = '$arg->{client}' ";
1231 SELECT Name AS name,
1233 AutoPrune AS autoprune,
1234 FileRetention AS fileretention,
1235 JobRetention AS jobretention
1240 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1242 foreach (values %$all) {
1243 $_->{fileretention} = human_sec($_->{fileretention});
1244 $_->{jobretention} = human_sec($_->{jobretention});
1247 my $dsp = { ID => $cur_id++,
1248 clients => [ values %$all] };
1250 $self->display($dsp, "client_list.tpl") ;
1255 my ($self, %arg) = @_;
1262 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1264 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1266 $self->{sql}->{TO_SEC}($arg{age})
1269 $label = "last " . human_sec($arg{age});
1272 if ($arg{groupby}) {
1273 $limit .= " GROUP BY $arg{groupby} ";
1277 $limit .= " ORDER BY $arg{order} ";
1281 $limit .= " LIMIT $arg{limit} ";
1282 $label .= " limited to $arg{limit}";
1286 $limit .= " OFFSET $arg{offset} ";
1287 $label .= " with $arg{offset} offset ";
1291 $label = 'no filter';
1294 return ($limit, $label);
1299 $bweb->get_form(...) - Get useful stuff
1303 This function get and check parameters against regexp.
1305 If word begin with 'q', the return will be quoted or join quoted
1306 if it's end with 's'.
1311 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1314 qclient => 'plume-fd',
1315 qpools => "'plume-fd', 'test-fd', '...'",
1322 my ($self, @what) = @_;
1323 my %what = map { $_ => 1 } @what;
1340 my %opt_s = ( # default to ''
1353 my %opt_p = ( # option with path
1359 foreach my $i (@what) {
1360 if (exists $opt_i{$i}) {# integer param
1361 my $value = CGI::param($i) || $opt_i{$i} ;
1362 if ($value =~ /^(\d+)$/) {
1365 } elsif ($opt_s{$i}) { # simple string param
1366 my $value = CGI::param($i) || '';
1367 if ($value =~ /^([\w\d\.-]+)$/) {
1371 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1372 my @value = CGI::param($1) ;
1374 $ret{$i} = $self->dbh_join(@value) ;
1377 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1378 my $value = CGI::param($1) ;
1380 $ret{$i} = $self->dbh_quote($value);
1383 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1384 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1386 } elsif (exists $opt_p{$i}) {
1387 my $value = CGI::param($i) || '';
1388 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1395 foreach my $s (CGI::param('slot')) {
1396 if ($s =~ /^(\d+)$/) {
1397 push @{$ret{slots}}, $s;
1402 if ($what{db_clients}) {
1404 SELECT Client.Name as clientname
1408 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1409 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1413 if ($what{db_mediatypes}) {
1415 SELECT MediaType as mediatype
1419 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1420 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1424 if ($what{db_locations}) {
1426 SELECT Location as location, Cost as cost FROM Location
1428 my $loc = $self->dbh_selectall_hashref($query, 'location');
1429 $ret{db_locations} = [ sort { $a->{location}
1435 if ($what{db_pools}) {
1436 my $query = "SELECT Name as name FROM Pool";
1438 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1439 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1442 if ($what{db_filesets}) {
1444 SELECT FileSet.FileSet AS fileset
1448 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1450 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1451 values %$filesets] ;
1455 if ($what{db_jobnames}) {
1457 SELECT DISTINCT Job.Name AS jobname
1461 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1463 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1464 values %$jobnames] ;
1468 if ($what{db_devices}) {
1470 SELECT Device.Name AS name
1474 my $devices = $self->dbh_selectall_hashref($query, 'name');
1476 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1488 my $fields = $self->get_form(qw/age level status clients filesets graph gtype type
1489 db_clients limit db_filesets width height
1490 qclients qfilesets qjobnames db_jobnames/);
1493 my $url = CGI::url(-full => 0,
1496 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1498 # this organisation is to keep user choice between 2 click
1499 # TODO : fileset and client selection doesn't work
1508 sub display_client_job
1510 my ($self, %arg) = @_ ;
1512 $arg{order} = ' Job.JobId DESC ';
1513 my ($limit, $label) = $self->get_limit(%arg);
1515 my $clientname = $self->dbh_quote($arg{clientname});
1518 SELECT DISTINCT Job.JobId AS jobid,
1519 Job.Name AS jobname,
1520 FileSet.FileSet AS fileset,
1522 StartTime AS starttime,
1523 JobFiles AS jobfiles,
1524 JobBytes AS jobbytes,
1525 JobStatus AS jobstatus,
1526 JobErrors AS joberrors
1528 FROM Client,Job,FileSet
1529 WHERE Client.Name=$clientname
1530 AND Client.ClientId=Job.ClientId
1531 AND Job.FileSetId=FileSet.FileSetId
1535 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1537 foreach (values %$all) {
1538 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1541 $self->display({ clientname => $arg{clientname},
1544 Jobs => [ values %$all ],
1546 "display_client_job.tpl") ;
1549 sub get_selected_media_location
1553 my $medias = $self->get_form('jmedias');
1555 unless ($medias->{jmedias}) {
1560 SELECT Media.VolumeName AS volumename, Location.Location AS location
1561 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1562 WHERE Media.VolumeName IN ($medias->{jmedias})
1565 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1567 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1578 my $medias = $self->get_selected_media_location();
1584 my $elt = $self->get_form('db_locations');
1586 $self->display({ ID => $cur_id++,
1587 %$elt, # db_locations
1589 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1599 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1601 $self->display($elt, "help_extern.tpl");
1604 sub help_extern_compute
1608 my $number = CGI::param('limit') || '' ;
1609 unless ($number =~ /^(\d+)$/) {
1610 return $self->error("Bad arg number : $number ");
1613 my ($sql, undef) = $self->get_param('pools',
1614 'locations', 'mediatypes');
1617 SELECT Media.VolumeName AS volumename,
1618 Media.VolStatus AS volstatus,
1619 Media.LastWritten AS lastwritten,
1620 Media.MediaType AS mediatype,
1621 Media.VolMounts AS volmounts,
1623 Media.Recycle AS recycle,
1624 $self->{sql}->{FROM_UNIXTIME}(
1625 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1626 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1629 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1630 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1632 WHERE Media.InChanger = 1
1633 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1635 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1639 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1641 $self->display({ Medias => [ values %$all ] },
1642 "help_extern_compute.tpl");
1649 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1650 $self->display($param, "help_intern.tpl");
1653 sub help_intern_compute
1657 my $number = CGI::param('limit') || '' ;
1658 unless ($number =~ /^(\d+)$/) {
1659 return $self->error("Bad arg number : $number ");
1662 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1664 if (CGI::param('expired')) {
1666 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1667 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1673 SELECT Media.VolumeName AS volumename,
1674 Media.VolStatus AS volstatus,
1675 Media.LastWritten AS lastwritten,
1676 Media.MediaType AS mediatype,
1677 Media.VolMounts AS volmounts,
1679 $self->{sql}->{FROM_UNIXTIME}(
1680 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1681 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1684 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1685 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1687 WHERE Media.InChanger <> 1
1688 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1689 AND Media.Recycle = 1
1691 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1695 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1697 $self->display({ Medias => [ values %$all ] },
1698 "help_intern_compute.tpl");
1704 my ($self, %arg) = @_ ;
1706 my ($limit, $label) = $self->get_limit(%arg);
1710 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1711 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1712 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1713 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1714 (SELECT count(Job.JobId)
1716 WHERE Job.JobStatus IN ('E','e','f','A')
1719 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1722 my $row = $self->dbh_selectrow_hashref($query) ;
1724 $row->{nb_bytes} = human_size($row->{nb_bytes});
1726 $row->{db_size} = '???';
1727 $row->{label} = $label;
1729 $self->display($row, "general.tpl");
1734 my ($self, @what) = @_ ;
1735 my %elt = map { $_ => 1 } @what;
1740 if ($elt{clients}) {
1741 my @clients = CGI::param('client');
1743 $ret{clients} = \@clients;
1744 my $str = $self->dbh_join(@clients);
1745 $limit .= "AND Client.Name IN ($str) ";
1749 if ($elt{filesets}) {
1750 my @filesets = CGI::param('fileset');
1752 $ret{filesets} = \@filesets;
1753 my $str = $self->dbh_join(@filesets);
1754 $limit .= "AND FileSet.FileSet IN ($str) ";
1758 if ($elt{mediatypes}) {
1759 my @medias = CGI::param('mediatype');
1761 $ret{mediatypes} = \@medias;
1762 my $str = $self->dbh_join(@medias);
1763 $limit .= "AND Media.MediaType IN ($str) ";
1768 my $client = CGI::param('client');
1769 $ret{client} = $client;
1770 $client = $self->dbh_join($client);
1771 $limit .= "AND Client.Name = $client ";
1775 my $level = CGI::param('level') || '';
1776 if ($level =~ /^(\w)$/) {
1778 $limit .= "AND Job.Level = '$1' ";
1783 my $jobid = CGI::param('jobid') || '';
1785 if ($jobid =~ /^(\d+)$/) {
1787 $limit .= "AND Job.JobId = '$1' ";
1792 my $status = CGI::param('status') || '';
1793 if ($status =~ /^(\w)$/) {
1795 $limit .= "AND Job.JobStatus = '$1' ";
1799 if ($elt{locations}) {
1800 my @location = CGI::param('location') ;
1802 $ret{locations} = \@location;
1803 my $str = $self->dbh_join(@location);
1804 $limit .= "AND Location.Location IN ($str) ";
1809 my @pool = CGI::param('pool') ;
1811 $ret{pools} = \@pool;
1812 my $str = $self->dbh_join(@pool);
1813 $limit .= "AND Pool.Name IN ($str) ";
1817 if ($elt{location}) {
1818 my $location = CGI::param('location') || '';
1820 $ret{location} = $location;
1821 $location = $self->dbh_quote($location);
1822 $limit .= "AND Location.Location = $location ";
1827 my $pool = CGI::param('pool') || '';
1830 $pool = $self->dbh_quote($pool);
1831 $limit .= "AND Pool.Name = $pool ";
1835 if ($elt{jobtype}) {
1836 my $jobtype = CGI::param('jobtype') || '';
1837 if ($jobtype =~ /^(\w)$/) {
1839 $limit .= "AND Job.Type = '$1' ";
1843 return ($limit, %ret);
1850 SELECT DISTINCT Job.JobId AS jobid,
1851 Client.Name AS client,
1852 FileSet.FileSet AS fileset,
1853 Job.Name AS jobname,
1855 StartTime AS starttime,
1856 JobFiles AS jobfiles,
1857 JobBytes AS jobbytes,
1858 VolumeName AS volumename,
1859 JobStatus AS jobstatus,
1860 JobErrors AS joberrors
1862 FROM Client,Job,JobMedia,Media,FileSet
1863 WHERE Client.ClientId=Job.ClientId
1864 AND Job.FileSetId=FileSet.FileSetId
1865 AND JobMedia.JobId=Job.JobId
1866 AND JobMedia.MediaId=Media.MediaId
1873 my ($self, %arg) = @_ ;
1875 $arg{order} = ' Job.JobId DESC ';
1877 my ($limit, $label) = $self->get_limit(%arg);
1878 my ($where, undef) = $self->get_param('clients',
1886 SELECT Job.JobId AS jobid,
1887 Client.Name AS client,
1888 FileSet.FileSet AS fileset,
1889 Job.Name AS jobname,
1891 StartTime AS starttime,
1892 Pool.Name AS poolname,
1893 JobFiles AS jobfiles,
1894 JobBytes AS jobbytes,
1895 JobStatus AS jobstatus,
1896 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1897 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1900 JobErrors AS joberrors
1903 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1904 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1905 WHERE Client.ClientId=Job.ClientId
1906 AND Job.JobStatus != 'R'
1911 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1913 foreach (values %$all) {
1914 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1917 $self->display({ Filter => $label,
1921 sort { $a->{jobid} <=> $b->{jobid} }
1928 # display job informations
1929 sub display_job_zoom
1931 my ($self, $jobid) = @_ ;
1933 $jobid = $self->dbh_quote($jobid);
1936 SELECT DISTINCT Job.JobId AS jobid,
1937 Client.Name AS client,
1938 Job.Name AS jobname,
1939 FileSet.FileSet AS fileset,
1941 Pool.Name AS poolname,
1942 StartTime AS starttime,
1943 JobFiles AS jobfiles,
1944 JobBytes AS jobbytes,
1945 JobStatus AS jobstatus,
1946 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1947 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1950 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1951 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1952 WHERE Client.ClientId=Job.ClientId
1953 AND Job.JobId = $jobid
1956 my $row = $self->dbh_selectrow_hashref($query) ;
1958 $row->{jobbytes} = human_size($row->{jobbytes}) ;
1960 # display all volumes associate with this job
1962 SELECT Media.VolumeName as volumename
1963 FROM Job,Media,JobMedia
1964 WHERE Job.JobId = $jobid
1965 AND JobMedia.JobId=Job.JobId
1966 AND JobMedia.MediaId=Media.MediaId
1969 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1971 $row->{volumes} = [ values %$all ] ;
1973 $self->display($row, "display_job_zoom.tpl");
1980 my ($where, %elt) = $self->get_param('pool',
1983 my $arg = $self->get_form('jmedias', 'qre_media');
1985 if ($arg->{jmedias}) {
1986 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1988 if ($arg->{qre_media}) {
1989 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1993 SELECT Media.VolumeName AS volumename,
1994 Media.VolBytes AS volbytes,
1995 Media.VolStatus AS volstatus,
1996 Media.MediaType AS mediatype,
1997 Media.InChanger AS online,
1998 Media.LastWritten AS lastwritten,
1999 Location.Location AS location,
2000 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2001 Pool.Name AS poolname,
2002 $self->{sql}->{FROM_UNIXTIME}(
2003 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2004 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2007 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2008 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2009 Media.MediaType AS MediaType
2011 WHERE Media.VolStatus = 'Full'
2012 GROUP BY Media.MediaType
2013 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2015 WHERE Media.PoolId=Pool.PoolId
2019 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2020 foreach (values %$all) {
2021 $_->{volbytes} = human_size($_->{volbytes}) ;
2024 $self->display({ ID => $cur_id++,
2026 Location => $elt{location},
2027 Medias => [ values %$all ]
2029 "display_media.tpl");
2036 my $pool = $self->get_form('db_pools');
2038 foreach my $name (@{ $pool->{db_pools} }) {
2039 CGI::param('pool', $name->{name});
2040 $self->display_media();
2044 sub display_media_zoom
2048 my $medias = $self->get_form('jmedias');
2050 unless ($medias->{jmedias}) {
2051 return $self->error("Can't get media selection");
2055 SELECT InChanger AS online,
2056 VolBytes AS nb_bytes,
2057 VolumeName AS volumename,
2058 VolStatus AS volstatus,
2059 VolMounts AS nb_mounts,
2060 Media.VolUseDuration AS voluseduration,
2061 Media.MaxVolJobs AS maxvoljobs,
2062 Media.MaxVolFiles AS maxvolfiles,
2063 Media.MaxVolBytes AS maxvolbytes,
2064 VolErrors AS nb_errors,
2065 Pool.Name AS poolname,
2066 Location.Location AS location,
2067 Media.Recycle AS recycle,
2068 Media.VolRetention AS volretention,
2069 Media.LastWritten AS lastwritten,
2070 Media.VolReadTime/1000000 AS volreadtime,
2071 Media.VolWriteTime/1000000 AS volwritetime,
2072 $self->{sql}->{FROM_UNIXTIME}(
2073 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2074 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2077 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2078 WHERE Pool.PoolId = Media.PoolId
2079 AND VolumeName IN ($medias->{jmedias})
2082 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2084 foreach my $media (values %$all) {
2085 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
2086 $media->{voluseduration} = human_sec($media->{voluseduration});
2087 $media->{volretention} = human_sec($media->{volretention});
2088 $media->{volreadtime} = human_sec($media->{volreadtime});
2089 $media->{volwritetime} = human_sec($media->{volwritetime});
2090 my $mq = $self->dbh_quote($media->{volumename});
2093 SELECT DISTINCT Job.JobId AS jobid,
2095 Job.StartTime AS starttime,
2098 Job.JobFiles AS files,
2099 Job.JobBytes AS bytes,
2100 Job.jobstatus AS status
2101 FROM Media,JobMedia,Job
2102 WHERE Media.VolumeName=$mq
2103 AND Media.MediaId=JobMedia.MediaId
2104 AND JobMedia.JobId=Job.JobId
2107 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2109 foreach (values %$jobs) {
2110 $_->{bytes} = human_size($_->{bytes}) ;
2114 SELECT LocationLog.Date AS date,
2115 Location.Location AS location,
2116 LocationLog.Comment AS comment
2117 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2118 WHERE Media.MediaId = LocationLog.MediaId
2119 AND Media.VolumeName = $mq
2123 my $log = $self->dbh_selectall_arrayref($query) ;
2125 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2128 $self->display({ jobs => [ values %$jobs ],
2129 LocationLog => $logtxt,
2131 "display_media_zoom.tpl");
2139 my $loc = $self->get_form('qlocation');
2140 unless ($loc->{qlocation}) {
2141 return $self->error("Can't get location");
2145 SELECT Location.Location AS location,
2146 Location.Cost AS cost,
2147 Location.Enabled AS enabled
2149 WHERE Location.Location = $loc->{qlocation}
2152 my $row = $self->dbh_selectrow_hashref($query);
2154 $self->display({ ID => $cur_id++,
2155 %$row }, "location_edit.tpl") ;
2163 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2164 unless ($arg->{qlocation}) {
2165 return $self->error("Can't get location");
2167 unless ($arg->{qnewlocation}) {
2168 return $self->error("Can't get new location name");
2170 unless ($arg->{cost}) {
2171 return $self->error("Can't get new cost");
2174 my $enabled = CGI::param('enabled') || '';
2175 $enabled = $enabled?1:0;
2178 UPDATE Location SET Cost = $arg->{cost},
2179 Location = $arg->{qnewlocation},
2181 WHERE Location.Location = $arg->{qlocation}
2184 $self->dbh_do($query);
2186 $self->display_location();
2192 my $arg = $self->get_form(qw/qlocation cost/) ;
2194 unless ($arg->{qlocation}) {
2195 $self->display({}, "location_add.tpl");
2198 unless ($arg->{cost}) {
2199 return $self->error("Can't get new cost");
2202 my $enabled = CGI::param('enabled') || '';
2203 $enabled = $enabled?1:0;
2206 INSERT INTO Location (Location, Cost, Enabled)
2207 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2210 $self->dbh_do($query);
2212 $self->display_location();
2215 sub display_location
2220 SELECT Location.Location AS location,
2221 Location.Cost AS cost,
2222 Location.Enabled AS enabled,
2223 (SELECT count(Media.MediaId)
2225 WHERE Media.LocationId = Location.LocationId
2230 my $location = $self->dbh_selectall_hashref($query, 'location');
2232 $self->display({ ID => $cur_id++,
2233 Locations => [ values %$location ] },
2234 "display_location.tpl");
2241 my $medias = $self->get_selected_media_location();
2246 my $arg = $self->get_form('db_locations', 'qnewlocation');
2248 $self->display({ email => $self->{info}->{email_media},
2250 medias => [ values %$medias ],
2252 "update_location.tpl");
2255 sub get_media_max_size
2257 my ($self, $type) = @_;
2259 "SELECT avg(VolBytes) AS size
2261 WHERE Media.VolStatus = 'Full'
2262 AND Media.MediaType = '$type'
2265 my $res = $self->selectrow_hashref($query);
2268 return $res->{size};
2278 my $media = CGI::param('media');
2280 return $self->error("Can't find media selection");
2283 $media = $self->dbh_quote($media);
2287 my $volstatus = CGI::param('volstatus') || '';
2288 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2289 $update .= " VolStatus=$volstatus, ";
2291 my $inchanger = CGI::param('inchanger') || '';
2293 $update .= " InChanger=1, " ;
2294 my $slot = CGI::param('slot') || '';
2295 if ($slot =~ /^(\d+)$/) {
2296 $update .= " Slot=$1, ";
2298 $update .= " Slot=0, ";
2301 $update = " Slot=0, InChanger=0, ";
2304 my $pool = CGI::param('pool') || '';
2305 $pool = $self->dbh_quote($pool); # is checked by db
2306 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2308 my $volretention = CGI::param('volretention') || '';
2309 $volretention = from_human_sec($volretention);
2310 unless ($volretention) {
2311 return $self->error("Can't get volume retention");
2314 $update .= " VolRetention = $volretention, ";
2316 my $loc = CGI::param('location') || '';
2317 $loc = $self->dbh_quote($loc); # is checked by db
2318 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2320 my $usedu = CGI::param('voluseduration') || '0';
2321 $usedu = from_human_sec($usedu);
2322 $update .= " VolUseDuration=$usedu, ";
2324 my $maxj = CGI::param('maxvoljobs') || '0';
2325 unless ($maxj =~ /^(\d+)$/) {
2326 return $self->error("Can't get max jobs");
2328 $update .= " MaxVolJobs=$1, " ;
2330 my $maxf = CGI::param('maxvolfiles') || '0';
2331 unless ($maxj =~ /^(\d+)$/) {
2332 return $self->error("Can't get max files");
2334 $update .= " MaxVolFiles=$1, " ;
2336 my $maxb = CGI::param('maxvolbytes') || '0';
2337 unless ($maxb =~ /^(\d+)$/) {
2338 return $self->error("Can't get max bytes");
2340 $update .= " MaxVolBytes=$1 " ;
2342 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2345 print "Update Ok\n";
2346 $self->update_media();
2354 my $media = $self->get_form('qmedia');
2356 unless ($media->{qmedia}) {
2357 return $self->error("Can't get media");
2361 SELECT Media.Slot AS slot,
2362 Pool.Name AS poolname,
2363 Media.VolStatus AS volstatus,
2364 Media.InChanger AS inchanger,
2365 Location.Location AS location,
2366 Media.VolumeName AS volumename,
2367 Media.MaxVolBytes AS maxvolbytes,
2368 Media.MaxVolJobs AS maxvoljobs,
2369 Media.MaxVolFiles AS maxvolfiles,
2370 Media.VolUseDuration AS voluseduration,
2371 Media.VolRetention AS volretention
2373 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2374 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2376 WHERE Media.VolumeName = $media->{qmedia}
2379 my $row = $self->dbh_selectrow_hashref($query);
2380 $row->{volretention} = human_sec($row->{volretention});
2381 $row->{voluseduration} = human_sec($row->{voluseduration});
2383 my $elt = $self->get_form(qw/db_pools db_locations/);
2389 "update_media.tpl");
2396 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2398 unless ($arg->{jmedias}) {
2399 return $self->error("Can't get selected media");
2402 unless ($arg->{qnewlocation}) {
2403 return $self->error("Can't get new location");
2408 SET LocationId = (SELECT LocationId
2410 WHERE Location = $arg->{qnewlocation})
2411 WHERE Media.VolumeName IN ($arg->{jmedias})
2414 my $nb = $self->dbh_do($query);
2416 print "$nb media updated";
2423 my $medias = $self->get_selected_media_location();
2425 return $self->error("Can't get media selection");
2427 my $newloc = CGI::param('newlocation');
2429 my $user = CGI::param('user') || 'unknow';
2430 my $comm = CGI::param('comment') || '';
2431 $comm = $self->dbh_quote("$user: $comm");
2435 foreach my $media (keys %$medias) {
2437 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2439 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2440 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2441 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2444 $self->dbh_do($query);
2445 $self->debug($query);
2449 $q->param('action', 'update_location');
2450 my $url = $q->url(-full => 1, -query=>1);
2452 $self->display({ email => $self->{info}->{email_media},
2454 newlocation => $newloc,
2455 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2456 medias => [ values %$medias ],
2458 "change_location.tpl");
2462 sub display_client_stats
2464 my ($self, %arg) = @_ ;
2466 my $client = $self->dbh_quote($arg{clientname});
2467 my ($limit, $label) = $self->get_limit(%arg);
2471 count(Job.JobId) AS nb_jobs,
2472 sum(Job.JobBytes) AS nb_bytes,
2473 sum(Job.JobErrors) AS nb_err,
2474 sum(Job.JobFiles) AS nb_files,
2475 Client.Name AS clientname
2476 FROM Job INNER JOIN Client USING (ClientId)
2478 Client.Name = $client
2480 GROUP BY Client.Name
2483 my $row = $self->dbh_selectrow_hashref($query);
2485 $row->{ID} = $cur_id++;
2486 $row->{label} = $label;
2487 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2489 $self->display($row, "display_client_stats.tpl");
2492 # poolname can be undef
2495 my ($self, $poolname) = @_ ;
2497 # TODO : afficher les tailles et les dates
2500 SELECT sum(subq.volmax) AS volmax,
2501 sum(subq.volnum) AS volnum,
2502 sum(subq.voltotal) AS voltotal,
2504 Pool.Recycle AS recycle,
2505 Pool.VolRetention AS volretention,
2506 Pool.VolUseDuration AS voluseduration,
2507 Pool.MaxVolJobs AS maxvoljobs,
2508 Pool.MaxVolFiles AS maxvolfiles,
2509 Pool.MaxVolBytes AS maxvolbytes,
2510 subq.PoolId AS PoolId
2513 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2514 count(Media.MediaId) AS volnum,
2515 sum(Media.VolBytes) AS voltotal,
2516 Media.PoolId AS PoolId,
2517 Media.MediaType AS MediaType
2519 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2520 Media.MediaType AS MediaType
2522 WHERE Media.VolStatus = 'Full'
2523 GROUP BY Media.MediaType
2524 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2525 GROUP BY Media.MediaType, Media.PoolId
2527 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2528 GROUP BY subq.PoolId
2531 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2533 foreach my $p (values %$all) {
2534 $p->{maxvolbytes} = human_size($p->{maxvolbytes}) ;
2535 $p->{volretention} = human_sec($p->{volretention}) ;
2536 $p->{voluseduration} = human_sec($p->{voluseduration}) ;
2539 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2541 $p->{poolusage} = 0;
2545 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2547 WHERE PoolId=$p->{poolid}
2550 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2551 foreach my $t (values %$content) {
2552 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2557 $self->display({ ID => $cur_id++,
2558 Pools => [ values %$all ]},
2559 "display_pool.tpl");
2562 sub display_running_job
2566 my $arg = $self->get_form('client', 'jobid');
2568 if (!$arg->{client} and $arg->{jobid}) {
2571 SELECT Client.Name AS name
2572 FROM Job INNER JOIN Client USING (ClientId)
2573 WHERE Job.JobId = $arg->{jobid}
2576 my $row = $self->dbh_selectrow_hashref($query);
2579 $arg->{client} = $row->{name};
2580 CGI::param('client', $arg->{client});
2584 if ($arg->{client}) {
2585 my $cli = new Bweb::Client(name => $arg->{client});
2586 $cli->display_running_job($self->{info}, $arg->{jobid});
2587 if ($arg->{jobid}) {
2588 $self->get_job_log();
2591 $self->error("Can't get client or jobid");
2595 sub display_running_jobs
2597 my ($self, $display_action) = @_;
2600 SELECT Job.JobId AS jobid,
2601 Job.Name AS jobname,
2603 Job.StartTime AS starttime,
2604 Job.JobFiles AS jobfiles,
2605 Job.JobBytes AS jobbytes,
2606 Job.JobStatus AS jobstatus,
2607 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2608 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2610 Client.Name AS clientname
2611 FROM Job INNER JOIN Client USING (ClientId)
2612 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2614 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2616 $self->display({ ID => $cur_id++,
2617 display_action => $display_action,
2618 Jobs => [ values %$all ]},
2619 "running_job.tpl") ;
2625 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2627 unless ($arg->{jmedias}) {
2628 return $self->error("Can't get media selection");
2631 my $a = $self->ach_get($arg->{ach});
2637 SELECT Media.VolumeName AS volumename,
2638 Storage.Name AS storage,
2639 Location.Location AS location,
2641 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2642 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2643 WHERE Media.VolumeName IN ($arg->{jmedias})
2644 AND Media.InChanger = 1
2647 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2651 foreach my $vol (values %$all) {
2652 print "eject $vol->{volumename} from $vol->{storage} : ";
2653 if ($a->send_to_io($vol->{slot})) {
2665 my $arg = $self->get_form('jobid', 'client');
2667 print CGI::header('text/brestore');
2668 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2669 print "client=$arg->{client}\n" if ($arg->{client});
2670 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2674 # TODO : move this to Bweb::Autochanger ?
2675 # TODO : make this internal to not eject tape ?
2681 my ($self, $name) = @_;
2684 return $self->error("Can't get your autochanger name ach");
2687 unless ($self->{info}->{ach_list}) {
2688 return $self->error("Could not find any autochanger");
2691 my $a = $self->{info}->{ach_list}->{$name};
2694 $self->error("Can't get your autochanger $name from your ach_list");
2705 my ($self, $ach) = @_;
2707 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2709 $self->{info}->save();
2717 my $arg = $self->get_form('ach');
2719 or !$self->{info}->{ach_list}
2720 or !$self->{info}->{ach_list}->{$arg->{ach}})
2722 return $self->error("Can't get autochanger name");
2725 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2729 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2731 my $b = new Bconsole(pref => $self->{info});
2732 my @storages = $b->list_storage() ;
2734 $ach->{devices} = [ map { { name => $_ } } @storages ];
2736 $self->display($ach, "ach_add.tpl");
2737 delete $ach->{drives};
2738 delete $ach->{devices};
2745 my $arg = $self->get_form('ach');
2748 or !$self->{info}->{ach_list}
2749 or !$self->{info}->{ach_list}->{$arg->{ach}})
2751 return $self->error("Can't get autochanger name");
2754 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2756 $self->{info}->save();
2757 $self->{info}->view();
2763 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2765 my $b = new Bconsole(pref => $self->{info});
2766 my @storages = $b->list_storage() ;
2768 unless ($arg->{ach}) {
2769 $arg->{devices} = [ map { { name => $_ } } @storages ];
2770 return $self->display($arg, "ach_add.tpl");
2774 foreach my $drive (CGI::param('drives'))
2776 unless (grep(/^$drive$/,@storages)) {
2777 return $self->error("Can't find $drive in storage list");
2780 my $index = CGI::param("index_$drive");
2781 unless (defined $index and $index =~ /^(\d+)$/) {
2782 return $self->error("Can't get $drive index");
2785 $drives[$index] = $drive;
2789 return $self->error("Can't get drives from Autochanger");
2792 my $a = new Bweb::Autochanger(name => $arg->{ach},
2793 precmd => $arg->{precmd},
2794 drive_name => \@drives,
2795 device => $arg->{device},
2796 mtxcmd => $arg->{mtxcmd});
2798 $self->ach_register($a) ;
2800 $self->{info}->view();
2806 my $arg = $self->get_form('jobid');
2808 my $b = new Bconsole(pref => $self->{info});
2810 if ($arg->{jobid}) {
2812 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2813 title => "Delete a job ",
2814 name => "delete jobid=$arg->{jobid}",
2823 my $ach = CGI::param('ach') ;
2824 unless ($ach =~ /^([\w\d\.-]+)$/) {
2825 return $self->error("Bad autochanger name");
2828 my $b = new Bconsole(pref => $self->{info});
2829 print "<pre>" . $b->update_slots($ach) . "</pre>";
2836 my $arg = $self->get_form('jobid');
2837 unless ($arg->{jobid}) {
2838 return $self->error("Can't get jobid");
2841 my $t = CGI::param('time') || '';
2844 SELECT Job.Name as name, Client.Name as clientname
2845 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2846 WHERE JobId = $arg->{jobid}
2849 my $row = $self->dbh_selectrow_hashref($query);
2852 return $self->error("Can't find $arg->{jobid} in catalog");
2856 SELECT Time AS time, LogText AS log
2858 WHERE JobId = $arg->{jobid}
2861 my $log = $self->dbh_selectall_arrayref($query);
2863 return $self->error("Can't get log for jobid $arg->{jobid}");
2869 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2871 $logtxt = join("", map { $_->[1] } @$log ) ;
2874 $self->display({ lines=> $logtxt,
2875 jobid => $arg->{jobid},
2876 name => $row->{name},
2877 client => $row->{clientname},
2878 }, 'display_log.tpl');
2886 my $arg = $self->get_form('ach', 'slots', 'drive');
2888 unless ($arg->{ach}) {
2889 return $self->error("Can't find autochanger name");
2894 if ($arg->{slots}) {
2895 $slots = join(",", @{ $arg->{slots} });
2896 $t += 60*scalar( @{ $arg->{slots} }) ;
2899 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2900 print "<h1>This command can take long time, be patient...</h1>";
2902 $b->label_barcodes(storage => $arg->{ach},
2903 drive => $arg->{drive},
2913 my @volume = CGI::param('media');
2915 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2918 content => $b->purge_volume(@volume),
2919 title => "Purge media",
2920 name => "purge volume=" . join(' volume=', @volume),
2928 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2930 my @volume = CGI::param('media');
2932 content => $b->prune_volume(@volume),
2933 title => "Prune media",
2934 name => "prune volume=" . join(' volume=', @volume),
2942 my $arg = $self->get_form('jobid');
2943 unless ($arg->{jobid}) {
2944 return $self->error('Bad jobid');
2947 my $b = new Bconsole(pref => $self->{info});
2949 content => $b->cancel($arg->{jobid}),
2950 title => "Cancel job",
2951 name => "cancel jobid=$arg->{jobid}",
2955 sub director_show_sched
2959 my $arg = $self->get_form('days');
2961 my $b = new Bconsole(pref => $self->{info}) ;
2963 my $ret = $b->director_get_sched( $arg->{days} );
2968 }, "scheduled_job.tpl");
2971 sub enable_disable_job
2973 my ($self, $what) = @_ ;
2975 my $name = CGI::param('job') || '';
2976 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2977 return $self->error("Can't find job name");
2980 my $b = new Bconsole(pref => $self->{info}) ;
2990 content => $b->send_cmd("$cmd job=\"$name\""),
2991 title => "$cmd $name",
2992 name => "$cmd job=\"$name\"",
2999 $b = new Bconsole(pref => $self->{info});
3001 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3003 $self->display({ Jobs => $joblist }, "run_job.tpl");
3008 my ($self, $ouput) = @_;
3011 foreach my $l (split(/\r\n/, $ouput)) {
3012 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3018 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3024 foreach my $k (keys %arg) {
3025 $lowcase{lc($k)} = $arg{$k} ;
3034 $b = new Bconsole(pref => $self->{info});
3036 my $job = CGI::param('job') || '';
3038 my $info = $b->send_cmd("show job=\"$job\"");
3039 my $attr = $self->run_parse_job($info);
3041 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3043 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3044 my $clients = [ map { { name => $_ } }$b->list_client()];
3045 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3046 my $storages= [ map { { name => $_ } }$b->list_storage()];
3051 clients => $clients,
3052 filesets => $filesets,
3053 storages => $storages,
3055 }, "run_job_mod.tpl");
3061 $b = new Bconsole(pref => $self->{info});
3063 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3073 $b = new Bconsole(pref => $self->{info});
3075 # TODO: check input (don't use pool, level)
3077 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3078 my $job = CGI::param('job') || '';
3079 my $storage = CGI::param('storage') || '';
3081 my $jobid = $b->run(job => $job,
3082 client => $arg->{client},
3083 priority => $arg->{priority},
3084 level => $arg->{level},
3085 storage => $storage,
3086 pool => $arg->{pool},
3089 print $jobid, $b->{error};
3091 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";