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";
1201 my $val = shift || 0;
1203 if ($val == 1 or $val eq "yes") {
1205 } elsif ($val == 2 or $val eq "archived") {
1212 # get Day, Hour, Year
1218 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1222 my %times = ( m => 60,
1228 my $mult = $times{$2} || 0;
1238 unless ($self->{dbh}) {
1239 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1240 $self->{info}->{user},
1241 $self->{info}->{password});
1243 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1244 unless ($self->{dbh});
1246 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1248 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1249 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1256 my ($class, %arg) = @_;
1258 dbh => undef, # connect_db();
1260 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1266 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1268 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1269 $self->{sql} = $sql_func{$1};
1272 $self->{debug} = $self->{info}->{debug};
1273 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1281 $self->display($self->{info}, "begin.tpl");
1287 $self->display($self->{info}, "end.tpl");
1295 my $arg = $self->get_form("client", "qre_client", "jclient_groups", "qnotingroup");
1297 if ($arg->{qre_client}) {
1298 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1299 } elsif ($arg->{client}) {
1300 $where = "WHERE Name = '$arg->{client}' ";
1301 } elsif ($arg->{jclient_groups}) {
1302 $where = "JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
1303 JOIN client_group USING (client_group_id)
1304 WHERE client_group_name IN ($arg->{jclient_groups})";
1305 } elsif ($arg->{qnotingroup}) {
1308 (SELECT 1 FROM client_group_member
1309 WHERE Client.ClientId = client_group_member.ClientId
1316 SELECT Name AS name,
1318 AutoPrune AS autoprune,
1319 FileRetention AS fileretention,
1320 JobRetention AS jobretention
1325 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1327 my $dsp = { ID => $cur_id++,
1328 clients => [ values %$all] };
1330 $self->display($dsp, "client_list.tpl") ;
1335 my ($self, %arg) = @_;
1342 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1344 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1346 $self->{sql}->{TO_SEC}($arg{age})
1349 $label = "last " . human_sec($arg{age});
1352 if ($arg{groupby}) {
1353 $limit .= " GROUP BY $arg{groupby} ";
1357 $limit .= " ORDER BY $arg{order} ";
1361 $limit .= " LIMIT $arg{limit} ";
1362 $label .= " limited to $arg{limit}";
1366 $limit .= " OFFSET $arg{offset} ";
1367 $label .= " with $arg{offset} offset ";
1371 $label = 'no filter';
1374 return ($limit, $label);
1379 $bweb->get_form(...) - Get useful stuff
1383 This function get and check parameters against regexp.
1385 If word begin with 'q', the return will be quoted or join quoted
1386 if it's end with 's'.
1391 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1394 qclient => 'plume-fd',
1395 qpools => "'plume-fd', 'test-fd', '...'",
1402 my ($self, @what) = @_;
1403 my %what = map { $_ => 1 } @what;
1425 my %opt_ss =( # string with space
1429 my %opt_s = ( # default to ''
1448 my %opt_p = ( # option with path
1455 my %opt_r = (regexwhere => 1);
1457 my %opt_d = ( # option with date
1462 foreach my $i (@what) {
1463 if (exists $opt_i{$i}) {# integer param
1464 my $value = CGI::param($i) || $opt_i{$i} ;
1465 if ($value =~ /^(\d+)$/) {
1468 } elsif ($opt_s{$i}) { # simple string param
1469 my $value = CGI::param($i) || '';
1470 if ($value =~ /^([\w\d\.-]+)$/) {
1473 } elsif ($opt_ss{$i}) { # simple string param (with space)
1474 my $value = CGI::param($i) || '';
1475 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1478 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1479 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1481 $ret{$i} = $self->dbh_join(@value) ;
1484 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1485 my $value = CGI::param($1) ;
1487 $ret{$i} = $self->dbh_quote($value);
1490 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1491 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1492 grep { ! /^\s*$/ } CGI::param($1) ];
1493 } elsif (exists $opt_p{$i}) {
1494 my $value = CGI::param($i) || '';
1495 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1498 } elsif (exists $opt_r{$i}) {
1499 my $value = CGI::param($i) || '';
1500 if ($value =~ /^([^'"']+)$/) {
1503 } elsif (exists $opt_d{$i}) {
1504 my $value = CGI::param($i) || '';
1505 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1512 foreach my $s (CGI::param('slot')) {
1513 if ($s =~ /^(\d+)$/) {
1514 push @{$ret{slots}}, $s;
1520 my $when = CGI::param('when') || '';
1521 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1526 if ($what{db_clients}) {
1528 SELECT Client.Name as clientname
1532 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1533 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1537 if ($what{db_client_groups}) {
1539 SELECT client_group_name AS name
1543 my $grps = $self->dbh_selectall_hashref($query, 'name');
1544 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1548 if ($what{db_mediatypes}) {
1550 SELECT MediaType as mediatype
1554 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1555 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1559 if ($what{db_locations}) {
1561 SELECT Location as location, Cost as cost
1564 my $loc = $self->dbh_selectall_hashref($query, 'location');
1565 $ret{db_locations} = [ sort { $a->{location}
1571 if ($what{db_pools}) {
1572 my $query = "SELECT Name as name FROM Pool";
1574 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1575 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1578 if ($what{db_filesets}) {
1580 SELECT FileSet.FileSet AS fileset
1584 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1586 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1587 values %$filesets] ;
1590 if ($what{db_jobnames}) {
1592 SELECT DISTINCT Job.Name AS jobname
1596 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1598 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1599 values %$jobnames] ;
1602 if ($what{db_devices}) {
1604 SELECT Device.Name AS name
1608 my $devices = $self->dbh_selectall_hashref($query, 'name');
1610 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1621 my $fields = $self->get_form(qw/age level status clients filesets
1623 db_clients limit db_filesets width height
1624 qclients qfilesets qjobnames db_jobnames/);
1627 my $url = CGI::url(-full => 0,
1630 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1632 # this organisation is to keep user choice between 2 click
1633 # TODO : fileset and client selection doesn't work
1642 sub display_client_job
1644 my ($self, %arg) = @_ ;
1646 $arg{order} = ' Job.JobId DESC ';
1647 my ($limit, $label) = $self->get_limit(%arg);
1649 my $clientname = $self->dbh_quote($arg{clientname});
1652 SELECT DISTINCT Job.JobId AS jobid,
1653 Job.Name AS jobname,
1654 FileSet.FileSet AS fileset,
1656 StartTime AS starttime,
1657 JobFiles AS jobfiles,
1658 JobBytes AS jobbytes,
1659 JobStatus AS jobstatus,
1660 JobErrors AS joberrors
1662 FROM Client,Job,FileSet
1663 WHERE Client.Name=$clientname
1664 AND Client.ClientId=Job.ClientId
1665 AND Job.FileSetId=FileSet.FileSetId
1669 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1671 $self->display({ clientname => $arg{clientname},
1674 Jobs => [ values %$all ],
1676 "display_client_job.tpl") ;
1679 sub get_selected_media_location
1683 my $media = $self->get_form('jmedias');
1685 unless ($media->{jmedias}) {
1690 SELECT Media.VolumeName AS volumename, Location.Location AS location
1691 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1692 WHERE Media.VolumeName IN ($media->{jmedias})
1695 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1697 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1706 my ($self, $in) = @_ ;
1708 my $media = $self->get_selected_media_location();
1714 my $elt = $self->get_form('db_locations');
1716 $self->display({ ID => $cur_id++,
1717 enabled => human_enabled($in),
1718 %$elt, # db_locations
1720 sort { $a->{volumename} cmp $b->{volumename} } values %$media
1730 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1732 $self->display($elt, "help_extern.tpl");
1735 sub help_extern_compute
1739 my $number = CGI::param('limit') || '' ;
1740 unless ($number =~ /^(\d+)$/) {
1741 return $self->error("Bad arg number : $number ");
1744 my ($sql, undef) = $self->get_param('pools',
1745 'locations', 'mediatypes');
1748 SELECT Media.VolumeName AS volumename,
1749 Media.VolStatus AS volstatus,
1750 Media.LastWritten AS lastwritten,
1751 Media.MediaType AS mediatype,
1752 Media.VolMounts AS volmounts,
1754 Media.Recycle AS recycle,
1755 $self->{sql}->{FROM_UNIXTIME}(
1756 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1757 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1760 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1761 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1763 WHERE Media.InChanger = 1
1764 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1766 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1770 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1772 $self->display({ Media => [ values %$all ] },
1773 "help_extern_compute.tpl");
1780 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1781 $self->display($param, "help_intern.tpl");
1784 sub help_intern_compute
1788 my $number = CGI::param('limit') || '' ;
1789 unless ($number =~ /^(\d+)$/) {
1790 return $self->error("Bad arg number : $number ");
1793 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1795 if (CGI::param('expired')) {
1797 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1798 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1804 SELECT Media.VolumeName AS volumename,
1805 Media.VolStatus AS volstatus,
1806 Media.LastWritten AS lastwritten,
1807 Media.MediaType AS mediatype,
1808 Media.VolMounts AS volmounts,
1810 $self->{sql}->{FROM_UNIXTIME}(
1811 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1812 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1815 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1816 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1818 WHERE Media.InChanger <> 1
1819 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1820 AND Media.Recycle = 1
1822 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1826 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1828 $self->display({ Media => [ values %$all ] },
1829 "help_intern_compute.tpl");
1835 my ($self, %arg) = @_ ;
1837 my ($limit, $label) = $self->get_limit(%arg);
1841 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1842 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1843 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1844 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1845 ($self->{sql}->{DB_SIZE}) AS db_size,
1846 (SELECT count(Job.JobId)
1848 WHERE Job.JobStatus IN ('E','e','f','A')
1851 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1854 my $row = $self->dbh_selectrow_hashref($query) ;
1856 $row->{nb_bytes} = human_size($row->{nb_bytes});
1858 $row->{db_size} = human_size($row->{db_size});
1859 $row->{label} = $label;
1861 $self->display($row, "general.tpl");
1866 my ($self, @what) = @_ ;
1867 my %elt = map { $_ => 1 } @what;
1872 if ($elt{clients}) {
1873 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1875 $ret{clients} = \@clients;
1876 my $str = $self->dbh_join(@clients);
1877 $limit .= "AND Client.Name IN ($str) ";
1881 if ($elt{client_groups}) {
1882 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1884 $ret{client_groups} = \@clients;
1885 my $str = $self->dbh_join(@clients);
1886 $limit .= "AND client_group_name IN ($str) ";
1890 if ($elt{filesets}) {
1891 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1893 $ret{filesets} = \@filesets;
1894 my $str = $self->dbh_join(@filesets);
1895 $limit .= "AND FileSet.FileSet IN ($str) ";
1899 if ($elt{mediatypes}) {
1900 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
1902 $ret{mediatypes} = \@media;
1903 my $str = $self->dbh_join(@media);
1904 $limit .= "AND Media.MediaType IN ($str) ";
1909 my $client = CGI::param('client');
1910 $ret{client} = $client;
1911 $client = $self->dbh_join($client);
1912 $limit .= "AND Client.Name = $client ";
1916 my $level = CGI::param('level') || '';
1917 if ($level =~ /^(\w)$/) {
1919 $limit .= "AND Job.Level = '$1' ";
1924 my $jobid = CGI::param('jobid') || '';
1926 if ($jobid =~ /^(\d+)$/) {
1928 $limit .= "AND Job.JobId = '$1' ";
1933 my $status = CGI::param('status') || '';
1934 if ($status =~ /^(\w)$/) {
1937 $limit .= "AND Job.JobStatus IN ('f','E') ";
1938 } elsif ($1 eq 'W') {
1939 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1941 $limit .= "AND Job.JobStatus = '$1' ";
1946 if ($elt{volstatus}) {
1947 my $status = CGI::param('volstatus') || '';
1948 if ($status =~ /^(\w+)$/) {
1950 $limit .= "AND Media.VolStatus = '$1' ";
1954 if ($elt{locations}) {
1955 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1957 $ret{locations} = \@location;
1958 my $str = $self->dbh_join(@location);
1959 $limit .= "AND Location.Location IN ($str) ";
1964 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1966 $ret{pools} = \@pool;
1967 my $str = $self->dbh_join(@pool);
1968 $limit .= "AND Pool.Name IN ($str) ";
1972 if ($elt{location}) {
1973 my $location = CGI::param('location') || '';
1975 $ret{location} = $location;
1976 $location = $self->dbh_quote($location);
1977 $limit .= "AND Location.Location = $location ";
1982 my $pool = CGI::param('pool') || '';
1985 $pool = $self->dbh_quote($pool);
1986 $limit .= "AND Pool.Name = $pool ";
1990 if ($elt{jobtype}) {
1991 my $jobtype = CGI::param('jobtype') || '';
1992 if ($jobtype =~ /^(\w)$/) {
1994 $limit .= "AND Job.Type = '$1' ";
1998 return ($limit, %ret);
2009 my ($self, %arg) = @_ ;
2011 $arg{order} = ' Job.JobId DESC ';
2013 my ($limit, $label) = $self->get_limit(%arg);
2014 my ($where, undef) = $self->get_param('clients',
2024 if (CGI::param('client_group')) {
2026 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2027 LEFT JOIN client_group USING (client_group_id)
2032 SELECT Job.JobId AS jobid,
2033 Client.Name AS client,
2034 FileSet.FileSet AS fileset,
2035 Job.Name AS jobname,
2037 StartTime AS starttime,
2039 Pool.Name AS poolname,
2040 JobFiles AS jobfiles,
2041 JobBytes AS jobbytes,
2042 JobStatus AS jobstatus,
2043 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2044 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2047 JobErrors AS joberrors
2050 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2051 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2053 WHERE Client.ClientId=Job.ClientId
2054 AND Job.JobStatus NOT IN ('R', 'C')
2059 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2061 $self->display({ Filter => $label,
2065 sort { $a->{jobid} <=> $b->{jobid} }
2072 # display job informations
2073 sub display_job_zoom
2075 my ($self, $jobid) = @_ ;
2077 $jobid = $self->dbh_quote($jobid);
2080 SELECT DISTINCT Job.JobId AS jobid,
2081 Client.Name AS client,
2082 Job.Name AS jobname,
2083 FileSet.FileSet AS fileset,
2085 Pool.Name AS poolname,
2086 StartTime AS starttime,
2087 JobFiles AS jobfiles,
2088 JobBytes AS jobbytes,
2089 JobStatus AS jobstatus,
2090 JobErrors AS joberrors,
2091 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2092 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2095 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2096 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2097 WHERE Client.ClientId=Job.ClientId
2098 AND Job.JobId = $jobid
2101 my $row = $self->dbh_selectrow_hashref($query) ;
2103 # display all volumes associate with this job
2105 SELECT Media.VolumeName as volumename
2106 FROM Job,Media,JobMedia
2107 WHERE Job.JobId = $jobid
2108 AND JobMedia.JobId=Job.JobId
2109 AND JobMedia.MediaId=Media.MediaId
2112 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2114 $row->{volumes} = [ values %$all ] ;
2116 $self->display($row, "display_job_zoom.tpl");
2119 sub display_job_group
2121 my ($self, %arg) = @_;
2123 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2125 my ($where, undef) = $self->get_param('client_groups',
2131 SELECT client_group_name AS client_group_name,
2132 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2133 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2134 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2135 COALESCE(jobok.nbjobs,0) AS nbjobok,
2136 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2137 COALESCE(jobok.duration, '0:0:0') AS duration
2139 FROM client_group LEFT JOIN (
2140 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2141 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2142 SUM(JobErrors) AS joberrors,
2143 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2144 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2147 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2148 JOIN client_group USING (client_group_id)
2150 WHERE JobStatus = 'T'
2153 ) AS jobok USING (client_group_name) LEFT JOIN
2156 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2157 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2158 SUM(JobErrors) AS joberrors
2159 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2160 JOIN client_group USING (client_group_id)
2162 WHERE JobStatus IN ('f','E', 'A')
2165 ) AS joberr USING (client_group_name)
2169 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2171 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2174 $self->display($rep, "display_job_group.tpl");
2179 my ($self, %arg) = @_ ;
2181 my ($limit, $label) = $self->get_limit(%arg);
2182 my ($where, %elt) = $self->get_param('pools',
2187 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2189 if ($arg->{jmedias}) {
2190 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2192 if ($arg->{qre_media}) {
2193 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2195 if ($arg->{expired}) {
2197 AND VolStatus = 'Full'
2198 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2199 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2200 ) < NOW() " . $where ;
2204 SELECT Media.VolumeName AS volumename,
2205 Media.VolBytes AS volbytes,
2206 Media.VolStatus AS volstatus,
2207 Media.MediaType AS mediatype,
2208 Media.InChanger AS online,
2209 Media.LastWritten AS lastwritten,
2210 Location.Location AS location,
2211 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2212 Pool.Name AS poolname,
2213 $self->{sql}->{FROM_UNIXTIME}(
2214 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2215 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2218 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2219 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2220 Media.MediaType AS MediaType
2222 WHERE Media.VolStatus = 'Full'
2223 GROUP BY Media.MediaType
2224 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2226 WHERE Media.PoolId=Pool.PoolId
2231 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2233 $self->display({ ID => $cur_id++,
2235 Location => $elt{location},
2236 Media => [ values %$all ],
2238 "display_media.tpl");
2241 sub display_allmedia
2245 my $pool = $self->get_form('db_pools');
2247 foreach my $name (@{ $pool->{db_pools} }) {
2248 CGI::param('pool', $name->{name});
2249 $self->display_media();
2253 sub display_media_zoom
2257 my $media = $self->get_form('jmedias');
2259 unless ($media->{jmedias}) {
2260 return $self->error("Can't get media selection");
2264 SELECT InChanger AS online,
2265 Media.Enabled AS enabled,
2266 VolBytes AS nb_bytes,
2267 VolumeName AS volumename,
2268 VolStatus AS volstatus,
2269 VolMounts AS nb_mounts,
2270 Media.VolUseDuration AS voluseduration,
2271 Media.MaxVolJobs AS maxvoljobs,
2272 Media.MaxVolFiles AS maxvolfiles,
2273 Media.MaxVolBytes AS maxvolbytes,
2274 VolErrors AS nb_errors,
2275 Pool.Name AS poolname,
2276 Location.Location AS location,
2277 Media.Recycle AS recycle,
2278 Media.VolRetention AS volretention,
2279 Media.LastWritten AS lastwritten,
2280 Media.VolReadTime/1000000 AS volreadtime,
2281 Media.VolWriteTime/1000000 AS volwritetime,
2282 Media.RecycleCount AS recyclecount,
2283 Media.Comment AS comment,
2284 $self->{sql}->{FROM_UNIXTIME}(
2285 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2286 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2289 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2290 WHERE Pool.PoolId = Media.PoolId
2291 AND VolumeName IN ($media->{jmedias})
2294 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2296 foreach my $media (values %$all) {
2297 my $mq = $self->dbh_quote($media->{volumename});
2300 SELECT DISTINCT Job.JobId AS jobid,
2302 Job.StartTime AS starttime,
2305 Job.JobFiles AS files,
2306 Job.JobBytes AS bytes,
2307 Job.jobstatus AS status
2308 FROM Media,JobMedia,Job
2309 WHERE Media.VolumeName=$mq
2310 AND Media.MediaId=JobMedia.MediaId
2311 AND JobMedia.JobId=Job.JobId
2314 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2317 SELECT LocationLog.Date AS date,
2318 Location.Location AS location,
2319 LocationLog.Comment AS comment
2320 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2321 WHERE Media.MediaId = LocationLog.MediaId
2322 AND Media.VolumeName = $mq
2326 my $log = $self->dbh_selectall_arrayref($query) ;
2328 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2331 $self->display({ jobs => [ values %$jobs ],
2332 LocationLog => $logtxt,
2334 "display_media_zoom.tpl");
2342 my $loc = $self->get_form('qlocation');
2343 unless ($loc->{qlocation}) {
2344 return $self->error("Can't get location");
2348 SELECT Location.Location AS location,
2349 Location.Cost AS cost,
2350 Location.Enabled AS enabled
2352 WHERE Location.Location = $loc->{qlocation}
2355 my $row = $self->dbh_selectrow_hashref($query);
2357 $self->display({ ID => $cur_id++,
2358 %$row }, "location_edit.tpl") ;
2366 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2367 unless ($arg->{qlocation}) {
2368 return $self->error("Can't get location");
2370 unless ($arg->{qnewlocation}) {
2371 return $self->error("Can't get new location name");
2373 unless ($arg->{cost}) {
2374 return $self->error("Can't get new cost");
2377 my $enabled = CGI::param('enabled') || '';
2378 $enabled = $enabled?1:0;
2381 UPDATE Location SET Cost = $arg->{cost},
2382 Location = $arg->{qnewlocation},
2384 WHERE Location.Location = $arg->{qlocation}
2387 $self->dbh_do($query);
2389 $self->location_display();
2395 my $arg = $self->get_form(qw/qlocation/) ;
2397 unless ($arg->{qlocation}) {
2398 return $self->error("Can't get location");
2402 SELECT count(Media.MediaId) AS nb
2403 FROM Media INNER JOIN Location USING (LocationID)
2404 WHERE Location = $arg->{qlocation}
2407 my $res = $self->dbh_selectrow_hashref($query);
2410 return $self->error("Sorry, the location must be empty");
2414 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2417 $self->dbh_do($query);
2419 $self->location_display();
2426 my $arg = $self->get_form(qw/qlocation cost/) ;
2428 unless ($arg->{qlocation}) {
2429 $self->display({}, "location_add.tpl");
2432 unless ($arg->{cost}) {
2433 return $self->error("Can't get new cost");
2436 my $enabled = CGI::param('enabled') || '';
2437 $enabled = $enabled?1:0;
2440 INSERT INTO Location (Location, Cost, Enabled)
2441 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2444 $self->dbh_do($query);
2446 $self->location_display();
2449 sub location_display
2454 SELECT Location.Location AS location,
2455 Location.Cost AS cost,
2456 Location.Enabled AS enabled,
2457 (SELECT count(Media.MediaId)
2459 WHERE Media.LocationId = Location.LocationId
2464 my $location = $self->dbh_selectall_hashref($query, 'location');
2466 $self->display({ ID => $cur_id++,
2467 Locations => [ values %$location ] },
2468 "display_location.tpl");
2475 my $media = $self->get_selected_media_location();
2480 my $arg = $self->get_form('db_locations', 'qnewlocation');
2482 $self->display({ email => $self->{info}->{email_media},
2484 media => [ values %$media ],
2486 "update_location.tpl");
2489 ###########################################################
2495 my $grp = $self->get_form(qw/qclient_group db_clients/);
2498 unless ($grp->{qclient_group}) {
2499 return $self->error("Can't get group");
2504 FROM Client JOIN client_group_member using (clientid)
2505 JOIN client_group using (client_group_id)
2506 WHERE client_group_name = $grp->{qclient_group}
2509 my $row = $self->dbh_selectall_hashref($query, "name");
2511 $self->display({ ID => $cur_id++,
2512 client_group => $grp->{qclient_group},
2514 client_group_member => [ values %$row]},
2522 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2523 unless ($arg->{qclient_group}) {
2524 return $self->error("Can't get groups");
2527 $self->{dbh}->begin_work();
2530 DELETE FROM client_group_member
2531 WHERE client_group_id IN
2532 (SELECT client_group_id
2534 WHERE client_group_name = $arg->{qclient_group})
2536 $self->dbh_do($query);
2539 INSERT INTO client_group_member (clientid, client_group_id)
2541 (SELECT client_group_id
2543 WHERE client_group_name = $arg->{qclient_group})
2544 FROM Client WHERE Name IN ($arg->{jclients})
2547 $self->dbh_do($query);
2549 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2552 SET client_group_name = $arg->{qnewgroup}
2553 WHERE client_group_name = $arg->{qclient_group}
2556 $self->dbh_do($query);
2559 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2561 $self->display_groups();
2567 my $arg = $self->get_form(qw/qclient_group/);
2569 unless ($arg->{qclient_group}) {
2570 return $self->error("Can't get groups");
2573 $self->{dbh}->begin_work();
2576 DELETE FROM client_group_member
2577 WHERE client_group_id IN
2578 (SELECT client_group_id
2580 WHERE client_group_name = $arg->{qclient_group});
2582 DELETE FROM client_group
2583 WHERE client_group_name = $arg->{qclient_group};
2585 $self->dbh_do($query);
2587 $self->{dbh}->commit();
2589 $self->display_groups();
2596 my $arg = $self->get_form(qw/qclient_group/) ;
2598 unless ($arg->{qclient_group}) {
2599 $self->display({}, "groups_add.tpl");
2604 INSERT INTO client_group (client_group_name)
2605 VALUES ($arg->{qclient_group})
2608 $self->dbh_do($query);
2610 $self->display_groups();
2617 my $arg = $self->get_form(qw/db_client_groups/) ;
2619 if ($self->{dbh}->errstr) {
2620 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2625 $self->display({ ID => $cur_id++,
2627 "display_groups.tpl");
2630 ###########################################################
2632 sub get_media_max_size
2634 my ($self, $type) = @_;
2636 "SELECT avg(VolBytes) AS size
2638 WHERE Media.VolStatus = 'Full'
2639 AND Media.MediaType = '$type'
2642 my $res = $self->selectrow_hashref($query);
2645 return $res->{size};
2655 my $media = $self->get_form('qmedia');
2657 unless ($media->{qmedia}) {
2658 return $self->error("Can't get media");
2662 SELECT Media.Slot AS slot,
2663 PoolMedia.Name AS poolname,
2664 Media.VolStatus AS volstatus,
2665 Media.InChanger AS inchanger,
2666 Location.Location AS location,
2667 Media.VolumeName AS volumename,
2668 Media.MaxVolBytes AS maxvolbytes,
2669 Media.MaxVolJobs AS maxvoljobs,
2670 Media.MaxVolFiles AS maxvolfiles,
2671 Media.VolUseDuration AS voluseduration,
2672 Media.VolRetention AS volretention,
2673 Media.Comment AS comment,
2674 PoolRecycle.Name AS poolrecycle,
2675 Media.Enabled AS enabled
2677 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2678 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2679 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2681 WHERE Media.VolumeName = $media->{qmedia}
2684 my $row = $self->dbh_selectrow_hashref($query);
2685 $row->{volretention} = human_sec($row->{volretention});
2686 $row->{voluseduration} = human_sec($row->{voluseduration});
2687 $row->{enabled} = human_enabled($row->{enabled});
2689 my $elt = $self->get_form(qw/db_pools db_locations/);
2694 }, "update_media.tpl");
2701 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2703 unless ($arg->{jmedias}) {
2704 return $self->error("Can't get selected media");
2707 unless ($arg->{qnewlocation}) {
2708 return $self->error("Can't get new location");
2713 SET LocationId = (SELECT LocationId
2715 WHERE Location = $arg->{qnewlocation})
2716 WHERE Media.VolumeName IN ($arg->{jmedias})
2719 my $nb = $self->dbh_do($query);
2721 print "$nb media updated, you may have to update your autochanger.";
2723 $self->display_media();
2730 my $media = $self->get_selected_media_location();
2732 return $self->error("Can't get media selection");
2734 my $newloc = CGI::param('newlocation');
2736 my $user = CGI::param('user') || 'unknown';
2737 my $comm = CGI::param('comment') || '';
2738 $comm = $self->dbh_quote("$user: $comm");
2740 my $arg = $self->get_form('enabled');
2741 my $en = human_enabled($arg->{enabled});
2742 my $b = $self->get_bconsole();
2745 foreach my $vol (keys %$media) {
2747 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2749 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$vol'),
2750 (SELECT LocationId FROM Location WHERE Location = '$media->{$vol}->{location}'),
2751 (SELECT VolStatus FROM Media WHERE VolumeName = '$vol')
2754 $self->dbh_do($query);
2755 $self->debug($query);
2756 $b->send_cmd("update volume=\"$vol\" enabled=$en");
2761 $q->param('action', 'update_location');
2762 my $url = $q->url(-full => 1, -query=>1);
2764 $self->display({ email => $self->{info}->{email_media},
2766 newlocation => $newloc,
2767 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2768 media => [ values %$media ],
2770 "change_location.tpl");
2774 sub display_client_stats
2776 my ($self, %arg) = @_ ;
2778 my $client = $self->dbh_quote($arg{clientname});
2780 my ($limit, $label) = $self->get_limit(%arg);
2784 count(Job.JobId) AS nb_jobs,
2785 sum(Job.JobBytes) AS nb_bytes,
2786 sum(Job.JobErrors) AS nb_err,
2787 sum(Job.JobFiles) AS nb_files,
2788 Client.Name AS clientname
2789 FROM Job JOIN Client USING (ClientId)
2791 Client.Name = $client
2793 GROUP BY Client.Name
2796 my $row = $self->dbh_selectrow_hashref($query);
2798 $row->{ID} = $cur_id++;
2799 $row->{label} = $label;
2800 $row->{grapharg} = "client";
2802 $self->display($row, "display_client_stats.tpl");
2806 sub display_group_stats
2808 my ($self, %arg) = @_ ;
2810 my $carg = $self->get_form(qw/qclient_group/);
2812 unless ($carg->{qclient_group}) {
2813 return $self->error("Can't get group");
2816 my ($limit, $label) = $self->get_limit(%arg);
2820 count(Job.JobId) AS nb_jobs,
2821 sum(Job.JobBytes) AS nb_bytes,
2822 sum(Job.JobErrors) AS nb_err,
2823 sum(Job.JobFiles) AS nb_files,
2824 client_group.client_group_name AS clientname
2825 FROM Job JOIN Client USING (ClientId)
2826 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
2827 JOIN client_group USING (client_group_id)
2829 client_group.client_group_name = $carg->{qclient_group}
2831 GROUP BY client_group.client_group_name
2834 my $row = $self->dbh_selectrow_hashref($query);
2836 $row->{ID} = $cur_id++;
2837 $row->{label} = $label;
2838 $row->{grapharg} = "client_group";
2840 $self->display($row, "display_client_stats.tpl");
2843 # poolname can be undef
2846 my ($self, $poolname) = @_ ;
2850 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2851 if ($arg->{jmediatypes}) {
2852 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2853 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2856 # TODO : afficher les tailles et les dates
2859 SELECT subq.volmax AS volmax,
2860 subq.volnum AS volnum,
2861 subq.voltotal AS voltotal,
2863 Pool.Recycle AS recycle,
2864 Pool.VolRetention AS volretention,
2865 Pool.VolUseDuration AS voluseduration,
2866 Pool.MaxVolJobs AS maxvoljobs,
2867 Pool.MaxVolFiles AS maxvolfiles,
2868 Pool.MaxVolBytes AS maxvolbytes,
2869 subq.PoolId AS PoolId,
2870 subq.MediaType AS mediatype,
2871 $self->{sql}->{CAT_POOL_TYPE} AS uniq
2874 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2875 count(Media.MediaId) AS volnum,
2876 sum(Media.VolBytes) AS voltotal,
2877 Media.PoolId AS PoolId,
2878 Media.MediaType AS MediaType
2880 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2881 Media.MediaType AS MediaType
2883 WHERE Media.VolStatus = 'Full'
2884 GROUP BY Media.MediaType
2885 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2886 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2888 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2892 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
2895 SELECT Pool.Name AS name,
2896 sum(VolBytes) AS size
2897 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2898 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2902 my $empty = $self->dbh_selectall_hashref($query, 'name');
2904 foreach my $p (values %$all) {
2905 if ($p->{volmax} > 0) { # mysql returns 0.0000
2906 # we remove Recycled/Purged media from pool usage
2907 if (defined $empty->{$p->{name}}) {
2908 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2910 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2912 $p->{poolusage} = 0;
2916 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2918 WHERE PoolId=$p->{poolid}
2919 AND Media.MediaType = '$p->{mediatype}'
2923 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2924 foreach my $t (values %$content) {
2925 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2930 $self->display({ ID => $cur_id++,
2931 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2932 Pools => [ values %$all ]},
2933 "display_pool.tpl");
2936 sub display_running_job
2940 my $arg = $self->get_form('client', 'jobid');
2942 if (!$arg->{client} and $arg->{jobid}) {
2945 SELECT Client.Name AS name
2946 FROM Job INNER JOIN Client USING (ClientId)
2947 WHERE Job.JobId = $arg->{jobid}
2950 my $row = $self->dbh_selectrow_hashref($query);
2953 $arg->{client} = $row->{name};
2954 CGI::param('client', $arg->{client});
2958 if ($arg->{client}) {
2959 my $cli = new Bweb::Client(name => $arg->{client});
2960 $cli->display_running_job($self->{info}, $arg->{jobid});
2961 if ($arg->{jobid}) {
2962 $self->get_job_log();
2965 $self->error("Can't get client or jobid");
2969 sub display_running_jobs
2971 my ($self, $display_action) = @_;
2974 SELECT Job.JobId AS jobid,
2975 Job.Name AS jobname,
2977 Job.StartTime AS starttime,
2978 Job.JobFiles AS jobfiles,
2979 Job.JobBytes AS jobbytes,
2980 Job.JobStatus AS jobstatus,
2981 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2982 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2984 Client.Name AS clientname
2985 FROM Job INNER JOIN Client USING (ClientId)
2986 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2988 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2990 $self->display({ ID => $cur_id++,
2991 display_action => $display_action,
2992 Jobs => [ values %$all ]},
2993 "running_job.tpl") ;
2996 # return the autochanger list to update
3001 my $arg = $self->get_form('jmedias');
3003 unless ($arg->{jmedias}) {
3004 return $self->error("Can't get media selection");
3008 SELECT Media.VolumeName AS volumename,
3009 Storage.Name AS storage,
3010 Location.Location AS location,
3012 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
3013 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3014 WHERE Media.VolumeName IN ($arg->{jmedias})
3015 AND Media.InChanger = 1
3018 my $all = $self->dbh_selectall_hashref($query, 'volumename');
3020 foreach my $vol (values %$all) {
3021 my $a = $self->ach_get($vol->{location});
3023 $ret{$vol->{location}} = 1;
3025 unless ($a->{have_status}) {
3027 $a->{have_status} = 1;
3030 print "eject $vol->{volumename} from $vol->{storage} : ";
3031 if ($a->send_to_io($vol->{slot})) {
3032 print "<img src='/bweb/T.png' alt='ok'><br/>";
3034 print "<img src='/bweb/E.png' alt='err'><br/>";
3044 my ($to, $subject, $content) = (CGI::param('email'),
3045 CGI::param('subject'),
3046 CGI::param('content'));
3047 $to =~ s/[^\w\d\.\@<>,]//;
3048 $subject =~ s/[^\w\d\.\[\]]/ /;
3050 open(MAIL, "|mail -s '$subject' '$to'") ;
3051 print MAIL $content;
3061 my $arg = $self->get_form('jobid', 'client');
3063 print CGI::header('text/brestore');
3064 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3065 print "client=$arg->{client}\n" if ($arg->{client});
3066 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3070 # TODO : move this to Bweb::Autochanger ?
3071 # TODO : make this internal to not eject tape ?
3077 my ($self, $name) = @_;
3080 return $self->error("Can't get your autochanger name ach");
3083 unless ($self->{info}->{ach_list}) {
3084 return $self->error("Could not find any autochanger");
3087 my $a = $self->{info}->{ach_list}->{$name};
3090 $self->error("Can't get your autochanger $name from your ach_list");
3095 $a->{debug} = $self->{debug};
3102 my ($self, $ach) = @_;
3104 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3106 $self->{info}->save();
3114 my $arg = $self->get_form('ach');
3116 or !$self->{info}->{ach_list}
3117 or !$self->{info}->{ach_list}->{$arg->{ach}})
3119 return $self->error("Can't get autochanger name");
3122 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3126 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3128 my $b = $self->get_bconsole();
3130 my @storages = $b->list_storage() ;
3132 $ach->{devices} = [ map { { name => $_ } } @storages ];
3134 $self->display($ach, "ach_add.tpl");
3135 delete $ach->{drives};
3136 delete $ach->{devices};
3143 my $arg = $self->get_form('ach');
3146 or !$self->{info}->{ach_list}
3147 or !$self->{info}->{ach_list}->{$arg->{ach}})
3149 return $self->error("Can't get autochanger name");
3152 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3154 $self->{info}->save();
3155 $self->{info}->view();
3161 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3163 my $b = $self->get_bconsole();
3164 my @storages = $b->list_storage() ;
3166 unless ($arg->{ach}) {
3167 $arg->{devices} = [ map { { name => $_ } } @storages ];
3168 return $self->display($arg, "ach_add.tpl");
3172 foreach my $drive (CGI::param('drives'))
3174 unless (grep(/^$drive$/,@storages)) {
3175 return $self->error("Can't find $drive in storage list");
3178 my $index = CGI::param("index_$drive");
3179 unless (defined $index and $index =~ /^(\d+)$/) {
3180 return $self->error("Can't get $drive index");
3183 $drives[$index] = $drive;
3187 return $self->error("Can't get drives from Autochanger");
3190 my $a = new Bweb::Autochanger(name => $arg->{ach},
3191 precmd => $arg->{precmd},
3192 drive_name => \@drives,
3193 device => $arg->{device},
3194 mtxcmd => $arg->{mtxcmd});
3196 $self->ach_register($a) ;
3198 $self->{info}->view();
3204 my $arg = $self->get_form('jobid');
3206 if ($arg->{jobid}) {
3207 my $b = $self->get_bconsole();
3208 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3212 title => "Delete a job ",
3213 name => "delete jobid=$arg->{jobid}",
3222 my $arg = $self->get_form(qw/media volstatus inchanger pool
3223 slot volretention voluseduration
3224 maxvoljobs maxvolfiles maxvolbytes
3225 qcomment poolrecycle enabled
3228 unless ($arg->{media}) {
3229 return $self->error("Can't find media selection");
3232 my $update = "update volume=$arg->{media} ";
3234 if ($arg->{volstatus}) {
3235 $update .= " volstatus=$arg->{volstatus} ";
3238 if ($arg->{inchanger}) {
3239 $update .= " inchanger=yes " ;
3241 $update .= " slot=$arg->{slot} ";
3244 $update .= " slot=0 inchanger=no ";
3247 if ($arg->{enabled}) {
3248 $update .= " enabled=$arg->{enabled} ";
3252 $update .= " pool=$arg->{pool} " ;
3255 if (defined $arg->{volretention}) {
3256 $update .= " volretention=\"$arg->{volretention}\" " ;
3259 if (defined $arg->{voluseduration}) {
3260 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3263 if (defined $arg->{maxvoljobs}) {
3264 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3267 if (defined $arg->{maxvolfiles}) {
3268 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3271 if (defined $arg->{maxvolbytes}) {
3272 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3275 if (defined $arg->{poolrecycle}) {
3276 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3279 my $b = $self->get_bconsole();
3282 content => $b->send_cmd($update),
3283 title => "Update a volume ",
3289 my $media = $self->dbh_quote($arg->{media});
3291 my $loc = CGI::param('location') || '';
3293 $loc = $self->dbh_quote($loc); # is checked by db
3294 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3296 if (!$arg->{qcomment}) {
3297 $arg->{qcomment} = "''";
3299 push @q, "Comment=$arg->{qcomment}";
3304 SET " . join (',', @q) . "
3305 WHERE Media.VolumeName = $media
3307 $self->dbh_do($query);
3309 $self->update_media();
3316 my $ach = CGI::param('ach') ;
3317 $ach = $self->ach_get($ach);
3319 return $self->error("Bad autochanger name");
3323 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3324 $b->update_slots($ach->{name});
3332 my $arg = $self->get_form('jobid', 'limit', 'offset');
3333 unless ($arg->{jobid}) {
3334 return $self->error("Can't get jobid");
3337 if ($arg->{limit} == 100) {
3338 $arg->{limit} = 1000;
3341 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3343 # display only Error and Warning messages
3345 if (CGI::param('error')) {
3346 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning' ";
3350 SELECT Job.Name as name, Client.Name as clientname
3351 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3352 WHERE JobId = $arg->{jobid}
3355 my $row = $self->dbh_selectrow_hashref($query);
3358 return $self->error("Can't find $arg->{jobid} in catalog");
3362 SELECT Time AS time, LogText AS log
3364 WHERE ( Log.JobId = $arg->{jobid}
3365 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3366 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3371 OFFSET $arg->{offset}
3374 my $log = $self->dbh_selectall_arrayref($query);
3376 return $self->error("Can't get log for jobid $arg->{jobid}");
3382 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3384 $logtxt = join("", map { $_->[1] } @$log ) ;
3387 $self->display({ lines=> $logtxt,
3388 jobid => $arg->{jobid},
3389 name => $row->{name},
3390 client => $row->{clientname},
3391 offset => $arg->{offset},
3392 limit => $arg->{limit},
3393 }, 'display_log.tpl');
3401 my $arg = $self->get_form('ach', 'slots', 'drive');
3403 unless ($arg->{ach}) {
3404 return $self->error("Can't find autochanger name");
3407 my $a = $self->ach_get($arg->{ach});
3409 return $self->error("Can't find autochanger name in configuration");
3412 my $storage = $a->get_drive_name($arg->{drive});
3414 return $self->error("Can't get your drive name");
3420 if ($arg->{slots}) {
3421 $slots = join(",", @{ $arg->{slots} });
3422 $slots_sql = " AND Slot IN ($slots) ";
3423 $t += 60*scalar( @{ $arg->{slots} }) ;
3426 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3427 print "<h1>This command can take long time, be patient...</h1>";
3429 $b->label_barcodes(storage => $storage,
3430 drive => $arg->{drive},
3438 SET LocationId = (SELECT LocationId
3440 WHERE Location = '$arg->{ach}')
3442 WHERE (LocationId = 0 OR LocationId IS NULL)
3452 my @volume = CGI::param('media');
3455 return $self->error("Can't get media selection");
3458 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3460 foreach my $v (@volume) {
3462 content => $b->purge_volume($v),
3463 title => "Purge media",
3464 name => "purge volume=$v",
3474 my @volume = CGI::param('media');
3476 return $self->error("Can't get media selection");
3479 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3481 foreach my $v (@volume) {
3483 content => $b->prune_volume($v),
3484 title => "Prune volume",
3485 name => "prune volume=$v",
3495 my $arg = $self->get_form('jobid');
3496 unless ($arg->{jobid}) {
3497 return $self->error("Can't get jobid");
3500 my $b = $self->get_bconsole();
3502 content => $b->cancel($arg->{jobid}),
3503 title => "Cancel job",
3504 name => "cancel jobid=$arg->{jobid}",
3510 # Warning, we display current fileset
3513 my $arg = $self->get_form('fileset');
3515 if ($arg->{fileset}) {
3516 my $b = $self->get_bconsole();
3517 my $ret = $b->get_fileset($arg->{fileset});
3518 $self->display({ fileset => $arg->{fileset},
3520 }, "fileset_view.tpl");
3522 $self->error("Can't get fileset name");
3526 sub director_show_sched
3530 my $arg = $self->get_form('days');
3532 my $b = $self->get_bconsole();
3533 my $ret = $b->director_get_sched( $arg->{days} );
3538 }, "scheduled_job.tpl");
3541 sub enable_disable_job
3543 my ($self, $what) = @_ ;
3545 my $name = CGI::param('job') || '';
3546 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3547 return $self->error("Can't find job name");
3550 my $b = $self->get_bconsole();
3560 content => $b->send_cmd("$cmd job=\"$name\""),
3561 title => "$cmd $name",
3562 name => "$cmd job=\"$name\"",
3569 return new Bconsole(pref => $self->{info});
3575 my $b = $self->get_bconsole();
3577 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3579 $self->display({ Jobs => $joblist }, "run_job.tpl");
3584 my ($self, $ouput) = @_;
3587 foreach my $l (split(/\r\n/, $ouput)) {
3588 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3594 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3600 foreach my $k (keys %arg) {
3601 $lowcase{lc($k)} = $arg{$k} ;
3610 my $b = $self->get_bconsole();
3612 my $job = CGI::param('job') || '';
3614 # we take informations from director, and we overwrite with user wish
3615 my $info = $b->send_cmd("show job=\"$job\"");
3616 my $attr = $self->run_parse_job($info);
3618 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3619 my %job_opt = (%$attr, %$arg);
3621 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3623 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3624 my $clients = [ map { { name => $_ } }$b->list_client()];
3625 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3626 my $storages= [ map { { name => $_ } }$b->list_storage()];
3631 clients => $clients,
3632 filesets => $filesets,
3633 storages => $storages,
3635 }, "run_job_mod.tpl");
3641 my $b = $self->get_bconsole();
3643 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3653 my $b = $self->get_bconsole();
3655 # TODO: check input (don't use pool, level)
3657 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3658 my $job = CGI::param('job') || '';
3659 my $storage = CGI::param('storage') || '';
3661 my $jobid = $b->run(job => $job,
3662 client => $arg->{client},
3663 priority => $arg->{priority},
3664 level => $arg->{level},
3665 storage => $storage,
3666 pool => $arg->{pool},
3667 fileset => $arg->{fileset},
3668 when => $arg->{when},
3671 print $jobid, $b->{error};
3673 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";