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()) ",
1055 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1056 FROM_UNIXTIME => 'FROM_UNIXTIME',
1059 SEC_TO_TIME => 'SEC_TO_TIME',
1060 MATCH => " REGEXP ",
1061 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1062 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1063 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1064 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1065 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1066 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1067 # with mysql < 5, you have to play with the ugly SHOW command
1068 DB_SIZE => " SELECT 0 ",
1069 # works only with mysql 5
1070 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1078 $self->{dbh}->disconnect();
1083 sub dbh_selectall_arrayref
1085 my ($self, $query) = @_;
1086 $self->connect_db();
1087 $self->debug($query);
1088 return $self->{dbh}->selectall_arrayref($query);
1093 my ($self, @what) = @_;
1094 return join(',', $self->dbh_quote(@what)) ;
1099 my ($self, @what) = @_;
1101 $self->connect_db();
1103 return map { $self->{dbh}->quote($_) } @what;
1105 return $self->{dbh}->quote($what[0]) ;
1111 my ($self, $query) = @_ ;
1112 $self->connect_db();
1113 $self->debug($query);
1114 return $self->{dbh}->do($query);
1117 sub dbh_selectall_hashref
1119 my ($self, $query, $join) = @_;
1121 $self->connect_db();
1122 $self->debug($query);
1123 return $self->{dbh}->selectall_hashref($query, $join) ;
1126 sub dbh_selectrow_hashref
1128 my ($self, $query) = @_;
1130 $self->connect_db();
1131 $self->debug($query);
1132 return $self->{dbh}->selectrow_hashref($query) ;
1138 my @unit = qw(b Kb Mb Gb Tb);
1139 my $val = shift || 0;
1141 my $format = '%i %s';
1142 while ($val / 1024 > 1) {
1146 $format = ($i>0)?'%0.1f %s':'%i %s';
1147 return sprintf($format, $val, $unit[$i]);
1150 # display Day, Hour, Year
1156 $val /= 60; # sec -> min
1158 if ($val / 60 <= 1) {
1162 $val /= 60; # min -> hour
1163 if ($val / 24 <= 1) {
1164 return "$val hours";
1167 $val /= 24; # hour -> day
1168 if ($val / 365 < 2) {
1172 $val /= 365 ; # day -> year
1174 return "$val years";
1177 # get Day, Hour, Year
1183 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1187 my %times = ( m => 60,
1193 my $mult = $times{$2} || 0;
1203 unless ($self->{dbh}) {
1204 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1205 $self->{info}->{user},
1206 $self->{info}->{password});
1208 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1209 unless ($self->{dbh});
1211 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1213 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1214 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1221 my ($class, %arg) = @_;
1223 dbh => undef, # connect_db();
1225 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1231 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1233 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1234 $self->{sql} = $sql_func{$1};
1237 $self->{debug} = $self->{info}->{debug};
1238 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1246 $self->display($self->{info}, "begin.tpl");
1252 $self->display($self->{info}, "end.tpl");
1260 my $arg = $self->get_form("client", "qre_client");
1262 if ($arg->{qre_client}) {
1263 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1264 } elsif ($arg->{client}) {
1265 $where = "WHERE Name = '$arg->{client}' ";
1269 SELECT Name AS name,
1271 AutoPrune AS autoprune,
1272 FileRetention AS fileretention,
1273 JobRetention AS jobretention
1278 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1280 my $dsp = { ID => $cur_id++,
1281 clients => [ values %$all] };
1283 $self->display($dsp, "client_list.tpl") ;
1288 my ($self, %arg) = @_;
1295 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1297 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1299 $self->{sql}->{TO_SEC}($arg{age})
1302 $label = "last " . human_sec($arg{age});
1305 if ($arg{groupby}) {
1306 $limit .= " GROUP BY $arg{groupby} ";
1310 $limit .= " ORDER BY $arg{order} ";
1314 $limit .= " LIMIT $arg{limit} ";
1315 $label .= " limited to $arg{limit}";
1319 $limit .= " OFFSET $arg{offset} ";
1320 $label .= " with $arg{offset} offset ";
1324 $label = 'no filter';
1327 return ($limit, $label);
1332 $bweb->get_form(...) - Get useful stuff
1336 This function get and check parameters against regexp.
1338 If word begin with 'q', the return will be quoted or join quoted
1339 if it's end with 's'.
1344 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1347 qclient => 'plume-fd',
1348 qpools => "'plume-fd', 'test-fd', '...'",
1355 my ($self, @what) = @_;
1356 my %what = map { $_ => 1 } @what;
1376 my %opt_ss =( # string with space
1380 my %opt_s = ( # default to ''
1397 my %opt_p = ( # option with path
1404 my %opt_r = (regexwhere => 1);
1406 my %opt_d = ( # option with date
1411 foreach my $i (@what) {
1412 if (exists $opt_i{$i}) {# integer param
1413 my $value = CGI::param($i) || $opt_i{$i} ;
1414 if ($value =~ /^(\d+)$/) {
1417 } elsif ($opt_s{$i}) { # simple string param
1418 my $value = CGI::param($i) || '';
1419 if ($value =~ /^([\w\d\.-]+)$/) {
1422 } elsif ($opt_ss{$i}) { # simple string param (with space)
1423 my $value = CGI::param($i) || '';
1424 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1427 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1428 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1430 $ret{$i} = $self->dbh_join(@value) ;
1433 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1434 my $value = CGI::param($1) ;
1436 $ret{$i} = $self->dbh_quote($value);
1439 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1440 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1441 grep { ! /^\s*$/ } CGI::param($1) ];
1442 } elsif (exists $opt_p{$i}) {
1443 my $value = CGI::param($i) || '';
1444 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1447 } elsif (exists $opt_r{$i}) {
1448 my $value = CGI::param($i) || '';
1449 if ($value =~ /^([^'"']+)$/) {
1452 } elsif (exists $opt_d{$i}) {
1453 my $value = CGI::param($i) || '';
1454 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1461 foreach my $s (CGI::param('slot')) {
1462 if ($s =~ /^(\d+)$/) {
1463 push @{$ret{slots}}, $s;
1469 my $when = CGI::param('when') || '';
1470 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1475 if ($what{db_clients}) {
1477 SELECT Client.Name as clientname
1481 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1482 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1486 if ($what{db_client_groups}) {
1488 SELECT client_group_name AS name
1492 my $grps = $self->dbh_selectall_hashref($query, 'name');
1493 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1497 if ($what{db_mediatypes}) {
1499 SELECT MediaType as mediatype
1503 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1504 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1508 if ($what{db_locations}) {
1510 SELECT Location as location, Cost as cost
1513 my $loc = $self->dbh_selectall_hashref($query, 'location');
1514 $ret{db_locations} = [ sort { $a->{location}
1520 if ($what{db_pools}) {
1521 my $query = "SELECT Name as name FROM Pool";
1523 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1524 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1527 if ($what{db_filesets}) {
1529 SELECT FileSet.FileSet AS fileset
1533 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1535 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1536 values %$filesets] ;
1539 if ($what{db_jobnames}) {
1541 SELECT DISTINCT Job.Name AS jobname
1545 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1547 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1548 values %$jobnames] ;
1551 if ($what{db_devices}) {
1553 SELECT Device.Name AS name
1557 my $devices = $self->dbh_selectall_hashref($query, 'name');
1559 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1570 my $fields = $self->get_form(qw/age level status clients filesets
1572 db_clients limit db_filesets width height
1573 qclients qfilesets qjobnames db_jobnames/);
1576 my $url = CGI::url(-full => 0,
1579 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1581 # this organisation is to keep user choice between 2 click
1582 # TODO : fileset and client selection doesn't work
1591 sub display_client_job
1593 my ($self, %arg) = @_ ;
1595 $arg{order} = ' Job.JobId DESC ';
1596 my ($limit, $label) = $self->get_limit(%arg);
1598 my $clientname = $self->dbh_quote($arg{clientname});
1601 SELECT DISTINCT Job.JobId AS jobid,
1602 Job.Name AS jobname,
1603 FileSet.FileSet AS fileset,
1605 StartTime AS starttime,
1606 JobFiles AS jobfiles,
1607 JobBytes AS jobbytes,
1608 JobStatus AS jobstatus,
1609 JobErrors AS joberrors
1611 FROM Client,Job,FileSet
1612 WHERE Client.Name=$clientname
1613 AND Client.ClientId=Job.ClientId
1614 AND Job.FileSetId=FileSet.FileSetId
1618 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1620 $self->display({ clientname => $arg{clientname},
1623 Jobs => [ values %$all ],
1625 "display_client_job.tpl") ;
1628 sub get_selected_media_location
1632 my $medias = $self->get_form('jmedias');
1634 unless ($medias->{jmedias}) {
1639 SELECT Media.VolumeName AS volumename, Location.Location AS location
1640 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1641 WHERE Media.VolumeName IN ($medias->{jmedias})
1644 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1646 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1657 my $medias = $self->get_selected_media_location();
1663 my $elt = $self->get_form('db_locations');
1665 $self->display({ ID => $cur_id++,
1666 %$elt, # db_locations
1668 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1678 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1680 $self->display($elt, "help_extern.tpl");
1683 sub help_extern_compute
1687 my $number = CGI::param('limit') || '' ;
1688 unless ($number =~ /^(\d+)$/) {
1689 return $self->error("Bad arg number : $number ");
1692 my ($sql, undef) = $self->get_param('pools',
1693 'locations', 'mediatypes');
1696 SELECT Media.VolumeName AS volumename,
1697 Media.VolStatus AS volstatus,
1698 Media.LastWritten AS lastwritten,
1699 Media.MediaType AS mediatype,
1700 Media.VolMounts AS volmounts,
1702 Media.Recycle AS recycle,
1703 $self->{sql}->{FROM_UNIXTIME}(
1704 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1705 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1708 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1709 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1711 WHERE Media.InChanger = 1
1712 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1714 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1718 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1720 $self->display({ Medias => [ values %$all ] },
1721 "help_extern_compute.tpl");
1728 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1729 $self->display($param, "help_intern.tpl");
1732 sub help_intern_compute
1736 my $number = CGI::param('limit') || '' ;
1737 unless ($number =~ /^(\d+)$/) {
1738 return $self->error("Bad arg number : $number ");
1741 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1743 if (CGI::param('expired')) {
1745 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1746 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1752 SELECT Media.VolumeName AS volumename,
1753 Media.VolStatus AS volstatus,
1754 Media.LastWritten AS lastwritten,
1755 Media.MediaType AS mediatype,
1756 Media.VolMounts AS volmounts,
1758 $self->{sql}->{FROM_UNIXTIME}(
1759 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1760 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1763 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1764 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1766 WHERE Media.InChanger <> 1
1767 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1768 AND Media.Recycle = 1
1770 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1774 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1776 $self->display({ Medias => [ values %$all ] },
1777 "help_intern_compute.tpl");
1783 my ($self, %arg) = @_ ;
1785 my ($limit, $label) = $self->get_limit(%arg);
1789 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1790 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1791 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1792 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1793 ($self->{sql}->{DB_SIZE}) AS db_size,
1794 (SELECT count(Job.JobId)
1796 WHERE Job.JobStatus IN ('E','e','f','A')
1799 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1802 my $row = $self->dbh_selectrow_hashref($query) ;
1804 $row->{nb_bytes} = human_size($row->{nb_bytes});
1806 $row->{db_size} = human_size($row->{db_size});
1807 $row->{label} = $label;
1809 $self->display($row, "general.tpl");
1814 my ($self, @what) = @_ ;
1815 my %elt = map { $_ => 1 } @what;
1820 if ($elt{clients}) {
1821 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1823 $ret{clients} = \@clients;
1824 my $str = $self->dbh_join(@clients);
1825 $limit .= "AND Client.Name IN ($str) ";
1829 if ($elt{client_groups}) {
1830 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1832 $ret{client_groups} = \@clients;
1833 my $str = $self->dbh_join(@clients);
1834 $limit .= "AND client_group_name IN ($str) ";
1838 if ($elt{filesets}) {
1839 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1841 $ret{filesets} = \@filesets;
1842 my $str = $self->dbh_join(@filesets);
1843 $limit .= "AND FileSet.FileSet IN ($str) ";
1847 if ($elt{mediatypes}) {
1848 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1850 $ret{mediatypes} = \@medias;
1851 my $str = $self->dbh_join(@medias);
1852 $limit .= "AND Media.MediaType IN ($str) ";
1857 my $client = CGI::param('client');
1858 $ret{client} = $client;
1859 $client = $self->dbh_join($client);
1860 $limit .= "AND Client.Name = $client ";
1864 my $level = CGI::param('level') || '';
1865 if ($level =~ /^(\w)$/) {
1867 $limit .= "AND Job.Level = '$1' ";
1872 my $jobid = CGI::param('jobid') || '';
1874 if ($jobid =~ /^(\d+)$/) {
1876 $limit .= "AND Job.JobId = '$1' ";
1881 my $status = CGI::param('status') || '';
1882 if ($status =~ /^(\w)$/) {
1885 $limit .= "AND Job.JobStatus IN ('f','E') ";
1886 } elsif ($1 eq 'W') {
1887 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1889 $limit .= "AND Job.JobStatus = '$1' ";
1894 if ($elt{volstatus}) {
1895 my $status = CGI::param('volstatus') || '';
1896 if ($status =~ /^(\w+)$/) {
1898 $limit .= "AND Media.VolStatus = '$1' ";
1902 if ($elt{locations}) {
1903 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1905 $ret{locations} = \@location;
1906 my $str = $self->dbh_join(@location);
1907 $limit .= "AND Location.Location IN ($str) ";
1912 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1914 $ret{pools} = \@pool;
1915 my $str = $self->dbh_join(@pool);
1916 $limit .= "AND Pool.Name IN ($str) ";
1920 if ($elt{location}) {
1921 my $location = CGI::param('location') || '';
1923 $ret{location} = $location;
1924 $location = $self->dbh_quote($location);
1925 $limit .= "AND Location.Location = $location ";
1930 my $pool = CGI::param('pool') || '';
1933 $pool = $self->dbh_quote($pool);
1934 $limit .= "AND Pool.Name = $pool ";
1938 if ($elt{jobtype}) {
1939 my $jobtype = CGI::param('jobtype') || '';
1940 if ($jobtype =~ /^(\w)$/) {
1942 $limit .= "AND Job.Type = '$1' ";
1946 return ($limit, %ret);
1957 my ($self, %arg) = @_ ;
1959 $arg{order} = ' Job.JobId DESC ';
1961 my ($limit, $label) = $self->get_limit(%arg);
1962 my ($where, undef) = $self->get_param('clients',
1972 if (CGI::param('client_group')) {
1974 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
1975 LEFT JOIN client_group USING (client_group_id)
1980 SELECT Job.JobId AS jobid,
1981 Client.Name AS client,
1982 FileSet.FileSet AS fileset,
1983 Job.Name AS jobname,
1985 StartTime AS starttime,
1987 Pool.Name AS poolname,
1988 JobFiles AS jobfiles,
1989 JobBytes AS jobbytes,
1990 JobStatus AS jobstatus,
1991 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1992 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1995 JobErrors AS joberrors
1998 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1999 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2001 WHERE Client.ClientId=Job.ClientId
2002 AND Job.JobStatus != 'R'
2007 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2009 $self->display({ Filter => $label,
2013 sort { $a->{jobid} <=> $b->{jobid} }
2020 # display job informations
2021 sub display_job_zoom
2023 my ($self, $jobid) = @_ ;
2025 $jobid = $self->dbh_quote($jobid);
2028 SELECT DISTINCT Job.JobId AS jobid,
2029 Client.Name AS client,
2030 Job.Name AS jobname,
2031 FileSet.FileSet AS fileset,
2033 Pool.Name AS poolname,
2034 StartTime AS starttime,
2035 JobFiles AS jobfiles,
2036 JobBytes AS jobbytes,
2037 JobStatus AS jobstatus,
2038 JobErrors AS joberrors,
2039 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2040 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2043 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2044 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2045 WHERE Client.ClientId=Job.ClientId
2046 AND Job.JobId = $jobid
2049 my $row = $self->dbh_selectrow_hashref($query) ;
2051 # display all volumes associate with this job
2053 SELECT Media.VolumeName as volumename
2054 FROM Job,Media,JobMedia
2055 WHERE Job.JobId = $jobid
2056 AND JobMedia.JobId=Job.JobId
2057 AND JobMedia.MediaId=Media.MediaId
2060 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2062 $row->{volumes} = [ values %$all ] ;
2064 $self->display($row, "display_job_zoom.tpl");
2069 my ($self, %arg) = @_ ;
2071 my ($limit, $label) = $self->get_limit(%arg);
2072 my ($where, %elt) = $self->get_param('pools',
2077 my $arg = $self->get_form('jmedias', 'qre_media');
2079 if ($arg->{jmedias}) {
2080 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2082 if ($arg->{qre_media}) {
2083 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2087 SELECT Media.VolumeName AS volumename,
2088 Media.VolBytes AS volbytes,
2089 Media.VolStatus AS volstatus,
2090 Media.MediaType AS mediatype,
2091 Media.InChanger AS online,
2092 Media.LastWritten AS lastwritten,
2093 Location.Location AS location,
2094 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2095 Pool.Name AS poolname,
2096 $self->{sql}->{FROM_UNIXTIME}(
2097 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2098 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2101 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2102 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2103 Media.MediaType AS MediaType
2105 WHERE Media.VolStatus = 'Full'
2106 GROUP BY Media.MediaType
2107 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2109 WHERE Media.PoolId=Pool.PoolId
2114 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2116 $self->display({ ID => $cur_id++,
2118 Location => $elt{location},
2119 Medias => [ values %$all ]
2121 "display_media.tpl");
2128 my $pool = $self->get_form('db_pools');
2130 foreach my $name (@{ $pool->{db_pools} }) {
2131 CGI::param('pool', $name->{name});
2132 $self->display_media();
2136 sub display_media_zoom
2140 my $medias = $self->get_form('jmedias');
2142 unless ($medias->{jmedias}) {
2143 return $self->error("Can't get media selection");
2147 SELECT InChanger AS online,
2148 VolBytes AS nb_bytes,
2149 VolumeName AS volumename,
2150 VolStatus AS volstatus,
2151 VolMounts AS nb_mounts,
2152 Media.VolUseDuration AS voluseduration,
2153 Media.MaxVolJobs AS maxvoljobs,
2154 Media.MaxVolFiles AS maxvolfiles,
2155 Media.MaxVolBytes AS maxvolbytes,
2156 VolErrors AS nb_errors,
2157 Pool.Name AS poolname,
2158 Location.Location AS location,
2159 Media.Recycle AS recycle,
2160 Media.VolRetention AS volretention,
2161 Media.LastWritten AS lastwritten,
2162 Media.VolReadTime/1000000 AS volreadtime,
2163 Media.VolWriteTime/1000000 AS volwritetime,
2164 Media.RecycleCount AS recyclecount,
2165 Media.Comment AS comment,
2166 $self->{sql}->{FROM_UNIXTIME}(
2167 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2168 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2171 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2172 WHERE Pool.PoolId = Media.PoolId
2173 AND VolumeName IN ($medias->{jmedias})
2176 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2178 foreach my $media (values %$all) {
2179 my $mq = $self->dbh_quote($media->{volumename});
2182 SELECT DISTINCT Job.JobId AS jobid,
2184 Job.StartTime AS starttime,
2187 Job.JobFiles AS files,
2188 Job.JobBytes AS bytes,
2189 Job.jobstatus AS status
2190 FROM Media,JobMedia,Job
2191 WHERE Media.VolumeName=$mq
2192 AND Media.MediaId=JobMedia.MediaId
2193 AND JobMedia.JobId=Job.JobId
2196 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2199 SELECT LocationLog.Date AS date,
2200 Location.Location AS location,
2201 LocationLog.Comment AS comment
2202 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2203 WHERE Media.MediaId = LocationLog.MediaId
2204 AND Media.VolumeName = $mq
2208 my $log = $self->dbh_selectall_arrayref($query) ;
2210 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2213 $self->display({ jobs => [ values %$jobs ],
2214 LocationLog => $logtxt,
2216 "display_media_zoom.tpl");
2224 my $loc = $self->get_form('qlocation');
2225 unless ($loc->{qlocation}) {
2226 return $self->error("Can't get location");
2230 SELECT Location.Location AS location,
2231 Location.Cost AS cost,
2232 Location.Enabled AS enabled
2234 WHERE Location.Location = $loc->{qlocation}
2237 my $row = $self->dbh_selectrow_hashref($query);
2239 $self->display({ ID => $cur_id++,
2240 %$row }, "location_edit.tpl") ;
2248 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2249 unless ($arg->{qlocation}) {
2250 return $self->error("Can't get location");
2252 unless ($arg->{qnewlocation}) {
2253 return $self->error("Can't get new location name");
2255 unless ($arg->{cost}) {
2256 return $self->error("Can't get new cost");
2259 my $enabled = CGI::param('enabled') || '';
2260 $enabled = $enabled?1:0;
2263 UPDATE Location SET Cost = $arg->{cost},
2264 Location = $arg->{qnewlocation},
2266 WHERE Location.Location = $arg->{qlocation}
2269 $self->dbh_do($query);
2271 $self->location_display();
2277 my $arg = $self->get_form(qw/qlocation/) ;
2279 unless ($arg->{qlocation}) {
2280 return $self->error("Can't get location");
2284 SELECT count(Media.MediaId) AS nb
2285 FROM Media INNER JOIN Location USING (LocationID)
2286 WHERE Location = $arg->{qlocation}
2289 my $res = $self->dbh_selectrow_hashref($query);
2292 return $self->error("Sorry, the location must be empty");
2296 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2299 $self->dbh_do($query);
2301 $self->location_display();
2308 my $arg = $self->get_form(qw/qlocation cost/) ;
2310 unless ($arg->{qlocation}) {
2311 $self->display({}, "location_add.tpl");
2314 unless ($arg->{cost}) {
2315 return $self->error("Can't get new cost");
2318 my $enabled = CGI::param('enabled') || '';
2319 $enabled = $enabled?1:0;
2322 INSERT INTO Location (Location, Cost, Enabled)
2323 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2326 $self->dbh_do($query);
2328 $self->location_display();
2331 sub location_display
2336 SELECT Location.Location AS location,
2337 Location.Cost AS cost,
2338 Location.Enabled AS enabled,
2339 (SELECT count(Media.MediaId)
2341 WHERE Media.LocationId = Location.LocationId
2346 my $location = $self->dbh_selectall_hashref($query, 'location');
2348 $self->display({ ID => $cur_id++,
2349 Locations => [ values %$location ] },
2350 "display_location.tpl");
2357 my $medias = $self->get_selected_media_location();
2362 my $arg = $self->get_form('db_locations', 'qnewlocation');
2364 $self->display({ email => $self->{info}->{email_media},
2366 medias => [ values %$medias ],
2368 "update_location.tpl");
2371 ###########################################################
2377 my $grp = $self->get_form(qw/qclient_group db_clients/);
2380 unless ($grp->{qclient_group}) {
2381 return $self->error("Can't get group");
2386 FROM Client JOIN client_group_member using (clientid)
2387 JOIN client_group using (client_group_id)
2388 WHERE client_group_name = $grp->{qclient_group}
2391 my $row = $self->dbh_selectall_hashref($query, "name");
2393 $self->display({ ID => $cur_id++,
2394 client_group => $grp->{qclient_group},
2396 client_group_member => [ values %$row]},
2404 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2405 unless ($arg->{qclient_group}) {
2406 return $self->error("Can't get groups");
2409 $self->{dbh}->begin_work();
2412 DELETE FROM client_group_member
2413 WHERE client_group_id IN
2414 (SELECT client_group_id
2416 WHERE client_group_name = $arg->{qclient_group})
2418 $self->dbh_do($query);
2421 INSERT INTO client_group_member (clientid, client_group_id)
2423 (SELECT client_group_id
2425 WHERE client_group_name = $arg->{qclient_group})
2426 FROM Client WHERE Name IN ($arg->{jclients})
2429 $self->dbh_do($query);
2431 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2434 SET client_group_name = $arg->{qnewgroup}
2435 WHERE client_group_name = $arg->{qclient_group}
2438 $self->dbh_do($query);
2441 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2443 $self->display_groups();
2449 my $arg = $self->get_form(qw/qclient_group/);
2451 unless ($arg->{qclient_group}) {
2452 return $self->error("Can't get groups");
2455 $self->{dbh}->begin_work();
2458 DELETE FROM client_group_member
2459 WHERE client_group_id IN
2460 (SELECT client_group_id
2462 WHERE client_group_name = $arg->{qclient_group});
2464 DELETE FROM client_group
2465 WHERE client_group_name = $arg->{qclient_group};
2467 $self->dbh_do($query);
2469 $self->{dbh}->commit();
2471 $self->display_groups();
2478 my $arg = $self->get_form(qw/qclient_group/) ;
2480 unless ($arg->{qclient_group}) {
2481 $self->display({}, "groups_add.tpl");
2486 INSERT INTO client_group (client_group_name)
2487 VALUES ($arg->{qclient_group})
2490 $self->dbh_do($query);
2492 $self->display_groups();
2500 SELECT client_group_name AS client_group
2501 FROM client_group ORDER BY client_group_name;
2504 my $groups = $self->dbh_selectall_hashref($query, 'client_group');
2506 $self->debug($groups);
2508 $self->display({ ID => $cur_id++,
2509 groups => [ values %$groups ] },
2510 "display_groups.tpl");
2513 ###########################################################
2515 sub get_media_max_size
2517 my ($self, $type) = @_;
2519 "SELECT avg(VolBytes) AS size
2521 WHERE Media.VolStatus = 'Full'
2522 AND Media.MediaType = '$type'
2525 my $res = $self->selectrow_hashref($query);
2528 return $res->{size};
2538 my $media = $self->get_form('qmedia');
2540 unless ($media->{qmedia}) {
2541 return $self->error("Can't get media");
2545 SELECT Media.Slot AS slot,
2546 PoolMedia.Name AS poolname,
2547 Media.VolStatus AS volstatus,
2548 Media.InChanger AS inchanger,
2549 Location.Location AS location,
2550 Media.VolumeName AS volumename,
2551 Media.MaxVolBytes AS maxvolbytes,
2552 Media.MaxVolJobs AS maxvoljobs,
2553 Media.MaxVolFiles AS maxvolfiles,
2554 Media.VolUseDuration AS voluseduration,
2555 Media.VolRetention AS volretention,
2556 Media.Comment AS comment,
2557 PoolRecycle.Name AS poolrecycle
2559 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2560 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2561 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2563 WHERE Media.VolumeName = $media->{qmedia}
2566 my $row = $self->dbh_selectrow_hashref($query);
2567 $row->{volretention} = human_sec($row->{volretention});
2568 $row->{voluseduration} = human_sec($row->{voluseduration});
2570 my $elt = $self->get_form(qw/db_pools db_locations/);
2575 }, "update_media.tpl");
2582 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2584 unless ($arg->{jmedias}) {
2585 return $self->error("Can't get selected media");
2588 unless ($arg->{qnewlocation}) {
2589 return $self->error("Can't get new location");
2594 SET LocationId = (SELECT LocationId
2596 WHERE Location = $arg->{qnewlocation})
2597 WHERE Media.VolumeName IN ($arg->{jmedias})
2600 my $nb = $self->dbh_do($query);
2602 print "$nb media updated, you may have to update your autochanger.";
2604 $self->display_media();
2611 my $medias = $self->get_selected_media_location();
2613 return $self->error("Can't get media selection");
2615 my $newloc = CGI::param('newlocation');
2617 my $user = CGI::param('user') || 'unknown';
2618 my $comm = CGI::param('comment') || '';
2619 $comm = $self->dbh_quote("$user: $comm");
2623 foreach my $media (keys %$medias) {
2625 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2627 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2628 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2629 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2632 $self->dbh_do($query);
2633 $self->debug($query);
2637 $q->param('action', 'update_location');
2638 my $url = $q->url(-full => 1, -query=>1);
2640 $self->display({ email => $self->{info}->{email_media},
2642 newlocation => $newloc,
2643 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81\81 },..]
2644 medias => [ values %$medias ],
2646 "change_location.tpl");
2650 sub display_client_stats
2652 my ($self, %arg) = @_ ;
2654 my $client = $self->dbh_quote($arg{clientname});
2655 my ($limit, $label) = $self->get_limit(%arg);
2659 count(Job.JobId) AS nb_jobs,
2660 sum(Job.JobBytes) AS nb_bytes,
2661 sum(Job.JobErrors) AS nb_err,
2662 sum(Job.JobFiles) AS nb_files,
2663 Client.Name AS clientname
2664 FROM Job INNER JOIN Client USING (ClientId)
2666 Client.Name = $client
2668 GROUP BY Client.Name
2671 my $row = $self->dbh_selectrow_hashref($query);
2673 $row->{ID} = $cur_id++;
2674 $row->{label} = $label;
2676 $self->display($row, "display_client_stats.tpl");
2679 # poolname can be undef
2682 my ($self, $poolname) = @_ ;
2686 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2687 if ($arg->{jmediatypes}) {
2688 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2689 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2692 # TODO : afficher les tailles et les dates
2695 SELECT subq.volmax AS volmax,
2696 subq.volnum AS volnum,
2697 subq.voltotal AS voltotal,
2699 Pool.Recycle AS recycle,
2700 Pool.VolRetention AS volretention,
2701 Pool.VolUseDuration AS voluseduration,
2702 Pool.MaxVolJobs AS maxvoljobs,
2703 Pool.MaxVolFiles AS maxvolfiles,
2704 Pool.MaxVolBytes AS maxvolbytes,
2705 subq.PoolId AS PoolId
2708 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2709 count(Media.MediaId) AS volnum,
2710 sum(Media.VolBytes) AS voltotal,
2711 Media.PoolId AS PoolId,
2712 Media.MediaType AS MediaType
2714 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2715 Media.MediaType AS MediaType
2717 WHERE Media.VolStatus = 'Full'
2718 GROUP BY Media.MediaType
2719 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2720 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2722 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2726 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2729 SELECT Pool.Name AS name,
2730 sum(VolBytes) AS size
2731 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2732 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2736 my $empty = $self->dbh_selectall_hashref($query, 'name');
2738 foreach my $p (values %$all) {
2739 if ($p->{volmax} > 0) { # mysql returns 0.0000
2740 # we remove Recycled/Purged media from pool usage
2741 if (defined $empty->{$p->{name}}) {
2742 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2744 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2746 $p->{poolusage} = 0;
2750 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2752 WHERE PoolId=$p->{poolid}
2756 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2757 foreach my $t (values %$content) {
2758 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2763 $self->display({ ID => $cur_id++,
2764 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2765 Pools => [ values %$all ]},
2766 "display_pool.tpl");
2769 sub display_running_job
2773 my $arg = $self->get_form('client', 'jobid');
2775 if (!$arg->{client} and $arg->{jobid}) {
2778 SELECT Client.Name AS name
2779 FROM Job INNER JOIN Client USING (ClientId)
2780 WHERE Job.JobId = $arg->{jobid}
2783 my $row = $self->dbh_selectrow_hashref($query);
2786 $arg->{client} = $row->{name};
2787 CGI::param('client', $arg->{client});
2791 if ($arg->{client}) {
2792 my $cli = new Bweb::Client(name => $arg->{client});
2793 $cli->display_running_job($self->{info}, $arg->{jobid});
2794 if ($arg->{jobid}) {
2795 $self->get_job_log();
2798 $self->error("Can't get client or jobid");
2802 sub display_running_jobs
2804 my ($self, $display_action) = @_;
2807 SELECT Job.JobId AS jobid,
2808 Job.Name AS jobname,
2810 Job.StartTime AS starttime,
2811 Job.JobFiles AS jobfiles,
2812 Job.JobBytes AS jobbytes,
2813 Job.JobStatus AS jobstatus,
2814 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2815 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2817 Client.Name AS clientname
2818 FROM Job INNER JOIN Client USING (ClientId)
2819 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2821 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2823 $self->display({ ID => $cur_id++,
2824 display_action => $display_action,
2825 Jobs => [ values %$all ]},
2826 "running_job.tpl") ;
2829 # return the autochanger list to update
2834 my $arg = $self->get_form('jmedias');
2836 unless ($arg->{jmedias}) {
2837 return $self->error("Can't get media selection");
2841 SELECT Media.VolumeName AS volumename,
2842 Storage.Name AS storage,
2843 Location.Location AS location,
2845 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2846 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2847 WHERE Media.VolumeName IN ($arg->{jmedias})
2848 AND Media.InChanger = 1
2851 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2853 foreach my $vol (values %$all) {
2854 my $a = $self->ach_get($vol->{location});
2856 $ret{$vol->{location}} = 1;
2858 unless ($a->{have_status}) {
2860 $a->{have_status} = 1;
2863 print "eject $vol->{volumename} from $vol->{storage} : ";
2864 if ($a->send_to_io($vol->{slot})) {
2865 print "<img src='/bweb/T.png' alt='ok'><br/>";
2867 print "<img src='/bweb/E.png' alt='err'><br/>";
2877 my ($to, $subject, $content) = (CGI::param('email'),
2878 CGI::param('subject'),
2879 CGI::param('content'));
2880 $to =~ s/[^\w\d\.\@<>,]//;
2881 $subject =~ s/[^\w\d\.\[\]]/ /;
2883 open(MAIL, "|mail -s '$subject' '$to'") ;
2884 print MAIL $content;
2894 my $arg = $self->get_form('jobid', 'client');
2896 print CGI::header('text/brestore');
2897 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2898 print "client=$arg->{client}\n" if ($arg->{client});
2899 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2903 # TODO : move this to Bweb::Autochanger ?
2904 # TODO : make this internal to not eject tape ?
2910 my ($self, $name) = @_;
2913 return $self->error("Can't get your autochanger name ach");
2916 unless ($self->{info}->{ach_list}) {
2917 return $self->error("Could not find any autochanger");
2920 my $a = $self->{info}->{ach_list}->{$name};
2923 $self->error("Can't get your autochanger $name from your ach_list");
2928 $a->{debug} = $self->{debug};
2935 my ($self, $ach) = @_;
2937 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2939 $self->{info}->save();
2947 my $arg = $self->get_form('ach');
2949 or !$self->{info}->{ach_list}
2950 or !$self->{info}->{ach_list}->{$arg->{ach}})
2952 return $self->error("Can't get autochanger name");
2955 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2959 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2961 my $b = $self->get_bconsole();
2963 my @storages = $b->list_storage() ;
2965 $ach->{devices} = [ map { { name => $_ } } @storages ];
2967 $self->display($ach, "ach_add.tpl");
2968 delete $ach->{drives};
2969 delete $ach->{devices};
2976 my $arg = $self->get_form('ach');
2979 or !$self->{info}->{ach_list}
2980 or !$self->{info}->{ach_list}->{$arg->{ach}})
2982 return $self->error("Can't get autochanger name");
2985 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2987 $self->{info}->save();
2988 $self->{info}->view();
2994 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2996 my $b = $self->get_bconsole();
2997 my @storages = $b->list_storage() ;
2999 unless ($arg->{ach}) {
3000 $arg->{devices} = [ map { { name => $_ } } @storages ];
3001 return $self->display($arg, "ach_add.tpl");
3005 foreach my $drive (CGI::param('drives'))
3007 unless (grep(/^$drive$/,@storages)) {
3008 return $self->error("Can't find $drive in storage list");
3011 my $index = CGI::param("index_$drive");
3012 unless (defined $index and $index =~ /^(\d+)$/) {
3013 return $self->error("Can't get $drive index");
3016 $drives[$index] = $drive;
3020 return $self->error("Can't get drives from Autochanger");
3023 my $a = new Bweb::Autochanger(name => $arg->{ach},
3024 precmd => $arg->{precmd},
3025 drive_name => \@drives,
3026 device => $arg->{device},
3027 mtxcmd => $arg->{mtxcmd});
3029 $self->ach_register($a) ;
3031 $self->{info}->view();
3037 my $arg = $self->get_form('jobid');
3039 if ($arg->{jobid}) {
3040 my $b = $self->get_bconsole();
3041 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3045 title => "Delete a job ",
3046 name => "delete jobid=$arg->{jobid}",
3055 my $arg = $self->get_form(qw/media volstatus inchanger pool
3056 slot volretention voluseduration
3057 maxvoljobs maxvolfiles maxvolbytes
3058 qcomment poolrecycle
3061 unless ($arg->{media}) {
3062 return $self->error("Can't find media selection");
3065 my $update = "update volume=$arg->{media} ";
3067 if ($arg->{volstatus}) {
3068 $update .= " volstatus=$arg->{volstatus} ";
3071 if ($arg->{inchanger}) {
3072 $update .= " inchanger=yes " ;
3074 $update .= " slot=$arg->{slot} ";
3077 $update .= " slot=0 inchanger=no ";
3081 $update .= " pool=$arg->{pool} " ;
3084 if (defined $arg->{volretention}) {
3085 $update .= " volretention=\"$arg->{volretention}\" " ;
3088 if (defined $arg->{voluseduration}) {
3089 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3092 if (defined $arg->{maxvoljobs}) {
3093 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3096 if (defined $arg->{maxvolfiles}) {
3097 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3100 if (defined $arg->{maxvolbytes}) {
3101 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3104 my $b = $self->get_bconsole();
3107 content => $b->send_cmd($update),
3108 title => "Update a volume ",
3114 my $media = $self->dbh_quote($arg->{media});
3116 my $loc = CGI::param('location') || '';
3118 $loc = $self->dbh_quote($loc); # is checked by db
3119 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3121 if ($arg->{poolrecycle}) {
3122 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
3124 if (!$arg->{qcomment}) {
3125 $arg->{qcomment} = "''";
3127 push @q, "Comment=$arg->{qcomment}";
3132 SET " . join (',', @q) . "
3133 WHERE Media.VolumeName = $media
3135 $self->dbh_do($query);
3137 $self->update_media();
3144 my $ach = CGI::param('ach') ;
3145 $ach = $self->ach_get($ach);
3147 return $self->error("Bad autochanger name");
3151 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3152 $b->update_slots($ach->{name});
3160 my $arg = $self->get_form('jobid', 'limit', 'offset');
3161 unless ($arg->{jobid}) {
3162 return $self->error("Can't get jobid");
3165 if ($arg->{limit} == 100) {
3166 $arg->{limit} = 1000;
3169 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3172 SELECT Job.Name as name, Client.Name as clientname
3173 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3174 WHERE JobId = $arg->{jobid}
3177 my $row = $self->dbh_selectrow_hashref($query);
3180 return $self->error("Can't find $arg->{jobid} in catalog");
3184 SELECT Time AS time, LogText AS log
3186 WHERE Log.JobId = $arg->{jobid}
3187 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3188 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3192 OFFSET $arg->{offset}
3195 my $log = $self->dbh_selectall_arrayref($query);
3197 return $self->error("Can't get log for jobid $arg->{jobid}");
3203 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3205 $logtxt = join("", map { $_->[1] } @$log ) ;
3208 $self->display({ lines=> $logtxt,
3209 jobid => $arg->{jobid},
3210 name => $row->{name},
3211 client => $row->{clientname},
3212 offset => $arg->{offset},
3213 limit => $arg->{limit},
3214 }, 'display_log.tpl');
3222 my $arg = $self->get_form('ach', 'slots', 'drive');
3224 unless ($arg->{ach}) {
3225 return $self->error("Can't find autochanger name");
3228 my $a = $self->ach_get($arg->{ach});
3230 return $self->error("Can't find autochanger name in configuration");
3233 my $storage = $a->get_drive_name($arg->{drive});
3235 return $self->error("Can't get your drive name");
3240 if ($arg->{slots}) {
3241 $slots = join(",", @{ $arg->{slots} });
3242 $t += 60*scalar( @{ $arg->{slots} }) ;
3245 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3246 print "<h1>This command can take long time, be patient...</h1>";
3248 $b->label_barcodes(storage => $storage,
3249 drive => $arg->{drive},
3257 SET LocationId = (SELECT LocationId
3259 WHERE Location = '$arg->{ach}'),
3261 RecyclePoolId = PoolId
3263 WHERE Media.PoolId = (SELECT PoolId
3265 WHERE Name = 'Scratch')
3266 AND (LocationId = 0 OR LocationId IS NULL)
3275 my @volume = CGI::param('media');
3278 return $self->error("Can't get media selection");
3281 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3284 content => $b->purge_volume(@volume),
3285 title => "Purge media",
3286 name => "purge volume=" . join(' volume=', @volume),
3295 my @volume = CGI::param('media');
3297 return $self->error("Can't get media selection");
3300 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3303 content => $b->prune_volume(@volume),
3304 title => "Prune media",
3305 name => "prune volume=" . join(' volume=', @volume),
3315 my $arg = $self->get_form('jobid');
3316 unless ($arg->{jobid}) {
3317 return $self->error("Can't get jobid");
3320 my $b = $self->get_bconsole();
3322 content => $b->cancel($arg->{jobid}),
3323 title => "Cancel job",
3324 name => "cancel jobid=$arg->{jobid}",
3330 # Warning, we display current fileset
3333 my $arg = $self->get_form('fileset');
3335 if ($arg->{fileset}) {
3336 my $b = $self->get_bconsole();
3337 my $ret = $b->get_fileset($arg->{fileset});
3338 $self->display({ fileset => $arg->{fileset},
3340 }, "fileset_view.tpl");
3342 $self->error("Can't get fileset name");
3346 sub director_show_sched
3350 my $arg = $self->get_form('days');
3352 my $b = $self->get_bconsole();
3353 my $ret = $b->director_get_sched( $arg->{days} );
3358 }, "scheduled_job.tpl");
3361 sub enable_disable_job
3363 my ($self, $what) = @_ ;
3365 my $name = CGI::param('job') || '';
3366 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3367 return $self->error("Can't find job name");
3370 my $b = $self->get_bconsole();
3380 content => $b->send_cmd("$cmd job=\"$name\""),
3381 title => "$cmd $name",
3382 name => "$cmd job=\"$name\"",
3389 return new Bconsole(pref => $self->{info});
3395 my $b = $self->get_bconsole();
3397 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3399 $self->display({ Jobs => $joblist }, "run_job.tpl");
3404 my ($self, $ouput) = @_;
3407 foreach my $l (split(/\r\n/, $ouput)) {
3408 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3414 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3420 foreach my $k (keys %arg) {
3421 $lowcase{lc($k)} = $arg{$k} ;
3430 my $b = $self->get_bconsole();
3432 my $job = CGI::param('job') || '';
3434 # we take informations from director, and we overwrite with user wish
3435 my $info = $b->send_cmd("show job=\"$job\"");
3436 my $attr = $self->run_parse_job($info);
3438 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3439 my %job_opt = (%$attr, %$arg);
3441 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3443 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3444 my $clients = [ map { { name => $_ } }$b->list_client()];
3445 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3446 my $storages= [ map { { name => $_ } }$b->list_storage()];
3451 clients => $clients,
3452 filesets => $filesets,
3453 storages => $storages,
3455 }, "run_job_mod.tpl");
3461 my $b = $self->get_bconsole();
3463 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3473 my $b = $self->get_bconsole();
3475 # TODO: check input (don't use pool, level)
3477 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3478 my $job = CGI::param('job') || '';
3479 my $storage = CGI::param('storage') || '';
3481 my $jobid = $b->run(job => $job,
3482 client => $arg->{client},
3483 priority => $arg->{priority},
3484 level => $arg->{level},
3485 storage => $storage,
3486 pool => $arg->{pool},
3487 fileset => $arg->{fileset},
3488 when => $arg->{when},
3491 print $jobid, $b->{error};
3493 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";