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 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1053 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1056 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1057 FROM_UNIXTIME => 'FROM_UNIXTIME',
1060 SEC_TO_TIME => 'SEC_TO_TIME',
1061 MATCH => " REGEXP ",
1062 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1063 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1064 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1065 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1066 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1067 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1068 # with mysql < 5, you have to play with the ugly SHOW command
1069 DB_SIZE => " SELECT 0 ",
1070 # works only with mysql 5
1071 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1072 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1080 $self->{dbh}->disconnect();
1085 sub dbh_selectall_arrayref
1087 my ($self, $query) = @_;
1088 $self->connect_db();
1089 $self->debug($query);
1090 return $self->{dbh}->selectall_arrayref($query);
1095 my ($self, @what) = @_;
1096 return join(',', $self->dbh_quote(@what)) ;
1101 my ($self, @what) = @_;
1103 $self->connect_db();
1105 return map { $self->{dbh}->quote($_) } @what;
1107 return $self->{dbh}->quote($what[0]) ;
1113 my ($self, $query) = @_ ;
1114 $self->connect_db();
1115 $self->debug($query);
1116 return $self->{dbh}->do($query);
1119 sub dbh_selectall_hashref
1121 my ($self, $query, $join) = @_;
1123 $self->connect_db();
1124 $self->debug($query);
1125 return $self->{dbh}->selectall_hashref($query, $join) ;
1128 sub dbh_selectrow_hashref
1130 my ($self, $query) = @_;
1132 $self->connect_db();
1133 $self->debug($query);
1134 return $self->{dbh}->selectrow_hashref($query) ;
1139 my ($self, @what) = @_;
1140 if ($self->{conf}->{connection_string} =~ /dbi:mysql/i) {
1141 return 'CONCAT(' . join(',', @what) . ')' ;
1143 return join(' || ', @what);
1149 my ($self, $query) = @_;
1150 $self->debug($query, up => 1);
1151 return $self->{dbh}->prepare($query);
1157 my @unit = qw(B KB MB GB TB);
1158 my $val = shift || 0;
1160 my $format = '%i %s';
1161 while ($val / 1024 > 1) {
1165 $format = ($i>0)?'%0.1f %s':'%i %s';
1166 return sprintf($format, $val, $unit[$i]);
1169 # display Day, Hour, Year
1175 $val /= 60; # sec -> min
1177 if ($val / 60 <= 1) {
1181 $val /= 60; # min -> hour
1182 if ($val / 24 <= 1) {
1183 return "$val hours";
1186 $val /= 24; # hour -> day
1187 if ($val / 365 < 2) {
1191 $val /= 365 ; # day -> year
1193 return "$val years";
1196 # get Day, Hour, Year
1202 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1206 my %times = ( m => 60,
1212 my $mult = $times{$2} || 0;
1222 unless ($self->{dbh}) {
1223 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1224 $self->{info}->{user},
1225 $self->{info}->{password});
1227 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1228 unless ($self->{dbh});
1230 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1232 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1233 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1240 my ($class, %arg) = @_;
1242 dbh => undef, # connect_db();
1244 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1250 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1252 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1253 $self->{sql} = $sql_func{$1};
1256 $self->{debug} = $self->{info}->{debug};
1257 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1265 $self->display($self->{info}, "begin.tpl");
1271 $self->display($self->{info}, "end.tpl");
1279 my $arg = $self->get_form("client", "qre_client", "jclient_groups", "qnotingroup");
1281 if ($arg->{qre_client}) {
1282 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1283 } elsif ($arg->{client}) {
1284 $where = "WHERE Name = '$arg->{client}' ";
1285 } elsif ($arg->{jclient_groups}) {
1286 $where = "JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
1287 JOIN client_group USING (client_group_id)
1288 WHERE client_group_name IN ($arg->{jclient_groups})";
1289 } elsif ($arg->{qnotingroup}) {
1292 (SELECT 1 FROM client_group_member
1293 WHERE Client.ClientId = client_group_member.ClientId
1300 SELECT Name AS name,
1302 AutoPrune AS autoprune,
1303 FileRetention AS fileretention,
1304 JobRetention AS jobretention
1309 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1311 my $dsp = { ID => $cur_id++,
1312 clients => [ values %$all] };
1314 $self->display($dsp, "client_list.tpl") ;
1319 my ($self, %arg) = @_;
1326 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1328 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1330 $self->{sql}->{TO_SEC}($arg{age})
1333 $label = "last " . human_sec($arg{age});
1336 if ($arg{groupby}) {
1337 $limit .= " GROUP BY $arg{groupby} ";
1341 $limit .= " ORDER BY $arg{order} ";
1345 $limit .= " LIMIT $arg{limit} ";
1346 $label .= " limited to $arg{limit}";
1350 $limit .= " OFFSET $arg{offset} ";
1351 $label .= " with $arg{offset} offset ";
1355 $label = 'no filter';
1358 return ($limit, $label);
1363 $bweb->get_form(...) - Get useful stuff
1367 This function get and check parameters against regexp.
1369 If word begin with 'q', the return will be quoted or join quoted
1370 if it's end with 's'.
1375 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1378 qclient => 'plume-fd',
1379 qpools => "'plume-fd', 'test-fd', '...'",
1386 my ($self, @what) = @_;
1387 my %what = map { $_ => 1 } @what;
1409 my %opt_ss =( # string with space
1413 my %opt_s = ( # default to ''
1430 my %opt_p = ( # option with path
1437 my %opt_r = (regexwhere => 1);
1439 my %opt_d = ( # option with date
1444 foreach my $i (@what) {
1445 if (exists $opt_i{$i}) {# integer param
1446 my $value = CGI::param($i) || $opt_i{$i} ;
1447 if ($value =~ /^(\d+)$/) {
1450 } elsif ($opt_s{$i}) { # simple string param
1451 my $value = CGI::param($i) || '';
1452 if ($value =~ /^([\w\d\.-]+)$/) {
1455 } elsif ($opt_ss{$i}) { # simple string param (with space)
1456 my $value = CGI::param($i) || '';
1457 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1460 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1461 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1463 $ret{$i} = $self->dbh_join(@value) ;
1466 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1467 my $value = CGI::param($1) ;
1469 $ret{$i} = $self->dbh_quote($value);
1472 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1473 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1474 grep { ! /^\s*$/ } CGI::param($1) ];
1475 } elsif (exists $opt_p{$i}) {
1476 my $value = CGI::param($i) || '';
1477 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1480 } elsif (exists $opt_r{$i}) {
1481 my $value = CGI::param($i) || '';
1482 if ($value =~ /^([^'"']+)$/) {
1485 } elsif (exists $opt_d{$i}) {
1486 my $value = CGI::param($i) || '';
1487 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1494 foreach my $s (CGI::param('slot')) {
1495 if ($s =~ /^(\d+)$/) {
1496 push @{$ret{slots}}, $s;
1502 my $when = CGI::param('when') || '';
1503 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1508 if ($what{db_clients}) {
1510 SELECT Client.Name as clientname
1514 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1515 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1519 if ($what{db_client_groups}) {
1521 SELECT client_group_name AS name
1525 my $grps = $self->dbh_selectall_hashref($query, 'name');
1526 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1530 if ($what{db_mediatypes}) {
1532 SELECT MediaType as mediatype
1536 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1537 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1541 if ($what{db_locations}) {
1543 SELECT Location as location, Cost as cost
1546 my $loc = $self->dbh_selectall_hashref($query, 'location');
1547 $ret{db_locations} = [ sort { $a->{location}
1553 if ($what{db_pools}) {
1554 my $query = "SELECT Name as name FROM Pool";
1556 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1557 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1560 if ($what{db_filesets}) {
1562 SELECT FileSet.FileSet AS fileset
1566 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1568 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1569 values %$filesets] ;
1572 if ($what{db_jobnames}) {
1574 SELECT DISTINCT Job.Name AS jobname
1578 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1580 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1581 values %$jobnames] ;
1584 if ($what{db_devices}) {
1586 SELECT Device.Name AS name
1590 my $devices = $self->dbh_selectall_hashref($query, 'name');
1592 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1603 my $fields = $self->get_form(qw/age level status clients filesets
1605 db_clients limit db_filesets width height
1606 qclients qfilesets qjobnames db_jobnames/);
1609 my $url = CGI::url(-full => 0,
1612 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1614 # this organisation is to keep user choice between 2 click
1615 # TODO : fileset and client selection doesn't work
1624 sub display_client_job
1626 my ($self, %arg) = @_ ;
1628 $arg{order} = ' Job.JobId DESC ';
1629 my ($limit, $label) = $self->get_limit(%arg);
1631 my $clientname = $self->dbh_quote($arg{clientname});
1634 SELECT DISTINCT Job.JobId AS jobid,
1635 Job.Name AS jobname,
1636 FileSet.FileSet AS fileset,
1638 StartTime AS starttime,
1639 JobFiles AS jobfiles,
1640 JobBytes AS jobbytes,
1641 JobStatus AS jobstatus,
1642 JobErrors AS joberrors
1644 FROM Client,Job,FileSet
1645 WHERE Client.Name=$clientname
1646 AND Client.ClientId=Job.ClientId
1647 AND Job.FileSetId=FileSet.FileSetId
1651 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1653 $self->display({ clientname => $arg{clientname},
1656 Jobs => [ values %$all ],
1658 "display_client_job.tpl") ;
1661 sub get_selected_media_location
1665 my $medias = $self->get_form('jmedias');
1667 unless ($medias->{jmedias}) {
1672 SELECT Media.VolumeName AS volumename, Location.Location AS location
1673 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1674 WHERE Media.VolumeName IN ($medias->{jmedias})
1677 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1679 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1690 my $medias = $self->get_selected_media_location();
1696 my $elt = $self->get_form('db_locations');
1698 $self->display({ ID => $cur_id++,
1699 %$elt, # db_locations
1701 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1711 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1713 $self->display($elt, "help_extern.tpl");
1716 sub help_extern_compute
1720 my $number = CGI::param('limit') || '' ;
1721 unless ($number =~ /^(\d+)$/) {
1722 return $self->error("Bad arg number : $number ");
1725 my ($sql, undef) = $self->get_param('pools',
1726 'locations', 'mediatypes');
1729 SELECT Media.VolumeName AS volumename,
1730 Media.VolStatus AS volstatus,
1731 Media.LastWritten AS lastwritten,
1732 Media.MediaType AS mediatype,
1733 Media.VolMounts AS volmounts,
1735 Media.Recycle AS recycle,
1736 $self->{sql}->{FROM_UNIXTIME}(
1737 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1738 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1741 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1742 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1744 WHERE Media.InChanger = 1
1745 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1747 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1751 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1753 $self->display({ Medias => [ values %$all ] },
1754 "help_extern_compute.tpl");
1761 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1762 $self->display($param, "help_intern.tpl");
1765 sub help_intern_compute
1769 my $number = CGI::param('limit') || '' ;
1770 unless ($number =~ /^(\d+)$/) {
1771 return $self->error("Bad arg number : $number ");
1774 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1776 if (CGI::param('expired')) {
1778 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1779 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1785 SELECT Media.VolumeName AS volumename,
1786 Media.VolStatus AS volstatus,
1787 Media.LastWritten AS lastwritten,
1788 Media.MediaType AS mediatype,
1789 Media.VolMounts AS volmounts,
1791 $self->{sql}->{FROM_UNIXTIME}(
1792 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1793 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1796 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1797 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1799 WHERE Media.InChanger <> 1
1800 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1801 AND Media.Recycle = 1
1803 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1807 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1809 $self->display({ Medias => [ values %$all ] },
1810 "help_intern_compute.tpl");
1816 my ($self, %arg) = @_ ;
1818 my ($limit, $label) = $self->get_limit(%arg);
1822 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1823 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1824 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1825 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1826 ($self->{sql}->{DB_SIZE}) AS db_size,
1827 (SELECT count(Job.JobId)
1829 WHERE Job.JobStatus IN ('E','e','f','A')
1832 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1835 my $row = $self->dbh_selectrow_hashref($query) ;
1837 $row->{nb_bytes} = human_size($row->{nb_bytes});
1839 $row->{db_size} = human_size($row->{db_size});
1840 $row->{label} = $label;
1842 $self->display($row, "general.tpl");
1847 my ($self, @what) = @_ ;
1848 my %elt = map { $_ => 1 } @what;
1853 if ($elt{clients}) {
1854 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1856 $ret{clients} = \@clients;
1857 my $str = $self->dbh_join(@clients);
1858 $limit .= "AND Client.Name IN ($str) ";
1862 if ($elt{client_groups}) {
1863 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1865 $ret{client_groups} = \@clients;
1866 my $str = $self->dbh_join(@clients);
1867 $limit .= "AND client_group_name IN ($str) ";
1871 if ($elt{filesets}) {
1872 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1874 $ret{filesets} = \@filesets;
1875 my $str = $self->dbh_join(@filesets);
1876 $limit .= "AND FileSet.FileSet IN ($str) ";
1880 if ($elt{mediatypes}) {
1881 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1883 $ret{mediatypes} = \@medias;
1884 my $str = $self->dbh_join(@medias);
1885 $limit .= "AND Media.MediaType IN ($str) ";
1890 my $client = CGI::param('client');
1891 $ret{client} = $client;
1892 $client = $self->dbh_join($client);
1893 $limit .= "AND Client.Name = $client ";
1897 my $level = CGI::param('level') || '';
1898 if ($level =~ /^(\w)$/) {
1900 $limit .= "AND Job.Level = '$1' ";
1905 my $jobid = CGI::param('jobid') || '';
1907 if ($jobid =~ /^(\d+)$/) {
1909 $limit .= "AND Job.JobId = '$1' ";
1914 my $status = CGI::param('status') || '';
1915 if ($status =~ /^(\w)$/) {
1918 $limit .= "AND Job.JobStatus IN ('f','E') ";
1919 } elsif ($1 eq 'W') {
1920 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1922 $limit .= "AND Job.JobStatus = '$1' ";
1927 if ($elt{volstatus}) {
1928 my $status = CGI::param('volstatus') || '';
1929 if ($status =~ /^(\w+)$/) {
1931 $limit .= "AND Media.VolStatus = '$1' ";
1935 if ($elt{locations}) {
1936 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1938 $ret{locations} = \@location;
1939 my $str = $self->dbh_join(@location);
1940 $limit .= "AND Location.Location IN ($str) ";
1945 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1947 $ret{pools} = \@pool;
1948 my $str = $self->dbh_join(@pool);
1949 $limit .= "AND Pool.Name IN ($str) ";
1953 if ($elt{location}) {
1954 my $location = CGI::param('location') || '';
1956 $ret{location} = $location;
1957 $location = $self->dbh_quote($location);
1958 $limit .= "AND Location.Location = $location ";
1963 my $pool = CGI::param('pool') || '';
1966 $pool = $self->dbh_quote($pool);
1967 $limit .= "AND Pool.Name = $pool ";
1971 if ($elt{jobtype}) {
1972 my $jobtype = CGI::param('jobtype') || '';
1973 if ($jobtype =~ /^(\w)$/) {
1975 $limit .= "AND Job.Type = '$1' ";
1979 return ($limit, %ret);
1990 my ($self, %arg) = @_ ;
1992 $arg{order} = ' Job.JobId DESC ';
1994 my ($limit, $label) = $self->get_limit(%arg);
1995 my ($where, undef) = $self->get_param('clients',
2005 if (CGI::param('client_group')) {
2007 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2008 LEFT JOIN client_group USING (client_group_id)
2013 SELECT Job.JobId AS jobid,
2014 Client.Name AS client,
2015 FileSet.FileSet AS fileset,
2016 Job.Name AS jobname,
2018 StartTime AS starttime,
2020 Pool.Name AS poolname,
2021 JobFiles AS jobfiles,
2022 JobBytes AS jobbytes,
2023 JobStatus AS jobstatus,
2024 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2025 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2028 JobErrors AS joberrors
2031 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2032 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2034 WHERE Client.ClientId=Job.ClientId
2035 AND Job.JobStatus NOT IN ('R', 'C')
2040 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2042 $self->display({ Filter => $label,
2046 sort { $a->{jobid} <=> $b->{jobid} }
2053 # display job informations
2054 sub display_job_zoom
2056 my ($self, $jobid) = @_ ;
2058 $jobid = $self->dbh_quote($jobid);
2061 SELECT DISTINCT Job.JobId AS jobid,
2062 Client.Name AS client,
2063 Job.Name AS jobname,
2064 FileSet.FileSet AS fileset,
2066 Pool.Name AS poolname,
2067 StartTime AS starttime,
2068 JobFiles AS jobfiles,
2069 JobBytes AS jobbytes,
2070 JobStatus AS jobstatus,
2071 JobErrors AS joberrors,
2072 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2073 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2076 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2077 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2078 WHERE Client.ClientId=Job.ClientId
2079 AND Job.JobId = $jobid
2082 my $row = $self->dbh_selectrow_hashref($query) ;
2084 # display all volumes associate with this job
2086 SELECT Media.VolumeName as volumename
2087 FROM Job,Media,JobMedia
2088 WHERE Job.JobId = $jobid
2089 AND JobMedia.JobId=Job.JobId
2090 AND JobMedia.MediaId=Media.MediaId
2093 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2095 $row->{volumes} = [ values %$all ] ;
2097 $self->display($row, "display_job_zoom.tpl");
2100 sub display_job_group
2102 my ($self, %arg) = @_;
2104 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2106 my ($where, undef) = $self->get_param('client_groups',
2112 SELECT client_group_name AS client_group_name,
2113 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2114 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2115 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2116 COALESCE(jobok.nbjobs,0) AS nbjobok,
2117 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2118 COALESCE(jobok.duration, '0:0:0') AS duration
2120 FROM client_group LEFT JOIN (
2121 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2122 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2123 SUM(JobErrors) AS joberrors,
2124 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2125 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2128 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2129 JOIN client_group USING (client_group_id)
2131 WHERE JobStatus = 'T'
2134 ) AS jobok USING (client_group_name) LEFT JOIN
2137 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2138 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2139 SUM(JobErrors) AS joberrors
2140 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2141 JOIN client_group USING (client_group_id)
2143 WHERE JobStatus IN ('f','E', 'A')
2146 ) AS joberr USING (client_group_name)
2150 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2152 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2155 $self->display($rep, "display_job_group.tpl");
2160 my ($self, %arg) = @_ ;
2162 my ($limit, $label) = $self->get_limit(%arg);
2163 my ($where, %elt) = $self->get_param('pools',
2168 my $arg = $self->get_form('jmedias', 'qre_media');
2170 if ($arg->{jmedias}) {
2171 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2173 if ($arg->{qre_media}) {
2174 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2178 SELECT Media.VolumeName AS volumename,
2179 Media.VolBytes AS volbytes,
2180 Media.VolStatus AS volstatus,
2181 Media.MediaType AS mediatype,
2182 Media.InChanger AS online,
2183 Media.LastWritten AS lastwritten,
2184 Location.Location AS location,
2185 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2186 Pool.Name AS poolname,
2187 $self->{sql}->{FROM_UNIXTIME}(
2188 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2189 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2192 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2193 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2194 Media.MediaType AS MediaType
2196 WHERE Media.VolStatus = 'Full'
2197 GROUP BY Media.MediaType
2198 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2200 WHERE Media.PoolId=Pool.PoolId
2205 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2207 $self->display({ ID => $cur_id++,
2209 Location => $elt{location},
2210 Medias => [ values %$all ]
2212 "display_media.tpl");
2219 my $pool = $self->get_form('db_pools');
2221 foreach my $name (@{ $pool->{db_pools} }) {
2222 CGI::param('pool', $name->{name});
2223 $self->display_media();
2227 sub display_media_zoom
2231 my $medias = $self->get_form('jmedias');
2233 unless ($medias->{jmedias}) {
2234 return $self->error("Can't get media selection");
2238 SELECT InChanger AS online,
2239 VolBytes AS nb_bytes,
2240 VolumeName AS volumename,
2241 VolStatus AS volstatus,
2242 VolMounts AS nb_mounts,
2243 Media.VolUseDuration AS voluseduration,
2244 Media.MaxVolJobs AS maxvoljobs,
2245 Media.MaxVolFiles AS maxvolfiles,
2246 Media.MaxVolBytes AS maxvolbytes,
2247 VolErrors AS nb_errors,
2248 Pool.Name AS poolname,
2249 Location.Location AS location,
2250 Media.Recycle AS recycle,
2251 Media.VolRetention AS volretention,
2252 Media.LastWritten AS lastwritten,
2253 Media.VolReadTime/1000000 AS volreadtime,
2254 Media.VolWriteTime/1000000 AS volwritetime,
2255 Media.RecycleCount AS recyclecount,
2256 Media.Comment AS comment,
2257 $self->{sql}->{FROM_UNIXTIME}(
2258 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2259 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2262 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2263 WHERE Pool.PoolId = Media.PoolId
2264 AND VolumeName IN ($medias->{jmedias})
2267 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2269 foreach my $media (values %$all) {
2270 my $mq = $self->dbh_quote($media->{volumename});
2273 SELECT DISTINCT Job.JobId AS jobid,
2275 Job.StartTime AS starttime,
2278 Job.JobFiles AS files,
2279 Job.JobBytes AS bytes,
2280 Job.jobstatus AS status
2281 FROM Media,JobMedia,Job
2282 WHERE Media.VolumeName=$mq
2283 AND Media.MediaId=JobMedia.MediaId
2284 AND JobMedia.JobId=Job.JobId
2287 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2290 SELECT LocationLog.Date AS date,
2291 Location.Location AS location,
2292 LocationLog.Comment AS comment
2293 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2294 WHERE Media.MediaId = LocationLog.MediaId
2295 AND Media.VolumeName = $mq
2299 my $log = $self->dbh_selectall_arrayref($query) ;
2301 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2304 $self->display({ jobs => [ values %$jobs ],
2305 LocationLog => $logtxt,
2307 "display_media_zoom.tpl");
2315 my $loc = $self->get_form('qlocation');
2316 unless ($loc->{qlocation}) {
2317 return $self->error("Can't get location");
2321 SELECT Location.Location AS location,
2322 Location.Cost AS cost,
2323 Location.Enabled AS enabled
2325 WHERE Location.Location = $loc->{qlocation}
2328 my $row = $self->dbh_selectrow_hashref($query);
2330 $self->display({ ID => $cur_id++,
2331 %$row }, "location_edit.tpl") ;
2339 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2340 unless ($arg->{qlocation}) {
2341 return $self->error("Can't get location");
2343 unless ($arg->{qnewlocation}) {
2344 return $self->error("Can't get new location name");
2346 unless ($arg->{cost}) {
2347 return $self->error("Can't get new cost");
2350 my $enabled = CGI::param('enabled') || '';
2351 $enabled = $enabled?1:0;
2354 UPDATE Location SET Cost = $arg->{cost},
2355 Location = $arg->{qnewlocation},
2357 WHERE Location.Location = $arg->{qlocation}
2360 $self->dbh_do($query);
2362 $self->location_display();
2368 my $arg = $self->get_form(qw/qlocation/) ;
2370 unless ($arg->{qlocation}) {
2371 return $self->error("Can't get location");
2375 SELECT count(Media.MediaId) AS nb
2376 FROM Media INNER JOIN Location USING (LocationID)
2377 WHERE Location = $arg->{qlocation}
2380 my $res = $self->dbh_selectrow_hashref($query);
2383 return $self->error("Sorry, the location must be empty");
2387 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2390 $self->dbh_do($query);
2392 $self->location_display();
2399 my $arg = $self->get_form(qw/qlocation cost/) ;
2401 unless ($arg->{qlocation}) {
2402 $self->display({}, "location_add.tpl");
2405 unless ($arg->{cost}) {
2406 return $self->error("Can't get new cost");
2409 my $enabled = CGI::param('enabled') || '';
2410 $enabled = $enabled?1:0;
2413 INSERT INTO Location (Location, Cost, Enabled)
2414 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2417 $self->dbh_do($query);
2419 $self->location_display();
2422 sub location_display
2427 SELECT Location.Location AS location,
2428 Location.Cost AS cost,
2429 Location.Enabled AS enabled,
2430 (SELECT count(Media.MediaId)
2432 WHERE Media.LocationId = Location.LocationId
2437 my $location = $self->dbh_selectall_hashref($query, 'location');
2439 $self->display({ ID => $cur_id++,
2440 Locations => [ values %$location ] },
2441 "display_location.tpl");
2448 my $medias = $self->get_selected_media_location();
2453 my $arg = $self->get_form('db_locations', 'qnewlocation');
2455 $self->display({ email => $self->{info}->{email_media},
2457 medias => [ values %$medias ],
2459 "update_location.tpl");
2462 ###########################################################
2468 my $grp = $self->get_form(qw/qclient_group db_clients/);
2471 unless ($grp->{qclient_group}) {
2472 return $self->error("Can't get group");
2477 FROM Client JOIN client_group_member using (clientid)
2478 JOIN client_group using (client_group_id)
2479 WHERE client_group_name = $grp->{qclient_group}
2482 my $row = $self->dbh_selectall_hashref($query, "name");
2484 $self->display({ ID => $cur_id++,
2485 client_group => $grp->{qclient_group},
2487 client_group_member => [ values %$row]},
2495 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2496 unless ($arg->{qclient_group}) {
2497 return $self->error("Can't get groups");
2500 $self->{dbh}->begin_work();
2503 DELETE FROM client_group_member
2504 WHERE client_group_id IN
2505 (SELECT client_group_id
2507 WHERE client_group_name = $arg->{qclient_group})
2509 $self->dbh_do($query);
2512 INSERT INTO client_group_member (clientid, client_group_id)
2514 (SELECT client_group_id
2516 WHERE client_group_name = $arg->{qclient_group})
2517 FROM Client WHERE Name IN ($arg->{jclients})
2520 $self->dbh_do($query);
2522 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2525 SET client_group_name = $arg->{qnewgroup}
2526 WHERE client_group_name = $arg->{qclient_group}
2529 $self->dbh_do($query);
2532 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2534 $self->display_groups();
2540 my $arg = $self->get_form(qw/qclient_group/);
2542 unless ($arg->{qclient_group}) {
2543 return $self->error("Can't get groups");
2546 $self->{dbh}->begin_work();
2549 DELETE FROM client_group_member
2550 WHERE client_group_id IN
2551 (SELECT client_group_id
2553 WHERE client_group_name = $arg->{qclient_group});
2555 DELETE FROM client_group
2556 WHERE client_group_name = $arg->{qclient_group};
2558 $self->dbh_do($query);
2560 $self->{dbh}->commit();
2562 $self->display_groups();
2569 my $arg = $self->get_form(qw/qclient_group/) ;
2571 unless ($arg->{qclient_group}) {
2572 $self->display({}, "groups_add.tpl");
2577 INSERT INTO client_group (client_group_name)
2578 VALUES ($arg->{qclient_group})
2581 $self->dbh_do($query);
2583 $self->display_groups();
2590 my $arg = $self->get_form(qw/db_client_groups/) ;
2592 if ($self->{dbh}->errstr) {
2593 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2598 $self->display({ ID => $cur_id++,
2600 "display_groups.tpl");
2603 ###########################################################
2605 sub get_media_max_size
2607 my ($self, $type) = @_;
2609 "SELECT avg(VolBytes) AS size
2611 WHERE Media.VolStatus = 'Full'
2612 AND Media.MediaType = '$type'
2615 my $res = $self->selectrow_hashref($query);
2618 return $res->{size};
2628 my $media = $self->get_form('qmedia');
2630 unless ($media->{qmedia}) {
2631 return $self->error("Can't get media");
2635 SELECT Media.Slot AS slot,
2636 PoolMedia.Name AS poolname,
2637 Media.VolStatus AS volstatus,
2638 Media.InChanger AS inchanger,
2639 Location.Location AS location,
2640 Media.VolumeName AS volumename,
2641 Media.MaxVolBytes AS maxvolbytes,
2642 Media.MaxVolJobs AS maxvoljobs,
2643 Media.MaxVolFiles AS maxvolfiles,
2644 Media.VolUseDuration AS voluseduration,
2645 Media.VolRetention AS volretention,
2646 Media.Comment AS comment,
2647 PoolRecycle.Name AS poolrecycle
2649 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2650 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2651 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2653 WHERE Media.VolumeName = $media->{qmedia}
2656 my $row = $self->dbh_selectrow_hashref($query);
2657 $row->{volretention} = human_sec($row->{volretention});
2658 $row->{voluseduration} = human_sec($row->{voluseduration});
2660 my $elt = $self->get_form(qw/db_pools db_locations/);
2665 }, "update_media.tpl");
2672 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2674 unless ($arg->{jmedias}) {
2675 return $self->error("Can't get selected media");
2678 unless ($arg->{qnewlocation}) {
2679 return $self->error("Can't get new location");
2684 SET LocationId = (SELECT LocationId
2686 WHERE Location = $arg->{qnewlocation})
2687 WHERE Media.VolumeName IN ($arg->{jmedias})
2690 my $nb = $self->dbh_do($query);
2692 print "$nb media updated, you may have to update your autochanger.";
2694 $self->display_media();
2701 my $medias = $self->get_selected_media_location();
2703 return $self->error("Can't get media selection");
2705 my $newloc = CGI::param('newlocation');
2707 my $user = CGI::param('user') || 'unknown';
2708 my $comm = CGI::param('comment') || '';
2709 $comm = $self->dbh_quote("$user: $comm");
2713 foreach my $media (keys %$medias) {
2715 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2717 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2718 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2719 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2722 $self->dbh_do($query);
2723 $self->debug($query);
2727 $q->param('action', 'update_location');
2728 my $url = $q->url(-full => 1, -query=>1);
2730 $self->display({ email => $self->{info}->{email_media},
2732 newlocation => $newloc,
2733 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81\81 },..]
2734 medias => [ values %$medias ],
2736 "change_location.tpl");
2740 sub display_client_stats
2742 my ($self, %arg) = @_ ;
2744 my $client = $self->dbh_quote($arg{clientname});
2746 my ($limit, $label) = $self->get_limit(%arg);
2750 count(Job.JobId) AS nb_jobs,
2751 sum(Job.JobBytes) AS nb_bytes,
2752 sum(Job.JobErrors) AS nb_err,
2753 sum(Job.JobFiles) AS nb_files,
2754 Client.Name AS clientname
2755 FROM Job JOIN Client USING (ClientId)
2757 Client.Name = $client
2759 GROUP BY Client.Name
2762 my $row = $self->dbh_selectrow_hashref($query);
2764 $row->{ID} = $cur_id++;
2765 $row->{label} = $label;
2766 $row->{grapharg} = "client";
2768 $self->display($row, "display_client_stats.tpl");
2772 sub display_group_stats
2774 my ($self, %arg) = @_ ;
2776 my $carg = $self->get_form(qw/qclient_group/);
2778 unless ($carg->{qclient_group}) {
2779 return $self->error("Can't get group");
2782 my ($limit, $label) = $self->get_limit(%arg);
2786 count(Job.JobId) AS nb_jobs,
2787 sum(Job.JobBytes) AS nb_bytes,
2788 sum(Job.JobErrors) AS nb_err,
2789 sum(Job.JobFiles) AS nb_files,
2790 client_group.client_group_name AS clientname
2791 FROM Job JOIN Client USING (ClientId)
2792 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
2793 JOIN client_group USING (client_group_id)
2795 client_group.client_group_name = $carg->{qclient_group}
2797 GROUP BY client_group.client_group_name
2800 my $row = $self->dbh_selectrow_hashref($query);
2802 $row->{ID} = $cur_id++;
2803 $row->{label} = $label;
2804 $row->{grapharg} = "client_group";
2806 $self->display($row, "display_client_stats.tpl");
2809 # poolname can be undef
2812 my ($self, $poolname) = @_ ;
2816 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2817 if ($arg->{jmediatypes}) {
2818 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2819 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2822 # TODO : afficher les tailles et les dates
2825 SELECT subq.volmax AS volmax,
2826 subq.volnum AS volnum,
2827 subq.voltotal AS voltotal,
2829 Pool.Recycle AS recycle,
2830 Pool.VolRetention AS volretention,
2831 Pool.VolUseDuration AS voluseduration,
2832 Pool.MaxVolJobs AS maxvoljobs,
2833 Pool.MaxVolFiles AS maxvolfiles,
2834 Pool.MaxVolBytes AS maxvolbytes,
2835 subq.PoolId AS PoolId,
2836 subq.MediaType AS mediatype,
2837 $self->{sql}->{CAT_POOL_TYPE} AS uniq
2840 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2841 count(Media.MediaId) AS volnum,
2842 sum(Media.VolBytes) AS voltotal,
2843 Media.PoolId AS PoolId,
2844 Media.MediaType AS MediaType
2846 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2847 Media.MediaType AS MediaType
2849 WHERE Media.VolStatus = 'Full'
2850 GROUP BY Media.MediaType
2851 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2852 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2854 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2858 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
2861 SELECT Pool.Name AS name,
2862 sum(VolBytes) AS size
2863 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2864 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2868 my $empty = $self->dbh_selectall_hashref($query, 'name');
2870 foreach my $p (values %$all) {
2871 if ($p->{volmax} > 0) { # mysql returns 0.0000
2872 # we remove Recycled/Purged media from pool usage
2873 if (defined $empty->{$p->{name}}) {
2874 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2876 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2878 $p->{poolusage} = 0;
2882 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2884 WHERE PoolId=$p->{poolid}
2885 AND Media.MediaType = '$p->{mediatype}'
2889 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2890 foreach my $t (values %$content) {
2891 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2896 $self->display({ ID => $cur_id++,
2897 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2898 Pools => [ values %$all ]},
2899 "display_pool.tpl");
2902 sub display_running_job
2906 my $arg = $self->get_form('client', 'jobid');
2908 if (!$arg->{client} and $arg->{jobid}) {
2911 SELECT Client.Name AS name
2912 FROM Job INNER JOIN Client USING (ClientId)
2913 WHERE Job.JobId = $arg->{jobid}
2916 my $row = $self->dbh_selectrow_hashref($query);
2919 $arg->{client} = $row->{name};
2920 CGI::param('client', $arg->{client});
2924 if ($arg->{client}) {
2925 my $cli = new Bweb::Client(name => $arg->{client});
2926 $cli->display_running_job($self->{info}, $arg->{jobid});
2927 if ($arg->{jobid}) {
2928 $self->get_job_log();
2931 $self->error("Can't get client or jobid");
2935 sub display_running_jobs
2937 my ($self, $display_action) = @_;
2940 SELECT Job.JobId AS jobid,
2941 Job.Name AS jobname,
2943 Job.StartTime AS starttime,
2944 Job.JobFiles AS jobfiles,
2945 Job.JobBytes AS jobbytes,
2946 Job.JobStatus AS jobstatus,
2947 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2948 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2950 Client.Name AS clientname
2951 FROM Job INNER JOIN Client USING (ClientId)
2952 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2954 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2956 $self->display({ ID => $cur_id++,
2957 display_action => $display_action,
2958 Jobs => [ values %$all ]},
2959 "running_job.tpl") ;
2962 # return the autochanger list to update
2967 my $arg = $self->get_form('jmedias');
2969 unless ($arg->{jmedias}) {
2970 return $self->error("Can't get media selection");
2974 SELECT Media.VolumeName AS volumename,
2975 Storage.Name AS storage,
2976 Location.Location AS location,
2978 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2979 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2980 WHERE Media.VolumeName IN ($arg->{jmedias})
2981 AND Media.InChanger = 1
2984 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2986 foreach my $vol (values %$all) {
2987 my $a = $self->ach_get($vol->{location});
2989 $ret{$vol->{location}} = 1;
2991 unless ($a->{have_status}) {
2993 $a->{have_status} = 1;
2996 print "eject $vol->{volumename} from $vol->{storage} : ";
2997 if ($a->send_to_io($vol->{slot})) {
2998 print "<img src='/bweb/T.png' alt='ok'><br/>";
3000 print "<img src='/bweb/E.png' alt='err'><br/>";
3010 my ($to, $subject, $content) = (CGI::param('email'),
3011 CGI::param('subject'),
3012 CGI::param('content'));
3013 $to =~ s/[^\w\d\.\@<>,]//;
3014 $subject =~ s/[^\w\d\.\[\]]/ /;
3016 open(MAIL, "|mail -s '$subject' '$to'") ;
3017 print MAIL $content;
3027 my $arg = $self->get_form('jobid', 'client');
3029 print CGI::header('text/brestore');
3030 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3031 print "client=$arg->{client}\n" if ($arg->{client});
3032 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3036 # TODO : move this to Bweb::Autochanger ?
3037 # TODO : make this internal to not eject tape ?
3043 my ($self, $name) = @_;
3046 return $self->error("Can't get your autochanger name ach");
3049 unless ($self->{info}->{ach_list}) {
3050 return $self->error("Could not find any autochanger");
3053 my $a = $self->{info}->{ach_list}->{$name};
3056 $self->error("Can't get your autochanger $name from your ach_list");
3061 $a->{debug} = $self->{debug};
3068 my ($self, $ach) = @_;
3070 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3072 $self->{info}->save();
3080 my $arg = $self->get_form('ach');
3082 or !$self->{info}->{ach_list}
3083 or !$self->{info}->{ach_list}->{$arg->{ach}})
3085 return $self->error("Can't get autochanger name");
3088 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3092 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3094 my $b = $self->get_bconsole();
3096 my @storages = $b->list_storage() ;
3098 $ach->{devices} = [ map { { name => $_ } } @storages ];
3100 $self->display($ach, "ach_add.tpl");
3101 delete $ach->{drives};
3102 delete $ach->{devices};
3109 my $arg = $self->get_form('ach');
3112 or !$self->{info}->{ach_list}
3113 or !$self->{info}->{ach_list}->{$arg->{ach}})
3115 return $self->error("Can't get autochanger name");
3118 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3120 $self->{info}->save();
3121 $self->{info}->view();
3127 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3129 my $b = $self->get_bconsole();
3130 my @storages = $b->list_storage() ;
3132 unless ($arg->{ach}) {
3133 $arg->{devices} = [ map { { name => $_ } } @storages ];
3134 return $self->display($arg, "ach_add.tpl");
3138 foreach my $drive (CGI::param('drives'))
3140 unless (grep(/^$drive$/,@storages)) {
3141 return $self->error("Can't find $drive in storage list");
3144 my $index = CGI::param("index_$drive");
3145 unless (defined $index and $index =~ /^(\d+)$/) {
3146 return $self->error("Can't get $drive index");
3149 $drives[$index] = $drive;
3153 return $self->error("Can't get drives from Autochanger");
3156 my $a = new Bweb::Autochanger(name => $arg->{ach},
3157 precmd => $arg->{precmd},
3158 drive_name => \@drives,
3159 device => $arg->{device},
3160 mtxcmd => $arg->{mtxcmd});
3162 $self->ach_register($a) ;
3164 $self->{info}->view();
3170 my $arg = $self->get_form('jobid');
3172 if ($arg->{jobid}) {
3173 my $b = $self->get_bconsole();
3174 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3178 title => "Delete a job ",
3179 name => "delete jobid=$arg->{jobid}",
3188 my $arg = $self->get_form(qw/media volstatus inchanger pool
3189 slot volretention voluseduration
3190 maxvoljobs maxvolfiles maxvolbytes
3191 qcomment poolrecycle
3194 unless ($arg->{media}) {
3195 return $self->error("Can't find media selection");
3198 my $update = "update volume=$arg->{media} ";
3200 if ($arg->{volstatus}) {
3201 $update .= " volstatus=$arg->{volstatus} ";
3204 if ($arg->{inchanger}) {
3205 $update .= " inchanger=yes " ;
3207 $update .= " slot=$arg->{slot} ";
3210 $update .= " slot=0 inchanger=no ";
3214 $update .= " pool=$arg->{pool} " ;
3217 if (defined $arg->{volretention}) {
3218 $update .= " volretention=\"$arg->{volretention}\" " ;
3221 if (defined $arg->{voluseduration}) {
3222 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3225 if (defined $arg->{maxvoljobs}) {
3226 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3229 if (defined $arg->{maxvolfiles}) {
3230 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3233 if (defined $arg->{maxvolbytes}) {
3234 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3237 if (defined $arg->{poolrecycle}) {
3238 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3241 my $b = $self->get_bconsole();
3244 content => $b->send_cmd($update),
3245 title => "Update a volume ",
3251 my $media = $self->dbh_quote($arg->{media});
3253 my $loc = CGI::param('location') || '';
3255 $loc = $self->dbh_quote($loc); # is checked by db
3256 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3258 if (!$arg->{qcomment}) {
3259 $arg->{qcomment} = "''";
3261 push @q, "Comment=$arg->{qcomment}";
3266 SET " . join (',', @q) . "
3267 WHERE Media.VolumeName = $media
3269 $self->dbh_do($query);
3271 $self->update_media();
3278 my $ach = CGI::param('ach') ;
3279 $ach = $self->ach_get($ach);
3281 return $self->error("Bad autochanger name");
3285 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3286 $b->update_slots($ach->{name});
3294 my $arg = $self->get_form('jobid', 'limit', 'offset');
3295 unless ($arg->{jobid}) {
3296 return $self->error("Can't get jobid");
3299 if ($arg->{limit} == 100) {
3300 $arg->{limit} = 1000;
3303 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3306 SELECT Job.Name as name, Client.Name as clientname
3307 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3308 WHERE JobId = $arg->{jobid}
3311 my $row = $self->dbh_selectrow_hashref($query);
3314 return $self->error("Can't find $arg->{jobid} in catalog");
3318 SELECT Time AS time, LogText AS log
3320 WHERE Log.JobId = $arg->{jobid}
3321 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3322 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3326 OFFSET $arg->{offset}
3329 my $log = $self->dbh_selectall_arrayref($query);
3331 return $self->error("Can't get log for jobid $arg->{jobid}");
3337 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3339 $logtxt = join("", map { $_->[1] } @$log ) ;
3342 $self->display({ lines=> $logtxt,
3343 jobid => $arg->{jobid},
3344 name => $row->{name},
3345 client => $row->{clientname},
3346 offset => $arg->{offset},
3347 limit => $arg->{limit},
3348 }, 'display_log.tpl');
3356 my $arg = $self->get_form('ach', 'slots', 'drive');
3358 unless ($arg->{ach}) {
3359 return $self->error("Can't find autochanger name");
3362 my $a = $self->ach_get($arg->{ach});
3364 return $self->error("Can't find autochanger name in configuration");
3367 my $storage = $a->get_drive_name($arg->{drive});
3369 return $self->error("Can't get your drive name");
3375 if ($arg->{slots}) {
3376 $slots = join(",", @{ $arg->{slots} });
3377 $slots_sql = " AND Slot IN ($slots) ";
3378 $t += 60*scalar( @{ $arg->{slots} }) ;
3381 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3382 print "<h1>This command can take long time, be patient...</h1>";
3384 $b->label_barcodes(storage => $storage,
3385 drive => $arg->{drive},
3393 SET LocationId = (SELECT LocationId
3395 WHERE Location = '$arg->{ach}')
3397 WHERE (LocationId = 0 OR LocationId IS NULL)
3407 my @volume = CGI::param('media');
3410 return $self->error("Can't get media selection");
3413 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3416 content => $b->purge_volume(@volume),
3417 title => "Purge media",
3418 name => "purge volume=" . join(' volume=', @volume),
3427 my @volume = CGI::param('media');
3429 return $self->error("Can't get media selection");
3432 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3435 content => $b->prune_volume(@volume),
3436 title => "Prune media",
3437 name => "prune volume=" . join(' volume=', @volume),
3447 my $arg = $self->get_form('jobid');
3448 unless ($arg->{jobid}) {
3449 return $self->error("Can't get jobid");
3452 my $b = $self->get_bconsole();
3454 content => $b->cancel($arg->{jobid}),
3455 title => "Cancel job",
3456 name => "cancel jobid=$arg->{jobid}",
3462 # Warning, we display current fileset
3465 my $arg = $self->get_form('fileset');
3467 if ($arg->{fileset}) {
3468 my $b = $self->get_bconsole();
3469 my $ret = $b->get_fileset($arg->{fileset});
3470 $self->display({ fileset => $arg->{fileset},
3472 }, "fileset_view.tpl");
3474 $self->error("Can't get fileset name");
3478 sub director_show_sched
3482 my $arg = $self->get_form('days');
3484 my $b = $self->get_bconsole();
3485 my $ret = $b->director_get_sched( $arg->{days} );
3490 }, "scheduled_job.tpl");
3493 sub enable_disable_job
3495 my ($self, $what) = @_ ;
3497 my $name = CGI::param('job') || '';
3498 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3499 return $self->error("Can't find job name");
3502 my $b = $self->get_bconsole();
3512 content => $b->send_cmd("$cmd job=\"$name\""),
3513 title => "$cmd $name",
3514 name => "$cmd job=\"$name\"",
3521 return new Bconsole(pref => $self->{info});
3527 my $b = $self->get_bconsole();
3529 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3531 $self->display({ Jobs => $joblist }, "run_job.tpl");
3536 my ($self, $ouput) = @_;
3539 foreach my $l (split(/\r\n/, $ouput)) {
3540 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3546 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3552 foreach my $k (keys %arg) {
3553 $lowcase{lc($k)} = $arg{$k} ;
3562 my $b = $self->get_bconsole();
3564 my $job = CGI::param('job') || '';
3566 # we take informations from director, and we overwrite with user wish
3567 my $info = $b->send_cmd("show job=\"$job\"");
3568 my $attr = $self->run_parse_job($info);
3570 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3571 my %job_opt = (%$attr, %$arg);
3573 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3575 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3576 my $clients = [ map { { name => $_ } }$b->list_client()];
3577 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3578 my $storages= [ map { { name => $_ } }$b->list_storage()];
3583 clients => $clients,
3584 filesets => $filesets,
3585 storages => $storages,
3587 }, "run_job_mod.tpl");
3593 my $b = $self->get_bconsole();
3595 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3605 my $b = $self->get_bconsole();
3607 # TODO: check input (don't use pool, level)
3609 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3610 my $job = CGI::param('job') || '';
3611 my $storage = CGI::param('storage') || '';
3613 my $jobid = $b->run(job => $job,
3614 client => $arg->{client},
3615 priority => $arg->{priority},
3616 level => $arg->{level},
3617 storage => $storage,
3618 pool => $arg->{pool},
3619 fileset => $arg->{fileset},
3620 when => $arg->{when},
3623 print $jobid, $b->{error};
3625 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";