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!^(.+)?$!,
218 stat_job_table => qr!^(\w*)$!,
223 load - load config_file
227 this function load the specified config_file.
235 unless (open(FP, $self->{config_file}))
237 return $self->error("can't load config_file $self->{config_file} : $!");
239 my $f=''; my $tmpbuffer;
240 while(read FP,$tmpbuffer,4096)
248 no strict; # I have no idea of the contents of the file
255 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...") ;
258 foreach my $k (keys %$VAR1) {
259 $self->{$k} = $VAR1->{$k};
267 load_old - load old configuration format
275 unless (open(FP, $self->{config_file}))
277 return $self->error("$self->{config_file} : $!");
280 while (my $line = <FP>)
283 my ($k, $v) = split(/\s*=\s*/, $line, 2);
295 save - save the current configuration to config_file
303 if ($self->{ach_list}) {
304 # shortcut for display_begin
305 $self->{achs} = [ map {{ name => $_ }}
306 keys %{$self->{ach_list}}
310 unless (open(FP, ">$self->{config_file}"))
312 return $self->error("$self->{config_file} : $!\n" .
313 "You must add this to your config file\n"
314 . Data::Dumper::Dumper($self));
317 print FP Data::Dumper::Dumper($self);
325 edit, view, modify - html form ouput
333 $self->display($self, "config_edit.tpl");
339 $self->display($self, "config_view.tpl");
349 foreach my $k (CGI::param())
351 next unless (exists $k_re{$k}) ;
352 my $val = CGI::param($k);
353 if ($val =~ $k_re{$k}) {
356 $self->{error} .= "bad parameter : $k = [$val]";
362 if ($self->{error}) { # an error as occured
363 $self->display($self, 'error.tpl');
371 ################################################################
373 package Bweb::Client;
375 use base q/Bweb::Gui/;
379 Bweb::Client - Bacula FD
383 this package is use to do all Client operations like, parse status etc...
387 $client = new Bweb::Client(name => 'zog-fd');
388 $client->status(); # do a 'status client=zog-fd'
394 display_running_job - Html display of a running job
398 this function is used to display information about a current job
402 sub display_running_job
404 my ($self, $conf, $jobid) = @_ ;
406 my $status = $self->status($conf);
409 if ($status->{$jobid}) {
410 $self->display($status->{$jobid}, "client_job_status.tpl");
413 for my $id (keys %$status) {
414 $self->display($status->{$id}, "client_job_status.tpl");
421 $client = new Bweb::Client(name => 'plume-fd');
423 $client->status($bweb);
427 dirty hack to parse "status client=xxx-fd"
431 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
432 Backup Job started: 06-jun-06 17:22
433 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
434 Files Examined=10,697
435 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
441 JobName => Full_plume.2006-06-06_17.22.23,
444 Bytes => 194,484,132,
454 my ($self, $conf) = @_ ;
456 if (defined $self->{cur_jobs}) {
457 return $self->{cur_jobs} ;
461 my $b = new Bconsole(pref => $conf);
462 my $ret = $b->send_cmd("st client=$self->{name}");
466 for my $r (split(/\n/, $ret)) {
468 $r =~ s/(^\s+|\s+$)//g;
469 if ($r =~ /JobId (\d+) Job (\S+)/) {
471 $arg->{$jobid} = { @param, JobId => $jobid } ;
475 @param = ( JobName => $2 );
477 } elsif ($r =~ /=.+=/) {
478 push @param, split(/\s+|\s*=\s*/, $r) ;
480 } elsif ($r =~ /=/) { # one per line
481 push @param, split(/\s*=\s*/, $r) ;
483 } elsif ($r =~ /:/) { # one per line
484 push @param, split(/\s*:\s*/, $r, 2) ;
488 if ($jobid and @param) {
489 $arg->{$jobid} = { @param,
491 Client => $self->{name},
495 $self->{cur_jobs} = $arg ;
501 ################################################################
503 package Bweb::Autochanger;
505 use base q/Bweb::Gui/;
509 Bweb::Autochanger - Object to manage Autochanger
513 this package will parse the mtx output and manage drives.
517 $auto = new Bweb::Autochanger(precmd => 'sudo');
519 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
523 $auto->slot_is_full(10);
524 $auto->transfer(10, 11);
530 my ($class, %arg) = @_;
533 name => '', # autochanger name
534 label => {}, # where are volume { label1 => 40, label2 => drive0 }
535 drive => [], # drive use [ 'media1', 'empty', ..]
536 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
537 io => [], # io slot number list [ 41, 42, 43...]
538 info => {slot => 0, # informations (slot, drive, io)
542 mtxcmd => '/usr/sbin/mtx',
544 device => '/dev/changer',
545 precmd => '', # ssh command
546 bweb => undef, # link to bacula web object (use for display)
549 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
556 status - parse the output of mtx status
560 this function will launch mtx status and parse the output. it will
561 give a perlish view of the autochanger content.
563 it uses ssh if the autochanger is on a other host.
570 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
572 # TODO : reset all infos
573 $self->{info}->{drive} = 0;
574 $self->{info}->{slot} = 0;
575 $self->{info}->{io} = 0;
577 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
580 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
581 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
582 #Data Transfer Element 1:Empty
583 # Storage Element 1:Empty
584 # Storage Element 2:Full :VolumeTag=000002
585 # Storage Element 3:Empty
586 # Storage Element 4:Full :VolumeTag=000004
587 # Storage Element 5:Full :VolumeTag=000001
588 # Storage Element 6:Full :VolumeTag=000003
589 # Storage Element 7:Empty
590 # Storage Element 41 IMPORT/EXPORT:Empty
591 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
596 # Storage Element 7:Empty
597 # Storage Element 2:Full :VolumeTag=000002
598 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
601 $self->set_empty_slot($1);
603 $self->set_slot($1, $4);
606 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
609 $self->set_empty_drive($1);
611 $self->set_drive($1, $4, $6);
614 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
617 $self->set_empty_io($1);
619 $self->set_io($1, $4);
622 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
624 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
625 $self->{info}->{drive} = $1;
626 $self->{info}->{slot} = $2;
627 if ($l =~ /(\d+)\s+Import/) {
628 $self->{info}->{io} = $1 ;
630 $self->{info}->{io} = 0;
635 $self->debug($self) ;
640 my ($self, $slot) = @_;
643 if ($self->{slot}->[$slot] eq 'loaded') {
647 my $label = $self->{slot}->[$slot] ;
649 return $self->is_media_loaded($label);
654 my ($self, $drive, $slot) = @_;
656 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
657 return 0 if ($self->slot_is_full($slot)) ;
659 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
662 my $content = $self->get_slot($slot);
663 print "content = $content<br/> $drive => $slot<br/>";
664 $self->set_empty_drive($drive);
665 $self->set_slot($slot, $content);
668 $self->{error} = $out;
673 # TODO: load/unload have to use mtx script from bacula
676 my ($self, $drive, $slot) = @_;
678 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
679 return 0 unless ($self->slot_is_full($slot)) ;
681 print "Loading drive $drive with slot $slot<br/>\n";
682 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
685 my $content = $self->get_slot($slot);
686 print "content = $content<br/> $slot => $drive<br/>";
687 $self->set_drive($drive, $slot, $content);
690 $self->{error} = $out;
698 my ($self, $media) = @_;
700 unless ($self->{label}->{$media}) {
704 if ($self->{label}->{$media} =~ /drive\d+/) {
714 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
719 my ($self, $slot, $tag) = @_;
720 $self->{slot}->[$slot] = $tag || 'full';
721 push @{ $self->{io} }, $slot;
724 $self->{label}->{$tag} = $slot;
730 my ($self, $slot) = @_;
732 push @{ $self->{io} }, $slot;
734 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
735 $self->{slot}->[$slot] = 'empty';
741 my ($self, $slot) = @_;
742 return $self->{slot}->[$slot];
747 my ($self, $slot, $tag) = @_;
748 $self->{slot}->[$slot] = $tag || 'full';
751 $self->{label}->{$tag} = $slot;
757 my ($self, $slot) = @_;
759 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
760 $self->{slot}->[$slot] = 'empty';
766 my ($self, $drive) = @_;
767 $self->{drive}->[$drive] = 'empty';
772 my ($self, $drive, $slot, $tag) = @_;
773 $self->{drive}->[$drive] = $tag || $slot;
775 $self->{slot}->[$slot] = $tag || 'loaded';
778 $self->{label}->{$tag} = "drive$drive";
784 my ($self, $slot) = @_;
786 # slot don't exists => full
787 if (not defined $self->{slot}->[$slot]) {
791 if ($self->{slot}->[$slot] eq 'empty') {
794 return 1; # vol, full, loaded
797 sub slot_get_first_free
800 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
801 return $slot unless ($self->slot_is_full($slot));
805 sub io_get_first_free
809 foreach my $slot (@{ $self->{io} }) {
810 return $slot unless ($self->slot_is_full($slot));
817 my ($self, $media) = @_;
819 return $self->{label}->{$media} ;
824 my ($self, $media) = @_;
826 return defined $self->{label}->{$media} ;
831 my ($self, $slot) = @_;
833 unless ($self->slot_is_full($slot)) {
834 print "Autochanger $self->{name} slot $slot is empty\n";
839 if ($self->is_slot_loaded($slot)) {
842 print "Autochanger $self->{name} $slot is currently in use\n";
846 # autochanger must have I/O
847 unless ($self->have_io()) {
848 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
852 my $dst = $self->io_get_first_free();
855 print "Autochanger $self->{name} you must empty I/O first\n";
858 $self->transfer($slot, $dst);
863 my ($self, $src, $dst) = @_ ;
864 if ($self->{debug}) {
865 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
867 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
870 my $content = $self->get_slot($src);
871 $self->{slot}->[$src] = 'empty';
872 $self->set_slot($dst, $content);
875 $self->{error} = $out;
882 my ($self, $index) = @_;
883 return $self->{drive_name}->[$index];
886 # TODO : do a tapeinfo request to get informations
896 for my $slot (@{$self->{io}})
898 if ($self->is_slot_loaded($slot)) {
899 print "$slot is currently loaded\n";
903 if ($self->slot_is_full($slot))
905 my $free = $self->slot_get_first_free() ;
906 print "move $slot to $free :\n";
909 if ($self->transfer($slot, $free)) {
910 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
912 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
916 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
922 # TODO : this is with mtx status output,
923 # we can do an other function from bacula view (with StorageId)
927 my $bweb = $self->{bweb};
929 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
930 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
933 SELECT Media.VolumeName AS volumename,
934 Media.VolStatus AS volstatus,
935 Media.LastWritten AS lastwritten,
936 Media.VolBytes AS volbytes,
937 Media.MediaType AS mediatype,
939 Media.InChanger AS inchanger,
941 $bweb->{sql}->{FROM_UNIXTIME}(
942 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
943 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
946 INNER JOIN Pool USING (PoolId)
948 WHERE Media.VolumeName IN ($media_list)
951 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
953 # TODO : verify slot and bacula slot
957 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
959 if ($self->slot_is_full($slot)) {
961 my $vol = $self->{slot}->[$slot];
962 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
964 my $bslot = $all->{$vol}->{slot} ;
965 my $inchanger = $all->{$vol}->{inchanger};
967 # if bacula slot or inchanger flag is bad, we display a message
968 if ($bslot != $slot or !$inchanger) {
969 push @to_update, $slot;
972 $all->{$vol}->{realslot} = $slot;
974 push @{ $param }, $all->{$vol};
976 } else { # empty or no label
977 push @{ $param }, {realslot => $slot,
978 volstatus => 'Unknow',
979 volumename => $self->{slot}->[$slot]} ;
982 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
986 my $i=0; my $drives = [] ;
987 foreach my $d (@{ $self->{drive} }) {
988 $drives->[$i] = { index => $i,
989 load => $self->{drive}->[$i],
990 name => $self->{drive_name}->[$i],
995 $bweb->display({ Name => $self->{name},
996 nb_drive => $self->{info}->{drive},
997 nb_io => $self->{info}->{io},
1000 Update => scalar(@to_update) },
1008 ################################################################
1012 use base q/Bweb::Gui/;
1016 Bweb - main Bweb package
1020 this package is use to compute and display informations
1025 use POSIX qw/strftime/;
1027 our $config_file='/etc/bacula/bweb.conf';
1033 %sql_func - hash to make query mysql/postgresql compliant
1039 UNIX_TIMESTAMP => '',
1040 FROM_UNIXTIME => '',
1041 TO_SEC => " interval '1 second' * ",
1042 SEC_TO_INT => "SEC_TO_INT",
1045 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1046 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1047 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1048 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1049 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1050 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1053 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1054 FROM_UNIXTIME => 'FROM_UNIXTIME',
1057 SEC_TO_TIME => 'SEC_TO_TIME',
1058 MATCH => " REGEXP ",
1059 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1060 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1061 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1062 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1063 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1064 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1068 sub dbh_selectall_arrayref
1070 my ($self, $query) = @_;
1071 $self->connect_db();
1072 $self->debug($query);
1073 return $self->{dbh}->selectall_arrayref($query);
1078 my ($self, @what) = @_;
1079 return join(',', $self->dbh_quote(@what)) ;
1084 my ($self, @what) = @_;
1086 $self->connect_db();
1088 return map { $self->{dbh}->quote($_) } @what;
1090 return $self->{dbh}->quote($what[0]) ;
1096 my ($self, $query) = @_ ;
1097 $self->connect_db();
1098 $self->debug($query);
1099 return $self->{dbh}->do($query);
1102 sub dbh_selectall_hashref
1104 my ($self, $query, $join) = @_;
1106 $self->connect_db();
1107 $self->debug($query);
1108 return $self->{dbh}->selectall_hashref($query, $join) ;
1111 sub dbh_selectrow_hashref
1113 my ($self, $query) = @_;
1115 $self->connect_db();
1116 $self->debug($query);
1117 return $self->{dbh}->selectrow_hashref($query) ;
1123 my @unit = qw(b Kb Mb Gb Tb);
1124 my $val = shift || 0;
1126 my $format = '%i %s';
1127 while ($val / 1024 > 1) {
1131 $format = ($i>0)?'%0.1f %s':'%i %s';
1132 return sprintf($format, $val, $unit[$i]);
1135 # display Day, Hour, Year
1141 $val /= 60; # sec -> min
1143 if ($val / 60 <= 1) {
1147 $val /= 60; # min -> hour
1148 if ($val / 24 <= 1) {
1149 return "$val hours";
1152 $val /= 24; # hour -> day
1153 if ($val / 365 < 2) {
1157 $val /= 365 ; # day -> year
1159 return "$val years";
1162 # get Day, Hour, Year
1168 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1172 my %times = ( m => 60,
1178 my $mult = $times{$2} || 0;
1188 unless ($self->{dbh}) {
1189 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1190 $self->{info}->{user},
1191 $self->{info}->{password});
1193 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1194 unless ($self->{dbh});
1196 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1198 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1199 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1206 my ($class, %arg) = @_;
1208 dbh => undef, # connect_db();
1210 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1216 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1218 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1219 $self->{sql} = $sql_func{$1};
1222 $self->{debug} = $self->{info}->{debug};
1223 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1231 $self->display($self->{info}, "begin.tpl");
1237 $self->display($self->{info}, "end.tpl");
1245 my $arg = $self->get_form("client", "qre_client");
1247 if ($arg->{qre_client}) {
1248 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1249 } elsif ($arg->{client}) {
1250 $where = "WHERE Name = '$arg->{client}' ";
1254 SELECT Name AS name,
1256 AutoPrune AS autoprune,
1257 FileRetention AS fileretention,
1258 JobRetention AS jobretention
1263 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1265 my $dsp = { ID => $cur_id++,
1266 clients => [ values %$all] };
1268 $self->display($dsp, "client_list.tpl") ;
1273 my ($self, %arg) = @_;
1280 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1282 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1284 $self->{sql}->{TO_SEC}($arg{age})
1287 $label = "last " . human_sec($arg{age});
1290 if ($arg{groupby}) {
1291 $limit .= " GROUP BY $arg{groupby} ";
1295 $limit .= " ORDER BY $arg{order} ";
1299 $limit .= " LIMIT $arg{limit} ";
1300 $label .= " limited to $arg{limit}";
1304 $limit .= " OFFSET $arg{offset} ";
1305 $label .= " with $arg{offset} offset ";
1309 $label = 'no filter';
1312 return ($limit, $label);
1317 $bweb->get_form(...) - Get useful stuff
1321 This function get and check parameters against regexp.
1323 If word begin with 'q', the return will be quoted or join quoted
1324 if it's end with 's'.
1329 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1332 qclient => 'plume-fd',
1333 qpools => "'plume-fd', 'test-fd', '...'",
1340 my ($self, @what) = @_;
1341 my %what = map { $_ => 1 } @what;
1361 my %opt_ss =( # string with space
1365 my %opt_s = ( # default to ''
1382 my %opt_p = ( # option with path
1390 my %opt_d = ( # option with date
1395 foreach my $i (@what) {
1396 if (exists $opt_i{$i}) {# integer param
1397 my $value = CGI::param($i) || $opt_i{$i} ;
1398 if ($value =~ /^(\d+)$/) {
1401 } elsif ($opt_s{$i}) { # simple string param
1402 my $value = CGI::param($i) || '';
1403 if ($value =~ /^([\w\d\.-]+)$/) {
1406 } elsif ($opt_ss{$i}) { # simple string param (with space)
1407 my $value = CGI::param($i) || '';
1408 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1411 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1412 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1414 $ret{$i} = $self->dbh_join(@value) ;
1417 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1418 my $value = CGI::param($1) ;
1420 $ret{$i} = $self->dbh_quote($value);
1423 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1424 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1425 grep { ! /^\s*$/ } CGI::param($1) ];
1426 } elsif (exists $opt_p{$i}) {
1427 my $value = CGI::param($i) || '';
1428 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1431 } elsif (exists $opt_d{$i}) {
1432 my $value = CGI::param($i) || '';
1433 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1440 foreach my $s (CGI::param('slot')) {
1441 if ($s =~ /^(\d+)$/) {
1442 push @{$ret{slots}}, $s;
1448 my $when = CGI::param('when') || '';
1449 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1454 if ($what{db_clients}) {
1456 SELECT Client.Name as clientname
1460 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1461 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1465 if ($what{db_mediatypes}) {
1467 SELECT MediaType as mediatype
1471 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1472 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1476 if ($what{db_locations}) {
1478 SELECT Location as location, Cost as cost FROM Location
1480 my $loc = $self->dbh_selectall_hashref($query, 'location');
1481 $ret{db_locations} = [ sort { $a->{location}
1487 if ($what{db_pools}) {
1488 my $query = "SELECT Name as name FROM Pool";
1490 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1491 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1494 if ($what{db_filesets}) {
1496 SELECT FileSet.FileSet AS fileset
1500 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1502 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1503 values %$filesets] ;
1506 if ($what{db_jobnames}) {
1508 SELECT DISTINCT Job.Name AS jobname
1512 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1514 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1515 values %$jobnames] ;
1518 if ($what{db_devices}) {
1520 SELECT Device.Name AS name
1524 my $devices = $self->dbh_selectall_hashref($query, 'name');
1526 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1537 my $fields = $self->get_form(qw/age level status clients filesets
1539 db_clients limit db_filesets width height
1540 qclients qfilesets qjobnames db_jobnames/);
1543 my $url = CGI::url(-full => 0,
1546 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1548 # this organisation is to keep user choice between 2 click
1549 # TODO : fileset and client selection doesn't work
1558 sub display_client_job
1560 my ($self, %arg) = @_ ;
1562 $arg{order} = ' Job.JobId DESC ';
1563 my ($limit, $label) = $self->get_limit(%arg);
1565 my $clientname = $self->dbh_quote($arg{clientname});
1568 SELECT DISTINCT Job.JobId AS jobid,
1569 Job.Name AS jobname,
1570 FileSet.FileSet AS fileset,
1572 StartTime AS starttime,
1573 JobFiles AS jobfiles,
1574 JobBytes AS jobbytes,
1575 JobStatus AS jobstatus,
1576 JobErrors AS joberrors
1578 FROM Client,Job,FileSet
1579 WHERE Client.Name=$clientname
1580 AND Client.ClientId=Job.ClientId
1581 AND Job.FileSetId=FileSet.FileSetId
1585 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1587 $self->display({ clientname => $arg{clientname},
1590 Jobs => [ values %$all ],
1592 "display_client_job.tpl") ;
1595 sub get_selected_media_location
1599 my $medias = $self->get_form('jmedias');
1601 unless ($medias->{jmedias}) {
1606 SELECT Media.VolumeName AS volumename, Location.Location AS location
1607 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1608 WHERE Media.VolumeName IN ($medias->{jmedias})
1611 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1613 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1624 my $medias = $self->get_selected_media_location();
1630 my $elt = $self->get_form('db_locations');
1632 $self->display({ ID => $cur_id++,
1633 %$elt, # db_locations
1635 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1645 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1647 $self->display($elt, "help_extern.tpl");
1650 sub help_extern_compute
1654 my $number = CGI::param('limit') || '' ;
1655 unless ($number =~ /^(\d+)$/) {
1656 return $self->error("Bad arg number : $number ");
1659 my ($sql, undef) = $self->get_param('pools',
1660 'locations', 'mediatypes');
1663 SELECT Media.VolumeName AS volumename,
1664 Media.VolStatus AS volstatus,
1665 Media.LastWritten AS lastwritten,
1666 Media.MediaType AS mediatype,
1667 Media.VolMounts AS volmounts,
1669 Media.Recycle AS recycle,
1670 $self->{sql}->{FROM_UNIXTIME}(
1671 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1672 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1675 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1676 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1678 WHERE Media.InChanger = 1
1679 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1681 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1685 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1687 $self->display({ Medias => [ values %$all ] },
1688 "help_extern_compute.tpl");
1695 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1696 $self->display($param, "help_intern.tpl");
1699 sub help_intern_compute
1703 my $number = CGI::param('limit') || '' ;
1704 unless ($number =~ /^(\d+)$/) {
1705 return $self->error("Bad arg number : $number ");
1708 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1710 if (CGI::param('expired')) {
1712 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1713 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1719 SELECT Media.VolumeName AS volumename,
1720 Media.VolStatus AS volstatus,
1721 Media.LastWritten AS lastwritten,
1722 Media.MediaType AS mediatype,
1723 Media.VolMounts AS volmounts,
1725 $self->{sql}->{FROM_UNIXTIME}(
1726 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1727 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1730 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1731 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1733 WHERE Media.InChanger <> 1
1734 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1735 AND Media.Recycle = 1
1737 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1741 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1743 $self->display({ Medias => [ values %$all ] },
1744 "help_intern_compute.tpl");
1750 my ($self, %arg) = @_ ;
1752 my ($limit, $label) = $self->get_limit(%arg);
1756 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1757 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1758 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1759 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1760 (SELECT count(Job.JobId)
1762 WHERE Job.JobStatus IN ('E','e','f','A')
1765 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1768 my $row = $self->dbh_selectrow_hashref($query) ;
1770 $row->{nb_bytes} = human_size($row->{nb_bytes});
1772 $row->{db_size} = '???';
1773 $row->{label} = $label;
1775 $self->display($row, "general.tpl");
1780 my ($self, @what) = @_ ;
1781 my %elt = map { $_ => 1 } @what;
1786 if ($elt{clients}) {
1787 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1789 $ret{clients} = \@clients;
1790 my $str = $self->dbh_join(@clients);
1791 $limit .= "AND Client.Name IN ($str) ";
1795 if ($elt{filesets}) {
1796 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1798 $ret{filesets} = \@filesets;
1799 my $str = $self->dbh_join(@filesets);
1800 $limit .= "AND FileSet.FileSet IN ($str) ";
1804 if ($elt{mediatypes}) {
1805 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1807 $ret{mediatypes} = \@medias;
1808 my $str = $self->dbh_join(@medias);
1809 $limit .= "AND Media.MediaType IN ($str) ";
1814 my $client = CGI::param('client');
1815 $ret{client} = $client;
1816 $client = $self->dbh_join($client);
1817 $limit .= "AND Client.Name = $client ";
1821 my $level = CGI::param('level') || '';
1822 if ($level =~ /^(\w)$/) {
1824 $limit .= "AND Job.Level = '$1' ";
1829 my $jobid = CGI::param('jobid') || '';
1831 if ($jobid =~ /^(\d+)$/) {
1833 $limit .= "AND Job.JobId = '$1' ";
1838 my $status = CGI::param('status') || '';
1839 if ($status =~ /^(\w)$/) {
1842 $limit .= "AND Job.JobStatus IN ('f','E') ";
1844 $limit .= "AND Job.JobStatus = '$1' ";
1849 if ($elt{volstatus}) {
1850 my $status = CGI::param('volstatus') || '';
1851 if ($status =~ /^(\w+)$/) {
1853 $limit .= "AND Media.VolStatus = '$1' ";
1857 if ($elt{locations}) {
1858 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1860 $ret{locations} = \@location;
1861 my $str = $self->dbh_join(@location);
1862 $limit .= "AND Location.Location IN ($str) ";
1867 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1869 $ret{pools} = \@pool;
1870 my $str = $self->dbh_join(@pool);
1871 $limit .= "AND Pool.Name IN ($str) ";
1875 if ($elt{location}) {
1876 my $location = CGI::param('location') || '';
1878 $ret{location} = $location;
1879 $location = $self->dbh_quote($location);
1880 $limit .= "AND Location.Location = $location ";
1885 my $pool = CGI::param('pool') || '';
1888 $pool = $self->dbh_quote($pool);
1889 $limit .= "AND Pool.Name = $pool ";
1893 if ($elt{jobtype}) {
1894 my $jobtype = CGI::param('jobtype') || '';
1895 if ($jobtype =~ /^(\w)$/) {
1897 $limit .= "AND Job.Type = '$1' ";
1901 return ($limit, %ret);
1912 my ($self, %arg) = @_ ;
1914 $arg{order} = ' Job.JobId DESC ';
1916 my ($limit, $label) = $self->get_limit(%arg);
1917 my ($where, undef) = $self->get_param('clients',
1926 SELECT Job.JobId AS jobid,
1927 Client.Name AS client,
1928 FileSet.FileSet AS fileset,
1929 Job.Name AS jobname,
1931 StartTime AS starttime,
1933 Pool.Name AS poolname,
1934 JobFiles AS jobfiles,
1935 JobBytes AS jobbytes,
1936 JobStatus AS jobstatus,
1937 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1938 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1941 JobErrors AS joberrors
1944 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1945 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1946 WHERE Client.ClientId=Job.ClientId
1947 AND Job.JobStatus != 'R'
1952 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1954 $self->display({ Filter => $label,
1958 sort { $a->{jobid} <=> $b->{jobid} }
1965 # display job informations
1966 sub display_job_zoom
1968 my ($self, $jobid) = @_ ;
1970 $jobid = $self->dbh_quote($jobid);
1973 SELECT DISTINCT Job.JobId AS jobid,
1974 Client.Name AS client,
1975 Job.Name AS jobname,
1976 FileSet.FileSet AS fileset,
1978 Pool.Name AS poolname,
1979 StartTime AS starttime,
1980 JobFiles AS jobfiles,
1981 JobBytes AS jobbytes,
1982 JobStatus AS jobstatus,
1983 JobErrors AS joberrors,
1984 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1985 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1988 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1989 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1990 WHERE Client.ClientId=Job.ClientId
1991 AND Job.JobId = $jobid
1994 my $row = $self->dbh_selectrow_hashref($query) ;
1996 # display all volumes associate with this job
1998 SELECT Media.VolumeName as volumename
1999 FROM Job,Media,JobMedia
2000 WHERE Job.JobId = $jobid
2001 AND JobMedia.JobId=Job.JobId
2002 AND JobMedia.MediaId=Media.MediaId
2005 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2007 $row->{volumes} = [ values %$all ] ;
2009 $self->display($row, "display_job_zoom.tpl");
2016 my ($where, %elt) = $self->get_param('pools',
2021 my $arg = $self->get_form('jmedias', 'qre_media');
2023 if ($arg->{jmedias}) {
2024 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2026 if ($arg->{qre_media}) {
2027 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2031 SELECT Media.VolumeName AS volumename,
2032 Media.VolBytes AS volbytes,
2033 Media.VolStatus AS volstatus,
2034 Media.MediaType AS mediatype,
2035 Media.InChanger AS online,
2036 Media.LastWritten AS lastwritten,
2037 Location.Location AS location,
2038 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2039 Pool.Name AS poolname,
2040 $self->{sql}->{FROM_UNIXTIME}(
2041 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2042 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2045 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2046 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2047 Media.MediaType AS MediaType
2049 WHERE Media.VolStatus = 'Full'
2050 GROUP BY Media.MediaType
2051 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2053 WHERE Media.PoolId=Pool.PoolId
2057 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2059 $self->display({ ID => $cur_id++,
2061 Location => $elt{location},
2062 Medias => [ values %$all ]
2064 "display_media.tpl");
2071 my $pool = $self->get_form('db_pools');
2073 foreach my $name (@{ $pool->{db_pools} }) {
2074 CGI::param('pool', $name->{name});
2075 $self->display_media();
2079 sub display_media_zoom
2083 my $medias = $self->get_form('jmedias');
2085 unless ($medias->{jmedias}) {
2086 return $self->error("Can't get media selection");
2090 SELECT InChanger AS online,
2091 VolBytes AS nb_bytes,
2092 VolumeName AS volumename,
2093 VolStatus AS volstatus,
2094 VolMounts AS nb_mounts,
2095 Media.VolUseDuration AS voluseduration,
2096 Media.MaxVolJobs AS maxvoljobs,
2097 Media.MaxVolFiles AS maxvolfiles,
2098 Media.MaxVolBytes AS maxvolbytes,
2099 VolErrors AS nb_errors,
2100 Pool.Name AS poolname,
2101 Location.Location AS location,
2102 Media.Recycle AS recycle,
2103 Media.VolRetention AS volretention,
2104 Media.LastWritten AS lastwritten,
2105 Media.VolReadTime/1000000 AS volreadtime,
2106 Media.VolWriteTime/1000000 AS volwritetime,
2107 Media.RecycleCount AS recyclecount,
2108 Media.Comment AS comment,
2109 $self->{sql}->{FROM_UNIXTIME}(
2110 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2111 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2114 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2115 WHERE Pool.PoolId = Media.PoolId
2116 AND VolumeName IN ($medias->{jmedias})
2119 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2121 foreach my $media (values %$all) {
2122 my $mq = $self->dbh_quote($media->{volumename});
2125 SELECT DISTINCT Job.JobId AS jobid,
2127 Job.StartTime AS starttime,
2130 Job.JobFiles AS files,
2131 Job.JobBytes AS bytes,
2132 Job.jobstatus AS status
2133 FROM Media,JobMedia,Job
2134 WHERE Media.VolumeName=$mq
2135 AND Media.MediaId=JobMedia.MediaId
2136 AND JobMedia.JobId=Job.JobId
2139 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2142 SELECT LocationLog.Date AS date,
2143 Location.Location AS location,
2144 LocationLog.Comment AS comment
2145 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2146 WHERE Media.MediaId = LocationLog.MediaId
2147 AND Media.VolumeName = $mq
2151 my $log = $self->dbh_selectall_arrayref($query) ;
2153 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2156 $self->display({ jobs => [ values %$jobs ],
2157 LocationLog => $logtxt,
2159 "display_media_zoom.tpl");
2167 my $loc = $self->get_form('qlocation');
2168 unless ($loc->{qlocation}) {
2169 return $self->error("Can't get location");
2173 SELECT Location.Location AS location,
2174 Location.Cost AS cost,
2175 Location.Enabled AS enabled
2177 WHERE Location.Location = $loc->{qlocation}
2180 my $row = $self->dbh_selectrow_hashref($query);
2182 $self->display({ ID => $cur_id++,
2183 %$row }, "location_edit.tpl") ;
2191 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2192 unless ($arg->{qlocation}) {
2193 return $self->error("Can't get location");
2195 unless ($arg->{qnewlocation}) {
2196 return $self->error("Can't get new location name");
2198 unless ($arg->{cost}) {
2199 return $self->error("Can't get new cost");
2202 my $enabled = CGI::param('enabled') || '';
2203 $enabled = $enabled?1:0;
2206 UPDATE Location SET Cost = $arg->{cost},
2207 Location = $arg->{qnewlocation},
2209 WHERE Location.Location = $arg->{qlocation}
2212 $self->dbh_do($query);
2214 $self->display_location();
2220 my $arg = $self->get_form(qw/qlocation/) ;
2222 unless ($arg->{qlocation}) {
2223 return $self->error("Can't get location");
2227 SELECT count(Media.MediaId) AS nb
2228 FROM Media INNER JOIN Location USING (LocationID)
2229 WHERE Location = $arg->{qlocation}
2232 my $res = $self->dbh_selectrow_hashref($query);
2235 return $self->error("Sorry, the location must be empty");
2239 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2242 $self->dbh_do($query);
2244 $self->display_location();
2251 my $arg = $self->get_form(qw/qlocation cost/) ;
2253 unless ($arg->{qlocation}) {
2254 $self->display({}, "location_add.tpl");
2257 unless ($arg->{cost}) {
2258 return $self->error("Can't get new cost");
2261 my $enabled = CGI::param('enabled') || '';
2262 $enabled = $enabled?1:0;
2265 INSERT INTO Location (Location, Cost, Enabled)
2266 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2269 $self->dbh_do($query);
2271 $self->display_location();
2274 sub display_location
2279 SELECT Location.Location AS location,
2280 Location.Cost AS cost,
2281 Location.Enabled AS enabled,
2282 (SELECT count(Media.MediaId)
2284 WHERE Media.LocationId = Location.LocationId
2289 my $location = $self->dbh_selectall_hashref($query, 'location');
2291 $self->display({ ID => $cur_id++,
2292 Locations => [ values %$location ] },
2293 "display_location.tpl");
2300 my $medias = $self->get_selected_media_location();
2305 my $arg = $self->get_form('db_locations', 'qnewlocation');
2307 $self->display({ email => $self->{info}->{email_media},
2309 medias => [ values %$medias ],
2311 "update_location.tpl");
2314 sub get_media_max_size
2316 my ($self, $type) = @_;
2318 "SELECT avg(VolBytes) AS size
2320 WHERE Media.VolStatus = 'Full'
2321 AND Media.MediaType = '$type'
2324 my $res = $self->selectrow_hashref($query);
2327 return $res->{size};
2337 my $media = $self->get_form('qmedia');
2339 unless ($media->{qmedia}) {
2340 return $self->error("Can't get media");
2344 SELECT Media.Slot AS slot,
2345 PoolMedia.Name AS poolname,
2346 Media.VolStatus AS volstatus,
2347 Media.InChanger AS inchanger,
2348 Location.Location AS location,
2349 Media.VolumeName AS volumename,
2350 Media.MaxVolBytes AS maxvolbytes,
2351 Media.MaxVolJobs AS maxvoljobs,
2352 Media.MaxVolFiles AS maxvolfiles,
2353 Media.VolUseDuration AS voluseduration,
2354 Media.VolRetention AS volretention,
2355 Media.Comment AS comment,
2356 PoolRecycle.Name AS poolrecycle
2358 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2359 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2360 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2362 WHERE Media.VolumeName = $media->{qmedia}
2365 my $row = $self->dbh_selectrow_hashref($query);
2366 $row->{volretention} = human_sec($row->{volretention});
2367 $row->{voluseduration} = human_sec($row->{voluseduration});
2369 my $elt = $self->get_form(qw/db_pools db_locations/);
2374 }, "update_media.tpl");
2381 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2383 unless ($arg->{jmedias}) {
2384 return $self->error("Can't get selected media");
2387 unless ($arg->{qnewlocation}) {
2388 return $self->error("Can't get new location");
2393 SET LocationId = (SELECT LocationId
2395 WHERE Location = $arg->{qnewlocation})
2396 WHERE Media.VolumeName IN ($arg->{jmedias})
2399 my $nb = $self->dbh_do($query);
2401 print "$nb media updated, you may have to update your autochanger.";
2403 $self->display_media();
2410 my $medias = $self->get_selected_media_location();
2412 return $self->error("Can't get media selection");
2414 my $newloc = CGI::param('newlocation');
2416 my $user = CGI::param('user') || 'unknow';
2417 my $comm = CGI::param('comment') || '';
2418 $comm = $self->dbh_quote("$user: $comm");
2422 foreach my $media (keys %$medias) {
2424 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2426 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2427 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2428 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2431 $self->dbh_do($query);
2432 $self->debug($query);
2436 $q->param('action', 'update_location');
2437 my $url = $q->url(-full => 1, -query=>1);
2439 $self->display({ email => $self->{info}->{email_media},
2441 newlocation => $newloc,
2442 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81 },..]
2443 medias => [ values %$medias ],
2445 "change_location.tpl");
2449 sub display_client_stats
2451 my ($self, %arg) = @_ ;
2453 my $client = $self->dbh_quote($arg{clientname});
2454 my ($limit, $label) = $self->get_limit(%arg);
2458 count(Job.JobId) AS nb_jobs,
2459 sum(Job.JobBytes) AS nb_bytes,
2460 sum(Job.JobErrors) AS nb_err,
2461 sum(Job.JobFiles) AS nb_files,
2462 Client.Name AS clientname
2463 FROM Job INNER JOIN Client USING (ClientId)
2465 Client.Name = $client
2467 GROUP BY Client.Name
2470 my $row = $self->dbh_selectrow_hashref($query);
2472 $row->{ID} = $cur_id++;
2473 $row->{label} = $label;
2475 $self->display($row, "display_client_stats.tpl");
2478 # poolname can be undef
2481 my ($self, $poolname) = @_ ;
2485 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2486 if ($arg->{jmediatypes}) {
2487 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2488 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2491 # TODO : afficher les tailles et les dates
2494 SELECT subq.volmax AS volmax,
2495 subq.volnum AS volnum,
2496 subq.voltotal AS voltotal,
2498 Pool.Recycle AS recycle,
2499 Pool.VolRetention AS volretention,
2500 Pool.VolUseDuration AS voluseduration,
2501 Pool.MaxVolJobs AS maxvoljobs,
2502 Pool.MaxVolFiles AS maxvolfiles,
2503 Pool.MaxVolBytes AS maxvolbytes,
2504 subq.PoolId AS PoolId
2507 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2508 count(Media.MediaId) AS volnum,
2509 sum(Media.VolBytes) AS voltotal,
2510 Media.PoolId AS PoolId,
2511 Media.MediaType AS MediaType
2513 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2514 Media.MediaType AS MediaType
2516 WHERE Media.VolStatus = 'Full'
2517 GROUP BY Media.MediaType
2518 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2519 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2521 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2525 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2528 SELECT Pool.Name AS name,
2529 sum(VolBytes) AS size
2530 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2531 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2535 my $empty = $self->dbh_selectall_hashref($query, 'name');
2537 foreach my $p (values %$all) {
2538 if ($p->{volmax} > 0) { # mysql returns 0.0000
2539 # we remove Recycled/Purged media from pool usage
2540 if (defined $empty->{$p->{name}}) {
2541 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2543 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2545 $p->{poolusage} = 0;
2549 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2551 WHERE PoolId=$p->{poolid}
2555 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2556 foreach my $t (values %$content) {
2557 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2562 $self->display({ ID => $cur_id++,
2563 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2564 Pools => [ values %$all ]},
2565 "display_pool.tpl");
2568 sub display_running_job
2572 my $arg = $self->get_form('client', 'jobid');
2574 if (!$arg->{client} and $arg->{jobid}) {
2577 SELECT Client.Name AS name
2578 FROM Job INNER JOIN Client USING (ClientId)
2579 WHERE Job.JobId = $arg->{jobid}
2582 my $row = $self->dbh_selectrow_hashref($query);
2585 $arg->{client} = $row->{name};
2586 CGI::param('client', $arg->{client});
2590 if ($arg->{client}) {
2591 my $cli = new Bweb::Client(name => $arg->{client});
2592 $cli->display_running_job($self->{info}, $arg->{jobid});
2593 if ($arg->{jobid}) {
2594 $self->get_job_log();
2597 $self->error("Can't get client or jobid");
2601 sub display_running_jobs
2603 my ($self, $display_action) = @_;
2606 SELECT Job.JobId AS jobid,
2607 Job.Name AS jobname,
2609 Job.StartTime AS starttime,
2610 Job.JobFiles AS jobfiles,
2611 Job.JobBytes AS jobbytes,
2612 Job.JobStatus AS jobstatus,
2613 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2614 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2616 Client.Name AS clientname
2617 FROM Job INNER JOIN Client USING (ClientId)
2618 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2620 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2622 $self->display({ ID => $cur_id++,
2623 display_action => $display_action,
2624 Jobs => [ values %$all ]},
2625 "running_job.tpl") ;
2628 # return the autochanger list to update
2633 my $arg = $self->get_form('jmedias');
2635 unless ($arg->{jmedias}) {
2636 return $self->error("Can't get media selection");
2640 SELECT Media.VolumeName AS volumename,
2641 Storage.Name AS storage,
2642 Location.Location AS location,
2644 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2645 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2646 WHERE Media.VolumeName IN ($arg->{jmedias})
2647 AND Media.InChanger = 1
2650 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2652 foreach my $vol (values %$all) {
2653 my $a = $self->ach_get($vol->{location});
2655 $ret{$vol->{location}} = 1;
2657 unless ($a->{have_status}) {
2659 $a->{have_status} = 1;
2662 print "eject $vol->{volumename} from $vol->{storage} : ";
2663 if ($a->send_to_io($vol->{slot})) {
2664 print "<img src='/bweb/T.png' alt='ok'><br/>";
2666 print "<img src='/bweb/E.png' alt='err'><br/>";
2676 my ($to, $subject, $content) = (CGI::param('email'),
2677 CGI::param('subject'),
2678 CGI::param('content'));
2679 $to =~ s/[^\w\d\.\@<>,]//;
2680 $subject =~ s/[^\w\d\.\[\]]/ /;
2682 open(MAIL, "|mail -s '$subject' '$to'") ;
2683 print MAIL $content;
2693 my $arg = $self->get_form('jobid', 'client');
2695 print CGI::header('text/brestore');
2696 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2697 print "client=$arg->{client}\n" if ($arg->{client});
2698 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2702 # TODO : move this to Bweb::Autochanger ?
2703 # TODO : make this internal to not eject tape ?
2709 my ($self, $name) = @_;
2712 return $self->error("Can't get your autochanger name ach");
2715 unless ($self->{info}->{ach_list}) {
2716 return $self->error("Could not find any autochanger");
2719 my $a = $self->{info}->{ach_list}->{$name};
2722 $self->error("Can't get your autochanger $name from your ach_list");
2727 $a->{debug} = $self->{debug};
2734 my ($self, $ach) = @_;
2736 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2738 $self->{info}->save();
2746 my $arg = $self->get_form('ach');
2748 or !$self->{info}->{ach_list}
2749 or !$self->{info}->{ach_list}->{$arg->{ach}})
2751 return $self->error("Can't get autochanger name");
2754 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2758 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2760 my $b = $self->get_bconsole();
2762 my @storages = $b->list_storage() ;
2764 $ach->{devices} = [ map { { name => $_ } } @storages ];
2766 $self->display($ach, "ach_add.tpl");
2767 delete $ach->{drives};
2768 delete $ach->{devices};
2775 my $arg = $self->get_form('ach');
2778 or !$self->{info}->{ach_list}
2779 or !$self->{info}->{ach_list}->{$arg->{ach}})
2781 return $self->error("Can't get autochanger name");
2784 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2786 $self->{info}->save();
2787 $self->{info}->view();
2793 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2795 my $b = $self->get_bconsole();
2796 my @storages = $b->list_storage() ;
2798 unless ($arg->{ach}) {
2799 $arg->{devices} = [ map { { name => $_ } } @storages ];
2800 return $self->display($arg, "ach_add.tpl");
2804 foreach my $drive (CGI::param('drives'))
2806 unless (grep(/^$drive$/,@storages)) {
2807 return $self->error("Can't find $drive in storage list");
2810 my $index = CGI::param("index_$drive");
2811 unless (defined $index and $index =~ /^(\d+)$/) {
2812 return $self->error("Can't get $drive index");
2815 $drives[$index] = $drive;
2819 return $self->error("Can't get drives from Autochanger");
2822 my $a = new Bweb::Autochanger(name => $arg->{ach},
2823 precmd => $arg->{precmd},
2824 drive_name => \@drives,
2825 device => $arg->{device},
2826 mtxcmd => $arg->{mtxcmd});
2828 $self->ach_register($a) ;
2830 $self->{info}->view();
2836 my $arg = $self->get_form('jobid');
2838 if ($arg->{jobid}) {
2839 my $b = $self->get_bconsole();
2840 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2844 title => "Delete a job ",
2845 name => "delete jobid=$arg->{jobid}",
2854 my $arg = $self->get_form(qw/media volstatus inchanger pool
2855 slot volretention voluseduration
2856 maxvoljobs maxvolfiles maxvolbytes
2857 qcomment poolrecycle
2860 unless ($arg->{media}) {
2861 return $self->error("Can't find media selection");
2864 my $update = "update volume=$arg->{media} ";
2866 if ($arg->{volstatus}) {
2867 $update .= " volstatus=$arg->{volstatus} ";
2870 if ($arg->{inchanger}) {
2871 $update .= " inchanger=yes " ;
2873 $update .= " slot=$arg->{slot} ";
2876 $update .= " slot=0 inchanger=no ";
2880 $update .= " pool=$arg->{pool} " ;
2883 if (defined $arg->{volretention}) {
2884 $update .= " volretention=\"$arg->{volretention}\" " ;
2887 if (defined $arg->{voluseduration}) {
2888 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2891 if (defined $arg->{maxvoljobs}) {
2892 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2895 if (defined $arg->{maxvolfiles}) {
2896 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2899 if (defined $arg->{maxvolbytes}) {
2900 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2903 my $b = $self->get_bconsole();
2906 content => $b->send_cmd($update),
2907 title => "Update a volume ",
2913 my $media = $self->dbh_quote($arg->{media});
2915 my $loc = CGI::param('location') || '';
2917 $loc = $self->dbh_quote($loc); # is checked by db
2918 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2920 if ($arg->{poolrecycle}) {
2921 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2923 if (!$arg->{qcomment}) {
2924 $arg->{qcomment} = "''";
2926 push @q, "Comment=$arg->{qcomment}";
2931 SET " . join (',', @q) . "
2932 WHERE Media.VolumeName = $media
2934 $self->dbh_do($query);
2936 $self->update_media();
2943 my $ach = CGI::param('ach') ;
2944 $ach = $self->ach_get($ach);
2946 return $self->error("Bad autochanger name");
2950 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2951 $b->update_slots($ach->{name});
2959 my $arg = $self->get_form('jobid');
2960 unless ($arg->{jobid}) {
2961 return $self->error("Can't get jobid");
2964 my $t = CGI::param('time') || '';
2967 SELECT Job.Name as name, Client.Name as clientname
2968 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2969 WHERE JobId = $arg->{jobid}
2972 my $row = $self->dbh_selectrow_hashref($query);
2975 return $self->error("Can't find $arg->{jobid} in catalog");
2979 SELECT Time AS time, LogText AS log
2981 WHERE Log.JobId = $arg->{jobid}
2982 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2983 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2988 my $log = $self->dbh_selectall_arrayref($query);
2990 return $self->error("Can't get log for jobid $arg->{jobid}");
2996 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2998 $logtxt = join("", map { $_->[1] } @$log ) ;
3001 $self->display({ lines=> $logtxt,
3002 jobid => $arg->{jobid},
3003 name => $row->{name},
3004 client => $row->{clientname},
3005 }, 'display_log.tpl');
3013 my $arg = $self->get_form('ach', 'slots', 'drive');
3015 unless ($arg->{ach}) {
3016 return $self->error("Can't find autochanger name");
3019 my $a = $self->ach_get($arg->{ach});
3021 return $self->error("Can't find autochanger name in configuration");
3024 my $storage = $a->get_drive_name($arg->{drive});
3026 return $self->error("Can't get your drive name");
3031 if ($arg->{slots}) {
3032 $slots = join(",", @{ $arg->{slots} });
3033 $t += 60*scalar( @{ $arg->{slots} }) ;
3036 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3037 print "<h1>This command can take long time, be patient...</h1>";
3039 $b->label_barcodes(storage => $storage,
3040 drive => $arg->{drive},
3048 SET LocationId = (SELECT LocationId
3050 WHERE Location = '$arg->{ach}'),
3052 RecyclePoolId = PoolId
3054 WHERE Media.PoolId = (SELECT PoolId
3056 WHERE Name = 'Scratch')
3057 AND (LocationId = 0 OR LocationId IS NULL)
3066 my @volume = CGI::param('media');
3069 return $self->error("Can't get media selection");
3072 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3075 content => $b->purge_volume(@volume),
3076 title => "Purge media",
3077 name => "purge volume=" . join(' volume=', @volume),
3086 my @volume = CGI::param('media');
3088 return $self->error("Can't get media selection");
3091 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3094 content => $b->prune_volume(@volume),
3095 title => "Prune media",
3096 name => "prune volume=" . join(' volume=', @volume),
3106 my $arg = $self->get_form('jobid');
3107 unless ($arg->{jobid}) {
3108 return $self->error("Can't get jobid");
3111 my $b = $self->get_bconsole();
3113 content => $b->cancel($arg->{jobid}),
3114 title => "Cancel job",
3115 name => "cancel jobid=$arg->{jobid}",
3121 # Warning, we display current fileset
3124 my $arg = $self->get_form('fileset');
3126 if ($arg->{fileset}) {
3127 my $b = $self->get_bconsole();
3128 my $ret = $b->get_fileset($arg->{fileset});
3129 $self->display({ fileset => $arg->{fileset},
3131 }, "fileset_view.tpl");
3133 $self->error("Can't get fileset name");
3137 sub director_show_sched
3141 my $arg = $self->get_form('days');
3143 my $b = $self->get_bconsole();
3144 my $ret = $b->director_get_sched( $arg->{days} );
3149 }, "scheduled_job.tpl");
3152 sub enable_disable_job
3154 my ($self, $what) = @_ ;
3156 my $name = CGI::param('job') || '';
3157 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3158 return $self->error("Can't find job name");
3161 my $b = $self->get_bconsole();
3171 content => $b->send_cmd("$cmd job=\"$name\""),
3172 title => "$cmd $name",
3173 name => "$cmd job=\"$name\"",
3180 return new Bconsole(pref => $self->{info});
3186 my $b = $self->get_bconsole();
3188 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3190 $self->display({ Jobs => $joblist }, "run_job.tpl");
3195 my ($self, $ouput) = @_;
3198 foreach my $l (split(/\r\n/, $ouput)) {
3199 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3205 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3211 foreach my $k (keys %arg) {
3212 $lowcase{lc($k)} = $arg{$k} ;
3221 my $b = $self->get_bconsole();
3223 my $job = CGI::param('job') || '';
3225 my $info = $b->send_cmd("show job=\"$job\"");
3226 my $attr = $self->run_parse_job($info);
3228 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3230 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3231 my $clients = [ map { { name => $_ } }$b->list_client()];
3232 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3233 my $storages= [ map { { name => $_ } }$b->list_storage()];
3238 clients => $clients,
3239 filesets => $filesets,
3240 storages => $storages,
3242 }, "run_job_mod.tpl");
3248 my $b = $self->get_bconsole();
3250 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3260 my $b = $self->get_bconsole();
3262 # TODO: check input (don't use pool, level)
3264 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3265 my $job = CGI::param('job') || '';
3266 my $storage = CGI::param('storage') || '';
3268 my $jobid = $b->run(job => $job,
3269 client => $arg->{client},
3270 priority => $arg->{priority},
3271 level => $arg->{level},
3272 storage => $storage,
3273 pool => $arg->{pool},
3274 when => $arg->{when},
3277 print $jobid, $b->{error};
3279 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";