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
1360 foreach my $i (@what) {
1361 if (exists $opt_i{$i}) {# integer param
1362 my $value = CGI::param($i) || $opt_i{$i} ;
1363 if ($value =~ /^(\d+)$/) {
1366 } elsif ($opt_s{$i}) { # simple string param
1367 my $value = CGI::param($i) || '';
1368 if ($value =~ /^([\w\d\.-]+)$/) {
1372 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1373 my @value = CGI::param($1) ;
1375 $ret{$i} = $self->dbh_join(@value) ;
1378 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1379 my $value = CGI::param($1) ;
1381 $ret{$i} = $self->dbh_quote($value);
1384 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1385 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1387 } elsif (exists $opt_p{$i}) {
1388 my $value = CGI::param($i) || '';
1389 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1396 foreach my $s (CGI::param('slot')) {
1397 if ($s =~ /^(\d+)$/) {
1398 push @{$ret{slots}}, $s;
1403 if ($what{db_clients}) {
1405 SELECT Client.Name as clientname
1409 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1410 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1414 if ($what{db_mediatypes}) {
1416 SELECT MediaType as mediatype
1420 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1421 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1425 if ($what{db_locations}) {
1427 SELECT Location as location, Cost as cost FROM Location
1429 my $loc = $self->dbh_selectall_hashref($query, 'location');
1430 $ret{db_locations} = [ sort { $a->{location}
1436 if ($what{db_pools}) {
1437 my $query = "SELECT Name as name FROM Pool";
1439 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1440 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1443 if ($what{db_filesets}) {
1445 SELECT FileSet.FileSet AS fileset
1449 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1451 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1452 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] ;
1467 if ($what{db_devices}) {
1469 SELECT Device.Name AS name
1473 my $devices = $self->dbh_selectall_hashref($query, 'name');
1475 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1486 my $fields = $self->get_form(qw/age level status clients filesets
1488 db_clients limit db_filesets width height
1489 qclients qfilesets qjobnames db_jobnames/);
1492 my $url = CGI::url(-full => 0,
1495 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1497 # this organisation is to keep user choice between 2 click
1498 # TODO : fileset and client selection doesn't work
1507 sub display_client_job
1509 my ($self, %arg) = @_ ;
1511 $arg{order} = ' Job.JobId DESC ';
1512 my ($limit, $label) = $self->get_limit(%arg);
1514 my $clientname = $self->dbh_quote($arg{clientname});
1517 SELECT DISTINCT Job.JobId AS jobid,
1518 Job.Name AS jobname,
1519 FileSet.FileSet AS fileset,
1521 StartTime AS starttime,
1522 JobFiles AS jobfiles,
1523 JobBytes AS jobbytes,
1524 JobStatus AS jobstatus,
1525 JobErrors AS joberrors
1527 FROM Client,Job,FileSet
1528 WHERE Client.Name=$clientname
1529 AND Client.ClientId=Job.ClientId
1530 AND Job.FileSetId=FileSet.FileSetId
1534 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1536 foreach (values %$all) {
1537 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1540 $self->display({ clientname => $arg{clientname},
1543 Jobs => [ values %$all ],
1545 "display_client_job.tpl") ;
1548 sub get_selected_media_location
1552 my $medias = $self->get_form('jmedias');
1554 unless ($medias->{jmedias}) {
1559 SELECT Media.VolumeName AS volumename, Location.Location AS location
1560 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1561 WHERE Media.VolumeName IN ($medias->{jmedias})
1564 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1566 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1577 my $medias = $self->get_selected_media_location();
1583 my $elt = $self->get_form('db_locations');
1585 $self->display({ ID => $cur_id++,
1586 %$elt, # db_locations
1588 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1598 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1600 $self->display($elt, "help_extern.tpl");
1603 sub help_extern_compute
1607 my $number = CGI::param('limit') || '' ;
1608 unless ($number =~ /^(\d+)$/) {
1609 return $self->error("Bad arg number : $number ");
1612 my ($sql, undef) = $self->get_param('pools',
1613 'locations', 'mediatypes');
1616 SELECT Media.VolumeName AS volumename,
1617 Media.VolStatus AS volstatus,
1618 Media.LastWritten AS lastwritten,
1619 Media.MediaType AS mediatype,
1620 Media.VolMounts AS volmounts,
1622 Media.Recycle AS recycle,
1623 $self->{sql}->{FROM_UNIXTIME}(
1624 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1625 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1628 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1629 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1631 WHERE Media.InChanger = 1
1632 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1634 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1638 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1640 $self->display({ Medias => [ values %$all ] },
1641 "help_extern_compute.tpl");
1648 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1649 $self->display($param, "help_intern.tpl");
1652 sub help_intern_compute
1656 my $number = CGI::param('limit') || '' ;
1657 unless ($number =~ /^(\d+)$/) {
1658 return $self->error("Bad arg number : $number ");
1661 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1663 if (CGI::param('expired')) {
1665 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1666 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1672 SELECT Media.VolumeName AS volumename,
1673 Media.VolStatus AS volstatus,
1674 Media.LastWritten AS lastwritten,
1675 Media.MediaType AS mediatype,
1676 Media.VolMounts AS volmounts,
1678 $self->{sql}->{FROM_UNIXTIME}(
1679 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1680 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1683 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1684 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1686 WHERE Media.InChanger <> 1
1687 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1688 AND Media.Recycle = 1
1690 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1694 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1696 $self->display({ Medias => [ values %$all ] },
1697 "help_intern_compute.tpl");
1703 my ($self, %arg) = @_ ;
1705 my ($limit, $label) = $self->get_limit(%arg);
1709 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1710 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1711 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1712 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1713 (SELECT count(Job.JobId)
1715 WHERE Job.JobStatus IN ('E','e','f','A')
1718 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1721 my $row = $self->dbh_selectrow_hashref($query) ;
1723 $row->{nb_bytes} = human_size($row->{nb_bytes});
1725 $row->{db_size} = '???';
1726 $row->{label} = $label;
1728 $self->display($row, "general.tpl");
1733 my ($self, @what) = @_ ;
1734 my %elt = map { $_ => 1 } @what;
1739 if ($elt{clients}) {
1740 my @clients = CGI::param('client');
1742 $ret{clients} = \@clients;
1743 my $str = $self->dbh_join(@clients);
1744 $limit .= "AND Client.Name IN ($str) ";
1748 if ($elt{filesets}) {
1749 my @filesets = CGI::param('fileset');
1751 $ret{filesets} = \@filesets;
1752 my $str = $self->dbh_join(@filesets);
1753 $limit .= "AND FileSet.FileSet IN ($str) ";
1757 if ($elt{mediatypes}) {
1758 my @medias = CGI::param('mediatype');
1760 $ret{mediatypes} = \@medias;
1761 my $str = $self->dbh_join(@medias);
1762 $limit .= "AND Media.MediaType IN ($str) ";
1767 my $client = CGI::param('client');
1768 $ret{client} = $client;
1769 $client = $self->dbh_join($client);
1770 $limit .= "AND Client.Name = $client ";
1774 my $level = CGI::param('level') || '';
1775 if ($level =~ /^(\w)$/) {
1777 $limit .= "AND Job.Level = '$1' ";
1782 my $jobid = CGI::param('jobid') || '';
1784 if ($jobid =~ /^(\d+)$/) {
1786 $limit .= "AND Job.JobId = '$1' ";
1791 my $status = CGI::param('status') || '';
1792 if ($status =~ /^(\w)$/) {
1794 $limit .= "AND Job.JobStatus = '$1' ";
1798 if ($elt{locations}) {
1799 my @location = CGI::param('location') ;
1801 $ret{locations} = \@location;
1802 my $str = $self->dbh_join(@location);
1803 $limit .= "AND Location.Location IN ($str) ";
1808 my @pool = CGI::param('pool') ;
1810 $ret{pools} = \@pool;
1811 my $str = $self->dbh_join(@pool);
1812 $limit .= "AND Pool.Name IN ($str) ";
1816 if ($elt{location}) {
1817 my $location = CGI::param('location') || '';
1819 $ret{location} = $location;
1820 $location = $self->dbh_quote($location);
1821 $limit .= "AND Location.Location = $location ";
1826 my $pool = CGI::param('pool') || '';
1829 $pool = $self->dbh_quote($pool);
1830 $limit .= "AND Pool.Name = $pool ";
1834 if ($elt{jobtype}) {
1835 my $jobtype = CGI::param('jobtype') || '';
1836 if ($jobtype =~ /^(\w)$/) {
1838 $limit .= "AND Job.Type = '$1' ";
1842 return ($limit, %ret);
1849 SELECT DISTINCT Job.JobId AS jobid,
1850 Client.Name AS client,
1851 FileSet.FileSet AS fileset,
1852 Job.Name AS jobname,
1854 StartTime AS starttime,
1855 JobFiles AS jobfiles,
1856 JobBytes AS jobbytes,
1857 VolumeName AS volumename,
1858 JobStatus AS jobstatus,
1859 JobErrors AS joberrors
1861 FROM Client,Job,JobMedia,Media,FileSet
1862 WHERE Client.ClientId=Job.ClientId
1863 AND Job.FileSetId=FileSet.FileSetId
1864 AND JobMedia.JobId=Job.JobId
1865 AND JobMedia.MediaId=Media.MediaId
1872 my ($self, %arg) = @_ ;
1874 $arg{order} = ' Job.JobId DESC ';
1876 my ($limit, $label) = $self->get_limit(%arg);
1877 my ($where, undef) = $self->get_param('clients',
1885 SELECT Job.JobId AS jobid,
1886 Client.Name AS client,
1887 FileSet.FileSet AS fileset,
1888 Job.Name AS jobname,
1890 StartTime AS starttime,
1891 Pool.Name AS poolname,
1892 JobFiles AS jobfiles,
1893 JobBytes AS jobbytes,
1894 JobStatus AS jobstatus,
1895 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1896 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1899 JobErrors AS joberrors
1902 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1903 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1904 WHERE Client.ClientId=Job.ClientId
1905 AND Job.JobStatus != 'R'
1910 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1912 foreach (values %$all) {
1913 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1916 $self->display({ Filter => $label,
1920 sort { $a->{jobid} <=> $b->{jobid} }
1927 # display job informations
1928 sub display_job_zoom
1930 my ($self, $jobid) = @_ ;
1932 $jobid = $self->dbh_quote($jobid);
1935 SELECT DISTINCT Job.JobId AS jobid,
1936 Client.Name AS client,
1937 Job.Name AS jobname,
1938 FileSet.FileSet AS fileset,
1940 Pool.Name AS poolname,
1941 StartTime AS starttime,
1942 JobFiles AS jobfiles,
1943 JobBytes AS jobbytes,
1944 JobStatus AS jobstatus,
1945 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1946 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1949 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1950 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1951 WHERE Client.ClientId=Job.ClientId
1952 AND Job.JobId = $jobid
1955 my $row = $self->dbh_selectrow_hashref($query) ;
1957 $row->{jobbytes} = human_size($row->{jobbytes}) ;
1959 # display all volumes associate with this job
1961 SELECT Media.VolumeName as volumename
1962 FROM Job,Media,JobMedia
1963 WHERE Job.JobId = $jobid
1964 AND JobMedia.JobId=Job.JobId
1965 AND JobMedia.MediaId=Media.MediaId
1968 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1970 $row->{volumes} = [ values %$all ] ;
1972 $self->display($row, "display_job_zoom.tpl");
1979 my ($where, %elt) = $self->get_param('pool',
1982 my $arg = $self->get_form('jmedias', 'qre_media');
1984 if ($arg->{jmedias}) {
1985 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1987 if ($arg->{qre_media}) {
1988 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1992 SELECT Media.VolumeName AS volumename,
1993 Media.VolBytes AS volbytes,
1994 Media.VolStatus AS volstatus,
1995 Media.MediaType AS mediatype,
1996 Media.InChanger AS online,
1997 Media.LastWritten AS lastwritten,
1998 Location.Location AS location,
1999 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2000 Pool.Name AS poolname,
2001 $self->{sql}->{FROM_UNIXTIME}(
2002 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2003 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2006 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2007 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2008 Media.MediaType AS MediaType
2010 WHERE Media.VolStatus = 'Full'
2011 GROUP BY Media.MediaType
2012 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2014 WHERE Media.PoolId=Pool.PoolId
2018 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2019 foreach (values %$all) {
2020 $_->{volbytes} = human_size($_->{volbytes}) ;
2023 $self->display({ ID => $cur_id++,
2025 Location => $elt{location},
2026 Medias => [ values %$all ]
2028 "display_media.tpl");
2035 my $pool = $self->get_form('db_pools');
2037 foreach my $name (@{ $pool->{db_pools} }) {
2038 CGI::param('pool', $name->{name});
2039 $self->display_media();
2043 sub display_media_zoom
2047 my $medias = $self->get_form('jmedias');
2049 unless ($medias->{jmedias}) {
2050 return $self->error("Can't get media selection");
2054 SELECT InChanger AS online,
2055 VolBytes AS nb_bytes,
2056 VolumeName AS volumename,
2057 VolStatus AS volstatus,
2058 VolMounts AS nb_mounts,
2059 Media.VolUseDuration AS voluseduration,
2060 Media.MaxVolJobs AS maxvoljobs,
2061 Media.MaxVolFiles AS maxvolfiles,
2062 Media.MaxVolBytes AS maxvolbytes,
2063 VolErrors AS nb_errors,
2064 Pool.Name AS poolname,
2065 Location.Location AS location,
2066 Media.Recycle AS recycle,
2067 Media.VolRetention AS volretention,
2068 Media.LastWritten AS lastwritten,
2069 Media.VolReadTime/1000000 AS volreadtime,
2070 Media.VolWriteTime/1000000 AS volwritetime,
2071 $self->{sql}->{FROM_UNIXTIME}(
2072 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2073 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2076 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2077 WHERE Pool.PoolId = Media.PoolId
2078 AND VolumeName IN ($medias->{jmedias})
2081 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2083 foreach my $media (values %$all) {
2084 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
2085 $media->{voluseduration} = human_sec($media->{voluseduration});
2086 $media->{volretention} = human_sec($media->{volretention});
2087 $media->{volreadtime} = human_sec($media->{volreadtime});
2088 $media->{volwritetime} = human_sec($media->{volwritetime});
2089 my $mq = $self->dbh_quote($media->{volumename});
2092 SELECT DISTINCT Job.JobId AS jobid,
2094 Job.StartTime AS starttime,
2097 Job.JobFiles AS files,
2098 Job.JobBytes AS bytes,
2099 Job.jobstatus AS status
2100 FROM Media,JobMedia,Job
2101 WHERE Media.VolumeName=$mq
2102 AND Media.MediaId=JobMedia.MediaId
2103 AND JobMedia.JobId=Job.JobId
2106 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2108 foreach (values %$jobs) {
2109 $_->{bytes} = human_size($_->{bytes}) ;
2113 SELECT LocationLog.Date AS date,
2114 Location.Location AS location,
2115 LocationLog.Comment AS comment
2116 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2117 WHERE Media.MediaId = LocationLog.MediaId
2118 AND Media.VolumeName = $mq
2122 my $log = $self->dbh_selectall_arrayref($query) ;
2124 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2127 $self->display({ jobs => [ values %$jobs ],
2128 LocationLog => $logtxt,
2130 "display_media_zoom.tpl");
2138 my $loc = $self->get_form('qlocation');
2139 unless ($loc->{qlocation}) {
2140 return $self->error("Can't get location");
2144 SELECT Location.Location AS location,
2145 Location.Cost AS cost,
2146 Location.Enabled AS enabled
2148 WHERE Location.Location = $loc->{qlocation}
2151 my $row = $self->dbh_selectrow_hashref($query);
2153 $self->display({ ID => $cur_id++,
2154 %$row }, "location_edit.tpl") ;
2162 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2163 unless ($arg->{qlocation}) {
2164 return $self->error("Can't get location");
2166 unless ($arg->{qnewlocation}) {
2167 return $self->error("Can't get new location name");
2169 unless ($arg->{cost}) {
2170 return $self->error("Can't get new cost");
2173 my $enabled = CGI::param('enabled') || '';
2174 $enabled = $enabled?1:0;
2177 UPDATE Location SET Cost = $arg->{cost},
2178 Location = $arg->{qnewlocation},
2180 WHERE Location.Location = $arg->{qlocation}
2183 $self->dbh_do($query);
2185 $self->display_location();
2191 my $arg = $self->get_form(qw/qlocation cost/) ;
2193 unless ($arg->{qlocation}) {
2194 $self->display({}, "location_add.tpl");
2197 unless ($arg->{cost}) {
2198 return $self->error("Can't get new cost");
2201 my $enabled = CGI::param('enabled') || '';
2202 $enabled = $enabled?1:0;
2205 INSERT INTO Location (Location, Cost, Enabled)
2206 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2209 $self->dbh_do($query);
2211 $self->display_location();
2214 sub display_location
2219 SELECT Location.Location AS location,
2220 Location.Cost AS cost,
2221 Location.Enabled AS enabled,
2222 (SELECT count(Media.MediaId)
2224 WHERE Media.LocationId = Location.LocationId
2229 my $location = $self->dbh_selectall_hashref($query, 'location');
2231 $self->display({ ID => $cur_id++,
2232 Locations => [ values %$location ] },
2233 "display_location.tpl");
2240 my $medias = $self->get_selected_media_location();
2245 my $arg = $self->get_form('db_locations', 'qnewlocation');
2247 $self->display({ email => $self->{info}->{email_media},
2249 medias => [ values %$medias ],
2251 "update_location.tpl");
2254 sub get_media_max_size
2256 my ($self, $type) = @_;
2258 "SELECT avg(VolBytes) AS size
2260 WHERE Media.VolStatus = 'Full'
2261 AND Media.MediaType = '$type'
2264 my $res = $self->selectrow_hashref($query);
2267 return $res->{size};
2277 my $media = CGI::param('media');
2279 return $self->error("Can't find media selection");
2282 $media = $self->dbh_quote($media);
2286 my $volstatus = CGI::param('volstatus') || '';
2287 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2288 $update .= " VolStatus=$volstatus, ";
2290 my $inchanger = CGI::param('inchanger') || '';
2292 $update .= " InChanger=1, " ;
2293 my $slot = CGI::param('slot') || '';
2294 if ($slot =~ /^(\d+)$/) {
2295 $update .= " Slot=$1, ";
2297 $update .= " Slot=0, ";
2300 $update = " Slot=0, InChanger=0, ";
2303 my $pool = CGI::param('pool') || '';
2304 $pool = $self->dbh_quote($pool); # is checked by db
2305 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2307 my $volretention = CGI::param('volretention') || '';
2308 $volretention = from_human_sec($volretention);
2309 unless ($volretention) {
2310 return $self->error("Can't get volume retention");
2313 $update .= " VolRetention = $volretention, ";
2315 my $loc = CGI::param('location') || '';
2316 $loc = $self->dbh_quote($loc); # is checked by db
2317 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2319 my $usedu = CGI::param('voluseduration') || '0';
2320 $usedu = from_human_sec($usedu);
2321 $update .= " VolUseDuration=$usedu, ";
2323 my $maxj = CGI::param('maxvoljobs') || '0';
2324 unless ($maxj =~ /^(\d+)$/) {
2325 return $self->error("Can't get max jobs");
2327 $update .= " MaxVolJobs=$1, " ;
2329 my $maxf = CGI::param('maxvolfiles') || '0';
2330 unless ($maxj =~ /^(\d+)$/) {
2331 return $self->error("Can't get max files");
2333 $update .= " MaxVolFiles=$1, " ;
2335 my $maxb = CGI::param('maxvolbytes') || '0';
2336 unless ($maxb =~ /^(\d+)$/) {
2337 return $self->error("Can't get max bytes");
2339 $update .= " MaxVolBytes=$1 " ;
2341 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2344 print "Update Ok\n";
2345 $self->update_media();
2353 my $media = $self->get_form('qmedia');
2355 unless ($media->{qmedia}) {
2356 return $self->error("Can't get media");
2360 SELECT Media.Slot AS slot,
2361 Pool.Name AS poolname,
2362 Media.VolStatus AS volstatus,
2363 Media.InChanger AS inchanger,
2364 Location.Location AS location,
2365 Media.VolumeName AS volumename,
2366 Media.MaxVolBytes AS maxvolbytes,
2367 Media.MaxVolJobs AS maxvoljobs,
2368 Media.MaxVolFiles AS maxvolfiles,
2369 Media.VolUseDuration AS voluseduration,
2370 Media.VolRetention AS volretention
2372 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2373 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2375 WHERE Media.VolumeName = $media->{qmedia}
2378 my $row = $self->dbh_selectrow_hashref($query);
2379 $row->{volretention} = human_sec($row->{volretention});
2380 $row->{voluseduration} = human_sec($row->{voluseduration});
2382 my $elt = $self->get_form(qw/db_pools db_locations/);
2388 "update_media.tpl");
2395 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2397 unless ($arg->{jmedias}) {
2398 return $self->error("Can't get selected media");
2401 unless ($arg->{qnewlocation}) {
2402 return $self->error("Can't get new location");
2407 SET LocationId = (SELECT LocationId
2409 WHERE Location = $arg->{qnewlocation})
2410 WHERE Media.VolumeName IN ($arg->{jmedias})
2413 my $nb = $self->dbh_do($query);
2415 print "$nb media updated";
2422 my $medias = $self->get_selected_media_location();
2424 return $self->error("Can't get media selection");
2426 my $newloc = CGI::param('newlocation');
2428 my $user = CGI::param('user') || 'unknow';
2429 my $comm = CGI::param('comment') || '';
2430 $comm = $self->dbh_quote("$user: $comm");
2434 foreach my $media (keys %$medias) {
2436 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2438 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2439 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2440 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2443 $self->dbh_do($query);
2444 $self->debug($query);
2448 $q->param('action', 'update_location');
2449 my $url = $q->url(-full => 1, -query=>1);
2451 $self->display({ email => $self->{info}->{email_media},
2453 newlocation => $newloc,
2454 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2455 medias => [ values %$medias ],
2457 "change_location.tpl");
2461 sub display_client_stats
2463 my ($self, %arg) = @_ ;
2465 my $client = $self->dbh_quote($arg{clientname});
2466 my ($limit, $label) = $self->get_limit(%arg);
2470 count(Job.JobId) AS nb_jobs,
2471 sum(Job.JobBytes) AS nb_bytes,
2472 sum(Job.JobErrors) AS nb_err,
2473 sum(Job.JobFiles) AS nb_files,
2474 Client.Name AS clientname
2475 FROM Job INNER JOIN Client USING (ClientId)
2477 Client.Name = $client
2479 GROUP BY Client.Name
2482 my $row = $self->dbh_selectrow_hashref($query);
2484 $row->{ID} = $cur_id++;
2485 $row->{label} = $label;
2486 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2488 $self->display($row, "display_client_stats.tpl");
2491 # poolname can be undef
2494 my ($self, $poolname) = @_ ;
2496 # TODO : afficher les tailles et les dates
2499 SELECT sum(subq.volmax) AS volmax,
2500 sum(subq.volnum) AS volnum,
2501 sum(subq.voltotal) AS voltotal,
2503 Pool.Recycle AS recycle,
2504 Pool.VolRetention AS volretention,
2505 Pool.VolUseDuration AS voluseduration,
2506 Pool.MaxVolJobs AS maxvoljobs,
2507 Pool.MaxVolFiles AS maxvolfiles,
2508 Pool.MaxVolBytes AS maxvolbytes,
2509 subq.PoolId AS PoolId
2512 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2513 count(Media.MediaId) AS volnum,
2514 sum(Media.VolBytes) AS voltotal,
2515 Media.PoolId AS PoolId,
2516 Media.MediaType AS MediaType
2518 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2519 Media.MediaType AS MediaType
2521 WHERE Media.VolStatus = 'Full'
2522 GROUP BY Media.MediaType
2523 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2524 GROUP BY Media.MediaType, Media.PoolId
2526 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2527 GROUP BY subq.PoolId
2530 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2532 foreach my $p (values %$all) {
2533 $p->{maxvolbytes} = human_size($p->{maxvolbytes}) ;
2534 $p->{volretention} = human_sec($p->{volretention}) ;
2535 $p->{voluseduration} = human_sec($p->{voluseduration}) ;
2538 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2540 $p->{poolusage} = 0;
2544 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2546 WHERE PoolId=$p->{poolid}
2549 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2550 foreach my $t (values %$content) {
2551 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2556 $self->display({ ID => $cur_id++,
2557 Pools => [ values %$all ]},
2558 "display_pool.tpl");
2561 sub display_running_job
2565 my $arg = $self->get_form('client', 'jobid');
2567 if (!$arg->{client} and $arg->{jobid}) {
2570 SELECT Client.Name AS name
2571 FROM Job INNER JOIN Client USING (ClientId)
2572 WHERE Job.JobId = $arg->{jobid}
2575 my $row = $self->dbh_selectrow_hashref($query);
2578 $arg->{client} = $row->{name};
2579 CGI::param('client', $arg->{client});
2583 if ($arg->{client}) {
2584 my $cli = new Bweb::Client(name => $arg->{client});
2585 $cli->display_running_job($self->{info}, $arg->{jobid});
2586 if ($arg->{jobid}) {
2587 $self->get_job_log();
2590 $self->error("Can't get client or jobid");
2594 sub display_running_jobs
2596 my ($self, $display_action) = @_;
2599 SELECT Job.JobId AS jobid,
2600 Job.Name AS jobname,
2602 Job.StartTime AS starttime,
2603 Job.JobFiles AS jobfiles,
2604 Job.JobBytes AS jobbytes,
2605 Job.JobStatus AS jobstatus,
2606 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2607 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2609 Client.Name AS clientname
2610 FROM Job INNER JOIN Client USING (ClientId)
2611 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2613 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2615 $self->display({ ID => $cur_id++,
2616 display_action => $display_action,
2617 Jobs => [ values %$all ]},
2618 "running_job.tpl") ;
2624 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2626 unless ($arg->{jmedias}) {
2627 return $self->error("Can't get media selection");
2630 my $a = $self->ach_get($arg->{ach});
2636 SELECT Media.VolumeName AS volumename,
2637 Storage.Name AS storage,
2638 Location.Location AS location,
2640 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2641 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2642 WHERE Media.VolumeName IN ($arg->{jmedias})
2643 AND Media.InChanger = 1
2646 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2650 foreach my $vol (values %$all) {
2651 print "eject $vol->{volumename} from $vol->{storage} : ";
2652 if ($a->send_to_io($vol->{slot})) {
2664 my $arg = $self->get_form('jobid', 'client');
2666 print CGI::header('text/brestore');
2667 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2668 print "client=$arg->{client}\n" if ($arg->{client});
2669 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2673 # TODO : move this to Bweb::Autochanger ?
2674 # TODO : make this internal to not eject tape ?
2680 my ($self, $name) = @_;
2683 return $self->error("Can't get your autochanger name ach");
2686 unless ($self->{info}->{ach_list}) {
2687 return $self->error("Could not find any autochanger");
2690 my $a = $self->{info}->{ach_list}->{$name};
2693 $self->error("Can't get your autochanger $name from your ach_list");
2704 my ($self, $ach) = @_;
2706 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2708 $self->{info}->save();
2716 my $arg = $self->get_form('ach');
2718 or !$self->{info}->{ach_list}
2719 or !$self->{info}->{ach_list}->{$arg->{ach}})
2721 return $self->error("Can't get autochanger name");
2724 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2728 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2730 my $b = $self->get_bconsole();
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 = $self->get_bconsole();
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 if ($arg->{jobid}) {
2809 my $b = $self->get_bconsole();
2810 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2813 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2814 title => "Delete a job ",
2815 name => "delete jobid=$arg->{jobid}",
2824 my $ach = CGI::param('ach') ;
2825 unless ($ach =~ /^([\w\d\.-]+)$/) {
2826 return $self->error("Bad autochanger name");
2829 my $b = $self->get_bconsole();
2830 print "<pre>" . $b->update_slots($ach) . "</pre>";
2837 my $arg = $self->get_form('jobid');
2838 unless ($arg->{jobid}) {
2839 return $self->error("Can't get jobid");
2842 my $t = CGI::param('time') || '';
2845 SELECT Job.Name as name, Client.Name as clientname
2846 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2847 WHERE JobId = $arg->{jobid}
2850 my $row = $self->dbh_selectrow_hashref($query);
2853 return $self->error("Can't find $arg->{jobid} in catalog");
2857 SELECT Time AS time, LogText AS log
2859 WHERE JobId = $arg->{jobid}
2862 my $log = $self->dbh_selectall_arrayref($query);
2864 return $self->error("Can't get log for jobid $arg->{jobid}");
2870 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2872 $logtxt = join("", map { $_->[1] } @$log ) ;
2875 $self->display({ lines=> $logtxt,
2876 jobid => $arg->{jobid},
2877 name => $row->{name},
2878 client => $row->{clientname},
2879 }, 'display_log.tpl');
2887 my $arg = $self->get_form('ach', 'slots', 'drive');
2889 unless ($arg->{ach}) {
2890 return $self->error("Can't find autochanger name");
2895 if ($arg->{slots}) {
2896 $slots = join(",", @{ $arg->{slots} });
2897 $t += 60*scalar( @{ $arg->{slots} }) ;
2900 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2901 print "<h1>This command can take long time, be patient...</h1>";
2903 $b->label_barcodes(storage => $arg->{ach},
2904 drive => $arg->{drive},
2915 my @volume = CGI::param('media');
2918 return $self->error("Can't get media selection");
2921 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2924 content => $b->purge_volume(@volume),
2925 title => "Purge media",
2926 name => "purge volume=" . join(' volume=', @volume),
2935 my @volume = CGI::param('media');
2937 return $self->error("Can't get media selection");
2940 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2943 content => $b->prune_volume(@volume),
2944 title => "Prune media",
2945 name => "prune volume=" . join(' volume=', @volume),
2955 my $arg = $self->get_form('jobid');
2956 unless ($arg->{jobid}) {
2957 return $self->error("Can't get jobid");
2960 my $b = $self->get_bconsole();
2962 content => $b->cancel($arg->{jobid}),
2963 title => "Cancel job",
2964 name => "cancel jobid=$arg->{jobid}",
2970 # Warning, we display current fileset
2973 my $arg = $self->get_form('fileset');
2975 if ($arg->{fileset}) {
2976 my $b = $self->get_bconsole();
2977 my $ret = $b->get_fileset($arg->{fileset});
2978 $self->display({ fileset => $arg->{fileset},
2980 }, "fileset_view.tpl");
2982 $self->error("Can't get fileset name");
2986 sub director_show_sched
2990 my $arg = $self->get_form('days');
2992 my $b = $self->get_bconsole();
2993 my $ret = $b->director_get_sched( $arg->{days} );
2998 }, "scheduled_job.tpl");
3001 sub enable_disable_job
3003 my ($self, $what) = @_ ;
3005 my $name = CGI::param('job') || '';
3006 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3007 return $self->error("Can't find job name");
3010 my $b = $self->get_bconsole();
3020 content => $b->send_cmd("$cmd job=\"$name\""),
3021 title => "$cmd $name",
3022 name => "$cmd job=\"$name\"",
3029 return new Bconsole(pref => $self->{info});
3035 my $b = $self->get_bconsole();
3037 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3039 $self->display({ Jobs => $joblist }, "run_job.tpl");
3044 my ($self, $ouput) = @_;
3047 foreach my $l (split(/\r\n/, $ouput)) {
3048 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3054 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3060 foreach my $k (keys %arg) {
3061 $lowcase{lc($k)} = $arg{$k} ;
3070 my $b = $self->get_bconsole();
3072 my $job = CGI::param('job') || '';
3074 my $info = $b->send_cmd("show job=\"$job\"");
3075 my $attr = $self->run_parse_job($info);
3077 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3079 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3080 my $clients = [ map { { name => $_ } }$b->list_client()];
3081 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3082 my $storages= [ map { { name => $_ } }$b->list_storage()];
3087 clients => $clients,
3088 filesets => $filesets,
3089 storages => $storages,
3091 }, "run_job_mod.tpl");
3097 my $b = $self->get_bconsole();
3099 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3109 my $b = $self->get_bconsole();
3111 # TODO: check input (don't use pool, level)
3113 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3114 my $job = CGI::param('job') || '';
3115 my $storage = CGI::param('storage') || '';
3117 my $jobid = $b->run(job => $job,
3118 client => $arg->{client},
3119 priority => $arg->{priority},
3120 level => $arg->{level},
3121 storage => $storage,
3122 pool => $arg->{pool},
3125 print $jobid, $b->{error};
3127 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";