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 unless (open(FP, ">$self->{config_file}"))
292 return $self->error("$self->{config_file} : $!\n" .
293 "You must add this to your config file\n"
294 . Data::Dumper::Dumper($self));
297 print FP Data::Dumper::Dumper($self);
305 edit, view, modify - html form ouput
313 $self->display($self, "config_edit.tpl");
319 $self->{achs} = [ map { { name => $_ } } keys %{$self->{ach_list}} ];
320 $self->display($self, "config_view.tpl");
321 delete $self->{achs};
331 foreach my $k (CGI::param())
333 next unless (exists $k_re{$k}) ;
334 my $val = CGI::param($k);
335 if ($val =~ $k_re{$k}) {
338 $self->{error} .= "bad parameter : $k = [$val]";
344 if ($self->{error}) { # an error as occured
345 $self->display($self, 'error.tpl');
353 ################################################################
355 package Bweb::Client;
357 use base q/Bweb::Gui/;
361 Bweb::Client - Bacula FD
365 this package is use to do all Client operations like, parse status etc...
369 $client = new Bweb::Client(name => 'zog-fd');
370 $client->status(); # do a 'status client=zog-fd'
376 display_running_job - Html display of a running job
380 this function is used to display information about a current job
384 sub display_running_job
386 my ($self, $conf, $jobid) = @_ ;
388 my $status = $self->status($conf);
391 if ($status->{$jobid}) {
392 $self->display($status->{$jobid}, "client_job_status.tpl");
395 for my $id (keys %$status) {
396 $self->display($status->{$id}, "client_job_status.tpl");
403 $client = new Bweb::Client(name => 'plume-fd');
405 $client->status($bweb);
409 dirty hack to parse "status client=xxx-fd"
413 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
414 Backup Job started: 06-jun-06 17:22
415 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
416 Files Examined=10,697
417 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
423 JobName => Full_plume.2006-06-06_17.22.23,
426 Bytes => 194,484,132,
436 my ($self, $conf) = @_ ;
438 if (defined $self->{cur_jobs}) {
439 return $self->{cur_jobs} ;
443 my $b = new Bconsole(pref => $conf);
444 my $ret = $b->send_cmd("st client=$self->{name}");
448 for my $r (split(/\n/, $ret)) {
450 $r =~ s/(^\s+|\s+$)//g;
451 if ($r =~ /JobId (\d+) Job (\S+)/) {
453 $arg->{$jobid} = { @param, JobId => $jobid } ;
457 @param = ( JobName => $2 );
459 } elsif ($r =~ /=.+=/) {
460 push @param, split(/\s+|\s*=\s*/, $r) ;
462 } elsif ($r =~ /=/) { # one per line
463 push @param, split(/\s*=\s*/, $r) ;
465 } elsif ($r =~ /:/) { # one per line
466 push @param, split(/\s*:\s*/, $r, 2) ;
470 if ($jobid and @param) {
471 $arg->{$jobid} = { @param,
473 Client => $self->{name},
477 $self->{cur_jobs} = $arg ;
483 ################################################################
485 package Bweb::Autochanger;
487 use base q/Bweb::Gui/;
491 Bweb::Autochanger - Object to manage Autochanger
495 this package will parse the mtx output and manage drives.
499 $auto = new Bweb::Autochanger(precmd => 'sudo');
501 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
505 $auto->slot_is_full(10);
506 $auto->transfer(10, 11);
512 my ($class, %arg) = @_;
515 name => '', # autochanger name
516 label => {}, # where are volume { label1 => 40, label2 => drive0 }
517 drive => [], # drive use [ 'media1', 'empty', ..]
518 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
519 io => [], # io slot number list [ 41, 42, 43...]
520 info => {slot => 0, # informations (slot, drive, io)
524 mtxcmd => '/usr/sbin/mtx',
526 device => '/dev/changer',
527 precmd => '', # ssh command
528 bweb => undef, # link to bacula web object (use for display)
531 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
538 status - parse the output of mtx status
542 this function will launch mtx status and parse the output. it will
543 give a perlish view of the autochanger content.
545 it uses ssh if the autochanger is on a other host.
552 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
554 # TODO : reset all infos
555 $self->{info}->{drive} = 0;
556 $self->{info}->{slot} = 0;
557 $self->{info}->{io} = 0;
559 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
562 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
563 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
564 #Data Transfer Element 1:Empty
565 # Storage Element 1:Empty
566 # Storage Element 2:Full :VolumeTag=000002
567 # Storage Element 3:Empty
568 # Storage Element 4:Full :VolumeTag=000004
569 # Storage Element 5:Full :VolumeTag=000001
570 # Storage Element 6:Full :VolumeTag=000003
571 # Storage Element 7:Empty
572 # Storage Element 41 IMPORT/EXPORT:Empty
573 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
578 # Storage Element 7:Empty
579 # Storage Element 2:Full :VolumeTag=000002
580 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
583 $self->set_empty_slot($1);
585 $self->set_slot($1, $4);
588 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
591 $self->set_empty_drive($1);
593 $self->set_drive($1, $4, $6);
596 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
599 $self->set_empty_io($1);
601 $self->set_io($1, $4);
604 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
606 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
607 $self->{info}->{drive} = $1;
608 $self->{info}->{slot} = $2;
609 if ($l =~ /(\d+)\s+Import/) {
610 $self->{info}->{io} = $1 ;
612 $self->{info}->{io} = 0;
617 $self->debug($self) ;
622 my ($self, $slot) = @_;
625 if ($self->{slot}->[$slot] eq 'loaded') {
629 my $label = $self->{slot}->[$slot] ;
631 return $self->is_media_loaded($label);
636 my ($self, $drive, $slot) = @_;
638 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
639 return 0 if ($self->slot_is_full($slot)) ;
641 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
644 my $content = $self->get_slot($slot);
645 print "content = $content<br/> $drive => $slot<br/>";
646 $self->set_empty_drive($drive);
647 $self->set_slot($slot, $content);
650 $self->{error} = $out;
655 # TODO: load/unload have to use mtx script from bacula
658 my ($self, $drive, $slot) = @_;
660 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
661 return 0 unless ($self->slot_is_full($slot)) ;
663 print "Loading drive $drive with slot $slot<br/>\n";
664 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
667 my $content = $self->get_slot($slot);
668 print "content = $content<br/> $slot => $drive<br/>";
669 $self->set_drive($drive, $slot, $content);
672 $self->{error} = $out;
680 my ($self, $media) = @_;
682 unless ($self->{label}->{$media}) {
686 if ($self->{label}->{$media} =~ /drive\d+/) {
696 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
701 my ($self, $slot, $tag) = @_;
702 $self->{slot}->[$slot] = $tag || 'full';
703 push @{ $self->{io} }, $slot;
706 $self->{label}->{$tag} = $slot;
712 my ($self, $slot) = @_;
714 push @{ $self->{io} }, $slot;
716 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
717 $self->{slot}->[$slot] = 'empty';
723 my ($self, $slot) = @_;
724 return $self->{slot}->[$slot];
729 my ($self, $slot, $tag) = @_;
730 $self->{slot}->[$slot] = $tag || 'full';
733 $self->{label}->{$tag} = $slot;
739 my ($self, $slot) = @_;
741 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
742 $self->{slot}->[$slot] = 'empty';
748 my ($self, $drive) = @_;
749 $self->{drive}->[$drive] = 'empty';
754 my ($self, $drive, $slot, $tag) = @_;
755 $self->{drive}->[$drive] = $tag || $slot;
757 $self->{slot}->[$slot] = $tag || 'loaded';
760 $self->{label}->{$tag} = "drive$drive";
766 my ($self, $slot) = @_;
768 # slot don't exists => full
769 if (not defined $self->{slot}->[$slot]) {
773 if ($self->{slot}->[$slot] eq 'empty') {
776 return 1; # vol, full, loaded
779 sub slot_get_first_free
782 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
783 return $slot unless ($self->slot_is_full($slot));
787 sub io_get_first_free
791 foreach my $slot (@{ $self->{io} }) {
792 return $slot unless ($self->slot_is_full($slot));
799 my ($self, $media) = @_;
801 return $self->{label}->{$media} ;
806 my ($self, $media) = @_;
808 return defined $self->{label}->{$media} ;
813 my ($self, $slot) = @_;
815 unless ($self->slot_is_full($slot)) {
816 print "Autochanger $self->{name} slot $slot is empty\n";
821 if ($self->is_slot_loaded($slot)) {
824 print "Autochanger $self->{name} $slot is currently in use\n";
828 # autochanger must have I/O
829 unless ($self->have_io()) {
830 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
834 my $dst = $self->io_get_first_free();
837 print "Autochanger $self->{name} you must empty I/O first\n";
840 $self->transfer($slot, $dst);
845 my ($self, $src, $dst) = @_ ;
846 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
847 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
850 my $content = $self->get_slot($src);
851 print "content = $content<br/> $src => $dst<br/>";
852 $self->{slot}->[$src] = 'empty';
853 $self->set_slot($dst, $content);
856 $self->{error} = $out;
863 my ($self, $index) = @_;
864 return $self->{drive_name}->[$index];
867 # TODO : do a tapeinfo request to get informations
877 for my $slot (@{$self->{io}})
879 if ($self->is_slot_loaded($slot)) {
880 print "$slot is currently loaded\n";
884 if ($self->slot_is_full($slot))
886 my $free = $self->slot_get_first_free() ;
887 print "want to move $slot to $free\n";
890 $self->transfer($slot, $free) || print "$self->{error}\n";
893 $self->{error} = "E : Can't find free slot";
899 # TODO : this is with mtx status output,
900 # we can do an other function from bacula view (with StorageId)
904 my $bweb = $self->{bweb};
906 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
907 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
910 SELECT Media.VolumeName AS volumename,
911 Media.VolStatus AS volstatus,
912 Media.LastWritten AS lastwritten,
913 Media.VolBytes AS volbytes,
914 Media.MediaType AS mediatype,
916 Media.InChanger AS inchanger,
918 $bweb->{sql}->{FROM_UNIXTIME}(
919 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
920 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
923 INNER JOIN Pool USING (PoolId)
925 WHERE Media.VolumeName IN ($media_list)
928 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
930 # TODO : verify slot and bacula slot
934 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
936 if ($self->slot_is_full($slot)) {
938 my $vol = $self->{slot}->[$slot];
939 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
941 my $bslot = $all->{$vol}->{slot} ;
942 my $inchanger = $all->{$vol}->{inchanger};
944 # if bacula slot or inchanger flag is bad, we display a message
945 if ($bslot != $slot or !$inchanger) {
946 push @to_update, $slot;
949 $all->{$vol}->{realslot} = $slot;
950 $all->{$vol}->{volbytes} = Bweb::human_size($all->{$vol}->{volbytes}) ;
952 push @{ $param }, $all->{$vol};
954 } else { # empty or no label
955 push @{ $param }, {realslot => $slot,
956 volstatus => 'Unknow',
957 volumename => $self->{slot}->[$slot]} ;
960 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
964 my $i=0; my $drives = [] ;
965 foreach my $d (@{ $self->{drive} }) {
966 $drives->[$i] = { index => $i,
967 load => $self->{drive}->[$i],
968 name => $self->{drive_name}->[$i],
973 $bweb->display({ Name => $self->{name},
974 nb_drive => $self->{info}->{drive},
975 nb_io => $self->{info}->{io},
978 Update => scalar(@to_update) },
986 ################################################################
990 use base q/Bweb::Gui/;
994 Bweb - main Bweb package
998 this package is use to compute and display informations
1003 use POSIX qw/strftime/;
1005 our $bpath="/usr/local/bacula";
1006 our $bconsole="$bpath/sbin/bconsole -c $bpath/etc/bconsole.conf";
1012 %sql_func - hash to make query mysql/postgresql compliant
1018 UNIX_TIMESTAMP => '',
1019 FROM_UNIXTIME => '',
1020 TO_SEC => " interval '1 second' * ",
1021 SEC_TO_INT => "SEC_TO_INT",
1025 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1026 FROM_UNIXTIME => 'FROM_UNIXTIME',
1029 SEC_TO_TIME => 'SEC_TO_TIME',
1033 sub dbh_selectall_arrayref
1035 my ($self, $query) = @_;
1036 $self->connect_db();
1037 $self->debug($query);
1038 return $self->{dbh}->selectall_arrayref($query);
1043 my ($self, @what) = @_;
1044 return join(',', $self->dbh_quote(@what)) ;
1049 my ($self, @what) = @_;
1051 $self->connect_db();
1053 return map { $self->{dbh}->quote($_) } @what;
1055 return $self->{dbh}->quote($what[0]) ;
1061 my ($self, $query) = @_ ;
1062 $self->connect_db();
1063 $self->debug($query);
1064 return $self->{dbh}->do($query);
1067 sub dbh_selectall_hashref
1069 my ($self, $query, $join) = @_;
1071 $self->connect_db();
1072 $self->debug($query);
1073 return $self->{dbh}->selectall_hashref($query, $join) ;
1076 sub dbh_selectrow_hashref
1078 my ($self, $query) = @_;
1080 $self->connect_db();
1081 $self->debug($query);
1082 return $self->{dbh}->selectrow_hashref($query) ;
1088 my @unit = qw(b Kb Mb Gb Tb);
1089 my $val = shift || 0;
1091 my $format = '%i %s';
1092 while ($val / 1024 > 1) {
1096 $format = ($i>0)?'%0.1f %s':'%i %s';
1097 return sprintf($format, $val, $unit[$i]);
1100 # display Day, Hour, Year
1106 $val /= 60; # sec -> min
1108 if ($val / 60 <= 1) {
1112 $val /= 60; # min -> hour
1113 if ($val / 24 <= 1) {
1114 return "$val hours";
1117 $val /= 24; # hour -> day
1118 if ($val / 365 < 2) {
1122 $val /= 365 ; # day -> year
1124 return "$val years";
1127 # get Day, Hour, Year
1133 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1137 my %times = ( m => 60,
1143 my $mult = $times{$2} || 0;
1153 unless ($self->{dbh}) {
1154 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1155 $self->{info}->{user},
1156 $self->{info}->{password});
1158 print "Can't connect to your database, see error log\n"
1159 unless ($self->{dbh});
1161 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1167 my ($class, %arg) = @_;
1169 dbh => undef, # connect_db();
1171 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1177 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1179 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1180 $self->{sql} = $sql_func{$1};
1183 $self->{debug} = $self->{info}->{debug};
1184 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1192 $self->display($self->{info}, "begin.tpl");
1198 $self->display($self->{info}, "end.tpl");
1206 SELECT Name AS name,
1208 AutoPrune AS autoprune,
1209 FileRetention AS fileretention,
1210 JobRetention AS jobretention
1215 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1217 foreach (values %$all) {
1218 $_->{fileretention} = human_sec($_->{fileretention});
1219 $_->{jobretention} = human_sec($_->{jobretention});
1222 my $arg = { ID => $cur_id++,
1223 clients => [ values %$all] };
1225 $self->display($arg, "client_list.tpl") ;
1230 my ($self, %arg) = @_;
1237 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1239 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1241 $self->{sql}->{TO_SEC}($arg{age})
1244 $label = "last " . human_sec($arg{age});
1248 $limit .= " ORDER BY $arg{order} ";
1252 $limit .= " LIMIT $arg{limit} ";
1253 $label .= " limited to $arg{limit}";
1257 $limit .= " OFFSET $arg{offset} ";
1258 $label .= " with $arg{offset} offset ";
1262 $label = 'no filter';
1265 return ($limit, $label);
1270 $bweb->get_form(...) - Get useful stuff
1274 This function get and check parameters against regexp.
1276 If word begin with 'q', the return will be quoted or join quoted
1277 if it's end with 's'.
1282 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1285 qclient => 'plume-fd',
1286 qpools => "'plume-fd', 'test-fd', '...'",
1293 my ($self, @what) = @_;
1294 my %what = map { $_ => 1 } @what;
1311 my %opt_s = ( # default to ''
1321 my %opt_p = ( # option with path
1327 foreach my $i (@what) {
1328 if (exists $opt_i{$i}) {# integer param
1329 my $value = CGI::param($i) || $opt_i{$i} ;
1330 if ($value =~ /^(\d+)$/) {
1333 } elsif ($opt_s{$i}) { # simple string param
1334 my $value = CGI::param($i) || '';
1335 if ($value =~ /^([\w\d\.-]+)$/) {
1338 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1339 my @value = CGI::param($1) ;
1341 $ret{$i} = $self->dbh_join(@value) ;
1344 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1345 my $value = CGI::param($1) ;
1347 $ret{$i} = $self->dbh_quote($value);
1350 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1351 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1353 } elsif (exists $opt_p{$i}) {
1354 my $value = CGI::param($i) || '';
1355 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1362 foreach my $s (CGI::param('slot')) {
1363 if ($s =~ /^(\d+)$/) {
1364 push @{$ret{slots}}, $s;
1369 if ($what{db_clients}) {
1371 SELECT Client.Name as clientname
1375 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1376 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1380 if ($what{db_mediatypes}) {
1382 SELECT MediaType as mediatype
1386 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1387 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1391 if ($what{db_locations}) {
1393 SELECT Location as location, Cost as cost FROM Location
1395 my $loc = $self->dbh_selectall_hashref($query, 'location');
1396 $ret{db_locations} = [ sort { $a->{location}
1402 if ($what{db_pools}) {
1403 my $query = "SELECT Name as name FROM Pool";
1405 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1406 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1409 if ($what{db_filesets}) {
1411 SELECT FileSet.FileSet AS fileset
1415 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1417 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1418 values %$filesets] ;
1422 if ($what{db_jobnames}) {
1424 SELECT DISTINCT Job.Name AS jobname
1428 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1430 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1431 values %$jobnames] ;
1435 if ($what{db_devices}) {
1437 SELECT Device.Name AS name
1441 my $devices = $self->dbh_selectall_hashref($query, 'name');
1443 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1455 my $fields = $self->get_form(qw/age level status clients filesets
1456 db_clients limit db_filesets width height
1457 qclients qfilesets qjobnames db_jobnames/);
1460 my $url = CGI::url(-full => 0,
1463 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1465 my $type = CGI::param('graph') || '';
1466 if ($type =~ /^(\w+)$/) {
1467 $fields->{graph} = $1;
1470 my $gtype = CGI::param('gtype') || '';
1471 if ($gtype =~ /^(\w+)$/) {
1472 $fields->{gtype} = $1;
1475 # this organisation is to keep user choice between 2 click
1476 # TODO : fileset and client selection doesn't work
1485 sub display_client_job
1487 my ($self, %arg) = @_ ;
1489 $arg{order} = ' Job.JobId DESC ';
1490 my ($limit, $label) = $self->get_limit(%arg);
1492 my $clientname = $self->dbh_quote($arg{clientname});
1495 SELECT DISTINCT Job.JobId AS jobid,
1496 Job.Name AS jobname,
1497 FileSet.FileSet AS fileset,
1499 StartTime AS starttime,
1500 JobFiles AS jobfiles,
1501 JobBytes AS jobbytes,
1502 JobStatus AS jobstatus,
1503 JobErrors AS joberrors
1505 FROM Client,Job,FileSet
1506 WHERE Client.Name=$clientname
1507 AND Client.ClientId=Job.ClientId
1508 AND Job.FileSetId=FileSet.FileSetId
1512 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1514 foreach (values %$all) {
1515 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1518 $self->display({ clientname => $arg{clientname},
1521 Jobs => [ values %$all ],
1523 "display_client_job.tpl") ;
1526 sub get_selected_media_location
1530 my $medias = $self->get_form('jmedias');
1532 unless ($medias->{jmedias}) {
1537 SELECT Media.VolumeName AS volumename, Location.Location AS location
1538 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1539 WHERE Media.VolumeName IN ($medias->{jmedias})
1542 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1544 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1555 my $medias = $self->get_selected_media_location();
1561 my $elt = $self->get_form('db_locations');
1563 $self->display({ ID => $cur_id++,
1564 %$elt, # db_locations
1566 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1576 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1578 $self->display($elt, "help_extern.tpl");
1581 sub help_extern_compute
1585 my $number = CGI::param('limit') || '' ;
1586 unless ($number =~ /^(\d+)$/) {
1587 return $self->error("Bad arg number : $number ");
1590 my ($sql, undef) = $self->get_param('pools',
1591 'locations', 'mediatypes');
1594 SELECT Media.VolumeName AS volumename,
1595 Media.VolStatus AS volstatus,
1596 Media.LastWritten AS lastwritten,
1597 Media.MediaType AS mediatype,
1598 Media.VolMounts AS volmounts,
1600 Media.Recycle AS recycle,
1601 $self->{sql}->{FROM_UNIXTIME}(
1602 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1603 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1606 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1607 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1609 WHERE Media.InChanger = 1
1610 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1612 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1616 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1618 $self->display({ Medias => [ values %$all ] },
1619 "help_extern_compute.tpl");
1626 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1627 $self->display($param, "help_intern.tpl");
1630 sub help_intern_compute
1634 my $number = CGI::param('limit') || '' ;
1635 unless ($number =~ /^(\d+)$/) {
1636 return $self->error("Bad arg number : $number ");
1639 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1641 if (CGI::param('expired')) {
1643 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1644 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1650 SELECT Media.VolumeName AS volumename,
1651 Media.VolStatus AS volstatus,
1652 Media.LastWritten AS lastwritten,
1653 Media.MediaType AS mediatype,
1654 Media.VolMounts AS volmounts,
1656 $self->{sql}->{FROM_UNIXTIME}(
1657 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1658 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1661 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1662 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1664 WHERE Media.InChanger <> 1
1665 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1666 AND Media.Recycle = 1
1668 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1672 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1674 $self->display({ Medias => [ values %$all ] },
1675 "help_intern_compute.tpl");
1681 my ($self, %arg) = @_ ;
1683 my ($limit, $label) = $self->get_limit(%arg);
1687 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1688 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1689 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1690 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1691 (SELECT count(Job.JobId)
1693 WHERE Job.JobStatus IN ('E','e','f','A')
1696 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1699 my $row = $self->dbh_selectrow_hashref($query) ;
1701 $row->{nb_bytes} = human_size($row->{nb_bytes});
1703 $row->{db_size} = '???';
1704 $row->{label} = $label;
1706 $self->display($row, "general.tpl");
1711 my ($self, @what) = @_ ;
1712 my %elt = map { $_ => 1 } @what;
1717 if ($elt{clients}) {
1718 my @clients = CGI::param('client');
1720 $ret{clients} = \@clients;
1721 my $str = $self->dbh_join(@clients);
1722 $limit .= "AND Client.Name IN ($str) ";
1726 if ($elt{filesets}) {
1727 my @filesets = CGI::param('fileset');
1729 $ret{filesets} = \@filesets;
1730 my $str = $self->dbh_join(@filesets);
1731 $limit .= "AND FileSet.FileSet IN ($str) ";
1735 if ($elt{mediatypes}) {
1736 my @medias = CGI::param('mediatype');
1738 $ret{mediatypes} = \@medias;
1739 my $str = $self->dbh_join(@medias);
1740 $limit .= "AND Media.MediaType IN ($str) ";
1745 my $client = CGI::param('client');
1746 $ret{client} = $client;
1747 $client = $self->dbh_join($client);
1748 $limit .= "AND Client.Name = $client ";
1752 my $level = CGI::param('level') || '';
1753 if ($level =~ /^(\w)$/) {
1755 $limit .= "AND Job.Level = '$1' ";
1760 my $jobid = CGI::param('jobid') || '';
1762 if ($jobid =~ /^(\d+)$/) {
1764 $limit .= "AND Job.JobId = '$1' ";
1769 my $status = CGI::param('status') || '';
1770 if ($status =~ /^(\w)$/) {
1772 $limit .= "AND Job.JobStatus = '$1' ";
1776 if ($elt{locations}) {
1777 my @location = CGI::param('location') ;
1779 $ret{locations} = \@location;
1780 my $str = $self->dbh_join(@location);
1781 $limit .= "AND Location.Location IN ($str) ";
1786 my @pool = CGI::param('pool') ;
1788 $ret{pools} = \@pool;
1789 my $str = $self->dbh_join(@pool);
1790 $limit .= "AND Pool.Name IN ($str) ";
1794 if ($elt{location}) {
1795 my $location = CGI::param('location') || '';
1797 $ret{location} = $location;
1798 $location = $self->dbh_quote($location);
1799 $limit .= "AND Location.Location = $location ";
1804 my $pool = CGI::param('pool') || '';
1807 $pool = $self->dbh_quote($pool);
1808 $limit .= "AND Pool.Name = $pool ";
1812 if ($elt{jobtype}) {
1813 my $jobtype = CGI::param('jobtype') || '';
1814 if ($jobtype =~ /^(\w)$/) {
1816 $limit .= "AND Job.Type = '$1' ";
1820 return ($limit, %ret);
1827 SELECT DISTINCT Job.JobId AS jobid,
1828 Client.Name AS client,
1829 FileSet.FileSet AS fileset,
1830 Job.Name AS jobname,
1832 StartTime AS starttime,
1833 JobFiles AS jobfiles,
1834 JobBytes AS jobbytes,
1835 VolumeName AS volumename,
1836 JobStatus AS jobstatus,
1837 JobErrors AS joberrors
1839 FROM Client,Job,JobMedia,Media,FileSet
1840 WHERE Client.ClientId=Job.ClientId
1841 AND Job.FileSetId=FileSet.FileSetId
1842 AND JobMedia.JobId=Job.JobId
1843 AND JobMedia.MediaId=Media.MediaId
1850 my ($self, %arg) = @_ ;
1852 $arg{order} = ' Job.JobId DESC ';
1854 my ($limit, $label) = $self->get_limit(%arg);
1855 my ($where, undef) = $self->get_param('clients',
1863 SELECT Job.JobId AS jobid,
1864 Client.Name AS client,
1865 FileSet.FileSet AS fileset,
1866 Job.Name AS jobname,
1868 StartTime AS starttime,
1869 Pool.Name AS poolname,
1870 JobFiles AS jobfiles,
1871 JobBytes AS jobbytes,
1872 JobStatus AS jobstatus,
1873 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1874 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1877 JobErrors AS joberrors
1880 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1881 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1882 WHERE Client.ClientId=Job.ClientId
1887 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1889 foreach (values %$all) {
1890 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1893 $self->display({ Filter => $label,
1897 sort { $a->{jobid} <=> $b->{jobid} }
1904 # display job informations
1905 sub display_job_zoom
1907 my ($self, $jobid) = @_ ;
1909 $jobid = $self->dbh_quote($jobid);
1912 SELECT DISTINCT Job.JobId AS jobid,
1913 Client.Name AS client,
1914 Job.Name AS jobname,
1915 FileSet.FileSet AS fileset,
1917 Pool.Name AS poolname,
1918 StartTime AS starttime,
1919 JobFiles AS jobfiles,
1920 JobBytes AS jobbytes,
1921 JobStatus AS jobstatus,
1922 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1923 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1926 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1927 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1928 WHERE Client.ClientId=Job.ClientId
1929 AND Job.JobId = $jobid
1932 my $row = $self->dbh_selectrow_hashref($query) ;
1934 $row->{jobbytes} = human_size($row->{jobbytes}) ;
1936 # display all volumes associate with this job
1938 SELECT Media.VolumeName as volumename
1939 FROM Job,Media,JobMedia
1940 WHERE Job.JobId = $jobid
1941 AND JobMedia.JobId=Job.JobId
1942 AND JobMedia.MediaId=Media.MediaId
1945 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1947 $row->{volumes} = [ values %$all ] ;
1949 $self->display($row, "display_job_zoom.tpl");
1956 my ($where, %elt) = $self->get_param('pool',
1959 my $arg = $self->get_form('jmedias');
1961 if ($arg->{jmedias}) {
1962 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1966 SELECT Media.VolumeName AS volumename,
1967 Media.VolBytes AS volbytes,
1968 Media.VolStatus AS volstatus,
1969 Media.MediaType AS mediatype,
1970 Media.InChanger AS online,
1971 Media.LastWritten AS lastwritten,
1972 Location.Location AS location,
1973 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1974 Pool.Name AS poolname,
1975 $self->{sql}->{FROM_UNIXTIME}(
1976 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1977 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1980 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1981 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1982 Media.MediaType AS MediaType
1984 WHERE Media.VolStatus = 'Full'
1985 GROUP BY Media.MediaType
1986 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
1988 WHERE Media.PoolId=Pool.PoolId
1992 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1993 foreach (values %$all) {
1994 $_->{volbytes} = human_size($_->{volbytes}) ;
1997 $self->display({ ID => $cur_id++,
1999 Location => $elt{location},
2000 Medias => [ values %$all ]
2002 "display_media.tpl");
2009 my $pool = $self->get_form('db_pools');
2011 foreach my $name (@{ $pool->{db_pools} }) {
2012 CGI::param('pool', $name->{name});
2013 $self->display_media();
2017 sub display_media_zoom
2021 my $medias = $self->get_form('jmedias');
2023 unless ($medias->{jmedias}) {
2024 return $self->error("Can't get media selection");
2028 SELECT InChanger AS online,
2029 VolBytes AS nb_bytes,
2030 VolumeName AS volumename,
2031 VolStatus AS volstatus,
2032 VolMounts AS nb_mounts,
2033 Media.VolUseDuration AS voluseduration,
2034 Media.MaxVolJobs AS maxvoljobs,
2035 Media.MaxVolFiles AS maxvolfiles,
2036 Media.MaxVolBytes AS maxvolbytes,
2037 VolErrors AS nb_errors,
2038 Pool.Name AS poolname,
2039 Location.Location AS location,
2040 Media.Recycle AS recycle,
2041 Media.VolRetention AS volretention,
2042 Media.LastWritten AS lastwritten,
2043 Media.VolReadTime/1000000 AS volreadtime,
2044 Media.VolWriteTime/1000000 AS volwritetime,
2045 $self->{sql}->{FROM_UNIXTIME}(
2046 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2047 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2050 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2051 WHERE Pool.PoolId = Media.PoolId
2052 AND VolumeName IN ($medias->{jmedias})
2055 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2057 foreach my $media (values %$all) {
2058 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
2059 $media->{voluseduration} = human_sec($media->{voluseduration});
2060 $media->{volretention} = human_sec($media->{volretention});
2061 $media->{volreadtime} = human_sec($media->{volreadtime});
2062 $media->{volwritetime} = human_sec($media->{volwritetime});
2063 my $mq = $self->dbh_quote($media->{volumename});
2066 SELECT DISTINCT Job.JobId AS jobid,
2068 Job.StartTime AS starttime,
2071 Job.JobFiles AS files,
2072 Job.JobBytes AS bytes,
2073 Job.jobstatus AS status
2074 FROM Media,JobMedia,Job
2075 WHERE Media.VolumeName=$mq
2076 AND Media.MediaId=JobMedia.MediaId
2077 AND JobMedia.JobId=Job.JobId
2080 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2082 foreach (values %$jobs) {
2083 $_->{bytes} = human_size($_->{bytes}) ;
2086 $self->display({ jobs => [ values %$jobs ],
2088 "display_media_zoom.tpl");
2096 my $loc = $self->get_form('qlocation');
2097 unless ($loc->{qlocation}) {
2098 return $self->error("Can't get location");
2102 SELECT Location.Location AS location,
2103 Location.Cost AS cost,
2104 Location.Enabled AS enabled
2106 WHERE Location.Location = $loc->{qlocation}
2109 my $row = $self->dbh_selectrow_hashref($query);
2111 $self->display({ ID => $cur_id++,
2112 %$row }, "location_edit.tpl") ;
2120 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2121 unless ($arg->{qlocation}) {
2122 return $self->error("Can't get location");
2124 unless ($arg->{qnewlocation}) {
2125 return $self->error("Can't get new location name");
2127 unless ($arg->{cost}) {
2128 return $self->error("Can't get new cost");
2131 my $enabled = CGI::param('enabled') || '';
2132 $enabled = $enabled?1:0;
2135 UPDATE Location SET Cost = $arg->{cost},
2136 Location = $arg->{qnewlocation},
2138 WHERE Location.Location = $arg->{qlocation}
2141 $self->dbh_do($query);
2143 $self->display_location();
2149 my $arg = $self->get_form(qw/qlocation cost/) ;
2151 unless ($arg->{qlocation}) {
2152 $self->display({}, "location_add.tpl");
2155 unless ($arg->{cost}) {
2156 return $self->error("Can't get new cost");
2159 my $enabled = CGI::param('enabled') || '';
2160 $enabled = $enabled?1:0;
2163 INSERT INTO Location (Location, Cost, Enabled)
2164 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2167 $self->dbh_do($query);
2169 $self->display_location();
2172 sub display_location
2177 SELECT Location.Location AS location,
2178 Location.Cost AS cost,
2179 Location.Enabled AS enabled,
2180 (SELECT count(Media.MediaId)
2182 WHERE Media.LocationId = Location.LocationId
2187 my $location = $self->dbh_selectall_hashref($query, 'location');
2189 $self->display({ ID => $cur_id++,
2190 Locations => [ values %$location ] },
2191 "display_location.tpl");
2198 my $medias = $self->get_selected_media_location();
2203 my $arg = $self->get_form('db_locations', 'qnewlocation');
2205 $self->display({ email => $self->{info}->{email_media},
2207 medias => [ values %$medias ],
2209 "update_location.tpl");
2212 sub get_media_max_size
2214 my ($self, $type) = @_;
2216 "SELECT avg(VolBytes) AS size
2218 WHERE Media.VolStatus = 'Full'
2219 AND Media.MediaType = '$type'
2222 my $res = $self->selectrow_hashref($query);
2225 return $res->{size};
2235 my $media = CGI::param('media');
2237 return $self->error("Can't find media selection");
2240 $media = $self->dbh_quote($media);
2244 my $volstatus = CGI::param('volstatus') || '';
2245 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2246 $update .= " VolStatus=$volstatus, ";
2248 my $inchanger = CGI::param('inchanger') || '';
2250 $update .= " InChanger=1, " ;
2251 my $slot = CGI::param('slot') || '';
2252 if ($slot =~ /^(\d+)$/) {
2253 $update .= " Slot=$1, ";
2255 $update .= " Slot=0, ";
2258 $update = " Slot=0, InChanger=0, ";
2261 my $pool = CGI::param('pool') || '';
2262 $pool = $self->dbh_quote($pool); # is checked by db
2263 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2265 my $volretention = CGI::param('volretention') || '';
2266 $volretention = from_human_sec($volretention);
2267 unless ($volretention) {
2268 return $self->error("Can't get volume retention");
2271 $update .= " VolRetention = $volretention, ";
2273 my $loc = CGI::param('location') || '';
2274 $loc = $self->dbh_quote($loc); # is checked by db
2275 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2277 my $usedu = CGI::param('voluseduration') || '0';
2278 $usedu = from_human_sec($usedu);
2279 $update .= " VolUseDuration=$usedu, ";
2281 my $maxj = CGI::param('maxvoljobs') || '0';
2282 unless ($maxj =~ /^(\d+)$/) {
2283 return $self->error("Can't get max jobs");
2285 $update .= " MaxVolJobs=$1, " ;
2287 my $maxf = CGI::param('maxvolfiles') || '0';
2288 unless ($maxj =~ /^(\d+)$/) {
2289 return $self->error("Can't get max files");
2291 $update .= " MaxVolFiles=$1, " ;
2293 my $maxb = CGI::param('maxvolbytes') || '0';
2294 unless ($maxb =~ /^(\d+)$/) {
2295 return $self->error("Can't get max bytes");
2297 $update .= " MaxVolBytes=$1 " ;
2299 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2302 print "Update Ok\n";
2303 $self->update_media();
2311 my $media = $self->get_form('qmedia');
2313 unless ($media->{qmedia}) {
2314 return $self->error("Can't get media");
2318 SELECT Media.Slot AS slot,
2319 Pool.Name AS poolname,
2320 Media.VolStatus AS volstatus,
2321 Media.InChanger AS inchanger,
2322 Location.Location AS location,
2323 Media.VolumeName AS volumename,
2324 Media.MaxVolBytes AS maxvolbytes,
2325 Media.MaxVolJobs AS maxvoljobs,
2326 Media.MaxVolFiles AS maxvolfiles,
2327 Media.VolUseDuration AS voluseduration,
2328 Media.VolRetention AS volretention
2330 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2331 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2333 WHERE Media.VolumeName = $media->{qmedia}
2336 my $row = $self->dbh_selectrow_hashref($query);
2337 $row->{volretention} = human_sec($row->{volretention});
2338 $row->{voluseduration} = human_sec($row->{voluseduration});
2340 my $elt = $self->get_form(qw/db_pools db_locations/);
2346 "update_media.tpl");
2353 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2355 unless ($arg->{jmedias}) {
2356 return $self->error("Can't get selected media");
2359 unless ($arg->{qnewlocation}) {
2360 return $self->error("Can't get new location");
2365 SET LocationId = (SELECT LocationId
2367 WHERE Location = $arg->{qnewlocation})
2368 WHERE Media.VolumeName IN ($arg->{jmedias})
2371 my $nb = $self->dbh_do($query);
2373 print "$nb media updated";
2380 my $medias = $self->get_selected_media_location();
2382 return $self->error("Can't get media selection");
2384 my $newloc = CGI::param('newlocation');
2386 my $user = CGI::param('user') || 'unknow';
2387 my $comm = CGI::param('comment') || '';
2388 $comm = $self->dbh_quote("$user: $comm");
2392 foreach my $media (keys %$medias) {
2394 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2396 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2397 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2398 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2401 $self->dbh_do($query);
2402 $self->debug($query);
2406 $q->param('action', 'update_location');
2407 my $url = $q->url(-full => 1, -query=>1);
2409 $self->display({ email => $self->{info}->{email_media},
2411 newlocation => $newloc,
2412 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2413 medias => [ values %$medias ],
2415 "change_location.tpl");
2419 sub display_client_stats
2421 my ($self, %arg) = @_ ;
2423 my $client = $self->dbh_quote($arg{clientname});
2424 my ($limit, $label) = $self->get_limit(%arg);
2428 count(Job.JobId) AS nb_jobs,
2429 sum(Job.JobBytes) AS nb_bytes,
2430 sum(Job.JobErrors) AS nb_err,
2431 sum(Job.JobFiles) AS nb_files,
2432 Client.Name AS clientname
2433 FROM Job INNER JOIN Client USING (ClientId)
2435 Client.Name = $client
2437 GROUP BY Client.Name
2440 my $row = $self->dbh_selectrow_hashref($query);
2442 $row->{ID} = $cur_id++;
2443 $row->{label} = $label;
2444 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2446 $self->display($row, "display_client_stats.tpl");
2449 # poolname can be undef
2452 my ($self, $poolname) = @_ ;
2454 # TODO : afficher les tailles et les dates
2457 SELECT sum(subq.volmax) AS volmax,
2458 sum(subq.volnum) AS volnum,
2459 sum(subq.voltotal) AS voltotal,
2461 Pool.Recycle AS recycle,
2462 Pool.VolRetention AS volretention,
2463 Pool.VolUseDuration AS voluseduration,
2464 Pool.MaxVolJobs AS maxvoljobs,
2465 Pool.MaxVolFiles AS maxvolfiles,
2466 Pool.MaxVolBytes AS maxvolbytes,
2467 subq.PoolId AS PoolId
2470 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2471 count(Media.MediaId) AS volnum,
2472 sum(Media.VolBytes) AS voltotal,
2473 Media.PoolId AS PoolId,
2474 Media.MediaType AS MediaType
2476 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2477 Media.MediaType AS MediaType
2479 WHERE Media.VolStatus = 'Full'
2480 GROUP BY Media.MediaType
2481 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2482 GROUP BY Media.MediaType, Media.PoolId
2484 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2485 GROUP BY subq.PoolId
2488 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2490 foreach my $p (values %$all) {
2491 $p->{maxvolbytes} = human_size($p->{maxvolbytes}) ;
2492 $p->{volretention} = human_sec($p->{volretention}) ;
2493 $p->{voluseduration} = human_sec($p->{voluseduration}) ;
2496 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2498 $p->{poolusage} = 0;
2502 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2504 WHERE PoolId=$p->{poolid}
2507 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2508 foreach my $t (values %$content) {
2509 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2514 $self->display({ ID => $cur_id++,
2515 Pools => [ values %$all ]},
2516 "display_pool.tpl");
2519 sub display_running_job
2523 my $arg = $self->get_form('client', 'jobid');
2525 if (!$arg->{client} and $arg->{jobid}) {
2528 SELECT Client.Name AS name
2529 FROM Job INNER JOIN Client USING (ClientId)
2530 WHERE Job.JobId = $arg->{jobid}
2533 my $row = $self->dbh_selectrow_hashref($query);
2536 $arg->{client} = $row->{name};
2537 CGI::param('client', $arg->{client});
2541 if ($arg->{client}) {
2542 my $cli = new Bweb::Client(name => $arg->{client});
2543 $cli->display_running_job($self->{info}, $arg->{jobid});
2544 if ($arg->{jobid}) {
2545 $self->get_job_log();
2548 $self->error("Can't get client or jobid");
2552 sub display_running_jobs
2554 my ($self, $display_action) = @_;
2557 SELECT Job.JobId AS jobid,
2558 Job.Name AS jobname,
2560 Job.StartTime AS starttime,
2561 Job.JobFiles AS jobfiles,
2562 Job.JobBytes AS jobbytes,
2563 Job.JobStatus AS jobstatus,
2564 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2565 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2567 Client.Name AS clientname
2568 FROM Job INNER JOIN Client USING (ClientId)
2569 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2571 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2573 $self->display({ ID => $cur_id++,
2574 display_action => $display_action,
2575 Jobs => [ values %$all ]},
2576 "running_job.tpl") ;
2582 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2584 unless ($arg->{jmedias}) {
2585 return $self->error("Can't get media selection");
2588 my $a = $self->ach_get($arg->{ach});
2594 SELECT Media.VolumeName AS volumename,
2595 Storage.Name AS storage,
2596 Location.Location AS location,
2598 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2599 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2600 WHERE Media.VolumeName IN ($arg->{jmedias})
2601 AND Media.InChanger = 1
2604 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2608 foreach my $vol (values %$all) {
2609 print "eject $vol->{volumename} from $vol->{storage} : ";
2610 if ($a->send_to_io($vol->{slot})) {
2622 my $arg = $self->get_form('jobid', 'client');
2624 print CGI::header('text/brestore');
2625 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2626 print "client=$arg->{client}\n" if ($arg->{client});
2627 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2631 # TODO : move this to Bweb::Autochanger ?
2632 # TODO : make this internal to not eject tape ?
2638 my ($self, $name) = @_;
2641 return $self->error("Can't get your autochanger name ach");
2644 unless ($self->{info}->{ach_list}) {
2645 return $self->error("Could not find any autochanger");
2648 my $a = $self->{info}->{ach_list}->{$name};
2651 $self->error("Can't get your autochanger $name from your ach_list");
2662 my ($self, $ach) = @_;
2664 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2665 $self->{info}->save();
2673 my $arg = $self->get_form('ach');
2675 or !$self->{info}->{ach_list}
2676 or !$self->{info}->{ach_list}->{$arg->{ach}})
2678 return $self->error("Can't get autochanger name");
2681 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2685 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2687 my $b = new Bconsole(pref => $self->{info});
2688 my @storages = $b->list_storage() ;
2690 $ach->{devices} = [ map { { name => $_ } } @storages ];
2692 $self->display($ach, "ach_add.tpl");
2693 delete $ach->{drives};
2694 delete $ach->{devices};
2701 my $arg = $self->get_form('ach');
2704 or !$self->{info}->{ach_list}
2705 or !$self->{info}->{ach_list}->{$arg->{ach}})
2707 return $self->error("Can't get autochanger name");
2710 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2712 $self->{info}->save();
2713 $self->{info}->view();
2719 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2721 my $b = new Bconsole(pref => $self->{info});
2722 my @storages = $b->list_storage() ;
2724 unless ($arg->{ach}) {
2725 $arg->{devices} = [ map { { name => $_ } } @storages ];
2726 return $self->display($arg, "ach_add.tpl");
2730 foreach my $drive (CGI::param('drives'))
2732 unless (grep(/^$drive$/,@storages)) {
2733 return $self->error("Can't find $drive in storage list");
2736 my $index = CGI::param("index_$drive");
2737 unless (defined $index and $index =~ /^(\d+)$/) {
2738 return $self->error("Can't get $drive index");
2741 $drives[$index] = $drive;
2745 return $self->error("Can't get drives from Autochanger");
2748 my $a = new Bweb::Autochanger(name => $arg->{ach},
2749 precmd => $arg->{precmd},
2750 drive_name => \@drives,
2751 device => $arg->{device},
2752 mtxcmd => $arg->{mtxcmd});
2754 $self->ach_register($a) ;
2756 $self->{info}->view();
2762 my $arg = $self->get_form('jobid');
2764 my $b = new Bconsole(pref => $self->{info});
2766 if ($arg->{jobid}) {
2767 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2769 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2770 title => "Delete a job ",
2771 name => "delete jobid=$arg->{jobid}",
2780 my $ach = CGI::param('ach') ;
2781 unless ($ach =~ /^([\w\d\.-]+)$/) {
2782 return $self->error("Bad autochanger name");
2785 my $b = new Bconsole(pref => $self->{info});
2786 print "<pre>" . $b->update_slots($ach) . "</pre>";
2793 my $arg = $self->get_form('jobid');
2794 unless ($arg->{jobid}) {
2795 return $self->error("Can't get jobid");
2798 my $t = CGI::param('time') || '';
2801 SELECT Job.Name as name, Client.Name as clientname
2802 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2803 WHERE JobId = $arg->{jobid}
2806 my $row = $self->dbh_selectrow_hashref($query);
2809 return $self->error("Can't find $arg->{jobid} in catalog");
2813 SELECT Time AS time, LogText AS log
2815 WHERE JobId = $arg->{jobid}
2818 my $log = $self->dbh_selectall_arrayref($query);
2820 return $self->error("Can't get log for jobid $arg->{jobid}");
2826 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2828 $logtxt = join("", map { $_->[1] } @$log ) ;
2831 $self->display({ lines=> $logtxt,
2832 jobid => $arg->{jobid},
2833 name => $row->{name},
2834 client => $row->{clientname},
2835 }, 'display_log.tpl');
2843 my $arg = $self->get_form('ach', 'slots', 'drive');
2845 unless ($arg->{ach}) {
2846 return $self->error("Can't find autochanger name");
2851 if ($arg->{slots}) {
2852 $slots = join(",", @{ $arg->{slots} });
2853 $t += 60*scalar( @{ $arg->{slots} }) ;
2856 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2857 print "<h1>This command can take long time, be patient...</h1>";
2859 $b->label_barcodes(storage => $arg->{ach},
2860 drive => $arg->{drive},
2870 my @volume = CGI::param('media');
2872 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2875 content => $b->purge_volume(@volume),
2876 title => "Purge media",
2877 name => "purge volume=" . join(' volume=', @volume),
2885 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2887 my @volume = CGI::param('media');
2889 content => $b->prune_volume(@volume),
2890 title => "Prune media",
2891 name => "prune volume=" . join(' volume=', @volume),
2899 my $arg = $self->get_form('jobid');
2900 unless ($arg->{jobid}) {
2901 return $self->error('Bad jobid');
2904 my $b = new Bconsole(pref => $self->{info});
2906 content => $b->cancel($arg->{jobid}),
2907 title => "Cancel job",
2908 name => "cancel jobid=$arg->{jobid}",
2912 sub director_show_sched
2916 my $arg = $self->get_form('days');
2918 my $b = new Bconsole(pref => $self->{info}) ;
2920 my $ret = $b->director_get_sched( $arg->{days} );
2925 }, "scheduled_job.tpl");
2928 sub enable_disable_job
2930 my ($self, $what) = @_ ;
2932 my $name = CGI::param('job') || '';
2933 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2934 return $self->error("Can't find job name");
2937 my $b = new Bconsole(pref => $self->{info}) ;
2947 content => $b->send_cmd("$cmd job=\"$name\""),
2948 title => "$cmd $name",
2949 name => "$cmd job=\"$name\"",
2956 $b = new Bconsole(pref => $self->{info});
2958 my $joblist = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".job")) ];
2960 $self->display({ Jobs => $joblist }, "run_job.tpl");
2965 my ($self, $ouput) = @_;
2968 foreach my $l (split(/\r\n/, $ouput)) {
2969 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
2975 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
2981 foreach my $k (keys %arg) {
2982 $lowcase{lc($k)} = $arg{$k} ;
2991 $b = new Bconsole(pref => $self->{info});
2993 my $job = CGI::param('job') || '';
2995 my $info = $b->send_cmd("show job=\"$job\"");
2996 my $attr = $self->run_parse_job($info);
2998 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
3000 my $pools = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".pool")) ];
3001 my $clients = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".client")) ];
3002 my $filesets= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".fileset")) ];
3003 my $storages= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".storage")) ];
3008 clients => $clients,
3009 filesets => $filesets,
3010 storages => $storages,
3012 }, "run_job_mod.tpl");
3018 $b = new Bconsole(pref => $self->{info});
3020 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
3030 $b = new Bconsole(pref => $self->{info});
3032 # TODO: check input (don't use pool, level)
3034 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
3035 my $job = CGI::param('job') || '';
3036 my $storage = CGI::param('storage') || '';
3038 my $jobid = $b->run(job => $job,
3039 client => $arg->{client},
3040 priority => $arg->{priority},
3041 level => $arg->{level},
3042 storage => $storage,
3043 pool => $arg->{pool},
3046 print $jobid, $b->{error};
3048 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";