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 ''
1357 my %opt_p = ( # option with path
1364 my %opt_d = ( # option with date
1369 foreach my $i (@what) {
1370 if (exists $opt_i{$i}) {# integer param
1371 my $value = CGI::param($i) || $opt_i{$i} ;
1372 if ($value =~ /^(\d+)$/) {
1375 } elsif ($opt_s{$i}) { # simple string param
1376 my $value = CGI::param($i) || '';
1377 if ($value =~ /^([\w\d\.-]+)$/) {
1381 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1382 my @value = CGI::param($1) ;
1384 $ret{$i} = $self->dbh_join(@value) ;
1387 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1388 my $value = CGI::param($1) ;
1390 $ret{$i} = $self->dbh_quote($value);
1393 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1394 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1396 } elsif (exists $opt_p{$i}) {
1397 my $value = CGI::param($i) || '';
1398 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1401 } elsif (exists $opt_d{$i}) {
1402 my $value = CGI::param($i) || '';
1403 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1410 foreach my $s (CGI::param('slot')) {
1411 if ($s =~ /^(\d+)$/) {
1412 push @{$ret{slots}}, $s;
1417 if ($what{db_clients}) {
1419 SELECT Client.Name as clientname
1423 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1424 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1428 if ($what{db_mediatypes}) {
1430 SELECT MediaType as mediatype
1434 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1435 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1439 if ($what{db_locations}) {
1441 SELECT Location as location, Cost as cost FROM Location
1443 my $loc = $self->dbh_selectall_hashref($query, 'location');
1444 $ret{db_locations} = [ sort { $a->{location}
1450 if ($what{db_pools}) {
1451 my $query = "SELECT Name as name FROM Pool";
1453 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1454 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1457 if ($what{db_filesets}) {
1459 SELECT FileSet.FileSet AS fileset
1463 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1465 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1466 values %$filesets] ;
1469 if ($what{db_jobnames}) {
1471 SELECT DISTINCT Job.Name AS jobname
1475 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1477 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1478 values %$jobnames] ;
1481 if ($what{db_devices}) {
1483 SELECT Device.Name AS name
1487 my $devices = $self->dbh_selectall_hashref($query, 'name');
1489 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1500 my $fields = $self->get_form(qw/age level status clients filesets
1502 db_clients limit db_filesets width height
1503 qclients qfilesets qjobnames db_jobnames/);
1506 my $url = CGI::url(-full => 0,
1509 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1511 # this organisation is to keep user choice between 2 click
1512 # TODO : fileset and client selection doesn't work
1521 sub display_client_job
1523 my ($self, %arg) = @_ ;
1525 $arg{order} = ' Job.JobId DESC ';
1526 my ($limit, $label) = $self->get_limit(%arg);
1528 my $clientname = $self->dbh_quote($arg{clientname});
1531 SELECT DISTINCT Job.JobId AS jobid,
1532 Job.Name AS jobname,
1533 FileSet.FileSet AS fileset,
1535 StartTime AS starttime,
1536 JobFiles AS jobfiles,
1537 JobBytes AS jobbytes,
1538 JobStatus AS jobstatus,
1539 JobErrors AS joberrors
1541 FROM Client,Job,FileSet
1542 WHERE Client.Name=$clientname
1543 AND Client.ClientId=Job.ClientId
1544 AND Job.FileSetId=FileSet.FileSetId
1548 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1550 $self->display({ clientname => $arg{clientname},
1553 Jobs => [ values %$all ],
1555 "display_client_job.tpl") ;
1558 sub get_selected_media_location
1562 my $medias = $self->get_form('jmedias');
1564 unless ($medias->{jmedias}) {
1569 SELECT Media.VolumeName AS volumename, Location.Location AS location
1570 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1571 WHERE Media.VolumeName IN ($medias->{jmedias})
1574 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1576 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1587 my $medias = $self->get_selected_media_location();
1593 my $elt = $self->get_form('db_locations');
1595 $self->display({ ID => $cur_id++,
1596 %$elt, # db_locations
1598 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1608 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1610 $self->display($elt, "help_extern.tpl");
1613 sub help_extern_compute
1617 my $number = CGI::param('limit') || '' ;
1618 unless ($number =~ /^(\d+)$/) {
1619 return $self->error("Bad arg number : $number ");
1622 my ($sql, undef) = $self->get_param('pools',
1623 'locations', 'mediatypes');
1626 SELECT Media.VolumeName AS volumename,
1627 Media.VolStatus AS volstatus,
1628 Media.LastWritten AS lastwritten,
1629 Media.MediaType AS mediatype,
1630 Media.VolMounts AS volmounts,
1632 Media.Recycle AS recycle,
1633 $self->{sql}->{FROM_UNIXTIME}(
1634 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1635 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1638 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1639 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1641 WHERE Media.InChanger = 1
1642 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1644 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1648 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1650 $self->display({ Medias => [ values %$all ] },
1651 "help_extern_compute.tpl");
1658 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1659 $self->display($param, "help_intern.tpl");
1662 sub help_intern_compute
1666 my $number = CGI::param('limit') || '' ;
1667 unless ($number =~ /^(\d+)$/) {
1668 return $self->error("Bad arg number : $number ");
1671 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1673 if (CGI::param('expired')) {
1675 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1676 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1682 SELECT Media.VolumeName AS volumename,
1683 Media.VolStatus AS volstatus,
1684 Media.LastWritten AS lastwritten,
1685 Media.MediaType AS mediatype,
1686 Media.VolMounts AS volmounts,
1688 $self->{sql}->{FROM_UNIXTIME}(
1689 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1690 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1693 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1694 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1696 WHERE Media.InChanger <> 1
1697 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1698 AND Media.Recycle = 1
1700 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1704 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1706 $self->display({ Medias => [ values %$all ] },
1707 "help_intern_compute.tpl");
1713 my ($self, %arg) = @_ ;
1715 my ($limit, $label) = $self->get_limit(%arg);
1719 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1720 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1721 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1722 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1723 (SELECT count(Job.JobId)
1725 WHERE Job.JobStatus IN ('E','e','f','A')
1728 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1731 my $row = $self->dbh_selectrow_hashref($query) ;
1733 $row->{nb_bytes} = human_size($row->{nb_bytes});
1735 $row->{db_size} = '???';
1736 $row->{label} = $label;
1738 $self->display($row, "general.tpl");
1743 my ($self, @what) = @_ ;
1744 my %elt = map { $_ => 1 } @what;
1749 if ($elt{clients}) {
1750 my @clients = CGI::param('client');
1752 $ret{clients} = \@clients;
1753 my $str = $self->dbh_join(@clients);
1754 $limit .= "AND Client.Name IN ($str) ";
1758 if ($elt{filesets}) {
1759 my @filesets = CGI::param('fileset');
1761 $ret{filesets} = \@filesets;
1762 my $str = $self->dbh_join(@filesets);
1763 $limit .= "AND FileSet.FileSet IN ($str) ";
1767 if ($elt{mediatypes}) {
1768 my @medias = CGI::param('mediatype');
1770 $ret{mediatypes} = \@medias;
1771 my $str = $self->dbh_join(@medias);
1772 $limit .= "AND Media.MediaType IN ($str) ";
1777 my $client = CGI::param('client');
1778 $ret{client} = $client;
1779 $client = $self->dbh_join($client);
1780 $limit .= "AND Client.Name = $client ";
1784 my $level = CGI::param('level') || '';
1785 if ($level =~ /^(\w)$/) {
1787 $limit .= "AND Job.Level = '$1' ";
1792 my $jobid = CGI::param('jobid') || '';
1794 if ($jobid =~ /^(\d+)$/) {
1796 $limit .= "AND Job.JobId = '$1' ";
1801 my $status = CGI::param('status') || '';
1802 if ($status =~ /^(\w)$/) {
1805 $limit .= "AND Job.JobStatus IN ('f','E') ";
1807 $limit .= "AND Job.JobStatus = '$1' ";
1812 if ($elt{locations}) {
1813 my @location = CGI::param('location') ;
1815 $ret{locations} = \@location;
1816 my $str = $self->dbh_join(@location);
1817 $limit .= "AND Location.Location IN ($str) ";
1822 my @pool = CGI::param('pool') ;
1824 $ret{pools} = \@pool;
1825 my $str = $self->dbh_join(@pool);
1826 $limit .= "AND Pool.Name IN ($str) ";
1830 if ($elt{location}) {
1831 my $location = CGI::param('location') || '';
1833 $ret{location} = $location;
1834 $location = $self->dbh_quote($location);
1835 $limit .= "AND Location.Location = $location ";
1840 my $pool = CGI::param('pool') || '';
1843 $pool = $self->dbh_quote($pool);
1844 $limit .= "AND Pool.Name = $pool ";
1848 if ($elt{jobtype}) {
1849 my $jobtype = CGI::param('jobtype') || '';
1850 if ($jobtype =~ /^(\w)$/) {
1852 $limit .= "AND Job.Type = '$1' ";
1856 return ($limit, %ret);
1867 my ($self, %arg) = @_ ;
1869 $arg{order} = ' Job.JobId DESC ';
1871 my ($limit, $label) = $self->get_limit(%arg);
1872 my ($where, undef) = $self->get_param('clients',
1880 SELECT Job.JobId AS jobid,
1881 Client.Name AS client,
1882 FileSet.FileSet AS fileset,
1883 Job.Name AS jobname,
1885 StartTime AS starttime,
1886 Pool.Name AS poolname,
1887 JobFiles AS jobfiles,
1888 JobBytes AS jobbytes,
1889 JobStatus AS jobstatus,
1890 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1891 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1894 JobErrors AS joberrors
1897 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1898 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1899 WHERE Client.ClientId=Job.ClientId
1900 AND Job.JobStatus != 'R'
1905 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1907 $self->display({ Filter => $label,
1911 sort { $a->{jobid} <=> $b->{jobid} }
1918 # display job informations
1919 sub display_job_zoom
1921 my ($self, $jobid) = @_ ;
1923 $jobid = $self->dbh_quote($jobid);
1926 SELECT DISTINCT Job.JobId AS jobid,
1927 Client.Name AS client,
1928 Job.Name AS jobname,
1929 FileSet.FileSet AS fileset,
1931 Pool.Name AS poolname,
1932 StartTime AS starttime,
1933 JobFiles AS jobfiles,
1934 JobBytes AS jobbytes,
1935 JobStatus AS jobstatus,
1936 JobErrors AS joberrors,
1937 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1938 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1941 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1942 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1943 WHERE Client.ClientId=Job.ClientId
1944 AND Job.JobId = $jobid
1947 my $row = $self->dbh_selectrow_hashref($query) ;
1949 # display all volumes associate with this job
1951 SELECT Media.VolumeName as volumename
1952 FROM Job,Media,JobMedia
1953 WHERE Job.JobId = $jobid
1954 AND JobMedia.JobId=Job.JobId
1955 AND JobMedia.MediaId=Media.MediaId
1958 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1960 $row->{volumes} = [ values %$all ] ;
1962 $self->display($row, "display_job_zoom.tpl");
1969 my ($where, %elt) = $self->get_param('pool',
1972 my $arg = $self->get_form('jmedias', 'qre_media');
1974 if ($arg->{jmedias}) {
1975 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1977 if ($arg->{qre_media}) {
1978 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
1982 SELECT Media.VolumeName AS volumename,
1983 Media.VolBytes AS volbytes,
1984 Media.VolStatus AS volstatus,
1985 Media.MediaType AS mediatype,
1986 Media.InChanger AS online,
1987 Media.LastWritten AS lastwritten,
1988 Location.Location AS location,
1989 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1990 Pool.Name AS poolname,
1991 $self->{sql}->{FROM_UNIXTIME}(
1992 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1993 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1996 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1997 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1998 Media.MediaType AS MediaType
2000 WHERE Media.VolStatus = 'Full'
2001 GROUP BY Media.MediaType
2002 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2004 WHERE Media.PoolId=Pool.PoolId
2008 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2010 $self->display({ ID => $cur_id++,
2012 Location => $elt{location},
2013 Medias => [ values %$all ]
2015 "display_media.tpl");
2022 my $pool = $self->get_form('db_pools');
2024 foreach my $name (@{ $pool->{db_pools} }) {
2025 CGI::param('pool', $name->{name});
2026 $self->display_media();
2030 sub display_media_zoom
2034 my $medias = $self->get_form('jmedias');
2036 unless ($medias->{jmedias}) {
2037 return $self->error("Can't get media selection");
2041 SELECT InChanger AS online,
2042 VolBytes AS nb_bytes,
2043 VolumeName AS volumename,
2044 VolStatus AS volstatus,
2045 VolMounts AS nb_mounts,
2046 Media.VolUseDuration AS voluseduration,
2047 Media.MaxVolJobs AS maxvoljobs,
2048 Media.MaxVolFiles AS maxvolfiles,
2049 Media.MaxVolBytes AS maxvolbytes,
2050 VolErrors AS nb_errors,
2051 Pool.Name AS poolname,
2052 Location.Location AS location,
2053 Media.Recycle AS recycle,
2054 Media.VolRetention AS volretention,
2055 Media.LastWritten AS lastwritten,
2056 Media.VolReadTime/1000000 AS volreadtime,
2057 Media.VolWriteTime/1000000 AS volwritetime,
2058 Media.RecycleCount AS recyclecount,
2059 Media.Comment AS comment,
2060 $self->{sql}->{FROM_UNIXTIME}(
2061 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2062 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2065 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2066 WHERE Pool.PoolId = Media.PoolId
2067 AND VolumeName IN ($medias->{jmedias})
2070 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2072 foreach my $media (values %$all) {
2073 my $mq = $self->dbh_quote($media->{volumename});
2076 SELECT DISTINCT Job.JobId AS jobid,
2078 Job.StartTime AS starttime,
2081 Job.JobFiles AS files,
2082 Job.JobBytes AS bytes,
2083 Job.jobstatus AS status
2084 FROM Media,JobMedia,Job
2085 WHERE Media.VolumeName=$mq
2086 AND Media.MediaId=JobMedia.MediaId
2087 AND JobMedia.JobId=Job.JobId
2090 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2093 SELECT LocationLog.Date AS date,
2094 Location.Location AS location,
2095 LocationLog.Comment AS comment
2096 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2097 WHERE Media.MediaId = LocationLog.MediaId
2098 AND Media.VolumeName = $mq
2102 my $log = $self->dbh_selectall_arrayref($query) ;
2104 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2107 $self->display({ jobs => [ values %$jobs ],
2108 LocationLog => $logtxt,
2110 "display_media_zoom.tpl");
2118 my $loc = $self->get_form('qlocation');
2119 unless ($loc->{qlocation}) {
2120 return $self->error("Can't get location");
2124 SELECT Location.Location AS location,
2125 Location.Cost AS cost,
2126 Location.Enabled AS enabled
2128 WHERE Location.Location = $loc->{qlocation}
2131 my $row = $self->dbh_selectrow_hashref($query);
2133 $self->display({ ID => $cur_id++,
2134 %$row }, "location_edit.tpl") ;
2142 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2143 unless ($arg->{qlocation}) {
2144 return $self->error("Can't get location");
2146 unless ($arg->{qnewlocation}) {
2147 return $self->error("Can't get new location name");
2149 unless ($arg->{cost}) {
2150 return $self->error("Can't get new cost");
2153 my $enabled = CGI::param('enabled') || '';
2154 $enabled = $enabled?1:0;
2157 UPDATE Location SET Cost = $arg->{cost},
2158 Location = $arg->{qnewlocation},
2160 WHERE Location.Location = $arg->{qlocation}
2163 $self->dbh_do($query);
2165 $self->display_location();
2171 my $arg = $self->get_form(qw/qlocation/) ;
2173 unless ($arg->{qlocation}) {
2174 return $self->error("Can't get location");
2178 SELECT count(Media.MediaId) AS nb
2179 FROM Media INNER JOIN Location USING (LocationID)
2180 WHERE Location = $arg->{qlocation}
2183 my $res = $self->dbh_selectrow_hashref($query);
2186 return $self->error("Sorry, the location must be empty");
2190 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2193 $self->dbh_do($query);
2195 $self->display_location();
2202 my $arg = $self->get_form(qw/qlocation cost/) ;
2204 unless ($arg->{qlocation}) {
2205 $self->display({}, "location_add.tpl");
2208 unless ($arg->{cost}) {
2209 return $self->error("Can't get new cost");
2212 my $enabled = CGI::param('enabled') || '';
2213 $enabled = $enabled?1:0;
2216 INSERT INTO Location (Location, Cost, Enabled)
2217 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2220 $self->dbh_do($query);
2222 $self->display_location();
2225 sub display_location
2230 SELECT Location.Location AS location,
2231 Location.Cost AS cost,
2232 Location.Enabled AS enabled,
2233 (SELECT count(Media.MediaId)
2235 WHERE Media.LocationId = Location.LocationId
2240 my $location = $self->dbh_selectall_hashref($query, 'location');
2242 $self->display({ ID => $cur_id++,
2243 Locations => [ values %$location ] },
2244 "display_location.tpl");
2251 my $medias = $self->get_selected_media_location();
2256 my $arg = $self->get_form('db_locations', 'qnewlocation');
2258 $self->display({ email => $self->{info}->{email_media},
2260 medias => [ values %$medias ],
2262 "update_location.tpl");
2265 sub get_media_max_size
2267 my ($self, $type) = @_;
2269 "SELECT avg(VolBytes) AS size
2271 WHERE Media.VolStatus = 'Full'
2272 AND Media.MediaType = '$type'
2275 my $res = $self->selectrow_hashref($query);
2278 return $res->{size};
2288 my $media = $self->get_form('qmedia');
2290 unless ($media->{qmedia}) {
2291 return $self->error("Can't get media");
2295 SELECT Media.Slot AS slot,
2296 PoolMedia.Name AS poolname,
2297 Media.VolStatus AS volstatus,
2298 Media.InChanger AS inchanger,
2299 Location.Location AS location,
2300 Media.VolumeName AS volumename,
2301 Media.MaxVolBytes AS maxvolbytes,
2302 Media.MaxVolJobs AS maxvoljobs,
2303 Media.MaxVolFiles AS maxvolfiles,
2304 Media.VolUseDuration AS voluseduration,
2305 Media.VolRetention AS volretention,
2306 Media.Comment AS comment,
2307 PoolRecycle.Name AS poolrecycle
2309 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2310 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2311 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2313 WHERE Media.VolumeName = $media->{qmedia}
2316 my $row = $self->dbh_selectrow_hashref($query);
2317 $row->{volretention} = human_sec($row->{volretention});
2318 $row->{voluseduration} = human_sec($row->{voluseduration});
2320 my $elt = $self->get_form(qw/db_pools db_locations/);
2325 }, "update_media.tpl");
2332 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2334 unless ($arg->{jmedias}) {
2335 return $self->error("Can't get selected media");
2338 unless ($arg->{qnewlocation}) {
2339 return $self->error("Can't get new location");
2344 SET LocationId = (SELECT LocationId
2346 WHERE Location = $arg->{qnewlocation})
2347 WHERE Media.VolumeName IN ($arg->{jmedias})
2350 my $nb = $self->dbh_do($query);
2352 print "$nb media updated, you may have to update your autochanger.";
2354 $self->display_media();
2361 my $medias = $self->get_selected_media_location();
2363 return $self->error("Can't get media selection");
2365 my $newloc = CGI::param('newlocation');
2367 my $user = CGI::param('user') || 'unknow';
2368 my $comm = CGI::param('comment') || '';
2369 $comm = $self->dbh_quote("$user: $comm");
2373 foreach my $media (keys %$medias) {
2375 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2377 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2378 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2379 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2382 $self->dbh_do($query);
2383 $self->debug($query);
2387 $q->param('action', 'update_location');
2388 my $url = $q->url(-full => 1, -query=>1);
2390 $self->display({ email => $self->{info}->{email_media},
2392 newlocation => $newloc,
2393 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2394 medias => [ values %$medias ],
2396 "change_location.tpl");
2400 sub display_client_stats
2402 my ($self, %arg) = @_ ;
2404 my $client = $self->dbh_quote($arg{clientname});
2405 my ($limit, $label) = $self->get_limit(%arg);
2409 count(Job.JobId) AS nb_jobs,
2410 sum(Job.JobBytes) AS nb_bytes,
2411 sum(Job.JobErrors) AS nb_err,
2412 sum(Job.JobFiles) AS nb_files,
2413 Client.Name AS clientname
2414 FROM Job INNER JOIN Client USING (ClientId)
2416 Client.Name = $client
2418 GROUP BY Client.Name
2421 my $row = $self->dbh_selectrow_hashref($query);
2423 $row->{ID} = $cur_id++;
2424 $row->{label} = $label;
2426 $self->display($row, "display_client_stats.tpl");
2429 # poolname can be undef
2432 my ($self, $poolname) = @_ ;
2434 # TODO : afficher les tailles et les dates
2437 SELECT subq.volmax AS volmax,
2438 subq.volnum AS volnum,
2439 subq.voltotal AS voltotal,
2441 Pool.Recycle AS recycle,
2442 Pool.VolRetention AS volretention,
2443 Pool.VolUseDuration AS voluseduration,
2444 Pool.MaxVolJobs AS maxvoljobs,
2445 Pool.MaxVolFiles AS maxvolfiles,
2446 Pool.MaxVolBytes AS maxvolbytes,
2447 subq.PoolId AS PoolId
2450 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2451 count(Media.MediaId) AS volnum,
2452 sum(Media.VolBytes) AS voltotal,
2453 Media.PoolId AS PoolId,
2454 Media.MediaType AS MediaType
2456 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2457 Media.MediaType AS MediaType
2459 WHERE Media.VolStatus = 'Full'
2460 GROUP BY Media.MediaType
2461 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2462 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2464 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2467 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2470 SELECT Pool.Name AS name,
2471 sum(VolBytes) AS size
2472 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2473 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2476 my $empty = $self->dbh_selectall_hashref($query, 'name');
2478 foreach my $p (values %$all) {
2479 if ($p->{volmax} > 0) { # mysql returns 0.0000
2480 # we remove Recycled/Purged media from pool usage
2481 if (defined $empty->{$p->{name}}) {
2482 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2484 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2486 $p->{poolusage} = 0;
2490 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2492 WHERE PoolId=$p->{poolid}
2495 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2496 foreach my $t (values %$content) {
2497 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2502 $self->display({ ID => $cur_id++,
2503 Pools => [ values %$all ]},
2504 "display_pool.tpl");
2507 sub display_running_job
2511 my $arg = $self->get_form('client', 'jobid');
2513 if (!$arg->{client} and $arg->{jobid}) {
2516 SELECT Client.Name AS name
2517 FROM Job INNER JOIN Client USING (ClientId)
2518 WHERE Job.JobId = $arg->{jobid}
2521 my $row = $self->dbh_selectrow_hashref($query);
2524 $arg->{client} = $row->{name};
2525 CGI::param('client', $arg->{client});
2529 if ($arg->{client}) {
2530 my $cli = new Bweb::Client(name => $arg->{client});
2531 $cli->display_running_job($self->{info}, $arg->{jobid});
2532 if ($arg->{jobid}) {
2533 $self->get_job_log();
2536 $self->error("Can't get client or jobid");
2540 sub display_running_jobs
2542 my ($self, $display_action) = @_;
2545 SELECT Job.JobId AS jobid,
2546 Job.Name AS jobname,
2548 Job.StartTime AS starttime,
2549 Job.JobFiles AS jobfiles,
2550 Job.JobBytes AS jobbytes,
2551 Job.JobStatus AS jobstatus,
2552 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2553 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2555 Client.Name AS clientname
2556 FROM Job INNER JOIN Client USING (ClientId)
2557 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2559 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2561 $self->display({ ID => $cur_id++,
2562 display_action => $display_action,
2563 Jobs => [ values %$all ]},
2564 "running_job.tpl") ;
2570 my $arg = $self->get_form('jmedias');
2572 unless ($arg->{jmedias}) {
2573 return $self->error("Can't get media selection");
2577 SELECT Media.VolumeName AS volumename,
2578 Storage.Name AS storage,
2579 Location.Location AS location,
2581 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2582 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2583 WHERE Media.VolumeName IN ($arg->{jmedias})
2584 AND Media.InChanger = 1
2587 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2589 foreach my $vol (values %$all) {
2590 my $a = $self->ach_get($vol->{location});
2593 unless ($a->{have_status}) {
2595 $a->{have_status} = 1;
2598 print "eject $vol->{volumename} from $vol->{storage} : ";
2599 if ($a->send_to_io($vol->{slot})) {
2611 my ($to, $subject, $content) = (CGI::param('email'),
2612 CGI::param('subject'),
2613 CGI::param('content'));
2614 $to =~ s/[^\w\d\.\@<>,]//;
2615 $subject =~ s/[^\w\d\.\[\]]/ /;
2617 open(MAIL, "|mail -s '$subject' '$to'") ;
2618 print MAIL $content;
2628 my $arg = $self->get_form('jobid', 'client');
2630 print CGI::header('text/brestore');
2631 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2632 print "client=$arg->{client}\n" if ($arg->{client});
2633 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2637 # TODO : move this to Bweb::Autochanger ?
2638 # TODO : make this internal to not eject tape ?
2644 my ($self, $name) = @_;
2647 return $self->error("Can't get your autochanger name ach");
2650 unless ($self->{info}->{ach_list}) {
2651 return $self->error("Could not find any autochanger");
2654 my $a = $self->{info}->{ach_list}->{$name};
2657 $self->error("Can't get your autochanger $name from your ach_list");
2668 my ($self, $ach) = @_;
2670 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2672 $self->{info}->save();
2680 my $arg = $self->get_form('ach');
2682 or !$self->{info}->{ach_list}
2683 or !$self->{info}->{ach_list}->{$arg->{ach}})
2685 return $self->error("Can't get autochanger name");
2688 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2692 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2694 my $b = $self->get_bconsole();
2696 my @storages = $b->list_storage() ;
2698 $ach->{devices} = [ map { { name => $_ } } @storages ];
2700 $self->display($ach, "ach_add.tpl");
2701 delete $ach->{drives};
2702 delete $ach->{devices};
2709 my $arg = $self->get_form('ach');
2712 or !$self->{info}->{ach_list}
2713 or !$self->{info}->{ach_list}->{$arg->{ach}})
2715 return $self->error("Can't get autochanger name");
2718 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2720 $self->{info}->save();
2721 $self->{info}->view();
2727 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2729 my $b = $self->get_bconsole();
2730 my @storages = $b->list_storage() ;
2732 unless ($arg->{ach}) {
2733 $arg->{devices} = [ map { { name => $_ } } @storages ];
2734 return $self->display($arg, "ach_add.tpl");
2738 foreach my $drive (CGI::param('drives'))
2740 unless (grep(/^$drive$/,@storages)) {
2741 return $self->error("Can't find $drive in storage list");
2744 my $index = CGI::param("index_$drive");
2745 unless (defined $index and $index =~ /^(\d+)$/) {
2746 return $self->error("Can't get $drive index");
2749 $drives[$index] = $drive;
2753 return $self->error("Can't get drives from Autochanger");
2756 my $a = new Bweb::Autochanger(name => $arg->{ach},
2757 precmd => $arg->{precmd},
2758 drive_name => \@drives,
2759 device => $arg->{device},
2760 mtxcmd => $arg->{mtxcmd});
2762 $self->ach_register($a) ;
2764 $self->{info}->view();
2770 my $arg = $self->get_form('jobid');
2772 if ($arg->{jobid}) {
2773 my $b = $self->get_bconsole();
2774 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2778 title => "Delete a job ",
2779 name => "delete jobid=$arg->{jobid}",
2788 my $arg = $self->get_form(qw/media volstatus inchanger pool
2789 slot volretention voluseduration
2790 maxvoljobs maxvolfiles maxvolbytes
2791 qcomment poolrecycle
2794 unless ($arg->{media}) {
2795 return $self->error("Can't find media selection");
2798 my $update = "update volume=$arg->{media} ";
2800 if ($arg->{volstatus}) {
2801 $update .= " volstatus=$arg->{volstatus} ";
2804 if ($arg->{inchanger}) {
2805 $update .= " inchanger=yes " ;
2807 $update .= " slot=$arg->{slot} ";
2810 $update .= " slot=0 inchanger=no ";
2814 $update .= " pool=$arg->{pool} " ;
2817 $arg->{volretention} ||= 0 ;
2818 if ($arg->{volretention}) {
2819 $update .= " volretention=\"$arg->{volretention}\" " ;
2822 $arg->{voluseduration} ||= 0 ;
2823 if ($arg->{voluseduration}) {
2824 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2827 $arg->{maxvoljobs} ||= 0;
2828 if ($arg->{maxvoljobs}) {
2829 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2832 $arg->{maxvolfiles} ||= 0;
2833 if ($arg->{maxvolfiles}) {
2834 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2837 $arg->{maxvolbytes} ||= 0;
2838 if ($arg->{maxvolbytes}) {
2839 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2842 my $b = $self->get_bconsole();
2845 content => $b->send_cmd($update),
2846 title => "Update a volume ",
2852 my $media = $self->dbh_quote($arg->{media});
2854 my $loc = CGI::param('location') || '';
2856 $loc = $self->dbh_quote($loc); # is checked by db
2857 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2859 if ($arg->{poolrecycle}) {
2860 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2862 if (!$arg->{qcomment}) {
2863 $arg->{qcomment} = "''";
2865 push @q, "Comment=$arg->{qcomment}";
2870 SET " . join (',', @q) . "
2871 WHERE Media.VolumeName = $media
2873 $self->dbh_do($query);
2875 $self->update_media();
2882 my $ach = CGI::param('ach') ;
2883 $ach = $self->ach_get($ach);
2885 return $self->error("Bad autochanger name");
2889 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2890 $b->update_slots($ach->{name});
2898 my $arg = $self->get_form('jobid');
2899 unless ($arg->{jobid}) {
2900 return $self->error("Can't get jobid");
2903 my $t = CGI::param('time') || '';
2906 SELECT Job.Name as name, Client.Name as clientname
2907 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2908 WHERE JobId = $arg->{jobid}
2911 my $row = $self->dbh_selectrow_hashref($query);
2914 return $self->error("Can't find $arg->{jobid} in catalog");
2918 SELECT Time AS time, LogText AS log
2919 FROM Log INNER JOIN Job ON (Job.JobId = Log.JobId)
2920 WHERE Log.JobId = $arg->{jobid}
2922 AND Log.Time >= Job.StartTime
2923 AND Log.Time <= COALESCE(Job.EndTime, Now())
2928 my $log = $self->dbh_selectall_arrayref($query);
2930 return $self->error("Can't get log for jobid $arg->{jobid}");
2936 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2938 $logtxt = join("", map { $_->[1] } @$log ) ;
2941 $self->display({ lines=> $logtxt,
2942 jobid => $arg->{jobid},
2943 name => $row->{name},
2944 client => $row->{clientname},
2945 }, 'display_log.tpl');
2953 my $arg = $self->get_form('ach', 'slots', 'drive');
2955 unless ($arg->{ach}) {
2956 return $self->error("Can't find autochanger name");
2961 if ($arg->{slots}) {
2962 $slots = join(",", @{ $arg->{slots} });
2963 $t += 60*scalar( @{ $arg->{slots} }) ;
2966 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2967 print "<h1>This command can take long time, be patient...</h1>";
2969 $b->label_barcodes(storage => $arg->{ach},
2970 drive => $arg->{drive},
2981 my @volume = CGI::param('media');
2984 return $self->error("Can't get media selection");
2987 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2990 content => $b->purge_volume(@volume),
2991 title => "Purge media",
2992 name => "purge volume=" . join(' volume=', @volume),
3001 my @volume = CGI::param('media');
3003 return $self->error("Can't get media selection");
3006 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3009 content => $b->prune_volume(@volume),
3010 title => "Prune media",
3011 name => "prune volume=" . join(' volume=', @volume),
3021 my $arg = $self->get_form('jobid');
3022 unless ($arg->{jobid}) {
3023 return $self->error("Can't get jobid");
3026 my $b = $self->get_bconsole();
3028 content => $b->cancel($arg->{jobid}),
3029 title => "Cancel job",
3030 name => "cancel jobid=$arg->{jobid}",
3036 # Warning, we display current fileset
3039 my $arg = $self->get_form('fileset');
3041 if ($arg->{fileset}) {
3042 my $b = $self->get_bconsole();
3043 my $ret = $b->get_fileset($arg->{fileset});
3044 $self->display({ fileset => $arg->{fileset},
3046 }, "fileset_view.tpl");
3048 $self->error("Can't get fileset name");
3052 sub director_show_sched
3056 my $arg = $self->get_form('days');
3058 my $b = $self->get_bconsole();
3059 my $ret = $b->director_get_sched( $arg->{days} );
3064 }, "scheduled_job.tpl");
3067 sub enable_disable_job
3069 my ($self, $what) = @_ ;
3071 my $name = CGI::param('job') || '';
3072 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3073 return $self->error("Can't find job name");
3076 my $b = $self->get_bconsole();
3086 content => $b->send_cmd("$cmd job=\"$name\""),
3087 title => "$cmd $name",
3088 name => "$cmd job=\"$name\"",
3095 return new Bconsole(pref => $self->{info});
3101 my $b = $self->get_bconsole();
3103 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3105 $self->display({ Jobs => $joblist }, "run_job.tpl");
3110 my ($self, $ouput) = @_;
3113 foreach my $l (split(/\r\n/, $ouput)) {
3114 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3120 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3126 foreach my $k (keys %arg) {
3127 $lowcase{lc($k)} = $arg{$k} ;
3136 my $b = $self->get_bconsole();
3138 my $job = CGI::param('job') || '';
3140 my $info = $b->send_cmd("show job=\"$job\"");
3141 my $attr = $self->run_parse_job($info);
3143 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3145 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3146 my $clients = [ map { { name => $_ } }$b->list_client()];
3147 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3148 my $storages= [ map { { name => $_ } }$b->list_storage()];
3153 clients => $clients,
3154 filesets => $filesets,
3155 storages => $storages,
3157 }, "run_job_mod.tpl");
3163 my $b = $self->get_bconsole();
3165 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3175 my $b = $self->get_bconsole();
3177 # TODO: check input (don't use pool, level)
3179 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3180 my $job = CGI::param('job') || '';
3181 my $storage = CGI::param('storage') || '';
3183 my $jobid = $b->run(job => $job,
3184 client => $arg->{client},
3185 priority => $arg->{priority},
3186 level => $arg->{level},
3187 storage => $storage,
3188 pool => $arg->{pool},
3191 print $jobid, $b->{error};
3193 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";