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 ($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';
1178 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1179 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1186 my ($class, %arg) = @_;
1188 dbh => undef, # connect_db();
1190 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1196 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1198 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1199 $self->{sql} = $sql_func{$1};
1202 $self->{debug} = $self->{info}->{debug};
1203 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1211 $self->display($self->{info}, "begin.tpl");
1217 $self->display($self->{info}, "end.tpl");
1225 my $arg = $self->get_form("client", "qre_client");
1227 if ($arg->{qre_client}) {
1228 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1229 } elsif ($arg->{client}) {
1230 $where = "WHERE Name = '$arg->{client}' ";
1234 SELECT Name AS name,
1236 AutoPrune AS autoprune,
1237 FileRetention AS fileretention,
1238 JobRetention AS jobretention
1243 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1245 my $dsp = { ID => $cur_id++,
1246 clients => [ values %$all] };
1248 $self->display($dsp, "client_list.tpl") ;
1253 my ($self, %arg) = @_;
1260 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1262 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1264 $self->{sql}->{TO_SEC}($arg{age})
1267 $label = "last " . human_sec($arg{age});
1270 if ($arg{groupby}) {
1271 $limit .= " GROUP BY $arg{groupby} ";
1275 $limit .= " ORDER BY $arg{order} ";
1279 $limit .= " LIMIT $arg{limit} ";
1280 $label .= " limited to $arg{limit}";
1284 $limit .= " OFFSET $arg{offset} ";
1285 $label .= " with $arg{offset} offset ";
1289 $label = 'no filter';
1292 return ($limit, $label);
1297 $bweb->get_form(...) - Get useful stuff
1301 This function get and check parameters against regexp.
1303 If word begin with 'q', the return will be quoted or join quoted
1304 if it's end with 's'.
1309 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1312 qclient => 'plume-fd',
1313 qpools => "'plume-fd', 'test-fd', '...'",
1320 my ($self, @what) = @_;
1321 my %what = map { $_ => 1 } @what;
1341 my %opt_s = ( # default to ''
1356 my %opt_p = ( # option with path
1363 my %opt_d = ( # option with date
1368 foreach my $i (@what) {
1369 if (exists $opt_i{$i}) {# integer param
1370 my $value = CGI::param($i) || $opt_i{$i} ;
1371 if ($value =~ /^(\d+)$/) {
1374 } elsif ($opt_s{$i}) { # simple string param
1375 my $value = CGI::param($i) || '';
1376 if ($value =~ /^([\w\d\.-]+)$/) {
1380 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1381 my @value = CGI::param($1) ;
1383 $ret{$i} = $self->dbh_join(@value) ;
1386 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1387 my $value = CGI::param($1) ;
1389 $ret{$i} = $self->dbh_quote($value);
1392 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1393 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1395 } elsif (exists $opt_p{$i}) {
1396 my $value = CGI::param($i) || '';
1397 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1400 } elsif (exists $opt_d{$i}) {
1401 my $value = CGI::param($i) || '';
1402 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1409 foreach my $s (CGI::param('slot')) {
1410 if ($s =~ /^(\d+)$/) {
1411 push @{$ret{slots}}, $s;
1416 if ($what{db_clients}) {
1418 SELECT Client.Name as clientname
1422 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1423 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1427 if ($what{db_mediatypes}) {
1429 SELECT MediaType as mediatype
1433 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1434 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1438 if ($what{db_locations}) {
1440 SELECT Location as location, Cost as cost FROM Location
1442 my $loc = $self->dbh_selectall_hashref($query, 'location');
1443 $ret{db_locations} = [ sort { $a->{location}
1449 if ($what{db_pools}) {
1450 my $query = "SELECT Name as name FROM Pool";
1452 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1453 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1456 if ($what{db_filesets}) {
1458 SELECT FileSet.FileSet AS fileset
1462 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1464 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1465 values %$filesets] ;
1468 if ($what{db_jobnames}) {
1470 SELECT DISTINCT Job.Name AS jobname
1474 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1476 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1477 values %$jobnames] ;
1480 if ($what{db_devices}) {
1482 SELECT Device.Name AS name
1486 my $devices = $self->dbh_selectall_hashref($query, 'name');
1488 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1499 my $fields = $self->get_form(qw/age level status clients filesets
1501 db_clients limit db_filesets width height
1502 qclients qfilesets qjobnames db_jobnames/);
1505 my $url = CGI::url(-full => 0,
1508 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1510 # this organisation is to keep user choice between 2 click
1511 # TODO : fileset and client selection doesn't work
1520 sub display_client_job
1522 my ($self, %arg) = @_ ;
1524 $arg{order} = ' Job.JobId DESC ';
1525 my ($limit, $label) = $self->get_limit(%arg);
1527 my $clientname = $self->dbh_quote($arg{clientname});
1530 SELECT DISTINCT Job.JobId AS jobid,
1531 Job.Name AS jobname,
1532 FileSet.FileSet AS fileset,
1534 StartTime AS starttime,
1535 JobFiles AS jobfiles,
1536 JobBytes AS jobbytes,
1537 JobStatus AS jobstatus,
1538 JobErrors AS joberrors
1540 FROM Client,Job,FileSet
1541 WHERE Client.Name=$clientname
1542 AND Client.ClientId=Job.ClientId
1543 AND Job.FileSetId=FileSet.FileSetId
1547 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1549 $self->display({ clientname => $arg{clientname},
1552 Jobs => [ values %$all ],
1554 "display_client_job.tpl") ;
1557 sub get_selected_media_location
1561 my $medias = $self->get_form('jmedias');
1563 unless ($medias->{jmedias}) {
1568 SELECT Media.VolumeName AS volumename, Location.Location AS location
1569 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1570 WHERE Media.VolumeName IN ($medias->{jmedias})
1573 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1575 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1586 my $medias = $self->get_selected_media_location();
1592 my $elt = $self->get_form('db_locations');
1594 $self->display({ ID => $cur_id++,
1595 %$elt, # db_locations
1597 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1607 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1609 $self->display($elt, "help_extern.tpl");
1612 sub help_extern_compute
1616 my $number = CGI::param('limit') || '' ;
1617 unless ($number =~ /^(\d+)$/) {
1618 return $self->error("Bad arg number : $number ");
1621 my ($sql, undef) = $self->get_param('pools',
1622 'locations', 'mediatypes');
1625 SELECT Media.VolumeName AS volumename,
1626 Media.VolStatus AS volstatus,
1627 Media.LastWritten AS lastwritten,
1628 Media.MediaType AS mediatype,
1629 Media.VolMounts AS volmounts,
1631 Media.Recycle AS recycle,
1632 $self->{sql}->{FROM_UNIXTIME}(
1633 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1634 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1637 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1638 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1640 WHERE Media.InChanger = 1
1641 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1643 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1647 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1649 $self->display({ Medias => [ values %$all ] },
1650 "help_extern_compute.tpl");
1657 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1658 $self->display($param, "help_intern.tpl");
1661 sub help_intern_compute
1665 my $number = CGI::param('limit') || '' ;
1666 unless ($number =~ /^(\d+)$/) {
1667 return $self->error("Bad arg number : $number ");
1670 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1672 if (CGI::param('expired')) {
1674 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1675 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1681 SELECT Media.VolumeName AS volumename,
1682 Media.VolStatus AS volstatus,
1683 Media.LastWritten AS lastwritten,
1684 Media.MediaType AS mediatype,
1685 Media.VolMounts AS volmounts,
1687 $self->{sql}->{FROM_UNIXTIME}(
1688 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1689 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1692 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1693 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1695 WHERE Media.InChanger <> 1
1696 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1697 AND Media.Recycle = 1
1699 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1703 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1705 $self->display({ Medias => [ values %$all ] },
1706 "help_intern_compute.tpl");
1712 my ($self, %arg) = @_ ;
1714 my ($limit, $label) = $self->get_limit(%arg);
1718 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1719 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1720 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1721 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1722 (SELECT count(Job.JobId)
1724 WHERE Job.JobStatus IN ('E','e','f','A')
1727 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1730 my $row = $self->dbh_selectrow_hashref($query) ;
1732 $row->{nb_bytes} = human_size($row->{nb_bytes});
1734 $row->{db_size} = '???';
1735 $row->{label} = $label;
1737 $self->display($row, "general.tpl");
1742 my ($self, @what) = @_ ;
1743 my %elt = map { $_ => 1 } @what;
1748 if ($elt{clients}) {
1749 my @clients = CGI::param('client');
1751 $ret{clients} = \@clients;
1752 my $str = $self->dbh_join(@clients);
1753 $limit .= "AND Client.Name IN ($str) ";
1757 if ($elt{filesets}) {
1758 my @filesets = CGI::param('fileset');
1760 $ret{filesets} = \@filesets;
1761 my $str = $self->dbh_join(@filesets);
1762 $limit .= "AND FileSet.FileSet IN ($str) ";
1766 if ($elt{mediatypes}) {
1767 my @medias = CGI::param('mediatype');
1769 $ret{mediatypes} = \@medias;
1770 my $str = $self->dbh_join(@medias);
1771 $limit .= "AND Media.MediaType IN ($str) ";
1776 my $client = CGI::param('client');
1777 $ret{client} = $client;
1778 $client = $self->dbh_join($client);
1779 $limit .= "AND Client.Name = $client ";
1783 my $level = CGI::param('level') || '';
1784 if ($level =~ /^(\w)$/) {
1786 $limit .= "AND Job.Level = '$1' ";
1791 my $jobid = CGI::param('jobid') || '';
1793 if ($jobid =~ /^(\d+)$/) {
1795 $limit .= "AND Job.JobId = '$1' ";
1800 my $status = CGI::param('status') || '';
1801 if ($status =~ /^(\w)$/) {
1804 $limit .= "AND Job.JobStatus IN ('f','E') ";
1806 $limit .= "AND Job.JobStatus = '$1' ";
1811 if ($elt{locations}) {
1812 my @location = CGI::param('location') ;
1814 $ret{locations} = \@location;
1815 my $str = $self->dbh_join(@location);
1816 $limit .= "AND Location.Location IN ($str) ";
1821 my @pool = CGI::param('pool') ;
1823 $ret{pools} = \@pool;
1824 my $str = $self->dbh_join(@pool);
1825 $limit .= "AND Pool.Name IN ($str) ";
1829 if ($elt{location}) {
1830 my $location = CGI::param('location') || '';
1832 $ret{location} = $location;
1833 $location = $self->dbh_quote($location);
1834 $limit .= "AND Location.Location = $location ";
1839 my $pool = CGI::param('pool') || '';
1842 $pool = $self->dbh_quote($pool);
1843 $limit .= "AND Pool.Name = $pool ";
1847 if ($elt{jobtype}) {
1848 my $jobtype = CGI::param('jobtype') || '';
1849 if ($jobtype =~ /^(\w)$/) {
1851 $limit .= "AND Job.Type = '$1' ";
1855 return ($limit, %ret);
1866 my ($self, %arg) = @_ ;
1868 $arg{order} = ' Job.JobId DESC ';
1870 my ($limit, $label) = $self->get_limit(%arg);
1871 my ($where, undef) = $self->get_param('clients',
1879 SELECT Job.JobId AS jobid,
1880 Client.Name AS client,
1881 FileSet.FileSet AS fileset,
1882 Job.Name AS jobname,
1884 StartTime AS starttime,
1885 Pool.Name AS poolname,
1886 JobFiles AS jobfiles,
1887 JobBytes AS jobbytes,
1888 JobStatus AS jobstatus,
1889 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1890 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1893 JobErrors AS joberrors
1896 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1897 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1898 WHERE Client.ClientId=Job.ClientId
1899 AND Job.JobStatus != 'R'
1904 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1906 $self->display({ Filter => $label,
1910 sort { $a->{jobid} <=> $b->{jobid} }
1917 # display job informations
1918 sub display_job_zoom
1920 my ($self, $jobid) = @_ ;
1922 $jobid = $self->dbh_quote($jobid);
1925 SELECT DISTINCT Job.JobId AS jobid,
1926 Client.Name AS client,
1927 Job.Name AS jobname,
1928 FileSet.FileSet AS fileset,
1930 Pool.Name AS poolname,
1931 StartTime AS starttime,
1932 JobFiles AS jobfiles,
1933 JobBytes AS jobbytes,
1934 JobStatus AS jobstatus,
1935 JobErrors AS joberrors,
1936 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1937 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1940 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1941 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1942 WHERE Client.ClientId=Job.ClientId
1943 AND Job.JobId = $jobid
1946 my $row = $self->dbh_selectrow_hashref($query) ;
1948 # display all volumes associate with this job
1950 SELECT Media.VolumeName as volumename
1951 FROM Job,Media,JobMedia
1952 WHERE Job.JobId = $jobid
1953 AND JobMedia.JobId=Job.JobId
1954 AND JobMedia.MediaId=Media.MediaId
1957 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1959 $row->{volumes} = [ values %$all ] ;
1961 $self->display($row, "display_job_zoom.tpl");
1968 my ($where, %elt) = $self->get_param('pool',
1971 my $arg = $self->get_form('jmedias', 'qre_media');
1973 if ($arg->{jmedias}) {
1974 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1976 if ($arg->{qre_media}) {
1977 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1981 SELECT Media.VolumeName AS volumename,
1982 Media.VolBytes AS volbytes,
1983 Media.VolStatus AS volstatus,
1984 Media.MediaType AS mediatype,
1985 Media.InChanger AS online,
1986 Media.LastWritten AS lastwritten,
1987 Location.Location AS location,
1988 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1989 Pool.Name AS poolname,
1990 $self->{sql}->{FROM_UNIXTIME}(
1991 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1992 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1995 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1996 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1997 Media.MediaType AS MediaType
1999 WHERE Media.VolStatus = 'Full'
2000 GROUP BY Media.MediaType
2001 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2003 WHERE Media.PoolId=Pool.PoolId
2007 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2009 $self->display({ ID => $cur_id++,
2011 Location => $elt{location},
2012 Medias => [ values %$all ]
2014 "display_media.tpl");
2021 my $pool = $self->get_form('db_pools');
2023 foreach my $name (@{ $pool->{db_pools} }) {
2024 CGI::param('pool', $name->{name});
2025 $self->display_media();
2029 sub display_media_zoom
2033 my $medias = $self->get_form('jmedias');
2035 unless ($medias->{jmedias}) {
2036 return $self->error("Can't get media selection");
2040 SELECT InChanger AS online,
2041 VolBytes AS nb_bytes,
2042 VolumeName AS volumename,
2043 VolStatus AS volstatus,
2044 VolMounts AS nb_mounts,
2045 Media.VolUseDuration AS voluseduration,
2046 Media.MaxVolJobs AS maxvoljobs,
2047 Media.MaxVolFiles AS maxvolfiles,
2048 Media.MaxVolBytes AS maxvolbytes,
2049 VolErrors AS nb_errors,
2050 Pool.Name AS poolname,
2051 Location.Location AS location,
2052 Media.Recycle AS recycle,
2053 Media.VolRetention AS volretention,
2054 Media.LastWritten AS lastwritten,
2055 Media.VolReadTime/1000000 AS volreadtime,
2056 Media.VolWriteTime/1000000 AS volwritetime,
2057 $self->{sql}->{FROM_UNIXTIME}(
2058 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2059 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2062 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2063 WHERE Pool.PoolId = Media.PoolId
2064 AND VolumeName IN ($medias->{jmedias})
2067 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2069 foreach my $media (values %$all) {
2070 my $mq = $self->dbh_quote($media->{volumename});
2073 SELECT DISTINCT Job.JobId AS jobid,
2075 Job.StartTime AS starttime,
2078 Job.JobFiles AS files,
2079 Job.JobBytes AS bytes,
2080 Job.jobstatus AS status
2081 FROM Media,JobMedia,Job
2082 WHERE Media.VolumeName=$mq
2083 AND Media.MediaId=JobMedia.MediaId
2084 AND JobMedia.JobId=Job.JobId
2087 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2090 SELECT LocationLog.Date AS date,
2091 Location.Location AS location,
2092 LocationLog.Comment AS comment
2093 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2094 WHERE Media.MediaId = LocationLog.MediaId
2095 AND Media.VolumeName = $mq
2099 my $log = $self->dbh_selectall_arrayref($query) ;
2101 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2104 $self->display({ jobs => [ values %$jobs ],
2105 LocationLog => $logtxt,
2107 "display_media_zoom.tpl");
2115 my $loc = $self->get_form('qlocation');
2116 unless ($loc->{qlocation}) {
2117 return $self->error("Can't get location");
2121 SELECT Location.Location AS location,
2122 Location.Cost AS cost,
2123 Location.Enabled AS enabled
2125 WHERE Location.Location = $loc->{qlocation}
2128 my $row = $self->dbh_selectrow_hashref($query);
2130 $self->display({ ID => $cur_id++,
2131 %$row }, "location_edit.tpl") ;
2139 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2140 unless ($arg->{qlocation}) {
2141 return $self->error("Can't get location");
2143 unless ($arg->{qnewlocation}) {
2144 return $self->error("Can't get new location name");
2146 unless ($arg->{cost}) {
2147 return $self->error("Can't get new cost");
2150 my $enabled = CGI::param('enabled') || '';
2151 $enabled = $enabled?1:0;
2154 UPDATE Location SET Cost = $arg->{cost},
2155 Location = $arg->{qnewlocation},
2157 WHERE Location.Location = $arg->{qlocation}
2160 $self->dbh_do($query);
2162 $self->display_location();
2168 my $arg = $self->get_form(qw/qlocation/) ;
2170 unless ($arg->{qlocation}) {
2171 return $self->error("Can't get location");
2175 SELECT count(Media.MediaId) AS nb
2176 FROM Media INNER JOIN Location USING (LocationID)
2177 WHERE Location = $arg->{qlocation}
2180 my $res = $self->dbh_selectrow_hashref($query);
2183 return $self->error("Sorry, the location must be empty");
2187 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2190 $self->dbh_do($query);
2192 $self->display_location();
2199 my $arg = $self->get_form(qw/qlocation cost/) ;
2201 unless ($arg->{qlocation}) {
2202 $self->display({}, "location_add.tpl");
2205 unless ($arg->{cost}) {
2206 return $self->error("Can't get new cost");
2209 my $enabled = CGI::param('enabled') || '';
2210 $enabled = $enabled?1:0;
2213 INSERT INTO Location (Location, Cost, Enabled)
2214 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2217 $self->dbh_do($query);
2219 $self->display_location();
2222 sub display_location
2227 SELECT Location.Location AS location,
2228 Location.Cost AS cost,
2229 Location.Enabled AS enabled,
2230 (SELECT count(Media.MediaId)
2232 WHERE Media.LocationId = Location.LocationId
2237 my $location = $self->dbh_selectall_hashref($query, 'location');
2239 $self->display({ ID => $cur_id++,
2240 Locations => [ values %$location ] },
2241 "display_location.tpl");
2248 my $medias = $self->get_selected_media_location();
2253 my $arg = $self->get_form('db_locations', 'qnewlocation');
2255 $self->display({ email => $self->{info}->{email_media},
2257 medias => [ values %$medias ],
2259 "update_location.tpl");
2262 sub get_media_max_size
2264 my ($self, $type) = @_;
2266 "SELECT avg(VolBytes) AS size
2268 WHERE Media.VolStatus = 'Full'
2269 AND Media.MediaType = '$type'
2272 my $res = $self->selectrow_hashref($query);
2275 return $res->{size};
2285 my $media = $self->get_form('qmedia');
2287 unless ($media->{qmedia}) {
2288 return $self->error("Can't get media");
2292 SELECT Media.Slot AS slot,
2293 Pool.Name AS poolname,
2294 Media.VolStatus AS volstatus,
2295 Media.InChanger AS inchanger,
2296 Location.Location AS location,
2297 Media.VolumeName AS volumename,
2298 Media.MaxVolBytes AS maxvolbytes,
2299 Media.MaxVolJobs AS maxvoljobs,
2300 Media.MaxVolFiles AS maxvolfiles,
2301 Media.VolUseDuration AS voluseduration,
2302 Media.VolRetention AS volretention
2304 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2305 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2307 WHERE Media.VolumeName = $media->{qmedia}
2310 my $row = $self->dbh_selectrow_hashref($query);
2311 $row->{volretention} = human_sec($row->{volretention});
2312 $row->{voluseduration} = human_sec($row->{voluseduration});
2314 my $elt = $self->get_form(qw/db_pools db_locations/);
2319 }, "update_media.tpl");
2326 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2328 unless ($arg->{jmedias}) {
2329 return $self->error("Can't get selected media");
2332 unless ($arg->{qnewlocation}) {
2333 return $self->error("Can't get new location");
2338 SET LocationId = (SELECT LocationId
2340 WHERE Location = $arg->{qnewlocation})
2341 WHERE Media.VolumeName IN ($arg->{jmedias})
2344 my $nb = $self->dbh_do($query);
2346 print "$nb media updated, you may have to update your autochanger.";
2348 $self->display_media();
2355 my $medias = $self->get_selected_media_location();
2357 return $self->error("Can't get media selection");
2359 my $newloc = CGI::param('newlocation');
2361 my $user = CGI::param('user') || 'unknow';
2362 my $comm = CGI::param('comment') || '';
2363 $comm = $self->dbh_quote("$user: $comm");
2367 foreach my $media (keys %$medias) {
2369 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2371 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2372 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2373 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2376 $self->dbh_do($query);
2377 $self->debug($query);
2381 $q->param('action', 'update_location');
2382 my $url = $q->url(-full => 1, -query=>1);
2384 $self->display({ email => $self->{info}->{email_media},
2386 newlocation => $newloc,
2387 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2388 medias => [ values %$medias ],
2390 "change_location.tpl");
2394 sub display_client_stats
2396 my ($self, %arg) = @_ ;
2398 my $client = $self->dbh_quote($arg{clientname});
2399 my ($limit, $label) = $self->get_limit(%arg);
2403 count(Job.JobId) AS nb_jobs,
2404 sum(Job.JobBytes) AS nb_bytes,
2405 sum(Job.JobErrors) AS nb_err,
2406 sum(Job.JobFiles) AS nb_files,
2407 Client.Name AS clientname
2408 FROM Job INNER JOIN Client USING (ClientId)
2410 Client.Name = $client
2412 GROUP BY Client.Name
2415 my $row = $self->dbh_selectrow_hashref($query);
2417 $row->{ID} = $cur_id++;
2418 $row->{label} = $label;
2420 $self->display($row, "display_client_stats.tpl");
2423 # poolname can be undef
2426 my ($self, $poolname) = @_ ;
2428 # TODO : afficher les tailles et les dates
2431 SELECT subq.volmax AS volmax,
2432 subq.volnum AS volnum,
2433 subq.voltotal AS voltotal,
2435 Pool.Recycle AS recycle,
2436 Pool.VolRetention AS volretention,
2437 Pool.VolUseDuration AS voluseduration,
2438 Pool.MaxVolJobs AS maxvoljobs,
2439 Pool.MaxVolFiles AS maxvolfiles,
2440 Pool.MaxVolBytes AS maxvolbytes,
2441 subq.PoolId AS PoolId
2444 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2445 count(Media.MediaId) AS volnum,
2446 sum(Media.VolBytes) AS voltotal,
2447 Media.PoolId AS PoolId,
2448 Media.MediaType AS MediaType
2450 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2451 Media.MediaType AS MediaType
2453 WHERE Media.VolStatus = 'Full'
2454 GROUP BY Media.MediaType
2455 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2456 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2458 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2461 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2464 SELECT Pool.Name AS name,
2465 sum(VolBytes) AS size
2466 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2467 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2470 my $empty = $self->dbh_selectall_hashref($query, 'name');
2472 foreach my $p (values %$all) {
2473 if ($p->{volmax} > 0) { # mysql returns 0.0000
2474 # we remove Recycled/Purged media from pool usage
2475 if (defined $empty->{$p->{name}}) {
2476 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2478 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2480 $p->{poolusage} = 0;
2484 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2486 WHERE PoolId=$p->{poolid}
2489 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2490 foreach my $t (values %$content) {
2491 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2496 $self->display({ ID => $cur_id++,
2497 Pools => [ values %$all ]},
2498 "display_pool.tpl");
2501 sub display_running_job
2505 my $arg = $self->get_form('client', 'jobid');
2507 if (!$arg->{client} and $arg->{jobid}) {
2510 SELECT Client.Name AS name
2511 FROM Job INNER JOIN Client USING (ClientId)
2512 WHERE Job.JobId = $arg->{jobid}
2515 my $row = $self->dbh_selectrow_hashref($query);
2518 $arg->{client} = $row->{name};
2519 CGI::param('client', $arg->{client});
2523 if ($arg->{client}) {
2524 my $cli = new Bweb::Client(name => $arg->{client});
2525 $cli->display_running_job($self->{info}, $arg->{jobid});
2526 if ($arg->{jobid}) {
2527 $self->get_job_log();
2530 $self->error("Can't get client or jobid");
2534 sub display_running_jobs
2536 my ($self, $display_action) = @_;
2539 SELECT Job.JobId AS jobid,
2540 Job.Name AS jobname,
2542 Job.StartTime AS starttime,
2543 Job.JobFiles AS jobfiles,
2544 Job.JobBytes AS jobbytes,
2545 Job.JobStatus AS jobstatus,
2546 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2547 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2549 Client.Name AS clientname
2550 FROM Job INNER JOIN Client USING (ClientId)
2551 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2553 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2555 $self->display({ ID => $cur_id++,
2556 display_action => $display_action,
2557 Jobs => [ values %$all ]},
2558 "running_job.tpl") ;
2564 my $arg = $self->get_form('jmedias');
2566 unless ($arg->{jmedias}) {
2567 return $self->error("Can't get media selection");
2571 SELECT Media.VolumeName AS volumename,
2572 Storage.Name AS storage,
2573 Location.Location AS location,
2575 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2576 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2577 WHERE Media.VolumeName IN ($arg->{jmedias})
2578 AND Media.InChanger = 1
2581 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2583 foreach my $vol (values %$all) {
2584 my $a = $self->ach_get($vol->{location});
2587 unless ($a->{have_status}) {
2589 $a->{have_status} = 1;
2592 print "eject $vol->{volumename} from $vol->{storage} : ";
2593 if ($a->send_to_io($vol->{slot})) {
2605 my ($to, $subject, $content) = (CGI::param('email'),
2606 CGI::param('subject'),
2607 CGI::param('content'));
2608 $to =~ s/[^\w\d\.\@<>,]//;
2609 $subject =~ s/[^\w\d\.\[\]]/ /;
2611 open(MAIL, "|mail -s '$subject' '$to'") ;
2612 print MAIL $content;
2622 my $arg = $self->get_form('jobid', 'client');
2624 print CGI::header('text/brestore');
2625 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2626 print "client=$arg->{client}\n" if ($arg->{client});
2627 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2631 # TODO : move this to Bweb::Autochanger ?
2632 # TODO : make this internal to not eject tape ?
2638 my ($self, $name) = @_;
2641 return $self->error("Can't get your autochanger name ach");
2644 unless ($self->{info}->{ach_list}) {
2645 return $self->error("Could not find any autochanger");
2648 my $a = $self->{info}->{ach_list}->{$name};
2651 $self->error("Can't get your autochanger $name from your ach_list");
2662 my ($self, $ach) = @_;
2664 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2666 $self->{info}->save();
2674 my $arg = $self->get_form('ach');
2676 or !$self->{info}->{ach_list}
2677 or !$self->{info}->{ach_list}->{$arg->{ach}})
2679 return $self->error("Can't get autochanger name");
2682 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2686 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2688 my $b = $self->get_bconsole();
2690 my @storages = $b->list_storage() ;
2692 $ach->{devices} = [ map { { name => $_ } } @storages ];
2694 $self->display($ach, "ach_add.tpl");
2695 delete $ach->{drives};
2696 delete $ach->{devices};
2703 my $arg = $self->get_form('ach');
2706 or !$self->{info}->{ach_list}
2707 or !$self->{info}->{ach_list}->{$arg->{ach}})
2709 return $self->error("Can't get autochanger name");
2712 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2714 $self->{info}->save();
2715 $self->{info}->view();
2721 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2723 my $b = $self->get_bconsole();
2724 my @storages = $b->list_storage() ;
2726 unless ($arg->{ach}) {
2727 $arg->{devices} = [ map { { name => $_ } } @storages ];
2728 return $self->display($arg, "ach_add.tpl");
2732 foreach my $drive (CGI::param('drives'))
2734 unless (grep(/^$drive$/,@storages)) {
2735 return $self->error("Can't find $drive in storage list");
2738 my $index = CGI::param("index_$drive");
2739 unless (defined $index and $index =~ /^(\d+)$/) {
2740 return $self->error("Can't get $drive index");
2743 $drives[$index] = $drive;
2747 return $self->error("Can't get drives from Autochanger");
2750 my $a = new Bweb::Autochanger(name => $arg->{ach},
2751 precmd => $arg->{precmd},
2752 drive_name => \@drives,
2753 device => $arg->{device},
2754 mtxcmd => $arg->{mtxcmd});
2756 $self->ach_register($a) ;
2758 $self->{info}->view();
2764 my $arg = $self->get_form('jobid');
2766 if ($arg->{jobid}) {
2767 my $b = $self->get_bconsole();
2768 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2772 title => "Delete a job ",
2773 name => "delete jobid=$arg->{jobid}",
2782 my $arg = $self->get_form(qw/media volstatus inchanger pool
2783 slot volretention voluseduration
2784 maxvoljobs maxvolfiles maxvolbytes
2787 unless ($arg->{media}) {
2788 return $self->error("Can't find media selection");
2791 my $update = "update volume=$arg->{media} ";
2793 if ($arg->{volstatus}) {
2794 $update .= " volstatus=$arg->{volstatus} ";
2797 if ($arg->{inchanger}) {
2798 $update .= " inchanger=yes " ;
2800 $update .= " slot=$arg->{slot} ";
2803 $update .= " slot=0 inchanger=no ";
2807 $update .= " pool=$arg->{pool} " ;
2810 $arg->{volretention} ||= 0 ;
2811 if ($arg->{volretention}) {
2812 $update .= " volretention=\"$arg->{volretention}\" " ;
2815 $arg->{voluseduration} ||= 0 ;
2816 if ($arg->{voluseduration}) {
2817 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2820 $arg->{maxvoljobs} ||= 0;
2821 if ($arg->{maxvoljobs}) {
2822 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2825 $arg->{maxvolfiles} ||= 0;
2826 if ($arg->{maxvolfiles}) {
2827 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2830 $arg->{maxvolbytes} ||= 0;
2831 if ($arg->{maxvolbytes}) {
2832 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2835 my $b = $self->get_bconsole();
2838 content => $b->send_cmd($update),
2839 title => "Update a volume ",
2844 my $loc = CGI::param('location') || '';
2846 my $media = $self->dbh_quote($arg->{media});
2847 $loc = $self->dbh_quote($loc); # is checked by db
2850 SET LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)
2851 WHERE Media.VolumeName = $media
2853 $self->dbh_do($query);
2856 $self->update_media();
2863 my $ach = CGI::param('ach') ;
2864 $ach = $self->ach_get($ach);
2866 return $self->error("Bad autochanger name");
2870 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2871 $b->update_slots($ach->{name});
2879 my $arg = $self->get_form('jobid');
2880 unless ($arg->{jobid}) {
2881 return $self->error("Can't get jobid");
2884 my $t = CGI::param('time') || '';
2887 SELECT Job.Name as name, Client.Name as clientname
2888 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2889 WHERE JobId = $arg->{jobid}
2892 my $row = $self->dbh_selectrow_hashref($query);
2895 return $self->error("Can't find $arg->{jobid} in catalog");
2899 SELECT Time AS time, LogText AS log
2901 WHERE JobId = $arg->{jobid}
2904 my $log = $self->dbh_selectall_arrayref($query);
2906 return $self->error("Can't get log for jobid $arg->{jobid}");
2912 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2914 $logtxt = join("", map { $_->[1] } @$log ) ;
2917 $self->display({ lines=> $logtxt,
2918 jobid => $arg->{jobid},
2919 name => $row->{name},
2920 client => $row->{clientname},
2921 }, 'display_log.tpl');
2929 my $arg = $self->get_form('ach', 'slots', 'drive');
2931 unless ($arg->{ach}) {
2932 return $self->error("Can't find autochanger name");
2937 if ($arg->{slots}) {
2938 $slots = join(",", @{ $arg->{slots} });
2939 $t += 60*scalar( @{ $arg->{slots} }) ;
2942 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2943 print "<h1>This command can take long time, be patient...</h1>";
2945 $b->label_barcodes(storage => $arg->{ach},
2946 drive => $arg->{drive},
2957 my @volume = CGI::param('media');
2960 return $self->error("Can't get media selection");
2963 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2966 content => $b->purge_volume(@volume),
2967 title => "Purge media",
2968 name => "purge volume=" . join(' volume=', @volume),
2977 my @volume = CGI::param('media');
2979 return $self->error("Can't get media selection");
2982 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2985 content => $b->prune_volume(@volume),
2986 title => "Prune media",
2987 name => "prune volume=" . join(' volume=', @volume),
2997 my $arg = $self->get_form('jobid');
2998 unless ($arg->{jobid}) {
2999 return $self->error("Can't get jobid");
3002 my $b = $self->get_bconsole();
3004 content => $b->cancel($arg->{jobid}),
3005 title => "Cancel job",
3006 name => "cancel jobid=$arg->{jobid}",
3012 # Warning, we display current fileset
3015 my $arg = $self->get_form('fileset');
3017 if ($arg->{fileset}) {
3018 my $b = $self->get_bconsole();
3019 my $ret = $b->get_fileset($arg->{fileset});
3020 $self->display({ fileset => $arg->{fileset},
3022 }, "fileset_view.tpl");
3024 $self->error("Can't get fileset name");
3028 sub director_show_sched
3032 my $arg = $self->get_form('days');
3034 my $b = $self->get_bconsole();
3035 my $ret = $b->director_get_sched( $arg->{days} );
3040 }, "scheduled_job.tpl");
3043 sub enable_disable_job
3045 my ($self, $what) = @_ ;
3047 my $name = CGI::param('job') || '';
3048 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3049 return $self->error("Can't find job name");
3052 my $b = $self->get_bconsole();
3062 content => $b->send_cmd("$cmd job=\"$name\""),
3063 title => "$cmd $name",
3064 name => "$cmd job=\"$name\"",
3071 return new Bconsole(pref => $self->{info});
3077 my $b = $self->get_bconsole();
3079 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3081 $self->display({ Jobs => $joblist }, "run_job.tpl");
3086 my ($self, $ouput) = @_;
3089 foreach my $l (split(/\r\n/, $ouput)) {
3090 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3096 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3102 foreach my $k (keys %arg) {
3103 $lowcase{lc($k)} = $arg{$k} ;
3112 my $b = $self->get_bconsole();
3114 my $job = CGI::param('job') || '';
3116 my $info = $b->send_cmd("show job=\"$job\"");
3117 my $attr = $self->run_parse_job($info);
3119 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3121 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3122 my $clients = [ map { { name => $_ } }$b->list_client()];
3123 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3124 my $storages= [ map { { name => $_ } }$b->list_storage()];
3129 clients => $clients,
3130 filesets => $filesets,
3131 storages => $storages,
3133 }, "run_job_mod.tpl");
3139 my $b = $self->get_bconsole();
3141 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3151 my $b = $self->get_bconsole();
3153 # TODO: check input (don't use pool, level)
3155 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3156 my $job = CGI::param('job') || '';
3157 my $storage = CGI::param('storage') || '';
3159 my $jobid = $b->run(job => $job,
3160 client => $arg->{client},
3161 priority => $arg->{priority},
3162 level => $arg->{level},
3163 storage => $storage,
3164 pool => $arg->{pool},
3167 print $jobid, $b->{error};
3169 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";