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_ss =( # string with space
1345 my %opt_s = ( # default to ''
1362 my %opt_p = ( # option with path
1370 my %opt_d = ( # option with date
1375 foreach my $i (@what) {
1376 if (exists $opt_i{$i}) {# integer param
1377 my $value = CGI::param($i) || $opt_i{$i} ;
1378 if ($value =~ /^(\d+)$/) {
1381 } elsif ($opt_s{$i}) { # simple string param
1382 my $value = CGI::param($i) || '';
1383 if ($value =~ /^([\w\d\.-]+)$/) {
1386 } elsif ($opt_ss{$i}) { # simple string param (with space)
1387 my $value = CGI::param($i) || '';
1388 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1391 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1392 my @value = CGI::param($1) ;
1394 $ret{$i} = $self->dbh_join(@value) ;
1397 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1398 my $value = CGI::param($1) ;
1400 $ret{$i} = $self->dbh_quote($value);
1403 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1404 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1406 } elsif (exists $opt_p{$i}) {
1407 my $value = CGI::param($i) || '';
1408 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1411 } elsif (exists $opt_d{$i}) {
1412 my $value = CGI::param($i) || '';
1413 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1420 foreach my $s (CGI::param('slot')) {
1421 if ($s =~ /^(\d+)$/) {
1422 push @{$ret{slots}}, $s;
1427 if ($what{db_clients}) {
1429 SELECT Client.Name as clientname
1433 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1434 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1438 if ($what{db_mediatypes}) {
1440 SELECT MediaType as mediatype
1444 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1445 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1449 if ($what{db_locations}) {
1451 SELECT Location as location, Cost as cost FROM Location
1453 my $loc = $self->dbh_selectall_hashref($query, 'location');
1454 $ret{db_locations} = [ sort { $a->{location}
1460 if ($what{db_pools}) {
1461 my $query = "SELECT Name as name FROM Pool";
1463 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1464 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1467 if ($what{db_filesets}) {
1469 SELECT FileSet.FileSet AS fileset
1473 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1475 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1476 values %$filesets] ;
1479 if ($what{db_jobnames}) {
1481 SELECT DISTINCT Job.Name AS jobname
1485 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1487 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1488 values %$jobnames] ;
1491 if ($what{db_devices}) {
1493 SELECT Device.Name AS name
1497 my $devices = $self->dbh_selectall_hashref($query, 'name');
1499 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1510 my $fields = $self->get_form(qw/age level status clients filesets
1512 db_clients limit db_filesets width height
1513 qclients qfilesets qjobnames db_jobnames/);
1516 my $url = CGI::url(-full => 0,
1519 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1521 # this organisation is to keep user choice between 2 click
1522 # TODO : fileset and client selection doesn't work
1531 sub display_client_job
1533 my ($self, %arg) = @_ ;
1535 $arg{order} = ' Job.JobId DESC ';
1536 my ($limit, $label) = $self->get_limit(%arg);
1538 my $clientname = $self->dbh_quote($arg{clientname});
1541 SELECT DISTINCT Job.JobId AS jobid,
1542 Job.Name AS jobname,
1543 FileSet.FileSet AS fileset,
1545 StartTime AS starttime,
1546 JobFiles AS jobfiles,
1547 JobBytes AS jobbytes,
1548 JobStatus AS jobstatus,
1549 JobErrors AS joberrors
1551 FROM Client,Job,FileSet
1552 WHERE Client.Name=$clientname
1553 AND Client.ClientId=Job.ClientId
1554 AND Job.FileSetId=FileSet.FileSetId
1558 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1560 $self->display({ clientname => $arg{clientname},
1563 Jobs => [ values %$all ],
1565 "display_client_job.tpl") ;
1568 sub get_selected_media_location
1572 my $medias = $self->get_form('jmedias');
1574 unless ($medias->{jmedias}) {
1579 SELECT Media.VolumeName AS volumename, Location.Location AS location
1580 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1581 WHERE Media.VolumeName IN ($medias->{jmedias})
1584 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1586 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1597 my $medias = $self->get_selected_media_location();
1603 my $elt = $self->get_form('db_locations');
1605 $self->display({ ID => $cur_id++,
1606 %$elt, # db_locations
1608 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1618 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1620 $self->display($elt, "help_extern.tpl");
1623 sub help_extern_compute
1627 my $number = CGI::param('limit') || '' ;
1628 unless ($number =~ /^(\d+)$/) {
1629 return $self->error("Bad arg number : $number ");
1632 my ($sql, undef) = $self->get_param('pools',
1633 'locations', 'mediatypes');
1636 SELECT Media.VolumeName AS volumename,
1637 Media.VolStatus AS volstatus,
1638 Media.LastWritten AS lastwritten,
1639 Media.MediaType AS mediatype,
1640 Media.VolMounts AS volmounts,
1642 Media.Recycle AS recycle,
1643 $self->{sql}->{FROM_UNIXTIME}(
1644 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1645 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1648 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1649 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1651 WHERE Media.InChanger = 1
1652 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1654 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1658 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1660 $self->display({ Medias => [ values %$all ] },
1661 "help_extern_compute.tpl");
1668 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1669 $self->display($param, "help_intern.tpl");
1672 sub help_intern_compute
1676 my $number = CGI::param('limit') || '' ;
1677 unless ($number =~ /^(\d+)$/) {
1678 return $self->error("Bad arg number : $number ");
1681 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1683 if (CGI::param('expired')) {
1685 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1686 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1692 SELECT Media.VolumeName AS volumename,
1693 Media.VolStatus AS volstatus,
1694 Media.LastWritten AS lastwritten,
1695 Media.MediaType AS mediatype,
1696 Media.VolMounts AS volmounts,
1698 $self->{sql}->{FROM_UNIXTIME}(
1699 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1700 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1703 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1704 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1706 WHERE Media.InChanger <> 1
1707 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1708 AND Media.Recycle = 1
1710 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1714 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1716 $self->display({ Medias => [ values %$all ] },
1717 "help_intern_compute.tpl");
1723 my ($self, %arg) = @_ ;
1725 my ($limit, $label) = $self->get_limit(%arg);
1729 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1730 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1731 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1732 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1733 (SELECT count(Job.JobId)
1735 WHERE Job.JobStatus IN ('E','e','f','A')
1738 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1741 my $row = $self->dbh_selectrow_hashref($query) ;
1743 $row->{nb_bytes} = human_size($row->{nb_bytes});
1745 $row->{db_size} = '???';
1746 $row->{label} = $label;
1748 $self->display($row, "general.tpl");
1753 my ($self, @what) = @_ ;
1754 my %elt = map { $_ => 1 } @what;
1759 if ($elt{clients}) {
1760 my @clients = CGI::param('client');
1762 $ret{clients} = \@clients;
1763 my $str = $self->dbh_join(@clients);
1764 $limit .= "AND Client.Name IN ($str) ";
1768 if ($elt{filesets}) {
1769 my @filesets = CGI::param('fileset');
1771 $ret{filesets} = \@filesets;
1772 my $str = $self->dbh_join(@filesets);
1773 $limit .= "AND FileSet.FileSet IN ($str) ";
1777 if ($elt{mediatypes}) {
1778 my @medias = CGI::param('mediatype');
1780 $ret{mediatypes} = \@medias;
1781 my $str = $self->dbh_join(@medias);
1782 $limit .= "AND Media.MediaType IN ($str) ";
1787 my $client = CGI::param('client');
1788 $ret{client} = $client;
1789 $client = $self->dbh_join($client);
1790 $limit .= "AND Client.Name = $client ";
1794 my $level = CGI::param('level') || '';
1795 if ($level =~ /^(\w)$/) {
1797 $limit .= "AND Job.Level = '$1' ";
1802 my $jobid = CGI::param('jobid') || '';
1804 if ($jobid =~ /^(\d+)$/) {
1806 $limit .= "AND Job.JobId = '$1' ";
1811 my $status = CGI::param('status') || '';
1812 if ($status =~ /^(\w)$/) {
1815 $limit .= "AND Job.JobStatus IN ('f','E') ";
1817 $limit .= "AND Job.JobStatus = '$1' ";
1822 if ($elt{locations}) {
1823 my @location = CGI::param('location') ;
1825 $ret{locations} = \@location;
1826 my $str = $self->dbh_join(@location);
1827 $limit .= "AND Location.Location IN ($str) ";
1832 my @pool = CGI::param('pool') ;
1834 $ret{pools} = \@pool;
1835 my $str = $self->dbh_join(@pool);
1836 $limit .= "AND Pool.Name IN ($str) ";
1840 if ($elt{location}) {
1841 my $location = CGI::param('location') || '';
1843 $ret{location} = $location;
1844 $location = $self->dbh_quote($location);
1845 $limit .= "AND Location.Location = $location ";
1850 my $pool = CGI::param('pool') || '';
1853 $pool = $self->dbh_quote($pool);
1854 $limit .= "AND Pool.Name = $pool ";
1858 if ($elt{jobtype}) {
1859 my $jobtype = CGI::param('jobtype') || '';
1860 if ($jobtype =~ /^(\w)$/) {
1862 $limit .= "AND Job.Type = '$1' ";
1866 return ($limit, %ret);
1877 my ($self, %arg) = @_ ;
1879 $arg{order} = ' Job.JobId DESC ';
1881 my ($limit, $label) = $self->get_limit(%arg);
1882 my ($where, undef) = $self->get_param('clients',
1890 SELECT Job.JobId AS jobid,
1891 Client.Name AS client,
1892 FileSet.FileSet AS fileset,
1893 Job.Name AS jobname,
1895 StartTime AS starttime,
1896 Pool.Name AS poolname,
1897 JobFiles AS jobfiles,
1898 JobBytes AS jobbytes,
1899 JobStatus AS jobstatus,
1900 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1901 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1904 JobErrors AS joberrors
1907 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1908 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1909 WHERE Client.ClientId=Job.ClientId
1910 AND Job.JobStatus != 'R'
1915 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1917 $self->display({ Filter => $label,
1921 sort { $a->{jobid} <=> $b->{jobid} }
1928 # display job informations
1929 sub display_job_zoom
1931 my ($self, $jobid) = @_ ;
1933 $jobid = $self->dbh_quote($jobid);
1936 SELECT DISTINCT Job.JobId AS jobid,
1937 Client.Name AS client,
1938 Job.Name AS jobname,
1939 FileSet.FileSet AS fileset,
1941 Pool.Name AS poolname,
1942 StartTime AS starttime,
1943 JobFiles AS jobfiles,
1944 JobBytes AS jobbytes,
1945 JobStatus AS jobstatus,
1946 JobErrors AS joberrors,
1947 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1948 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1951 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1952 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1953 WHERE Client.ClientId=Job.ClientId
1954 AND Job.JobId = $jobid
1957 my $row = $self->dbh_selectrow_hashref($query) ;
1959 # display all volumes associate with this job
1961 SELECT Media.VolumeName as volumename
1962 FROM Job,Media,JobMedia
1963 WHERE Job.JobId = $jobid
1964 AND JobMedia.JobId=Job.JobId
1965 AND JobMedia.MediaId=Media.MediaId
1968 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1970 $row->{volumes} = [ values %$all ] ;
1972 $self->display($row, "display_job_zoom.tpl");
1979 my ($where, %elt) = $self->get_param('pool',
1982 my $arg = $self->get_form('jmedias', 'qre_media');
1984 if ($arg->{jmedias}) {
1985 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1987 if ($arg->{qre_media}) {
1988 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1992 SELECT Media.VolumeName AS volumename,
1993 Media.VolBytes AS volbytes,
1994 Media.VolStatus AS volstatus,
1995 Media.MediaType AS mediatype,
1996 Media.InChanger AS online,
1997 Media.LastWritten AS lastwritten,
1998 Location.Location AS location,
1999 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2000 Pool.Name AS poolname,
2001 $self->{sql}->{FROM_UNIXTIME}(
2002 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2003 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2006 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2007 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2008 Media.MediaType AS MediaType
2010 WHERE Media.VolStatus = 'Full'
2011 GROUP BY Media.MediaType
2012 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2014 WHERE Media.PoolId=Pool.PoolId
2018 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2020 $self->display({ ID => $cur_id++,
2022 Location => $elt{location},
2023 Medias => [ values %$all ]
2025 "display_media.tpl");
2032 my $pool = $self->get_form('db_pools');
2034 foreach my $name (@{ $pool->{db_pools} }) {
2035 CGI::param('pool', $name->{name});
2036 $self->display_media();
2040 sub display_media_zoom
2044 my $medias = $self->get_form('jmedias');
2046 unless ($medias->{jmedias}) {
2047 return $self->error("Can't get media selection");
2051 SELECT InChanger AS online,
2052 VolBytes AS nb_bytes,
2053 VolumeName AS volumename,
2054 VolStatus AS volstatus,
2055 VolMounts AS nb_mounts,
2056 Media.VolUseDuration AS voluseduration,
2057 Media.MaxVolJobs AS maxvoljobs,
2058 Media.MaxVolFiles AS maxvolfiles,
2059 Media.MaxVolBytes AS maxvolbytes,
2060 VolErrors AS nb_errors,
2061 Pool.Name AS poolname,
2062 Location.Location AS location,
2063 Media.Recycle AS recycle,
2064 Media.VolRetention AS volretention,
2065 Media.LastWritten AS lastwritten,
2066 Media.VolReadTime/1000000 AS volreadtime,
2067 Media.VolWriteTime/1000000 AS volwritetime,
2068 Media.RecycleCount AS recyclecount,
2069 Media.Comment AS comment,
2070 $self->{sql}->{FROM_UNIXTIME}(
2071 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2072 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2075 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2076 WHERE Pool.PoolId = Media.PoolId
2077 AND VolumeName IN ($medias->{jmedias})
2080 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2082 foreach my $media (values %$all) {
2083 my $mq = $self->dbh_quote($media->{volumename});
2086 SELECT DISTINCT Job.JobId AS jobid,
2088 Job.StartTime AS starttime,
2091 Job.JobFiles AS files,
2092 Job.JobBytes AS bytes,
2093 Job.jobstatus AS status
2094 FROM Media,JobMedia,Job
2095 WHERE Media.VolumeName=$mq
2096 AND Media.MediaId=JobMedia.MediaId
2097 AND JobMedia.JobId=Job.JobId
2100 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2103 SELECT LocationLog.Date AS date,
2104 Location.Location AS location,
2105 LocationLog.Comment AS comment
2106 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2107 WHERE Media.MediaId = LocationLog.MediaId
2108 AND Media.VolumeName = $mq
2112 my $log = $self->dbh_selectall_arrayref($query) ;
2114 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2117 $self->display({ jobs => [ values %$jobs ],
2118 LocationLog => $logtxt,
2120 "display_media_zoom.tpl");
2128 my $loc = $self->get_form('qlocation');
2129 unless ($loc->{qlocation}) {
2130 return $self->error("Can't get location");
2134 SELECT Location.Location AS location,
2135 Location.Cost AS cost,
2136 Location.Enabled AS enabled
2138 WHERE Location.Location = $loc->{qlocation}
2141 my $row = $self->dbh_selectrow_hashref($query);
2143 $self->display({ ID => $cur_id++,
2144 %$row }, "location_edit.tpl") ;
2152 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2153 unless ($arg->{qlocation}) {
2154 return $self->error("Can't get location");
2156 unless ($arg->{qnewlocation}) {
2157 return $self->error("Can't get new location name");
2159 unless ($arg->{cost}) {
2160 return $self->error("Can't get new cost");
2163 my $enabled = CGI::param('enabled') || '';
2164 $enabled = $enabled?1:0;
2167 UPDATE Location SET Cost = $arg->{cost},
2168 Location = $arg->{qnewlocation},
2170 WHERE Location.Location = $arg->{qlocation}
2173 $self->dbh_do($query);
2175 $self->display_location();
2181 my $arg = $self->get_form(qw/qlocation/) ;
2183 unless ($arg->{qlocation}) {
2184 return $self->error("Can't get location");
2188 SELECT count(Media.MediaId) AS nb
2189 FROM Media INNER JOIN Location USING (LocationID)
2190 WHERE Location = $arg->{qlocation}
2193 my $res = $self->dbh_selectrow_hashref($query);
2196 return $self->error("Sorry, the location must be empty");
2200 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2203 $self->dbh_do($query);
2205 $self->display_location();
2212 my $arg = $self->get_form(qw/qlocation cost/) ;
2214 unless ($arg->{qlocation}) {
2215 $self->display({}, "location_add.tpl");
2218 unless ($arg->{cost}) {
2219 return $self->error("Can't get new cost");
2222 my $enabled = CGI::param('enabled') || '';
2223 $enabled = $enabled?1:0;
2226 INSERT INTO Location (Location, Cost, Enabled)
2227 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2230 $self->dbh_do($query);
2232 $self->display_location();
2235 sub display_location
2240 SELECT Location.Location AS location,
2241 Location.Cost AS cost,
2242 Location.Enabled AS enabled,
2243 (SELECT count(Media.MediaId)
2245 WHERE Media.LocationId = Location.LocationId
2250 my $location = $self->dbh_selectall_hashref($query, 'location');
2252 $self->display({ ID => $cur_id++,
2253 Locations => [ values %$location ] },
2254 "display_location.tpl");
2261 my $medias = $self->get_selected_media_location();
2266 my $arg = $self->get_form('db_locations', 'qnewlocation');
2268 $self->display({ email => $self->{info}->{email_media},
2270 medias => [ values %$medias ],
2272 "update_location.tpl");
2275 sub get_media_max_size
2277 my ($self, $type) = @_;
2279 "SELECT avg(VolBytes) AS size
2281 WHERE Media.VolStatus = 'Full'
2282 AND Media.MediaType = '$type'
2285 my $res = $self->selectrow_hashref($query);
2288 return $res->{size};
2298 my $media = $self->get_form('qmedia');
2300 unless ($media->{qmedia}) {
2301 return $self->error("Can't get media");
2305 SELECT Media.Slot AS slot,
2306 PoolMedia.Name AS poolname,
2307 Media.VolStatus AS volstatus,
2308 Media.InChanger AS inchanger,
2309 Location.Location AS location,
2310 Media.VolumeName AS volumename,
2311 Media.MaxVolBytes AS maxvolbytes,
2312 Media.MaxVolJobs AS maxvoljobs,
2313 Media.MaxVolFiles AS maxvolfiles,
2314 Media.VolUseDuration AS voluseduration,
2315 Media.VolRetention AS volretention,
2316 Media.Comment AS comment,
2317 PoolRecycle.Name AS poolrecycle
2319 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2320 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2321 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2323 WHERE Media.VolumeName = $media->{qmedia}
2326 my $row = $self->dbh_selectrow_hashref($query);
2327 $row->{volretention} = human_sec($row->{volretention});
2328 $row->{voluseduration} = human_sec($row->{voluseduration});
2330 my $elt = $self->get_form(qw/db_pools db_locations/);
2335 }, "update_media.tpl");
2342 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2344 unless ($arg->{jmedias}) {
2345 return $self->error("Can't get selected media");
2348 unless ($arg->{qnewlocation}) {
2349 return $self->error("Can't get new location");
2354 SET LocationId = (SELECT LocationId
2356 WHERE Location = $arg->{qnewlocation})
2357 WHERE Media.VolumeName IN ($arg->{jmedias})
2360 my $nb = $self->dbh_do($query);
2362 print "$nb media updated, you may have to update your autochanger.";
2364 $self->display_media();
2371 my $medias = $self->get_selected_media_location();
2373 return $self->error("Can't get media selection");
2375 my $newloc = CGI::param('newlocation');
2377 my $user = CGI::param('user') || 'unknow';
2378 my $comm = CGI::param('comment') || '';
2379 $comm = $self->dbh_quote("$user: $comm");
2383 foreach my $media (keys %$medias) {
2385 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2387 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2388 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2389 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2392 $self->dbh_do($query);
2393 $self->debug($query);
2397 $q->param('action', 'update_location');
2398 my $url = $q->url(-full => 1, -query=>1);
2400 $self->display({ email => $self->{info}->{email_media},
2402 newlocation => $newloc,
2403 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2404 medias => [ values %$medias ],
2406 "change_location.tpl");
2410 sub display_client_stats
2412 my ($self, %arg) = @_ ;
2414 my $client = $self->dbh_quote($arg{clientname});
2415 my ($limit, $label) = $self->get_limit(%arg);
2419 count(Job.JobId) AS nb_jobs,
2420 sum(Job.JobBytes) AS nb_bytes,
2421 sum(Job.JobErrors) AS nb_err,
2422 sum(Job.JobFiles) AS nb_files,
2423 Client.Name AS clientname
2424 FROM Job INNER JOIN Client USING (ClientId)
2426 Client.Name = $client
2428 GROUP BY Client.Name
2431 my $row = $self->dbh_selectrow_hashref($query);
2433 $row->{ID} = $cur_id++;
2434 $row->{label} = $label;
2436 $self->display($row, "display_client_stats.tpl");
2439 # poolname can be undef
2442 my ($self, $poolname) = @_ ;
2444 # TODO : afficher les tailles et les dates
2447 SELECT subq.volmax AS volmax,
2448 subq.volnum AS volnum,
2449 subq.voltotal AS voltotal,
2451 Pool.Recycle AS recycle,
2452 Pool.VolRetention AS volretention,
2453 Pool.VolUseDuration AS voluseduration,
2454 Pool.MaxVolJobs AS maxvoljobs,
2455 Pool.MaxVolFiles AS maxvolfiles,
2456 Pool.MaxVolBytes AS maxvolbytes,
2457 subq.PoolId AS PoolId
2460 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2461 count(Media.MediaId) AS volnum,
2462 sum(Media.VolBytes) AS voltotal,
2463 Media.PoolId AS PoolId,
2464 Media.MediaType AS MediaType
2466 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2467 Media.MediaType AS MediaType
2469 WHERE Media.VolStatus = 'Full'
2470 GROUP BY Media.MediaType
2471 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2472 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2474 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2477 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2480 SELECT Pool.Name AS name,
2481 sum(VolBytes) AS size
2482 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2483 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2486 my $empty = $self->dbh_selectall_hashref($query, 'name');
2488 foreach my $p (values %$all) {
2489 if ($p->{volmax} > 0) { # mysql returns 0.0000
2490 # we remove Recycled/Purged media from pool usage
2491 if (defined $empty->{$p->{name}}) {
2492 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2494 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2496 $p->{poolusage} = 0;
2500 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2502 WHERE PoolId=$p->{poolid}
2505 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2506 foreach my $t (values %$content) {
2507 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2512 $self->display({ ID => $cur_id++,
2513 Pools => [ values %$all ]},
2514 "display_pool.tpl");
2517 sub display_running_job
2521 my $arg = $self->get_form('client', 'jobid');
2523 if (!$arg->{client} and $arg->{jobid}) {
2526 SELECT Client.Name AS name
2527 FROM Job INNER JOIN Client USING (ClientId)
2528 WHERE Job.JobId = $arg->{jobid}
2531 my $row = $self->dbh_selectrow_hashref($query);
2534 $arg->{client} = $row->{name};
2535 CGI::param('client', $arg->{client});
2539 if ($arg->{client}) {
2540 my $cli = new Bweb::Client(name => $arg->{client});
2541 $cli->display_running_job($self->{info}, $arg->{jobid});
2542 if ($arg->{jobid}) {
2543 $self->get_job_log();
2546 $self->error("Can't get client or jobid");
2550 sub display_running_jobs
2552 my ($self, $display_action) = @_;
2555 SELECT Job.JobId AS jobid,
2556 Job.Name AS jobname,
2558 Job.StartTime AS starttime,
2559 Job.JobFiles AS jobfiles,
2560 Job.JobBytes AS jobbytes,
2561 Job.JobStatus AS jobstatus,
2562 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2563 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2565 Client.Name AS clientname
2566 FROM Job INNER JOIN Client USING (ClientId)
2567 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2569 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2571 $self->display({ ID => $cur_id++,
2572 display_action => $display_action,
2573 Jobs => [ values %$all ]},
2574 "running_job.tpl") ;
2580 my $arg = $self->get_form('jmedias');
2582 unless ($arg->{jmedias}) {
2583 return $self->error("Can't get media selection");
2587 SELECT Media.VolumeName AS volumename,
2588 Storage.Name AS storage,
2589 Location.Location AS location,
2591 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2592 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2593 WHERE Media.VolumeName IN ($arg->{jmedias})
2594 AND Media.InChanger = 1
2597 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2599 foreach my $vol (values %$all) {
2600 my $a = $self->ach_get($vol->{location});
2603 unless ($a->{have_status}) {
2605 $a->{have_status} = 1;
2608 print "eject $vol->{volumename} from $vol->{storage} : ";
2609 if ($a->send_to_io($vol->{slot})) {
2621 my ($to, $subject, $content) = (CGI::param('email'),
2622 CGI::param('subject'),
2623 CGI::param('content'));
2624 $to =~ s/[^\w\d\.\@<>,]//;
2625 $subject =~ s/[^\w\d\.\[\]]/ /;
2627 open(MAIL, "|mail -s '$subject' '$to'") ;
2628 print MAIL $content;
2638 my $arg = $self->get_form('jobid', 'client');
2640 print CGI::header('text/brestore');
2641 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2642 print "client=$arg->{client}\n" if ($arg->{client});
2643 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2647 # TODO : move this to Bweb::Autochanger ?
2648 # TODO : make this internal to not eject tape ?
2654 my ($self, $name) = @_;
2657 return $self->error("Can't get your autochanger name ach");
2660 unless ($self->{info}->{ach_list}) {
2661 return $self->error("Could not find any autochanger");
2664 my $a = $self->{info}->{ach_list}->{$name};
2667 $self->error("Can't get your autochanger $name from your ach_list");
2678 my ($self, $ach) = @_;
2680 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2682 $self->{info}->save();
2690 my $arg = $self->get_form('ach');
2692 or !$self->{info}->{ach_list}
2693 or !$self->{info}->{ach_list}->{$arg->{ach}})
2695 return $self->error("Can't get autochanger name");
2698 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2702 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2704 my $b = $self->get_bconsole();
2706 my @storages = $b->list_storage() ;
2708 $ach->{devices} = [ map { { name => $_ } } @storages ];
2710 $self->display($ach, "ach_add.tpl");
2711 delete $ach->{drives};
2712 delete $ach->{devices};
2719 my $arg = $self->get_form('ach');
2722 or !$self->{info}->{ach_list}
2723 or !$self->{info}->{ach_list}->{$arg->{ach}})
2725 return $self->error("Can't get autochanger name");
2728 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2730 $self->{info}->save();
2731 $self->{info}->view();
2737 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2739 my $b = $self->get_bconsole();
2740 my @storages = $b->list_storage() ;
2742 unless ($arg->{ach}) {
2743 $arg->{devices} = [ map { { name => $_ } } @storages ];
2744 return $self->display($arg, "ach_add.tpl");
2748 foreach my $drive (CGI::param('drives'))
2750 unless (grep(/^$drive$/,@storages)) {
2751 return $self->error("Can't find $drive in storage list");
2754 my $index = CGI::param("index_$drive");
2755 unless (defined $index and $index =~ /^(\d+)$/) {
2756 return $self->error("Can't get $drive index");
2759 $drives[$index] = $drive;
2763 return $self->error("Can't get drives from Autochanger");
2766 my $a = new Bweb::Autochanger(name => $arg->{ach},
2767 precmd => $arg->{precmd},
2768 drive_name => \@drives,
2769 device => $arg->{device},
2770 mtxcmd => $arg->{mtxcmd});
2772 $self->ach_register($a) ;
2774 $self->{info}->view();
2780 my $arg = $self->get_form('jobid');
2782 if ($arg->{jobid}) {
2783 my $b = $self->get_bconsole();
2784 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2788 title => "Delete a job ",
2789 name => "delete jobid=$arg->{jobid}",
2798 my $arg = $self->get_form(qw/media volstatus inchanger pool
2799 slot volretention voluseduration
2800 maxvoljobs maxvolfiles maxvolbytes
2801 qcomment poolrecycle
2804 unless ($arg->{media}) {
2805 return $self->error("Can't find media selection");
2808 my $update = "update volume=$arg->{media} ";
2810 if ($arg->{volstatus}) {
2811 $update .= " volstatus=$arg->{volstatus} ";
2814 if ($arg->{inchanger}) {
2815 $update .= " inchanger=yes " ;
2817 $update .= " slot=$arg->{slot} ";
2820 $update .= " slot=0 inchanger=no ";
2824 $update .= " pool=$arg->{pool} " ;
2827 $arg->{volretention} ||= 0 ;
2828 if ($arg->{volretention}) {
2829 $update .= " volretention=\"$arg->{volretention}\" " ;
2832 $arg->{voluseduration} ||= 0 ;
2833 if ($arg->{voluseduration}) {
2834 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2837 $arg->{maxvoljobs} ||= 0;
2838 if ($arg->{maxvoljobs}) {
2839 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2842 $arg->{maxvolfiles} ||= 0;
2843 if ($arg->{maxvolfiles}) {
2844 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2847 $arg->{maxvolbytes} ||= 0;
2848 if ($arg->{maxvolbytes}) {
2849 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2852 my $b = $self->get_bconsole();
2855 content => $b->send_cmd($update),
2856 title => "Update a volume ",
2862 my $media = $self->dbh_quote($arg->{media});
2864 my $loc = CGI::param('location') || '';
2866 $loc = $self->dbh_quote($loc); # is checked by db
2867 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2869 if ($arg->{poolrecycle}) {
2870 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2872 if (!$arg->{qcomment}) {
2873 $arg->{qcomment} = "''";
2875 push @q, "Comment=$arg->{qcomment}";
2880 SET " . join (',', @q) . "
2881 WHERE Media.VolumeName = $media
2883 $self->dbh_do($query);
2885 $self->update_media();
2892 my $ach = CGI::param('ach') ;
2893 $ach = $self->ach_get($ach);
2895 return $self->error("Bad autochanger name");
2899 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2900 $b->update_slots($ach->{name});
2908 my $arg = $self->get_form('jobid');
2909 unless ($arg->{jobid}) {
2910 return $self->error("Can't get jobid");
2913 my $t = CGI::param('time') || '';
2916 SELECT Job.Name as name, Client.Name as clientname
2917 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2918 WHERE JobId = $arg->{jobid}
2921 my $row = $self->dbh_selectrow_hashref($query);
2924 return $self->error("Can't find $arg->{jobid} in catalog");
2928 SELECT Time AS time, LogText AS log
2930 WHERE Log.JobId = $arg->{jobid}
2931 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2932 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2937 my $log = $self->dbh_selectall_arrayref($query);
2939 return $self->error("Can't get log for jobid $arg->{jobid}");
2945 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2947 $logtxt = join("", map { $_->[1] } @$log ) ;
2950 $self->display({ lines=> $logtxt,
2951 jobid => $arg->{jobid},
2952 name => $row->{name},
2953 client => $row->{clientname},
2954 }, 'display_log.tpl');
2962 my $arg = $self->get_form('ach', 'slots', 'drive');
2964 unless ($arg->{ach}) {
2965 return $self->error("Can't find autochanger name");
2970 if ($arg->{slots}) {
2971 $slots = join(",", @{ $arg->{slots} });
2972 $t += 60*scalar( @{ $arg->{slots} }) ;
2975 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2976 print "<h1>This command can take long time, be patient...</h1>";
2978 $b->label_barcodes(storage => $arg->{ach},
2979 drive => $arg->{drive},
2990 my @volume = CGI::param('media');
2993 return $self->error("Can't get media selection");
2996 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2999 content => $b->purge_volume(@volume),
3000 title => "Purge media",
3001 name => "purge volume=" . join(' volume=', @volume),
3010 my @volume = CGI::param('media');
3012 return $self->error("Can't get media selection");
3015 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3018 content => $b->prune_volume(@volume),
3019 title => "Prune media",
3020 name => "prune volume=" . join(' volume=', @volume),
3030 my $arg = $self->get_form('jobid');
3031 unless ($arg->{jobid}) {
3032 return $self->error("Can't get jobid");
3035 my $b = $self->get_bconsole();
3037 content => $b->cancel($arg->{jobid}),
3038 title => "Cancel job",
3039 name => "cancel jobid=$arg->{jobid}",
3045 # Warning, we display current fileset
3048 my $arg = $self->get_form('fileset');
3050 if ($arg->{fileset}) {
3051 my $b = $self->get_bconsole();
3052 my $ret = $b->get_fileset($arg->{fileset});
3053 $self->display({ fileset => $arg->{fileset},
3055 }, "fileset_view.tpl");
3057 $self->error("Can't get fileset name");
3061 sub director_show_sched
3065 my $arg = $self->get_form('days');
3067 my $b = $self->get_bconsole();
3068 my $ret = $b->director_get_sched( $arg->{days} );
3073 }, "scheduled_job.tpl");
3076 sub enable_disable_job
3078 my ($self, $what) = @_ ;
3080 my $name = CGI::param('job') || '';
3081 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3082 return $self->error("Can't find job name");
3085 my $b = $self->get_bconsole();
3095 content => $b->send_cmd("$cmd job=\"$name\""),
3096 title => "$cmd $name",
3097 name => "$cmd job=\"$name\"",
3104 return new Bconsole(pref => $self->{info});
3110 my $b = $self->get_bconsole();
3112 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3114 $self->display({ Jobs => $joblist }, "run_job.tpl");
3119 my ($self, $ouput) = @_;
3122 foreach my $l (split(/\r\n/, $ouput)) {
3123 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3129 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3135 foreach my $k (keys %arg) {
3136 $lowcase{lc($k)} = $arg{$k} ;
3145 my $b = $self->get_bconsole();
3147 my $job = CGI::param('job') || '';
3149 my $info = $b->send_cmd("show job=\"$job\"");
3150 my $attr = $self->run_parse_job($info);
3152 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3154 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3155 my $clients = [ map { { name => $_ } }$b->list_client()];
3156 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3157 my $storages= [ map { { name => $_ } }$b->list_storage()];
3162 clients => $clients,
3163 filesets => $filesets,
3164 storages => $storages,
3166 }, "run_job_mod.tpl");
3172 my $b = $self->get_bconsole();
3174 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3184 my $b = $self->get_bconsole();
3186 # TODO: check input (don't use pool, level)
3188 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3189 my $job = CGI::param('job') || '';
3190 my $storage = CGI::param('storage') || '';
3192 my $jobid = $b->run(job => $job,
3193 client => $arg->{client},
3194 priority => $arg->{priority},
3195 level => $arg->{level},
3196 storage => $storage,
3197 pool => $arg->{pool},
3200 print $jobid, $b->{error};
3202 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";