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;
956 push @{ $param }, $all->{$vol};
958 } else { # empty or no label
959 push @{ $param }, {realslot => $slot,
960 volstatus => 'Unknow',
961 volumename => $self->{slot}->[$slot]} ;
964 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
968 my $i=0; my $drives = [] ;
969 foreach my $d (@{ $self->{drive} }) {
970 $drives->[$i] = { index => $i,
971 load => $self->{drive}->[$i],
972 name => $self->{drive_name}->[$i],
977 $bweb->display({ Name => $self->{name},
978 nb_drive => $self->{info}->{drive},
979 nb_io => $self->{info}->{io},
982 Update => scalar(@to_update) },
990 ################################################################
994 use base q/Bweb::Gui/;
998 Bweb - main Bweb package
1002 this package is use to compute and display informations
1007 use POSIX qw/strftime/;
1013 %sql_func - hash to make query mysql/postgresql compliant
1019 UNIX_TIMESTAMP => '',
1020 FROM_UNIXTIME => '',
1021 TO_SEC => " interval '1 second' * ",
1022 SEC_TO_INT => "SEC_TO_INT",
1025 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1026 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1027 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1028 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1029 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1030 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1033 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1034 FROM_UNIXTIME => 'FROM_UNIXTIME',
1037 SEC_TO_TIME => 'SEC_TO_TIME',
1038 MATCH => " REGEXP ",
1039 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1040 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1041 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1042 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1043 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1044 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1048 sub dbh_selectall_arrayref
1050 my ($self, $query) = @_;
1051 $self->connect_db();
1052 $self->debug($query);
1053 return $self->{dbh}->selectall_arrayref($query);
1058 my ($self, @what) = @_;
1059 return join(',', $self->dbh_quote(@what)) ;
1064 my ($self, @what) = @_;
1066 $self->connect_db();
1068 return map { $self->{dbh}->quote($_) } @what;
1070 return $self->{dbh}->quote($what[0]) ;
1076 my ($self, $query) = @_ ;
1077 $self->connect_db();
1078 $self->debug($query);
1079 return $self->{dbh}->do($query);
1082 sub dbh_selectall_hashref
1084 my ($self, $query, $join) = @_;
1086 $self->connect_db();
1087 $self->debug($query);
1088 return $self->{dbh}->selectall_hashref($query, $join) ;
1091 sub dbh_selectrow_hashref
1093 my ($self, $query) = @_;
1095 $self->connect_db();
1096 $self->debug($query);
1097 return $self->{dbh}->selectrow_hashref($query) ;
1103 my @unit = qw(b Kb Mb Gb Tb);
1104 my $val = shift || 0;
1106 my $format = '%i %s';
1107 while ($val / 1024 > 1) {
1111 $format = ($i>0)?'%0.1f %s':'%i %s';
1112 return sprintf($format, $val, $unit[$i]);
1115 # display Day, Hour, Year
1121 $val /= 60; # sec -> min
1123 if ($val / 60 <= 1) {
1127 $val /= 60; # min -> hour
1128 if ($val / 24 <= 1) {
1129 return "$val hours";
1132 $val /= 24; # hour -> day
1133 if ($val / 365 < 2) {
1137 $val /= 365 ; # day -> year
1139 return "$val years";
1142 # get Day, Hour, Year
1148 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1152 my %times = ( m => 60,
1158 my $mult = $times{$2} || 0;
1168 unless ($self->{dbh}) {
1169 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1170 $self->{info}->{user},
1171 $self->{info}->{password});
1173 print "Can't connect to your database, see error log\n"
1174 unless ($self->{dbh});
1176 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1182 my ($class, %arg) = @_;
1184 dbh => undef, # connect_db();
1186 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1192 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1194 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1195 $self->{sql} = $sql_func{$1};
1198 $self->{debug} = $self->{info}->{debug};
1199 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1207 $self->display($self->{info}, "begin.tpl");
1213 $self->display($self->{info}, "end.tpl");
1221 my $arg = $self->get_form("client", "qre_client");
1223 if ($arg->{qre_client}) {
1224 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1225 } elsif ($arg->{client}) {
1226 $where = "WHERE Name = '$arg->{client}' ";
1230 SELECT Name AS name,
1232 AutoPrune AS autoprune,
1233 FileRetention AS fileretention,
1234 JobRetention AS jobretention
1239 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1241 my $dsp = { ID => $cur_id++,
1242 clients => [ values %$all] };
1244 $self->display($dsp, "client_list.tpl") ;
1249 my ($self, %arg) = @_;
1256 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1258 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1260 $self->{sql}->{TO_SEC}($arg{age})
1263 $label = "last " . human_sec($arg{age});
1266 if ($arg{groupby}) {
1267 $limit .= " GROUP BY $arg{groupby} ";
1271 $limit .= " ORDER BY $arg{order} ";
1275 $limit .= " LIMIT $arg{limit} ";
1276 $label .= " limited to $arg{limit}";
1280 $limit .= " OFFSET $arg{offset} ";
1281 $label .= " with $arg{offset} offset ";
1285 $label = 'no filter';
1288 return ($limit, $label);
1293 $bweb->get_form(...) - Get useful stuff
1297 This function get and check parameters against regexp.
1299 If word begin with 'q', the return will be quoted or join quoted
1300 if it's end with 's'.
1305 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1308 qclient => 'plume-fd',
1309 qpools => "'plume-fd', 'test-fd', '...'",
1316 my ($self, @what) = @_;
1317 my %what = map { $_ => 1 } @what;
1334 my %opt_s = ( # default to ''
1347 my %opt_p = ( # option with path
1354 foreach my $i (@what) {
1355 if (exists $opt_i{$i}) {# integer param
1356 my $value = CGI::param($i) || $opt_i{$i} ;
1357 if ($value =~ /^(\d+)$/) {
1360 } elsif ($opt_s{$i}) { # simple string param
1361 my $value = CGI::param($i) || '';
1362 if ($value =~ /^([\w\d\.-]+)$/) {
1366 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1367 my @value = CGI::param($1) ;
1369 $ret{$i} = $self->dbh_join(@value) ;
1372 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1373 my $value = CGI::param($1) ;
1375 $ret{$i} = $self->dbh_quote($value);
1378 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1379 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1381 } elsif (exists $opt_p{$i}) {
1382 my $value = CGI::param($i) || '';
1383 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1390 foreach my $s (CGI::param('slot')) {
1391 if ($s =~ /^(\d+)$/) {
1392 push @{$ret{slots}}, $s;
1397 if ($what{db_clients}) {
1399 SELECT Client.Name as clientname
1403 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1404 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1408 if ($what{db_mediatypes}) {
1410 SELECT MediaType as mediatype
1414 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1415 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1419 if ($what{db_locations}) {
1421 SELECT Location as location, Cost as cost FROM Location
1423 my $loc = $self->dbh_selectall_hashref($query, 'location');
1424 $ret{db_locations} = [ sort { $a->{location}
1430 if ($what{db_pools}) {
1431 my $query = "SELECT Name as name FROM Pool";
1433 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1434 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1437 if ($what{db_filesets}) {
1439 SELECT FileSet.FileSet AS fileset
1443 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1445 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1446 values %$filesets] ;
1449 if ($what{db_jobnames}) {
1451 SELECT DISTINCT Job.Name AS jobname
1455 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1457 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1458 values %$jobnames] ;
1461 if ($what{db_devices}) {
1463 SELECT Device.Name AS name
1467 my $devices = $self->dbh_selectall_hashref($query, 'name');
1469 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1480 my $fields = $self->get_form(qw/age level status clients filesets
1482 db_clients limit db_filesets width height
1483 qclients qfilesets qjobnames db_jobnames/);
1486 my $url = CGI::url(-full => 0,
1489 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1491 # this organisation is to keep user choice between 2 click
1492 # TODO : fileset and client selection doesn't work
1501 sub display_client_job
1503 my ($self, %arg) = @_ ;
1505 $arg{order} = ' Job.JobId DESC ';
1506 my ($limit, $label) = $self->get_limit(%arg);
1508 my $clientname = $self->dbh_quote($arg{clientname});
1511 SELECT DISTINCT Job.JobId AS jobid,
1512 Job.Name AS jobname,
1513 FileSet.FileSet AS fileset,
1515 StartTime AS starttime,
1516 JobFiles AS jobfiles,
1517 JobBytes AS jobbytes,
1518 JobStatus AS jobstatus,
1519 JobErrors AS joberrors
1521 FROM Client,Job,FileSet
1522 WHERE Client.Name=$clientname
1523 AND Client.ClientId=Job.ClientId
1524 AND Job.FileSetId=FileSet.FileSetId
1528 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1530 $self->display({ clientname => $arg{clientname},
1533 Jobs => [ values %$all ],
1535 "display_client_job.tpl") ;
1538 sub get_selected_media_location
1542 my $medias = $self->get_form('jmedias');
1544 unless ($medias->{jmedias}) {
1549 SELECT Media.VolumeName AS volumename, Location.Location AS location
1550 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1551 WHERE Media.VolumeName IN ($medias->{jmedias})
1554 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1556 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1567 my $medias = $self->get_selected_media_location();
1573 my $elt = $self->get_form('db_locations');
1575 $self->display({ ID => $cur_id++,
1576 %$elt, # db_locations
1578 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1588 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1590 $self->display($elt, "help_extern.tpl");
1593 sub help_extern_compute
1597 my $number = CGI::param('limit') || '' ;
1598 unless ($number =~ /^(\d+)$/) {
1599 return $self->error("Bad arg number : $number ");
1602 my ($sql, undef) = $self->get_param('pools',
1603 'locations', 'mediatypes');
1606 SELECT Media.VolumeName AS volumename,
1607 Media.VolStatus AS volstatus,
1608 Media.LastWritten AS lastwritten,
1609 Media.MediaType AS mediatype,
1610 Media.VolMounts AS volmounts,
1612 Media.Recycle AS recycle,
1613 $self->{sql}->{FROM_UNIXTIME}(
1614 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1615 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1618 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1619 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1621 WHERE Media.InChanger = 1
1622 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1624 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1628 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1630 $self->display({ Medias => [ values %$all ] },
1631 "help_extern_compute.tpl");
1638 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1639 $self->display($param, "help_intern.tpl");
1642 sub help_intern_compute
1646 my $number = CGI::param('limit') || '' ;
1647 unless ($number =~ /^(\d+)$/) {
1648 return $self->error("Bad arg number : $number ");
1651 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1653 if (CGI::param('expired')) {
1655 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1656 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1662 SELECT Media.VolumeName AS volumename,
1663 Media.VolStatus AS volstatus,
1664 Media.LastWritten AS lastwritten,
1665 Media.MediaType AS mediatype,
1666 Media.VolMounts AS volmounts,
1668 $self->{sql}->{FROM_UNIXTIME}(
1669 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1670 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1673 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1674 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1676 WHERE Media.InChanger <> 1
1677 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1678 AND Media.Recycle = 1
1680 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1684 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1686 $self->display({ Medias => [ values %$all ] },
1687 "help_intern_compute.tpl");
1693 my ($self, %arg) = @_ ;
1695 my ($limit, $label) = $self->get_limit(%arg);
1699 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1700 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1701 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1702 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1703 (SELECT count(Job.JobId)
1705 WHERE Job.JobStatus IN ('E','e','f','A')
1708 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1711 my $row = $self->dbh_selectrow_hashref($query) ;
1713 $row->{nb_bytes} = human_size($row->{nb_bytes});
1715 $row->{db_size} = '???';
1716 $row->{label} = $label;
1718 $self->display($row, "general.tpl");
1723 my ($self, @what) = @_ ;
1724 my %elt = map { $_ => 1 } @what;
1729 if ($elt{clients}) {
1730 my @clients = CGI::param('client');
1732 $ret{clients} = \@clients;
1733 my $str = $self->dbh_join(@clients);
1734 $limit .= "AND Client.Name IN ($str) ";
1738 if ($elt{filesets}) {
1739 my @filesets = CGI::param('fileset');
1741 $ret{filesets} = \@filesets;
1742 my $str = $self->dbh_join(@filesets);
1743 $limit .= "AND FileSet.FileSet IN ($str) ";
1747 if ($elt{mediatypes}) {
1748 my @medias = CGI::param('mediatype');
1750 $ret{mediatypes} = \@medias;
1751 my $str = $self->dbh_join(@medias);
1752 $limit .= "AND Media.MediaType IN ($str) ";
1757 my $client = CGI::param('client');
1758 $ret{client} = $client;
1759 $client = $self->dbh_join($client);
1760 $limit .= "AND Client.Name = $client ";
1764 my $level = CGI::param('level') || '';
1765 if ($level =~ /^(\w)$/) {
1767 $limit .= "AND Job.Level = '$1' ";
1772 my $jobid = CGI::param('jobid') || '';
1774 if ($jobid =~ /^(\d+)$/) {
1776 $limit .= "AND Job.JobId = '$1' ";
1781 my $status = CGI::param('status') || '';
1782 if ($status =~ /^(\w)$/) {
1784 $limit .= "AND Job.JobStatus = '$1' ";
1788 if ($elt{locations}) {
1789 my @location = CGI::param('location') ;
1791 $ret{locations} = \@location;
1792 my $str = $self->dbh_join(@location);
1793 $limit .= "AND Location.Location IN ($str) ";
1798 my @pool = CGI::param('pool') ;
1800 $ret{pools} = \@pool;
1801 my $str = $self->dbh_join(@pool);
1802 $limit .= "AND Pool.Name IN ($str) ";
1806 if ($elt{location}) {
1807 my $location = CGI::param('location') || '';
1809 $ret{location} = $location;
1810 $location = $self->dbh_quote($location);
1811 $limit .= "AND Location.Location = $location ";
1816 my $pool = CGI::param('pool') || '';
1819 $pool = $self->dbh_quote($pool);
1820 $limit .= "AND Pool.Name = $pool ";
1824 if ($elt{jobtype}) {
1825 my $jobtype = CGI::param('jobtype') || '';
1826 if ($jobtype =~ /^(\w)$/) {
1828 $limit .= "AND Job.Type = '$1' ";
1832 return ($limit, %ret);
1843 my ($self, %arg) = @_ ;
1845 $arg{order} = ' Job.JobId DESC ';
1847 my ($limit, $label) = $self->get_limit(%arg);
1848 my ($where, undef) = $self->get_param('clients',
1856 SELECT Job.JobId AS jobid,
1857 Client.Name AS client,
1858 FileSet.FileSet AS fileset,
1859 Job.Name AS jobname,
1861 StartTime AS starttime,
1862 Pool.Name AS poolname,
1863 JobFiles AS jobfiles,
1864 JobBytes AS jobbytes,
1865 JobStatus AS jobstatus,
1866 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1867 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1870 JobErrors AS joberrors
1873 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1874 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1875 WHERE Client.ClientId=Job.ClientId
1876 AND Job.JobStatus != 'R'
1881 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1883 $self->display({ Filter => $label,
1887 sort { $a->{jobid} <=> $b->{jobid} }
1894 # display job informations
1895 sub display_job_zoom
1897 my ($self, $jobid) = @_ ;
1899 $jobid = $self->dbh_quote($jobid);
1902 SELECT DISTINCT Job.JobId AS jobid,
1903 Client.Name AS client,
1904 Job.Name AS jobname,
1905 FileSet.FileSet AS fileset,
1907 Pool.Name AS poolname,
1908 StartTime AS starttime,
1909 JobFiles AS jobfiles,
1910 JobBytes AS jobbytes,
1911 JobStatus AS jobstatus,
1912 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1913 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1916 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1917 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1918 WHERE Client.ClientId=Job.ClientId
1919 AND Job.JobId = $jobid
1922 my $row = $self->dbh_selectrow_hashref($query) ;
1924 # display all volumes associate with this job
1926 SELECT Media.VolumeName as volumename
1927 FROM Job,Media,JobMedia
1928 WHERE Job.JobId = $jobid
1929 AND JobMedia.JobId=Job.JobId
1930 AND JobMedia.MediaId=Media.MediaId
1933 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1935 $row->{volumes} = [ values %$all ] ;
1937 $self->display($row, "display_job_zoom.tpl");
1944 my ($where, %elt) = $self->get_param('pool',
1947 my $arg = $self->get_form('jmedias', 'qre_media');
1949 if ($arg->{jmedias}) {
1950 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1952 if ($arg->{qre_media}) {
1953 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1957 SELECT Media.VolumeName AS volumename,
1958 Media.VolBytes AS volbytes,
1959 Media.VolStatus AS volstatus,
1960 Media.MediaType AS mediatype,
1961 Media.InChanger AS online,
1962 Media.LastWritten AS lastwritten,
1963 Location.Location AS location,
1964 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1965 Pool.Name AS poolname,
1966 $self->{sql}->{FROM_UNIXTIME}(
1967 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1968 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1971 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1972 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1973 Media.MediaType AS MediaType
1975 WHERE Media.VolStatus = 'Full'
1976 GROUP BY Media.MediaType
1977 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
1979 WHERE Media.PoolId=Pool.PoolId
1983 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1985 $self->display({ ID => $cur_id++,
1987 Location => $elt{location},
1988 Medias => [ values %$all ]
1990 "display_media.tpl");
1997 my $pool = $self->get_form('db_pools');
1999 foreach my $name (@{ $pool->{db_pools} }) {
2000 CGI::param('pool', $name->{name});
2001 $self->display_media();
2005 sub display_media_zoom
2009 my $medias = $self->get_form('jmedias');
2011 unless ($medias->{jmedias}) {
2012 return $self->error("Can't get media selection");
2016 SELECT InChanger AS online,
2017 VolBytes AS nb_bytes,
2018 VolumeName AS volumename,
2019 VolStatus AS volstatus,
2020 VolMounts AS nb_mounts,
2021 Media.VolUseDuration AS voluseduration,
2022 Media.MaxVolJobs AS maxvoljobs,
2023 Media.MaxVolFiles AS maxvolfiles,
2024 Media.MaxVolBytes AS maxvolbytes,
2025 VolErrors AS nb_errors,
2026 Pool.Name AS poolname,
2027 Location.Location AS location,
2028 Media.Recycle AS recycle,
2029 Media.VolRetention AS volretention,
2030 Media.LastWritten AS lastwritten,
2031 Media.VolReadTime/1000000 AS volreadtime,
2032 Media.VolWriteTime/1000000 AS volwritetime,
2033 $self->{sql}->{FROM_UNIXTIME}(
2034 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2035 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2038 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2039 WHERE Pool.PoolId = Media.PoolId
2040 AND VolumeName IN ($medias->{jmedias})
2043 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2045 foreach my $media (values %$all) {
2046 my $mq = $self->dbh_quote($media->{volumename});
2049 SELECT DISTINCT Job.JobId AS jobid,
2051 Job.StartTime AS starttime,
2054 Job.JobFiles AS files,
2055 Job.JobBytes AS bytes,
2056 Job.jobstatus AS status
2057 FROM Media,JobMedia,Job
2058 WHERE Media.VolumeName=$mq
2059 AND Media.MediaId=JobMedia.MediaId
2060 AND JobMedia.JobId=Job.JobId
2063 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2066 SELECT LocationLog.Date AS date,
2067 Location.Location AS location,
2068 LocationLog.Comment AS comment
2069 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2070 WHERE Media.MediaId = LocationLog.MediaId
2071 AND Media.VolumeName = $mq
2075 my $log = $self->dbh_selectall_arrayref($query) ;
2077 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2080 $self->display({ jobs => [ values %$jobs ],
2081 LocationLog => $logtxt,
2083 "display_media_zoom.tpl");
2091 my $loc = $self->get_form('qlocation');
2092 unless ($loc->{qlocation}) {
2093 return $self->error("Can't get location");
2097 SELECT Location.Location AS location,
2098 Location.Cost AS cost,
2099 Location.Enabled AS enabled
2101 WHERE Location.Location = $loc->{qlocation}
2104 my $row = $self->dbh_selectrow_hashref($query);
2106 $self->display({ ID => $cur_id++,
2107 %$row }, "location_edit.tpl") ;
2115 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2116 unless ($arg->{qlocation}) {
2117 return $self->error("Can't get location");
2119 unless ($arg->{qnewlocation}) {
2120 return $self->error("Can't get new location name");
2122 unless ($arg->{cost}) {
2123 return $self->error("Can't get new cost");
2126 my $enabled = CGI::param('enabled') || '';
2127 $enabled = $enabled?1:0;
2130 UPDATE Location SET Cost = $arg->{cost},
2131 Location = $arg->{qnewlocation},
2133 WHERE Location.Location = $arg->{qlocation}
2136 $self->dbh_do($query);
2138 $self->display_location();
2144 my $arg = $self->get_form(qw/qlocation/) ;
2146 unless ($arg->{qlocation}) {
2147 return $self->error("Can't get location");
2151 SELECT count(Media.MediaId) AS nb
2152 FROM Media INNER JOIN Location USING (LocationID)
2153 WHERE Location = $arg->{qlocation}
2156 my $res = $self->dbh_selectrow_hashref($query);
2159 return $self->error("Sorry, the location must be empty");
2163 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2166 $self->dbh_do($query);
2168 $self->display_location();
2175 my $arg = $self->get_form(qw/qlocation cost/) ;
2177 unless ($arg->{qlocation}) {
2178 $self->display({}, "location_add.tpl");
2181 unless ($arg->{cost}) {
2182 return $self->error("Can't get new cost");
2185 my $enabled = CGI::param('enabled') || '';
2186 $enabled = $enabled?1:0;
2189 INSERT INTO Location (Location, Cost, Enabled)
2190 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2193 $self->dbh_do($query);
2195 $self->display_location();
2198 sub display_location
2203 SELECT Location.Location AS location,
2204 Location.Cost AS cost,
2205 Location.Enabled AS enabled,
2206 (SELECT count(Media.MediaId)
2208 WHERE Media.LocationId = Location.LocationId
2213 my $location = $self->dbh_selectall_hashref($query, 'location');
2215 $self->display({ ID => $cur_id++,
2216 Locations => [ values %$location ] },
2217 "display_location.tpl");
2224 my $medias = $self->get_selected_media_location();
2229 my $arg = $self->get_form('db_locations', 'qnewlocation');
2231 $self->display({ email => $self->{info}->{email_media},
2233 medias => [ values %$medias ],
2235 "update_location.tpl");
2238 sub get_media_max_size
2240 my ($self, $type) = @_;
2242 "SELECT avg(VolBytes) AS size
2244 WHERE Media.VolStatus = 'Full'
2245 AND Media.MediaType = '$type'
2248 my $res = $self->selectrow_hashref($query);
2251 return $res->{size};
2261 my $media = CGI::param('media');
2263 return $self->error("Can't find media selection");
2266 $media = $self->dbh_quote($media);
2270 my $volstatus = CGI::param('volstatus') || '';
2271 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2272 $update .= " VolStatus=$volstatus, ";
2274 my $inchanger = CGI::param('inchanger') || '';
2276 $update .= " InChanger=1, " ;
2277 my $slot = CGI::param('slot') || '';
2278 if ($slot =~ /^(\d+)$/) {
2279 $update .= " Slot=$1, ";
2281 $update .= " Slot=0, ";
2284 $update = " Slot=0, InChanger=0, ";
2287 my $pool = CGI::param('pool') || '';
2288 $pool = $self->dbh_quote($pool); # is checked by db
2289 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2291 my $volretention = CGI::param('volretention') || '';
2292 $volretention = from_human_sec($volretention);
2293 unless ($volretention) {
2294 return $self->error("Can't get volume retention");
2297 $update .= " VolRetention = $volretention, ";
2299 my $loc = CGI::param('location') || '';
2300 $loc = $self->dbh_quote($loc); # is checked by db
2301 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2303 my $usedu = CGI::param('voluseduration') || '0';
2304 $usedu = from_human_sec($usedu);
2305 $update .= " VolUseDuration=$usedu, ";
2307 my $maxj = CGI::param('maxvoljobs') || '0';
2308 unless ($maxj =~ /^(\d+)$/) {
2309 return $self->error("Can't get max jobs");
2311 $update .= " MaxVolJobs=$1, " ;
2313 my $maxf = CGI::param('maxvolfiles') || '0';
2314 unless ($maxj =~ /^(\d+)$/) {
2315 return $self->error("Can't get max files");
2317 $update .= " MaxVolFiles=$1, " ;
2319 my $maxb = CGI::param('maxvolbytes') || '0';
2320 unless ($maxb =~ /^(\d+)$/) {
2321 return $self->error("Can't get max bytes");
2323 $update .= " MaxVolBytes=$1 " ;
2325 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2328 print "Update Ok\n";
2329 $self->update_media();
2337 my $media = $self->get_form('qmedia');
2339 unless ($media->{qmedia}) {
2340 return $self->error("Can't get media");
2344 SELECT Media.Slot AS slot,
2345 Pool.Name AS poolname,
2346 Media.VolStatus AS volstatus,
2347 Media.InChanger AS inchanger,
2348 Location.Location AS location,
2349 Media.VolumeName AS volumename,
2350 Media.MaxVolBytes AS maxvolbytes,
2351 Media.MaxVolJobs AS maxvoljobs,
2352 Media.MaxVolFiles AS maxvolfiles,
2353 Media.VolUseDuration AS voluseduration,
2354 Media.VolRetention AS volretention
2356 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2357 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2359 WHERE Media.VolumeName = $media->{qmedia}
2362 my $row = $self->dbh_selectrow_hashref($query);
2363 $row->{volretention} = human_sec($row->{volretention});
2364 $row->{voluseduration} = human_sec($row->{voluseduration});
2366 my $elt = $self->get_form(qw/db_pools db_locations/);
2371 }, "update_media.tpl");
2378 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2380 unless ($arg->{jmedias}) {
2381 return $self->error("Can't get selected media");
2384 unless ($arg->{qnewlocation}) {
2385 return $self->error("Can't get new location");
2390 SET LocationId = (SELECT LocationId
2392 WHERE Location = $arg->{qnewlocation})
2393 WHERE Media.VolumeName IN ($arg->{jmedias})
2396 my $nb = $self->dbh_do($query);
2398 print "$nb media updated";
2405 my $medias = $self->get_selected_media_location();
2407 return $self->error("Can't get media selection");
2409 my $newloc = CGI::param('newlocation');
2411 my $user = CGI::param('user') || 'unknow';
2412 my $comm = CGI::param('comment') || '';
2413 $comm = $self->dbh_quote("$user: $comm");
2417 foreach my $media (keys %$medias) {
2419 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2421 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2422 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2423 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2426 $self->dbh_do($query);
2427 $self->debug($query);
2431 $q->param('action', 'update_location');
2432 my $url = $q->url(-full => 1, -query=>1);
2434 $self->display({ email => $self->{info}->{email_media},
2436 newlocation => $newloc,
2437 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2438 medias => [ values %$medias ],
2440 "change_location.tpl");
2444 sub display_client_stats
2446 my ($self, %arg) = @_ ;
2448 my $client = $self->dbh_quote($arg{clientname});
2449 my ($limit, $label) = $self->get_limit(%arg);
2453 count(Job.JobId) AS nb_jobs,
2454 sum(Job.JobBytes) AS nb_bytes,
2455 sum(Job.JobErrors) AS nb_err,
2456 sum(Job.JobFiles) AS nb_files,
2457 Client.Name AS clientname
2458 FROM Job INNER JOIN Client USING (ClientId)
2460 Client.Name = $client
2462 GROUP BY Client.Name
2465 my $row = $self->dbh_selectrow_hashref($query);
2467 $row->{ID} = $cur_id++;
2468 $row->{label} = $label;
2470 $self->display($row, "display_client_stats.tpl");
2473 # poolname can be undef
2476 my ($self, $poolname) = @_ ;
2478 # TODO : afficher les tailles et les dates
2481 SELECT sum(subq.volmax) AS volmax,
2482 sum(subq.volnum) AS volnum,
2483 sum(subq.voltotal) AS voltotal,
2485 Pool.Recycle AS recycle,
2486 Pool.VolRetention AS volretention,
2487 Pool.VolUseDuration AS voluseduration,
2488 Pool.MaxVolJobs AS maxvoljobs,
2489 Pool.MaxVolFiles AS maxvolfiles,
2490 Pool.MaxVolBytes AS maxvolbytes,
2491 subq.PoolId AS PoolId
2494 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2495 count(Media.MediaId) AS volnum,
2496 sum(Media.VolBytes) AS voltotal,
2497 Media.PoolId AS PoolId,
2498 Media.MediaType AS MediaType
2500 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2501 Media.MediaType AS MediaType
2503 WHERE Media.VolStatus = 'Full'
2504 GROUP BY Media.MediaType
2505 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2506 GROUP BY Media.MediaType, Media.PoolId
2508 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2509 GROUP BY subq.PoolId
2512 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2514 foreach my $p (values %$all) {
2516 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2518 $p->{poolusage} = 0;
2522 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2524 WHERE PoolId=$p->{poolid}
2527 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2528 foreach my $t (values %$content) {
2529 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2534 $self->display({ ID => $cur_id++,
2535 Pools => [ values %$all ]},
2536 "display_pool.tpl");
2539 sub display_running_job
2543 my $arg = $self->get_form('client', 'jobid');
2545 if (!$arg->{client} and $arg->{jobid}) {
2548 SELECT Client.Name AS name
2549 FROM Job INNER JOIN Client USING (ClientId)
2550 WHERE Job.JobId = $arg->{jobid}
2553 my $row = $self->dbh_selectrow_hashref($query);
2556 $arg->{client} = $row->{name};
2557 CGI::param('client', $arg->{client});
2561 if ($arg->{client}) {
2562 my $cli = new Bweb::Client(name => $arg->{client});
2563 $cli->display_running_job($self->{info}, $arg->{jobid});
2564 if ($arg->{jobid}) {
2565 $self->get_job_log();
2568 $self->error("Can't get client or jobid");
2572 sub display_running_jobs
2574 my ($self, $display_action) = @_;
2577 SELECT Job.JobId AS jobid,
2578 Job.Name AS jobname,
2580 Job.StartTime AS starttime,
2581 Job.JobFiles AS jobfiles,
2582 Job.JobBytes AS jobbytes,
2583 Job.JobStatus AS jobstatus,
2584 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2585 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2587 Client.Name AS clientname
2588 FROM Job INNER JOIN Client USING (ClientId)
2589 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2591 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2593 $self->display({ ID => $cur_id++,
2594 display_action => $display_action,
2595 Jobs => [ values %$all ]},
2596 "running_job.tpl") ;
2602 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2604 unless ($arg->{jmedias}) {
2605 return $self->error("Can't get media selection");
2608 my $a = $self->ach_get($arg->{ach});
2614 SELECT Media.VolumeName AS volumename,
2615 Storage.Name AS storage,
2616 Location.Location AS location,
2618 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2619 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2620 WHERE Media.VolumeName IN ($arg->{jmedias})
2621 AND Media.InChanger = 1
2624 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2628 foreach my $vol (values %$all) {
2629 print "eject $vol->{volumename} from $vol->{storage} : ";
2630 if ($a->send_to_io($vol->{slot})) {
2642 my $arg = $self->get_form('jobid', 'client');
2644 print CGI::header('text/brestore');
2645 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2646 print "client=$arg->{client}\n" if ($arg->{client});
2647 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2651 # TODO : move this to Bweb::Autochanger ?
2652 # TODO : make this internal to not eject tape ?
2658 my ($self, $name) = @_;
2661 return $self->error("Can't get your autochanger name ach");
2664 unless ($self->{info}->{ach_list}) {
2665 return $self->error("Could not find any autochanger");
2668 my $a = $self->{info}->{ach_list}->{$name};
2671 $self->error("Can't get your autochanger $name from your ach_list");
2682 my ($self, $ach) = @_;
2684 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2686 $self->{info}->save();
2694 my $arg = $self->get_form('ach');
2696 or !$self->{info}->{ach_list}
2697 or !$self->{info}->{ach_list}->{$arg->{ach}})
2699 return $self->error("Can't get autochanger name");
2702 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2706 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2708 my $b = $self->get_bconsole();
2710 my @storages = $b->list_storage() ;
2712 $ach->{devices} = [ map { { name => $_ } } @storages ];
2714 $self->display($ach, "ach_add.tpl");
2715 delete $ach->{drives};
2716 delete $ach->{devices};
2723 my $arg = $self->get_form('ach');
2726 or !$self->{info}->{ach_list}
2727 or !$self->{info}->{ach_list}->{$arg->{ach}})
2729 return $self->error("Can't get autochanger name");
2732 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2734 $self->{info}->save();
2735 $self->{info}->view();
2741 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2743 my $b = $self->get_bconsole();
2744 my @storages = $b->list_storage() ;
2746 unless ($arg->{ach}) {
2747 $arg->{devices} = [ map { { name => $_ } } @storages ];
2748 return $self->display($arg, "ach_add.tpl");
2752 foreach my $drive (CGI::param('drives'))
2754 unless (grep(/^$drive$/,@storages)) {
2755 return $self->error("Can't find $drive in storage list");
2758 my $index = CGI::param("index_$drive");
2759 unless (defined $index and $index =~ /^(\d+)$/) {
2760 return $self->error("Can't get $drive index");
2763 $drives[$index] = $drive;
2767 return $self->error("Can't get drives from Autochanger");
2770 my $a = new Bweb::Autochanger(name => $arg->{ach},
2771 precmd => $arg->{precmd},
2772 drive_name => \@drives,
2773 device => $arg->{device},
2774 mtxcmd => $arg->{mtxcmd});
2776 $self->ach_register($a) ;
2778 $self->{info}->view();
2784 my $arg = $self->get_form('jobid');
2786 if ($arg->{jobid}) {
2787 my $b = $self->get_bconsole();
2788 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2791 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2792 title => "Delete a job ",
2793 name => "delete jobid=$arg->{jobid}",
2802 my $ach = CGI::param('ach') ;
2803 unless ($ach =~ /^([\w\d\.-]+)$/) {
2804 return $self->error("Bad autochanger name");
2808 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2809 $b->update_slots($ach);
2817 my $arg = $self->get_form('jobid');
2818 unless ($arg->{jobid}) {
2819 return $self->error("Can't get jobid");
2822 my $t = CGI::param('time') || '';
2825 SELECT Job.Name as name, Client.Name as clientname
2826 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2827 WHERE JobId = $arg->{jobid}
2830 my $row = $self->dbh_selectrow_hashref($query);
2833 return $self->error("Can't find $arg->{jobid} in catalog");
2837 SELECT Time AS time, LogText AS log
2839 WHERE JobId = $arg->{jobid}
2842 my $log = $self->dbh_selectall_arrayref($query);
2844 return $self->error("Can't get log for jobid $arg->{jobid}");
2850 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2852 $logtxt = join("", map { $_->[1] } @$log ) ;
2855 $self->display({ lines=> $logtxt,
2856 jobid => $arg->{jobid},
2857 name => $row->{name},
2858 client => $row->{clientname},
2859 }, 'display_log.tpl');
2867 my $arg = $self->get_form('ach', 'slots', 'drive');
2869 unless ($arg->{ach}) {
2870 return $self->error("Can't find autochanger name");
2875 if ($arg->{slots}) {
2876 $slots = join(",", @{ $arg->{slots} });
2877 $t += 60*scalar( @{ $arg->{slots} }) ;
2880 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2881 print "<h1>This command can take long time, be patient...</h1>";
2883 $b->label_barcodes(storage => $arg->{ach},
2884 drive => $arg->{drive},
2895 my @volume = CGI::param('media');
2898 return $self->error("Can't get media selection");
2901 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2904 content => $b->purge_volume(@volume),
2905 title => "Purge media",
2906 name => "purge volume=" . join(' volume=', @volume),
2915 my @volume = CGI::param('media');
2917 return $self->error("Can't get media selection");
2920 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2923 content => $b->prune_volume(@volume),
2924 title => "Prune media",
2925 name => "prune volume=" . join(' volume=', @volume),
2935 my $arg = $self->get_form('jobid');
2936 unless ($arg->{jobid}) {
2937 return $self->error("Can't get jobid");
2940 my $b = $self->get_bconsole();
2942 content => $b->cancel($arg->{jobid}),
2943 title => "Cancel job",
2944 name => "cancel jobid=$arg->{jobid}",
2950 # Warning, we display current fileset
2953 my $arg = $self->get_form('fileset');
2955 if ($arg->{fileset}) {
2956 my $b = $self->get_bconsole();
2957 my $ret = $b->get_fileset($arg->{fileset});
2958 $self->display({ fileset => $arg->{fileset},
2960 }, "fileset_view.tpl");
2962 $self->error("Can't get fileset name");
2966 sub director_show_sched
2970 my $arg = $self->get_form('days');
2972 my $b = $self->get_bconsole();
2973 my $ret = $b->director_get_sched( $arg->{days} );
2978 }, "scheduled_job.tpl");
2981 sub enable_disable_job
2983 my ($self, $what) = @_ ;
2985 my $name = CGI::param('job') || '';
2986 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2987 return $self->error("Can't find job name");
2990 my $b = $self->get_bconsole();
3000 content => $b->send_cmd("$cmd job=\"$name\""),
3001 title => "$cmd $name",
3002 name => "$cmd job=\"$name\"",
3009 return new Bconsole(pref => $self->{info});
3015 my $b = $self->get_bconsole();
3017 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3019 $self->display({ Jobs => $joblist }, "run_job.tpl");
3024 my ($self, $ouput) = @_;
3027 foreach my $l (split(/\r\n/, $ouput)) {
3028 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3034 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3040 foreach my $k (keys %arg) {
3041 $lowcase{lc($k)} = $arg{$k} ;
3050 my $b = $self->get_bconsole();
3052 my $job = CGI::param('job') || '';
3054 my $info = $b->send_cmd("show job=\"$job\"");
3055 my $attr = $self->run_parse_job($info);
3057 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3059 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3060 my $clients = [ map { { name => $_ } }$b->list_client()];
3061 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3062 my $storages= [ map { { name => $_ } }$b->list_storage()];
3067 clients => $clients,
3068 filesets => $filesets,
3069 storages => $storages,
3071 }, "run_job_mod.tpl");
3077 my $b = $self->get_bconsole();
3079 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3089 my $b = $self->get_bconsole();
3091 # TODO: check input (don't use pool, level)
3093 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3094 my $job = CGI::param('job') || '';
3095 my $storage = CGI::param('storage') || '';
3097 my $jobid = $b->run(job => $job,
3098 client => $arg->{client},
3099 priority => $arg->{priority},
3100 level => $arg->{level},
3101 storage => $storage,
3102 pool => $arg->{pool},
3105 print $jobid, $b->{error};
3107 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";