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';
59 new - creation a of new Bweb object
63 This function take an hash of argument and place them
66 IE : $obj = new Obj(name => 'test', age => '10');
68 $obj->{name} eq 'test' and $obj->{age} eq 10
74 my ($class, %arg) = @_;
79 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
86 my ($self, $what) = @_;
90 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
92 print "<pre>$what</pre>";
99 error - display an error to the user
103 this function set $self->{error} with arg, display a message with
104 error.tpl and return 0
109 return $self->error("Can't use this file");
116 my ($self, $what) = @_;
117 $self->{error} = $what;
118 $self->display($self, 'error.tpl');
124 display - display an html page with HTML::Template
128 this function is use to render all html codes. it takes an
129 ref hash as arg in which all param are usable in template.
131 it will use global template_dir to search the template file.
133 hash keys are not sensitive. See HTML::Template for more
134 explanations about the hash ref. (it's can be quiet hard to understand)
138 $ref = { name => 'me', age => 26 };
139 $self->display($ref, "people.tpl");
145 my ($self, $hash, $tpl) = @_ ;
147 my $template = HTML::Template->new(filename => $tpl,
148 path =>[$template_dir],
149 die_on_bad_params => 0,
150 case_sensitive => 0);
152 foreach my $var (qw/limit offset/) {
154 unless ($hash->{$var}) {
155 my $value = CGI::param($var) || '';
157 if ($value =~ /^(\d+)$/) {
158 $template->param($var, $1) ;
163 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
164 $template->param('loginname', CGI::remote_user());
166 $template->param($hash);
167 print $template->output();
171 ################################################################
173 package Bweb::Config;
175 use base q/Bweb::Gui/;
179 Bweb::Config - read, write, display, modify configuration
183 this package is used for manage configuration
187 $conf = new Bweb::Config(config_file => '/path/to/conf');
198 =head1 PACKAGE VARIABLE
200 %k_re - hash of all acceptable option.
204 this variable permit to check all option with a regexp.
208 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
209 user => qr/^([\w\d\.-]+)$/i,
210 password => qr/^(.*)$/i,
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!^(.+)?$!,
222 load - load config_file
226 this function load the specified config_file.
234 unless (open(FP, $self->{config_file}))
236 return $self->error("$self->{config_file} : $!");
238 my $f=''; my $tmpbuffer;
239 while(read FP,$tmpbuffer,4096)
247 no strict; # I have no idea of the contents of the file
254 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...") ;
257 foreach my $k (keys %$VAR1) {
258 $self->{$k} = $VAR1->{$k};
266 load_old - load old configuration format
274 unless (open(FP, $self->{config_file}))
276 return $self->error("$self->{config_file} : $!");
279 while (my $line = <FP>)
282 my ($k, $v) = split(/\s*=\s*/, $line, 2);
294 save - save the current configuration to config_file
302 if ($self->{ach_list}) {
303 # shortcut for display_begin
304 $self->{achs} = [ map {{ name => $_ }}
305 keys %{$self->{ach_list}}
309 unless (open(FP, ">$self->{config_file}"))
311 return $self->error("$self->{config_file} : $!\n" .
312 "You must add this to your config file\n"
313 . Data::Dumper::Dumper($self));
316 print FP Data::Dumper::Dumper($self);
324 edit, view, modify - html form ouput
332 $self->display($self, "config_edit.tpl");
338 $self->display($self, "config_view.tpl");
348 foreach my $k (CGI::param())
350 next unless (exists $k_re{$k}) ;
351 my $val = CGI::param($k);
352 if ($val =~ $k_re{$k}) {
355 $self->{error} .= "bad parameter : $k = [$val]";
361 if ($self->{error}) { # an error as occured
362 $self->display($self, 'error.tpl');
370 ################################################################
372 package Bweb::Client;
374 use base q/Bweb::Gui/;
378 Bweb::Client - Bacula FD
382 this package is use to do all Client operations like, parse status etc...
386 $client = new Bweb::Client(name => 'zog-fd');
387 $client->status(); # do a 'status client=zog-fd'
393 display_running_job - Html display of a running job
397 this function is used to display information about a current job
401 sub display_running_job
403 my ($self, $conf, $jobid) = @_ ;
405 my $status = $self->status($conf);
408 if ($status->{$jobid}) {
409 $self->display($status->{$jobid}, "client_job_status.tpl");
412 for my $id (keys %$status) {
413 $self->display($status->{$id}, "client_job_status.tpl");
420 $client = new Bweb::Client(name => 'plume-fd');
422 $client->status($bweb);
426 dirty hack to parse "status client=xxx-fd"
430 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
431 Backup Job started: 06-jun-06 17:22
432 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
433 Files Examined=10,697
434 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
440 JobName => Full_plume.2006-06-06_17.22.23,
443 Bytes => 194,484,132,
453 my ($self, $conf) = @_ ;
455 if (defined $self->{cur_jobs}) {
456 return $self->{cur_jobs} ;
460 my $b = new Bconsole(pref => $conf);
461 my $ret = $b->send_cmd("st client=$self->{name}");
465 for my $r (split(/\n/, $ret)) {
467 $r =~ s/(^\s+|\s+$)//g;
468 if ($r =~ /JobId (\d+) Job (\S+)/) {
470 $arg->{$jobid} = { @param, JobId => $jobid } ;
474 @param = ( JobName => $2 );
476 } elsif ($r =~ /=.+=/) {
477 push @param, split(/\s+|\s*=\s*/, $r) ;
479 } elsif ($r =~ /=/) { # one per line
480 push @param, split(/\s*=\s*/, $r) ;
482 } elsif ($r =~ /:/) { # one per line
483 push @param, split(/\s*:\s*/, $r, 2) ;
487 if ($jobid and @param) {
488 $arg->{$jobid} = { @param,
490 Client => $self->{name},
494 $self->{cur_jobs} = $arg ;
500 ################################################################
502 package Bweb::Autochanger;
504 use base q/Bweb::Gui/;
508 Bweb::Autochanger - Object to manage Autochanger
512 this package will parse the mtx output and manage drives.
516 $auto = new Bweb::Autochanger(precmd => 'sudo');
518 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
522 $auto->slot_is_full(10);
523 $auto->transfer(10, 11);
529 my ($class, %arg) = @_;
532 name => '', # autochanger name
533 label => {}, # where are volume { label1 => 40, label2 => drive0 }
534 drive => [], # drive use [ 'media1', 'empty', ..]
535 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
536 io => [], # io slot number list [ 41, 42, 43...]
537 info => {slot => 0, # informations (slot, drive, io)
541 mtxcmd => '/usr/sbin/mtx',
543 device => '/dev/changer',
544 precmd => '', # ssh command
545 bweb => undef, # link to bacula web object (use for display)
548 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
555 status - parse the output of mtx status
559 this function will launch mtx status and parse the output. it will
560 give a perlish view of the autochanger content.
562 it uses ssh if the autochanger is on a other host.
569 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
571 # TODO : reset all infos
572 $self->{info}->{drive} = 0;
573 $self->{info}->{slot} = 0;
574 $self->{info}->{io} = 0;
576 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
579 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
580 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
581 #Data Transfer Element 1:Empty
582 # Storage Element 1:Empty
583 # Storage Element 2:Full :VolumeTag=000002
584 # Storage Element 3:Empty
585 # Storage Element 4:Full :VolumeTag=000004
586 # Storage Element 5:Full :VolumeTag=000001
587 # Storage Element 6:Full :VolumeTag=000003
588 # Storage Element 7:Empty
589 # Storage Element 41 IMPORT/EXPORT:Empty
590 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
595 # Storage Element 7:Empty
596 # Storage Element 2:Full :VolumeTag=000002
597 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
600 $self->set_empty_slot($1);
602 $self->set_slot($1, $4);
605 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
608 $self->set_empty_drive($1);
610 $self->set_drive($1, $4, $6);
613 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
616 $self->set_empty_io($1);
618 $self->set_io($1, $4);
621 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
623 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
624 $self->{info}->{drive} = $1;
625 $self->{info}->{slot} = $2;
626 if ($l =~ /(\d+)\s+Import/) {
627 $self->{info}->{io} = $1 ;
629 $self->{info}->{io} = 0;
634 $self->debug($self) ;
639 my ($self, $slot) = @_;
642 if ($self->{slot}->[$slot] eq 'loaded') {
646 my $label = $self->{slot}->[$slot] ;
648 return $self->is_media_loaded($label);
653 my ($self, $drive, $slot) = @_;
655 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
656 return 0 if ($self->slot_is_full($slot)) ;
658 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
661 my $content = $self->get_slot($slot);
662 print "content = $content<br/> $drive => $slot<br/>";
663 $self->set_empty_drive($drive);
664 $self->set_slot($slot, $content);
667 $self->{error} = $out;
672 # TODO: load/unload have to use mtx script from bacula
675 my ($self, $drive, $slot) = @_;
677 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
678 return 0 unless ($self->slot_is_full($slot)) ;
680 print "Loading drive $drive with slot $slot<br/>\n";
681 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
684 my $content = $self->get_slot($slot);
685 print "content = $content<br/> $slot => $drive<br/>";
686 $self->set_drive($drive, $slot, $content);
689 $self->{error} = $out;
697 my ($self, $media) = @_;
699 unless ($self->{label}->{$media}) {
703 if ($self->{label}->{$media} =~ /drive\d+/) {
713 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
718 my ($self, $slot, $tag) = @_;
719 $self->{slot}->[$slot] = $tag || 'full';
720 push @{ $self->{io} }, $slot;
723 $self->{label}->{$tag} = $slot;
729 my ($self, $slot) = @_;
731 push @{ $self->{io} }, $slot;
733 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
734 $self->{slot}->[$slot] = 'empty';
740 my ($self, $slot) = @_;
741 return $self->{slot}->[$slot];
746 my ($self, $slot, $tag) = @_;
747 $self->{slot}->[$slot] = $tag || 'full';
750 $self->{label}->{$tag} = $slot;
756 my ($self, $slot) = @_;
758 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
759 $self->{slot}->[$slot] = 'empty';
765 my ($self, $drive) = @_;
766 $self->{drive}->[$drive] = 'empty';
771 my ($self, $drive, $slot, $tag) = @_;
772 $self->{drive}->[$drive] = $tag || $slot;
774 $self->{slot}->[$slot] = $tag || 'loaded';
777 $self->{label}->{$tag} = "drive$drive";
783 my ($self, $slot) = @_;
785 # slot don't exists => full
786 if (not defined $self->{slot}->[$slot]) {
790 if ($self->{slot}->[$slot] eq 'empty') {
793 return 1; # vol, full, loaded
796 sub slot_get_first_free
799 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
800 return $slot unless ($self->slot_is_full($slot));
804 sub io_get_first_free
808 foreach my $slot (@{ $self->{io} }) {
809 return $slot unless ($self->slot_is_full($slot));
816 my ($self, $media) = @_;
818 return $self->{label}->{$media} ;
823 my ($self, $media) = @_;
825 return defined $self->{label}->{$media} ;
830 my ($self, $slot) = @_;
832 unless ($self->slot_is_full($slot)) {
833 print "Autochanger $self->{name} slot $slot is empty\n";
838 if ($self->is_slot_loaded($slot)) {
841 print "Autochanger $self->{name} $slot is currently in use\n";
845 # autochanger must have I/O
846 unless ($self->have_io()) {
847 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
851 my $dst = $self->io_get_first_free();
854 print "Autochanger $self->{name} you must empty I/O first\n";
857 $self->transfer($slot, $dst);
862 my ($self, $src, $dst) = @_ ;
863 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
864 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
867 my $content = $self->get_slot($src);
868 print "$content ($src) => $dst<br/>";
869 $self->{slot}->[$src] = 'empty';
870 $self->set_slot($dst, $content);
873 $self->{error} = $out;
880 my ($self, $index) = @_;
881 return $self->{drive_name}->[$index];
884 # TODO : do a tapeinfo request to get informations
894 for my $slot (@{$self->{io}})
896 if ($self->is_slot_loaded($slot)) {
897 print "$slot is currently loaded\n";
901 if ($self->slot_is_full($slot))
903 my $free = $self->slot_get_first_free() ;
904 print "want to move $slot to $free\n";
907 $self->transfer($slot, $free) || print "$self->{error}\n";
910 $self->{error} = "E : Can't find free slot";
916 # TODO : this is with mtx status output,
917 # we can do an other function from bacula view (with StorageId)
921 my $bweb = $self->{bweb};
923 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
924 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
927 SELECT Media.VolumeName AS volumename,
928 Media.VolStatus AS volstatus,
929 Media.LastWritten AS lastwritten,
930 Media.VolBytes AS volbytes,
931 Media.MediaType AS mediatype,
933 Media.InChanger AS inchanger,
935 $bweb->{sql}->{FROM_UNIXTIME}(
936 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
937 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
940 INNER JOIN Pool USING (PoolId)
942 WHERE Media.VolumeName IN ($media_list)
945 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
947 # TODO : verify slot and bacula slot
951 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
953 if ($self->slot_is_full($slot)) {
955 my $vol = $self->{slot}->[$slot];
956 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
958 my $bslot = $all->{$vol}->{slot} ;
959 my $inchanger = $all->{$vol}->{inchanger};
961 # if bacula slot or inchanger flag is bad, we display a message
962 if ($bslot != $slot or !$inchanger) {
963 push @to_update, $slot;
966 $all->{$vol}->{realslot} = $slot;
968 push @{ $param }, $all->{$vol};
970 } else { # empty or no label
971 push @{ $param }, {realslot => $slot,
972 volstatus => 'Unknow',
973 volumename => $self->{slot}->[$slot]} ;
976 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
980 my $i=0; my $drives = [] ;
981 foreach my $d (@{ $self->{drive} }) {
982 $drives->[$i] = { index => $i,
983 load => $self->{drive}->[$i],
984 name => $self->{drive_name}->[$i],
989 $bweb->display({ Name => $self->{name},
990 nb_drive => $self->{info}->{drive},
991 nb_io => $self->{info}->{io},
994 Update => scalar(@to_update) },
1002 ################################################################
1006 use base q/Bweb::Gui/;
1010 Bweb - main Bweb package
1014 this package is use to compute and display informations
1019 use POSIX qw/strftime/;
1025 %sql_func - hash to make query mysql/postgresql compliant
1031 UNIX_TIMESTAMP => '',
1032 FROM_UNIXTIME => '',
1033 TO_SEC => " interval '1 second' * ",
1034 SEC_TO_INT => "SEC_TO_INT",
1037 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1038 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1039 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1040 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1041 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1042 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1045 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1046 FROM_UNIXTIME => 'FROM_UNIXTIME',
1049 SEC_TO_TIME => 'SEC_TO_TIME',
1050 MATCH => " REGEXP ",
1051 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1052 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1053 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1054 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1055 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1056 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1060 sub dbh_selectall_arrayref
1062 my ($self, $query) = @_;
1063 $self->connect_db();
1064 $self->debug($query);
1065 return $self->{dbh}->selectall_arrayref($query);
1070 my ($self, @what) = @_;
1071 return join(',', $self->dbh_quote(@what)) ;
1076 my ($self, @what) = @_;
1078 $self->connect_db();
1080 return map { $self->{dbh}->quote($_) } @what;
1082 return $self->{dbh}->quote($what[0]) ;
1088 my ($self, $query) = @_ ;
1089 $self->connect_db();
1090 $self->debug($query);
1091 return $self->{dbh}->do($query);
1094 sub dbh_selectall_hashref
1096 my ($self, $query, $join) = @_;
1098 $self->connect_db();
1099 $self->debug($query);
1100 return $self->{dbh}->selectall_hashref($query, $join) ;
1103 sub dbh_selectrow_hashref
1105 my ($self, $query) = @_;
1107 $self->connect_db();
1108 $self->debug($query);
1109 return $self->{dbh}->selectrow_hashref($query) ;
1115 my @unit = qw(b Kb Mb Gb Tb);
1116 my $val = shift || 0;
1118 my $format = '%i %s';
1119 while ($val / 1024 > 1) {
1123 $format = ($i>0)?'%0.1f %s':'%i %s';
1124 return sprintf($format, $val, $unit[$i]);
1127 # display Day, Hour, Year
1133 $val /= 60; # sec -> min
1135 if ($val / 60 <= 1) {
1139 $val /= 60; # min -> hour
1140 if ($val / 24 <= 1) {
1141 return "$val hours";
1144 $val /= 24; # hour -> day
1145 if ($val / 365 < 2) {
1149 $val /= 365 ; # day -> year
1151 return "$val years";
1154 # get Day, Hour, Year
1160 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1164 my %times = ( m => 60,
1170 my $mult = $times{$2} || 0;
1180 unless ($self->{dbh}) {
1181 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1182 $self->{info}->{user},
1183 $self->{info}->{password});
1185 print "Can't connect to your database, see error log\n"
1186 unless ($self->{dbh});
1188 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1190 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1191 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1198 my ($class, %arg) = @_;
1200 dbh => undef, # connect_db();
1202 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1208 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1210 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1211 $self->{sql} = $sql_func{$1};
1214 $self->{debug} = $self->{info}->{debug};
1215 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1223 $self->display($self->{info}, "begin.tpl");
1229 $self->display($self->{info}, "end.tpl");
1237 my $arg = $self->get_form("client", "qre_client");
1239 if ($arg->{qre_client}) {
1240 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1241 } elsif ($arg->{client}) {
1242 $where = "WHERE Name = '$arg->{client}' ";
1246 SELECT Name AS name,
1248 AutoPrune AS autoprune,
1249 FileRetention AS fileretention,
1250 JobRetention AS jobretention
1255 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1257 my $dsp = { ID => $cur_id++,
1258 clients => [ values %$all] };
1260 $self->display($dsp, "client_list.tpl") ;
1265 my ($self, %arg) = @_;
1272 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1274 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1276 $self->{sql}->{TO_SEC}($arg{age})
1279 $label = "last " . human_sec($arg{age});
1282 if ($arg{groupby}) {
1283 $limit .= " GROUP BY $arg{groupby} ";
1287 $limit .= " ORDER BY $arg{order} ";
1291 $limit .= " LIMIT $arg{limit} ";
1292 $label .= " limited to $arg{limit}";
1296 $limit .= " OFFSET $arg{offset} ";
1297 $label .= " with $arg{offset} offset ";
1301 $label = 'no filter';
1304 return ($limit, $label);
1309 $bweb->get_form(...) - Get useful stuff
1313 This function get and check parameters against regexp.
1315 If word begin with 'q', the return will be quoted or join quoted
1316 if it's end with 's'.
1321 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1324 qclient => 'plume-fd',
1325 qpools => "'plume-fd', 'test-fd', '...'",
1332 my ($self, @what) = @_;
1333 my %what = map { $_ => 1 } @what;
1353 my %opt_ss =( # string with space
1357 my %opt_s = ( # default to ''
1374 my %opt_p = ( # option with path
1382 my %opt_d = ( # option with date
1387 foreach my $i (@what) {
1388 if (exists $opt_i{$i}) {# integer param
1389 my $value = CGI::param($i) || $opt_i{$i} ;
1390 if ($value =~ /^(\d+)$/) {
1393 } elsif ($opt_s{$i}) { # simple string param
1394 my $value = CGI::param($i) || '';
1395 if ($value =~ /^([\w\d\.-]+)$/) {
1398 } elsif ($opt_ss{$i}) { # simple string param (with space)
1399 my $value = CGI::param($i) || '';
1400 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1403 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1404 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1406 $ret{$i} = $self->dbh_join(@value) ;
1409 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1410 my $value = CGI::param($1) ;
1412 $ret{$i} = $self->dbh_quote($value);
1415 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1416 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1417 grep { ! /^\s*$/ } CGI::param($1) ];
1418 } elsif (exists $opt_p{$i}) {
1419 my $value = CGI::param($i) || '';
1420 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1423 } elsif (exists $opt_d{$i}) {
1424 my $value = CGI::param($i) || '';
1425 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1432 foreach my $s (CGI::param('slot')) {
1433 if ($s =~ /^(\d+)$/) {
1434 push @{$ret{slots}}, $s;
1440 my $when = CGI::param('when') || '';
1441 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1446 if ($what{db_clients}) {
1448 SELECT Client.Name as clientname
1452 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1453 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1457 if ($what{db_mediatypes}) {
1459 SELECT MediaType as mediatype
1463 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1464 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1468 if ($what{db_locations}) {
1470 SELECT Location as location, Cost as cost FROM Location
1472 my $loc = $self->dbh_selectall_hashref($query, 'location');
1473 $ret{db_locations} = [ sort { $a->{location}
1479 if ($what{db_pools}) {
1480 my $query = "SELECT Name as name FROM Pool";
1482 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1483 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1486 if ($what{db_filesets}) {
1488 SELECT FileSet.FileSet AS fileset
1492 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1494 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1495 values %$filesets] ;
1498 if ($what{db_jobnames}) {
1500 SELECT DISTINCT Job.Name AS jobname
1504 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1506 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1507 values %$jobnames] ;
1510 if ($what{db_devices}) {
1512 SELECT Device.Name AS name
1516 my $devices = $self->dbh_selectall_hashref($query, 'name');
1518 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1529 my $fields = $self->get_form(qw/age level status clients filesets
1531 db_clients limit db_filesets width height
1532 qclients qfilesets qjobnames db_jobnames/);
1535 my $url = CGI::url(-full => 0,
1538 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1540 # this organisation is to keep user choice between 2 click
1541 # TODO : fileset and client selection doesn't work
1550 sub display_client_job
1552 my ($self, %arg) = @_ ;
1554 $arg{order} = ' Job.JobId DESC ';
1555 my ($limit, $label) = $self->get_limit(%arg);
1557 my $clientname = $self->dbh_quote($arg{clientname});
1560 SELECT DISTINCT Job.JobId AS jobid,
1561 Job.Name AS jobname,
1562 FileSet.FileSet AS fileset,
1564 StartTime AS starttime,
1565 JobFiles AS jobfiles,
1566 JobBytes AS jobbytes,
1567 JobStatus AS jobstatus,
1568 JobErrors AS joberrors
1570 FROM Client,Job,FileSet
1571 WHERE Client.Name=$clientname
1572 AND Client.ClientId=Job.ClientId
1573 AND Job.FileSetId=FileSet.FileSetId
1577 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1579 $self->display({ clientname => $arg{clientname},
1582 Jobs => [ values %$all ],
1584 "display_client_job.tpl") ;
1587 sub get_selected_media_location
1591 my $medias = $self->get_form('jmedias');
1593 unless ($medias->{jmedias}) {
1598 SELECT Media.VolumeName AS volumename, Location.Location AS location
1599 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1600 WHERE Media.VolumeName IN ($medias->{jmedias})
1603 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1605 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1616 my $medias = $self->get_selected_media_location();
1622 my $elt = $self->get_form('db_locations');
1624 $self->display({ ID => $cur_id++,
1625 %$elt, # db_locations
1627 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1637 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1639 $self->display($elt, "help_extern.tpl");
1642 sub help_extern_compute
1646 my $number = CGI::param('limit') || '' ;
1647 unless ($number =~ /^(\d+)$/) {
1648 return $self->error("Bad arg number : $number ");
1651 my ($sql, undef) = $self->get_param('pools',
1652 'locations', 'mediatypes');
1655 SELECT Media.VolumeName AS volumename,
1656 Media.VolStatus AS volstatus,
1657 Media.LastWritten AS lastwritten,
1658 Media.MediaType AS mediatype,
1659 Media.VolMounts AS volmounts,
1661 Media.Recycle AS recycle,
1662 $self->{sql}->{FROM_UNIXTIME}(
1663 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1664 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1667 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1668 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1670 WHERE Media.InChanger = 1
1671 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1673 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1677 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1679 $self->display({ Medias => [ values %$all ] },
1680 "help_extern_compute.tpl");
1687 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1688 $self->display($param, "help_intern.tpl");
1691 sub help_intern_compute
1695 my $number = CGI::param('limit') || '' ;
1696 unless ($number =~ /^(\d+)$/) {
1697 return $self->error("Bad arg number : $number ");
1700 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1702 if (CGI::param('expired')) {
1704 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1705 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1711 SELECT Media.VolumeName AS volumename,
1712 Media.VolStatus AS volstatus,
1713 Media.LastWritten AS lastwritten,
1714 Media.MediaType AS mediatype,
1715 Media.VolMounts AS volmounts,
1717 $self->{sql}->{FROM_UNIXTIME}(
1718 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1719 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1722 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1723 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1725 WHERE Media.InChanger <> 1
1726 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1727 AND Media.Recycle = 1
1729 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1733 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1735 $self->display({ Medias => [ values %$all ] },
1736 "help_intern_compute.tpl");
1742 my ($self, %arg) = @_ ;
1744 my ($limit, $label) = $self->get_limit(%arg);
1748 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1749 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1750 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1751 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1752 (SELECT count(Job.JobId)
1754 WHERE Job.JobStatus IN ('E','e','f','A')
1757 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1760 my $row = $self->dbh_selectrow_hashref($query) ;
1762 $row->{nb_bytes} = human_size($row->{nb_bytes});
1764 $row->{db_size} = '???';
1765 $row->{label} = $label;
1767 $self->display($row, "general.tpl");
1772 my ($self, @what) = @_ ;
1773 my %elt = map { $_ => 1 } @what;
1778 if ($elt{clients}) {
1779 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1781 $ret{clients} = \@clients;
1782 my $str = $self->dbh_join(@clients);
1783 $limit .= "AND Client.Name IN ($str) ";
1787 if ($elt{filesets}) {
1788 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1790 $ret{filesets} = \@filesets;
1791 my $str = $self->dbh_join(@filesets);
1792 $limit .= "AND FileSet.FileSet IN ($str) ";
1796 if ($elt{mediatypes}) {
1797 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1799 $ret{mediatypes} = \@medias;
1800 my $str = $self->dbh_join(@medias);
1801 $limit .= "AND Media.MediaType IN ($str) ";
1806 my $client = CGI::param('client');
1807 $ret{client} = $client;
1808 $client = $self->dbh_join($client);
1809 $limit .= "AND Client.Name = $client ";
1813 my $level = CGI::param('level') || '';
1814 if ($level =~ /^(\w)$/) {
1816 $limit .= "AND Job.Level = '$1' ";
1821 my $jobid = CGI::param('jobid') || '';
1823 if ($jobid =~ /^(\d+)$/) {
1825 $limit .= "AND Job.JobId = '$1' ";
1830 my $status = CGI::param('status') || '';
1831 if ($status =~ /^(\w)$/) {
1834 $limit .= "AND Job.JobStatus IN ('f','E') ";
1836 $limit .= "AND Job.JobStatus = '$1' ";
1841 if ($elt{volstatus}) {
1842 my $status = CGI::param('volstatus') || '';
1843 if ($status =~ /^(\w+)$/) {
1845 $limit .= "AND Media.VolStatus = '$1' ";
1849 if ($elt{locations}) {
1850 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1852 $ret{locations} = \@location;
1853 my $str = $self->dbh_join(@location);
1854 $limit .= "AND Location.Location IN ($str) ";
1859 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1861 $ret{pools} = \@pool;
1862 my $str = $self->dbh_join(@pool);
1863 $limit .= "AND Pool.Name IN ($str) ";
1867 if ($elt{location}) {
1868 my $location = CGI::param('location') || '';
1870 $ret{location} = $location;
1871 $location = $self->dbh_quote($location);
1872 $limit .= "AND Location.Location = $location ";
1877 my $pool = CGI::param('pool') || '';
1880 $pool = $self->dbh_quote($pool);
1881 $limit .= "AND Pool.Name = $pool ";
1885 if ($elt{jobtype}) {
1886 my $jobtype = CGI::param('jobtype') || '';
1887 if ($jobtype =~ /^(\w)$/) {
1889 $limit .= "AND Job.Type = '$1' ";
1893 return ($limit, %ret);
1904 my ($self, %arg) = @_ ;
1906 $arg{order} = ' Job.JobId DESC ';
1908 my ($limit, $label) = $self->get_limit(%arg);
1909 my ($where, undef) = $self->get_param('clients',
1918 SELECT Job.JobId AS jobid,
1919 Client.Name AS client,
1920 FileSet.FileSet AS fileset,
1921 Job.Name AS jobname,
1923 StartTime AS starttime,
1924 Pool.Name AS poolname,
1925 JobFiles AS jobfiles,
1926 JobBytes AS jobbytes,
1927 JobStatus AS jobstatus,
1928 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1929 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1932 JobErrors AS joberrors
1935 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1936 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1937 WHERE Client.ClientId=Job.ClientId
1938 AND Job.JobStatus != 'R'
1943 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1945 $self->display({ Filter => $label,
1949 sort { $a->{jobid} <=> $b->{jobid} }
1956 # display job informations
1957 sub display_job_zoom
1959 my ($self, $jobid) = @_ ;
1961 $jobid = $self->dbh_quote($jobid);
1964 SELECT DISTINCT Job.JobId AS jobid,
1965 Client.Name AS client,
1966 Job.Name AS jobname,
1967 FileSet.FileSet AS fileset,
1969 Pool.Name AS poolname,
1970 StartTime AS starttime,
1971 JobFiles AS jobfiles,
1972 JobBytes AS jobbytes,
1973 JobStatus AS jobstatus,
1974 JobErrors AS joberrors,
1975 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1976 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1979 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1980 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1981 WHERE Client.ClientId=Job.ClientId
1982 AND Job.JobId = $jobid
1985 my $row = $self->dbh_selectrow_hashref($query) ;
1987 # display all volumes associate with this job
1989 SELECT Media.VolumeName as volumename
1990 FROM Job,Media,JobMedia
1991 WHERE Job.JobId = $jobid
1992 AND JobMedia.JobId=Job.JobId
1993 AND JobMedia.MediaId=Media.MediaId
1996 my $all = $self->dbh_selectall_hashref($query, 'volumename');
1998 $row->{volumes} = [ values %$all ] ;
2000 $self->display($row, "display_job_zoom.tpl");
2007 my ($where, %elt) = $self->get_param('pools',
2012 my $arg = $self->get_form('jmedias', 'qre_media');
2014 if ($arg->{jmedias}) {
2015 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2017 if ($arg->{qre_media}) {
2018 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2022 SELECT Media.VolumeName AS volumename,
2023 Media.VolBytes AS volbytes,
2024 Media.VolStatus AS volstatus,
2025 Media.MediaType AS mediatype,
2026 Media.InChanger AS online,
2027 Media.LastWritten AS lastwritten,
2028 Location.Location AS location,
2029 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2030 Pool.Name AS poolname,
2031 $self->{sql}->{FROM_UNIXTIME}(
2032 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2033 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2036 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2037 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2038 Media.MediaType AS MediaType
2040 WHERE Media.VolStatus = 'Full'
2041 GROUP BY Media.MediaType
2042 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2044 WHERE Media.PoolId=Pool.PoolId
2048 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2050 $self->display({ ID => $cur_id++,
2052 Location => $elt{location},
2053 Medias => [ values %$all ]
2055 "display_media.tpl");
2062 my $pool = $self->get_form('db_pools');
2064 foreach my $name (@{ $pool->{db_pools} }) {
2065 CGI::param('pool', $name->{name});
2066 $self->display_media();
2070 sub display_media_zoom
2074 my $medias = $self->get_form('jmedias');
2076 unless ($medias->{jmedias}) {
2077 return $self->error("Can't get media selection");
2081 SELECT InChanger AS online,
2082 VolBytes AS nb_bytes,
2083 VolumeName AS volumename,
2084 VolStatus AS volstatus,
2085 VolMounts AS nb_mounts,
2086 Media.VolUseDuration AS voluseduration,
2087 Media.MaxVolJobs AS maxvoljobs,
2088 Media.MaxVolFiles AS maxvolfiles,
2089 Media.MaxVolBytes AS maxvolbytes,
2090 VolErrors AS nb_errors,
2091 Pool.Name AS poolname,
2092 Location.Location AS location,
2093 Media.Recycle AS recycle,
2094 Media.VolRetention AS volretention,
2095 Media.LastWritten AS lastwritten,
2096 Media.VolReadTime/1000000 AS volreadtime,
2097 Media.VolWriteTime/1000000 AS volwritetime,
2098 Media.RecycleCount AS recyclecount,
2099 Media.Comment AS comment,
2100 $self->{sql}->{FROM_UNIXTIME}(
2101 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2102 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2105 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2106 WHERE Pool.PoolId = Media.PoolId
2107 AND VolumeName IN ($medias->{jmedias})
2110 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2112 foreach my $media (values %$all) {
2113 my $mq = $self->dbh_quote($media->{volumename});
2116 SELECT DISTINCT Job.JobId AS jobid,
2118 Job.StartTime AS starttime,
2121 Job.JobFiles AS files,
2122 Job.JobBytes AS bytes,
2123 Job.jobstatus AS status
2124 FROM Media,JobMedia,Job
2125 WHERE Media.VolumeName=$mq
2126 AND Media.MediaId=JobMedia.MediaId
2127 AND JobMedia.JobId=Job.JobId
2130 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2133 SELECT LocationLog.Date AS date,
2134 Location.Location AS location,
2135 LocationLog.Comment AS comment
2136 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2137 WHERE Media.MediaId = LocationLog.MediaId
2138 AND Media.VolumeName = $mq
2142 my $log = $self->dbh_selectall_arrayref($query) ;
2144 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2147 $self->display({ jobs => [ values %$jobs ],
2148 LocationLog => $logtxt,
2150 "display_media_zoom.tpl");
2158 my $loc = $self->get_form('qlocation');
2159 unless ($loc->{qlocation}) {
2160 return $self->error("Can't get location");
2164 SELECT Location.Location AS location,
2165 Location.Cost AS cost,
2166 Location.Enabled AS enabled
2168 WHERE Location.Location = $loc->{qlocation}
2171 my $row = $self->dbh_selectrow_hashref($query);
2173 $self->display({ ID => $cur_id++,
2174 %$row }, "location_edit.tpl") ;
2182 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2183 unless ($arg->{qlocation}) {
2184 return $self->error("Can't get location");
2186 unless ($arg->{qnewlocation}) {
2187 return $self->error("Can't get new location name");
2189 unless ($arg->{cost}) {
2190 return $self->error("Can't get new cost");
2193 my $enabled = CGI::param('enabled') || '';
2194 $enabled = $enabled?1:0;
2197 UPDATE Location SET Cost = $arg->{cost},
2198 Location = $arg->{qnewlocation},
2200 WHERE Location.Location = $arg->{qlocation}
2203 $self->dbh_do($query);
2205 $self->display_location();
2211 my $arg = $self->get_form(qw/qlocation/) ;
2213 unless ($arg->{qlocation}) {
2214 return $self->error("Can't get location");
2218 SELECT count(Media.MediaId) AS nb
2219 FROM Media INNER JOIN Location USING (LocationID)
2220 WHERE Location = $arg->{qlocation}
2223 my $res = $self->dbh_selectrow_hashref($query);
2226 return $self->error("Sorry, the location must be empty");
2230 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2233 $self->dbh_do($query);
2235 $self->display_location();
2242 my $arg = $self->get_form(qw/qlocation cost/) ;
2244 unless ($arg->{qlocation}) {
2245 $self->display({}, "location_add.tpl");
2248 unless ($arg->{cost}) {
2249 return $self->error("Can't get new cost");
2252 my $enabled = CGI::param('enabled') || '';
2253 $enabled = $enabled?1:0;
2256 INSERT INTO Location (Location, Cost, Enabled)
2257 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2260 $self->dbh_do($query);
2262 $self->display_location();
2265 sub display_location
2270 SELECT Location.Location AS location,
2271 Location.Cost AS cost,
2272 Location.Enabled AS enabled,
2273 (SELECT count(Media.MediaId)
2275 WHERE Media.LocationId = Location.LocationId
2280 my $location = $self->dbh_selectall_hashref($query, 'location');
2282 $self->display({ ID => $cur_id++,
2283 Locations => [ values %$location ] },
2284 "display_location.tpl");
2291 my $medias = $self->get_selected_media_location();
2296 my $arg = $self->get_form('db_locations', 'qnewlocation');
2298 $self->display({ email => $self->{info}->{email_media},
2300 medias => [ values %$medias ],
2302 "update_location.tpl");
2305 sub get_media_max_size
2307 my ($self, $type) = @_;
2309 "SELECT avg(VolBytes) AS size
2311 WHERE Media.VolStatus = 'Full'
2312 AND Media.MediaType = '$type'
2315 my $res = $self->selectrow_hashref($query);
2318 return $res->{size};
2328 my $media = $self->get_form('qmedia');
2330 unless ($media->{qmedia}) {
2331 return $self->error("Can't get media");
2335 SELECT Media.Slot AS slot,
2336 PoolMedia.Name AS poolname,
2337 Media.VolStatus AS volstatus,
2338 Media.InChanger AS inchanger,
2339 Location.Location AS location,
2340 Media.VolumeName AS volumename,
2341 Media.MaxVolBytes AS maxvolbytes,
2342 Media.MaxVolJobs AS maxvoljobs,
2343 Media.MaxVolFiles AS maxvolfiles,
2344 Media.VolUseDuration AS voluseduration,
2345 Media.VolRetention AS volretention,
2346 Media.Comment AS comment,
2347 PoolRecycle.Name AS poolrecycle
2349 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2350 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2351 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2353 WHERE Media.VolumeName = $media->{qmedia}
2356 my $row = $self->dbh_selectrow_hashref($query);
2357 $row->{volretention} = human_sec($row->{volretention});
2358 $row->{voluseduration} = human_sec($row->{voluseduration});
2360 my $elt = $self->get_form(qw/db_pools db_locations/);
2365 }, "update_media.tpl");
2372 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2374 unless ($arg->{jmedias}) {
2375 return $self->error("Can't get selected media");
2378 unless ($arg->{qnewlocation}) {
2379 return $self->error("Can't get new location");
2384 SET LocationId = (SELECT LocationId
2386 WHERE Location = $arg->{qnewlocation})
2387 WHERE Media.VolumeName IN ($arg->{jmedias})
2390 my $nb = $self->dbh_do($query);
2392 print "$nb media updated, you may have to update your autochanger.";
2394 $self->display_media();
2401 my $medias = $self->get_selected_media_location();
2403 return $self->error("Can't get media selection");
2405 my $newloc = CGI::param('newlocation');
2407 my $user = CGI::param('user') || 'unknow';
2408 my $comm = CGI::param('comment') || '';
2409 $comm = $self->dbh_quote("$user: $comm");
2413 foreach my $media (keys %$medias) {
2415 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2417 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2418 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2419 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2422 $self->dbh_do($query);
2423 $self->debug($query);
2427 $q->param('action', 'update_location');
2428 my $url = $q->url(-full => 1, -query=>1);
2430 $self->display({ email => $self->{info}->{email_media},
2432 newlocation => $newloc,
2433 # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
2434 medias => [ values %$medias ],
2436 "change_location.tpl");
2440 sub display_client_stats
2442 my ($self, %arg) = @_ ;
2444 my $client = $self->dbh_quote($arg{clientname});
2445 my ($limit, $label) = $self->get_limit(%arg);
2449 count(Job.JobId) AS nb_jobs,
2450 sum(Job.JobBytes) AS nb_bytes,
2451 sum(Job.JobErrors) AS nb_err,
2452 sum(Job.JobFiles) AS nb_files,
2453 Client.Name AS clientname
2454 FROM Job INNER JOIN Client USING (ClientId)
2456 Client.Name = $client
2458 GROUP BY Client.Name
2461 my $row = $self->dbh_selectrow_hashref($query);
2463 $row->{ID} = $cur_id++;
2464 $row->{label} = $label;
2466 $self->display($row, "display_client_stats.tpl");
2469 # poolname can be undef
2472 my ($self, $poolname) = @_ ;
2476 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2477 if ($arg->{jmediatypes}) {
2478 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2479 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2482 # TODO : afficher les tailles et les dates
2485 SELECT subq.volmax AS volmax,
2486 subq.volnum AS volnum,
2487 subq.voltotal AS voltotal,
2489 Pool.Recycle AS recycle,
2490 Pool.VolRetention AS volretention,
2491 Pool.VolUseDuration AS voluseduration,
2492 Pool.MaxVolJobs AS maxvoljobs,
2493 Pool.MaxVolFiles AS maxvolfiles,
2494 Pool.MaxVolBytes AS maxvolbytes,
2495 subq.PoolId AS PoolId
2498 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2499 count(Media.MediaId) AS volnum,
2500 sum(Media.VolBytes) AS voltotal,
2501 Media.PoolId AS PoolId,
2502 Media.MediaType AS MediaType
2504 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2505 Media.MediaType AS MediaType
2507 WHERE Media.VolStatus = 'Full'
2508 GROUP BY Media.MediaType
2509 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2510 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2512 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2516 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2519 SELECT Pool.Name AS name,
2520 sum(VolBytes) AS size
2521 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2522 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2526 my $empty = $self->dbh_selectall_hashref($query, 'name');
2528 foreach my $p (values %$all) {
2529 if ($p->{volmax} > 0) { # mysql returns 0.0000
2530 # we remove Recycled/Purged media from pool usage
2531 if (defined $empty->{$p->{name}}) {
2532 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2534 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2536 $p->{poolusage} = 0;
2540 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2542 WHERE PoolId=$p->{poolid}
2546 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2547 foreach my $t (values %$content) {
2548 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2553 $self->display({ ID => $cur_id++,
2554 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2555 Pools => [ values %$all ]},
2556 "display_pool.tpl");
2559 sub display_running_job
2563 my $arg = $self->get_form('client', 'jobid');
2565 if (!$arg->{client} and $arg->{jobid}) {
2568 SELECT Client.Name AS name
2569 FROM Job INNER JOIN Client USING (ClientId)
2570 WHERE Job.JobId = $arg->{jobid}
2573 my $row = $self->dbh_selectrow_hashref($query);
2576 $arg->{client} = $row->{name};
2577 CGI::param('client', $arg->{client});
2581 if ($arg->{client}) {
2582 my $cli = new Bweb::Client(name => $arg->{client});
2583 $cli->display_running_job($self->{info}, $arg->{jobid});
2584 if ($arg->{jobid}) {
2585 $self->get_job_log();
2588 $self->error("Can't get client or jobid");
2592 sub display_running_jobs
2594 my ($self, $display_action) = @_;
2597 SELECT Job.JobId AS jobid,
2598 Job.Name AS jobname,
2600 Job.StartTime AS starttime,
2601 Job.JobFiles AS jobfiles,
2602 Job.JobBytes AS jobbytes,
2603 Job.JobStatus AS jobstatus,
2604 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2605 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2607 Client.Name AS clientname
2608 FROM Job INNER JOIN Client USING (ClientId)
2609 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2611 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2613 $self->display({ ID => $cur_id++,
2614 display_action => $display_action,
2615 Jobs => [ values %$all ]},
2616 "running_job.tpl") ;
2622 my $arg = $self->get_form('jmedias');
2624 unless ($arg->{jmedias}) {
2625 return $self->error("Can't get media selection");
2629 SELECT Media.VolumeName AS volumename,
2630 Storage.Name AS storage,
2631 Location.Location AS location,
2633 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2634 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2635 WHERE Media.VolumeName IN ($arg->{jmedias})
2636 AND Media.InChanger = 1
2639 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2641 foreach my $vol (values %$all) {
2642 my $a = $self->ach_get($vol->{location});
2645 unless ($a->{have_status}) {
2647 $a->{have_status} = 1;
2650 print "eject $vol->{volumename} from $vol->{storage} : ";
2651 if ($a->send_to_io($vol->{slot})) {
2663 my ($to, $subject, $content) = (CGI::param('email'),
2664 CGI::param('subject'),
2665 CGI::param('content'));
2666 $to =~ s/[^\w\d\.\@<>,]//;
2667 $subject =~ s/[^\w\d\.\[\]]/ /;
2669 open(MAIL, "|mail -s '$subject' '$to'") ;
2670 print MAIL $content;
2680 my $arg = $self->get_form('jobid', 'client');
2682 print CGI::header('text/brestore');
2683 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2684 print "client=$arg->{client}\n" if ($arg->{client});
2685 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2689 # TODO : move this to Bweb::Autochanger ?
2690 # TODO : make this internal to not eject tape ?
2696 my ($self, $name) = @_;
2699 return $self->error("Can't get your autochanger name ach");
2702 unless ($self->{info}->{ach_list}) {
2703 return $self->error("Could not find any autochanger");
2706 my $a = $self->{info}->{ach_list}->{$name};
2709 $self->error("Can't get your autochanger $name from your ach_list");
2720 my ($self, $ach) = @_;
2722 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2724 $self->{info}->save();
2732 my $arg = $self->get_form('ach');
2734 or !$self->{info}->{ach_list}
2735 or !$self->{info}->{ach_list}->{$arg->{ach}})
2737 return $self->error("Can't get autochanger name");
2740 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2744 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2746 my $b = $self->get_bconsole();
2748 my @storages = $b->list_storage() ;
2750 $ach->{devices} = [ map { { name => $_ } } @storages ];
2752 $self->display($ach, "ach_add.tpl");
2753 delete $ach->{drives};
2754 delete $ach->{devices};
2761 my $arg = $self->get_form('ach');
2764 or !$self->{info}->{ach_list}
2765 or !$self->{info}->{ach_list}->{$arg->{ach}})
2767 return $self->error("Can't get autochanger name");
2770 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2772 $self->{info}->save();
2773 $self->{info}->view();
2779 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2781 my $b = $self->get_bconsole();
2782 my @storages = $b->list_storage() ;
2784 unless ($arg->{ach}) {
2785 $arg->{devices} = [ map { { name => $_ } } @storages ];
2786 return $self->display($arg, "ach_add.tpl");
2790 foreach my $drive (CGI::param('drives'))
2792 unless (grep(/^$drive$/,@storages)) {
2793 return $self->error("Can't find $drive in storage list");
2796 my $index = CGI::param("index_$drive");
2797 unless (defined $index and $index =~ /^(\d+)$/) {
2798 return $self->error("Can't get $drive index");
2801 $drives[$index] = $drive;
2805 return $self->error("Can't get drives from Autochanger");
2808 my $a = new Bweb::Autochanger(name => $arg->{ach},
2809 precmd => $arg->{precmd},
2810 drive_name => \@drives,
2811 device => $arg->{device},
2812 mtxcmd => $arg->{mtxcmd});
2814 $self->ach_register($a) ;
2816 $self->{info}->view();
2822 my $arg = $self->get_form('jobid');
2824 if ($arg->{jobid}) {
2825 my $b = $self->get_bconsole();
2826 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2830 title => "Delete a job ",
2831 name => "delete jobid=$arg->{jobid}",
2840 my $arg = $self->get_form(qw/media volstatus inchanger pool
2841 slot volretention voluseduration
2842 maxvoljobs maxvolfiles maxvolbytes
2843 qcomment poolrecycle
2846 unless ($arg->{media}) {
2847 return $self->error("Can't find media selection");
2850 my $update = "update volume=$arg->{media} ";
2852 if ($arg->{volstatus}) {
2853 $update .= " volstatus=$arg->{volstatus} ";
2856 if ($arg->{inchanger}) {
2857 $update .= " inchanger=yes " ;
2859 $update .= " slot=$arg->{slot} ";
2862 $update .= " slot=0 inchanger=no ";
2866 $update .= " pool=$arg->{pool} " ;
2869 $arg->{volretention} ||= 0 ;
2870 if ($arg->{volretention}) {
2871 $update .= " volretention=\"$arg->{volretention}\" " ;
2874 $arg->{voluseduration} ||= 0 ;
2875 if ($arg->{voluseduration}) {
2876 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2879 $arg->{maxvoljobs} ||= 0;
2880 if ($arg->{maxvoljobs}) {
2881 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2884 $arg->{maxvolfiles} ||= 0;
2885 if ($arg->{maxvolfiles}) {
2886 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2889 $arg->{maxvolbytes} ||= 0;
2890 if ($arg->{maxvolbytes}) {
2891 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2894 my $b = $self->get_bconsole();
2897 content => $b->send_cmd($update),
2898 title => "Update a volume ",
2904 my $media = $self->dbh_quote($arg->{media});
2906 my $loc = CGI::param('location') || '';
2908 $loc = $self->dbh_quote($loc); # is checked by db
2909 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2911 if ($arg->{poolrecycle}) {
2912 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2914 if (!$arg->{qcomment}) {
2915 $arg->{qcomment} = "''";
2917 push @q, "Comment=$arg->{qcomment}";
2922 SET " . join (',', @q) . "
2923 WHERE Media.VolumeName = $media
2925 $self->dbh_do($query);
2927 $self->update_media();
2934 my $ach = CGI::param('ach') ;
2935 $ach = $self->ach_get($ach);
2937 return $self->error("Bad autochanger name");
2941 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2942 $b->update_slots($ach->{name});
2950 my $arg = $self->get_form('jobid');
2951 unless ($arg->{jobid}) {
2952 return $self->error("Can't get jobid");
2955 my $t = CGI::param('time') || '';
2958 SELECT Job.Name as name, Client.Name as clientname
2959 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2960 WHERE JobId = $arg->{jobid}
2963 my $row = $self->dbh_selectrow_hashref($query);
2966 return $self->error("Can't find $arg->{jobid} in catalog");
2970 SELECT Time AS time, LogText AS log
2972 WHERE Log.JobId = $arg->{jobid}
2973 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2974 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2979 my $log = $self->dbh_selectall_arrayref($query);
2981 return $self->error("Can't get log for jobid $arg->{jobid}");
2987 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
2989 $logtxt = join("", map { $_->[1] } @$log ) ;
2992 $self->display({ lines=> $logtxt,
2993 jobid => $arg->{jobid},
2994 name => $row->{name},
2995 client => $row->{clientname},
2996 }, 'display_log.tpl');
3004 my $arg = $self->get_form('ach', 'slots', 'drive');
3006 unless ($arg->{ach}) {
3007 return $self->error("Can't find autochanger name");
3012 if ($arg->{slots}) {
3013 $slots = join(",", @{ $arg->{slots} });
3014 $t += 60*scalar( @{ $arg->{slots} }) ;
3017 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3018 print "<h1>This command can take long time, be patient...</h1>";
3020 $b->label_barcodes(storage => $arg->{ach},
3021 drive => $arg->{drive},
3032 my @volume = CGI::param('media');
3035 return $self->error("Can't get media selection");
3038 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3041 content => $b->purge_volume(@volume),
3042 title => "Purge media",
3043 name => "purge volume=" . join(' volume=', @volume),
3052 my @volume = CGI::param('media');
3054 return $self->error("Can't get media selection");
3057 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3060 content => $b->prune_volume(@volume),
3061 title => "Prune media",
3062 name => "prune volume=" . join(' volume=', @volume),
3072 my $arg = $self->get_form('jobid');
3073 unless ($arg->{jobid}) {
3074 return $self->error("Can't get jobid");
3077 my $b = $self->get_bconsole();
3079 content => $b->cancel($arg->{jobid}),
3080 title => "Cancel job",
3081 name => "cancel jobid=$arg->{jobid}",
3087 # Warning, we display current fileset
3090 my $arg = $self->get_form('fileset');
3092 if ($arg->{fileset}) {
3093 my $b = $self->get_bconsole();
3094 my $ret = $b->get_fileset($arg->{fileset});
3095 $self->display({ fileset => $arg->{fileset},
3097 }, "fileset_view.tpl");
3099 $self->error("Can't get fileset name");
3103 sub director_show_sched
3107 my $arg = $self->get_form('days');
3109 my $b = $self->get_bconsole();
3110 my $ret = $b->director_get_sched( $arg->{days} );
3115 }, "scheduled_job.tpl");
3118 sub enable_disable_job
3120 my ($self, $what) = @_ ;
3122 my $name = CGI::param('job') || '';
3123 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3124 return $self->error("Can't find job name");
3127 my $b = $self->get_bconsole();
3137 content => $b->send_cmd("$cmd job=\"$name\""),
3138 title => "$cmd $name",
3139 name => "$cmd job=\"$name\"",
3146 return new Bconsole(pref => $self->{info});
3152 my $b = $self->get_bconsole();
3154 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3156 $self->display({ Jobs => $joblist }, "run_job.tpl");
3161 my ($self, $ouput) = @_;
3164 foreach my $l (split(/\r\n/, $ouput)) {
3165 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3171 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3177 foreach my $k (keys %arg) {
3178 $lowcase{lc($k)} = $arg{$k} ;
3187 my $b = $self->get_bconsole();
3189 my $job = CGI::param('job') || '';
3191 my $info = $b->send_cmd("show job=\"$job\"");
3192 my $attr = $self->run_parse_job($info);
3194 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3196 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3197 my $clients = [ map { { name => $_ } }$b->list_client()];
3198 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3199 my $storages= [ map { { name => $_ } }$b->list_storage()];
3204 clients => $clients,
3205 filesets => $filesets,
3206 storages => $storages,
3208 }, "run_job_mod.tpl");
3214 my $b = $self->get_bconsole();
3216 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3226 my $b = $self->get_bconsole();
3228 # TODO: check input (don't use pool, level)
3230 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3231 my $job = CGI::param('job') || '';
3232 my $storage = CGI::param('storage') || '';
3234 my $jobid = $b->run(job => $job,
3235 client => $arg->{client},
3236 priority => $arg->{priority},
3237 level => $arg->{level},
3238 storage => $storage,
3239 pool => $arg->{pool},
3240 when => $arg->{when},
3243 print $jobid, $b->{error};
3245 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";