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", "jclient_groups");
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}' ";
1266 } elsif ($arg->{jclient_groups}) {
1267 $where = "JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
1268 JOIN client_group USING (client_group_id)
1269 WHERE client_group_name IN ($arg->{jclient_groups})";
1273 SELECT Name AS name,
1275 AutoPrune AS autoprune,
1276 FileRetention AS fileretention,
1277 JobRetention AS jobretention
1282 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1284 my $dsp = { ID => $cur_id++,
1285 clients => [ values %$all] };
1287 $self->display($dsp, "client_list.tpl") ;
1292 my ($self, %arg) = @_;
1299 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1301 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1303 $self->{sql}->{TO_SEC}($arg{age})
1306 $label = "last " . human_sec($arg{age});
1309 if ($arg{groupby}) {
1310 $limit .= " GROUP BY $arg{groupby} ";
1314 $limit .= " ORDER BY $arg{order} ";
1318 $limit .= " LIMIT $arg{limit} ";
1319 $label .= " limited to $arg{limit}";
1323 $limit .= " OFFSET $arg{offset} ";
1324 $label .= " with $arg{offset} offset ";
1328 $label = 'no filter';
1331 return ($limit, $label);
1336 $bweb->get_form(...) - Get useful stuff
1340 This function get and check parameters against regexp.
1342 If word begin with 'q', the return will be quoted or join quoted
1343 if it's end with 's'.
1348 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1351 qclient => 'plume-fd',
1352 qpools => "'plume-fd', 'test-fd', '...'",
1359 my ($self, @what) = @_;
1360 my %what = map { $_ => 1 } @what;
1380 my %opt_ss =( # string with space
1384 my %opt_s = ( # default to ''
1401 my %opt_p = ( # option with path
1408 my %opt_r = (regexwhere => 1);
1410 my %opt_d = ( # option with date
1415 foreach my $i (@what) {
1416 if (exists $opt_i{$i}) {# integer param
1417 my $value = CGI::param($i) || $opt_i{$i} ;
1418 if ($value =~ /^(\d+)$/) {
1421 } elsif ($opt_s{$i}) { # simple string param
1422 my $value = CGI::param($i) || '';
1423 if ($value =~ /^([\w\d\.-]+)$/) {
1426 } elsif ($opt_ss{$i}) { # simple string param (with space)
1427 my $value = CGI::param($i) || '';
1428 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1431 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1432 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1434 $ret{$i} = $self->dbh_join(@value) ;
1437 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1438 my $value = CGI::param($1) ;
1440 $ret{$i} = $self->dbh_quote($value);
1443 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1444 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1445 grep { ! /^\s*$/ } CGI::param($1) ];
1446 } elsif (exists $opt_p{$i}) {
1447 my $value = CGI::param($i) || '';
1448 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1451 } elsif (exists $opt_r{$i}) {
1452 my $value = CGI::param($i) || '';
1453 if ($value =~ /^([^'"']+)$/) {
1456 } elsif (exists $opt_d{$i}) {
1457 my $value = CGI::param($i) || '';
1458 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1465 foreach my $s (CGI::param('slot')) {
1466 if ($s =~ /^(\d+)$/) {
1467 push @{$ret{slots}}, $s;
1473 my $when = CGI::param('when') || '';
1474 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1479 if ($what{db_clients}) {
1481 SELECT Client.Name as clientname
1485 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1486 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1490 if ($what{db_client_groups}) {
1492 SELECT client_group_name AS name
1496 my $grps = $self->dbh_selectall_hashref($query, 'name');
1497 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1501 if ($what{db_mediatypes}) {
1503 SELECT MediaType as mediatype
1507 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1508 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1512 if ($what{db_locations}) {
1514 SELECT Location as location, Cost as cost
1517 my $loc = $self->dbh_selectall_hashref($query, 'location');
1518 $ret{db_locations} = [ sort { $a->{location}
1524 if ($what{db_pools}) {
1525 my $query = "SELECT Name as name FROM Pool";
1527 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1528 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1531 if ($what{db_filesets}) {
1533 SELECT FileSet.FileSet AS fileset
1537 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1539 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1540 values %$filesets] ;
1543 if ($what{db_jobnames}) {
1545 SELECT DISTINCT Job.Name AS jobname
1549 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1551 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1552 values %$jobnames] ;
1555 if ($what{db_devices}) {
1557 SELECT Device.Name AS name
1561 my $devices = $self->dbh_selectall_hashref($query, 'name');
1563 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1574 my $fields = $self->get_form(qw/age level status clients filesets
1576 db_clients limit db_filesets width height
1577 qclients qfilesets qjobnames db_jobnames/);
1580 my $url = CGI::url(-full => 0,
1583 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1585 # this organisation is to keep user choice between 2 click
1586 # TODO : fileset and client selection doesn't work
1595 sub display_client_job
1597 my ($self, %arg) = @_ ;
1599 $arg{order} = ' Job.JobId DESC ';
1600 my ($limit, $label) = $self->get_limit(%arg);
1602 my $clientname = $self->dbh_quote($arg{clientname});
1605 SELECT DISTINCT Job.JobId AS jobid,
1606 Job.Name AS jobname,
1607 FileSet.FileSet AS fileset,
1609 StartTime AS starttime,
1610 JobFiles AS jobfiles,
1611 JobBytes AS jobbytes,
1612 JobStatus AS jobstatus,
1613 JobErrors AS joberrors
1615 FROM Client,Job,FileSet
1616 WHERE Client.Name=$clientname
1617 AND Client.ClientId=Job.ClientId
1618 AND Job.FileSetId=FileSet.FileSetId
1622 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1624 $self->display({ clientname => $arg{clientname},
1627 Jobs => [ values %$all ],
1629 "display_client_job.tpl") ;
1632 sub get_selected_media_location
1636 my $medias = $self->get_form('jmedias');
1638 unless ($medias->{jmedias}) {
1643 SELECT Media.VolumeName AS volumename, Location.Location AS location
1644 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1645 WHERE Media.VolumeName IN ($medias->{jmedias})
1648 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1650 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1661 my $medias = $self->get_selected_media_location();
1667 my $elt = $self->get_form('db_locations');
1669 $self->display({ ID => $cur_id++,
1670 %$elt, # db_locations
1672 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1682 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1684 $self->display($elt, "help_extern.tpl");
1687 sub help_extern_compute
1691 my $number = CGI::param('limit') || '' ;
1692 unless ($number =~ /^(\d+)$/) {
1693 return $self->error("Bad arg number : $number ");
1696 my ($sql, undef) = $self->get_param('pools',
1697 'locations', 'mediatypes');
1700 SELECT Media.VolumeName AS volumename,
1701 Media.VolStatus AS volstatus,
1702 Media.LastWritten AS lastwritten,
1703 Media.MediaType AS mediatype,
1704 Media.VolMounts AS volmounts,
1706 Media.Recycle AS recycle,
1707 $self->{sql}->{FROM_UNIXTIME}(
1708 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1709 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1712 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1713 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1715 WHERE Media.InChanger = 1
1716 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1718 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1722 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1724 $self->display({ Medias => [ values %$all ] },
1725 "help_extern_compute.tpl");
1732 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1733 $self->display($param, "help_intern.tpl");
1736 sub help_intern_compute
1740 my $number = CGI::param('limit') || '' ;
1741 unless ($number =~ /^(\d+)$/) {
1742 return $self->error("Bad arg number : $number ");
1745 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1747 if (CGI::param('expired')) {
1749 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1750 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1756 SELECT Media.VolumeName AS volumename,
1757 Media.VolStatus AS volstatus,
1758 Media.LastWritten AS lastwritten,
1759 Media.MediaType AS mediatype,
1760 Media.VolMounts AS volmounts,
1762 $self->{sql}->{FROM_UNIXTIME}(
1763 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1764 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1767 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1768 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1770 WHERE Media.InChanger <> 1
1771 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1772 AND Media.Recycle = 1
1774 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1778 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1780 $self->display({ Medias => [ values %$all ] },
1781 "help_intern_compute.tpl");
1787 my ($self, %arg) = @_ ;
1789 my ($limit, $label) = $self->get_limit(%arg);
1793 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1794 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1795 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1796 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1797 ($self->{sql}->{DB_SIZE}) AS db_size,
1798 (SELECT count(Job.JobId)
1800 WHERE Job.JobStatus IN ('E','e','f','A')
1803 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1806 my $row = $self->dbh_selectrow_hashref($query) ;
1808 $row->{nb_bytes} = human_size($row->{nb_bytes});
1810 $row->{db_size} = human_size($row->{db_size});
1811 $row->{label} = $label;
1813 $self->display($row, "general.tpl");
1818 my ($self, @what) = @_ ;
1819 my %elt = map { $_ => 1 } @what;
1824 if ($elt{clients}) {
1825 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1827 $ret{clients} = \@clients;
1828 my $str = $self->dbh_join(@clients);
1829 $limit .= "AND Client.Name IN ($str) ";
1833 if ($elt{client_groups}) {
1834 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1836 $ret{client_groups} = \@clients;
1837 my $str = $self->dbh_join(@clients);
1838 $limit .= "AND client_group_name IN ($str) ";
1842 if ($elt{filesets}) {
1843 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1845 $ret{filesets} = \@filesets;
1846 my $str = $self->dbh_join(@filesets);
1847 $limit .= "AND FileSet.FileSet IN ($str) ";
1851 if ($elt{mediatypes}) {
1852 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1854 $ret{mediatypes} = \@medias;
1855 my $str = $self->dbh_join(@medias);
1856 $limit .= "AND Media.MediaType IN ($str) ";
1861 my $client = CGI::param('client');
1862 $ret{client} = $client;
1863 $client = $self->dbh_join($client);
1864 $limit .= "AND Client.Name = $client ";
1868 my $level = CGI::param('level') || '';
1869 if ($level =~ /^(\w)$/) {
1871 $limit .= "AND Job.Level = '$1' ";
1876 my $jobid = CGI::param('jobid') || '';
1878 if ($jobid =~ /^(\d+)$/) {
1880 $limit .= "AND Job.JobId = '$1' ";
1885 my $status = CGI::param('status') || '';
1886 if ($status =~ /^(\w)$/) {
1889 $limit .= "AND Job.JobStatus IN ('f','E') ";
1890 } elsif ($1 eq 'W') {
1891 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1893 $limit .= "AND Job.JobStatus = '$1' ";
1898 if ($elt{volstatus}) {
1899 my $status = CGI::param('volstatus') || '';
1900 if ($status =~ /^(\w+)$/) {
1902 $limit .= "AND Media.VolStatus = '$1' ";
1906 if ($elt{locations}) {
1907 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1909 $ret{locations} = \@location;
1910 my $str = $self->dbh_join(@location);
1911 $limit .= "AND Location.Location IN ($str) ";
1916 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1918 $ret{pools} = \@pool;
1919 my $str = $self->dbh_join(@pool);
1920 $limit .= "AND Pool.Name IN ($str) ";
1924 if ($elt{location}) {
1925 my $location = CGI::param('location') || '';
1927 $ret{location} = $location;
1928 $location = $self->dbh_quote($location);
1929 $limit .= "AND Location.Location = $location ";
1934 my $pool = CGI::param('pool') || '';
1937 $pool = $self->dbh_quote($pool);
1938 $limit .= "AND Pool.Name = $pool ";
1942 if ($elt{jobtype}) {
1943 my $jobtype = CGI::param('jobtype') || '';
1944 if ($jobtype =~ /^(\w)$/) {
1946 $limit .= "AND Job.Type = '$1' ";
1950 return ($limit, %ret);
1961 my ($self, %arg) = @_ ;
1963 $arg{order} = ' Job.JobId DESC ';
1965 my ($limit, $label) = $self->get_limit(%arg);
1966 my ($where, undef) = $self->get_param('clients',
1976 if (CGI::param('client_group')) {
1978 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
1979 LEFT JOIN client_group USING (client_group_id)
1984 SELECT Job.JobId AS jobid,
1985 Client.Name AS client,
1986 FileSet.FileSet AS fileset,
1987 Job.Name AS jobname,
1989 StartTime AS starttime,
1991 Pool.Name AS poolname,
1992 JobFiles AS jobfiles,
1993 JobBytes AS jobbytes,
1994 JobStatus AS jobstatus,
1995 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1996 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1999 JobErrors AS joberrors
2002 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2003 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2005 WHERE Client.ClientId=Job.ClientId
2006 AND Job.JobStatus != 'R'
2011 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2013 $self->display({ Filter => $label,
2017 sort { $a->{jobid} <=> $b->{jobid} }
2024 # display job informations
2025 sub display_job_zoom
2027 my ($self, $jobid) = @_ ;
2029 $jobid = $self->dbh_quote($jobid);
2032 SELECT DISTINCT Job.JobId AS jobid,
2033 Client.Name AS client,
2034 Job.Name AS jobname,
2035 FileSet.FileSet AS fileset,
2037 Pool.Name AS poolname,
2038 StartTime AS starttime,
2039 JobFiles AS jobfiles,
2040 JobBytes AS jobbytes,
2041 JobStatus AS jobstatus,
2042 JobErrors AS joberrors,
2043 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2044 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2047 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2048 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2049 WHERE Client.ClientId=Job.ClientId
2050 AND Job.JobId = $jobid
2053 my $row = $self->dbh_selectrow_hashref($query) ;
2055 # display all volumes associate with this job
2057 SELECT Media.VolumeName as volumename
2058 FROM Job,Media,JobMedia
2059 WHERE Job.JobId = $jobid
2060 AND JobMedia.JobId=Job.JobId
2061 AND JobMedia.MediaId=Media.MediaId
2064 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2066 $row->{volumes} = [ values %$all ] ;
2068 $self->display($row, "display_job_zoom.tpl");
2073 my ($self, %arg) = @_ ;
2075 my ($limit, $label) = $self->get_limit(%arg);
2076 my ($where, %elt) = $self->get_param('pools',
2081 my $arg = $self->get_form('jmedias', 'qre_media');
2083 if ($arg->{jmedias}) {
2084 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2086 if ($arg->{qre_media}) {
2087 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2091 SELECT Media.VolumeName AS volumename,
2092 Media.VolBytes AS volbytes,
2093 Media.VolStatus AS volstatus,
2094 Media.MediaType AS mediatype,
2095 Media.InChanger AS online,
2096 Media.LastWritten AS lastwritten,
2097 Location.Location AS location,
2098 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2099 Pool.Name AS poolname,
2100 $self->{sql}->{FROM_UNIXTIME}(
2101 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2102 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2105 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2106 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2107 Media.MediaType AS MediaType
2109 WHERE Media.VolStatus = 'Full'
2110 GROUP BY Media.MediaType
2111 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2113 WHERE Media.PoolId=Pool.PoolId
2118 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2120 $self->display({ ID => $cur_id++,
2122 Location => $elt{location},
2123 Medias => [ values %$all ]
2125 "display_media.tpl");
2132 my $pool = $self->get_form('db_pools');
2134 foreach my $name (@{ $pool->{db_pools} }) {
2135 CGI::param('pool', $name->{name});
2136 $self->display_media();
2140 sub display_media_zoom
2144 my $medias = $self->get_form('jmedias');
2146 unless ($medias->{jmedias}) {
2147 return $self->error("Can't get media selection");
2151 SELECT InChanger AS online,
2152 VolBytes AS nb_bytes,
2153 VolumeName AS volumename,
2154 VolStatus AS volstatus,
2155 VolMounts AS nb_mounts,
2156 Media.VolUseDuration AS voluseduration,
2157 Media.MaxVolJobs AS maxvoljobs,
2158 Media.MaxVolFiles AS maxvolfiles,
2159 Media.MaxVolBytes AS maxvolbytes,
2160 VolErrors AS nb_errors,
2161 Pool.Name AS poolname,
2162 Location.Location AS location,
2163 Media.Recycle AS recycle,
2164 Media.VolRetention AS volretention,
2165 Media.LastWritten AS lastwritten,
2166 Media.VolReadTime/1000000 AS volreadtime,
2167 Media.VolWriteTime/1000000 AS volwritetime,
2168 Media.RecycleCount AS recyclecount,
2169 Media.Comment AS comment,
2170 $self->{sql}->{FROM_UNIXTIME}(
2171 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2172 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2175 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2176 WHERE Pool.PoolId = Media.PoolId
2177 AND VolumeName IN ($medias->{jmedias})
2180 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2182 foreach my $media (values %$all) {
2183 my $mq = $self->dbh_quote($media->{volumename});
2186 SELECT DISTINCT Job.JobId AS jobid,
2188 Job.StartTime AS starttime,
2191 Job.JobFiles AS files,
2192 Job.JobBytes AS bytes,
2193 Job.jobstatus AS status
2194 FROM Media,JobMedia,Job
2195 WHERE Media.VolumeName=$mq
2196 AND Media.MediaId=JobMedia.MediaId
2197 AND JobMedia.JobId=Job.JobId
2200 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2203 SELECT LocationLog.Date AS date,
2204 Location.Location AS location,
2205 LocationLog.Comment AS comment
2206 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2207 WHERE Media.MediaId = LocationLog.MediaId
2208 AND Media.VolumeName = $mq
2212 my $log = $self->dbh_selectall_arrayref($query) ;
2214 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2217 $self->display({ jobs => [ values %$jobs ],
2218 LocationLog => $logtxt,
2220 "display_media_zoom.tpl");
2228 my $loc = $self->get_form('qlocation');
2229 unless ($loc->{qlocation}) {
2230 return $self->error("Can't get location");
2234 SELECT Location.Location AS location,
2235 Location.Cost AS cost,
2236 Location.Enabled AS enabled
2238 WHERE Location.Location = $loc->{qlocation}
2241 my $row = $self->dbh_selectrow_hashref($query);
2243 $self->display({ ID => $cur_id++,
2244 %$row }, "location_edit.tpl") ;
2252 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2253 unless ($arg->{qlocation}) {
2254 return $self->error("Can't get location");
2256 unless ($arg->{qnewlocation}) {
2257 return $self->error("Can't get new location name");
2259 unless ($arg->{cost}) {
2260 return $self->error("Can't get new cost");
2263 my $enabled = CGI::param('enabled') || '';
2264 $enabled = $enabled?1:0;
2267 UPDATE Location SET Cost = $arg->{cost},
2268 Location = $arg->{qnewlocation},
2270 WHERE Location.Location = $arg->{qlocation}
2273 $self->dbh_do($query);
2275 $self->location_display();
2281 my $arg = $self->get_form(qw/qlocation/) ;
2283 unless ($arg->{qlocation}) {
2284 return $self->error("Can't get location");
2288 SELECT count(Media.MediaId) AS nb
2289 FROM Media INNER JOIN Location USING (LocationID)
2290 WHERE Location = $arg->{qlocation}
2293 my $res = $self->dbh_selectrow_hashref($query);
2296 return $self->error("Sorry, the location must be empty");
2300 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2303 $self->dbh_do($query);
2305 $self->location_display();
2312 my $arg = $self->get_form(qw/qlocation cost/) ;
2314 unless ($arg->{qlocation}) {
2315 $self->display({}, "location_add.tpl");
2318 unless ($arg->{cost}) {
2319 return $self->error("Can't get new cost");
2322 my $enabled = CGI::param('enabled') || '';
2323 $enabled = $enabled?1:0;
2326 INSERT INTO Location (Location, Cost, Enabled)
2327 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2330 $self->dbh_do($query);
2332 $self->location_display();
2335 sub location_display
2340 SELECT Location.Location AS location,
2341 Location.Cost AS cost,
2342 Location.Enabled AS enabled,
2343 (SELECT count(Media.MediaId)
2345 WHERE Media.LocationId = Location.LocationId
2350 my $location = $self->dbh_selectall_hashref($query, 'location');
2352 $self->display({ ID => $cur_id++,
2353 Locations => [ values %$location ] },
2354 "display_location.tpl");
2361 my $medias = $self->get_selected_media_location();
2366 my $arg = $self->get_form('db_locations', 'qnewlocation');
2368 $self->display({ email => $self->{info}->{email_media},
2370 medias => [ values %$medias ],
2372 "update_location.tpl");
2375 ###########################################################
2381 my $grp = $self->get_form(qw/qclient_group db_clients/);
2384 unless ($grp->{qclient_group}) {
2385 return $self->error("Can't get group");
2390 FROM Client JOIN client_group_member using (clientid)
2391 JOIN client_group using (client_group_id)
2392 WHERE client_group_name = $grp->{qclient_group}
2395 my $row = $self->dbh_selectall_hashref($query, "name");
2397 $self->display({ ID => $cur_id++,
2398 client_group => $grp->{qclient_group},
2400 client_group_member => [ values %$row]},
2408 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2409 unless ($arg->{qclient_group}) {
2410 return $self->error("Can't get groups");
2413 $self->{dbh}->begin_work();
2416 DELETE FROM client_group_member
2417 WHERE client_group_id IN
2418 (SELECT client_group_id
2420 WHERE client_group_name = $arg->{qclient_group})
2422 $self->dbh_do($query);
2425 INSERT INTO client_group_member (clientid, client_group_id)
2427 (SELECT client_group_id
2429 WHERE client_group_name = $arg->{qclient_group})
2430 FROM Client WHERE Name IN ($arg->{jclients})
2433 $self->dbh_do($query);
2435 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2438 SET client_group_name = $arg->{qnewgroup}
2439 WHERE client_group_name = $arg->{qclient_group}
2442 $self->dbh_do($query);
2445 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2447 $self->display_groups();
2453 my $arg = $self->get_form(qw/qclient_group/);
2455 unless ($arg->{qclient_group}) {
2456 return $self->error("Can't get groups");
2459 $self->{dbh}->begin_work();
2462 DELETE FROM client_group_member
2463 WHERE client_group_id IN
2464 (SELECT client_group_id
2466 WHERE client_group_name = $arg->{qclient_group});
2468 DELETE FROM client_group
2469 WHERE client_group_name = $arg->{qclient_group};
2471 $self->dbh_do($query);
2473 $self->{dbh}->commit();
2475 $self->display_groups();
2482 my $arg = $self->get_form(qw/qclient_group/) ;
2484 unless ($arg->{qclient_group}) {
2485 $self->display({}, "groups_add.tpl");
2490 INSERT INTO client_group (client_group_name)
2491 VALUES ($arg->{qclient_group})
2494 $self->dbh_do($query);
2496 $self->display_groups();
2503 my $arg = $self->get_form(qw/db_client_groups/) ;
2505 if ($self->{dbh}->errstr) {
2506 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2511 $self->display({ ID => $cur_id++,
2513 "display_groups.tpl");
2516 ###########################################################
2518 sub get_media_max_size
2520 my ($self, $type) = @_;
2522 "SELECT avg(VolBytes) AS size
2524 WHERE Media.VolStatus = 'Full'
2525 AND Media.MediaType = '$type'
2528 my $res = $self->selectrow_hashref($query);
2531 return $res->{size};
2541 my $media = $self->get_form('qmedia');
2543 unless ($media->{qmedia}) {
2544 return $self->error("Can't get media");
2548 SELECT Media.Slot AS slot,
2549 PoolMedia.Name AS poolname,
2550 Media.VolStatus AS volstatus,
2551 Media.InChanger AS inchanger,
2552 Location.Location AS location,
2553 Media.VolumeName AS volumename,
2554 Media.MaxVolBytes AS maxvolbytes,
2555 Media.MaxVolJobs AS maxvoljobs,
2556 Media.MaxVolFiles AS maxvolfiles,
2557 Media.VolUseDuration AS voluseduration,
2558 Media.VolRetention AS volretention,
2559 Media.Comment AS comment,
2560 PoolRecycle.Name AS poolrecycle
2562 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2563 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2564 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2566 WHERE Media.VolumeName = $media->{qmedia}
2569 my $row = $self->dbh_selectrow_hashref($query);
2570 $row->{volretention} = human_sec($row->{volretention});
2571 $row->{voluseduration} = human_sec($row->{voluseduration});
2573 my $elt = $self->get_form(qw/db_pools db_locations/);
2578 }, "update_media.tpl");
2585 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2587 unless ($arg->{jmedias}) {
2588 return $self->error("Can't get selected media");
2591 unless ($arg->{qnewlocation}) {
2592 return $self->error("Can't get new location");
2597 SET LocationId = (SELECT LocationId
2599 WHERE Location = $arg->{qnewlocation})
2600 WHERE Media.VolumeName IN ($arg->{jmedias})
2603 my $nb = $self->dbh_do($query);
2605 print "$nb media updated, you may have to update your autochanger.";
2607 $self->display_media();
2614 my $medias = $self->get_selected_media_location();
2616 return $self->error("Can't get media selection");
2618 my $newloc = CGI::param('newlocation');
2620 my $user = CGI::param('user') || 'unknown';
2621 my $comm = CGI::param('comment') || '';
2622 $comm = $self->dbh_quote("$user: $comm");
2626 foreach my $media (keys %$medias) {
2628 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2630 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2631 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2632 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2635 $self->dbh_do($query);
2636 $self->debug($query);
2640 $q->param('action', 'update_location');
2641 my $url = $q->url(-full => 1, -query=>1);
2643 $self->display({ email => $self->{info}->{email_media},
2645 newlocation => $newloc,
2646 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81\81 },..]
2647 medias => [ values %$medias ],
2649 "change_location.tpl");
2653 sub display_client_stats
2655 my ($self, %arg) = @_ ;
2657 my $client = $self->dbh_quote($arg{clientname});
2659 my ($limit, $label) = $self->get_limit(%arg);
2663 count(Job.JobId) AS nb_jobs,
2664 sum(Job.JobBytes) AS nb_bytes,
2665 sum(Job.JobErrors) AS nb_err,
2666 sum(Job.JobFiles) AS nb_files,
2667 Client.Name AS clientname
2668 FROM Job JOIN Client USING (ClientId)
2670 Client.Name = $client
2672 GROUP BY Client.Name
2675 my $row = $self->dbh_selectrow_hashref($query);
2677 $row->{ID} = $cur_id++;
2678 $row->{label} = $label;
2679 $row->{grapharg} = "client";
2681 $self->display($row, "display_client_stats.tpl");
2685 sub display_group_stats
2687 my ($self, %arg) = @_ ;
2689 my $carg = $self->get_form(qw/qclient_group/);
2691 my ($limit, $label) = $self->get_limit(%arg);
2695 count(Job.JobId) AS nb_jobs,
2696 sum(Job.JobBytes) AS nb_bytes,
2697 sum(Job.JobErrors) AS nb_err,
2698 sum(Job.JobFiles) AS nb_files,
2699 client_group.client_group_name AS clientname
2700 FROM Job JOIN Client USING (ClientId)
2701 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
2702 JOIN client_group USING (client_group_id)
2704 client_group.client_group_name = $carg->{qclient_group}
2706 GROUP BY client_group.client_group_name
2709 my $row = $self->dbh_selectrow_hashref($query);
2711 $row->{ID} = $cur_id++;
2712 $row->{label} = $label;
2713 $row->{grapharg} = "client_group";
2715 $self->display($row, "display_client_stats.tpl");
2718 # poolname can be undef
2721 my ($self, $poolname) = @_ ;
2725 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2726 if ($arg->{jmediatypes}) {
2727 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2728 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2731 # TODO : afficher les tailles et les dates
2734 SELECT subq.volmax AS volmax,
2735 subq.volnum AS volnum,
2736 subq.voltotal AS voltotal,
2738 Pool.Recycle AS recycle,
2739 Pool.VolRetention AS volretention,
2740 Pool.VolUseDuration AS voluseduration,
2741 Pool.MaxVolJobs AS maxvoljobs,
2742 Pool.MaxVolFiles AS maxvolfiles,
2743 Pool.MaxVolBytes AS maxvolbytes,
2744 subq.PoolId AS PoolId
2747 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2748 count(Media.MediaId) AS volnum,
2749 sum(Media.VolBytes) AS voltotal,
2750 Media.PoolId AS PoolId,
2751 Media.MediaType AS MediaType
2753 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2754 Media.MediaType AS MediaType
2756 WHERE Media.VolStatus = 'Full'
2757 GROUP BY Media.MediaType
2758 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2759 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2761 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2765 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2768 SELECT Pool.Name AS name,
2769 sum(VolBytes) AS size
2770 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2771 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2775 my $empty = $self->dbh_selectall_hashref($query, 'name');
2777 foreach my $p (values %$all) {
2778 if ($p->{volmax} > 0) { # mysql returns 0.0000
2779 # we remove Recycled/Purged media from pool usage
2780 if (defined $empty->{$p->{name}}) {
2781 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2783 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2785 $p->{poolusage} = 0;
2789 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2791 WHERE PoolId=$p->{poolid}
2795 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2796 foreach my $t (values %$content) {
2797 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2802 $self->display({ ID => $cur_id++,
2803 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2804 Pools => [ values %$all ]},
2805 "display_pool.tpl");
2808 sub display_running_job
2812 my $arg = $self->get_form('client', 'jobid');
2814 if (!$arg->{client} and $arg->{jobid}) {
2817 SELECT Client.Name AS name
2818 FROM Job INNER JOIN Client USING (ClientId)
2819 WHERE Job.JobId = $arg->{jobid}
2822 my $row = $self->dbh_selectrow_hashref($query);
2825 $arg->{client} = $row->{name};
2826 CGI::param('client', $arg->{client});
2830 if ($arg->{client}) {
2831 my $cli = new Bweb::Client(name => $arg->{client});
2832 $cli->display_running_job($self->{info}, $arg->{jobid});
2833 if ($arg->{jobid}) {
2834 $self->get_job_log();
2837 $self->error("Can't get client or jobid");
2841 sub display_running_jobs
2843 my ($self, $display_action) = @_;
2846 SELECT Job.JobId AS jobid,
2847 Job.Name AS jobname,
2849 Job.StartTime AS starttime,
2850 Job.JobFiles AS jobfiles,
2851 Job.JobBytes AS jobbytes,
2852 Job.JobStatus AS jobstatus,
2853 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2854 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2856 Client.Name AS clientname
2857 FROM Job INNER JOIN Client USING (ClientId)
2858 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2860 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2862 $self->display({ ID => $cur_id++,
2863 display_action => $display_action,
2864 Jobs => [ values %$all ]},
2865 "running_job.tpl") ;
2868 # return the autochanger list to update
2873 my $arg = $self->get_form('jmedias');
2875 unless ($arg->{jmedias}) {
2876 return $self->error("Can't get media selection");
2880 SELECT Media.VolumeName AS volumename,
2881 Storage.Name AS storage,
2882 Location.Location AS location,
2884 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2885 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2886 WHERE Media.VolumeName IN ($arg->{jmedias})
2887 AND Media.InChanger = 1
2890 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2892 foreach my $vol (values %$all) {
2893 my $a = $self->ach_get($vol->{location});
2895 $ret{$vol->{location}} = 1;
2897 unless ($a->{have_status}) {
2899 $a->{have_status} = 1;
2902 print "eject $vol->{volumename} from $vol->{storage} : ";
2903 if ($a->send_to_io($vol->{slot})) {
2904 print "<img src='/bweb/T.png' alt='ok'><br/>";
2906 print "<img src='/bweb/E.png' alt='err'><br/>";
2916 my ($to, $subject, $content) = (CGI::param('email'),
2917 CGI::param('subject'),
2918 CGI::param('content'));
2919 $to =~ s/[^\w\d\.\@<>,]//;
2920 $subject =~ s/[^\w\d\.\[\]]/ /;
2922 open(MAIL, "|mail -s '$subject' '$to'") ;
2923 print MAIL $content;
2933 my $arg = $self->get_form('jobid', 'client');
2935 print CGI::header('text/brestore');
2936 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2937 print "client=$arg->{client}\n" if ($arg->{client});
2938 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2942 # TODO : move this to Bweb::Autochanger ?
2943 # TODO : make this internal to not eject tape ?
2949 my ($self, $name) = @_;
2952 return $self->error("Can't get your autochanger name ach");
2955 unless ($self->{info}->{ach_list}) {
2956 return $self->error("Could not find any autochanger");
2959 my $a = $self->{info}->{ach_list}->{$name};
2962 $self->error("Can't get your autochanger $name from your ach_list");
2967 $a->{debug} = $self->{debug};
2974 my ($self, $ach) = @_;
2976 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2978 $self->{info}->save();
2986 my $arg = $self->get_form('ach');
2988 or !$self->{info}->{ach_list}
2989 or !$self->{info}->{ach_list}->{$arg->{ach}})
2991 return $self->error("Can't get autochanger name");
2994 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2998 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3000 my $b = $self->get_bconsole();
3002 my @storages = $b->list_storage() ;
3004 $ach->{devices} = [ map { { name => $_ } } @storages ];
3006 $self->display($ach, "ach_add.tpl");
3007 delete $ach->{drives};
3008 delete $ach->{devices};
3015 my $arg = $self->get_form('ach');
3018 or !$self->{info}->{ach_list}
3019 or !$self->{info}->{ach_list}->{$arg->{ach}})
3021 return $self->error("Can't get autochanger name");
3024 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3026 $self->{info}->save();
3027 $self->{info}->view();
3033 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3035 my $b = $self->get_bconsole();
3036 my @storages = $b->list_storage() ;
3038 unless ($arg->{ach}) {
3039 $arg->{devices} = [ map { { name => $_ } } @storages ];
3040 return $self->display($arg, "ach_add.tpl");
3044 foreach my $drive (CGI::param('drives'))
3046 unless (grep(/^$drive$/,@storages)) {
3047 return $self->error("Can't find $drive in storage list");
3050 my $index = CGI::param("index_$drive");
3051 unless (defined $index and $index =~ /^(\d+)$/) {
3052 return $self->error("Can't get $drive index");
3055 $drives[$index] = $drive;
3059 return $self->error("Can't get drives from Autochanger");
3062 my $a = new Bweb::Autochanger(name => $arg->{ach},
3063 precmd => $arg->{precmd},
3064 drive_name => \@drives,
3065 device => $arg->{device},
3066 mtxcmd => $arg->{mtxcmd});
3068 $self->ach_register($a) ;
3070 $self->{info}->view();
3076 my $arg = $self->get_form('jobid');
3078 if ($arg->{jobid}) {
3079 my $b = $self->get_bconsole();
3080 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3084 title => "Delete a job ",
3085 name => "delete jobid=$arg->{jobid}",
3094 my $arg = $self->get_form(qw/media volstatus inchanger pool
3095 slot volretention voluseduration
3096 maxvoljobs maxvolfiles maxvolbytes
3097 qcomment poolrecycle
3100 unless ($arg->{media}) {
3101 return $self->error("Can't find media selection");
3104 my $update = "update volume=$arg->{media} ";
3106 if ($arg->{volstatus}) {
3107 $update .= " volstatus=$arg->{volstatus} ";
3110 if ($arg->{inchanger}) {
3111 $update .= " inchanger=yes " ;
3113 $update .= " slot=$arg->{slot} ";
3116 $update .= " slot=0 inchanger=no ";
3120 $update .= " pool=$arg->{pool} " ;
3123 if (defined $arg->{volretention}) {
3124 $update .= " volretention=\"$arg->{volretention}\" " ;
3127 if (defined $arg->{voluseduration}) {
3128 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3131 if (defined $arg->{maxvoljobs}) {
3132 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3135 if (defined $arg->{maxvolfiles}) {
3136 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3139 if (defined $arg->{maxvolbytes}) {
3140 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3143 my $b = $self->get_bconsole();
3146 content => $b->send_cmd($update),
3147 title => "Update a volume ",
3153 my $media = $self->dbh_quote($arg->{media});
3155 my $loc = CGI::param('location') || '';
3157 $loc = $self->dbh_quote($loc); # is checked by db
3158 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3160 if ($arg->{poolrecycle}) {
3161 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
3163 if (!$arg->{qcomment}) {
3164 $arg->{qcomment} = "''";
3166 push @q, "Comment=$arg->{qcomment}";
3171 SET " . join (',', @q) . "
3172 WHERE Media.VolumeName = $media
3174 $self->dbh_do($query);
3176 $self->update_media();
3183 my $ach = CGI::param('ach') ;
3184 $ach = $self->ach_get($ach);
3186 return $self->error("Bad autochanger name");
3190 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3191 $b->update_slots($ach->{name});
3199 my $arg = $self->get_form('jobid', 'limit', 'offset');
3200 unless ($arg->{jobid}) {
3201 return $self->error("Can't get jobid");
3204 if ($arg->{limit} == 100) {
3205 $arg->{limit} = 1000;
3208 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3211 SELECT Job.Name as name, Client.Name as clientname
3212 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3213 WHERE JobId = $arg->{jobid}
3216 my $row = $self->dbh_selectrow_hashref($query);
3219 return $self->error("Can't find $arg->{jobid} in catalog");
3223 SELECT Time AS time, LogText AS log
3225 WHERE Log.JobId = $arg->{jobid}
3226 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3227 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3231 OFFSET $arg->{offset}
3234 my $log = $self->dbh_selectall_arrayref($query);
3236 return $self->error("Can't get log for jobid $arg->{jobid}");
3242 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3244 $logtxt = join("", map { $_->[1] } @$log ) ;
3247 $self->display({ lines=> $logtxt,
3248 jobid => $arg->{jobid},
3249 name => $row->{name},
3250 client => $row->{clientname},
3251 offset => $arg->{offset},
3252 limit => $arg->{limit},
3253 }, 'display_log.tpl');
3261 my $arg = $self->get_form('ach', 'slots', 'drive');
3263 unless ($arg->{ach}) {
3264 return $self->error("Can't find autochanger name");
3267 my $a = $self->ach_get($arg->{ach});
3269 return $self->error("Can't find autochanger name in configuration");
3272 my $storage = $a->get_drive_name($arg->{drive});
3274 return $self->error("Can't get your drive name");
3279 if ($arg->{slots}) {
3280 $slots = join(",", @{ $arg->{slots} });
3281 $t += 60*scalar( @{ $arg->{slots} }) ;
3284 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3285 print "<h1>This command can take long time, be patient...</h1>";
3287 $b->label_barcodes(storage => $storage,
3288 drive => $arg->{drive},
3296 SET LocationId = (SELECT LocationId
3298 WHERE Location = '$arg->{ach}'),
3300 RecyclePoolId = PoolId
3302 WHERE Media.PoolId = (SELECT PoolId
3304 WHERE Name = 'Scratch')
3305 AND (LocationId = 0 OR LocationId IS NULL)
3314 my @volume = CGI::param('media');
3317 return $self->error("Can't get media selection");
3320 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3323 content => $b->purge_volume(@volume),
3324 title => "Purge media",
3325 name => "purge volume=" . join(' volume=', @volume),
3334 my @volume = CGI::param('media');
3336 return $self->error("Can't get media selection");
3339 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3342 content => $b->prune_volume(@volume),
3343 title => "Prune media",
3344 name => "prune volume=" . join(' volume=', @volume),
3354 my $arg = $self->get_form('jobid');
3355 unless ($arg->{jobid}) {
3356 return $self->error("Can't get jobid");
3359 my $b = $self->get_bconsole();
3361 content => $b->cancel($arg->{jobid}),
3362 title => "Cancel job",
3363 name => "cancel jobid=$arg->{jobid}",
3369 # Warning, we display current fileset
3372 my $arg = $self->get_form('fileset');
3374 if ($arg->{fileset}) {
3375 my $b = $self->get_bconsole();
3376 my $ret = $b->get_fileset($arg->{fileset});
3377 $self->display({ fileset => $arg->{fileset},
3379 }, "fileset_view.tpl");
3381 $self->error("Can't get fileset name");
3385 sub director_show_sched
3389 my $arg = $self->get_form('days');
3391 my $b = $self->get_bconsole();
3392 my $ret = $b->director_get_sched( $arg->{days} );
3397 }, "scheduled_job.tpl");
3400 sub enable_disable_job
3402 my ($self, $what) = @_ ;
3404 my $name = CGI::param('job') || '';
3405 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3406 return $self->error("Can't find job name");
3409 my $b = $self->get_bconsole();
3419 content => $b->send_cmd("$cmd job=\"$name\""),
3420 title => "$cmd $name",
3421 name => "$cmd job=\"$name\"",
3428 return new Bconsole(pref => $self->{info});
3434 my $b = $self->get_bconsole();
3436 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3438 $self->display({ Jobs => $joblist }, "run_job.tpl");
3443 my ($self, $ouput) = @_;
3446 foreach my $l (split(/\r\n/, $ouput)) {
3447 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3453 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3459 foreach my $k (keys %arg) {
3460 $lowcase{lc($k)} = $arg{$k} ;
3469 my $b = $self->get_bconsole();
3471 my $job = CGI::param('job') || '';
3473 # we take informations from director, and we overwrite with user wish
3474 my $info = $b->send_cmd("show job=\"$job\"");
3475 my $attr = $self->run_parse_job($info);
3477 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3478 my %job_opt = (%$attr, %$arg);
3480 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3482 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3483 my $clients = [ map { { name => $_ } }$b->list_client()];
3484 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3485 my $storages= [ map { { name => $_ } }$b->list_storage()];
3490 clients => $clients,
3491 filesets => $filesets,
3492 storages => $storages,
3494 }, "run_job_mod.tpl");
3500 my $b = $self->get_bconsole();
3502 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3512 my $b = $self->get_bconsole();
3514 # TODO: check input (don't use pool, level)
3516 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3517 my $job = CGI::param('job') || '';
3518 my $storage = CGI::param('storage') || '';
3520 my $jobid = $b->run(job => $job,
3521 client => $arg->{client},
3522 priority => $arg->{priority},
3523 level => $arg->{level},
3524 storage => $storage,
3525 pool => $arg->{pool},
3526 fileset => $arg->{fileset},
3527 when => $arg->{when},
3530 print $jobid, $b->{error};
3532 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";