1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
15 This program is Free Software; you can redistribute it and/or
16 modify it under the terms of version two of the GNU General Public
17 License as published by the Free Software Foundation plus additions
18 that are listed in the file LICENSE.
20 This program is distributed in the hope that it will be useful, but
21 WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 Bacula® is a registered trademark of John Walker.
31 The licensor of Bacula is the Free Software Foundation Europe
32 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
33 Switzerland, email:ftf@fsfeurope.org.
45 Bweb::Gui - Base package for all Bweb object
49 This package define base fonction like new, display, etc..
54 our $template_dir='/usr/share/bweb/tpl';
58 new - creation a of new Bweb object
62 This function take an hash of argument and place them
65 IE : $obj = new Obj(name => 'test', age => '10');
67 $obj->{name} eq 'test' and $obj->{age} eq 10
73 my ($class, %arg) = @_;
78 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
85 my ($self, $what) = @_;
89 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
91 print "<pre>$what</pre>";
98 error - display an error to the user
102 this function set $self->{error} with arg, display a message with
103 error.tpl and return 0
108 return $self->error("Can't use this file");
115 my ($self, $what) = @_;
116 $self->{error} = $what;
117 $self->display($self, 'error.tpl');
123 display - display an html page with HTML::Template
127 this function is use to render all html codes. it takes an
128 ref hash as arg in which all param are usable in template.
130 it will use global template_dir to search the template file.
132 hash keys are not sensitive. See HTML::Template for more
133 explanations about the hash ref. (it's can be quiet hard to understand)
137 $ref = { name => 'me', age => 26 };
138 $self->display($ref, "people.tpl");
144 my ($self, $hash, $tpl) = @_ ;
146 my $template = HTML::Template->new(filename => $tpl,
147 path =>[$template_dir],
148 die_on_bad_params => 0,
149 case_sensitive => 0);
151 foreach my $var (qw/limit offset/) {
153 unless ($hash->{$var}) {
154 my $value = CGI::param($var) || '';
156 if ($value =~ /^(\d+)$/) {
157 $template->param($var, $1) ;
162 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
163 $template->param('loginname', CGI::remote_user());
165 $template->param($hash);
166 print $template->output();
170 ################################################################
172 package Bweb::Config;
174 use base q/Bweb::Gui/;
178 Bweb::Config - read, write, display, modify configuration
182 this package is used for manage configuration
186 $conf = new Bweb::Config(config_file => '/path/to/conf');
197 =head1 PACKAGE VARIABLE
199 %k_re - hash of all acceptable option.
203 this variable permit to check all option with a regexp.
207 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
208 user => qr/^([\w\d\.-]+)$/i,
209 password => qr/^(.*)$/i,
210 fv_write_path => qr!^([/\w\d\.-]+)$!,
211 template_dir => qr!^([/\w\d\.-]+)$!,
212 debug => qr/^(on)?$/,
213 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
214 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
215 bconsole => qr!^(.+)?$!,
216 syslog_file => qr!^(.+)?$!,
217 log_dir => qr!^(.+)?$!,
222 load - load config_file
226 this function load the specified config_file.
234 unless (open(FP, $self->{config_file}))
236 return $self->error("can't load config_file $self->{config_file} : $!");
238 my $f=''; my $tmpbuffer;
239 while(read FP,$tmpbuffer,4096)
247 no strict; # I have no idea of the contents of the file
254 return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
257 foreach my $k (keys %$VAR1) {
258 $self->{$k} = $VAR1->{$k};
266 load_old - load old configuration format
274 unless (open(FP, $self->{config_file}))
276 return $self->error("$self->{config_file} : $!");
279 while (my $line = <FP>)
282 my ($k, $v) = split(/\s*=\s*/, $line, 2);
294 save - save the current configuration to config_file
302 if ($self->{ach_list}) {
303 # shortcut for display_begin
304 $self->{achs} = [ map {{ name => $_ }}
305 keys %{$self->{ach_list}}
309 unless (open(FP, ">$self->{config_file}"))
311 return $self->error("$self->{config_file} : $!\n" .
312 "You must add this to your config file\n"
313 . Data::Dumper::Dumper($self));
316 print FP Data::Dumper::Dumper($self);
324 edit, view, modify - html form ouput
332 $self->display($self, "config_edit.tpl");
338 $self->display($self, "config_view.tpl");
348 foreach my $k (CGI::param())
350 next unless (exists $k_re{$k}) ;
351 my $val = CGI::param($k);
352 if ($val =~ $k_re{$k}) {
355 $self->{error} .= "bad parameter : $k = [$val]";
361 if ($self->{error}) { # an error as occured
362 $self->display($self, 'error.tpl');
370 ################################################################
372 package Bweb::Client;
374 use base q/Bweb::Gui/;
378 Bweb::Client - Bacula FD
382 this package is use to do all Client operations like, parse status etc...
386 $client = new Bweb::Client(name => 'zog-fd');
387 $client->status(); # do a 'status client=zog-fd'
393 display_running_job - Html display of a running job
397 this function is used to display information about a current job
401 sub display_running_job
403 my ($self, $conf, $jobid) = @_ ;
405 my $status = $self->status($conf);
408 if ($status->{$jobid}) {
409 $self->display($status->{$jobid}, "client_job_status.tpl");
412 for my $id (keys %$status) {
413 $self->display($status->{$id}, "client_job_status.tpl");
420 $client = new Bweb::Client(name => 'plume-fd');
422 $client->status($bweb);
426 dirty hack to parse "status client=xxx-fd"
430 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
431 Backup Job started: 06-jun-06 17:22
432 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
433 Files Examined=10,697
434 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
440 JobName => Full_plume.2006-06-06_17.22.23,
443 Bytes => 194,484,132,
453 my ($self, $conf) = @_ ;
455 if (defined $self->{cur_jobs}) {
456 return $self->{cur_jobs} ;
460 my $b = new Bconsole(pref => $conf);
461 my $ret = $b->send_cmd("st client=$self->{name}");
465 for my $r (split(/\n/, $ret)) {
467 $r =~ s/(^\s+|\s+$)//g;
468 if ($r =~ /JobId (\d+) Job (\S+)/) {
470 $arg->{$jobid} = { @param, JobId => $jobid } ;
474 @param = ( JobName => $2 );
476 } elsif ($r =~ /=.+=/) {
477 push @param, split(/\s+|\s*=\s*/, $r) ;
479 } elsif ($r =~ /=/) { # one per line
480 push @param, split(/\s*=\s*/, $r) ;
482 } elsif ($r =~ /:/) { # one per line
483 push @param, split(/\s*:\s*/, $r, 2) ;
487 if ($jobid and @param) {
488 $arg->{$jobid} = { @param,
490 Client => $self->{name},
494 $self->{cur_jobs} = $arg ;
500 ################################################################
502 package Bweb::Autochanger;
504 use base q/Bweb::Gui/;
508 Bweb::Autochanger - Object to manage Autochanger
512 this package will parse the mtx output and manage drives.
516 $auto = new Bweb::Autochanger(precmd => 'sudo');
518 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
522 $auto->slot_is_full(10);
523 $auto->transfer(10, 11);
529 my ($class, %arg) = @_;
532 name => '', # autochanger name
533 label => {}, # where are volume { label1 => 40, label2 => drive0 }
534 drive => [], # drive use [ 'media1', 'empty', ..]
535 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
536 io => [], # io slot number list [ 41, 42, 43...]
537 info => {slot => 0, # informations (slot, drive, io)
541 mtxcmd => '/usr/sbin/mtx',
543 device => '/dev/changer',
544 precmd => '', # ssh command
545 bweb => undef, # link to bacula web object (use for display)
548 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
555 status - parse the output of mtx status
559 this function will launch mtx status and parse the output. it will
560 give a perlish view of the autochanger content.
562 it uses ssh if the autochanger is on a other host.
569 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
571 # TODO : reset all infos
572 $self->{info}->{drive} = 0;
573 $self->{info}->{slot} = 0;
574 $self->{info}->{io} = 0;
576 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
579 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
580 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
581 #Data Transfer Element 1:Empty
582 # Storage Element 1:Empty
583 # Storage Element 2:Full :VolumeTag=000002
584 # Storage Element 3:Empty
585 # Storage Element 4:Full :VolumeTag=000004
586 # Storage Element 5:Full :VolumeTag=000001
587 # Storage Element 6:Full :VolumeTag=000003
588 # Storage Element 7:Empty
589 # Storage Element 41 IMPORT/EXPORT:Empty
590 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
595 # Storage Element 7:Empty
596 # Storage Element 2:Full :VolumeTag=000002
597 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
600 $self->set_empty_slot($1);
602 $self->set_slot($1, $4);
605 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
608 $self->set_empty_drive($1);
610 $self->set_drive($1, $4, $6);
613 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
616 $self->set_empty_io($1);
618 $self->set_io($1, $4);
621 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
623 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
624 $self->{info}->{drive} = $1;
625 $self->{info}->{slot} = $2;
626 if ($l =~ /(\d+)\s+Import/) {
627 $self->{info}->{io} = $1 ;
629 $self->{info}->{io} = 0;
634 $self->debug($self) ;
639 my ($self, $slot) = @_;
642 if ($self->{slot}->[$slot] eq 'loaded') {
646 my $label = $self->{slot}->[$slot] ;
648 return $self->is_media_loaded($label);
653 my ($self, $drive, $slot) = @_;
655 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
656 return 0 if ($self->slot_is_full($slot)) ;
658 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
661 my $content = $self->get_slot($slot);
662 print "content = $content<br/> $drive => $slot<br/>";
663 $self->set_empty_drive($drive);
664 $self->set_slot($slot, $content);
667 $self->{error} = $out;
672 # TODO: load/unload have to use mtx script from bacula
675 my ($self, $drive, $slot) = @_;
677 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
678 return 0 unless ($self->slot_is_full($slot)) ;
680 print "Loading drive $drive with slot $slot<br/>\n";
681 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
684 my $content = $self->get_slot($slot);
685 print "content = $content<br/> $slot => $drive<br/>";
686 $self->set_drive($drive, $slot, $content);
689 $self->{error} = $out;
697 my ($self, $media) = @_;
699 unless ($self->{label}->{$media}) {
703 if ($self->{label}->{$media} =~ /drive\d+/) {
713 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
718 my ($self, $slot, $tag) = @_;
719 $self->{slot}->[$slot] = $tag || 'full';
720 push @{ $self->{io} }, $slot;
723 $self->{label}->{$tag} = $slot;
729 my ($self, $slot) = @_;
731 push @{ $self->{io} }, $slot;
733 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
734 $self->{slot}->[$slot] = 'empty';
740 my ($self, $slot) = @_;
741 return $self->{slot}->[$slot];
746 my ($self, $slot, $tag) = @_;
747 $self->{slot}->[$slot] = $tag || 'full';
750 $self->{label}->{$tag} = $slot;
756 my ($self, $slot) = @_;
758 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
759 $self->{slot}->[$slot] = 'empty';
765 my ($self, $drive) = @_;
766 $self->{drive}->[$drive] = 'empty';
771 my ($self, $drive, $slot, $tag) = @_;
772 $self->{drive}->[$drive] = $tag || $slot;
774 $self->{slot}->[$slot] = $tag || 'loaded';
777 $self->{label}->{$tag} = "drive$drive";
783 my ($self, $slot) = @_;
785 # slot don't exists => full
786 if (not defined $self->{slot}->[$slot]) {
790 if ($self->{slot}->[$slot] eq 'empty') {
793 return 1; # vol, full, loaded
796 sub slot_get_first_free
799 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
800 return $slot unless ($self->slot_is_full($slot));
804 sub io_get_first_free
808 foreach my $slot (@{ $self->{io} }) {
809 return $slot unless ($self->slot_is_full($slot));
816 my ($self, $media) = @_;
818 return $self->{label}->{$media} ;
823 my ($self, $media) = @_;
825 return defined $self->{label}->{$media} ;
830 my ($self, $slot) = @_;
832 unless ($self->slot_is_full($slot)) {
833 print "Autochanger $self->{name} slot $slot is empty\n";
838 if ($self->is_slot_loaded($slot)) {
841 print "Autochanger $self->{name} $slot is currently in use\n";
845 # autochanger must have I/O
846 unless ($self->have_io()) {
847 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
851 my $dst = $self->io_get_first_free();
854 print "Autochanger $self->{name} you must empty I/O first\n";
857 $self->transfer($slot, $dst);
862 my ($self, $src, $dst) = @_ ;
863 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
864 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
867 my $content = $self->get_slot($src);
868 print "$content ($src) => $dst<br/>";
869 $self->{slot}->[$src] = 'empty';
870 $self->set_slot($dst, $content);
873 $self->{error} = $out;
880 my ($self, $index) = @_;
881 return $self->{drive_name}->[$index];
884 # TODO : do a tapeinfo request to get informations
894 for my $slot (@{$self->{io}})
896 if ($self->is_slot_loaded($slot)) {
897 print "$slot is currently loaded\n";
901 if ($self->slot_is_full($slot))
903 my $free = $self->slot_get_first_free() ;
904 print "want to move $slot to $free\n";
907 $self->transfer($slot, $free) || print "$self->{error}\n";
910 $self->{error} = "E : Can't find free slot";
916 # TODO : this is with mtx status output,
917 # we can do an other function from bacula view (with StorageId)
921 my $bweb = $self->{bweb};
923 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
924 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
927 SELECT Media.VolumeName AS volumename,
928 Media.VolStatus AS volstatus,
929 Media.LastWritten AS lastwritten,
930 Media.VolBytes AS volbytes,
931 Media.MediaType AS mediatype,
933 Media.InChanger AS inchanger,
935 $bweb->{sql}->{FROM_UNIXTIME}(
936 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
937 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
940 INNER JOIN Pool USING (PoolId)
942 WHERE Media.VolumeName IN ($media_list)
945 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
947 # TODO : verify slot and bacula slot
951 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
953 if ($self->slot_is_full($slot)) {
955 my $vol = $self->{slot}->[$slot];
956 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
958 my $bslot = $all->{$vol}->{slot} ;
959 my $inchanger = $all->{$vol}->{inchanger};
961 # if bacula slot or inchanger flag is bad, we display a message
962 if ($bslot != $slot or !$inchanger) {
963 push @to_update, $slot;
966 $all->{$vol}->{realslot} = $slot;
968 push @{ $param }, $all->{$vol};
970 } else { # empty or no label
971 push @{ $param }, {realslot => $slot,
972 volstatus => 'Unknow',
973 volumename => $self->{slot}->[$slot]} ;
976 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
980 my $i=0; my $drives = [] ;
981 foreach my $d (@{ $self->{drive} }) {
982 $drives->[$i] = { index => $i,
983 load => $self->{drive}->[$i],
984 name => $self->{drive_name}->[$i],
989 $bweb->display({ Name => $self->{name},
990 nb_drive => $self->{info}->{drive},
991 nb_io => $self->{info}->{io},
994 Update => scalar(@to_update) },
1002 ################################################################
1006 use base q/Bweb::Gui/;
1010 Bweb - main Bweb package
1014 this package is use to compute and display informations
1019 use POSIX qw/strftime/;
1021 our $config_file='/etc/bacula/bweb.conf';
1027 %sql_func - hash to make query mysql/postgresql compliant
1033 UNIX_TIMESTAMP => '',
1034 FROM_UNIXTIME => '',
1035 TO_SEC => " interval '1 second' * ",
1036 SEC_TO_INT => "SEC_TO_INT",
1039 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1040 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1041 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1042 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1043 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1044 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1047 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1048 FROM_UNIXTIME => 'FROM_UNIXTIME',
1051 SEC_TO_TIME => 'SEC_TO_TIME',
1052 MATCH => " REGEXP ",
1053 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1054 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1055 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1056 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1057 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1058 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1062 sub dbh_selectall_arrayref
1064 my ($self, $query) = @_;
1065 $self->connect_db();
1066 $self->debug($query);
1067 return $self->{dbh}->selectall_arrayref($query);
1072 my ($self, @what) = @_;
1073 return join(',', $self->dbh_quote(@what)) ;
1078 my ($self, @what) = @_;
1080 $self->connect_db();
1082 return map { $self->{dbh}->quote($_) } @what;
1084 return $self->{dbh}->quote($what[0]) ;
1090 my ($self, $query) = @_ ;
1091 $self->connect_db();
1092 $self->debug($query);
1093 return $self->{dbh}->do($query);
1096 sub dbh_selectall_hashref
1098 my ($self, $query, $join) = @_;
1100 $self->connect_db();
1101 $self->debug($query);
1102 return $self->{dbh}->selectall_hashref($query, $join) ;
1105 sub dbh_selectrow_hashref
1107 my ($self, $query) = @_;
1109 $self->connect_db();
1110 $self->debug($query);
1111 return $self->{dbh}->selectrow_hashref($query) ;
1117 my @unit = qw(b Kb Mb Gb Tb);
1118 my $val = shift || 0;
1120 my $format = '%i %s';
1121 while ($val / 1024 > 1) {
1125 $format = ($i>0)?'%0.1f %s':'%i %s';
1126 return sprintf($format, $val, $unit[$i]);
1129 # display Day, Hour, Year
1135 $val /= 60; # sec -> min
1137 if ($val / 60 <= 1) {
1141 $val /= 60; # min -> hour
1142 if ($val / 24 <= 1) {
1143 return "$val hours";
1146 $val /= 24; # hour -> day
1147 if ($val / 365 < 2) {
1151 $val /= 365 ; # day -> year
1153 return "$val years";
1156 # get Day, Hour, Year
1162 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1166 my %times = ( m => 60,
1172 my $mult = $times{$2} || 0;
1182 unless ($self->{dbh}) {
1183 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1184 $self->{info}->{user},
1185 $self->{info}->{password});
1187 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1188 unless ($self->{dbh});
1190 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1192 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1193 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1200 my ($class, %arg) = @_;
1202 dbh => undef, # connect_db();
1204 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1210 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1212 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1213 $self->{sql} = $sql_func{$1};
1216 $self->{debug} = $self->{info}->{debug};
1217 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1225 $self->display($self->{info}, "begin.tpl");
1231 $self->display($self->{info}, "end.tpl");
1239 my $arg = $self->get_form("client", "qre_client");
1241 if ($arg->{qre_client}) {
1242 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1243 } elsif ($arg->{client}) {
1244 $where = "WHERE Name = '$arg->{client}' ";
1248 SELECT Name AS name,
1250 AutoPrune AS autoprune,
1251 FileRetention AS fileretention,
1252 JobRetention AS jobretention
1257 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1259 my $dsp = { ID => $cur_id++,
1260 clients => [ values %$all] };
1262 $self->display($dsp, "client_list.tpl") ;
1267 my ($self, %arg) = @_;
1274 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1276 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1278 $self->{sql}->{TO_SEC}($arg{age})
1281 $label = "last " . human_sec($arg{age});
1284 if ($arg{groupby}) {
1285 $limit .= " GROUP BY $arg{groupby} ";
1289 $limit .= " ORDER BY $arg{order} ";
1293 $limit .= " LIMIT $arg{limit} ";
1294 $label .= " limited to $arg{limit}";
1298 $limit .= " OFFSET $arg{offset} ";
1299 $label .= " with $arg{offset} offset ";
1303 $label = 'no filter';
1306 return ($limit, $label);
1311 $bweb->get_form(...) - Get useful stuff
1315 This function get and check parameters against regexp.
1317 If word begin with 'q', the return will be quoted or join quoted
1318 if it's end with 's'.
1323 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1326 qclient => 'plume-fd',
1327 qpools => "'plume-fd', 'test-fd', '...'",
1334 my ($self, @what) = @_;
1335 my %what = map { $_ => 1 } @what;
1355 my %opt_ss =( # string with space
1359 my %opt_s = ( # default to ''
1376 my %opt_p = ( # option with path
1384 my %opt_d = ( # option with date
1389 foreach my $i (@what) {
1390 if (exists $opt_i{$i}) {# integer param
1391 my $value = CGI::param($i) || $opt_i{$i} ;
1392 if ($value =~ /^(\d+)$/) {
1395 } elsif ($opt_s{$i}) { # simple string param
1396 my $value = CGI::param($i) || '';
1397 if ($value =~ /^([\w\d\.-]+)$/) {
1400 } elsif ($opt_ss{$i}) { # simple string param (with space)
1401 my $value = CGI::param($i) || '';
1402 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1405 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1406 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1408 $ret{$i} = $self->dbh_join(@value) ;
1411 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1412 my $value = CGI::param($1) ;
1414 $ret{$i} = $self->dbh_quote($value);
1417 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1418 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1419 grep { ! /^\s*$/ } CGI::param($1) ];
1420 } elsif (exists $opt_p{$i}) {
1421 my $value = CGI::param($i) || '';
1422 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1425 } elsif (exists $opt_d{$i}) {
1426 my $value = CGI::param($i) || '';
1427 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1434 foreach my $s (CGI::param('slot')) {
1435 if ($s =~ /^(\d+)$/) {
1436 push @{$ret{slots}}, $s;
1442 my $when = CGI::param('when') || '';
1443 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1448 if ($what{db_clients}) {
1450 SELECT Client.Name as clientname
1454 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1455 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1459 if ($what{db_mediatypes}) {
1461 SELECT MediaType as mediatype
1465 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1466 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1470 if ($what{db_locations}) {
1472 SELECT Location as location, Cost as cost FROM Location
1474 my $loc = $self->dbh_selectall_hashref($query, 'location');
1475 $ret{db_locations} = [ sort { $a->{location}
1481 if ($what{db_pools}) {
1482 my $query = "SELECT Name as name FROM Pool";
1484 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1485 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1488 if ($what{db_filesets}) {
1490 SELECT FileSet.FileSet AS fileset
1494 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1496 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1497 values %$filesets] ;
1500 if ($what{db_jobnames}) {
1502 SELECT DISTINCT Job.Name AS jobname
1506 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1508 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1509 values %$jobnames] ;
1512 if ($what{db_devices}) {
1514 SELECT Device.Name AS name
1518 my $devices = $self->dbh_selectall_hashref($query, 'name');
1520 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1531 my $fields = $self->get_form(qw/age level status clients filesets
1533 db_clients limit db_filesets width height
1534 qclients qfilesets qjobnames db_jobnames/);
1537 my $url = CGI::url(-full => 0,
1540 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1542 # this organisation is to keep user choice between 2 click
1543 # TODO : fileset and client selection doesn't work
1552 sub display_client_job
1554 my ($self, %arg) = @_ ;
1556 $arg{order} = ' Job.JobId DESC ';
1557 my ($limit, $label) = $self->get_limit(%arg);
1559 my $clientname = $self->dbh_quote($arg{clientname});
1562 SELECT DISTINCT Job.JobId AS jobid,
1563 Job.Name AS jobname,
1564 FileSet.FileSet AS fileset,
1566 StartTime AS starttime,
1567 JobFiles AS jobfiles,
1568 JobBytes AS jobbytes,
1569 JobStatus AS jobstatus,
1570 JobErrors AS joberrors
1572 FROM Client,Job,FileSet
1573 WHERE Client.Name=$clientname
1574 AND Client.ClientId=Job.ClientId
1575 AND Job.FileSetId=FileSet.FileSetId
1579 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1581 $self->display({ clientname => $arg{clientname},
1584 Jobs => [ values %$all ],
1586 "display_client_job.tpl") ;
1589 sub get_selected_media_location
1593 my $medias = $self->get_form('jmedias');
1595 unless ($medias->{jmedias}) {
1600 SELECT Media.VolumeName AS volumename, Location.Location AS location
1601 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1602 WHERE Media.VolumeName IN ($medias->{jmedias})
1605 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1607 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1618 my $medias = $self->get_selected_media_location();
1624 my $elt = $self->get_form('db_locations');
1626 $self->display({ ID => $cur_id++,
1627 %$elt, # db_locations
1629 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1639 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1641 $self->display($elt, "help_extern.tpl");
1644 sub help_extern_compute
1648 my $number = CGI::param('limit') || '' ;
1649 unless ($number =~ /^(\d+)$/) {
1650 return $self->error("Bad arg number : $number ");
1653 my ($sql, undef) = $self->get_param('pools',
1654 'locations', 'mediatypes');
1657 SELECT Media.VolumeName AS volumename,
1658 Media.VolStatus AS volstatus,
1659 Media.LastWritten AS lastwritten,
1660 Media.MediaType AS mediatype,
1661 Media.VolMounts AS volmounts,
1663 Media.Recycle AS recycle,
1664 $self->{sql}->{FROM_UNIXTIME}(
1665 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1666 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1669 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1670 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1672 WHERE Media.InChanger = 1
1673 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1675 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1679 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1681 $self->display({ Medias => [ values %$all ] },
1682 "help_extern_compute.tpl");
1689 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1690 $self->display($param, "help_intern.tpl");
1693 sub help_intern_compute
1697 my $number = CGI::param('limit') || '' ;
1698 unless ($number =~ /^(\d+)$/) {
1699 return $self->error("Bad arg number : $number ");
1702 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1704 if (CGI::param('expired')) {
1706 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1707 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1713 SELECT Media.VolumeName AS volumename,
1714 Media.VolStatus AS volstatus,
1715 Media.LastWritten AS lastwritten,
1716 Media.MediaType AS mediatype,
1717 Media.VolMounts AS volmounts,
1719 $self->{sql}->{FROM_UNIXTIME}(
1720 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1721 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1724 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1725 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1727 WHERE Media.InChanger <> 1
1728 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1729 AND Media.Recycle = 1
1731 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1735 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1737 $self->display({ Medias => [ values %$all ] },
1738 "help_intern_compute.tpl");
1744 my ($self, %arg) = @_ ;
1746 my ($limit, $label) = $self->get_limit(%arg);
1750 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1751 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1752 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1753 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1754 (SELECT count(Job.JobId)
1756 WHERE Job.JobStatus IN ('E','e','f','A')
1759 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1762 my $row = $self->dbh_selectrow_hashref($query) ;
1764 $row->{nb_bytes} = human_size($row->{nb_bytes});
1766 $row->{db_size} = '???';
1767 $row->{label} = $label;
1769 $self->display($row, "general.tpl");
1774 my ($self, @what) = @_ ;
1775 my %elt = map { $_ => 1 } @what;
1780 if ($elt{clients}) {
1781 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1783 $ret{clients} = \@clients;
1784 my $str = $self->dbh_join(@clients);
1785 $limit .= "AND Client.Name IN ($str) ";
1789 if ($elt{filesets}) {
1790 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1792 $ret{filesets} = \@filesets;
1793 my $str = $self->dbh_join(@filesets);
1794 $limit .= "AND FileSet.FileSet IN ($str) ";
1798 if ($elt{mediatypes}) {
1799 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1801 $ret{mediatypes} = \@medias;
1802 my $str = $self->dbh_join(@medias);
1803 $limit .= "AND Media.MediaType IN ($str) ";
1808 my $client = CGI::param('client');
1809 $ret{client} = $client;
1810 $client = $self->dbh_join($client);
1811 $limit .= "AND Client.Name = $client ";
1815 my $level = CGI::param('level') || '';
1816 if ($level =~ /^(\w)$/) {
1818 $limit .= "AND Job.Level = '$1' ";
1823 my $jobid = CGI::param('jobid') || '';
1825 if ($jobid =~ /^(\d+)$/) {
1827 $limit .= "AND Job.JobId = '$1' ";
1832 my $status = CGI::param('status') || '';
1833 if ($status =~ /^(\w)$/) {
1836 $limit .= "AND Job.JobStatus IN ('f','E') ";
1838 $limit .= "AND Job.JobStatus = '$1' ";
1843 if ($elt{volstatus}) {
1844 my $status = CGI::param('volstatus') || '';
1845 if ($status =~ /^(\w+)$/) {
1847 $limit .= "AND Media.VolStatus = '$1' ";
1851 if ($elt{locations}) {
1852 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1854 $ret{locations} = \@location;
1855 my $str = $self->dbh_join(@location);
1856 $limit .= "AND Location.Location IN ($str) ";
1861 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1863 $ret{pools} = \@pool;
1864 my $str = $self->dbh_join(@pool);
1865 $limit .= "AND Pool.Name IN ($str) ";
1869 if ($elt{location}) {
1870 my $location = CGI::param('location') || '';
1872 $ret{location} = $location;
1873 $location = $self->dbh_quote($location);
1874 $limit .= "AND Location.Location = $location ";
1879 my $pool = CGI::param('pool') || '';
1882 $pool = $self->dbh_quote($pool);
1883 $limit .= "AND Pool.Name = $pool ";
1887 if ($elt{jobtype}) {
1888 my $jobtype = CGI::param('jobtype') || '';
1889 if ($jobtype =~ /^(\w)$/) {
1891 $limit .= "AND Job.Type = '$1' ";
1895 return ($limit, %ret);
1906 my ($self, %arg) = @_ ;
1908 $arg{order} = ' Job.JobId DESC ';
1910 my ($limit, $label) = $self->get_limit(%arg);
1911 my ($where, undef) = $self->get_param('clients',
1920 SELECT Job.JobId AS jobid,
1921 Client.Name AS client,
1922 FileSet.FileSet AS fileset,
1923 Job.Name AS jobname,
1925 StartTime AS starttime,
1926 Pool.Name AS poolname,
1927 JobFiles AS jobfiles,
1928 JobBytes AS jobbytes,
1929 JobStatus AS jobstatus,
1930 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1931 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1934 JobErrors AS joberrors
1937 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1938 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1939 WHERE Client.ClientId=Job.ClientId
1940 AND Job.JobStatus != 'R'
1945 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1947 $self->display({ Filter => $label,
1951 sort { $a->{jobid} <=> $b->{jobid} }
1958 # display job informations
1959 sub display_job_zoom
1961 my ($self, $jobid) = @_ ;
1963 $jobid = $self->dbh_quote($jobid);
1966 SELECT DISTINCT Job.JobId AS jobid,
1967 Client.Name AS client,
1968 Job.Name AS jobname,
1969 FileSet.FileSet AS fileset,
1971 Pool.Name AS poolname,
1972 StartTime AS starttime,
1973 JobFiles AS jobfiles,
1974 JobBytes AS jobbytes,
1975 JobStatus AS jobstatus,
1976 JobErrors AS joberrors,
1977 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1978 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1981 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1982 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1983 WHERE Client.ClientId=Job.ClientId
1984 AND Job.JobId = $jobid
1987 my $row = $self->dbh_selectrow_hashref($query) ;
1989 # display all volumes associate with this job
1991 SELECT Media.VolumeName as volumename
1992 FROM Job,Media,JobMedia
1993 WHERE Job.JobId = $jobid
1994 AND JobMedia.JobId=Job.JobId
1995 AND JobMedia.MediaId=Media.MediaId
1998 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2000 $row->{volumes} = [ values %$all ] ;
2002 $self->display($row, "display_job_zoom.tpl");
2009 my ($where, %elt) = $self->get_param('pools',
2014 my $arg = $self->get_form('jmedias', 'qre_media');
2016 if ($arg->{jmedias}) {
2017 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2019 if ($arg->{qre_media}) {
2020 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2024 SELECT Media.VolumeName AS volumename,
2025 Media.VolBytes AS volbytes,
2026 Media.VolStatus AS volstatus,
2027 Media.MediaType AS mediatype,
2028 Media.InChanger AS online,
2029 Media.LastWritten AS lastwritten,
2030 Location.Location AS location,
2031 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2032 Pool.Name AS poolname,
2033 $self->{sql}->{FROM_UNIXTIME}(
2034 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2035 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2038 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2039 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2040 Media.MediaType AS MediaType
2042 WHERE Media.VolStatus = 'Full'
2043 GROUP BY Media.MediaType
2044 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2046 WHERE Media.PoolId=Pool.PoolId
2050 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2052 $self->display({ ID => $cur_id++,
2054 Location => $elt{location},
2055 Medias => [ values %$all ]
2057 "display_media.tpl");
2064 my $pool = $self->get_form('db_pools');
2066 foreach my $name (@{ $pool->{db_pools} }) {
2067 CGI::param('pool', $name->{name});
2068 $self->display_media();
2072 sub display_media_zoom
2076 my $medias = $self->get_form('jmedias');
2078 unless ($medias->{jmedias}) {
2079 return $self->error("Can't get media selection");
2083 SELECT InChanger AS online,
2084 VolBytes AS nb_bytes,
2085 VolumeName AS volumename,
2086 VolStatus AS volstatus,
2087 VolMounts AS nb_mounts,
2088 Media.VolUseDuration AS voluseduration,
2089 Media.MaxVolJobs AS maxvoljobs,
2090 Media.MaxVolFiles AS maxvolfiles,
2091 Media.MaxVolBytes AS maxvolbytes,
2092 VolErrors AS nb_errors,
2093 Pool.Name AS poolname,
2094 Location.Location AS location,
2095 Media.Recycle AS recycle,
2096 Media.VolRetention AS volretention,
2097 Media.LastWritten AS lastwritten,
2098 Media.VolReadTime/1000000 AS volreadtime,
2099 Media.VolWriteTime/1000000 AS volwritetime,
2100 Media.RecycleCount AS recyclecount,
2101 Media.Comment AS comment,
2102 $self->{sql}->{FROM_UNIXTIME}(
2103 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2104 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2107 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2108 WHERE Pool.PoolId = Media.PoolId
2109 AND VolumeName IN ($medias->{jmedias})
2112 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2114 foreach my $media (values %$all) {
2115 my $mq = $self->dbh_quote($media->{volumename});
2118 SELECT DISTINCT Job.JobId AS jobid,
2120 Job.StartTime AS starttime,
2123 Job.JobFiles AS files,
2124 Job.JobBytes AS bytes,
2125 Job.jobstatus AS status
2126 FROM Media,JobMedia,Job
2127 WHERE Media.VolumeName=$mq
2128 AND Media.MediaId=JobMedia.MediaId
2129 AND JobMedia.JobId=Job.JobId
2132 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2135 SELECT LocationLog.Date AS date,
2136 Location.Location AS location,
2137 LocationLog.Comment AS comment
2138 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2139 WHERE Media.MediaId = LocationLog.MediaId
2140 AND Media.VolumeName = $mq
2144 my $log = $self->dbh_selectall_arrayref($query) ;
2146 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2149 $self->display({ jobs => [ values %$jobs ],
2150 LocationLog => $logtxt,
2152 "display_media_zoom.tpl");
2160 my $loc = $self->get_form('qlocation');
2161 unless ($loc->{qlocation}) {
2162 return $self->error("Can't get location");
2166 SELECT Location.Location AS location,
2167 Location.Cost AS cost,
2168 Location.Enabled AS enabled
2170 WHERE Location.Location = $loc->{qlocation}
2173 my $row = $self->dbh_selectrow_hashref($query);
2175 $self->display({ ID => $cur_id++,
2176 %$row }, "location_edit.tpl") ;
2184 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2185 unless ($arg->{qlocation}) {
2186 return $self->error("Can't get location");
2188 unless ($arg->{qnewlocation}) {
2189 return $self->error("Can't get new location name");
2191 unless ($arg->{cost}) {
2192 return $self->error("Can't get new cost");
2195 my $enabled = CGI::param('enabled') || '';
2196 $enabled = $enabled?1:0;
2199 UPDATE Location SET Cost = $arg->{cost},
2200 Location = $arg->{qnewlocation},
2202 WHERE Location.Location = $arg->{qlocation}
2205 $self->dbh_do($query);
2207 $self->display_location();
2213 my $arg = $self->get_form(qw/qlocation/) ;
2215 unless ($arg->{qlocation}) {
2216 return $self->error("Can't get location");
2220 SELECT count(Media.MediaId) AS nb
2221 FROM Media INNER JOIN Location USING (LocationID)
2222 WHERE Location = $arg->{qlocation}
2225 my $res = $self->dbh_selectrow_hashref($query);
2228 return $self->error("Sorry, the location must be empty");
2232 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2235 $self->dbh_do($query);
2237 $self->display_location();
2244 my $arg = $self->get_form(qw/qlocation cost/) ;
2246 unless ($arg->{qlocation}) {
2247 $self->display({}, "location_add.tpl");
2250 unless ($arg->{cost}) {
2251 return $self->error("Can't get new cost");
2254 my $enabled = CGI::param('enabled') || '';
2255 $enabled = $enabled?1:0;
2258 INSERT INTO Location (Location, Cost, Enabled)
2259 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2262 $self->dbh_do($query);
2264 $self->display_location();
2267 sub display_location
2272 SELECT Location.Location AS location,
2273 Location.Cost AS cost,
2274 Location.Enabled AS enabled,
2275 (SELECT count(Media.MediaId)
2277 WHERE Media.LocationId = Location.LocationId
2282 my $location = $self->dbh_selectall_hashref($query, 'location');
2284 $self->display({ ID => $cur_id++,
2285 Locations => [ values %$location ] },
2286 "display_location.tpl");
2293 my $medias = $self->get_selected_media_location();
2298 my $arg = $self->get_form('db_locations', 'qnewlocation');
2300 $self->display({ email => $self->{info}->{email_media},
2302 medias => [ values %$medias ],
2304 "update_location.tpl");
2307 sub get_media_max_size
2309 my ($self, $type) = @_;
2311 "SELECT avg(VolBytes) AS size
2313 WHERE Media.VolStatus = 'Full'
2314 AND Media.MediaType = '$type'
2317 my $res = $self->selectrow_hashref($query);
2320 return $res->{size};
2330 my $media = $self->get_form('qmedia');
2332 unless ($media->{qmedia}) {
2333 return $self->error("Can't get media");
2337 SELECT Media.Slot AS slot,
2338 PoolMedia.Name AS poolname,
2339 Media.VolStatus AS volstatus,
2340 Media.InChanger AS inchanger,
2341 Location.Location AS location,
2342 Media.VolumeName AS volumename,
2343 Media.MaxVolBytes AS maxvolbytes,
2344 Media.MaxVolJobs AS maxvoljobs,
2345 Media.MaxVolFiles AS maxvolfiles,
2346 Media.VolUseDuration AS voluseduration,
2347 Media.VolRetention AS volretention,
2348 Media.Comment AS comment,
2349 PoolRecycle.Name AS poolrecycle
2351 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2352 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2353 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2355 WHERE Media.VolumeName = $media->{qmedia}
2358 my $row = $self->dbh_selectrow_hashref($query);
2359 $row->{volretention} = human_sec($row->{volretention});
2360 $row->{voluseduration} = human_sec($row->{voluseduration});
2362 my $elt = $self->get_form(qw/db_pools db_locations/);
2367 }, "update_media.tpl");
2374 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2376 unless ($arg->{jmedias}) {
2377 return $self->error("Can't get selected media");
2380 unless ($arg->{qnewlocation}) {
2381 return $self->error("Can't get new location");
2386 SET LocationId = (SELECT LocationId
2388 WHERE Location = $arg->{qnewlocation})
2389 WHERE Media.VolumeName IN ($arg->{jmedias})
2392 my $nb = $self->dbh_do($query);
2394 print "$nb media updated, you may have to update your autochanger.";
2396 $self->display_media();
2403 my $medias = $self->get_selected_media_location();
2405 return $self->error("Can't get media selection");
2407 my $newloc = CGI::param('newlocation');
2409 my $user = CGI::param('user') || 'unknow';
2410 my $comm = CGI::param('comment') || '';
2411 $comm = $self->dbh_quote("$user: $comm");
2415 foreach my $media (keys %$medias) {
2417 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2419 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2420 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2421 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2424 $self->dbh_do($query);
2425 $self->debug($query);
2429 $q->param('action', 'update_location');
2430 my $url = $q->url(-full => 1, -query=>1);
2432 $self->display({ email => $self->{info}->{email_media},
2434 newlocation => $newloc,
2435 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2436 medias => [ values %$medias ],
2438 "change_location.tpl");
2442 sub display_client_stats
2444 my ($self, %arg) = @_ ;
2446 my $client = $self->dbh_quote($arg{clientname});
2447 my ($limit, $label) = $self->get_limit(%arg);
2451 count(Job.JobId) AS nb_jobs,
2452 sum(Job.JobBytes) AS nb_bytes,
2453 sum(Job.JobErrors) AS nb_err,
2454 sum(Job.JobFiles) AS nb_files,
2455 Client.Name AS clientname
2456 FROM Job INNER JOIN Client USING (ClientId)
2458 Client.Name = $client
2460 GROUP BY Client.Name
2463 my $row = $self->dbh_selectrow_hashref($query);
2465 $row->{ID} = $cur_id++;
2466 $row->{label} = $label;
2468 $self->display($row, "display_client_stats.tpl");
2471 # poolname can be undef
2474 my ($self, $poolname) = @_ ;
2478 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2479 if ($arg->{jmediatypes}) {
2480 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2481 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2484 # TODO : afficher les tailles et les dates
2487 SELECT subq.volmax AS volmax,
2488 subq.volnum AS volnum,
2489 subq.voltotal AS voltotal,
2491 Pool.Recycle AS recycle,
2492 Pool.VolRetention AS volretention,
2493 Pool.VolUseDuration AS voluseduration,
2494 Pool.MaxVolJobs AS maxvoljobs,
2495 Pool.MaxVolFiles AS maxvolfiles,
2496 Pool.MaxVolBytes AS maxvolbytes,
2497 subq.PoolId AS PoolId
2500 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2501 count(Media.MediaId) AS volnum,
2502 sum(Media.VolBytes) AS voltotal,
2503 Media.PoolId AS PoolId,
2504 Media.MediaType AS MediaType
2506 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2507 Media.MediaType AS MediaType
2509 WHERE Media.VolStatus = 'Full'
2510 GROUP BY Media.MediaType
2511 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2512 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2514 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2518 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2521 SELECT Pool.Name AS name,
2522 sum(VolBytes) AS size
2523 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2524 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2528 my $empty = $self->dbh_selectall_hashref($query, 'name');
2530 foreach my $p (values %$all) {
2531 if ($p->{volmax} > 0) { # mysql returns 0.0000
2532 # we remove Recycled/Purged media from pool usage
2533 if (defined $empty->{$p->{name}}) {
2534 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2536 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2538 $p->{poolusage} = 0;
2542 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2544 WHERE PoolId=$p->{poolid}
2548 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2549 foreach my $t (values %$content) {
2550 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2555 $self->display({ ID => $cur_id++,
2556 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2557 Pools => [ values %$all ]},
2558 "display_pool.tpl");
2561 sub display_running_job
2565 my $arg = $self->get_form('client', 'jobid');
2567 if (!$arg->{client} and $arg->{jobid}) {
2570 SELECT Client.Name AS name
2571 FROM Job INNER JOIN Client USING (ClientId)
2572 WHERE Job.JobId = $arg->{jobid}
2575 my $row = $self->dbh_selectrow_hashref($query);
2578 $arg->{client} = $row->{name};
2579 CGI::param('client', $arg->{client});
2583 if ($arg->{client}) {
2584 my $cli = new Bweb::Client(name => $arg->{client});
2585 $cli->display_running_job($self->{info}, $arg->{jobid});
2586 if ($arg->{jobid}) {
2587 $self->get_job_log();
2590 $self->error("Can't get client or jobid");
2594 sub display_running_jobs
2596 my ($self, $display_action) = @_;
2599 SELECT Job.JobId AS jobid,
2600 Job.Name AS jobname,
2602 Job.StartTime AS starttime,
2603 Job.JobFiles AS jobfiles,
2604 Job.JobBytes AS jobbytes,
2605 Job.JobStatus AS jobstatus,
2606 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2607 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2609 Client.Name AS clientname
2610 FROM Job INNER JOIN Client USING (ClientId)
2611 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2613 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2615 $self->display({ ID => $cur_id++,
2616 display_action => $display_action,
2617 Jobs => [ values %$all ]},
2618 "running_job.tpl") ;
2624 my $arg = $self->get_form('jmedias');
2626 unless ($arg->{jmedias}) {
2627 return $self->error("Can't get media selection");
2631 SELECT Media.VolumeName AS volumename,
2632 Storage.Name AS storage,
2633 Location.Location AS location,
2635 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2636 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2637 WHERE Media.VolumeName IN ($arg->{jmedias})
2638 AND Media.InChanger = 1
2641 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2643 foreach my $vol (values %$all) {
2644 my $a = $self->ach_get($vol->{location});
2647 unless ($a->{have_status}) {
2649 $a->{have_status} = 1;
2652 print "eject $vol->{volumename} from $vol->{storage} : ";
2653 if ($a->send_to_io($vol->{slot})) {
2665 my ($to, $subject, $content) = (CGI::param('email'),
2666 CGI::param('subject'),
2667 CGI::param('content'));
2668 $to =~ s/[^\w\d\.\@<>,]//;
2669 $subject =~ s/[^\w\d\.\[\]]/ /;
2671 open(MAIL, "|mail -s '$subject' '$to'") ;
2672 print MAIL $content;
2682 my $arg = $self->get_form('jobid', 'client');
2684 print CGI::header('text/brestore');
2685 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2686 print "client=$arg->{client}\n" if ($arg->{client});
2687 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2691 # TODO : move this to Bweb::Autochanger ?
2692 # TODO : make this internal to not eject tape ?
2698 my ($self, $name) = @_;
2701 return $self->error("Can't get your autochanger name ach");
2704 unless ($self->{info}->{ach_list}) {
2705 return $self->error("Could not find any autochanger");
2708 my $a = $self->{info}->{ach_list}->{$name};
2711 $self->error("Can't get your autochanger $name from your ach_list");
2722 my ($self, $ach) = @_;
2724 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2726 $self->{info}->save();
2734 my $arg = $self->get_form('ach');
2736 or !$self->{info}->{ach_list}
2737 or !$self->{info}->{ach_list}->{$arg->{ach}})
2739 return $self->error("Can't get autochanger name");
2742 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2746 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2748 my $b = $self->get_bconsole();
2750 my @storages = $b->list_storage() ;
2752 $ach->{devices} = [ map { { name => $_ } } @storages ];
2754 $self->display($ach, "ach_add.tpl");
2755 delete $ach->{drives};
2756 delete $ach->{devices};
2763 my $arg = $self->get_form('ach');
2766 or !$self->{info}->{ach_list}
2767 or !$self->{info}->{ach_list}->{$arg->{ach}})
2769 return $self->error("Can't get autochanger name");
2772 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2774 $self->{info}->save();
2775 $self->{info}->view();
2781 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2783 my $b = $self->get_bconsole();
2784 my @storages = $b->list_storage() ;
2786 unless ($arg->{ach}) {
2787 $arg->{devices} = [ map { { name => $_ } } @storages ];
2788 return $self->display($arg, "ach_add.tpl");
2792 foreach my $drive (CGI::param('drives'))
2794 unless (grep(/^$drive$/,@storages)) {
2795 return $self->error("Can't find $drive in storage list");
2798 my $index = CGI::param("index_$drive");
2799 unless (defined $index and $index =~ /^(\d+)$/) {
2800 return $self->error("Can't get $drive index");
2803 $drives[$index] = $drive;
2807 return $self->error("Can't get drives from Autochanger");
2810 my $a = new Bweb::Autochanger(name => $arg->{ach},
2811 precmd => $arg->{precmd},
2812 drive_name => \@drives,
2813 device => $arg->{device},
2814 mtxcmd => $arg->{mtxcmd});
2816 $self->ach_register($a) ;
2818 $self->{info}->view();
2824 my $arg = $self->get_form('jobid');
2826 if ($arg->{jobid}) {
2827 my $b = $self->get_bconsole();
2828 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2832 title => "Delete a job ",
2833 name => "delete jobid=$arg->{jobid}",
2842 my $arg = $self->get_form(qw/media volstatus inchanger pool
2843 slot volretention voluseduration
2844 maxvoljobs maxvolfiles maxvolbytes
2845 qcomment poolrecycle
2848 unless ($arg->{media}) {
2849 return $self->error("Can't find media selection");
2852 my $update = "update volume=$arg->{media} ";
2854 if ($arg->{volstatus}) {
2855 $update .= " volstatus=$arg->{volstatus} ";
2858 if ($arg->{inchanger}) {
2859 $update .= " inchanger=yes " ;
2861 $update .= " slot=$arg->{slot} ";
2864 $update .= " slot=0 inchanger=no ";
2868 $update .= " pool=$arg->{pool} " ;
2871 $arg->{volretention} ||= 0 ;
2872 if ($arg->{volretention}) {
2873 $update .= " volretention=\"$arg->{volretention}\" " ;
2876 $arg->{voluseduration} ||= 0 ;
2877 if ($arg->{voluseduration}) {
2878 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2881 $arg->{maxvoljobs} ||= 0;
2882 if ($arg->{maxvoljobs}) {
2883 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2886 $arg->{maxvolfiles} ||= 0;
2887 if ($arg->{maxvolfiles}) {
2888 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2891 $arg->{maxvolbytes} ||= 0;
2892 if ($arg->{maxvolbytes}) {
2893 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2896 my $b = $self->get_bconsole();
2899 content => $b->send_cmd($update),
2900 title => "Update a volume ",
2906 my $media = $self->dbh_quote($arg->{media});
2908 my $loc = CGI::param('location') || '';
2910 $loc = $self->dbh_quote($loc); # is checked by db
2911 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2913 if ($arg->{poolrecycle}) {
2914 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2916 if (!$arg->{qcomment}) {
2917 $arg->{qcomment} = "''";
2919 push @q, "Comment=$arg->{qcomment}";
2924 SET " . join (',', @q) . "
2925 WHERE Media.VolumeName = $media
2927 $self->dbh_do($query);
2929 $self->update_media();
2936 my $ach = CGI::param('ach') ;
2937 $ach = $self->ach_get($ach);
2939 return $self->error("Bad autochanger name");
2943 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2944 $b->update_slots($ach->{name});
2952 my $arg = $self->get_form('jobid');
2953 unless ($arg->{jobid}) {
2954 return $self->error("Can't get jobid");
2957 my $t = CGI::param('time') || '';
2960 SELECT Job.Name as name, Client.Name as clientname
2961 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2962 WHERE JobId = $arg->{jobid}
2965 my $row = $self->dbh_selectrow_hashref($query);
2968 return $self->error("Can't find $arg->{jobid} in catalog");
2972 SELECT Time AS time, LogText AS log
2974 WHERE Log.JobId = $arg->{jobid}
2975 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2976 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2981 my $log = $self->dbh_selectall_arrayref($query);
2983 return $self->error("Can't get log for jobid $arg->{jobid}");
2989 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2991 $logtxt = join("", map { $_->[1] } @$log ) ;
2994 $self->display({ lines=> $logtxt,
2995 jobid => $arg->{jobid},
2996 name => $row->{name},
2997 client => $row->{clientname},
2998 }, 'display_log.tpl');
3006 my $arg = $self->get_form('ach', 'slots', 'drive');
3008 unless ($arg->{ach}) {
3009 return $self->error("Can't find autochanger name");
3014 if ($arg->{slots}) {
3015 $slots = join(",", @{ $arg->{slots} });
3016 $t += 60*scalar( @{ $arg->{slots} }) ;
3019 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3020 print "<h1>This command can take long time, be patient...</h1>";
3022 $b->label_barcodes(storage => $arg->{ach},
3023 drive => $arg->{drive},
3034 my @volume = CGI::param('media');
3037 return $self->error("Can't get media selection");
3040 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3043 content => $b->purge_volume(@volume),
3044 title => "Purge media",
3045 name => "purge volume=" . join(' volume=', @volume),
3054 my @volume = CGI::param('media');
3056 return $self->error("Can't get media selection");
3059 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3062 content => $b->prune_volume(@volume),
3063 title => "Prune media",
3064 name => "prune volume=" . join(' volume=', @volume),
3074 my $arg = $self->get_form('jobid');
3075 unless ($arg->{jobid}) {
3076 return $self->error("Can't get jobid");
3079 my $b = $self->get_bconsole();
3081 content => $b->cancel($arg->{jobid}),
3082 title => "Cancel job",
3083 name => "cancel jobid=$arg->{jobid}",
3089 # Warning, we display current fileset
3092 my $arg = $self->get_form('fileset');
3094 if ($arg->{fileset}) {
3095 my $b = $self->get_bconsole();
3096 my $ret = $b->get_fileset($arg->{fileset});
3097 $self->display({ fileset => $arg->{fileset},
3099 }, "fileset_view.tpl");
3101 $self->error("Can't get fileset name");
3105 sub director_show_sched
3109 my $arg = $self->get_form('days');
3111 my $b = $self->get_bconsole();
3112 my $ret = $b->director_get_sched( $arg->{days} );
3117 }, "scheduled_job.tpl");
3120 sub enable_disable_job
3122 my ($self, $what) = @_ ;
3124 my $name = CGI::param('job') || '';
3125 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3126 return $self->error("Can't find job name");
3129 my $b = $self->get_bconsole();
3139 content => $b->send_cmd("$cmd job=\"$name\""),
3140 title => "$cmd $name",
3141 name => "$cmd job=\"$name\"",
3148 return new Bconsole(pref => $self->{info});
3154 my $b = $self->get_bconsole();
3156 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3158 $self->display({ Jobs => $joblist }, "run_job.tpl");
3163 my ($self, $ouput) = @_;
3166 foreach my $l (split(/\r\n/, $ouput)) {
3167 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3173 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3179 foreach my $k (keys %arg) {
3180 $lowcase{lc($k)} = $arg{$k} ;
3189 my $b = $self->get_bconsole();
3191 my $job = CGI::param('job') || '';
3193 my $info = $b->send_cmd("show job=\"$job\"");
3194 my $attr = $self->run_parse_job($info);
3196 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3198 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3199 my $clients = [ map { { name => $_ } }$b->list_client()];
3200 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3201 my $storages= [ map { { name => $_ } }$b->list_storage()];
3206 clients => $clients,
3207 filesets => $filesets,
3208 storages => $storages,
3210 }, "run_job_mod.tpl");
3216 my $b = $self->get_bconsole();
3218 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3228 my $b = $self->get_bconsole();
3230 # TODO: check input (don't use pool, level)
3232 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3233 my $job = CGI::param('job') || '';
3234 my $storage = CGI::param('storage') || '';
3236 my $jobid = $b->run(job => $job,
3237 client => $arg->{client},
3238 priority => $arg->{priority},
3239 level => $arg->{level},
3240 storage => $storage,
3241 pool => $arg->{pool},
3242 when => $arg->{when},
3245 print $jobid, $b->{error};
3247 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";