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} : $!");
227 while (my $line = <FP>)
230 my ($k, $v) = split(/\s*=\s*/, $line, 2);
240 save - save the current configuration to config_file
248 unless (open(FP, ">$self->{config_file}"))
250 return $self->error("$self->{config_file} : $!");
253 foreach my $k (keys %$self)
255 next unless (exists $k_re{$k}) ;
256 print FP "$k = $self->{$k}\n";
265 edit, view, modify - html form ouput
273 $self->display($self, "config_edit.tpl");
280 $self->display($self, "config_view.tpl");
290 foreach my $k (CGI::param())
292 next unless (exists $k_re{$k}) ;
293 my $val = CGI::param($k);
294 if ($val =~ $k_re{$k}) {
297 $self->{error} .= "bad parameter : $k = [$val]";
301 $self->display($self, "config_view.tpl");
303 if ($self->{error}) { # an error as occured
304 $self->display($self, 'error.tpl');
312 ################################################################
314 package Bweb::Client;
316 use base q/Bweb::Gui/;
320 Bweb::Client - Bacula FD
324 this package is use to do all Client operations like, parse status etc...
328 $client = new Bweb::Client(name => 'zog-fd');
329 $client->status(); # do a 'status client=zog-fd'
335 display_running_job - Html display of a running job
339 this function is used to display information about a current job
343 sub display_running_job
345 my ($self, $conf, $jobid) = @_ ;
347 my $status = $self->status($conf);
350 if ($status->{$jobid}) {
351 $self->display($status->{$jobid}, "client_job_status.tpl");
354 for my $id (keys %$status) {
355 $self->display($status->{$id}, "client_job_status.tpl");
362 $client = new Bweb::Client(name => 'plume-fd');
364 $client->status($bweb);
368 dirty hack to parse "status client=xxx-fd"
372 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
373 Backup Job started: 06-jun-06 17:22
374 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
375 Files Examined=10,697
376 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
382 JobName => Full_plume.2006-06-06_17.22.23,
385 Bytes => 194,484,132,
395 my ($self, $conf) = @_ ;
397 if (defined $self->{cur_jobs}) {
398 return $self->{cur_jobs} ;
402 my $b = new Bconsole(pref => $conf);
403 my $ret = $b->send_cmd("st client=$self->{name}");
407 for my $r (split(/\n/, $ret)) {
409 $r =~ s/(^\s+|\s+$)//g;
410 if ($r =~ /JobId (\d+) Job (\S+)/) {
412 $arg->{$jobid} = { @param, JobId => $jobid } ;
416 @param = ( JobName => $2 );
418 } elsif ($r =~ /=.+=/) {
419 push @param, split(/\s+|\s*=\s*/, $r) ;
421 } elsif ($r =~ /=/) { # one per line
422 push @param, split(/\s*=\s*/, $r) ;
424 } elsif ($r =~ /:/) { # one per line
425 push @param, split(/\s*:\s*/, $r, 2) ;
429 if ($jobid and @param) {
430 $arg->{$jobid} = { @param,
432 Client => $self->{name},
436 $self->{cur_jobs} = $arg ;
442 ################################################################
444 package Bweb::Autochanger;
446 use base q/Bweb::Gui/;
450 Bweb::Autochanger - Object to manage Autochanger
454 this package will parse the mtx output and manage drives.
458 $auto = new Bweb::Autochanger(precmd => 'sudo');
460 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
464 $auto->slot_is_full(10);
465 $auto->transfer(10, 11);
469 # TODO : get autochanger definition from config/dump file
474 my ($name, $bweb) = @_;
475 my $a = new Bweb::Autochanger(debug => $bweb->{debug},
479 drive_name => ['S1_L80_SDLT0', 'S1_L80_SDLT1'],
486 my ($class, %arg) = @_;
489 name => '', # autochanger name
490 label => {}, # where are volume { label1 => 40, label2 => drive0 }
491 drive => [], # drive use [ 'media1', 'empty', ..]
492 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
493 io => [], # io slot number list [ 41, 42, 43...]
494 info => {slot => 0, # informations (slot, drive, io)
498 mtxcmd => '/usr/sbin/mtx',
500 device => '/dev/changer',
501 precmd => '', # ssh command
502 bweb => undef, # link to bacula web object (use for display)
505 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
512 status - parse the output of mtx status
516 this function will launch mtx status and parse the output. it will
517 give a perlish view of the autochanger content.
519 it uses ssh if the autochanger is on a other host.
526 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
528 # TODO : reset all infos
529 $self->{info}->{drive} = 0;
530 $self->{info}->{slot} = 0;
531 $self->{info}->{io} = 0;
533 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
536 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
537 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
538 #Data Transfer Element 1:Empty
539 # Storage Element 1:Empty
540 # Storage Element 2:Full :VolumeTag=000002
541 # Storage Element 3:Empty
542 # Storage Element 4:Full :VolumeTag=000004
543 # Storage Element 5:Full :VolumeTag=000001
544 # Storage Element 6:Full :VolumeTag=000003
545 # Storage Element 7:Empty
546 # Storage Element 41 IMPORT/EXPORT:Empty
547 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
552 # Storage Element 7:Empty
553 # Storage Element 2:Full :VolumeTag=000002
554 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
557 $self->set_empty_slot($1);
559 $self->set_slot($1, $4);
562 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
565 $self->set_empty_drive($1);
567 $self->set_drive($1, $4, $6);
570 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
573 $self->set_empty_io($1);
575 $self->set_io($1, $4);
578 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
580 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
581 $self->{info}->{drive} = $1;
582 $self->{info}->{slot} = $2;
583 if ($l =~ /(\d+)\s+Import/) {
584 $self->{info}->{io} = $1 ;
586 $self->{info}->{io} = 0;
591 $self->debug($self) ;
596 my ($self, $slot) = @_;
599 if ($self->{slot}->[$slot] eq 'loaded') {
603 my $label = $self->{slot}->[$slot] ;
605 return $self->is_media_loaded($label);
610 my ($self, $drive, $slot) = @_;
612 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
613 return 0 if ($self->slot_is_full($slot)) ;
615 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
618 my $content = $self->get_slot($slot);
619 print "content = $content<br/> $drive => $slot<br/>";
620 $self->set_empty_drive($drive);
621 $self->set_slot($slot, $content);
624 $self->{error} = $out;
629 # TODO: load/unload have to use mtx script from bacula
632 my ($self, $drive, $slot) = @_;
634 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
635 return 0 unless ($self->slot_is_full($slot)) ;
637 print "Loading drive $drive with slot $slot<br/>\n";
638 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
641 my $content = $self->get_slot($slot);
642 print "content = $content<br/> $slot => $drive<br/>";
643 $self->set_drive($drive, $slot, $content);
646 $self->{error} = $out;
654 my ($self, $media) = @_;
656 unless ($self->{label}->{$media}) {
660 if ($self->{label}->{$media} =~ /drive\d+/) {
670 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
675 my ($self, $slot, $tag) = @_;
676 $self->{slot}->[$slot] = $tag || 'full';
677 push @{ $self->{io} }, $slot;
680 $self->{label}->{$tag} = $slot;
686 my ($self, $slot) = @_;
688 push @{ $self->{io} }, $slot;
690 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
691 $self->{slot}->[$slot] = 'empty';
697 my ($self, $slot) = @_;
698 return $self->{slot}->[$slot];
703 my ($self, $slot, $tag) = @_;
704 $self->{slot}->[$slot] = $tag || 'full';
707 $self->{label}->{$tag} = $slot;
713 my ($self, $slot) = @_;
715 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
716 $self->{slot}->[$slot] = 'empty';
722 my ($self, $drive) = @_;
723 $self->{drive}->[$drive] = 'empty';
728 my ($self, $drive, $slot, $tag) = @_;
729 $self->{drive}->[$drive] = $tag || $slot;
731 $self->{slot}->[$slot] = $tag || 'loaded';
734 $self->{label}->{$tag} = "drive$drive";
740 my ($self, $slot) = @_;
742 # slot don't exists => full
743 if (not defined $self->{slot}->[$slot]) {
747 if ($self->{slot}->[$slot] eq 'empty') {
750 return 1; # vol, full, loaded
753 sub slot_get_first_free
756 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
757 return $slot unless ($self->slot_is_full($slot));
761 sub io_get_first_free
765 foreach my $slot (@{ $self->{io} }) {
766 return $slot unless ($self->slot_is_full($slot));
773 my ($self, $media) = @_;
775 return $self->{label}->{$media} ;
780 my ($self, $media) = @_;
782 return defined $self->{label}->{$media} ;
787 my ($self, $slot) = @_;
789 unless ($self->slot_is_full($slot)) {
790 print "Autochanger $self->{name} slot $slot is empty\n";
795 if ($self->is_slot_loaded($slot)) {
798 print "Autochanger $self->{name} $slot is currently in use\n";
802 # autochanger must have I/O
803 unless ($self->have_io()) {
804 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
808 my $dst = $self->io_get_first_free();
811 print "Autochanger $self->{name} you must empty I/O first\n";
814 $self->transfer($slot, $dst);
819 my ($self, $src, $dst) = @_ ;
820 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
821 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
824 my $content = $self->get_slot($src);
825 print "content = $content<br/> $src => $dst<br/>";
826 $self->{slot}->[$src] = 'empty';
827 $self->set_slot($dst, $content);
830 $self->{error} = $out;
835 # TODO : do a tapeinfo request to get informations
845 for my $slot (@{$self->{io}})
847 if ($self->is_slot_loaded($slot)) {
848 print "$slot is currently loaded\n";
852 if ($self->slot_is_full($slot))
854 my $free = $self->slot_get_first_free() ;
855 print "want to move $slot to $free\n";
858 $self->transfer($slot, $free) || print "$self->{error}\n";
861 $self->{error} = "E : Can't find free slot";
867 # TODO : this is with mtx status output,
868 # we can do an other function from bacula view (with StorageId)
872 my $bweb = $self->{bweb};
874 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
875 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
878 SELECT Media.VolumeName AS volumename,
879 Media.VolStatus AS volstatus,
880 Media.LastWritten AS lastwritten,
881 Media.VolBytes AS volbytes,
882 Media.MediaType AS mediatype,
884 Media.InChanger AS inchanger,
886 $bweb->{sql}->{FROM_UNIXTIME}(
887 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
888 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
891 INNER JOIN Pool USING (PoolId)
893 WHERE Media.VolumeName IN ($media_list)
896 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
898 # TODO : verify slot and bacula slot
902 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
904 if ($self->slot_is_full($slot)) {
906 my $vol = $self->{slot}->[$slot];
907 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
909 my $bslot = $all->{$vol}->{slot} ;
910 my $inchanger = $all->{$vol}->{inchanger};
912 # if bacula slot or inchanger flag is bad, we display a message
913 if ($bslot != $slot or !$inchanger) {
914 push @to_update, $slot;
917 $all->{$vol}->{realslot} = $slot;
918 $all->{$vol}->{volbytes} = Bweb::human_size($all->{$vol}->{volbytes}) ;
920 push @{ $param }, $all->{$vol};
922 } else { # empty or no label
923 push @{ $param }, {realslot => $slot,
924 volstatus => 'Unknow',
925 volumename => $self->{slot}->[$slot]} ;
928 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
932 my $i=0; my $drives = [] ;
933 foreach my $d (@{ $self->{drive} }) {
934 $drives->[$i] = { index => $i,
935 load => $self->{drive}->[$i],
936 name => $self->{drive_name}->[$i],
941 $bweb->display({ Name => $self->{name},
942 nb_drive => $self->{info}->{drive},
943 nb_io => $self->{info}->{io},
946 Update => scalar(@to_update) },
954 ################################################################
958 use base q/Bweb::Gui/;
962 Bweb - main Bweb package
966 this package is use to compute and display informations
971 use POSIX qw/strftime/;
973 our $bpath="/usr/local/bacula";
974 our $bconsole="$bpath/sbin/bconsole -c $bpath/etc/bconsole.conf";
980 %sql_func - hash to make query mysql/postgresql compliant
986 UNIX_TIMESTAMP => '',
988 TO_SEC => " interval '1 second' * ",
989 SEC_TO_INT => "SEC_TO_INT",
993 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
994 FROM_UNIXTIME => 'FROM_UNIXTIME',
997 SEC_TO_TIME => 'SEC_TO_TIME',
1001 sub dbh_selectall_arrayref
1003 my ($self, $query) = @_;
1004 $self->connect_db();
1005 $self->debug($query);
1006 return $self->{dbh}->selectall_arrayref($query);
1011 my ($self, @what) = @_;
1012 return join(',', $self->dbh_quote(@what)) ;
1017 my ($self, @what) = @_;
1019 $self->connect_db();
1021 return map { $self->{dbh}->quote($_) } @what;
1023 return $self->{dbh}->quote($what[0]) ;
1029 my ($self, $query) = @_ ;
1030 $self->connect_db();
1031 $self->debug($query);
1032 return $self->{dbh}->do($query);
1035 sub dbh_selectall_hashref
1037 my ($self, $query, $join) = @_;
1039 $self->connect_db();
1040 $self->debug($query);
1041 return $self->{dbh}->selectall_hashref($query, $join) ;
1044 sub dbh_selectrow_hashref
1046 my ($self, $query) = @_;
1048 $self->connect_db();
1049 $self->debug($query);
1050 return $self->{dbh}->selectrow_hashref($query) ;
1056 my @unit = qw(b Kb Mb Gb Tb);
1057 my $val = shift || 0;
1059 my $format = '%i %s';
1060 while ($val / 1024 > 1) {
1064 $format = ($i>0)?'%0.1f %s':'%i %s';
1065 return sprintf($format, $val, $unit[$i]);
1068 # display Day, Hour, Year
1074 $val /= 60; # sec -> min
1076 if ($val / 60 <= 1) {
1080 $val /= 60; # min -> hour
1081 if ($val / 24 <= 1) {
1082 return "$val hours";
1085 $val /= 24; # hour -> day
1086 if ($val / 365 < 2) {
1090 $val /= 365 ; # day -> year
1092 return "$val years";
1095 # get Day, Hour, Year
1101 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1105 my %times = ( m => 60,
1111 my $mult = $times{$2} || 0;
1121 unless ($self->{dbh}) {
1122 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1123 $self->{info}->{user},
1124 $self->{info}->{password});
1126 print "Can't connect to your database, see error log\n"
1127 unless ($self->{dbh});
1129 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1135 my ($class, %arg) = @_;
1137 dbh => undef, # connect_db();
1139 dbi => 'DBI:Pg:database=bacula;host=127.0.0.1',
1145 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1147 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1148 $self->{sql} = $sql_func{$1};
1151 $self->{debug} = $self->{info}->{debug};
1152 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1160 $self->display($self->{info}, "begin.tpl");
1166 $self->display($self->{info}, "end.tpl");
1174 SELECT Name AS name,
1176 AutoPrune AS autoprune,
1177 FileRetention AS fileretention,
1178 JobRetention AS jobretention
1183 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1185 foreach (values %$all) {
1186 $_->{fileretention} = human_sec($_->{fileretention});
1187 $_->{jobretention} = human_sec($_->{jobretention});
1190 my $arg = { ID => $cur_id++,
1191 clients => [ values %$all] };
1193 $self->display($arg, "client_list.tpl") ;
1198 my ($self, %arg) = @_;
1205 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1207 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1209 $self->{sql}->{TO_SEC}($arg{age})
1212 $label = "last " . human_sec($arg{age});
1216 $limit .= " ORDER BY $arg{order} ";
1220 $limit .= " LIMIT $arg{limit} ";
1221 $label .= " limited to $arg{limit}";
1225 $limit .= " OFFSET $arg{offset} ";
1226 $label .= " with $arg{offset} offset ";
1230 $label = 'no filter';
1233 return ($limit, $label);
1238 $bweb->get_form(...) - Get useful stuff
1242 This function get and check parameters against regexp.
1244 If word begin with 'q', the return will be quoted or join quoted
1245 if it's end with 's'.
1250 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1253 qclient => 'plume-fd',
1254 qpools => "'plume-fd', 'test-fd', '...'",
1261 my ($self, @what) = @_;
1262 my %what = map { $_ => 1 } @what;
1279 my %opt_s = ( # default to ''
1290 foreach my $i (@what) {
1291 if (exists $opt_i{$i}) {# integer param
1292 my $value = CGI::param($i) || $opt_i{$i} ;
1293 if ($value =~ /^(\d+)$/) {
1296 } elsif ($opt_s{$i}) { # simple string param
1297 my $value = CGI::param($i) || '';
1298 if ($value =~ /^([\w\d\.-]+)$/) {
1301 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1302 my @value = CGI::param($1) ;
1304 $ret{$i} = $self->dbh_join(@value) ;
1307 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1308 my $value = CGI::param($1) ;
1310 $ret{$i} = $self->dbh_quote($value);
1313 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1314 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1320 foreach my $s (CGI::param('slot')) {
1321 if ($s =~ /^(\d+)$/) {
1322 push @{$ret{slots}}, $s;
1327 if ($what{db_clients}) {
1329 SELECT Client.Name as clientname
1333 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1334 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1338 if ($what{db_mediatypes}) {
1340 SELECT MediaType as mediatype
1344 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1345 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1349 if ($what{db_locations}) {
1351 SELECT Location as location, Cost as cost FROM Location
1353 my $loc = $self->dbh_selectall_hashref($query, 'location');
1354 $ret{db_locations} = [ sort { $a->{location}
1360 if ($what{db_pools}) {
1361 my $query = "SELECT Name as name FROM Pool";
1363 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1364 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1367 if ($what{db_filesets}) {
1369 SELECT FileSet.FileSet AS fileset
1373 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1375 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1376 values %$filesets] ;
1387 my $fields = $self->get_form(qw/age level status clients filesets
1388 db_clients limit db_filesets width height
1389 qclients qfilesets/);
1392 my $url = CGI::url(-full => 0,
1395 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1397 my $type = CGI::param('graph') || '';
1398 if ($type =~ /^(\w+)$/) {
1399 $fields->{graph} = $1;
1402 my $gtype = CGI::param('gtype') || '';
1403 if ($gtype =~ /^(\w+)$/) {
1404 $fields->{gtype} = $1;
1407 # this organisation is to keep user choice between 2 click
1408 # TODO : fileset and client selection doesn't work
1417 sub display_client_job
1419 my ($self, %arg) = @_ ;
1421 $arg{order} = ' Job.JobId DESC ';
1422 my ($limit, $label) = $self->get_limit(%arg);
1424 my $clientname = $self->dbh_quote($arg{clientname});
1427 SELECT DISTINCT Job.JobId AS jobid,
1428 Job.Name AS jobname,
1429 FileSet.FileSet AS fileset,
1431 StartTime AS starttime,
1432 JobFiles AS jobfiles,
1433 JobBytes AS jobbytes,
1434 JobStatus AS jobstatus,
1435 JobErrors AS joberrors
1437 FROM Client,Job,FileSet
1438 WHERE Client.Name=$clientname
1439 AND Client.ClientId=Job.ClientId
1440 AND Job.FileSetId=FileSet.FileSetId
1444 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1446 foreach (values %$all) {
1447 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1450 $self->display({ clientname => $arg{clientname},
1453 Jobs => [ values %$all ],
1455 "display_client_job.tpl") ;
1458 sub get_selected_media_location
1462 my $medias = $self->get_form('jmedias');
1464 unless ($medias->{jmedias}) {
1469 SELECT Media.VolumeName AS volumename, Location.Location AS location
1470 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1471 WHERE Media.VolumeName IN ($medias->{jmedias})
1474 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1476 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1487 my $medias = $self->get_selected_media_location();
1493 my $elt = $self->get_form('db_locations');
1495 $self->display({ ID => $cur_id++,
1496 %$elt, # db_locations
1498 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1508 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1510 $self->display($elt, "help_extern.tpl");
1513 sub help_extern_compute
1517 my $number = CGI::param('limit') || '' ;
1518 unless ($number =~ /^(\d+)$/) {
1519 return $self->error("Bad arg number : $number ");
1522 my ($sql, undef) = $self->get_param('pools',
1523 'locations', 'mediatypes');
1526 SELECT Media.VolumeName AS volumename,
1527 Media.VolStatus AS volstatus,
1528 Media.LastWritten AS lastwritten,
1529 Media.MediaType AS mediatype,
1530 Media.VolMounts AS volmounts,
1532 Media.Recycle AS recycle,
1533 $self->{sql}->{FROM_UNIXTIME}(
1534 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1535 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1538 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1539 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1541 WHERE Media.InChanger = 1
1542 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1544 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1548 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1550 $self->display({ Medias => [ values %$all ] },
1551 "help_extern_compute.tpl");
1558 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1559 $self->display($param, "help_intern.tpl");
1562 sub help_intern_compute
1566 my $number = CGI::param('limit') || '' ;
1567 unless ($number =~ /^(\d+)$/) {
1568 return $self->error("Bad arg number : $number ");
1571 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1573 if (CGI::param('expired')) {
1575 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1576 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1582 SELECT Media.VolumeName AS volumename,
1583 Media.VolStatus AS volstatus,
1584 Media.LastWritten AS lastwritten,
1585 Media.MediaType AS mediatype,
1586 Media.VolMounts AS volmounts,
1588 $self->{sql}->{FROM_UNIXTIME}(
1589 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1590 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1593 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1594 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1596 WHERE Media.InChanger <> 1
1597 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1598 AND Media.Recycle = 1
1600 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1604 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1606 $self->display({ Medias => [ values %$all ] },
1607 "help_intern_compute.tpl");
1613 my ($self, %arg) = @_ ;
1615 my ($limit, $label) = $self->get_limit(%arg);
1619 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1620 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1621 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1622 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1623 (SELECT count(Job.JobId)
1625 WHERE Job.JobStatus IN ('E','e','f','A')
1628 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1631 my $row = $self->dbh_selectrow_hashref($query) ;
1633 $row->{nb_bytes} = human_size($row->{nb_bytes});
1635 $row->{db_size} = '???';
1636 $row->{label} = $label;
1638 $self->display($row, "general.tpl");
1643 my ($self, @what) = @_ ;
1644 my %elt = map { $_ => 1 } @what;
1649 if ($elt{clients}) {
1650 my @clients = CGI::param('client');
1652 $ret{clients} = \@clients;
1653 my $str = $self->dbh_join(@clients);
1654 $limit .= "AND Client.Name IN ($str) ";
1658 if ($elt{filesets}) {
1659 my @filesets = CGI::param('fileset');
1661 $ret{filesets} = \@filesets;
1662 my $str = $self->dbh_join(@filesets);
1663 $limit .= "AND FileSet.FileSet IN ($str) ";
1667 if ($elt{mediatypes}) {
1668 my @medias = CGI::param('mediatype');
1670 $ret{mediatypes} = \@medias;
1671 my $str = $self->dbh_join(@medias);
1672 $limit .= "AND Media.MediaType IN ($str) ";
1677 my $client = CGI::param('client');
1678 $ret{client} = $client;
1679 $client = $self->dbh_join($client);
1680 $limit .= "AND Client.Name = $client ";
1684 my $level = CGI::param('level') || '';
1685 if ($level =~ /^(\w)$/) {
1687 $limit .= "AND Job.Level = '$1' ";
1692 my $jobid = CGI::param('jobid') || '';
1694 if ($jobid =~ /^(\d+)$/) {
1696 $limit .= "AND Job.JobId = '$1' ";
1701 my $status = CGI::param('status') || '';
1702 if ($status =~ /^(\w)$/) {
1704 $limit .= "AND Job.JobStatus = '$1' ";
1708 if ($elt{locations}) {
1709 my @location = CGI::param('location') ;
1711 $ret{locations} = \@location;
1712 my $str = $self->dbh_join(@location);
1713 $limit .= "AND Location.Location IN ($str) ";
1718 my @pool = CGI::param('pool') ;
1720 $ret{pools} = \@pool;
1721 my $str = $self->dbh_join(@pool);
1722 $limit .= "AND Pool.Name IN ($str) ";
1726 if ($elt{location}) {
1727 my $location = CGI::param('location') || '';
1729 $ret{location} = $location;
1730 $location = $self->dbh_quote($location);
1731 $limit .= "AND Location.Location = $location ";
1736 my $pool = CGI::param('pool') || '';
1739 $pool = $self->dbh_quote($pool);
1740 $limit .= "AND Pool.Name = $pool ";
1744 if ($elt{jobtype}) {
1745 my $jobtype = CGI::param('jobtype') || '';
1746 if ($jobtype =~ /^(\w)$/) {
1748 $limit .= "AND Job.Type = '$1' ";
1752 return ($limit, %ret);
1759 SELECT DISTINCT Job.JobId AS jobid,
1760 Client.Name AS client,
1761 FileSet.FileSet AS fileset,
1762 Job.Name AS jobname,
1764 StartTime AS starttime,
1765 JobFiles AS jobfiles,
1766 JobBytes AS jobbytes,
1767 VolumeName AS volumename,
1768 JobStatus AS jobstatus,
1769 JobErrors AS joberrors
1771 FROM Client,Job,JobMedia,Media,FileSet
1772 WHERE Client.ClientId=Job.ClientId
1773 AND Job.FileSetId=FileSet.FileSetId
1774 AND JobMedia.JobId=Job.JobId
1775 AND JobMedia.MediaId=Media.MediaId
1782 my ($self, %arg) = @_ ;
1784 $arg{order} = ' Job.JobId DESC ';
1786 my ($limit, $label) = $self->get_limit(%arg);
1787 my ($where, undef) = $self->get_param('clients',
1795 SELECT Job.JobId AS jobid,
1796 Client.Name AS client,
1797 FileSet.FileSet AS fileset,
1798 Job.Name AS jobname,
1800 StartTime AS starttime,
1801 Pool.Name AS poolname,
1802 JobFiles AS jobfiles,
1803 JobBytes AS jobbytes,
1804 JobStatus AS jobstatus,
1805 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1806 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1809 JobErrors AS joberrors
1812 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1813 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1814 WHERE Client.ClientId=Job.ClientId
1819 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1821 foreach (values %$all) {
1822 $_->{jobbytes} = human_size($_->{jobbytes}) ;
1825 $self->display({ Filter => $label,
1829 sort { $a->{jobid} <=> $b->{jobid} }
1836 # display job informations
1837 sub display_job_zoom
1839 my ($self, $jobid) = @_ ;
1841 $jobid = $self->dbh_quote($jobid);
1844 SELECT DISTINCT Job.JobId AS jobid,
1845 Client.Name AS client,
1846 Job.Name AS jobname,
1847 FileSet.FileSet AS fileset,
1849 Pool.Name AS poolname,
1850 StartTime AS starttime,
1851 JobFiles AS jobfiles,
1852 JobBytes AS jobbytes,
1853 JobStatus AS jobstatus,
1854 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1855 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1858 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1859 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1860 WHERE Client.ClientId=Job.ClientId
1861 AND Job.JobId = $jobid
1864 my $row = $self->dbh_selectrow_hashref($query) ;
1866 $row->{jobbytes} = human_size($row->{jobbytes}) ;
1868 # display all volumes associate with this job
1870 SELECT Media.VolumeName as volumename
1871 FROM Job,Media,JobMedia
1872 WHERE Job.JobId = $jobid
1873 AND JobMedia.JobId=Job.JobId
1874 AND JobMedia.MediaId=Media.MediaId
1877 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1879 $row->{volumes} = [ values %$all ] ;
1881 $self->display($row, "display_job_zoom.tpl");
1888 my ($where, %elt) = $self->get_param('pool',
1891 my $arg = $self->get_form('jmedias');
1893 if ($arg->{jmedias}) {
1894 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
1898 SELECT Media.VolumeName AS volumename,
1899 Media.VolBytes AS volbytes,
1900 Media.VolStatus AS volstatus,
1901 Media.MediaType AS mediatype,
1902 Media.InChanger AS online,
1903 Media.LastWritten AS lastwritten,
1904 Location.Location AS location,
1905 Pool.Name AS poolname,
1906 $self->{sql}->{FROM_UNIXTIME}(
1907 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1908 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1910 FROM Pool, Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1911 WHERE Media.PoolId=Pool.PoolId
1915 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1916 foreach (values %$all) {
1917 $_->{volbytes} = human_size($_->{volbytes}) ;
1920 $self->display({ ID => $cur_id++,
1922 Location => $elt{location},
1923 Medias => [ values %$all ]
1925 "display_media.tpl");
1932 my $pool = $self->get_form('db_pools');
1934 foreach my $name (@{ $pool->{db_pools} }) {
1935 CGI::param('pool', $name->{name});
1936 $self->display_media();
1940 sub display_media_zoom
1944 my $medias = $self->get_form('jmedias');
1946 unless ($medias->{jmedias}) {
1947 return $self->error("Can't get media selection");
1951 SELECT InChanger AS online,
1952 VolBytes AS nb_bytes,
1953 VolumeName AS volumename,
1954 VolStatus AS volstatus,
1955 VolMounts AS nb_mounts,
1956 Media.VolUseDuration AS voluseduration,
1957 Media.MaxVolJobs AS maxvoljobs,
1958 Media.MaxVolFiles AS maxvolfiles,
1959 Media.MaxVolBytes AS maxvolbytes,
1960 VolErrors AS nb_errors,
1961 Pool.Name AS poolname,
1962 Location.Location AS location,
1963 Media.Recycle AS recycle,
1964 Media.VolRetention AS volretention,
1965 Media.LastWritten AS lastwritten,
1966 $self->{sql}->{FROM_UNIXTIME}(
1967 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1968 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1971 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1972 WHERE Pool.PoolId = Media.PoolId
1973 AND VolumeName IN ($medias->{jmedias})
1976 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1978 foreach my $media (values %$all) {
1979 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
1980 $media->{voluseduration} = human_sec($media->{voluseduration});
1981 $media->{volretention} = human_sec($media->{volretention});
1982 my $mq = $self->dbh_quote($media->{volumename});
1985 SELECT DISTINCT Job.JobId AS jobid,
1987 Job.StartTime AS starttime,
1990 Job.JobFiles AS files,
1991 Job.JobBytes AS bytes,
1992 Job.jobstatus AS status
1993 FROM Media,JobMedia,Job
1994 WHERE Media.VolumeName=$mq
1995 AND Media.MediaId=JobMedia.MediaId
1996 AND JobMedia.JobId=Job.JobId
1999 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2001 foreach (values %$jobs) {
2002 $_->{bytes} = human_size($_->{bytes}) ;
2005 $self->display({ jobs => [ values %$jobs ],
2007 "display_media_zoom.tpl");
2015 my $loc = $self->get_form('qlocation');
2016 unless ($loc->{qlocation}) {
2017 return $self->error("Can't get location");
2021 SELECT Location.Location AS location,
2022 Location.Cost AS cost,
2023 Location.Enabled AS enabled
2025 WHERE Location.Location = $loc->{qlocation}
2028 my $row = $self->dbh_selectrow_hashref($query);
2030 $self->display({ ID => $cur_id++,
2031 %$row }, "location_edit.tpl") ;
2039 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2040 unless ($arg->{qlocation}) {
2041 return $self->error("Can't get location");
2043 unless ($arg->{qnewlocation}) {
2044 return $self->error("Can't get new location name");
2046 unless ($arg->{cost}) {
2047 return $self->error("Can't get new cost");
2050 my $enabled = CGI::param('enabled') || '';
2051 $enabled = $enabled?1:0;
2054 UPDATE Location SET Cost = $arg->{cost},
2055 Location = $arg->{qnewlocation},
2057 WHERE Location.Location = $arg->{qlocation}
2060 $self->dbh_do($query);
2062 $self->display_location();
2068 my $arg = $self->get_form(qw/qlocation cost/) ;
2070 unless ($arg->{qlocation}) {
2071 $self->display({}, "location_add.tpl");
2074 unless ($arg->{cost}) {
2075 return $self->error("Can't get new cost");
2078 my $enabled = CGI::param('enabled') || '';
2079 $enabled = $enabled?1:0;
2082 INSERT INTO Location (Location, Cost, Enabled)
2083 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2086 $self->dbh_do($query);
2088 $self->display_location();
2091 sub display_location
2096 SELECT Location.Location AS location,
2097 Location.Cost AS cost,
2098 Location.Enabled AS enabled,
2099 (SELECT count(Media.MediaId)
2101 WHERE Media.LocationId = Location.LocationId
2106 my $location = $self->dbh_selectall_hashref($query, 'location');
2108 $self->display({ ID => $cur_id++,
2109 Locations => [ values %$location ] },
2110 "display_location.tpl");
2117 my $medias = $self->get_selected_media_location();
2122 my $arg = $self->get_form('db_locations', 'qnewlocation');
2124 $self->display({ email => $self->{info}->{email_media},
2126 medias => [ values %$medias ],
2128 "update_location.tpl");
2135 my $media = CGI::param('media');
2137 return $self->error("Can't find media selection");
2140 $media = $self->dbh_quote($media);
2144 my $volstatus = CGI::param('volstatus') || '';
2145 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2146 $update .= " VolStatus=$volstatus, ";
2148 my $inchanger = CGI::param('inchanger') || '';
2150 $update .= " InChanger=1, " ;
2151 my $slot = CGI::param('slot') || '';
2152 if ($slot =~ /^(\d+)$/) {
2153 $update .= " Slot=$1, ";
2155 $update .= " Slot=0, ";
2158 $update = " Slot=0, InChanger=0, ";
2161 my $pool = CGI::param('pool') || '';
2162 $pool = $self->dbh_quote($pool); # is checked by db
2163 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2165 my $volretention = CGI::param('volretention') || '';
2166 $volretention = from_human_sec($volretention);
2167 unless ($volretention) {
2168 return $self->error("Can't get volume retention");
2171 $update .= " VolRetention = $volretention, ";
2173 my $loc = CGI::param('location') || '';
2174 $loc = $self->dbh_quote($loc); # is checked by db
2175 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2177 my $usedu = CGI::param('voluseduration') || '0';
2178 $usedu = from_human_sec($usedu);
2179 $update .= " VolUseDuration=$usedu, ";
2181 my $maxj = CGI::param('maxvoljobs') || '0';
2182 unless ($maxj =~ /^(\d+)$/) {
2183 return $self->error("Can't get max jobs");
2185 $update .= " MaxVolJobs=$1, " ;
2187 my $maxf = CGI::param('maxvolfiles') || '0';
2188 unless ($maxj =~ /^(\d+)$/) {
2189 return $self->error("Can't get max files");
2191 $update .= " MaxVolFiles=$1, " ;
2193 my $maxb = CGI::param('maxvolbytes') || '0';
2194 unless ($maxb =~ /^(\d+)$/) {
2195 return $self->error("Can't get max bytes");
2197 $update .= " MaxVolBytes=$1 " ;
2199 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2202 print "Update Ok\n";
2203 $self->update_media();
2211 my $media = $self->get_form('qmedia');
2213 unless ($media->{qmedia}) {
2214 return $self->error("Can't get media");
2218 SELECT Media.Slot AS slot,
2219 Pool.Name AS poolname,
2220 Media.VolStatus AS volstatus,
2221 Media.InChanger AS inchanger,
2222 Location.Location AS location,
2223 Media.VolumeName AS volumename,
2224 Media.MaxVolBytes AS maxvolbytes,
2225 Media.MaxVolJobs AS maxvoljobs,
2226 Media.MaxVolFiles AS maxvolfiles,
2227 Media.VolUseDuration AS voluseduration,
2228 Media.VolRetention AS volretention
2230 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2231 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2233 WHERE Media.VolumeName = $media->{qmedia}
2236 my $row = $self->dbh_selectrow_hashref($query);
2237 $row->{volretention} = human_sec($row->{volretention});
2238 $row->{voluseduration} = human_sec($row->{voluseduration});
2240 my $elt = $self->get_form(qw/db_pools db_locations/);
2246 "update_media.tpl");
2253 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2255 unless ($arg->{jmedias}) {
2256 return $self->error("Can't get selected media");
2259 unless ($arg->{qnewlocation}) {
2260 return $self->error("Can't get new location");
2265 SET LocationId = (SELECT LocationId
2267 WHERE Location = $arg->{qnewlocation})
2268 WHERE Media.VolumeName IN ($arg->{jmedias})
2271 my $nb = $self->dbh_do($query);
2273 print "$nb media updated";
2280 my $medias = $self->get_selected_media_location();
2282 return $self->error("Can't get media selection");
2284 my $newloc = CGI::param('newlocation');
2286 my $user = CGI::param('user') || 'unknow';
2287 my $comm = CGI::param('comment') || '';
2288 $comm = $self->dbh_quote("$user: $comm");
2292 foreach my $media (keys %$medias) {
2294 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2296 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2297 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2298 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2302 $self->debug($query);
2306 $q->param('action', 'update_location');
2307 my $url = $q->url(-full => 1, -query=>1);
2309 $self->display({ email => $self->{info}->{email_media},
2311 newlocation => $newloc,
2312 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2313 medias => [ values %$medias ],
2315 "change_location.tpl");
2319 sub display_client_stats
2321 my ($self, %arg) = @_ ;
2323 my $client = $self->dbh_quote($arg{clientname});
2324 my ($limit, $label) = $self->get_limit(%arg);
2328 count(Job.JobId) AS nb_jobs,
2329 sum(Job.JobBytes) AS nb_bytes,
2330 sum(Job.JobErrors) AS nb_err,
2331 sum(Job.JobFiles) AS nb_files,
2332 Client.Name AS clientname
2333 FROM Job INNER JOIN Client USING (ClientId)
2335 Client.Name = $client
2337 GROUP BY Client.Name
2340 my $row = $self->dbh_selectrow_hashref($query);
2342 $row->{ID} = $cur_id++;
2343 $row->{label} = $label;
2344 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2346 $self->display($row, "display_client_stats.tpl");
2349 # poolname can be undef
2352 my ($self, $poolname) = @_ ;
2354 # TODO : afficher les tailles et les dates
2357 SELECT Pool.Name AS name,
2358 Pool.Recycle AS recycle,
2359 Pool.VolRetention AS volretention,
2360 Pool.VolUseDuration AS voluseduration,
2361 Pool.MaxVolJobs AS maxvoljobs,
2362 Pool.MaxVolFiles AS maxvolfiles,
2363 Pool.MaxVolBytes AS maxvolbytes,
2364 (SELECT count(Media.MediaId)
2366 WHERE Media.PoolId = Pool.PoolId
2371 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2372 foreach (values %$all) {
2373 $_->{maxvolbytes} = human_size($_->{maxvolbytes}) ;
2374 $_->{volretention} = human_sec($_->{volretention}) ;
2375 $_->{voluseduration} = human_sec($_->{voluseduration}) ;
2378 $self->display({ ID => $cur_id++,
2379 Pools => [ values %$all ]},
2380 "display_pool.tpl");
2383 sub display_running_job
2387 my $arg = $self->get_form('client', 'jobid');
2389 if (!$arg->{client} and $arg->{jobid}) {
2392 SELECT Client.Name AS name
2393 FROM Job INNER JOIN Client USING (ClientId)
2394 WHERE Job.JobId = $arg->{jobid}
2397 my $row = $self->dbh_selectrow_hashref($query);
2400 $arg->{client} = $row->{name};
2401 CGI::param('client', $arg->{client});
2405 if ($arg->{client}) {
2406 my $cli = new Bweb::Client(name => $arg->{client});
2407 $cli->display_running_job($self->{info}, $arg->{jobid});
2408 if ($arg->{jobid}) {
2409 $self->get_job_log();
2412 $self->error("Can't get client or jobid");
2416 sub display_running_jobs
2418 my ($self, $display_action) = @_;
2421 SELECT Job.JobId AS jobid,
2422 Job.Name AS jobname,
2424 Job.StartTime AS starttime,
2425 Job.JobFiles AS jobfiles,
2426 Job.JobBytes AS jobbytes,
2427 Job.JobStatus AS jobstatus,
2428 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2429 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2431 Client.Name AS clientname
2432 FROM Job INNER JOIN Client USING (ClientId)
2433 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2435 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2437 $self->display({ ID => $cur_id++,
2438 display_action => $display_action,
2439 Jobs => [ values %$all ]},
2440 "running_job.tpl") ;
2446 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2448 unless ($arg->{jmedias}) {
2449 return $self->error("Can't get media selection");
2453 SELECT Media.VolumeName AS volumename,
2454 Storage.Name AS storage,
2455 Location.Location AS location,
2457 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2458 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2459 WHERE Media.VolumeName IN ($arg->{jmedias})
2460 AND Media.InChanger = 1
2463 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2465 my $a = Bweb::Autochanger::get('S1_L80', $self);
2468 foreach my $vol (values %$all) {
2469 print "eject $vol->{volumename} from $vol->{storage} : ";
2470 if ($a->send_to_io($vol->{slot})) {
2482 my $arg = $self->get_form('jobid', 'client');
2484 print CGI::header('text/brestore');
2485 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2486 print "client=$arg->{client}\n" if ($arg->{client});
2490 # TODO : move this to Bweb::Autochanger ?
2491 # TODO : make this internal to not eject tape ?
2497 my $arg = $self->get_form('jobid');
2499 my $b = new Bconsole(pref => $self->{info});
2501 if ($arg->{jobid}) {
2502 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2504 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2505 title => "Delete a job ",
2506 name => "delete jobid=$arg->{jobid}",
2515 my $ach = CGI::param('ach') ;
2516 unless ($ach =~ /^([\w\d\.-]+)$/) {
2517 return $self->error("Bad autochanger name");
2520 my $b = new Bconsole(pref => $self->{info});
2521 print "<pre>" . $b->update_slots($ach) . "</pre>";
2528 my $arg = $self->get_form('jobid');
2529 unless ($arg->{jobid}) {
2530 return $self->error("Can't get jobid");
2533 my $t = CGI::param('time') || '';
2536 SELECT Job.Name as name, Client.Name as clientname
2537 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2538 WHERE JobId = $arg->{jobid}
2541 my $row = $self->dbh_selectrow_hashref($query);
2544 return $self->error("Can't find $arg->{jobid} in catalog");
2549 SELECT Time AS time, LogText AS log
2551 WHERE JobId = $arg->{jobid}
2554 my $log = $self->dbh_selectall_arrayref($query);
2556 return $self->error("Can't get log for jobid $arg->{jobid}");
2562 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2564 $logtxt = join("", map { $_->[1] } @$log ) ;
2567 $self->display({ lines=> $logtxt,
2568 jobid => $arg->{jobid},
2569 name => $row->{name},
2570 client => $row->{clientname},
2571 }, 'display_log.tpl');
2579 my $arg = $self->get_form('ach', 'slots', 'drive');
2581 unless ($arg->{ach}) {
2582 return $self->error("Can't find autochanger name");
2586 if ($arg->{slots}) {
2587 $slots = join(",", @{ $arg->{slots} });
2590 my $t = 60*scalar( @{ $arg->{slots} });
2591 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2592 print "<h1>This command can take long time, be patient...</h1>";
2594 $b->label_barcodes(storage => $arg->{ach},
2595 drive => $arg->{drive},
2605 my @volume = CGI::param('media');
2607 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2610 content => $b->purge_volume(@volume),
2611 title => "Purge media",
2612 name => "purge volume=" . join(' volume=', @volume),
2620 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2622 my @volume = CGI::param('media');
2624 content => $b->prune_volume(@volume),
2625 title => "Prune media",
2626 name => "prune volume=" . join(' volume=', @volume),
2634 my $arg = $self->get_form('jobid');
2635 unless ($arg->{jobid}) {
2636 return $self->error('Bad jobid');
2639 my $b = new Bconsole(pref => $self->{info});
2641 content => $b->cancel($arg->{jobid}),
2642 title => "Cancel job",
2643 name => "cancel jobid=$arg->{jobid}",
2647 sub director_show_sched
2651 my $arg = $self->get_form('days');
2653 my $b = new Bconsole(pref => $self->{info}) ;
2655 my $ret = $b->director_get_sched( $arg->{days} );
2660 }, "scheduled_job.tpl");
2663 sub enable_disable_job
2665 my ($self, $what) = @_ ;
2667 my $name = CGI::param('job') || '';
2668 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2669 return $self->error("Can't find job name");
2672 my $b = new Bconsole(pref => $self->{info}) ;
2682 content => $b->send_cmd("$cmd job=\"$name\""),
2683 title => "$cmd $name",
2684 name => "$cmd job=\"$name\"",
2691 $b = new Bconsole(pref => $self->{info});
2693 my $joblist = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".job")) ];
2695 $self->display({ Jobs => $joblist }, "run_job.tpl");
2700 my ($self, $ouput) = @_;
2703 foreach my $l (split(/\r\n/, $ouput)) {
2704 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
2710 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
2716 foreach my $k (keys %arg) {
2717 $lowcase{lc($k)} = $arg{$k} ;
2726 $b = new Bconsole(pref => $self->{info});
2728 my $job = CGI::param('job') || '';
2730 my $info = $b->send_cmd("show job=\"$job\"");
2731 my $attr = $self->run_parse_job($info);
2733 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2735 my $pools = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".pool")) ];
2736 my $clients = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".client")) ];
2737 my $filesets= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".fileset")) ];
2738 my $storages= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".storage")) ];
2743 clients => $clients,
2744 filesets => $filesets,
2745 storages => $storages,
2747 }, "run_job_mod.tpl");
2753 $b = new Bconsole(pref => $self->{info});
2755 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2765 $b = new Bconsole(pref => $self->{info});
2767 # TODO: check input (don't use pool, level)
2769 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
2770 my $job = CGI::param('job') || '';
2771 my $storage = CGI::param('storage') || '';
2773 my $jobid = $b->run(job => $job,
2774 client => $arg->{client},
2775 priority => $arg->{priority},
2776 level => $arg->{level},
2777 storage => $storage,
2778 pool => $arg->{pool},
2781 print $jobid, $b->{error};
2783 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";