git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/GBalloon.pm

   1
   2 =head1 LICENSE
   3
   4    Bweb - A Bacula web interface
   5    Bacula® - The Network Backup Solution
   6
   7    Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
   8
   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.
  12
  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.
  17
  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.
  22
  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
  26    02110-1301, USA.
  27
  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.
  32
  33 =cut
  34
  35 use strict ;
  36 use GD qw/gdSmallFont/;
  37
  38 package GBalloon ;
  39
  40 our $gd ;
  41 our @color_tab ;
  42
  43 our $black ;
  44 our $white ;
  45
  46 sub new
  47 {
  48     my ($class, %arg) = @_ ;
  49
  50     my $self = {
  51         height     => 800,      # element height in px
  52         width      => 600,      # element width in px
  53         xmarge     => 75,
  54         ymarge     => 100,
  55         z_max_size => 50,       # max circle size
  56         z_min_size => 8,        # min circle size
  57
  58         x_min => 0,
  59         y_min => 0,
  60         x_max => 1,
  61         y_max => 1,
  62         z_max => 1,
  63
  64         data       => [],
  65         type       => {},
  66
  67         img_id => 'imggraph',   # used to display graph
  68
  69         base_url   => '',
  70     } ;
  71
  72     map { $self->{$_} = $arg{$_} } keys %arg ;
  73
  74     bless $self ;
  75
  76     return $self ;
  77 }
  78
  79 sub get_imagemap
  80 {
  81     my ($self, $title, $img) = @_ ;
  82
  83     return "
  84 <map name='$self->{img_id}'>
  85 " . join ('', reverse @{$self->{image_map}}) . "
  86 </map>
  87 <script type='text/javascript' language='JavaScript'>
  88  document.getElementById('$self->{img_id}').src='$img';
  89 </script>
  90 " ;
  91
  92 }
  93
  94 sub push_image_map
  95 {
  96     my ($self, $label, $tips, $x, $y, $z) = @_ ;
  97
  98     my $ret = sprintf("%.2f,%.2f,%.2f",
  99                       $x,$y,$z);
 100
 101     push @{$self->{image_map}},
 102         "<area shape='circle' coords='$ret' ".
 103         "title='$tips' href='$self->{base_url}${label}'>\n" ;
 104 }
 105
 106 sub init_gd
 107 {
 108     my ($self) = @_;
 109
 110     unless (defined $gd) {
 111         my $height = $self->{height} ;
 112         my $width  = $self->{width} ;
 113
 114         $gd    = new GD::Image($width+100,$height+100);
 115         $white = $gd->colorAllocate(255,255,255);
 116
 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),
 126                           ) ;
 127
 128         $black = $gd->colorAllocate(0,0,0);
 129         $gd->transparent($white);
 130 #        $gd->interlaced('true');
 131         #         x  y   x    y
 132     }
 133 }
 134 use POSIX qw/strftime/;
 135
 136 sub compute
 137 {
 138     my ($self, $d) = @_;
 139
 140 #    print STDERR "compute: x=$d->[0] y=$d->[1] z=$d->[2]\n";
 141
 142     #       offset                       percent                 max
 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};
 146
 147     if ($z < $self->{z_min_size}) {
 148         $z += $self->{z_min_size};      # min size
 149     }
 150
 151     return ($x, $y, $z);
 152 }
 153
 154 sub finalize
 155 {
 156     my ($self) = @_;
 157
 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));
 161
 162     # the max z will take something like 10% of the total size
 163     $self->{z_max} = sqrt($data[0]->[2]) || 1;
 164     my $c=0;
 165
 166 #   print STDERR "max: x=$self->{x_max} y=$self->{y_max} z=$self->{z_max}\n";
 167
 168     foreach my $d (@data)
 169     {
 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);
 175     }
 176
 177     $self->draw_axis();
 178 }
 179
 180 sub set_legend_axis
 181 {
 182     my ($self, %arg) = @_;
 183
 184     unless ($arg{x_func}) {
 185         $arg{x_func} = sub { join(" ", @_) }
 186     }
 187
 188     unless ($arg{y_func}) {
 189         $arg{y_func} = sub { join(" ", @_) }
 190     }
 191
 192     $self->{axis} = \%arg;
 193 }
 194
 195 sub draw_axis
 196 {
 197     my ($self) = @_;
 198     # draw axis
 199     $gd->line($self->{xmarge}, 5,
 200               $self->{xmarge}, $self->{height},
 201               $black);
 202     $gd->line($self->{xmarge}, $self->{height},
 203               $self->{width} - 5, $self->{height}, $black);
 204
 205     $gd->string(GD::Font->Small,
 206                 $self->{width} - 5,
 207                 $self->{height} + 10,
 208                 $self->{axis}->{x_title},
 209                 $black);
 210
 211     $gd->string(GD::Font->Small,
 212                 0,
 213                 10,
 214                 $self->{axis}->{y_title},
 215                 $black);
 216
 217     my $h = $self->{height} ;
 218     my $w = $self->{width}  - $self->{xmarge};
 219
 220     my $i=0;
 221     for (my $p = $self->{xmarge}; $p <= $w; $p = $p + $w/7) {
 222         $gd->string(GD::Font->Small,
 223                     $p,
 224                     $self->{height} + 10,
 225                     $self->{axis}->{x_func}($i),
 226                     $black);
 227
 228         $gd->line($p,
 229                   $self->{height} - 2,
 230                   $p,
 231                   $self->{height} + 2,
 232                   $black);
 233
 234         $i = $i + $self->{x_max}/7;
 235     }
 236
 237     $i=0;
 238     for (my $p = $h; $p >= 0; $p = $p - $h/7) {
 239         $gd->string(GD::Font->Small,
 240                     10, $p,
 241                     $self->{axis}->{y_func}($i),
 242                     $black);
 243
 244         $gd->line($self->{xmarge} - 2,
 245                   $p,
 246                   $self->{xmarge} + 2,
 247                   $p,
 248                   $black);
 249
 250         $i = $i + $self->{y_max}/7;
 251     }
 252 }
 253
 254 sub add_point
 255 {
 256     my ($self, $x_val, $y_val, $z_val, $label, $link) = @_;
 257     return unless ($x_val or $y_val or $z_val or $label);
 258
 259     if ($self->{x_max} < $x_val) {
 260         $self->{x_max} = $x_val;
 261     }
 262     if ($self->{y_max} < $y_val) {
 263         $self->{y_max} = $y_val;
 264     }
 265
 266     if ($self->{x_min} > $x_val) {
 267         $self->{x_min} = $x_val;
 268     }
 269     if ($self->{y_min} > $y_val) {
 270         $self->{y_min} = $y_val;
 271     }
 272
 273     # z will be compute after
 274     push @{$self->{data}}, [$x_val, $y_val, $z_val, $label, $link];
 275 }
 276
 277 1;
 278 __END__
 279
 280 package main ;
 281
 282 # display Mb/Gb/Kb
 283 sub human_size
 284 {
 285     my @unit = qw(B KB MB GB TB);
 286     my $val = shift || 0;
 287     my $i=0;
 288     my $format = '%i %s';
 289     while ($val / 1024 > 1) {
 290         $i++;
 291         $val /= 1024;
 292     }
 293     $format = ($i>0)?'%0.1f %s':'%i %s';
 294     return sprintf($format, $val, $unit[$i]);
 295 }
 296
 297 # display Day, Hour, Year
 298 sub human_sec
 299 {
 300     use integer;
 301
 302     my $val = shift;
 303     $val /= 60;                 # sec -> min
 304
 305     if ($val / 60 <= 1) {
 306         return "$val mins";
 307     }
 308
 309     $val /= 60;                 # min -> hour
 310     if ($val / 24 <= 1) {
 311         return "$val hours";
 312     }
 313
 314     $val /= 24;                 # hour -> day
 315     return "$val days";
 316 }
 317
 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');
 322
 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');
 330
 331
 332
 333 $top->init_gd();
 334 $top->finalize() ;
 335 #$top->draw_labels() ;
 336 # make sure we are writing to a binary stream
 337 binmode STDOUT;
 338
 339 # Convert the image to PNG and print it on standard output
 340 print $gd->png;
 341
 342 print STDERR "<html><body>";
 343 print STDERR $top->get_imagemap("example", "a.png");
 344 print STDERR "</body></html>";