1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
15 This program is Free Software; you can redistribute it and/or
16 modify it under the terms of version two of the GNU General Public
17 License as published by the Free Software Foundation plus additions
18 that are listed in the file LICENSE.
20 This program is distributed in the hope that it will be useful, but
21 WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 Bacula® is a registered trademark of John Walker.
31 The licensor of Bacula is the Free Software Foundation Europe
32 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
33 Switzerland, email:ftf@fsfeurope.org.
45 Bweb::Gui - Base package for all Bweb object
49 This package define base fonction like new, display, etc..
54 our $template_dir='/usr/share/bweb/tpl';
58 new - creation a of new Bweb object
62 This function take an hash of argument and place them
65 IE : $obj = new Obj(name => 'test', age => '10');
67 $obj->{name} eq 'test' and $obj->{age} eq 10
73 my ($class, %arg) = @_;
78 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
85 my ($self, $what) = @_;
89 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
91 print "<pre>$what</pre>";
98 error - display an error to the user
102 this function set $self->{error} with arg, display a message with
103 error.tpl and return 0
108 return $self->error("Can't use this file");
115 my ($self, $what) = @_;
116 $self->{error} = $what;
117 $self->display($self, 'error.tpl');
123 display - display an html page with HTML::Template
127 this function is use to render all html codes. it takes an
128 ref hash as arg in which all param are usable in template.
130 it will use global template_dir to search the template file.
132 hash keys are not sensitive. See HTML::Template for more
133 explanations about the hash ref. (it's can be quiet hard to understand)
137 $ref = { name => 'me', age => 26 };
138 $self->display($ref, "people.tpl");
144 my ($self, $hash, $tpl) = @_ ;
146 my $template = HTML::Template->new(filename => $tpl,
147 path =>[$template_dir],
148 die_on_bad_params => 0,
149 case_sensitive => 0);
151 foreach my $var (qw/limit offset/) {
153 unless ($hash->{$var}) {
154 my $value = CGI::param($var) || '';
156 if ($value =~ /^(\d+)$/) {
157 $template->param($var, $1) ;
162 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
163 $template->param('loginname', CGI::remote_user());
165 $template->param($hash);
166 print $template->output();
170 ################################################################
172 package Bweb::Config;
174 use base q/Bweb::Gui/;
178 Bweb::Config - read, write, display, modify configuration
182 this package is used for manage configuration
186 $conf = new Bweb::Config(config_file => '/path/to/conf');
197 =head1 PACKAGE VARIABLE
199 %k_re - hash of all acceptable option.
203 this variable permit to check all option with a regexp.
207 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
208 user => qr/^([\w\d\.-]+)$/i,
209 password => qr/^(.*)$/i,
210 fv_write_path => qr!^([/\w\d\.-]*)$!,
211 template_dir => qr!^([/\w\d\.-]+)$!,
212 debug => qr/^(on)?$/,
213 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
214 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
215 bconsole => qr!^(.+)?$!,
216 syslog_file => qr!^(.+)?$!,
217 log_dir => qr!^(.+)?$!,
218 stat_job_table => qr!^(\w*)$!,
219 display_log_time => qr!^(on)?$!,
224 load - load config_file
228 this function load the specified config_file.
236 unless (open(FP, $self->{config_file}))
238 return $self->error("can't load config_file $self->{config_file} : $!");
240 my $f=''; my $tmpbuffer;
241 while(read FP,$tmpbuffer,4096)
249 no strict; # I have no idea of the contents of the file
256 return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
259 foreach my $k (keys %$VAR1) {
260 $self->{$k} = $VAR1->{$k};
268 load_old - load old configuration format
276 unless (open(FP, $self->{config_file}))
278 return $self->error("$self->{config_file} : $!");
281 while (my $line = <FP>)
284 my ($k, $v) = split(/\s*=\s*/, $line, 2);
296 save - save the current configuration to config_file
304 if ($self->{ach_list}) {
305 # shortcut for display_begin
306 $self->{achs} = [ map {{ name => $_ }}
307 keys %{$self->{ach_list}}
311 unless (open(FP, ">$self->{config_file}"))
313 return $self->error("$self->{config_file} : $!\n" .
314 "You must add this to your config file\n"
315 . Data::Dumper::Dumper($self));
318 print FP Data::Dumper::Dumper($self);
326 edit, view, modify - html form ouput
334 $self->display($self, "config_edit.tpl");
340 $self->display($self, "config_view.tpl");
350 foreach my $k (CGI::param())
352 next unless (exists $k_re{$k}) ;
353 my $val = CGI::param($k);
354 if ($val =~ $k_re{$k}) {
357 $self->{error} .= "bad parameter : $k = [$val]";
363 if ($self->{error}) { # an error as occured
364 $self->display($self, 'error.tpl');
372 ################################################################
374 package Bweb::Client;
376 use base q/Bweb::Gui/;
380 Bweb::Client - Bacula FD
384 this package is use to do all Client operations like, parse status etc...
388 $client = new Bweb::Client(name => 'zog-fd');
389 $client->status(); # do a 'status client=zog-fd'
395 display_running_job - Html display of a running job
399 this function is used to display information about a current job
403 sub display_running_job
405 my ($self, $conf, $jobid) = @_ ;
407 my $status = $self->status($conf);
410 if ($status->{$jobid}) {
411 $self->display($status->{$jobid}, "client_job_status.tpl");
414 for my $id (keys %$status) {
415 $self->display($status->{$id}, "client_job_status.tpl");
422 $client = new Bweb::Client(name => 'plume-fd');
424 $client->status($bweb);
428 dirty hack to parse "status client=xxx-fd"
432 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
433 Backup Job started: 06-jun-06 17:22
434 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
435 Files Examined=10,697
436 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
442 JobName => Full_plume.2006-06-06_17.22.23,
445 Bytes => 194,484,132,
455 my ($self, $conf) = @_ ;
457 if (defined $self->{cur_jobs}) {
458 return $self->{cur_jobs} ;
462 my $b = new Bconsole(pref => $conf);
463 my $ret = $b->send_cmd("st client=$self->{name}");
467 for my $r (split(/\n/, $ret)) {
469 $r =~ s/(^\s+|\s+$)//g;
470 if ($r =~ /JobId (\d+) Job (\S+)/) {
472 $arg->{$jobid} = { @param, JobId => $jobid } ;
476 @param = ( JobName => $2 );
478 } elsif ($r =~ /=.+=/) {
479 push @param, split(/\s+|\s*=\s*/, $r) ;
481 } elsif ($r =~ /=/) { # one per line
482 push @param, split(/\s*=\s*/, $r) ;
484 } elsif ($r =~ /:/) { # one per line
485 push @param, split(/\s*:\s*/, $r, 2) ;
489 if ($jobid and @param) {
490 $arg->{$jobid} = { @param,
492 Client => $self->{name},
496 $self->{cur_jobs} = $arg ;
502 ################################################################
504 package Bweb::Autochanger;
506 use base q/Bweb::Gui/;
510 Bweb::Autochanger - Object to manage Autochanger
514 this package will parse the mtx output and manage drives.
518 $auto = new Bweb::Autochanger(precmd => 'sudo');
520 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
524 $auto->slot_is_full(10);
525 $auto->transfer(10, 11);
531 my ($class, %arg) = @_;
534 name => '', # autochanger name
535 label => {}, # where are volume { label1 => 40, label2 => drive0 }
536 drive => [], # drive use [ 'media1', 'empty', ..]
537 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
538 io => [], # io slot number list [ 41, 42, 43...]
539 info => {slot => 0, # informations (slot, drive, io)
543 mtxcmd => '/usr/sbin/mtx',
545 device => '/dev/changer',
546 precmd => '', # ssh command
547 bweb => undef, # link to bacula web object (use for display)
550 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
557 status - parse the output of mtx status
561 this function will launch mtx status and parse the output. it will
562 give a perlish view of the autochanger content.
564 it uses ssh if the autochanger is on a other host.
571 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
573 # TODO : reset all infos
574 $self->{info}->{drive} = 0;
575 $self->{info}->{slot} = 0;
576 $self->{info}->{io} = 0;
578 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
581 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
582 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
583 #Data Transfer Element 1:Empty
584 # Storage Element 1:Empty
585 # Storage Element 2:Full :VolumeTag=000002
586 # Storage Element 3:Empty
587 # Storage Element 4:Full :VolumeTag=000004
588 # Storage Element 5:Full :VolumeTag=000001
589 # Storage Element 6:Full :VolumeTag=000003
590 # Storage Element 7:Empty
591 # Storage Element 41 IMPORT/EXPORT:Empty
592 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
597 # Storage Element 7:Empty
598 # Storage Element 2:Full :VolumeTag=000002
599 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
602 $self->set_empty_slot($1);
604 $self->set_slot($1, $4);
607 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
610 $self->set_empty_drive($1);
612 $self->set_drive($1, $4, $6);
615 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
618 $self->set_empty_io($1);
620 $self->set_io($1, $4);
623 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
625 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
626 $self->{info}->{drive} = $1;
627 $self->{info}->{slot} = $2;
628 if ($l =~ /(\d+)\s+Import/) {
629 $self->{info}->{io} = $1 ;
631 $self->{info}->{io} = 0;
636 $self->debug($self) ;
641 my ($self, $slot) = @_;
644 if ($self->{slot}->[$slot] eq 'loaded') {
648 my $label = $self->{slot}->[$slot] ;
650 return $self->is_media_loaded($label);
655 my ($self, $drive, $slot) = @_;
657 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
658 return 0 if ($self->slot_is_full($slot)) ;
660 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
663 my $content = $self->get_slot($slot);
664 print "content = $content<br/> $drive => $slot<br/>";
665 $self->set_empty_drive($drive);
666 $self->set_slot($slot, $content);
669 $self->{error} = $out;
674 # TODO: load/unload have to use mtx script from bacula
677 my ($self, $drive, $slot) = @_;
679 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
680 return 0 unless ($self->slot_is_full($slot)) ;
682 print "Loading drive $drive with slot $slot<br/>\n";
683 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
686 my $content = $self->get_slot($slot);
687 print "content = $content<br/> $slot => $drive<br/>";
688 $self->set_drive($drive, $slot, $content);
691 $self->{error} = $out;
699 my ($self, $media) = @_;
701 unless ($self->{label}->{$media}) {
705 if ($self->{label}->{$media} =~ /drive\d+/) {
715 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
720 my ($self, $slot, $tag) = @_;
721 $self->{slot}->[$slot] = $tag || 'full';
722 push @{ $self->{io} }, $slot;
725 $self->{label}->{$tag} = $slot;
731 my ($self, $slot) = @_;
733 push @{ $self->{io} }, $slot;
735 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
736 $self->{slot}->[$slot] = 'empty';
742 my ($self, $slot) = @_;
743 return $self->{slot}->[$slot];
748 my ($self, $slot, $tag) = @_;
749 $self->{slot}->[$slot] = $tag || 'full';
752 $self->{label}->{$tag} = $slot;
758 my ($self, $slot) = @_;
760 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
761 $self->{slot}->[$slot] = 'empty';
767 my ($self, $drive) = @_;
768 $self->{drive}->[$drive] = 'empty';
773 my ($self, $drive, $slot, $tag) = @_;
774 $self->{drive}->[$drive] = $tag || $slot;
776 $self->{slot}->[$slot] = $tag || 'loaded';
779 $self->{label}->{$tag} = "drive$drive";
785 my ($self, $slot) = @_;
787 # slot don't exists => full
788 if (not defined $self->{slot}->[$slot]) {
792 if ($self->{slot}->[$slot] eq 'empty') {
795 return 1; # vol, full, loaded
798 sub slot_get_first_free
801 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
802 return $slot unless ($self->slot_is_full($slot));
806 sub io_get_first_free
810 foreach my $slot (@{ $self->{io} }) {
811 return $slot unless ($self->slot_is_full($slot));
818 my ($self, $media) = @_;
820 return $self->{label}->{$media} ;
825 my ($self, $media) = @_;
827 return defined $self->{label}->{$media} ;
832 my ($self, $slot) = @_;
834 unless ($self->slot_is_full($slot)) {
835 print "Autochanger $self->{name} slot $slot is empty\n";
840 if ($self->is_slot_loaded($slot)) {
843 print "Autochanger $self->{name} $slot is currently in use\n";
847 # autochanger must have I/O
848 unless ($self->have_io()) {
849 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
853 my $dst = $self->io_get_first_free();
856 print "Autochanger $self->{name} you must empty I/O first\n";
859 $self->transfer($slot, $dst);
864 my ($self, $src, $dst) = @_ ;
865 if ($self->{debug}) {
866 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
868 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
871 my $content = $self->get_slot($src);
872 $self->{slot}->[$src] = 'empty';
873 $self->set_slot($dst, $content);
876 $self->{error} = $out;
883 my ($self, $index) = @_;
884 return $self->{drive_name}->[$index];
887 # TODO : do a tapeinfo request to get informations
897 for my $slot (@{$self->{io}})
899 if ($self->is_slot_loaded($slot)) {
900 print "$slot is currently loaded\n";
904 if ($self->slot_is_full($slot))
906 my $free = $self->slot_get_first_free() ;
907 print "move $slot to $free :\n";
910 if ($self->transfer($slot, $free)) {
911 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
913 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
917 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
923 # TODO : this is with mtx status output,
924 # we can do an other function from bacula view (with StorageId)
928 my $bweb = $self->{bweb};
930 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
931 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
934 SELECT Media.VolumeName AS volumename,
935 Media.VolStatus AS volstatus,
936 Media.LastWritten AS lastwritten,
937 Media.VolBytes AS volbytes,
938 Media.MediaType AS mediatype,
940 Media.InChanger AS inchanger,
942 $bweb->{sql}->{FROM_UNIXTIME}(
943 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
944 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
947 INNER JOIN Pool USING (PoolId)
949 WHERE Media.VolumeName IN ($media_list)
952 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
954 # TODO : verify slot and bacula slot
958 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
960 if ($self->slot_is_full($slot)) {
962 my $vol = $self->{slot}->[$slot];
963 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
965 my $bslot = $all->{$vol}->{slot} ;
966 my $inchanger = $all->{$vol}->{inchanger};
968 # if bacula slot or inchanger flag is bad, we display a message
969 if ($bslot != $slot or !$inchanger) {
970 push @to_update, $slot;
973 $all->{$vol}->{realslot} = $slot;
975 push @{ $param }, $all->{$vol};
977 } else { # empty or no label
978 push @{ $param }, {realslot => $slot,
979 volstatus => 'Unknown',
980 volumename => $self->{slot}->[$slot]} ;
983 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
987 my $i=0; my $drives = [] ;
988 foreach my $d (@{ $self->{drive} }) {
989 $drives->[$i] = { index => $i,
990 load => $self->{drive}->[$i],
991 name => $self->{drive_name}->[$i],
996 $bweb->display({ Name => $self->{name},
997 nb_drive => $self->{info}->{drive},
998 nb_io => $self->{info}->{io},
1001 Update => scalar(@to_update) },
1009 ################################################################
1013 use base q/Bweb::Gui/;
1017 Bweb - main Bweb package
1021 this package is use to compute and display informations
1026 use POSIX qw/strftime/;
1028 our $config_file='/etc/bacula/bweb.conf';
1034 %sql_func - hash to make query mysql/postgresql compliant
1040 UNIX_TIMESTAMP => '',
1041 FROM_UNIXTIME => '',
1042 TO_SEC => " interval '1 second' * ",
1043 SEC_TO_INT => "SEC_TO_INT",
1046 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1047 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1048 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1049 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1050 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1051 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1052 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1053 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1056 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1057 FROM_UNIXTIME => 'FROM_UNIXTIME',
1060 SEC_TO_TIME => 'SEC_TO_TIME',
1061 MATCH => " REGEXP ",
1062 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1063 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1064 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1065 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1066 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1067 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1068 # with mysql < 5, you have to play with the ugly SHOW command
1069 DB_SIZE => " SELECT 0 ",
1070 # works only with mysql 5
1071 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1072 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1080 $self->{dbh}->disconnect();
1085 sub dbh_selectall_arrayref
1087 my ($self, $query) = @_;
1088 $self->connect_db();
1089 $self->debug($query);
1090 return $self->{dbh}->selectall_arrayref($query);
1095 my ($self, @what) = @_;
1096 return join(',', $self->dbh_quote(@what)) ;
1101 my ($self, @what) = @_;
1103 $self->connect_db();
1105 return map { $self->{dbh}->quote($_) } @what;
1107 return $self->{dbh}->quote($what[0]) ;
1113 my ($self, $query) = @_ ;
1114 $self->connect_db();
1115 $self->debug($query);
1116 return $self->{dbh}->do($query);
1119 sub dbh_selectall_hashref
1121 my ($self, $query, $join) = @_;
1123 $self->connect_db();
1124 $self->debug($query);
1125 return $self->{dbh}->selectall_hashref($query, $join) ;
1128 sub dbh_selectrow_hashref
1130 my ($self, $query) = @_;
1132 $self->connect_db();
1133 $self->debug($query);
1134 return $self->{dbh}->selectrow_hashref($query) ;
1140 my @unit = qw(B KB MB GB TB);
1141 my $val = shift || 0;
1143 my $format = '%i %s';
1144 while ($val / 1024 > 1) {
1148 $format = ($i>0)?'%0.1f %s':'%i %s';
1149 return sprintf($format, $val, $unit[$i]);
1152 # display Day, Hour, Year
1158 $val /= 60; # sec -> min
1160 if ($val / 60 <= 1) {
1164 $val /= 60; # min -> hour
1165 if ($val / 24 <= 1) {
1166 return "$val hours";
1169 $val /= 24; # hour -> day
1170 if ($val / 365 < 2) {
1174 $val /= 365 ; # day -> year
1176 return "$val years";
1179 # get Day, Hour, Year
1185 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1189 my %times = ( m => 60,
1195 my $mult = $times{$2} || 0;
1205 unless ($self->{dbh}) {
1206 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1207 $self->{info}->{user},
1208 $self->{info}->{password});
1210 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1211 unless ($self->{dbh});
1213 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1215 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1216 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1223 my ($class, %arg) = @_;
1225 dbh => undef, # connect_db();
1227 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1233 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1235 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1236 $self->{sql} = $sql_func{$1};
1239 $self->{debug} = $self->{info}->{debug};
1240 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1248 $self->display($self->{info}, "begin.tpl");
1254 $self->display($self->{info}, "end.tpl");
1262 my $arg = $self->get_form("client", "qre_client", "jclient_groups");
1264 if ($arg->{qre_client}) {
1265 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1266 } elsif ($arg->{client}) {
1267 $where = "WHERE Name = '$arg->{client}' ";
1268 } elsif ($arg->{jclient_groups}) {
1269 $where = "JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
1270 JOIN client_group USING (client_group_id)
1271 WHERE client_group_name IN ($arg->{jclient_groups})";
1275 SELECT Name AS name,
1277 AutoPrune AS autoprune,
1278 FileRetention AS fileretention,
1279 JobRetention AS jobretention
1284 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1286 my $dsp = { ID => $cur_id++,
1287 clients => [ values %$all] };
1289 $self->display($dsp, "client_list.tpl") ;
1294 my ($self, %arg) = @_;
1301 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1303 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1305 $self->{sql}->{TO_SEC}($arg{age})
1308 $label = "last " . human_sec($arg{age});
1311 if ($arg{groupby}) {
1312 $limit .= " GROUP BY $arg{groupby} ";
1316 $limit .= " ORDER BY $arg{order} ";
1320 $limit .= " LIMIT $arg{limit} ";
1321 $label .= " limited to $arg{limit}";
1325 $limit .= " OFFSET $arg{offset} ";
1326 $label .= " with $arg{offset} offset ";
1330 $label = 'no filter';
1333 return ($limit, $label);
1338 $bweb->get_form(...) - Get useful stuff
1342 This function get and check parameters against regexp.
1344 If word begin with 'q', the return will be quoted or join quoted
1345 if it's end with 's'.
1350 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1353 qclient => 'plume-fd',
1354 qpools => "'plume-fd', 'test-fd', '...'",
1361 my ($self, @what) = @_;
1362 my %what = map { $_ => 1 } @what;
1383 my %opt_ss =( # string with space
1387 my %opt_s = ( # default to ''
1404 my %opt_p = ( # option with path
1411 my %opt_r = (regexwhere => 1);
1413 my %opt_d = ( # option with date
1418 foreach my $i (@what) {
1419 if (exists $opt_i{$i}) {# integer param
1420 my $value = CGI::param($i) || $opt_i{$i} ;
1421 if ($value =~ /^(\d+)$/) {
1424 } elsif ($opt_s{$i}) { # simple string param
1425 my $value = CGI::param($i) || '';
1426 if ($value =~ /^([\w\d\.-]+)$/) {
1429 } elsif ($opt_ss{$i}) { # simple string param (with space)
1430 my $value = CGI::param($i) || '';
1431 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1434 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1435 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1437 $ret{$i} = $self->dbh_join(@value) ;
1440 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1441 my $value = CGI::param($1) ;
1443 $ret{$i} = $self->dbh_quote($value);
1446 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1447 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1448 grep { ! /^\s*$/ } CGI::param($1) ];
1449 } elsif (exists $opt_p{$i}) {
1450 my $value = CGI::param($i) || '';
1451 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1454 } elsif (exists $opt_r{$i}) {
1455 my $value = CGI::param($i) || '';
1456 if ($value =~ /^([^'"']+)$/) {
1459 } elsif (exists $opt_d{$i}) {
1460 my $value = CGI::param($i) || '';
1461 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1468 foreach my $s (CGI::param('slot')) {
1469 if ($s =~ /^(\d+)$/) {
1470 push @{$ret{slots}}, $s;
1476 my $when = CGI::param('when') || '';
1477 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1482 if ($what{db_clients}) {
1484 SELECT Client.Name as clientname
1488 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1489 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1493 if ($what{db_client_groups}) {
1495 SELECT client_group_name AS name
1499 my $grps = $self->dbh_selectall_hashref($query, 'name');
1500 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1504 if ($what{db_mediatypes}) {
1506 SELECT MediaType as mediatype
1510 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1511 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1515 if ($what{db_locations}) {
1517 SELECT Location as location, Cost as cost
1520 my $loc = $self->dbh_selectall_hashref($query, 'location');
1521 $ret{db_locations} = [ sort { $a->{location}
1527 if ($what{db_pools}) {
1528 my $query = "SELECT Name as name FROM Pool";
1530 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1531 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1534 if ($what{db_filesets}) {
1536 SELECT FileSet.FileSet AS fileset
1540 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1542 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1543 values %$filesets] ;
1546 if ($what{db_jobnames}) {
1548 SELECT DISTINCT Job.Name AS jobname
1552 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1554 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1555 values %$jobnames] ;
1558 if ($what{db_devices}) {
1560 SELECT Device.Name AS name
1564 my $devices = $self->dbh_selectall_hashref($query, 'name');
1566 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1577 my $fields = $self->get_form(qw/age level status clients filesets
1579 db_clients limit db_filesets width height
1580 qclients qfilesets qjobnames db_jobnames/);
1583 my $url = CGI::url(-full => 0,
1586 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1588 # this organisation is to keep user choice between 2 click
1589 # TODO : fileset and client selection doesn't work
1598 sub display_client_job
1600 my ($self, %arg) = @_ ;
1602 $arg{order} = ' Job.JobId DESC ';
1603 my ($limit, $label) = $self->get_limit(%arg);
1605 my $clientname = $self->dbh_quote($arg{clientname});
1608 SELECT DISTINCT Job.JobId AS jobid,
1609 Job.Name AS jobname,
1610 FileSet.FileSet AS fileset,
1612 StartTime AS starttime,
1613 JobFiles AS jobfiles,
1614 JobBytes AS jobbytes,
1615 JobStatus AS jobstatus,
1616 JobErrors AS joberrors
1618 FROM Client,Job,FileSet
1619 WHERE Client.Name=$clientname
1620 AND Client.ClientId=Job.ClientId
1621 AND Job.FileSetId=FileSet.FileSetId
1625 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1627 $self->display({ clientname => $arg{clientname},
1630 Jobs => [ values %$all ],
1632 "display_client_job.tpl") ;
1635 sub get_selected_media_location
1639 my $medias = $self->get_form('jmedias');
1641 unless ($medias->{jmedias}) {
1646 SELECT Media.VolumeName AS volumename, Location.Location AS location
1647 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1648 WHERE Media.VolumeName IN ($medias->{jmedias})
1651 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1653 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1664 my $medias = $self->get_selected_media_location();
1670 my $elt = $self->get_form('db_locations');
1672 $self->display({ ID => $cur_id++,
1673 %$elt, # db_locations
1675 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1685 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1687 $self->display($elt, "help_extern.tpl");
1690 sub help_extern_compute
1694 my $number = CGI::param('limit') || '' ;
1695 unless ($number =~ /^(\d+)$/) {
1696 return $self->error("Bad arg number : $number ");
1699 my ($sql, undef) = $self->get_param('pools',
1700 'locations', 'mediatypes');
1703 SELECT Media.VolumeName AS volumename,
1704 Media.VolStatus AS volstatus,
1705 Media.LastWritten AS lastwritten,
1706 Media.MediaType AS mediatype,
1707 Media.VolMounts AS volmounts,
1709 Media.Recycle AS recycle,
1710 $self->{sql}->{FROM_UNIXTIME}(
1711 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1712 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1715 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1716 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1718 WHERE Media.InChanger = 1
1719 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1721 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1725 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1727 $self->display({ Medias => [ values %$all ] },
1728 "help_extern_compute.tpl");
1735 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1736 $self->display($param, "help_intern.tpl");
1739 sub help_intern_compute
1743 my $number = CGI::param('limit') || '' ;
1744 unless ($number =~ /^(\d+)$/) {
1745 return $self->error("Bad arg number : $number ");
1748 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1750 if (CGI::param('expired')) {
1752 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1753 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1759 SELECT Media.VolumeName AS volumename,
1760 Media.VolStatus AS volstatus,
1761 Media.LastWritten AS lastwritten,
1762 Media.MediaType AS mediatype,
1763 Media.VolMounts AS volmounts,
1765 $self->{sql}->{FROM_UNIXTIME}(
1766 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1767 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1770 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1771 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1773 WHERE Media.InChanger <> 1
1774 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1775 AND Media.Recycle = 1
1777 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1781 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1783 $self->display({ Medias => [ values %$all ] },
1784 "help_intern_compute.tpl");
1790 my ($self, %arg) = @_ ;
1792 my ($limit, $label) = $self->get_limit(%arg);
1796 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1797 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1798 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1799 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1800 ($self->{sql}->{DB_SIZE}) AS db_size,
1801 (SELECT count(Job.JobId)
1803 WHERE Job.JobStatus IN ('E','e','f','A')
1806 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1809 my $row = $self->dbh_selectrow_hashref($query) ;
1811 $row->{nb_bytes} = human_size($row->{nb_bytes});
1813 $row->{db_size} = human_size($row->{db_size});
1814 $row->{label} = $label;
1816 $self->display($row, "general.tpl");
1821 my ($self, @what) = @_ ;
1822 my %elt = map { $_ => 1 } @what;
1827 if ($elt{clients}) {
1828 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1830 $ret{clients} = \@clients;
1831 my $str = $self->dbh_join(@clients);
1832 $limit .= "AND Client.Name IN ($str) ";
1836 if ($elt{client_groups}) {
1837 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1839 $ret{client_groups} = \@clients;
1840 my $str = $self->dbh_join(@clients);
1841 $limit .= "AND client_group_name IN ($str) ";
1845 if ($elt{filesets}) {
1846 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1848 $ret{filesets} = \@filesets;
1849 my $str = $self->dbh_join(@filesets);
1850 $limit .= "AND FileSet.FileSet IN ($str) ";
1854 if ($elt{mediatypes}) {
1855 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1857 $ret{mediatypes} = \@medias;
1858 my $str = $self->dbh_join(@medias);
1859 $limit .= "AND Media.MediaType IN ($str) ";
1864 my $client = CGI::param('client');
1865 $ret{client} = $client;
1866 $client = $self->dbh_join($client);
1867 $limit .= "AND Client.Name = $client ";
1871 my $level = CGI::param('level') || '';
1872 if ($level =~ /^(\w)$/) {
1874 $limit .= "AND Job.Level = '$1' ";
1879 my $jobid = CGI::param('jobid') || '';
1881 if ($jobid =~ /^(\d+)$/) {
1883 $limit .= "AND Job.JobId = '$1' ";
1888 my $status = CGI::param('status') || '';
1889 if ($status =~ /^(\w)$/) {
1892 $limit .= "AND Job.JobStatus IN ('f','E') ";
1893 } elsif ($1 eq 'W') {
1894 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1896 $limit .= "AND Job.JobStatus = '$1' ";
1901 if ($elt{volstatus}) {
1902 my $status = CGI::param('volstatus') || '';
1903 if ($status =~ /^(\w+)$/) {
1905 $limit .= "AND Media.VolStatus = '$1' ";
1909 if ($elt{locations}) {
1910 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1912 $ret{locations} = \@location;
1913 my $str = $self->dbh_join(@location);
1914 $limit .= "AND Location.Location IN ($str) ";
1919 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1921 $ret{pools} = \@pool;
1922 my $str = $self->dbh_join(@pool);
1923 $limit .= "AND Pool.Name IN ($str) ";
1927 if ($elt{location}) {
1928 my $location = CGI::param('location') || '';
1930 $ret{location} = $location;
1931 $location = $self->dbh_quote($location);
1932 $limit .= "AND Location.Location = $location ";
1937 my $pool = CGI::param('pool') || '';
1940 $pool = $self->dbh_quote($pool);
1941 $limit .= "AND Pool.Name = $pool ";
1945 if ($elt{jobtype}) {
1946 my $jobtype = CGI::param('jobtype') || '';
1947 if ($jobtype =~ /^(\w)$/) {
1949 $limit .= "AND Job.Type = '$1' ";
1953 return ($limit, %ret);
1964 my ($self, %arg) = @_ ;
1966 $arg{order} = ' Job.JobId DESC ';
1968 my ($limit, $label) = $self->get_limit(%arg);
1969 my ($where, undef) = $self->get_param('clients',
1979 if (CGI::param('client_group')) {
1981 LEFT JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
1982 LEFT JOIN client_group USING (client_group_id)
1987 SELECT Job.JobId AS jobid,
1988 Client.Name AS client,
1989 FileSet.FileSet AS fileset,
1990 Job.Name AS jobname,
1992 StartTime AS starttime,
1994 Pool.Name AS poolname,
1995 JobFiles AS jobfiles,
1996 JobBytes AS jobbytes,
1997 JobStatus AS jobstatus,
1998 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1999 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2002 JobErrors AS joberrors
2005 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2006 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2008 WHERE Client.ClientId=Job.ClientId
2009 AND Job.JobStatus != 'R'
2014 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2016 $self->display({ Filter => $label,
2020 sort { $a->{jobid} <=> $b->{jobid} }
2027 # display job informations
2028 sub display_job_zoom
2030 my ($self, $jobid) = @_ ;
2032 $jobid = $self->dbh_quote($jobid);
2035 SELECT DISTINCT Job.JobId AS jobid,
2036 Client.Name AS client,
2037 Job.Name AS jobname,
2038 FileSet.FileSet AS fileset,
2040 Pool.Name AS poolname,
2041 StartTime AS starttime,
2042 JobFiles AS jobfiles,
2043 JobBytes AS jobbytes,
2044 JobStatus AS jobstatus,
2045 JobErrors AS joberrors,
2046 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2047 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2050 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2051 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2052 WHERE Client.ClientId=Job.ClientId
2053 AND Job.JobId = $jobid
2056 my $row = $self->dbh_selectrow_hashref($query) ;
2058 # display all volumes associate with this job
2060 SELECT Media.VolumeName as volumename
2061 FROM Job,Media,JobMedia
2062 WHERE Job.JobId = $jobid
2063 AND JobMedia.JobId=Job.JobId
2064 AND JobMedia.MediaId=Media.MediaId
2067 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2069 $row->{volumes} = [ values %$all ] ;
2071 $self->display($row, "display_job_zoom.tpl");
2074 sub display_job_group
2076 my ($self, %arg) = @_;
2078 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2080 my ($where, undef) = $self->get_param('client_groups',
2086 SELECT client_group_name AS client_group_name,
2087 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2088 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2089 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2090 COALESCE(jobok.nbjobs,0) AS nbjobok,
2091 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2092 COALESCE(jobok.duration, '0:0:0') AS duration
2094 FROM client_group LEFT JOIN (
2095 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2096 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2097 SUM(JobErrors) AS joberrors,
2098 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2099 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2102 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2103 JOIN client_group USING (client_group_id)
2105 WHERE JobStatus = 'T'
2108 ) AS jobok USING (client_group_name) LEFT JOIN
2111 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2112 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2113 SUM(JobErrors) AS joberrors
2114 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2115 JOIN client_group USING (client_group_id)
2117 WHERE JobStatus IN ('f','E', 'A')
2120 ) AS joberr USING (client_group_name)
2124 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2126 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2129 $self->display($rep, "display_job_group.tpl");
2134 my ($self, %arg) = @_ ;
2136 my ($limit, $label) = $self->get_limit(%arg);
2137 my ($where, %elt) = $self->get_param('pools',
2142 my $arg = $self->get_form('jmedias', 'qre_media');
2144 if ($arg->{jmedias}) {
2145 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2147 if ($arg->{qre_media}) {
2148 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2152 SELECT Media.VolumeName AS volumename,
2153 Media.VolBytes AS volbytes,
2154 Media.VolStatus AS volstatus,
2155 Media.MediaType AS mediatype,
2156 Media.InChanger AS online,
2157 Media.LastWritten AS lastwritten,
2158 Location.Location AS location,
2159 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2160 Pool.Name AS poolname,
2161 $self->{sql}->{FROM_UNIXTIME}(
2162 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2163 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2166 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2167 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2168 Media.MediaType AS MediaType
2170 WHERE Media.VolStatus = 'Full'
2171 GROUP BY Media.MediaType
2172 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2174 WHERE Media.PoolId=Pool.PoolId
2179 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2181 $self->display({ ID => $cur_id++,
2183 Location => $elt{location},
2184 Medias => [ values %$all ]
2186 "display_media.tpl");
2193 my $pool = $self->get_form('db_pools');
2195 foreach my $name (@{ $pool->{db_pools} }) {
2196 CGI::param('pool', $name->{name});
2197 $self->display_media();
2201 sub display_media_zoom
2205 my $medias = $self->get_form('jmedias');
2207 unless ($medias->{jmedias}) {
2208 return $self->error("Can't get media selection");
2212 SELECT InChanger AS online,
2213 VolBytes AS nb_bytes,
2214 VolumeName AS volumename,
2215 VolStatus AS volstatus,
2216 VolMounts AS nb_mounts,
2217 Media.VolUseDuration AS voluseduration,
2218 Media.MaxVolJobs AS maxvoljobs,
2219 Media.MaxVolFiles AS maxvolfiles,
2220 Media.MaxVolBytes AS maxvolbytes,
2221 VolErrors AS nb_errors,
2222 Pool.Name AS poolname,
2223 Location.Location AS location,
2224 Media.Recycle AS recycle,
2225 Media.VolRetention AS volretention,
2226 Media.LastWritten AS lastwritten,
2227 Media.VolReadTime/1000000 AS volreadtime,
2228 Media.VolWriteTime/1000000 AS volwritetime,
2229 Media.RecycleCount AS recyclecount,
2230 Media.Comment AS comment,
2231 $self->{sql}->{FROM_UNIXTIME}(
2232 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2233 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2236 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2237 WHERE Pool.PoolId = Media.PoolId
2238 AND VolumeName IN ($medias->{jmedias})
2241 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2243 foreach my $media (values %$all) {
2244 my $mq = $self->dbh_quote($media->{volumename});
2247 SELECT DISTINCT Job.JobId AS jobid,
2249 Job.StartTime AS starttime,
2252 Job.JobFiles AS files,
2253 Job.JobBytes AS bytes,
2254 Job.jobstatus AS status
2255 FROM Media,JobMedia,Job
2256 WHERE Media.VolumeName=$mq
2257 AND Media.MediaId=JobMedia.MediaId
2258 AND JobMedia.JobId=Job.JobId
2261 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2264 SELECT LocationLog.Date AS date,
2265 Location.Location AS location,
2266 LocationLog.Comment AS comment
2267 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2268 WHERE Media.MediaId = LocationLog.MediaId
2269 AND Media.VolumeName = $mq
2273 my $log = $self->dbh_selectall_arrayref($query) ;
2275 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2278 $self->display({ jobs => [ values %$jobs ],
2279 LocationLog => $logtxt,
2281 "display_media_zoom.tpl");
2289 my $loc = $self->get_form('qlocation');
2290 unless ($loc->{qlocation}) {
2291 return $self->error("Can't get location");
2295 SELECT Location.Location AS location,
2296 Location.Cost AS cost,
2297 Location.Enabled AS enabled
2299 WHERE Location.Location = $loc->{qlocation}
2302 my $row = $self->dbh_selectrow_hashref($query);
2304 $self->display({ ID => $cur_id++,
2305 %$row }, "location_edit.tpl") ;
2313 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2314 unless ($arg->{qlocation}) {
2315 return $self->error("Can't get location");
2317 unless ($arg->{qnewlocation}) {
2318 return $self->error("Can't get new location name");
2320 unless ($arg->{cost}) {
2321 return $self->error("Can't get new cost");
2324 my $enabled = CGI::param('enabled') || '';
2325 $enabled = $enabled?1:0;
2328 UPDATE Location SET Cost = $arg->{cost},
2329 Location = $arg->{qnewlocation},
2331 WHERE Location.Location = $arg->{qlocation}
2334 $self->dbh_do($query);
2336 $self->location_display();
2342 my $arg = $self->get_form(qw/qlocation/) ;
2344 unless ($arg->{qlocation}) {
2345 return $self->error("Can't get location");
2349 SELECT count(Media.MediaId) AS nb
2350 FROM Media INNER JOIN Location USING (LocationID)
2351 WHERE Location = $arg->{qlocation}
2354 my $res = $self->dbh_selectrow_hashref($query);
2357 return $self->error("Sorry, the location must be empty");
2361 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2364 $self->dbh_do($query);
2366 $self->location_display();
2373 my $arg = $self->get_form(qw/qlocation cost/) ;
2375 unless ($arg->{qlocation}) {
2376 $self->display({}, "location_add.tpl");
2379 unless ($arg->{cost}) {
2380 return $self->error("Can't get new cost");
2383 my $enabled = CGI::param('enabled') || '';
2384 $enabled = $enabled?1:0;
2387 INSERT INTO Location (Location, Cost, Enabled)
2388 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2391 $self->dbh_do($query);
2393 $self->location_display();
2396 sub location_display
2401 SELECT Location.Location AS location,
2402 Location.Cost AS cost,
2403 Location.Enabled AS enabled,
2404 (SELECT count(Media.MediaId)
2406 WHERE Media.LocationId = Location.LocationId
2411 my $location = $self->dbh_selectall_hashref($query, 'location');
2413 $self->display({ ID => $cur_id++,
2414 Locations => [ values %$location ] },
2415 "display_location.tpl");
2422 my $medias = $self->get_selected_media_location();
2427 my $arg = $self->get_form('db_locations', 'qnewlocation');
2429 $self->display({ email => $self->{info}->{email_media},
2431 medias => [ values %$medias ],
2433 "update_location.tpl");
2436 ###########################################################
2442 my $grp = $self->get_form(qw/qclient_group db_clients/);
2445 unless ($grp->{qclient_group}) {
2446 return $self->error("Can't get group");
2451 FROM Client JOIN client_group_member using (clientid)
2452 JOIN client_group using (client_group_id)
2453 WHERE client_group_name = $grp->{qclient_group}
2456 my $row = $self->dbh_selectall_hashref($query, "name");
2458 $self->display({ ID => $cur_id++,
2459 client_group => $grp->{qclient_group},
2461 client_group_member => [ values %$row]},
2469 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2470 unless ($arg->{qclient_group}) {
2471 return $self->error("Can't get groups");
2474 $self->{dbh}->begin_work();
2477 DELETE FROM client_group_member
2478 WHERE client_group_id IN
2479 (SELECT client_group_id
2481 WHERE client_group_name = $arg->{qclient_group})
2483 $self->dbh_do($query);
2486 INSERT INTO client_group_member (clientid, client_group_id)
2488 (SELECT client_group_id
2490 WHERE client_group_name = $arg->{qclient_group})
2491 FROM Client WHERE Name IN ($arg->{jclients})
2494 $self->dbh_do($query);
2496 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2499 SET client_group_name = $arg->{qnewgroup}
2500 WHERE client_group_name = $arg->{qclient_group}
2503 $self->dbh_do($query);
2506 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2508 $self->display_groups();
2514 my $arg = $self->get_form(qw/qclient_group/);
2516 unless ($arg->{qclient_group}) {
2517 return $self->error("Can't get groups");
2520 $self->{dbh}->begin_work();
2523 DELETE FROM client_group_member
2524 WHERE client_group_id IN
2525 (SELECT client_group_id
2527 WHERE client_group_name = $arg->{qclient_group});
2529 DELETE FROM client_group
2530 WHERE client_group_name = $arg->{qclient_group};
2532 $self->dbh_do($query);
2534 $self->{dbh}->commit();
2536 $self->display_groups();
2543 my $arg = $self->get_form(qw/qclient_group/) ;
2545 unless ($arg->{qclient_group}) {
2546 $self->display({}, "groups_add.tpl");
2551 INSERT INTO client_group (client_group_name)
2552 VALUES ($arg->{qclient_group})
2555 $self->dbh_do($query);
2557 $self->display_groups();
2564 my $arg = $self->get_form(qw/db_client_groups/) ;
2566 if ($self->{dbh}->errstr) {
2567 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2572 $self->display({ ID => $cur_id++,
2574 "display_groups.tpl");
2577 ###########################################################
2579 sub get_media_max_size
2581 my ($self, $type) = @_;
2583 "SELECT avg(VolBytes) AS size
2585 WHERE Media.VolStatus = 'Full'
2586 AND Media.MediaType = '$type'
2589 my $res = $self->selectrow_hashref($query);
2592 return $res->{size};
2602 my $media = $self->get_form('qmedia');
2604 unless ($media->{qmedia}) {
2605 return $self->error("Can't get media");
2609 SELECT Media.Slot AS slot,
2610 PoolMedia.Name AS poolname,
2611 Media.VolStatus AS volstatus,
2612 Media.InChanger AS inchanger,
2613 Location.Location AS location,
2614 Media.VolumeName AS volumename,
2615 Media.MaxVolBytes AS maxvolbytes,
2616 Media.MaxVolJobs AS maxvoljobs,
2617 Media.MaxVolFiles AS maxvolfiles,
2618 Media.VolUseDuration AS voluseduration,
2619 Media.VolRetention AS volretention,
2620 Media.Comment AS comment,
2621 PoolRecycle.Name AS poolrecycle
2623 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2624 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2625 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2627 WHERE Media.VolumeName = $media->{qmedia}
2630 my $row = $self->dbh_selectrow_hashref($query);
2631 $row->{volretention} = human_sec($row->{volretention});
2632 $row->{voluseduration} = human_sec($row->{voluseduration});
2634 my $elt = $self->get_form(qw/db_pools db_locations/);
2639 }, "update_media.tpl");
2646 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2648 unless ($arg->{jmedias}) {
2649 return $self->error("Can't get selected media");
2652 unless ($arg->{qnewlocation}) {
2653 return $self->error("Can't get new location");
2658 SET LocationId = (SELECT LocationId
2660 WHERE Location = $arg->{qnewlocation})
2661 WHERE Media.VolumeName IN ($arg->{jmedias})
2664 my $nb = $self->dbh_do($query);
2666 print "$nb media updated, you may have to update your autochanger.";
2668 $self->display_media();
2675 my $medias = $self->get_selected_media_location();
2677 return $self->error("Can't get media selection");
2679 my $newloc = CGI::param('newlocation');
2681 my $user = CGI::param('user') || 'unknown';
2682 my $comm = CGI::param('comment') || '';
2683 $comm = $self->dbh_quote("$user: $comm");
2687 foreach my $media (keys %$medias) {
2689 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2691 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2692 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2693 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2696 $self->dbh_do($query);
2697 $self->debug($query);
2701 $q->param('action', 'update_location');
2702 my $url = $q->url(-full => 1, -query=>1);
2704 $self->display({ email => $self->{info}->{email_media},
2706 newlocation => $newloc,
2707 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81\81 },..]
2708 medias => [ values %$medias ],
2710 "change_location.tpl");
2714 sub display_client_stats
2716 my ($self, %arg) = @_ ;
2718 my $client = $self->dbh_quote($arg{clientname});
2720 my ($limit, $label) = $self->get_limit(%arg);
2724 count(Job.JobId) AS nb_jobs,
2725 sum(Job.JobBytes) AS nb_bytes,
2726 sum(Job.JobErrors) AS nb_err,
2727 sum(Job.JobFiles) AS nb_files,
2728 Client.Name AS clientname
2729 FROM Job JOIN Client USING (ClientId)
2731 Client.Name = $client
2733 GROUP BY Client.Name
2736 my $row = $self->dbh_selectrow_hashref($query);
2738 $row->{ID} = $cur_id++;
2739 $row->{label} = $label;
2740 $row->{grapharg} = "client";
2742 $self->display($row, "display_client_stats.tpl");
2746 sub display_group_stats
2748 my ($self, %arg) = @_ ;
2750 my $carg = $self->get_form(qw/qclient_group/);
2752 unless ($carg->{qclient_group}) {
2753 return $self->error("Can't get group");
2756 my ($limit, $label) = $self->get_limit(%arg);
2760 count(Job.JobId) AS nb_jobs,
2761 sum(Job.JobBytes) AS nb_bytes,
2762 sum(Job.JobErrors) AS nb_err,
2763 sum(Job.JobFiles) AS nb_files,
2764 client_group.client_group_name AS clientname
2765 FROM Job JOIN Client USING (ClientId)
2766 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
2767 JOIN client_group USING (client_group_id)
2769 client_group.client_group_name = $carg->{qclient_group}
2771 GROUP BY client_group.client_group_name
2774 my $row = $self->dbh_selectrow_hashref($query);
2776 $row->{ID} = $cur_id++;
2777 $row->{label} = $label;
2778 $row->{grapharg} = "client_group";
2780 $self->display($row, "display_client_stats.tpl");
2783 # poolname can be undef
2786 my ($self, $poolname) = @_ ;
2790 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2791 if ($arg->{jmediatypes}) {
2792 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2793 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2796 # TODO : afficher les tailles et les dates
2799 SELECT subq.volmax AS volmax,
2800 subq.volnum AS volnum,
2801 subq.voltotal AS voltotal,
2803 Pool.Recycle AS recycle,
2804 Pool.VolRetention AS volretention,
2805 Pool.VolUseDuration AS voluseduration,
2806 Pool.MaxVolJobs AS maxvoljobs,
2807 Pool.MaxVolFiles AS maxvolfiles,
2808 Pool.MaxVolBytes AS maxvolbytes,
2809 subq.PoolId AS PoolId,
2810 subq.MediaType AS mediatype,
2811 $self->{sql}->{CAT_POOL_TYPE} AS uniq
2814 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2815 count(Media.MediaId) AS volnum,
2816 sum(Media.VolBytes) AS voltotal,
2817 Media.PoolId AS PoolId,
2818 Media.MediaType AS MediaType
2820 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2821 Media.MediaType AS MediaType
2823 WHERE Media.VolStatus = 'Full'
2824 GROUP BY Media.MediaType
2825 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2826 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2828 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2832 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
2835 SELECT Pool.Name AS name,
2836 sum(VolBytes) AS size
2837 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2838 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2842 my $empty = $self->dbh_selectall_hashref($query, 'name');
2844 foreach my $p (values %$all) {
2845 if ($p->{volmax} > 0) { # mysql returns 0.0000
2846 # we remove Recycled/Purged media from pool usage
2847 if (defined $empty->{$p->{name}}) {
2848 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2850 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2852 $p->{poolusage} = 0;
2856 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2858 WHERE PoolId=$p->{poolid}
2859 AND Media.MediaType = '$p->{mediatype}'
2863 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2864 foreach my $t (values %$content) {
2865 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2870 $self->display({ ID => $cur_id++,
2871 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2872 Pools => [ values %$all ]},
2873 "display_pool.tpl");
2876 sub display_running_job
2880 my $arg = $self->get_form('client', 'jobid');
2882 if (!$arg->{client} and $arg->{jobid}) {
2885 SELECT Client.Name AS name
2886 FROM Job INNER JOIN Client USING (ClientId)
2887 WHERE Job.JobId = $arg->{jobid}
2890 my $row = $self->dbh_selectrow_hashref($query);
2893 $arg->{client} = $row->{name};
2894 CGI::param('client', $arg->{client});
2898 if ($arg->{client}) {
2899 my $cli = new Bweb::Client(name => $arg->{client});
2900 $cli->display_running_job($self->{info}, $arg->{jobid});
2901 if ($arg->{jobid}) {
2902 $self->get_job_log();
2905 $self->error("Can't get client or jobid");
2909 sub display_running_jobs
2911 my ($self, $display_action) = @_;
2914 SELECT Job.JobId AS jobid,
2915 Job.Name AS jobname,
2917 Job.StartTime AS starttime,
2918 Job.JobFiles AS jobfiles,
2919 Job.JobBytes AS jobbytes,
2920 Job.JobStatus AS jobstatus,
2921 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2922 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2924 Client.Name AS clientname
2925 FROM Job INNER JOIN Client USING (ClientId)
2926 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2928 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2930 $self->display({ ID => $cur_id++,
2931 display_action => $display_action,
2932 Jobs => [ values %$all ]},
2933 "running_job.tpl") ;
2936 # return the autochanger list to update
2941 my $arg = $self->get_form('jmedias');
2943 unless ($arg->{jmedias}) {
2944 return $self->error("Can't get media selection");
2948 SELECT Media.VolumeName AS volumename,
2949 Storage.Name AS storage,
2950 Location.Location AS location,
2952 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2953 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2954 WHERE Media.VolumeName IN ($arg->{jmedias})
2955 AND Media.InChanger = 1
2958 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2960 foreach my $vol (values %$all) {
2961 my $a = $self->ach_get($vol->{location});
2963 $ret{$vol->{location}} = 1;
2965 unless ($a->{have_status}) {
2967 $a->{have_status} = 1;
2970 print "eject $vol->{volumename} from $vol->{storage} : ";
2971 if ($a->send_to_io($vol->{slot})) {
2972 print "<img src='/bweb/T.png' alt='ok'><br/>";
2974 print "<img src='/bweb/E.png' alt='err'><br/>";
2984 my ($to, $subject, $content) = (CGI::param('email'),
2985 CGI::param('subject'),
2986 CGI::param('content'));
2987 $to =~ s/[^\w\d\.\@<>,]//;
2988 $subject =~ s/[^\w\d\.\[\]]/ /;
2990 open(MAIL, "|mail -s '$subject' '$to'") ;
2991 print MAIL $content;
3001 my $arg = $self->get_form('jobid', 'client');
3003 print CGI::header('text/brestore');
3004 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3005 print "client=$arg->{client}\n" if ($arg->{client});
3006 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3010 # TODO : move this to Bweb::Autochanger ?
3011 # TODO : make this internal to not eject tape ?
3017 my ($self, $name) = @_;
3020 return $self->error("Can't get your autochanger name ach");
3023 unless ($self->{info}->{ach_list}) {
3024 return $self->error("Could not find any autochanger");
3027 my $a = $self->{info}->{ach_list}->{$name};
3030 $self->error("Can't get your autochanger $name from your ach_list");
3035 $a->{debug} = $self->{debug};
3042 my ($self, $ach) = @_;
3044 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3046 $self->{info}->save();
3054 my $arg = $self->get_form('ach');
3056 or !$self->{info}->{ach_list}
3057 or !$self->{info}->{ach_list}->{$arg->{ach}})
3059 return $self->error("Can't get autochanger name");
3062 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3066 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3068 my $b = $self->get_bconsole();
3070 my @storages = $b->list_storage() ;
3072 $ach->{devices} = [ map { { name => $_ } } @storages ];
3074 $self->display($ach, "ach_add.tpl");
3075 delete $ach->{drives};
3076 delete $ach->{devices};
3083 my $arg = $self->get_form('ach');
3086 or !$self->{info}->{ach_list}
3087 or !$self->{info}->{ach_list}->{$arg->{ach}})
3089 return $self->error("Can't get autochanger name");
3092 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3094 $self->{info}->save();
3095 $self->{info}->view();
3101 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3103 my $b = $self->get_bconsole();
3104 my @storages = $b->list_storage() ;
3106 unless ($arg->{ach}) {
3107 $arg->{devices} = [ map { { name => $_ } } @storages ];
3108 return $self->display($arg, "ach_add.tpl");
3112 foreach my $drive (CGI::param('drives'))
3114 unless (grep(/^$drive$/,@storages)) {
3115 return $self->error("Can't find $drive in storage list");
3118 my $index = CGI::param("index_$drive");
3119 unless (defined $index and $index =~ /^(\d+)$/) {
3120 return $self->error("Can't get $drive index");
3123 $drives[$index] = $drive;
3127 return $self->error("Can't get drives from Autochanger");
3130 my $a = new Bweb::Autochanger(name => $arg->{ach},
3131 precmd => $arg->{precmd},
3132 drive_name => \@drives,
3133 device => $arg->{device},
3134 mtxcmd => $arg->{mtxcmd});
3136 $self->ach_register($a) ;
3138 $self->{info}->view();
3144 my $arg = $self->get_form('jobid');
3146 if ($arg->{jobid}) {
3147 my $b = $self->get_bconsole();
3148 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3152 title => "Delete a job ",
3153 name => "delete jobid=$arg->{jobid}",
3162 my $arg = $self->get_form(qw/media volstatus inchanger pool
3163 slot volretention voluseduration
3164 maxvoljobs maxvolfiles maxvolbytes
3165 qcomment poolrecycle
3168 unless ($arg->{media}) {
3169 return $self->error("Can't find media selection");
3172 my $update = "update volume=$arg->{media} ";
3174 if ($arg->{volstatus}) {
3175 $update .= " volstatus=$arg->{volstatus} ";
3178 if ($arg->{inchanger}) {
3179 $update .= " inchanger=yes " ;
3181 $update .= " slot=$arg->{slot} ";
3184 $update .= " slot=0 inchanger=no ";
3188 $update .= " pool=$arg->{pool} " ;
3191 if (defined $arg->{volretention}) {
3192 $update .= " volretention=\"$arg->{volretention}\" " ;
3195 if (defined $arg->{voluseduration}) {
3196 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3199 if (defined $arg->{maxvoljobs}) {
3200 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3203 if (defined $arg->{maxvolfiles}) {
3204 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3207 if (defined $arg->{maxvolbytes}) {
3208 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3211 my $b = $self->get_bconsole();
3214 content => $b->send_cmd($update),
3215 title => "Update a volume ",
3221 my $media = $self->dbh_quote($arg->{media});
3223 my $loc = CGI::param('location') || '';
3225 $loc = $self->dbh_quote($loc); # is checked by db
3226 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3228 if ($arg->{poolrecycle}) {
3229 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
3231 if (!$arg->{qcomment}) {
3232 $arg->{qcomment} = "''";
3234 push @q, "Comment=$arg->{qcomment}";
3239 SET " . join (',', @q) . "
3240 WHERE Media.VolumeName = $media
3242 $self->dbh_do($query);
3244 $self->update_media();
3251 my $ach = CGI::param('ach') ;
3252 $ach = $self->ach_get($ach);
3254 return $self->error("Bad autochanger name");
3258 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3259 $b->update_slots($ach->{name});
3267 my $arg = $self->get_form('jobid', 'limit', 'offset');
3268 unless ($arg->{jobid}) {
3269 return $self->error("Can't get jobid");
3272 if ($arg->{limit} == 100) {
3273 $arg->{limit} = 1000;
3276 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
3279 SELECT Job.Name as name, Client.Name as clientname
3280 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
3281 WHERE JobId = $arg->{jobid}
3284 my $row = $self->dbh_selectrow_hashref($query);
3287 return $self->error("Can't find $arg->{jobid} in catalog");
3291 SELECT Time AS time, LogText AS log
3293 WHERE Log.JobId = $arg->{jobid}
3294 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3295 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3299 OFFSET $arg->{offset}
3302 my $log = $self->dbh_selectall_arrayref($query);
3304 return $self->error("Can't get log for jobid $arg->{jobid}");
3310 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3312 $logtxt = join("", map { $_->[1] } @$log ) ;
3315 $self->display({ lines=> $logtxt,
3316 jobid => $arg->{jobid},
3317 name => $row->{name},
3318 client => $row->{clientname},
3319 offset => $arg->{offset},
3320 limit => $arg->{limit},
3321 }, 'display_log.tpl');
3329 my $arg = $self->get_form('ach', 'slots', 'drive');
3331 unless ($arg->{ach}) {
3332 return $self->error("Can't find autochanger name");
3335 my $a = $self->ach_get($arg->{ach});
3337 return $self->error("Can't find autochanger name in configuration");
3340 my $storage = $a->get_drive_name($arg->{drive});
3342 return $self->error("Can't get your drive name");
3348 if ($arg->{slots}) {
3349 $slots = join(",", @{ $arg->{slots} });
3350 $slots_sql = " AND Slot IN ($slots) ";
3351 $t += 60*scalar( @{ $arg->{slots} }) ;
3356 SET LocationId = (SELECT LocationId
3358 WHERE Location = '$arg->{ach}'),
3360 RecyclePoolId = (SELECT PoolId
3362 WHERE Name = 'Scratch')
3364 WHERE (LocationId = 0 OR LocationId IS NULL)
3368 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3369 print "<h1>This command can take long time, be patient...</h1>";
3371 $b->label_barcodes(storage => $storage,
3372 drive => $arg->{drive},
3383 my @volume = CGI::param('media');
3386 return $self->error("Can't get media selection");
3389 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3392 content => $b->purge_volume(@volume),
3393 title => "Purge media",
3394 name => "purge volume=" . join(' volume=', @volume),
3403 my @volume = CGI::param('media');
3405 return $self->error("Can't get media selection");
3408 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3411 content => $b->prune_volume(@volume),
3412 title => "Prune media",
3413 name => "prune volume=" . join(' volume=', @volume),
3423 my $arg = $self->get_form('jobid');
3424 unless ($arg->{jobid}) {
3425 return $self->error("Can't get jobid");
3428 my $b = $self->get_bconsole();
3430 content => $b->cancel($arg->{jobid}),
3431 title => "Cancel job",
3432 name => "cancel jobid=$arg->{jobid}",
3438 # Warning, we display current fileset
3441 my $arg = $self->get_form('fileset');
3443 if ($arg->{fileset}) {
3444 my $b = $self->get_bconsole();
3445 my $ret = $b->get_fileset($arg->{fileset});
3446 $self->display({ fileset => $arg->{fileset},
3448 }, "fileset_view.tpl");
3450 $self->error("Can't get fileset name");
3454 sub director_show_sched
3458 my $arg = $self->get_form('days');
3460 my $b = $self->get_bconsole();
3461 my $ret = $b->director_get_sched( $arg->{days} );
3466 }, "scheduled_job.tpl");
3469 sub enable_disable_job
3471 my ($self, $what) = @_ ;
3473 my $name = CGI::param('job') || '';
3474 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3475 return $self->error("Can't find job name");
3478 my $b = $self->get_bconsole();
3488 content => $b->send_cmd("$cmd job=\"$name\""),
3489 title => "$cmd $name",
3490 name => "$cmd job=\"$name\"",
3497 return new Bconsole(pref => $self->{info});
3503 my $b = $self->get_bconsole();
3505 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3507 $self->display({ Jobs => $joblist }, "run_job.tpl");
3512 my ($self, $ouput) = @_;
3515 foreach my $l (split(/\r\n/, $ouput)) {
3516 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3522 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3528 foreach my $k (keys %arg) {
3529 $lowcase{lc($k)} = $arg{$k} ;
3538 my $b = $self->get_bconsole();
3540 my $job = CGI::param('job') || '';
3542 # we take informations from director, and we overwrite with user wish
3543 my $info = $b->send_cmd("show job=\"$job\"");
3544 my $attr = $self->run_parse_job($info);
3546 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
3547 my %job_opt = (%$attr, %$arg);
3549 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3551 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3552 my $clients = [ map { { name => $_ } }$b->list_client()];
3553 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3554 my $storages= [ map { { name => $_ } }$b->list_storage()];
3559 clients => $clients,
3560 filesets => $filesets,
3561 storages => $storages,
3563 }, "run_job_mod.tpl");
3569 my $b = $self->get_bconsole();
3571 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3581 my $b = $self->get_bconsole();
3583 # TODO: check input (don't use pool, level)
3585 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
3586 my $job = CGI::param('job') || '';
3587 my $storage = CGI::param('storage') || '';
3589 my $jobid = $b->run(job => $job,
3590 client => $arg->{client},
3591 priority => $arg->{priority},
3592 level => $arg->{level},
3593 storage => $storage,
3594 pool => $arg->{pool},
3595 fileset => $arg->{fileset},
3596 when => $arg->{when},
3599 print $jobid, $b->{error};
3601 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";