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*)$!,
219 display_log_time => qr!^(on)?$!,
224 load - load config_file
228 this function load the specified config_file.
236 unless (open(FP, $self->{config_file}))
238 return $self->error("can't load config_file $self->{config_file} : $!");
240 my $f=''; my $tmpbuffer;
241 while(read FP,$tmpbuffer,4096)
249 no strict; # I have no idea of the contents of the file
256 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...") ;
259 foreach my $k (keys %$VAR1) {
260 $self->{$k} = $VAR1->{$k};
268 load_old - load old configuration format
276 unless (open(FP, $self->{config_file}))
278 return $self->error("$self->{config_file} : $!");
281 while (my $line = <FP>)
284 my ($k, $v) = split(/\s*=\s*/, $line, 2);
296 save - save the current configuration to config_file
304 if ($self->{ach_list}) {
305 # shortcut for display_begin
306 $self->{achs} = [ map {{ name => $_ }}
307 keys %{$self->{ach_list}}
311 unless (open(FP, ">$self->{config_file}"))
313 return $self->error("$self->{config_file} : $!\n" .
314 "You must add this to your config file\n"
315 . Data::Dumper::Dumper($self));
318 print FP Data::Dumper::Dumper($self);
326 edit, view, modify - html form ouput
334 $self->display($self, "config_edit.tpl");
340 $self->display($self, "config_view.tpl");
350 foreach my $k (CGI::param())
352 next unless (exists $k_re{$k}) ;
353 my $val = CGI::param($k);
354 if ($val =~ $k_re{$k}) {
357 $self->{error} .= "bad parameter : $k = [$val]";
363 if ($self->{error}) { # an error as occured
364 $self->display($self, 'error.tpl');
372 ################################################################
374 package Bweb::Client;
376 use base q/Bweb::Gui/;
380 Bweb::Client - Bacula FD
384 this package is use to do all Client operations like, parse status etc...
388 $client = new Bweb::Client(name => 'zog-fd');
389 $client->status(); # do a 'status client=zog-fd'
395 display_running_job - Html display of a running job
399 this function is used to display information about a current job
403 sub display_running_job
405 my ($self, $conf, $jobid) = @_ ;
407 my $status = $self->status($conf);
410 if ($status->{$jobid}) {
411 $self->display($status->{$jobid}, "client_job_status.tpl");
414 for my $id (keys %$status) {
415 $self->display($status->{$id}, "client_job_status.tpl");
422 $client = new Bweb::Client(name => 'plume-fd');
424 $client->status($bweb);
428 dirty hack to parse "status client=xxx-fd"
432 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
433 Backup Job started: 06-jun-06 17:22
434 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
435 Files Examined=10,697
436 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
442 JobName => Full_plume.2006-06-06_17.22.23,
445 Bytes => 194,484,132,
455 my ($self, $conf) = @_ ;
457 if (defined $self->{cur_jobs}) {
458 return $self->{cur_jobs} ;
462 my $b = new Bconsole(pref => $conf);
463 my $ret = $b->send_cmd("st client=$self->{name}");
467 for my $r (split(/\n/, $ret)) {
469 $r =~ s/(^\s+|\s+$)//g;
470 if ($r =~ /JobId (\d+) Job (\S+)/) {
472 $arg->{$jobid} = { @param, JobId => $jobid } ;
476 @param = ( JobName => $2 );
478 } elsif ($r =~ /=.+=/) {
479 push @param, split(/\s+|\s*=\s*/, $r) ;
481 } elsif ($r =~ /=/) { # one per line
482 push @param, split(/\s*=\s*/, $r) ;
484 } elsif ($r =~ /:/) { # one per line
485 push @param, split(/\s*:\s*/, $r, 2) ;
489 if ($jobid and @param) {
490 $arg->{$jobid} = { @param,
492 Client => $self->{name},
496 $self->{cur_jobs} = $arg ;
502 ################################################################
504 package Bweb::Autochanger;
506 use base q/Bweb::Gui/;
510 Bweb::Autochanger - Object to manage Autochanger
514 this package will parse the mtx output and manage drives.
518 $auto = new Bweb::Autochanger(precmd => 'sudo');
520 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
524 $auto->slot_is_full(10);
525 $auto->transfer(10, 11);
531 my ($class, %arg) = @_;
534 name => '', # autochanger name
535 label => {}, # where are volume { label1 => 40, label2 => drive0 }
536 drive => [], # drive use [ 'media1', 'empty', ..]
537 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
538 io => [], # io slot number list [ 41, 42, 43...]
539 info => {slot => 0, # informations (slot, drive, io)
543 mtxcmd => '/usr/sbin/mtx',
545 device => '/dev/changer',
546 precmd => '', # ssh command
547 bweb => undef, # link to bacula web object (use for display)
550 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
557 status - parse the output of mtx status
561 this function will launch mtx status and parse the output. it will
562 give a perlish view of the autochanger content.
564 it uses ssh if the autochanger is on a other host.
571 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
573 # TODO : reset all infos
574 $self->{info}->{drive} = 0;
575 $self->{info}->{slot} = 0;
576 $self->{info}->{io} = 0;
578 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
581 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
582 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
583 #Data Transfer Element 1:Empty
584 # Storage Element 1:Empty
585 # Storage Element 2:Full :VolumeTag=000002
586 # Storage Element 3:Empty
587 # Storage Element 4:Full :VolumeTag=000004
588 # Storage Element 5:Full :VolumeTag=000001
589 # Storage Element 6:Full :VolumeTag=000003
590 # Storage Element 7:Empty
591 # Storage Element 41 IMPORT/EXPORT:Empty
592 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
597 # Storage Element 7:Empty
598 # Storage Element 2:Full :VolumeTag=000002
599 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
602 $self->set_empty_slot($1);
604 $self->set_slot($1, $4);
607 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
610 $self->set_empty_drive($1);
612 $self->set_drive($1, $4, $6);
615 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
618 $self->set_empty_io($1);
620 $self->set_io($1, $4);
623 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
625 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
626 $self->{info}->{drive} = $1;
627 $self->{info}->{slot} = $2;
628 if ($l =~ /(\d+)\s+Import/) {
629 $self->{info}->{io} = $1 ;
631 $self->{info}->{io} = 0;
636 $self->debug($self) ;
641 my ($self, $slot) = @_;
644 if ($self->{slot}->[$slot] eq 'loaded') {
648 my $label = $self->{slot}->[$slot] ;
650 return $self->is_media_loaded($label);
655 my ($self, $drive, $slot) = @_;
657 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
658 return 0 if ($self->slot_is_full($slot)) ;
660 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
663 my $content = $self->get_slot($slot);
664 print "content = $content<br/> $drive => $slot<br/>";
665 $self->set_empty_drive($drive);
666 $self->set_slot($slot, $content);
669 $self->{error} = $out;
674 # TODO: load/unload have to use mtx script from bacula
677 my ($self, $drive, $slot) = @_;
679 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
680 return 0 unless ($self->slot_is_full($slot)) ;
682 print "Loading drive $drive with slot $slot<br/>\n";
683 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
686 my $content = $self->get_slot($slot);
687 print "content = $content<br/> $slot => $drive<br/>";
688 $self->set_drive($drive, $slot, $content);
691 $self->{error} = $out;
699 my ($self, $media) = @_;
701 unless ($self->{label}->{$media}) {
705 if ($self->{label}->{$media} =~ /drive\d+/) {
715 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
720 my ($self, $slot, $tag) = @_;
721 $self->{slot}->[$slot] = $tag || 'full';
722 push @{ $self->{io} }, $slot;
725 $self->{label}->{$tag} = $slot;
731 my ($self, $slot) = @_;
733 push @{ $self->{io} }, $slot;
735 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
736 $self->{slot}->[$slot] = 'empty';
742 my ($self, $slot) = @_;
743 return $self->{slot}->[$slot];
748 my ($self, $slot, $tag) = @_;
749 $self->{slot}->[$slot] = $tag || 'full';
752 $self->{label}->{$tag} = $slot;
758 my ($self, $slot) = @_;
760 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
761 $self->{slot}->[$slot] = 'empty';
767 my ($self, $drive) = @_;
768 $self->{drive}->[$drive] = 'empty';
773 my ($self, $drive, $slot, $tag) = @_;
774 $self->{drive}->[$drive] = $tag || $slot;
776 $self->{slot}->[$slot] = $tag || 'loaded';
779 $self->{label}->{$tag} = "drive$drive";
785 my ($self, $slot) = @_;
787 # slot don't exists => full
788 if (not defined $self->{slot}->[$slot]) {
792 if ($self->{slot}->[$slot] eq 'empty') {
795 return 1; # vol, full, loaded
798 sub slot_get_first_free
801 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
802 return $slot unless ($self->slot_is_full($slot));
806 sub io_get_first_free
810 foreach my $slot (@{ $self->{io} }) {
811 return $slot unless ($self->slot_is_full($slot));
818 my ($self, $media) = @_;
820 return $self->{label}->{$media} ;
825 my ($self, $media) = @_;
827 return defined $self->{label}->{$media} ;
832 my ($self, $slot) = @_;
834 unless ($self->slot_is_full($slot)) {
835 print "Autochanger $self->{name} slot $slot is empty\n";
840 if ($self->is_slot_loaded($slot)) {
843 print "Autochanger $self->{name} $slot is currently in use\n";
847 # autochanger must have I/O
848 unless ($self->have_io()) {
849 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
853 my $dst = $self->io_get_first_free();
856 print "Autochanger $self->{name} you must empty I/O first\n";
859 $self->transfer($slot, $dst);
864 my ($self, $src, $dst) = @_ ;
865 if ($self->{debug}) {
866 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
868 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
871 my $content = $self->get_slot($src);
872 $self->{slot}->[$src] = 'empty';
873 $self->set_slot($dst, $content);
876 $self->{error} = $out;
883 my ($self, $index) = @_;
884 return $self->{drive_name}->[$index];
887 # TODO : do a tapeinfo request to get informations
897 for my $slot (@{$self->{io}})
899 if ($self->is_slot_loaded($slot)) {
900 print "$slot is currently loaded\n";
904 if ($self->slot_is_full($slot))
906 my $free = $self->slot_get_first_free() ;
907 print "move $slot to $free :\n";
910 if ($self->transfer($slot, $free)) {
911 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
913 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
917 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
923 # TODO : this is with mtx status output,
924 # we can do an other function from bacula view (with StorageId)
928 my $bweb = $self->{bweb};
930 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
931 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
934 SELECT Media.VolumeName AS volumename,
935 Media.VolStatus AS volstatus,
936 Media.LastWritten AS lastwritten,
937 Media.VolBytes AS volbytes,
938 Media.MediaType AS mediatype,
940 Media.InChanger AS inchanger,
942 $bweb->{sql}->{FROM_UNIXTIME}(
943 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
944 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
947 INNER JOIN Pool USING (PoolId)
949 WHERE Media.VolumeName IN ($media_list)
952 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
954 # TODO : verify slot and bacula slot
958 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
960 if ($self->slot_is_full($slot)) {
962 my $vol = $self->{slot}->[$slot];
963 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
965 my $bslot = $all->{$vol}->{slot} ;
966 my $inchanger = $all->{$vol}->{inchanger};
968 # if bacula slot or inchanger flag is bad, we display a message
969 if ($bslot != $slot or !$inchanger) {
970 push @to_update, $slot;
973 $all->{$vol}->{realslot} = $slot;
975 push @{ $param }, $all->{$vol};
977 } else { # empty or no label
978 push @{ $param }, {realslot => $slot,
979 volstatus => 'Unknown',
980 volumename => $self->{slot}->[$slot]} ;
983 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
987 my $i=0; my $drives = [] ;
988 foreach my $d (@{ $self->{drive} }) {
989 $drives->[$i] = { index => $i,
990 load => $self->{drive}->[$i],
991 name => $self->{drive_name}->[$i],
996 $bweb->display({ Name => $self->{name},
997 nb_drive => $self->{info}->{drive},
998 nb_io => $self->{info}->{io},
1001 Update => scalar(@to_update) },
1009 ################################################################
1013 use base q/Bweb::Gui/;
1017 Bweb - main Bweb package
1021 this package is use to compute and display informations
1026 use POSIX qw/strftime/;
1028 our $config_file='/etc/bacula/bweb.conf';
1034 %sql_func - hash to make query mysql/postgresql compliant
1040 UNIX_TIMESTAMP => '',
1041 FROM_UNIXTIME => '',
1042 TO_SEC => " interval '1 second' * ",
1043 SEC_TO_INT => "SEC_TO_INT",
1046 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1047 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1048 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1049 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1050 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1051 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1052 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1053 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1054 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1057 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1058 FROM_UNIXTIME => 'FROM_UNIXTIME',
1061 SEC_TO_TIME => 'SEC_TO_TIME',
1062 MATCH => " REGEXP ",
1063 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1064 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1065 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1066 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1067 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1068 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1069 STARTTIME_PWEEK => " DATE_FORMAT(StartTime, '%v') ",
1070 # with mysql < 5, you have to play with the ugly SHOW command
1071 DB_SIZE => " SELECT 0 ",
1072 # works only with mysql 5
1073 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1074 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1082 $self->{dbh}->disconnect();
1087 sub dbh_selectall_arrayref
1089 my ($self, $query) = @_;
1090 $self->connect_db();
1091 $self->debug($query);
1092 return $self->{dbh}->selectall_arrayref($query);
1097 my ($self, @what) = @_;
1098 return join(',', $self->dbh_quote(@what)) ;
1103 my ($self, @what) = @_;
1105 $self->connect_db();
1107 return map { $self->{dbh}->quote($_) } @what;
1109 return $self->{dbh}->quote($what[0]) ;
1115 my ($self, $query) = @_ ;
1116 $self->connect_db();
1117 $self->debug($query);
1118 return $self->{dbh}->do($query);
1121 sub dbh_selectall_hashref
1123 my ($self, $query, $join) = @_;
1125 $self->connect_db();
1126 $self->debug($query);
1127 return $self->{dbh}->selectall_hashref($query, $join) ;
1130 sub dbh_selectrow_hashref
1132 my ($self, $query) = @_;
1134 $self->connect_db();
1135 $self->debug($query);
1136 return $self->{dbh}->selectrow_hashref($query) ;
1141 my ($self, @what) = @_;
1142 if ($self->{conf}->{connection_string} =~ /dbi:mysql/i) {
1143 return 'CONCAT(' . join(',', @what) . ')' ;
1145 return join(' || ', @what);
1151 my ($self, $query) = @_;
1152 $self->debug($query, up => 1);
1153 return $self->{dbh}->prepare($query);
1159 my @unit = qw(B KB MB GB TB);
1160 my $val = shift || 0;
1162 my $format = '%i %s';
1163 while ($val / 1024 > 1) {
1167 $format = ($i>0)?'%0.1f %s':'%i %s';
1168 return sprintf($format, $val, $unit[$i]);
1171 # display Day, Hour, Year
1177 $val /= 60; # sec -> min
1179 if ($val / 60 <= 1) {
1183 $val /= 60; # min -> hour
1184 if ($val / 24 <= 1) {
1185 return "$val hours";
1188 $val /= 24; # hour -> day
1189 if ($val / 365 < 2) {
1193 $val /= 365 ; # day -> year
1195 return "$val years";
1198 # get Day, Hour, Year
1204 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1208 my %times = ( m => 60,
1214 my $mult = $times{$2} || 0;
1224 unless ($self->{dbh}) {
1225 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1226 $self->{info}->{user},
1227 $self->{info}->{password});
1229 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1230 unless ($self->{dbh});
1232 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1234 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1235 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1242 my ($class, %arg) = @_;
1244 dbh => undef, # connect_db();
1246 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1252 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1254 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1255 $self->{sql} = $sql_func{$1};
1258 $self->{debug} = $self->{info}->{debug};
1259 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1267 $self->display($self->{info}, "begin.tpl");
1273 $self->display($self->{info}, "end.tpl");
1281 my $arg = $self->get_form("client", "qre_client", "jclient_groups", "qnotingroup");
1283 if ($arg->{qre_client}) {
1284 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1285 } elsif ($arg->{client}) {
1286 $where = "WHERE Name = '$arg->{client}' ";
1287 } elsif ($arg->{jclient_groups}) {
1288 $where = "JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
1289 JOIN client_group USING (client_group_id)
1290 WHERE client_group_name IN ($arg->{jclient_groups})";
1291 } elsif ($arg->{qnotingroup}) {
1294 (SELECT 1 FROM client_group_member
1295 WHERE Client.ClientId = client_group_member.ClientId
1302 SELECT Name AS name,
1304 AutoPrune AS autoprune,
1305 FileRetention AS fileretention,
1306 JobRetention AS jobretention
1311 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1313 my $dsp = { ID => $cur_id++,
1314 clients => [ values %$all] };
1316 $self->display($dsp, "client_list.tpl") ;
1321 my ($self, %arg) = @_;
1328 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1330 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1332 $self->{sql}->{TO_SEC}($arg{age})
1335 $label = "last " . human_sec($arg{age});
1338 if ($arg{groupby}) {
1339 $limit .= " GROUP BY $arg{groupby} ";
1343 $limit .= " ORDER BY $arg{order} ";
1347 $limit .= " LIMIT $arg{limit} ";
1348 $label .= " limited to $arg{limit}";
1352 $limit .= " OFFSET $arg{offset} ";
1353 $label .= " with $arg{offset} offset ";
1357 $label = 'no filter';
1360 return ($limit, $label);
1365 $bweb->get_form(...) - Get useful stuff
1369 This function get and check parameters against regexp.
1371 If word begin with 'q', the return will be quoted or join quoted
1372 if it's end with 's'.
1377 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1380 qclient => 'plume-fd',
1381 qpools => "'plume-fd', 'test-fd', '...'",
1388 my ($self, @what) = @_;
1389 my %what = map { $_ => 1 } @what;
1411 my %opt_ss =( # string with space
1415 my %opt_s = ( # default to ''
1432 my %opt_p = ( # option with path
1439 my %opt_r = (regexwhere => 1);
1441 my %opt_d = ( # option with date
1446 foreach my $i (@what) {
1447 if (exists $opt_i{$i}) {# integer param
1448 my $value = CGI::param($i) || $opt_i{$i} ;
1449 if ($value =~ /^(\d+)$/) {
1452 } elsif ($opt_s{$i}) { # simple string param
1453 my $value = CGI::param($i) || '';
1454 if ($value =~ /^([\w\d\.-]+)$/) {
1457 } elsif ($opt_ss{$i}) { # simple string param (with space)
1458 my $value = CGI::param($i) || '';
1459 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1462 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1463 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1465 $ret{$i} = $self->dbh_join(@value) ;
1468 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1469 my $value = CGI::param($1) ;
1471 $ret{$i} = $self->dbh_quote($value);
1474 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1475 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1476 grep { ! /^\s*$/ } CGI::param($1) ];
1477 } elsif (exists $opt_p{$i}) {
1478 my $value = CGI::param($i) || '';
1479 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1482 } elsif (exists $opt_r{$i}) {
1483 my $value = CGI::param($i) || '';
1484 if ($value =~ /^([^'"']+)$/) {
1487 } elsif (exists $opt_d{$i}) {
1488 my $value = CGI::param($i) || '';
1489 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1496 foreach my $s (CGI::param('slot')) {
1497 if ($s =~ /^(\d+)$/) {
1498 push @{$ret{slots}}, $s;
1504 my $when = CGI::param('when') || '';
1505 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1510 if ($what{db_clients}) {
1512 SELECT Client.Name as clientname
1516 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1517 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1521 if ($what{db_client_groups}) {
1523 SELECT client_group_name AS name
1527 my $grps = $self->dbh_selectall_hashref($query, 'name');
1528 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1532 if ($what{db_mediatypes}) {
1534 SELECT MediaType as mediatype
1538 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1539 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1543 if ($what{db_locations}) {
1545 SELECT Location as location, Cost as cost
1548 my $loc = $self->dbh_selectall_hashref($query, 'location');
1549 $ret{db_locations} = [ sort { $a->{location}
1555 if ($what{db_pools}) {
1556 my $query = "SELECT Name as name FROM Pool";
1558 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1559 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1562 if ($what{db_filesets}) {
1564 SELECT FileSet.FileSet AS fileset
1568 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1570 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1571 values %$filesets] ;
1574 if ($what{db_jobnames}) {
1576 SELECT DISTINCT Job.Name AS jobname
1580 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1582 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1583 values %$jobnames] ;
1586 if ($what{db_devices}) {
1588 SELECT Device.Name AS name
1592 my $devices = $self->dbh_selectall_hashref($query, 'name');
1594 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1605 my $fields = $self->get_form(qw/age level status clients filesets
1607 db_clients limit db_filesets width height
1608 qclients qfilesets qjobnames db_jobnames/);
1611 my $url = CGI::url(-full => 0,
1614 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1616 # this organisation is to keep user choice between 2 click
1617 # TODO : fileset and client selection doesn't work
1626 sub display_client_job
1628 my ($self, %arg) = @_ ;
1630 $arg{order} = ' Job.JobId DESC ';
1631 my ($limit, $label) = $self->get_limit(%arg);
1633 my $clientname = $self->dbh_quote($arg{clientname});
1636 SELECT DISTINCT Job.JobId AS jobid,
1637 Job.Name AS jobname,
1638 FileSet.FileSet AS fileset,
1640 StartTime AS starttime,
1641 JobFiles AS jobfiles,
1642 JobBytes AS jobbytes,
1643 JobStatus AS jobstatus,
1644 JobErrors AS joberrors
1646 FROM Client,Job,FileSet
1647 WHERE Client.Name=$clientname
1648 AND Client.ClientId=Job.ClientId
1649 AND Job.FileSetId=FileSet.FileSetId
1653 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1655 $self->display({ clientname => $arg{clientname},
1658 Jobs => [ values %$all ],
1660 "display_client_job.tpl") ;
1663 sub get_selected_media_location
1667 my $medias = $self->get_form('jmedias');
1669 unless ($medias->{jmedias}) {
1674 SELECT Media.VolumeName AS volumename, Location.Location AS location
1675 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1676 WHERE Media.VolumeName IN ($medias->{jmedias})
1679 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1681 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1692 my $medias = $self->get_selected_media_location();
1698 my $elt = $self->get_form('db_locations');
1700 $self->display({ ID => $cur_id++,
1701 %$elt, # db_locations
1703 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1713 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1715 $self->display($elt, "help_extern.tpl");
1718 sub help_extern_compute
1722 my $number = CGI::param('limit') || '' ;
1723 unless ($number =~ /^(\d+)$/) {
1724 return $self->error("Bad arg number : $number ");
1727 my ($sql, undef) = $self->get_param('pools',
1728 'locations', 'mediatypes');
1731 SELECT Media.VolumeName AS volumename,
1732 Media.VolStatus AS volstatus,
1733 Media.LastWritten AS lastwritten,
1734 Media.MediaType AS mediatype,
1735 Media.VolMounts AS volmounts,
1737 Media.Recycle AS recycle,
1738 $self->{sql}->{FROM_UNIXTIME}(
1739 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1740 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1743 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1744 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1746 WHERE Media.InChanger = 1
1747 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1749 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1753 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1755 $self->display({ Medias => [ values %$all ] },
1756 "help_extern_compute.tpl");
1763 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1764 $self->display($param, "help_intern.tpl");
1767 sub help_intern_compute
1771 my $number = CGI::param('limit') || '' ;
1772 unless ($number =~ /^(\d+)$/) {
1773 return $self->error("Bad arg number : $number ");
1776 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1778 if (CGI::param('expired')) {
1780 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1781 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1787 SELECT Media.VolumeName AS volumename,
1788 Media.VolStatus AS volstatus,
1789 Media.LastWritten AS lastwritten,
1790 Media.MediaType AS mediatype,
1791 Media.VolMounts AS volmounts,
1793 $self->{sql}->{FROM_UNIXTIME}(
1794 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1795 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1798 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1799 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1801 WHERE Media.InChanger <> 1
1802 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1803 AND Media.Recycle = 1
1805 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1809 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1811 $self->display({ Medias => [ values %$all ] },
1812 "help_intern_compute.tpl");
1818 my ($self, %arg) = @_ ;
1820 my ($limit, $label) = $self->get_limit(%arg);
1824 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1825 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1826 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1827 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1828 ($self->{sql}->{DB_SIZE}) AS db_size,
1829 (SELECT count(Job.JobId)
1831 WHERE Job.JobStatus IN ('E','e','f','A')
1834 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1837 my $row = $self->dbh_selectrow_hashref($query) ;
1839 $row->{nb_bytes} = human_size($row->{nb_bytes});
1841 $row->{db_size} = human_size($row->{db_size});
1842 $row->{label} = $label;
1844 $self->display($row, "general.tpl");
1849 my ($self, @what) = @_ ;
1850 my %elt = map { $_ => 1 } @what;
1855 if ($elt{clients}) {
1856 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1858 $ret{clients} = \@clients;
1859 my $str = $self->dbh_join(@clients);
1860 $limit .= "AND Client.Name IN ($str) ";
1864 if ($elt{client_groups}) {
1865 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1867 $ret{client_groups} = \@clients;
1868 my $str = $self->dbh_join(@clients);
1869 $limit .= "AND client_group_name IN ($str) ";
1873 if ($elt{filesets}) {
1874 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1876 $ret{filesets} = \@filesets;
1877 my $str = $self->dbh_join(@filesets);
1878 $limit .= "AND FileSet.FileSet IN ($str) ";
1882 if ($elt{mediatypes}) {
1883 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1885 $ret{mediatypes} = \@medias;
1886 my $str = $self->dbh_join(@medias);
1887 $limit .= "AND Media.MediaType IN ($str) ";
1892 my $client = CGI::param('client');
1893 $ret{client} = $client;
1894 $client = $self->dbh_join($client);
1895 $limit .= "AND Client.Name = $client ";
1899 my $level = CGI::param('level') || '';
1900 if ($level =~ /^(\w)$/) {
1902 $limit .= "AND Job.Level = '$1' ";
1907 my $jobid = CGI::param('jobid') || '';
1909 if ($jobid =~ /^(\d+)$/) {
1911 $limit .= "AND Job.JobId = '$1' ";
1916 my $status = CGI::param('status') || '';
1917 if ($status =~ /^(\w)$/) {
1920 $limit .= "AND Job.JobStatus IN ('f','E') ";
1921 } elsif ($1 eq 'W') {
1922 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1924 $limit .= "AND Job.JobStatus = '$1' ";
1929 if ($elt{volstatus}) {
1930 my $status = CGI::param('volstatus') || '';
1931 if ($status =~ /^(\w+)$/) {
1933 $limit .= "AND Media.VolStatus = '$1' ";
1937 if ($elt{locations}) {
1938 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1940 $ret{locations} = \@location;
1941 my $str = $self->dbh_join(@location);
1942 $limit .= "AND Location.Location IN ($str) ";
1947 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1949 $ret{pools} = \@pool;
1950 my $str = $self->dbh_join(@pool);
1951 $limit .= "AND Pool.Name IN ($str) ";
1955 if ($elt{location}) {
1956 my $location = CGI::param('location') || '';
1958 $ret{location} = $location;
1959 $location = $self->dbh_quote($location);
1960 $limit .= "AND Location.Location = $location ";
1965 my $pool = CGI::param('pool') || '';
1968 $pool = $self->dbh_quote($pool);
1969 $limit .= "AND Pool.Name = $pool ";
1973 if ($elt{jobtype}) {
1974 my $jobtype = CGI::param('jobtype') || '';
1975 if ($jobtype =~ /^(\w)$/) {
1977 $limit .= "AND Job.Type = '$1' ";
1981 return ($limit, %ret);
1992 my ($self, %arg) = @_ ;
1994 $arg{order} = ' Job.JobId DESC ';
1996 my ($limit, $label) = $self->get_limit(%arg);
1997 my ($where, undef) = $self->get_param('clients',
2007 if (CGI::param('client_group')) {
2009 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2010 LEFT JOIN client_group USING (client_group_id)
2015 SELECT Job.JobId AS jobid,
2016 Client.Name AS client,
2017 FileSet.FileSet AS fileset,
2018 Job.Name AS jobname,
2020 StartTime AS starttime,
2022 Pool.Name AS poolname,
2023 JobFiles AS jobfiles,
2024 JobBytes AS jobbytes,
2025 JobStatus AS jobstatus,
2026 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2027 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2030 JobErrors AS joberrors
2033 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2034 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2036 WHERE Client.ClientId=Job.ClientId
2037 AND Job.JobStatus NOT IN ('R', 'C')
2042 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2044 $self->display({ Filter => $label,
2048 sort { $a->{jobid} <=> $b->{jobid} }
2055 # display job informations
2056 sub display_job_zoom
2058 my ($self, $jobid) = @_ ;
2060 $jobid = $self->dbh_quote($jobid);
2063 SELECT DISTINCT Job.JobId AS jobid,
2064 Client.Name AS client,
2065 Job.Name AS jobname,
2066 FileSet.FileSet AS fileset,
2068 Pool.Name AS poolname,
2069 StartTime AS starttime,
2070 JobFiles AS jobfiles,
2071 JobBytes AS jobbytes,
2072 JobStatus AS jobstatus,
2073 JobErrors AS joberrors,
2074 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2075 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2078 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2079 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2080 WHERE Client.ClientId=Job.ClientId
2081 AND Job.JobId = $jobid
2084 my $row = $self->dbh_selectrow_hashref($query) ;
2086 # display all volumes associate with this job
2088 SELECT Media.VolumeName as volumename
2089 FROM Job,Media,JobMedia
2090 WHERE Job.JobId = $jobid
2091 AND JobMedia.JobId=Job.JobId
2092 AND JobMedia.MediaId=Media.MediaId
2095 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2097 $row->{volumes} = [ values %$all ] ;
2099 $self->display($row, "display_job_zoom.tpl");
2102 sub display_job_group
2104 my ($self, %arg) = @_;
2106 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2108 my ($where, undef) = $self->get_param('client_groups',
2114 SELECT client_group_name AS client_group_name,
2115 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2116 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2117 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2118 COALESCE(jobok.nbjobs,0) AS nbjobok,
2119 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2120 COALESCE(jobok.duration, '0:0:0') AS duration
2122 FROM client_group LEFT JOIN (
2123 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2124 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2125 SUM(JobErrors) AS joberrors,
2126 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2127 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2130 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2131 JOIN client_group USING (client_group_id)
2133 WHERE JobStatus = 'T'
2136 ) AS jobok USING (client_group_name) LEFT JOIN
2139 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2140 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2141 SUM(JobErrors) AS joberrors
2142 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2143 JOIN client_group USING (client_group_id)
2145 WHERE JobStatus IN ('f','E', 'A')
2148 ) AS joberr USING (client_group_name)
2152 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2154 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2157 $self->display($rep, "display_job_group.tpl");
2162 my ($self, %arg) = @_ ;
2164 my ($limit, $label) = $self->get_limit(%arg);
2165 my ($where, %elt) = $self->get_param('pools',
2170 my $arg = $self->get_form('jmedias', 'qre_media');
2172 if ($arg->{jmedias}) {
2173 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2175 if ($arg->{qre_media}) {
2176 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2180 SELECT Media.VolumeName AS volumename,
2181 Media.VolBytes AS volbytes,
2182 Media.VolStatus AS volstatus,
2183 Media.MediaType AS mediatype,
2184 Media.InChanger AS online,
2185 Media.LastWritten AS lastwritten,
2186 Location.Location AS location,
2187 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2188 Pool.Name AS poolname,
2189 $self->{sql}->{FROM_UNIXTIME}(
2190 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2191 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2194 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2195 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2196 Media.MediaType AS MediaType
2198 WHERE Media.VolStatus = 'Full'
2199 GROUP BY Media.MediaType
2200 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2202 WHERE Media.PoolId=Pool.PoolId
2207 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2209 $self->display({ ID => $cur_id++,
2211 Location => $elt{location},
2212 Medias => [ values %$all ]
2214 "display_media.tpl");
2221 my $pool = $self->get_form('db_pools');
2223 foreach my $name (@{ $pool->{db_pools} }) {
2224 CGI::param('pool', $name->{name});
2225 $self->display_media();
2229 sub display_media_zoom
2233 my $medias = $self->get_form('jmedias');
2235 unless ($medias->{jmedias}) {
2236 return $self->error("Can't get media selection");
2240 SELECT InChanger AS online,
2241 VolBytes AS nb_bytes,
2242 VolumeName AS volumename,
2243 VolStatus AS volstatus,
2244 VolMounts AS nb_mounts,
2245 Media.VolUseDuration AS voluseduration,
2246 Media.MaxVolJobs AS maxvoljobs,
2247 Media.MaxVolFiles AS maxvolfiles,
2248 Media.MaxVolBytes AS maxvolbytes,
2249 VolErrors AS nb_errors,
2250 Pool.Name AS poolname,
2251 Location.Location AS location,
2252 Media.Recycle AS recycle,
2253 Media.VolRetention AS volretention,
2254 Media.LastWritten AS lastwritten,
2255 Media.VolReadTime/1000000 AS volreadtime,
2256 Media.VolWriteTime/1000000 AS volwritetime,
2257 Media.RecycleCount AS recyclecount,
2258 Media.Comment AS comment,
2259 $self->{sql}->{FROM_UNIXTIME}(
2260 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2261 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2264 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2265 WHERE Pool.PoolId = Media.PoolId
2266 AND VolumeName IN ($medias->{jmedias})
2269 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2271 foreach my $media (values %$all) {
2272 my $mq = $self->dbh_quote($media->{volumename});
2275 SELECT DISTINCT Job.JobId AS jobid,
2277 Job.StartTime AS starttime,
2280 Job.JobFiles AS files,
2281 Job.JobBytes AS bytes,
2282 Job.jobstatus AS status
2283 FROM Media,JobMedia,Job
2284 WHERE Media.VolumeName=$mq
2285 AND Media.MediaId=JobMedia.MediaId
2286 AND JobMedia.JobId=Job.JobId
2289 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2292 SELECT LocationLog.Date AS date,
2293 Location.Location AS location,
2294 LocationLog.Comment AS comment
2295 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2296 WHERE Media.MediaId = LocationLog.MediaId
2297 AND Media.VolumeName = $mq
2301 my $log = $self->dbh_selectall_arrayref($query) ;
2303 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2306 $self->display({ jobs => [ values %$jobs ],
2307 LocationLog => $logtxt,
2309 "display_media_zoom.tpl");
2317 my $loc = $self->get_form('qlocation');
2318 unless ($loc->{qlocation}) {
2319 return $self->error("Can't get location");
2323 SELECT Location.Location AS location,
2324 Location.Cost AS cost,
2325 Location.Enabled AS enabled
2327 WHERE Location.Location = $loc->{qlocation}
2330 my $row = $self->dbh_selectrow_hashref($query);
2332 $self->display({ ID => $cur_id++,
2333 %$row }, "location_edit.tpl") ;
2341 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2342 unless ($arg->{qlocation}) {
2343 return $self->error("Can't get location");
2345 unless ($arg->{qnewlocation}) {
2346 return $self->error("Can't get new location name");
2348 unless ($arg->{cost}) {
2349 return $self->error("Can't get new cost");
2352 my $enabled = CGI::param('enabled') || '';
2353 $enabled = $enabled?1:0;
2356 UPDATE Location SET Cost = $arg->{cost},
2357 Location = $arg->{qnewlocation},
2359 WHERE Location.Location = $arg->{qlocation}
2362 $self->dbh_do($query);
2364 $self->location_display();
2370 my $arg = $self->get_form(qw/qlocation/) ;
2372 unless ($arg->{qlocation}) {
2373 return $self->error("Can't get location");
2377 SELECT count(Media.MediaId) AS nb
2378 FROM Media INNER JOIN Location USING (LocationID)
2379 WHERE Location = $arg->{qlocation}
2382 my $res = $self->dbh_selectrow_hashref($query);
2385 return $self->error("Sorry, the location must be empty");
2389 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2392 $self->dbh_do($query);
2394 $self->location_display();
2401 my $arg = $self->get_form(qw/qlocation cost/) ;
2403 unless ($arg->{qlocation}) {
2404 $self->display({}, "location_add.tpl");
2407 unless ($arg->{cost}) {
2408 return $self->error("Can't get new cost");
2411 my $enabled = CGI::param('enabled') || '';
2412 $enabled = $enabled?1:0;
2415 INSERT INTO Location (Location, Cost, Enabled)
2416 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2419 $self->dbh_do($query);
2421 $self->location_display();
2424 sub location_display
2429 SELECT Location.Location AS location,
2430 Location.Cost AS cost,
2431 Location.Enabled AS enabled,
2432 (SELECT count(Media.MediaId)
2434 WHERE Media.LocationId = Location.LocationId
2439 my $location = $self->dbh_selectall_hashref($query, 'location');
2441 $self->display({ ID => $cur_id++,
2442 Locations => [ values %$location ] },
2443 "display_location.tpl");
2450 my $medias = $self->get_selected_media_location();
2455 my $arg = $self->get_form('db_locations', 'qnewlocation');
2457 $self->display({ email => $self->{info}->{email_media},
2459 medias => [ values %$medias ],
2461 "update_location.tpl");
2464 ###########################################################
2470 my $grp = $self->get_form(qw/qclient_group db_clients/);
2473 unless ($grp->{qclient_group}) {
2474 return $self->error("Can't get group");
2479 FROM Client JOIN client_group_member using (clientid)
2480 JOIN client_group using (client_group_id)
2481 WHERE client_group_name = $grp->{qclient_group}
2484 my $row = $self->dbh_selectall_hashref($query, "name");
2486 $self->display({ ID => $cur_id++,
2487 client_group => $grp->{qclient_group},
2489 client_group_member => [ values %$row]},
2497 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2498 unless ($arg->{qclient_group}) {
2499 return $self->error("Can't get groups");
2502 $self->{dbh}->begin_work();
2505 DELETE FROM client_group_member
2506 WHERE client_group_id IN
2507 (SELECT client_group_id
2509 WHERE client_group_name = $arg->{qclient_group})
2511 $self->dbh_do($query);
2514 INSERT INTO client_group_member (clientid, client_group_id)
2516 (SELECT client_group_id
2518 WHERE client_group_name = $arg->{qclient_group})
2519 FROM Client WHERE Name IN ($arg->{jclients})
2522 $self->dbh_do($query);
2524 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2527 SET client_group_name = $arg->{qnewgroup}
2528 WHERE client_group_name = $arg->{qclient_group}
2531 $self->dbh_do($query);
2534 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2536 $self->display_groups();
2542 my $arg = $self->get_form(qw/qclient_group/);
2544 unless ($arg->{qclient_group}) {
2545 return $self->error("Can't get groups");
2548 $self->{dbh}->begin_work();
2551 DELETE FROM client_group_member
2552 WHERE client_group_id IN
2553 (SELECT client_group_id
2555 WHERE client_group_name = $arg->{qclient_group});
2557 DELETE FROM client_group
2558 WHERE client_group_name = $arg->{qclient_group};
2560 $self->dbh_do($query);
2562 $self->{dbh}->commit();
2564 $self->display_groups();
2571 my $arg = $self->get_form(qw/qclient_group/) ;
2573 unless ($arg->{qclient_group}) {
2574 $self->display({}, "groups_add.tpl");
2579 INSERT INTO client_group (client_group_name)
2580 VALUES ($arg->{qclient_group})
2583 $self->dbh_do($query);
2585 $self->display_groups();
2592 my $arg = $self->get_form(qw/db_client_groups/) ;
2594 if ($self->{dbh}->errstr) {
2595 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2600 $self->display({ ID => $cur_id++,
2602 "display_groups.tpl");
2605 ###########################################################
2607 sub get_media_max_size
2609 my ($self, $type) = @_;
2611 "SELECT avg(VolBytes) AS size
2613 WHERE Media.VolStatus = 'Full'
2614 AND Media.MediaType = '$type'
2617 my $res = $self->selectrow_hashref($query);
2620 return $res->{size};
2630 my $media = $self->get_form('qmedia');
2632 unless ($media->{qmedia}) {
2633 return $self->error("Can't get media");
2637 SELECT Media.Slot AS slot,
2638 PoolMedia.Name AS poolname,
2639 Media.VolStatus AS volstatus,
2640 Media.InChanger AS inchanger,
2641 Location.Location AS location,
2642 Media.VolumeName AS volumename,
2643 Media.MaxVolBytes AS maxvolbytes,
2644 Media.MaxVolJobs AS maxvoljobs,
2645 Media.MaxVolFiles AS maxvolfiles,
2646 Media.VolUseDuration AS voluseduration,
2647 Media.VolRetention AS volretention,
2648 Media.Comment AS comment,
2649 PoolRecycle.Name AS poolrecycle
2651 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2652 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2653 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2655 WHERE Media.VolumeName = $media->{qmedia}
2658 my $row = $self->dbh_selectrow_hashref($query);
2659 $row->{volretention} = human_sec($row->{volretention});
2660 $row->{voluseduration} = human_sec($row->{voluseduration});
2662 my $elt = $self->get_form(qw/db_pools db_locations/);
2667 }, "update_media.tpl");
2674 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2676 unless ($arg->{jmedias}) {
2677 return $self->error("Can't get selected media");
2680 unless ($arg->{qnewlocation}) {
2681 return $self->error("Can't get new location");
2686 SET LocationId = (SELECT LocationId
2688 WHERE Location = $arg->{qnewlocation})
2689 WHERE Media.VolumeName IN ($arg->{jmedias})
2692 my $nb = $self->dbh_do($query);
2694 print "$nb media updated, you may have to update your autochanger.";
2696 $self->display_media();
2703 my $medias = $self->get_selected_media_location();
2705 return $self->error("Can't get media selection");
2707 my $newloc = CGI::param('newlocation');
2709 my $user = CGI::param('user') || 'unknown';
2710 my $comm = CGI::param('comment') || '';
2711 $comm = $self->dbh_quote("$user: $comm");
2715 foreach my $media (keys %$medias) {
2717 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2719 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2720 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2721 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2724 $self->dbh_do($query);
2725 $self->debug($query);
2729 $q->param('action', 'update_location');
2730 my $url = $q->url(-full => 1, -query=>1);
2732 $self->display({ email => $self->{info}->{email_media},
2734 newlocation => $newloc,
2735 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81\81 },..]
2736 medias => [ values %$medias ],
2738 "change_location.tpl");
2742 sub display_client_stats
2744 my ($self, %arg) = @_ ;
2746 my $client = $self->dbh_quote($arg{clientname});
2748 my ($limit, $label) = $self->get_limit(%arg);
2752 count(Job.JobId) AS nb_jobs,
2753 sum(Job.JobBytes) AS nb_bytes,
2754 sum(Job.JobErrors) AS nb_err,
2755 sum(Job.JobFiles) AS nb_files,
2756 Client.Name AS clientname
2757 FROM Job JOIN Client USING (ClientId)
2759 Client.Name = $client
2761 GROUP BY Client.Name
2764 my $row = $self->dbh_selectrow_hashref($query);
2766 $row->{ID} = $cur_id++;
2767 $row->{label} = $label;
2768 $row->{grapharg} = "client";
2770 $self->display($row, "display_client_stats.tpl");
2774 sub display_group_stats
2776 my ($self, %arg) = @_ ;
2778 my $carg = $self->get_form(qw/qclient_group/);
2780 unless ($carg->{qclient_group}) {
2781 return $self->error("Can't get group");
2784 my ($limit, $label) = $self->get_limit(%arg);
2788 count(Job.JobId) AS nb_jobs,
2789 sum(Job.JobBytes) AS nb_bytes,
2790 sum(Job.JobErrors) AS nb_err,
2791 sum(Job.JobFiles) AS nb_files,
2792 client_group.client_group_name AS clientname
2793 FROM Job JOIN Client USING (ClientId)
2794 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
2795 JOIN client_group USING (client_group_id)
2797 client_group.client_group_name = $carg->{qclient_group}
2799 GROUP BY client_group.client_group_name
2802 my $row = $self->dbh_selectrow_hashref($query);
2804 $row->{ID} = $cur_id++;
2805 $row->{label} = $label;
2806 $row->{grapharg} = "client_group";
2808 $self->display($row, "display_client_stats.tpl");
2811 # poolname can be undef
2814 my ($self, $poolname) = @_ ;
2818 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2819 if ($arg->{jmediatypes}) {
2820 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2821 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2824 # TODO : afficher les tailles et les dates
2827 SELECT subq.volmax AS volmax,
2828 subq.volnum AS volnum,
2829 subq.voltotal AS voltotal,
2831 Pool.Recycle AS recycle,
2832 Pool.VolRetention AS volretention,
2833 Pool.VolUseDuration AS voluseduration,
2834 Pool.MaxVolJobs AS maxvoljobs,
2835 Pool.MaxVolFiles AS maxvolfiles,
2836 Pool.MaxVolBytes AS maxvolbytes,
2837 subq.PoolId AS PoolId,
2838 subq.MediaType AS mediatype,
2839 $self->{sql}->{CAT_POOL_TYPE} AS uniq
2842 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2843 count(Media.MediaId) AS volnum,
2844 sum(Media.VolBytes) AS voltotal,
2845 Media.PoolId AS PoolId,
2846 Media.MediaType AS MediaType
2848 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2849 Media.MediaType AS MediaType
2851 WHERE Media.VolStatus = 'Full'
2852 GROUP BY Media.MediaType
2853 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2854 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2856 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2860 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
2863 SELECT Pool.Name AS name,
2864 sum(VolBytes) AS size
2865 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2866 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2870 my $empty = $self->dbh_selectall_hashref($query, 'name');
2872 foreach my $p (values %$all) {
2873 if ($p->{volmax} > 0) { # mysql returns 0.0000
2874 # we remove Recycled/Purged media from pool usage
2875 if (defined $empty->{$p->{name}}) {
2876 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2878 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2880 $p->{poolusage} = 0;
2884 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2886 WHERE PoolId=$p->{poolid}
2887 AND Media.MediaType = '$p->{mediatype}'
2891 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2892 foreach my $t (values %$content) {
2893 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2898 $self->display({ ID => $cur_id++,
2899 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2900 Pools => [ values %$all ]},
2901 "display_pool.tpl");
2904 sub display_running_job
2908 my $arg = $self->get_form('client', 'jobid');
2910 if (!$arg->{client} and $arg->{jobid}) {
2913 SELECT Client.Name AS name
2914 FROM Job INNER JOIN Client USING (ClientId)
2915 WHERE Job.JobId = $arg->{jobid}
2918 my $row = $self->dbh_selectrow_hashref($query);
2921 $arg->{client} = $row->{name};
2922 CGI::param('client', $arg->{client});
2926 if ($arg->{client}) {
2927 my $cli = new Bweb::Client(name => $arg->{client});
2928 $cli->display_running_job($self->{info}, $arg->{jobid});
2929 if ($arg->{jobid}) {
2930 $self->get_job_log();
2933 $self->error("Can't get client or jobid");
2937 sub display_running_jobs
2939 my ($self, $display_action) = @_;
2942 SELECT Job.JobId AS jobid,
2943 Job.Name AS jobname,
2945 Job.StartTime AS starttime,
2946 Job.JobFiles AS jobfiles,
2947 Job.JobBytes AS jobbytes,
2948 Job.JobStatus AS jobstatus,
2949 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2950 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2952 Client.Name AS clientname
2953 FROM Job INNER JOIN Client USING (ClientId)
2954 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2956 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2958 $self->display({ ID => $cur_id++,
2959 display_action => $display_action,
2960 Jobs => [ values %$all ]},
2961 "running_job.tpl") ;
2964 # return the autochanger list to update
2969 my $arg = $self->get_form('jmedias');
2971 unless ($arg->{jmedias}) {
2972 return $self->error("Can't get media selection");
2976 SELECT Media.VolumeName AS volumename,
2977 Storage.Name AS storage,
2978 Location.Location AS location,
2980 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2981 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2982 WHERE Media.VolumeName IN ($arg->{jmedias})
2983 AND Media.InChanger = 1
2986 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2988 foreach my $vol (values %$all) {
2989 my $a = $self->ach_get($vol->{location});
2991 $ret{$vol->{location}} = 1;
2993 unless ($a->{have_status}) {
2995 $a->{have_status} = 1;
2998 print "eject $vol->{volumename} from $vol->{storage} : ";
2999 if ($a->send_to_io($vol->{slot})) {
3000 print "<img src='/bweb/T.png' alt='ok'><br/>";
3002 print "<img src='/bweb/E.png' alt='err'><br/>";
3012 my ($to, $subject, $content) = (CGI::param('email'),
3013 CGI::param('subject'),
3014 CGI::param('content'));
3015 $to =~ s/[^\w\d\.\@<>,]//;
3016 $subject =~ s/[^\w\d\.\[\]]/ /;
3018 open(MAIL, "|mail -s '$subject' '$to'") ;
3019 print MAIL $content;
3029 my $arg = $self->get_form('jobid', 'client');
3031 print CGI::header('text/brestore');
3032 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3033 print "client=$arg->{client}\n" if ($arg->{client});
3034 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3038 # TODO : move this to Bweb::Autochanger ?
3039 # TODO : make this internal to not eject tape ?
3045 my ($self, $name) = @_;
3048 return $self->error("Can't get your autochanger name ach");
3051 unless ($self->{info}->{ach_list}) {
3052 return $self->error("Could not find any autochanger");
3055 my $a = $self->{info}->{ach_list}->{$name};
3058 $self->error("Can't get your autochanger $name from your ach_list");
3063 $a->{debug} = $self->{debug};
3070 my ($self, $ach) = @_;
3072 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3074 $self->{info}->save();
3082 my $arg = $self->get_form('ach');
3084 or !$self->{info}->{ach_list}
3085 or !$self->{info}->{ach_list}->{$arg->{ach}})
3087 return $self->error("Can't get autochanger name");
3090 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3094 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3096 my $b = $self->get_bconsole();
3098 my @storages = $b->list_storage() ;
3100 $ach->{devices} = [ map { { name => $_ } } @storages ];
3102 $self->display($ach, "ach_add.tpl");
3103 delete $ach->{drives};
3104 delete $ach->{devices};
3111 my $arg = $self->get_form('ach');
3114 or !$self->{info}->{ach_list}
3115 or !$self->{info}->{ach_list}->{$arg->{ach}})
3117 return $self->error("Can't get autochanger name");
3120 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3122 $self->{info}->save();
3123 $self->{info}->view();
3129 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3131 my $b = $self->get_bconsole();
3132 my @storages = $b->list_storage() ;
3134 unless ($arg->{ach}) {
3135 $arg->{devices} = [ map { { name => $_ } } @storages ];
3136 return $self->display($arg, "ach_add.tpl");
3140 foreach my $drive (CGI::param('drives'))
3142 unless (grep(/^$drive$/,@storages)) {
3143 return $self->error("Can't find $drive in storage list");
3146 my $index = CGI::param("index_$drive");
3147 unless (defined $index and $index =~ /^(\d+)$/) {
3148 return $self->error("Can't get $drive index");
3151 $drives[$index] = $drive;
3155 return $self->error("Can't get drives from Autochanger");
3158 my $a = new Bweb::Autochanger(name => $arg->{ach},
3159 precmd => $arg->{precmd},
3160 drive_name => \@drives,
3161 device => $arg->{device},
3162 mtxcmd => $arg->{mtxcmd});
3164 $self->ach_register($a) ;
3166 $self->{info}->view();
3172 my $arg = $self->get_form('jobid');
3174 if ($arg->{jobid}) {
3175 my $b = $self->get_bconsole();
3176 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3180 title => "Delete a job ",
3181 name => "delete jobid=$arg->{jobid}",
3190 my $arg = $self->get_form(qw/media volstatus inchanger pool
3191 slot volretention voluseduration
3192 maxvoljobs maxvolfiles maxvolbytes
3193 qcomment poolrecycle
3196 unless ($arg->{media}) {
3197 return $self->error("Can't find media selection");
3200 my $update = "update volume=$arg->{media} ";
3202 if ($arg->{volstatus}) {
3203 $update .= " volstatus=$arg->{volstatus} ";
3206 if ($arg->{inchanger}) {
3207 $update .= " inchanger=yes " ;
3209 $update .= " slot=$arg->{slot} ";
3212 $update .= " slot=0 inchanger=no ";
3216 $update .= " pool=$arg->{pool} " ;
3219 if (defined $arg->{volretention}) {
3220 $update .= " volretention=\"$arg->{volretention}\" " ;
3223 if (defined $arg->{voluseduration}) {
3224 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3227 if (defined $arg->{maxvoljobs}) {
3228 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3231 if (defined $arg->{maxvolfiles}) {
3232 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3235 if (defined $arg->{maxvolbytes}) {
3236 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3239 if (defined $arg->{poolrecycle}) {
3240 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3243 my $b = $self->get_bconsole();
3246 content => $b->send_cmd($update),
3247 title => "Update a volume ",
3253 my $media = $self->dbh_quote($arg->{media});
3255 my $loc = CGI::param('location') || '';
3257 $loc = $self->dbh_quote($loc); # is checked by db
3258 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3260 if (!$arg->{qcomment}) {
3261 $arg->{qcomment} = "''";
3263 push @q, "Comment=$arg->{qcomment}";
3268 SET " . join (',', @q) . "
3269 WHERE Media.VolumeName = $media
3271 $self->dbh_do($query);
3273 $self->update_media();
3280 my $ach = CGI::param('ach') ;
3281 $ach = $self->ach_get($ach);
3283 return $self->error("Bad autochanger name");
3287 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3288 $b->update_slots($ach->{name});
3296 my $arg = $self->get_form('jobid', 'limit', 'offset');
3297 unless ($arg->{jobid}) {
3298 return $self->error("Can't get jobid");
3301 if ($arg->{limit} == 100) {
3302 $arg->{limit} = 1000;
3305 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3308 SELECT Job.Name as name, Client.Name as clientname
3309 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3310 WHERE JobId = $arg->{jobid}
3313 my $row = $self->dbh_selectrow_hashref($query);
3316 return $self->error("Can't find $arg->{jobid} in catalog");
3320 SELECT Time AS time, LogText AS log
3322 WHERE Log.JobId = $arg->{jobid}
3323 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3324 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3328 OFFSET $arg->{offset}
3331 my $log = $self->dbh_selectall_arrayref($query);
3333 return $self->error("Can't get log for jobid $arg->{jobid}");
3339 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3341 $logtxt = join("", map { $_->[1] } @$log ) ;
3344 $self->display({ lines=> $logtxt,
3345 jobid => $arg->{jobid},
3346 name => $row->{name},
3347 client => $row->{clientname},
3348 offset => $arg->{offset},
3349 limit => $arg->{limit},
3350 }, 'display_log.tpl');
3358 my $arg = $self->get_form('ach', 'slots', 'drive');
3360 unless ($arg->{ach}) {
3361 return $self->error("Can't find autochanger name");
3364 my $a = $self->ach_get($arg->{ach});
3366 return $self->error("Can't find autochanger name in configuration");
3369 my $storage = $a->get_drive_name($arg->{drive});
3371 return $self->error("Can't get your drive name");
3377 if ($arg->{slots}) {
3378 $slots = join(",", @{ $arg->{slots} });
3379 $slots_sql = " AND Slot IN ($slots) ";
3380 $t += 60*scalar( @{ $arg->{slots} }) ;
3383 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3384 print "<h1>This command can take long time, be patient...</h1>";
3386 $b->label_barcodes(storage => $storage,
3387 drive => $arg->{drive},
3395 SET LocationId = (SELECT LocationId
3397 WHERE Location = '$arg->{ach}')
3399 WHERE (LocationId = 0 OR LocationId IS NULL)
3409 my @volume = CGI::param('media');
3412 return $self->error("Can't get media selection");
3415 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3417 foreach my $v (@volume) {
3419 content => $b->purge_volume($v),
3420 title => "Purge media",
3421 name => "purge volume=$v",
3431 my @volume = CGI::param('media');
3433 return $self->error("Can't get media selection");
3436 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3438 foreach my $v (@volume) {
3440 content => $b->prune_volume($v),
3441 title => "Prune volume",
3442 name => "prune volume=$v",
3452 my $arg = $self->get_form('jobid');
3453 unless ($arg->{jobid}) {
3454 return $self->error("Can't get jobid");
3457 my $b = $self->get_bconsole();
3459 content => $b->cancel($arg->{jobid}),
3460 title => "Cancel job",
3461 name => "cancel jobid=$arg->{jobid}",
3467 # Warning, we display current fileset
3470 my $arg = $self->get_form('fileset');
3472 if ($arg->{fileset}) {
3473 my $b = $self->get_bconsole();
3474 my $ret = $b->get_fileset($arg->{fileset});
3475 $self->display({ fileset => $arg->{fileset},
3477 }, "fileset_view.tpl");
3479 $self->error("Can't get fileset name");
3483 sub director_show_sched
3487 my $arg = $self->get_form('days');
3489 my $b = $self->get_bconsole();
3490 my $ret = $b->director_get_sched( $arg->{days} );
3495 }, "scheduled_job.tpl");
3498 sub enable_disable_job
3500 my ($self, $what) = @_ ;
3502 my $name = CGI::param('job') || '';
3503 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3504 return $self->error("Can't find job name");
3507 my $b = $self->get_bconsole();
3517 content => $b->send_cmd("$cmd job=\"$name\""),
3518 title => "$cmd $name",
3519 name => "$cmd job=\"$name\"",
3526 return new Bconsole(pref => $self->{info});
3532 my $b = $self->get_bconsole();
3534 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3536 $self->display({ Jobs => $joblist }, "run_job.tpl");
3541 my ($self, $ouput) = @_;
3544 foreach my $l (split(/\r\n/, $ouput)) {
3545 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3551 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3557 foreach my $k (keys %arg) {
3558 $lowcase{lc($k)} = $arg{$k} ;
3567 my $b = $self->get_bconsole();
3569 my $job = CGI::param('job') || '';
3571 # we take informations from director, and we overwrite with user wish
3572 my $info = $b->send_cmd("show job=\"$job\"");
3573 my $attr = $self->run_parse_job($info);
3575 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3576 my %job_opt = (%$attr, %$arg);
3578 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3580 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3581 my $clients = [ map { { name => $_ } }$b->list_client()];
3582 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3583 my $storages= [ map { { name => $_ } }$b->list_storage()];
3588 clients => $clients,
3589 filesets => $filesets,
3590 storages => $storages,
3592 }, "run_job_mod.tpl");
3598 my $b = $self->get_bconsole();
3600 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3610 my $b = $self->get_bconsole();
3612 # TODO: check input (don't use pool, level)
3614 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3615 my $job = CGI::param('job') || '';
3616 my $storage = CGI::param('storage') || '';
3618 my $jobid = $b->run(job => $job,
3619 client => $arg->{client},
3620 priority => $arg->{priority},
3621 level => $arg->{level},
3622 storage => $storage,
3623 pool => $arg->{pool},
3624 fileset => $arg->{fileset},
3625 when => $arg->{when},
3628 print $jobid, $b->{error};
3630 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";