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 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
1906 Pool.Name AS poolname,
1907 $self->{sql}->{FROM_UNIXTIME}(
1908 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1909 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1912 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1913 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
1914 Media.MediaType AS MediaType
1916 WHERE Media.VolStatus = 'Full'
1917 GROUP BY Media.MediaType
1918 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
1920 WHERE Media.PoolId=Pool.PoolId
1924 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1925 foreach (values %$all) {
1926 $_->{volbytes} = human_size($_->{volbytes}) ;
1929 $self->display({ ID => $cur_id++,
1931 Location => $elt{location},
1932 Medias => [ values %$all ]
1934 "display_media.tpl");
1941 my $pool = $self->get_form('db_pools');
1943 foreach my $name (@{ $pool->{db_pools} }) {
1944 CGI::param('pool', $name->{name});
1945 $self->display_media();
1949 sub display_media_zoom
1953 my $medias = $self->get_form('jmedias');
1955 unless ($medias->{jmedias}) {
1956 return $self->error("Can't get media selection");
1960 SELECT InChanger AS online,
1961 VolBytes AS nb_bytes,
1962 VolumeName AS volumename,
1963 VolStatus AS volstatus,
1964 VolMounts AS nb_mounts,
1965 Media.VolUseDuration AS voluseduration,
1966 Media.MaxVolJobs AS maxvoljobs,
1967 Media.MaxVolFiles AS maxvolfiles,
1968 Media.MaxVolBytes AS maxvolbytes,
1969 VolErrors AS nb_errors,
1970 Pool.Name AS poolname,
1971 Location.Location AS location,
1972 Media.Recycle AS recycle,
1973 Media.VolRetention AS volretention,
1974 Media.LastWritten AS lastwritten,
1975 Media.VolReadTime/100000 AS volreadtime,
1976 Media.VolWriteTime/100000 AS volwritetime,
1977 $self->{sql}->{FROM_UNIXTIME}(
1978 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1979 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1982 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1983 WHERE Pool.PoolId = Media.PoolId
1984 AND VolumeName IN ($medias->{jmedias})
1987 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1989 foreach my $media (values %$all) {
1990 $media->{nb_bytes} = human_size($media->{nb_bytes}) ;
1991 $media->{voluseduration} = human_sec($media->{voluseduration});
1992 $media->{volretention} = human_sec($media->{volretention});
1993 $media->{volreadtime} = human_sec($media->{volreadtime});
1994 $media->{volwritetime} = human_sec($media->{volwritetime});
1995 my $mq = $self->dbh_quote($media->{volumename});
1998 SELECT DISTINCT Job.JobId AS jobid,
2000 Job.StartTime AS starttime,
2003 Job.JobFiles AS files,
2004 Job.JobBytes AS bytes,
2005 Job.jobstatus AS status
2006 FROM Media,JobMedia,Job
2007 WHERE Media.VolumeName=$mq
2008 AND Media.MediaId=JobMedia.MediaId
2009 AND JobMedia.JobId=Job.JobId
2012 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2014 foreach (values %$jobs) {
2015 $_->{bytes} = human_size($_->{bytes}) ;
2018 $self->display({ jobs => [ values %$jobs ],
2020 "display_media_zoom.tpl");
2028 my $loc = $self->get_form('qlocation');
2029 unless ($loc->{qlocation}) {
2030 return $self->error("Can't get location");
2034 SELECT Location.Location AS location,
2035 Location.Cost AS cost,
2036 Location.Enabled AS enabled
2038 WHERE Location.Location = $loc->{qlocation}
2041 my $row = $self->dbh_selectrow_hashref($query);
2043 $self->display({ ID => $cur_id++,
2044 %$row }, "location_edit.tpl") ;
2052 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2053 unless ($arg->{qlocation}) {
2054 return $self->error("Can't get location");
2056 unless ($arg->{qnewlocation}) {
2057 return $self->error("Can't get new location name");
2059 unless ($arg->{cost}) {
2060 return $self->error("Can't get new cost");
2063 my $enabled = CGI::param('enabled') || '';
2064 $enabled = $enabled?1:0;
2067 UPDATE Location SET Cost = $arg->{cost},
2068 Location = $arg->{qnewlocation},
2070 WHERE Location.Location = $arg->{qlocation}
2073 $self->dbh_do($query);
2075 $self->display_location();
2081 my $arg = $self->get_form(qw/qlocation cost/) ;
2083 unless ($arg->{qlocation}) {
2084 $self->display({}, "location_add.tpl");
2087 unless ($arg->{cost}) {
2088 return $self->error("Can't get new cost");
2091 my $enabled = CGI::param('enabled') || '';
2092 $enabled = $enabled?1:0;
2095 INSERT INTO Location (Location, Cost, Enabled)
2096 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2099 $self->dbh_do($query);
2101 $self->display_location();
2104 sub display_location
2109 SELECT Location.Location AS location,
2110 Location.Cost AS cost,
2111 Location.Enabled AS enabled,
2112 (SELECT count(Media.MediaId)
2114 WHERE Media.LocationId = Location.LocationId
2119 my $location = $self->dbh_selectall_hashref($query, 'location');
2121 $self->display({ ID => $cur_id++,
2122 Locations => [ values %$location ] },
2123 "display_location.tpl");
2130 my $medias = $self->get_selected_media_location();
2135 my $arg = $self->get_form('db_locations', 'qnewlocation');
2137 $self->display({ email => $self->{info}->{email_media},
2139 medias => [ values %$medias ],
2141 "update_location.tpl");
2144 sub get_media_max_size
2146 my ($self, $type) = @_;
2148 "SELECT avg(VolBytes) AS size
2150 WHERE Media.VolStatus = 'Full'
2151 AND Media.MediaType = '$type'
2154 my $res = $self->selectrow_hashref($query);
2157 return $res->{size};
2167 my $media = CGI::param('media');
2169 return $self->error("Can't find media selection");
2172 $media = $self->dbh_quote($media);
2176 my $volstatus = CGI::param('volstatus') || '';
2177 $volstatus = $self->dbh_quote($volstatus); # is checked by db
2178 $update .= " VolStatus=$volstatus, ";
2180 my $inchanger = CGI::param('inchanger') || '';
2182 $update .= " InChanger=1, " ;
2183 my $slot = CGI::param('slot') || '';
2184 if ($slot =~ /^(\d+)$/) {
2185 $update .= " Slot=$1, ";
2187 $update .= " Slot=0, ";
2190 $update = " Slot=0, InChanger=0, ";
2193 my $pool = CGI::param('pool') || '';
2194 $pool = $self->dbh_quote($pool); # is checked by db
2195 $update .= " PoolId=(SELECT PoolId FROM Pool WHERE Name=$pool), ";
2197 my $volretention = CGI::param('volretention') || '';
2198 $volretention = from_human_sec($volretention);
2199 unless ($volretention) {
2200 return $self->error("Can't get volume retention");
2203 $update .= " VolRetention = $volretention, ";
2205 my $loc = CGI::param('location') || '';
2206 $loc = $self->dbh_quote($loc); # is checked by db
2207 $update .= " LocationId=(SELECT LocationId FROM Location WHERE Location=$loc), ";
2209 my $usedu = CGI::param('voluseduration') || '0';
2210 $usedu = from_human_sec($usedu);
2211 $update .= " VolUseDuration=$usedu, ";
2213 my $maxj = CGI::param('maxvoljobs') || '0';
2214 unless ($maxj =~ /^(\d+)$/) {
2215 return $self->error("Can't get max jobs");
2217 $update .= " MaxVolJobs=$1, " ;
2219 my $maxf = CGI::param('maxvolfiles') || '0';
2220 unless ($maxj =~ /^(\d+)$/) {
2221 return $self->error("Can't get max files");
2223 $update .= " MaxVolFiles=$1, " ;
2225 my $maxb = CGI::param('maxvolbytes') || '0';
2226 unless ($maxb =~ /^(\d+)$/) {
2227 return $self->error("Can't get max bytes");
2229 $update .= " MaxVolBytes=$1 " ;
2231 my $row=$self->dbh_do("UPDATE Media SET $update WHERE VolumeName=$media");
2234 print "Update Ok\n";
2235 $self->update_media();
2243 my $media = $self->get_form('qmedia');
2245 unless ($media->{qmedia}) {
2246 return $self->error("Can't get media");
2250 SELECT Media.Slot AS slot,
2251 Pool.Name AS poolname,
2252 Media.VolStatus AS volstatus,
2253 Media.InChanger AS inchanger,
2254 Location.Location AS location,
2255 Media.VolumeName AS volumename,
2256 Media.MaxVolBytes AS maxvolbytes,
2257 Media.MaxVolJobs AS maxvoljobs,
2258 Media.MaxVolFiles AS maxvolfiles,
2259 Media.VolUseDuration AS voluseduration,
2260 Media.VolRetention AS volretention
2262 FROM Media INNER JOIN Pool ON (Media.PoolId = Pool.PoolId)
2263 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2265 WHERE Media.VolumeName = $media->{qmedia}
2268 my $row = $self->dbh_selectrow_hashref($query);
2269 $row->{volretention} = human_sec($row->{volretention});
2270 $row->{voluseduration} = human_sec($row->{voluseduration});
2272 my $elt = $self->get_form(qw/db_pools db_locations/);
2278 "update_media.tpl");
2285 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2287 unless ($arg->{jmedias}) {
2288 return $self->error("Can't get selected media");
2291 unless ($arg->{qnewlocation}) {
2292 return $self->error("Can't get new location");
2297 SET LocationId = (SELECT LocationId
2299 WHERE Location = $arg->{qnewlocation})
2300 WHERE Media.VolumeName IN ($arg->{jmedias})
2303 my $nb = $self->dbh_do($query);
2305 print "$nb media updated";
2312 my $medias = $self->get_selected_media_location();
2314 return $self->error("Can't get media selection");
2316 my $newloc = CGI::param('newlocation');
2318 my $user = CGI::param('user') || 'unknow';
2319 my $comm = CGI::param('comment') || '';
2320 $comm = $self->dbh_quote("$user: $comm");
2324 foreach my $media (keys %$medias) {
2326 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2328 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2329 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2330 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2334 $self->debug($query);
2338 $q->param('action', 'update_location');
2339 my $url = $q->url(-full => 1, -query=>1);
2341 $self->display({ email => $self->{info}->{email_media},
2343 newlocation => $newloc,
2344 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2345 medias => [ values %$medias ],
2347 "change_location.tpl");
2351 sub display_client_stats
2353 my ($self, %arg) = @_ ;
2355 my $client = $self->dbh_quote($arg{clientname});
2356 my ($limit, $label) = $self->get_limit(%arg);
2360 count(Job.JobId) AS nb_jobs,
2361 sum(Job.JobBytes) AS nb_bytes,
2362 sum(Job.JobErrors) AS nb_err,
2363 sum(Job.JobFiles) AS nb_files,
2364 Client.Name AS clientname
2365 FROM Job INNER JOIN Client USING (ClientId)
2367 Client.Name = $client
2369 GROUP BY Client.Name
2372 my $row = $self->dbh_selectrow_hashref($query);
2374 $row->{ID} = $cur_id++;
2375 $row->{label} = $label;
2376 $row->{nb_bytes} = human_size($row->{nb_bytes}) ;
2378 $self->display($row, "display_client_stats.tpl");
2381 # poolname can be undef
2384 my ($self, $poolname) = @_ ;
2386 # TODO : afficher les tailles et les dates
2389 SELECT sum(subq.volmax) AS volmax,
2390 sum(subq.volnum) AS volnum,
2391 sum(subq.voltotal) AS voltotal,
2393 Pool.Recycle AS recycle,
2394 Pool.VolRetention AS volretention,
2395 Pool.VolUseDuration AS voluseduration,
2396 Pool.MaxVolJobs AS maxvoljobs,
2397 Pool.MaxVolFiles AS maxvolfiles,
2398 Pool.MaxVolBytes AS maxvolbytes,
2399 subq.PoolId AS PoolId
2402 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2403 count(Media.MediaId) AS volnum,
2404 sum(Media.VolBytes) AS voltotal,
2405 Media.PoolId AS PoolId,
2406 Media.MediaType AS MediaType
2408 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2409 Media.MediaType AS MediaType
2411 WHERE Media.VolStatus = 'Full'
2412 GROUP BY Media.MediaType
2413 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2414 GROUP BY Media.MediaType, Media.PoolId
2416 INNER JOIN Pool ON (Pool.PoolId = subq.PoolId)
2417 GROUP BY subq.PoolId
2420 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2422 foreach my $p (values %$all) {
2423 $p->{maxvolbytes} = human_size($p->{maxvolbytes}) ;
2424 $p->{volretention} = human_sec($p->{volretention}) ;
2425 $p->{voluseduration} = human_sec($p->{voluseduration}) ;
2428 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2430 $p->{poolusage} = 0;
2434 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2436 WHERE PoolId=$p->{poolid}
2439 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2440 foreach my $t (values %$content) {
2441 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2446 $self->display({ ID => $cur_id++,
2447 Pools => [ values %$all ]},
2448 "display_pool.tpl");
2451 sub display_running_job
2455 my $arg = $self->get_form('client', 'jobid');
2457 if (!$arg->{client} and $arg->{jobid}) {
2460 SELECT Client.Name AS name
2461 FROM Job INNER JOIN Client USING (ClientId)
2462 WHERE Job.JobId = $arg->{jobid}
2465 my $row = $self->dbh_selectrow_hashref($query);
2468 $arg->{client} = $row->{name};
2469 CGI::param('client', $arg->{client});
2473 if ($arg->{client}) {
2474 my $cli = new Bweb::Client(name => $arg->{client});
2475 $cli->display_running_job($self->{info}, $arg->{jobid});
2476 if ($arg->{jobid}) {
2477 $self->get_job_log();
2480 $self->error("Can't get client or jobid");
2484 sub display_running_jobs
2486 my ($self, $display_action) = @_;
2489 SELECT Job.JobId AS jobid,
2490 Job.Name AS jobname,
2492 Job.StartTime AS starttime,
2493 Job.JobFiles AS jobfiles,
2494 Job.JobBytes AS jobbytes,
2495 Job.JobStatus AS jobstatus,
2496 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2497 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2499 Client.Name AS clientname
2500 FROM Job INNER JOIN Client USING (ClientId)
2501 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2503 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2505 $self->display({ ID => $cur_id++,
2506 display_action => $display_action,
2507 Jobs => [ values %$all ]},
2508 "running_job.tpl") ;
2514 my $arg = $self->get_form('jmedias', 'slots', 'ach');
2516 unless ($arg->{jmedias}) {
2517 return $self->error("Can't get media selection");
2521 SELECT Media.VolumeName AS volumename,
2522 Storage.Name AS storage,
2523 Location.Location AS location,
2525 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2526 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2527 WHERE Media.VolumeName IN ($arg->{jmedias})
2528 AND Media.InChanger = 1
2531 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2533 my $a = Bweb::Autochanger::get('S1_L80', $self);
2536 foreach my $vol (values %$all) {
2537 print "eject $vol->{volumename} from $vol->{storage} : ";
2538 if ($a->send_to_io($vol->{slot})) {
2550 my $arg = $self->get_form('jobid', 'client');
2552 print CGI::header('text/brestore');
2553 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2554 print "client=$arg->{client}\n" if ($arg->{client});
2558 # TODO : move this to Bweb::Autochanger ?
2559 # TODO : make this internal to not eject tape ?
2565 my $arg = $self->get_form('jobid');
2567 my $b = new Bconsole(pref => $self->{info});
2569 if ($arg->{jobid}) {
2570 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2572 content => $b->send_cmd("delete jobid=\"$arg->{jobid}\""),
2573 title => "Delete a job ",
2574 name => "delete jobid=$arg->{jobid}",
2583 my $ach = CGI::param('ach') ;
2584 unless ($ach =~ /^([\w\d\.-]+)$/) {
2585 return $self->error("Bad autochanger name");
2588 my $b = new Bconsole(pref => $self->{info});
2589 print "<pre>" . $b->update_slots($ach) . "</pre>";
2596 my $arg = $self->get_form('jobid');
2597 unless ($arg->{jobid}) {
2598 return $self->error("Can't get jobid");
2601 my $t = CGI::param('time') || '';
2604 SELECT Job.Name as name, Client.Name as clientname
2605 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2606 WHERE JobId = $arg->{jobid}
2609 my $row = $self->dbh_selectrow_hashref($query);
2612 return $self->error("Can't find $arg->{jobid} in catalog");
2617 SELECT Time AS time, LogText AS log
2619 WHERE JobId = $arg->{jobid}
2622 my $log = $self->dbh_selectall_arrayref($query);
2624 return $self->error("Can't get log for jobid $arg->{jobid}");
2630 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2632 $logtxt = join("", map { $_->[1] } @$log ) ;
2635 $self->display({ lines=> $logtxt,
2636 jobid => $arg->{jobid},
2637 name => $row->{name},
2638 client => $row->{clientname},
2639 }, 'display_log.tpl');
2647 my $arg = $self->get_form('ach', 'slots', 'drive');
2649 unless ($arg->{ach}) {
2650 return $self->error("Can't find autochanger name");
2654 if ($arg->{slots}) {
2655 $slots = join(",", @{ $arg->{slots} });
2658 my $t = 60*scalar( @{ $arg->{slots} });
2659 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
2660 print "<h1>This command can take long time, be patient...</h1>";
2662 $b->label_barcodes(storage => $arg->{ach},
2663 drive => $arg->{drive},
2673 my @volume = CGI::param('media');
2675 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2678 content => $b->purge_volume(@volume),
2679 title => "Purge media",
2680 name => "purge volume=" . join(' volume=', @volume),
2688 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
2690 my @volume = CGI::param('media');
2692 content => $b->prune_volume(@volume),
2693 title => "Prune media",
2694 name => "prune volume=" . join(' volume=', @volume),
2702 my $arg = $self->get_form('jobid');
2703 unless ($arg->{jobid}) {
2704 return $self->error('Bad jobid');
2707 my $b = new Bconsole(pref => $self->{info});
2709 content => $b->cancel($arg->{jobid}),
2710 title => "Cancel job",
2711 name => "cancel jobid=$arg->{jobid}",
2715 sub director_show_sched
2719 my $arg = $self->get_form('days');
2721 my $b = new Bconsole(pref => $self->{info}) ;
2723 my $ret = $b->director_get_sched( $arg->{days} );
2728 }, "scheduled_job.tpl");
2731 sub enable_disable_job
2733 my ($self, $what) = @_ ;
2735 my $name = CGI::param('job') || '';
2736 unless ($name =~ /^[\w\d\.\-\s]+$/) {
2737 return $self->error("Can't find job name");
2740 my $b = new Bconsole(pref => $self->{info}) ;
2750 content => $b->send_cmd("$cmd job=\"$name\""),
2751 title => "$cmd $name",
2752 name => "$cmd job=\"$name\"",
2759 $b = new Bconsole(pref => $self->{info});
2761 my $joblist = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".job")) ];
2763 $self->display({ Jobs => $joblist }, "run_job.tpl");
2768 my ($self, $ouput) = @_;
2771 foreach my $l (split(/\r\n/, $ouput)) {
2772 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
2778 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
2784 foreach my $k (keys %arg) {
2785 $lowcase{lc($k)} = $arg{$k} ;
2794 $b = new Bconsole(pref => $self->{info});
2796 my $job = CGI::param('job') || '';
2798 my $info = $b->send_cmd("show job=\"$job\"");
2799 my $attr = $self->run_parse_job($info);
2801 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2803 my $pools = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".pool")) ];
2804 my $clients = [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".client")) ];
2805 my $filesets= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".fileset")) ];
2806 my $storages= [ map { { name => $_ } } split(/\r\n/, $b->send_cmd(".storage")) ];
2811 clients => $clients,
2812 filesets => $filesets,
2813 storages => $storages,
2815 }, "run_job_mod.tpl");
2821 $b = new Bconsole(pref => $self->{info});
2823 my $jobs = [ map {{ name => $_ }} split(/\r\n/, $b->send_cmd(".job")) ];
2833 $b = new Bconsole(pref => $self->{info});
2835 # TODO: check input (don't use pool, level)
2837 my $arg = $self->get_form('pool', 'level', 'client', 'priority');
2838 my $job = CGI::param('job') || '';
2839 my $storage = CGI::param('storage') || '';
2841 my $jobid = $b->run(job => $job,
2842 client => $arg->{client},
2843 priority => $arg->{priority},
2844 level => $arg->{level},
2845 storage => $storage,
2846 pool => $arg->{pool},
2849 print $jobid, $b->{error};
2851 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";