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 cost/) ;
2146 unless ($arg->{qlocation}) {
2147 $self->display({}, "location_add.tpl");
2150 unless ($arg->{cost}) {
2151 return $self->error("Can't get new cost");
2154 my $enabled = CGI::param('enabled') || '';
2155 $enabled = $enabled?1:0;
2158 INSERT INTO Location (Location, Cost, Enabled)
2159 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2162 $self->dbh_do($query);
2164 $self->display_location();
2167 sub display_location
2172 SELECT Location.Location AS location,
2173 Location.Cost AS cost,
2174 Location.Enabled AS enabled,
2175 (SELECT count(Media.MediaId)
2177 WHERE Media.LocationId = Location.LocationId
2182 my $location = $self->dbh_selectall_hashref($query, 'location');
2184 $self->display({ ID => $cur_id++,
2185 Locations => [ values %$location ] },
2186 "display_location.tpl");
2193 my $medias = $self->get_selected_media_location();
2198 my $arg = $self->get_form('db_locations', 'qnewlocation');
2200 $self->display({ email => $self->{info}->{email_media},
2202 medias => [ values %$medias ],
2204 "update_location.tpl");
2207 sub get_media_max_size
2209 my ($self, $type) = @_;
2211 "SELECT avg(VolBytes) AS size
2213 WHERE Media.VolStatus = 'Full'
2214 AND Media.MediaType = '$type'
2217 my $res = $self->selectrow_hashref($query);
2220 return $res->{size};
2230 my $media = CGI::param('media');
2232 return $self->error("Can't find media selection");
2235 $media = $self->dbh_quote($media);
2239 my $volstatus = CGI::param('volstatus') || '';
2240 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2241 $update .= " VolStatus=$volstatus, ";
2243 my $inchanger = CGI::param('inchanger') || '';
2245 $update .= " InChanger=1, " ;
2246 my $slot = CGI::param('slot') || '';
2247 if ($slot =~ /^(\d+)$/) {
2248 $update .= " Slot=$1, ";
2250 $update .= " Slot=0, ";
2253 $update = " Slot=0, InChanger=0, ";
2256 my $pool = CGI::param('pool') || '';
2257 $pool = $self->dbh_quote($pool); # is checked by db
2258 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2260 my $volretention = CGI::param('volretention') || '';
2261 $volretention = from_human_sec($volretention);
2262 unless ($volretention) {
2263 return $self->error("Can't get volume retention");
2266 $update .= " VolRetention = $volretention, ";
2268 my $loc = CGI::param('location') || '';
2269 $loc = $self->dbh_quote($loc); # is checked by db
2270 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2272 my $usedu = CGI::param('voluseduration') || '0';
2273 $usedu = from_human_sec($usedu);
2274 $update .= " VolUseDuration=$usedu, ";
2276 my $maxj = CGI::param('maxvoljobs') || '0';
2277 unless ($maxj =~ /^(\d+)$/) {
2278 return $self->error("Can't get max jobs");
2280 $update .= " MaxVolJobs=$1, " ;
2282 my $maxf = CGI::param('maxvolfiles') || '0';
2283 unless ($maxj =~ /^(\d+)$/) {
2284 return $self->error("Can't get max files");
2286 $update .= " MaxVolFiles=$1, " ;
2288 my $maxb = CGI::param('maxvolbytes') || '0';
2289 unless ($maxb =~ /^(\d+)$/) {
2290 return $self->error("Can't get max bytes");
2292 $update .= " MaxVolBytes=$1 " ;
2294 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2297 print "Update Ok\n";
2298 $self->update_media();
2306 my $media = $self->get_form('qmedia');
2308 unless ($media->{qmedia}) {
2309 return $self->error("Can't get media");
2313 SELECT Media.Slot AS slot,
2314 Pool.Name AS poolname,
2315 Media.VolStatus AS volstatus,
2316 Media.InChanger AS inchanger,
2317 Location.Location AS location,
2318 Media.VolumeName AS volumename,
2319 Media.MaxVolBytes AS maxvolbytes,
2320 Media.MaxVolJobs AS maxvoljobs,
2321 Media.MaxVolFiles AS maxvolfiles,
2322 Media.VolUseDuration AS voluseduration,
2323 Media.VolRetention AS volretention
2325 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2326 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2328 WHERE Media.VolumeName = $media->{qmedia}
2331 my $row = $self->dbh_selectrow_hashref($query);
2332 $row->{volretention} = human_sec($row->{volretention});
2333 $row->{voluseduration} = human_sec($row->{voluseduration});
2335 my $elt = $self->get_form(qw/db_pools db_locations/);
2340 }, "update_media.tpl");
2347 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2349 unless ($arg->{jmedias}) {
2350 return $self->error("Can't get selected media");
2353 unless ($arg->{qnewlocation}) {
2354 return $self->error("Can't get new location");
2359 SET LocationId = (SELECT LocationId
2361 WHERE Location = $arg->{qnewlocation})
2362 WHERE Media.VolumeName IN ($arg->{jmedias})
2365 my $nb = $self->dbh_do($query);
2367 print "$nb media updated";
2374 my $medias = $self->get_selected_media_location();
2376 return $self->error("Can't get media selection");
2378 my $newloc = CGI::param('newlocation');
2380 my $user = CGI::param('user') || 'unknow';
2381 my $comm = CGI::param('comment') || '';
2382 $comm = $self->dbh_quote("$user: $comm");
2386 foreach my $media (keys %$medias) {
2388 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2390 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2391 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2392 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2395 $self->dbh_do($query);
2396 $self->debug($query);
2400 $q->param('action', 'update_location');
2401 my $url = $q->url(-full => 1, -query=>1);
2403 $self->display({ email => $self->{info}->{email_media},
2405 newlocation => $newloc,
2406 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2407 medias => [ values %$medias ],
2409 "change_location.tpl");
2413 sub display_client_stats
2415 my ($self, %arg) = @_ ;
2417 my $client = $self->dbh_quote($arg{clientname});
2418 my ($limit, $label) = $self->get_limit(%arg);
2422 count(Job.JobId) AS nb_jobs,
2423 sum(Job.JobBytes) AS nb_bytes,
2424 sum(Job.JobErrors) AS nb_err,
2425 sum(Job.JobFiles) AS nb_files,
2426 Client.Name AS clientname
2427 FROM Job INNER JOIN Client USING (ClientId)
2429 Client.Name = $client
2431 GROUP BY Client.Name
2434 my $row = $self->dbh_selectrow_hashref($query);
2436 $row->{ID} = $cur_id++;
2437 $row->{label} = $label;
2439 $self->display($row, "display_client_stats.tpl");
2442 # poolname can be undef
2445 my ($self, $poolname) = @_ ;
2447 # TODO : afficher les tailles et les dates
2450 SELECT sum(subq.volmax) AS volmax,
2451 sum(subq.volnum) AS volnum,
2452 sum(subq.voltotal) AS voltotal,
2454 Pool.Recycle AS recycle,
2455 Pool.VolRetention AS volretention,
2456 Pool.VolUseDuration AS voluseduration,
2457 Pool.MaxVolJobs AS maxvoljobs,
2458 Pool.MaxVolFiles AS maxvolfiles,
2459 Pool.MaxVolBytes AS maxvolbytes,
2460 subq.PoolId AS PoolId
2463 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2464 count(Media.MediaId) AS volnum,
2465 sum(Media.VolBytes) AS voltotal,
2466 Media.PoolId AS PoolId,
2467 Media.MediaType AS MediaType
2469 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2470 Media.MediaType AS MediaType
2472 WHERE Media.VolStatus = 'Full'
2473 GROUP BY Media.MediaType
2474 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2475 GROUP BY Media.MediaType, Media.PoolId
2477 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2478 GROUP BY subq.PoolId
2481 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2483 foreach my $p (values %$all) {
2485 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2487 $p->{poolusage} = 0;
2491 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2493 WHERE PoolId=$p->{poolid}
2496 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2497 foreach my $t (values %$content) {
2498 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2503 $self->display({ ID => $cur_id++,
2504 Pools => [ values %$all ]},
2505 "display_pool.tpl");
2508 sub display_running_job
2512 my $arg = $self->get_form('client', 'jobid');
2514 if (!$arg->{client} and $arg->{jobid}) {
2517 SELECT Client.Name AS name
2518 FROM Job INNER JOIN Client USING (ClientId)
2519 WHERE Job.JobId = $arg->{jobid}
2522 my $row = $self->dbh_selectrow_hashref($query);
2525 $arg->{client} = $row->{name};
2526 CGI::param('client', $arg->{client});
2530 if ($arg->{client}) {
2531 my $cli = new Bweb::Client(name => $arg->{client});
2532 $cli->display_running_job($self->{info}, $arg->{jobid});
2533 if ($arg->{jobid}) {
2534 $self->get_job_log();
2537 $self->error("Can't get client or jobid");
2541 sub display_running_jobs
2543 my ($self, $display_action) = @_;
2546 SELECT Job.JobId AS jobid,
2547 Job.Name AS jobname,
2549 Job.StartTime AS starttime,
2550 Job.JobFiles AS jobfiles,
2551 Job.JobBytes AS jobbytes,
2552 Job.JobStatus AS jobstatus,
2553 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2554 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2556 Client.Name AS clientname
2557 FROM Job INNER JOIN Client USING (ClientId)
2558 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2560 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2562 $self->display({ ID => $cur_id++,
2563 display_action => $display_action,
2564 Jobs => [ values %$all ]},
2565 "running_job.tpl") ;
2571 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2573 unless ($arg->{jmedias}) {
2574 return $self->error("Can't get media selection");
2577 my $a = $self->ach_get($arg->{ach});
2583 SELECT Media.VolumeName AS volumename,
2584 Storage.Name AS storage,
2585 Location.Location AS location,
2587 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2588 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2589 WHERE Media.VolumeName IN ($arg->{jmedias})
2590 AND Media.InChanger = 1
2593 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2597 foreach my $vol (values %$all) {
2598 print "eject $vol->{volumename} from $vol->{storage} : ";
2599 if ($a->send_to_io($vol->{slot})) {
2611 my $arg = $self->get_form('jobid', 'client');
2613 print CGI::header('text/brestore');
2614 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2615 print "client=$arg->{client}\n" if ($arg->{client});
2616 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2620 # TODO : move this to Bweb::Autochanger ?
2621 # TODO : make this internal to not eject tape ?
2627 my ($self, $name) = @_;
2630 return $self->error("Can't get your autochanger name ach");
2633 unless ($self->{info}->{ach_list}) {
2634 return $self->error("Could not find any autochanger");
2637 my $a = $self->{info}->{ach_list}->{$name};
2640 $self->error("Can't get your autochanger $name from your ach_list");
2651 my ($self, $ach) = @_;
2653 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2655 $self->{info}->save();
2663 my $arg = $self->get_form('ach');
2665 or !$self->{info}->{ach_list}
2666 or !$self->{info}->{ach_list}->{$arg->{ach}})
2668 return $self->error("Can't get autochanger name");
2671 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2675 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2677 my $b = $self->get_bconsole();
2679 my @storages = $b->list_storage() ;
2681 $ach->{devices} = [ map { { name => $_ } } @storages ];
2683 $self->display($ach, "ach_add.tpl");
2684 delete $ach->{drives};
2685 delete $ach->{devices};
2692 my $arg = $self->get_form('ach');
2695 or !$self->{info}->{ach_list}
2696 or !$self->{info}->{ach_list}->{$arg->{ach}})
2698 return $self->error("Can't get autochanger name");
2701 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2703 $self->{info}->save();
2704 $self->{info}->view();
2710 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2712 my $b = $self->get_bconsole();
2713 my @storages = $b->list_storage() ;
2715 unless ($arg->{ach}) {
2716 $arg->{devices} = [ map { { name => $_ } } @storages ];
2717 return $self->display($arg, "ach_add.tpl");
2721 foreach my $drive (CGI::param('drives'))
2723 unless (grep(/^$drive$/,@storages)) {
2724 return $self->error("Can't find $drive in storage list");
2727 my $index = CGI::param("index_$drive");
2728 unless (defined $index and $index =~ /^(\d+)$/) {
2729 return $self->error("Can't get $drive index");
2732 $drives[$index] = $drive;
2736 return $self->error("Can't get drives from Autochanger");
2739 my $a = new Bweb::Autochanger(name => $arg->{ach},
2740 precmd => $arg->{precmd},
2741 drive_name => \@drives,
2742 device => $arg->{device},
2743 mtxcmd => $arg->{mtxcmd});
2745 $self->ach_register($a) ;
2747 $self->{info}->view();
2753 my $arg = $self->get_form('jobid');
2755 if ($arg->{jobid}) {
2756 my $b = $self->get_bconsole();
2757 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2760 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2761 title => "Delete a job ",
2762 name => "delete jobid=$arg->{jobid}",
2771 my $ach = CGI::param('ach') ;
2772 unless ($ach =~ /^([\w\d\.-]+)$/) {
2773 return $self->error("Bad autochanger name");
2777 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2778 $b->update_slots($ach);
2786 my $arg = $self->get_form('jobid');
2787 unless ($arg->{jobid}) {
2788 return $self->error("Can't get jobid");
2791 my $t = CGI::param('time') || '';
2794 SELECT Job.Name as name, Client.Name as clientname
2795 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2796 WHERE JobId = $arg->{jobid}
2799 my $row = $self->dbh_selectrow_hashref($query);
2802 return $self->error("Can't find $arg->{jobid} in catalog");
2806 SELECT Time AS time, LogText AS log
2808 WHERE JobId = $arg->{jobid}
2811 my $log = $self->dbh_selectall_arrayref($query);
2813 return $self->error("Can't get log for jobid $arg->{jobid}");
2819 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2821 $logtxt = join("", map { $_->[1] } @$log ) ;
2824 $self->display({ lines=> $logtxt,
2825 jobid => $arg->{jobid},
2826 name => $row->{name},
2827 client => $row->{clientname},
2828 }, 'display_log.tpl');
2836 my $arg = $self->get_form('ach', 'slots', 'drive');
2838 unless ($arg->{ach}) {
2839 return $self->error("Can't find autochanger name");
2844 if ($arg->{slots}) {
2845 $slots = join(",", @{ $arg->{slots} });
2846 $t += 60*scalar( @{ $arg->{slots} }) ;
2849 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2850 print "<h1>This command can take long time, be patient...</h1>";
2852 $b->label_barcodes(storage => $arg->{ach},
2853 drive => $arg->{drive},
2864 my @volume = CGI::param('media');
2867 return $self->error("Can't get media selection");
2870 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2873 content => $b->purge_volume(@volume),
2874 title => "Purge media",
2875 name => "purge volume=" . join(' volume=', @volume),
2884 my @volume = CGI::param('media');
2886 return $self->error("Can't get media selection");
2889 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2892 content => $b->prune_volume(@volume),
2893 title => "Prune media",
2894 name => "prune volume=" . join(' volume=', @volume),
2904 my $arg = $self->get_form('jobid');
2905 unless ($arg->{jobid}) {
2906 return $self->error("Can't get jobid");
2909 my $b = $self->get_bconsole();
2911 content => $b->cancel($arg->{jobid}),
2912 title => "Cancel job",
2913 name => "cancel jobid=$arg->{jobid}",
2919 # Warning, we display current fileset
2922 my $arg = $self->get_form('fileset');
2924 if ($arg->{fileset}) {
2925 my $b = $self->get_bconsole();
2926 my $ret = $b->get_fileset($arg->{fileset});
2927 $self->display({ fileset => $arg->{fileset},
2929 }, "fileset_view.tpl");
2931 $self->error("Can't get fileset name");
2935 sub director_show_sched
2939 my $arg = $self->get_form('days');
2941 my $b = $self->get_bconsole();
2942 my $ret = $b->director_get_sched( $arg->{days} );
2947 }, "scheduled_job.tpl");
2950 sub enable_disable_job
2952 my ($self, $what) = @_ ;
2954 my $name = CGI::param('job') || '';
2955 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2956 return $self->error("Can't find job name");
2959 my $b = $self->get_bconsole();
2969 content => $b->send_cmd("$cmd job=\"$name\""),
2970 title => "$cmd $name",
2971 name => "$cmd job=\"$name\"",
2978 return new Bconsole(pref => $self->{info});
2984 my $b = $self->get_bconsole();
2986 my $joblist = [ map { { name => $_ } } $b->list_job() ];
2988 $self->display({ Jobs => $joblist }, "run_job.tpl");
2993 my ($self, $ouput) = @_;
2996 foreach my $l (split(/\r\n/, $ouput)) {
2997 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3003 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3009 foreach my $k (keys %arg) {
3010 $lowcase{lc($k)} = $arg{$k} ;
3019 my $b = $self->get_bconsole();
3021 my $job = CGI::param('job') || '';
3023 my $info = $b->send_cmd("show job=\"$job\"");
3024 my $attr = $self->run_parse_job($info);
3026 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3028 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3029 my $clients = [ map { { name => $_ } }$b->list_client()];
3030 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3031 my $storages= [ map { { name => $_ } }$b->list_storage()];
3036 clients => $clients,
3037 filesets => $filesets,
3038 storages => $storages,
3040 }, "run_job_mod.tpl");
3046 my $b = $self->get_bconsole();
3048 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3058 my $b = $self->get_bconsole();
3060 # TODO: check input (don't use pool, level)
3062 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3063 my $job = CGI::param('job') || '';
3064 my $storage = CGI::param('storage') || '';
3066 my $jobid = $b->run(job => $job,
3067 client => $arg->{client},
3068 priority => $arg->{priority},
3069 level => $arg->{level},
3070 storage => $storage,
3071 pool => $arg->{pool},
3074 print $jobid, $b->{error};
3076 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";