4 Bweb - A Bacula web interface
5 Bacula® - The Network Backup Solution
7 Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
9 The main author of Bweb is Eric Bollengier.
10 The main author of Bacula is Kern Sibbald, with contributions from
11 many others, a complete list can be found in the file AUTHORS.
13 This program is Free Software; you can redistribute it and/or
14 modify it under the terms of version two of the GNU General Public
15 License as published by the Free Software Foundation plus additions
16 that are listed in the file LICENSE.
18 This program is distributed in the hope that it will be useful, but
19 WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 General Public License for more details.
23 You should have received a copy of the GNU General Public License
24 along with this program; if not, write to the Free Software
25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 Bacula® is a registered trademark of John Walker.
29 The licensor of Bacula is the Free Software Foundation Europe
30 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
31 Switzerland, email:ftf@fsfeurope.org.
36 use GD qw/gdSmallFont/;
48 my ($class, %arg) = @_ ;
51 height => 800, # element height in px
52 width => 600, # element width in px
55 z_max_size => 50, # max circle size
56 z_min_size => 8, # min circle size
67 img_id => 'imggraph', # used to display graph
72 map { $self->{$_} = $arg{$_} } keys %arg ;
81 my ($self, $title, $img) = @_ ;
84 <map name='$self->{img_id}'>
85 " . join ('', reverse @{$self->{image_map}}) . "
87 <script type='text/javascript' language='JavaScript'>
88 document.getElementById('$self->{img_id}').src='$img';
96 my ($self, $label, $tips, $x, $y, $z) = @_ ;
98 my $ret = sprintf("%.2f,%.2f,%.2f",
101 push @{$self->{image_map}},
102 "<area shape='circle' coords='$ret' ".
103 "title='$tips' href='$self->{base_url}${label}'>\n" ;
110 unless (defined $gd) {
111 my $height = $self->{height} ;
112 my $width = $self->{width} ;
114 $gd = new GD::Image($width+100,$height+100);
115 $white = $gd->colorAllocate(255,255,255);
117 push @color_tab, ($gd->colorAllocate(135,236,88),
118 $gd->colorAllocate( 255, 236, 139),
119 $gd->colorAllocate(255,95,95),
120 $gd->colorAllocate(255,149,0),
121 $gd->colorAllocate( 255, 174, 185),
122 $gd->colorAllocate( 179, 255, 58),
123 $gd->colorAllocate( 205, 133, 0),
124 $gd->colorAllocate(205, 133, 0 ),
125 $gd->colorAllocate(238, 238, 209),
128 $black = $gd->colorAllocate(0,0,0);
129 $gd->transparent($white);
130 # $gd->interlaced('true');
134 use POSIX qw/strftime/;
140 # print STDERR "compute: x=$d->[0] y=$d->[1] z=$d->[2]\n";
143 my $x = $self->{xmarge} + $d->[0] / $self->{x_max} * ($self->{width} - $self->{xmarge});
144 my $y = $self->{height} - $d->[1] / $self->{y_max} * ($self->{height} - $self->{ymarge});
145 my $z = sqrt($d->[2]) / $self->{z_max} * $self->{z_max_size};
147 if ($z < $self->{z_min_size}) {
148 $z += $self->{z_min_size}; # min size
158 # we need to display big z before min z
159 my @data = sort { $b->[2] <=> $a->[2] } @{$self->{data}};
160 return unless (scalar(@data));
162 # the max z will take something like 10% of the total size
163 $self->{z_max} = sqrt($data[0]->[2]) || 1;
166 # print STDERR "max: x=$self->{x_max} y=$self->{y_max} z=$self->{z_max}\n";
168 foreach my $d (@data)
170 my ($x, $y, $z) = $self->compute($d);
171 # print STDERR "current: x=$x y=$y z=$z\n";
172 $c = ($c+1) % scalar(@color_tab);
173 $gd->filledArc($x, $y, 2*$z, 2*$z, 0, 360, $color_tab[$c]);
174 $self->push_image_map($d->[3], $d->[4],$x,$y,$z);
182 my ($self, %arg) = @_;
184 unless ($arg{x_func}) {
185 $arg{x_func} = sub { join(" ", @_) }
188 unless ($arg{y_func}) {
189 $arg{y_func} = sub { join(" ", @_) }
192 $self->{axis} = \%arg;
199 $gd->line($self->{xmarge}, 5,
200 $self->{xmarge}, $self->{height},
202 $gd->line($self->{xmarge}, $self->{height},
203 $self->{width} - 5, $self->{height}, $black);
205 $gd->string(GD::Font->Small,
207 $self->{height} + 10,
208 $self->{axis}->{x_title},
211 $gd->string(GD::Font->Small,
214 $self->{axis}->{y_title},
217 my $h = $self->{height} ;
218 my $w = $self->{width} - $self->{xmarge};
221 for (my $p = $self->{xmarge}; $p <= $w; $p = $p + $w/7) {
222 $gd->string(GD::Font->Small,
224 $self->{height} + 10,
225 $self->{axis}->{x_func}($i),
234 $i = $i + $self->{x_max}/7;
238 for (my $p = $h; $p >= 0; $p = $p - $h/7) {
239 $gd->string(GD::Font->Small,
241 $self->{axis}->{y_func}($i),
244 $gd->line($self->{xmarge} - 2,
250 $i = $i + $self->{y_max}/7;
256 my ($self, $x_val, $y_val, $z_val, $label, $link) = @_;
257 return unless ($x_val or $y_val or $z_val or $label);
259 if ($self->{x_max} < $x_val) {
260 $self->{x_max} = $x_val;
262 if ($self->{y_max} < $y_val) {
263 $self->{y_max} = $y_val;
266 if ($self->{x_min} > $x_val) {
267 $self->{x_min} = $x_val;
269 if ($self->{y_min} > $y_val) {
270 $self->{y_min} = $y_val;
273 # z will be compute after
274 push @{$self->{data}}, [$x_val, $y_val, $z_val, $label, $link];
285 my @unit = qw(B KB MB GB TB);
286 my $val = shift || 0;
288 my $format = '%i %s';
289 while ($val / 1024 > 1) {
293 $format = ($i>0)?'%0.1f %s':'%i %s';
294 return sprintf($format, $val, $unit[$i]);
297 # display Day, Hour, Year
303 $val /= 60; # sec -> min
305 if ($val / 60 <= 1) {
309 $val /= 60; # min -> hour
310 if ($val / 24 <= 1) {
314 $val /= 24; # hour -> day
318 my $top = new GBalloon(debug => 1) ;
319 $top->set_legend_axis(x_title => 'Time', x_func => \&human_sec,
320 y_title => 'Size', y_func => \&human_size,
321 z_title => 'Nb files');
323 $top->add_point( 13*60+56 , 3518454692 , 6 , 'PRLISVCS_RMAN');
324 $top->add_point( 23*60+31 , 2419151398 , 4 , 'RHREC_BACKUP' );
325 $top->add_point( 12*60+07 , 1373969860 , 1044 , '3_DATA');
326 $top->add_point( 13*60+40 , 2284109956 , 1121 , '4_DATA');
327 $top->add_point( 13*60+40 , 2284109956 , 1 , '1_DATA');
328 $top->add_point( 13*60+10 , 2284109956 , 1 , '2_DATA');
329 $top->add_point( 13*60+10 , 2284109956 , 2000000 , '7_DATA');
335 #$top->draw_labels() ;
336 # make sure we are writing to a binary stream
339 # Convert the image to PNG and print it on standard output
342 print STDERR "<html><body>";
343 print STDERR $top->get_imagemap("example", "a.png");
344 print STDERR "</body></html>";