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-2010 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    This program is Free Software; you can redistribute it and/or
  13    modify it under the terms of version three of the GNU Affero General Public
  14    License as published by the Free Software Foundation and included
  15    in the file LICENSE.
  16
  17    This program is distributed in the hope that it will be useful, but
  18    WITHOUT ANY WARRANTY; without even the implied warranty of
  19    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  20    General Public License for more details.
  21
  22    You should have received a copy of the GNU Affero General Public License
  23    along with this program; if not, write to the Free Software
  24    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25    02110-1301, USA.
  26
  27    Bacula® is a registered trademark of Kern Sibbald.
  28    The licensor of Bacula is the Free Software Foundation Europe
  29    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
  30    Switzerland, email:ftf@fsfeurope.org.
  31
  32 =cut
  33
  34 use strict ;
  35 use GD qw/gdSmallFont/;
  36
  37 package GBalloon ;
  38
  39 our $gd ;
  40 our @color_tab ;
  41
  42 our $black ;
  43 our $white ;
  44
  45 sub new
  46 {
  47     my ($class, %arg) = @_ ;
  48
  49     my $self = {
  50         height     => 800,      # element height in px
  51         width      => 600,      # element width in px
  52         xmarge     => 75,
  53         ymarge     => 100,
  54         z_max_size => 50,       # max circle size
  55         z_min_size => 8,        # min circle size
  56
  57         x_min => 0,
  58         y_min => 0,
  59         x_max => 1,
  60         y_max => 1,
  61         z_max => 1,
  62
  63         data       => [],
  64         type       => {},
  65
  66         img_id => 'imggraph',   # used to display graph
  67
  68         base_url   => '',
  69     } ;
  70
  71     map { $self->{$_} = $arg{$_} } keys %arg ;
  72
  73     bless $self ;
  74
  75     return $self ;
  76 }
  77
  78 sub get_imagemap
  79 {
  80     my ($self, $title, $img) = @_ ;
  81
  82     return "
  83 <map name='$self->{img_id}'>
  84 " . join ('', reverse @{$self->{image_map}}) . "
  85 </map>
  86 <script type='text/javascript' language='JavaScript'>
  87  document.getElementById('$self->{img_id}').src='$img';
  88 </script>
  89 " ;
  90
  91 }
  92
  93 sub push_image_map
  94 {
  95     my ($self, $label, $tips, $x, $y, $z) = @_ ;
  96
  97     my $ret = sprintf("%.2f,%.2f,%.2f",
  98                       $x,$y,$z);
  99
 100     push @{$self->{image_map}},
 101         "<area shape='circle' coords='$ret' ".
 102         "title='$tips' href='$self->{base_url}${label}'>\n" ;
 103 }
 104
 105 sub init_gd
 106 {
 107     my ($self) = @_;
 108
 109     unless (defined $gd) {
 110         my $height = $self->{height} ;
 111         my $width  = $self->{width} ;
 112
 113         $gd    = new GD::Image($width+100,$height+100);
 114         $white = $gd->colorAllocate(255,255,255);
 115
 116         push @color_tab, ($gd->colorAllocate(135,236,88),
 117                           $gd->colorAllocate( 255, 236, 139),
 118                           $gd->colorAllocate(255,95,95),
 119                           $gd->colorAllocate(255,149,0),
 120                           $gd->colorAllocate( 255, 174, 185),
 121                           $gd->colorAllocate( 179, 255,  58),
 122                           $gd->colorAllocate( 205, 133,   0),
 123                           $gd->colorAllocate(205, 133,   0 ),
 124                           $gd->colorAllocate(238, 238, 209),
 125                           ) ;
 126
 127         $black = $gd->colorAllocate(0,0,0);
 128         $gd->transparent($white);
 129 #        $gd->interlaced('true');
 130         #         x  y   x    y
 131     }
 132 }
 133 use POSIX qw/strftime/;
 134
 135 sub compute
 136 {
 137     my ($self, $d) = @_;
 138
 139 #    print STDERR "compute: x=$d->[0] y=$d->[1] z=$d->[2]\n";
 140
 141     #       offset                       percent                 max
 142     my $x = $self->{xmarge} + $d->[0] / $self->{x_max} * ($self->{width} - $self->{xmarge});
 143     my $y = $self->{height} - $d->[1] / $self->{y_max} * ($self->{height} - $self->{ymarge});
 144     my $z = sqrt($d->[2]) / $self->{z_max} * $self->{z_max_size};
 145
 146     if ($z < $self->{z_min_size}) {
 147         $z += $self->{z_min_size};      # min size
 148     }
 149
 150     return ($x, $y, $z);
 151 }
 152
 153 sub finalize
 154 {
 155     my ($self) = @_;
 156
 157     # we need to display big z before min z
 158     my @data = sort { $b->[2] <=> $a->[2] } @{$self->{data}};
 159     return unless (scalar(@data));
 160
 161     # the max z will take something like 10% of the total size
 162     $self->{z_max} = sqrt($data[0]->[2]) || 1;
 163     my $c=0;
 164
 165 #   print STDERR "max: x=$self->{x_max} y=$self->{y_max} z=$self->{z_max}\n";
 166
 167     foreach my $d (@data)
 168     {
 169         my ($x, $y, $z) = $self->compute($d);
 170 #       print STDERR "current: x=$x y=$y z=$z\n";
 171         $c = ($c+1) % scalar(@color_tab);
 172         $gd->filledArc($x, $y, 2*$z, 2*$z, 0, 360, $color_tab[$c]);
 173         $self->push_image_map($d->[3], $d->[4],$x,$y,$z);
 174     }
 175
 176     $self->draw_axis();
 177 }
 178
 179 sub set_legend_axis
 180 {
 181     my ($self, %arg) = @_;
 182
 183     unless ($arg{x_func}) {
 184         $arg{x_func} = sub { join(" ", @_) }
 185     }
 186
 187     unless ($arg{y_func}) {
 188         $arg{y_func} = sub { join(" ", @_) }
 189     }
 190
 191     $self->{axis} = \%arg;
 192 }
 193
 194 sub draw_axis
 195 {
 196     my ($self) = @_;
 197     # draw axis
 198     $gd->line($self->{xmarge}, 5,
 199               $self->{xmarge}, $self->{height},
 200               $black);
 201     $gd->line($self->{xmarge}, $self->{height},
 202               $self->{width} - 5, $self->{height}, $black);
 203
 204     $gd->string(GD::Font->Small,
 205                 $self->{width} - 5,
 206                 $self->{height} + 10,
 207                 $self->{axis}->{x_title},
 208                 $black);
 209
 210     $gd->string(GD::Font->Small,
 211                 0,
 212                 10,
 213                 $self->{axis}->{y_title},
 214                 $black);
 215
 216     my $h = $self->{height} ;
 217     my $w = $self->{width}  - $self->{xmarge};
 218
 219     my $i=0;
 220     for (my $p = $self->{xmarge}; $p <= $w; $p = $p + $w/7) {
 221         $gd->string(GD::Font->Small,
 222                     $p,
 223                     $self->{height} + 10,
 224                     $self->{axis}->{x_func}($i),
 225                     $black);
 226
 227         $gd->line($p,
 228                   $self->{height} - 2,
 229                   $p,
 230                   $self->{height} + 2,
 231                   $black);
 232
 233         $i = $i + $self->{x_max}/7;
 234     }
 235
 236     $i=0;
 237     for (my $p = $h; $p >= 0; $p = $p - $h/7) {
 238         $gd->string(GD::Font->Small,
 239                     10, $p,
 240                     $self->{axis}->{y_func}($i),
 241                     $black);
 242
 243         $gd->line($self->{xmarge} - 2,
 244                   $p,
 245                   $self->{xmarge} + 2,
 246                   $p,
 247                   $black);
 248
 249         $i = $i + $self->{y_max}/7;
 250     }
 251 }
 252
 253 sub add_point
 254 {
 255     my ($self, $x_val, $y_val, $z_val, $label, $link) = @_;
 256     return unless ($x_val or $y_val or $z_val or $label);
 257
 258     if ($self->{x_max} < $x_val) {
 259         $self->{x_max} = $x_val;
 260     }
 261     if ($self->{y_max} < $y_val) {
 262         $self->{y_max} = $y_val;
 263     }
 264
 265     if ($self->{x_min} > $x_val) {
 266         $self->{x_min} = $x_val;
 267     }
 268     if ($self->{y_min} > $y_val) {
 269         $self->{y_min} = $y_val;
 270     }
 271
 272     # z will be compute after
 273     push @{$self->{data}}, [$x_val, $y_val, $z_val, $label, $link];
 274 }
 275
 276 1;
 277 __END__
 278
 279 package main ;
 280
 281 # display Mb/Gb/Kb
 282 sub human_size
 283 {
 284     my @unit = qw(B KB MB GB TB);
 285     my $val = shift || 0;
 286     my $i=0;
 287     my $format = '%i %s';
 288     while ($val / 1024 > 1) {
 289         $i++;
 290         $val /= 1024;
 291     }
 292     $format = ($i>0)?'%0.1f %s':'%i %s';
 293     return sprintf($format, $val, $unit[$i]);
 294 }
 295
 296 # display Day, Hour, Year
 297 sub human_sec
 298 {
 299     use integer;
 300
 301     my $val = shift;
 302     $val /= 60;                 # sec -> min
 303
 304     if ($val / 60 <= 1) {
 305         return "$val mins";
 306     }
 307
 308     $val /= 60;                 # min -> hour
 309     if ($val / 24 <= 1) {
 310         return "$val hours";
 311     }
 312
 313     $val /= 24;                 # hour -> day
 314     return "$val days";
 315 }
 316
 317 my $top = new GBalloon(debug => 1) ;
 318 $top->set_legend_axis(x_title => 'Time', x_func => \&human_sec,
 319                       y_title => 'Size', y_func => \&human_size,
 320                       z_title => 'Nb files');
 321
 322 $top->add_point( 13*60+56 , 3518454692 ,        6 , 'PRLISVCS_RMAN');
 323 $top->add_point( 23*60+31 , 2419151398 ,        4 , 'RHREC_BACKUP' );
 324 $top->add_point( 12*60+07 , 1373969860 ,     1044 , '3_DATA');
 325 $top->add_point( 13*60+40 , 2284109956 ,     1121 , '4_DATA');
 326 $top->add_point( 13*60+40 , 2284109956 ,     1 , '1_DATA');
 327 $top->add_point( 13*60+10 , 2284109956 ,     1 , '2_DATA');
 328 $top->add_point( 13*60+10 , 2284109956 ,     2000000 , '7_DATA');
 329
 330
 331
 332 $top->init_gd();
 333 $top->finalize() ;
 334 #$top->draw_labels() ;
 335 # make sure we are writing to a binary stream
 336 binmode STDOUT;
 337
 338 # Convert the image to PNG and print it on standard output
 339 print $gd->png;
 340
 341 print STDERR "<html><body>";
 342 print STDERR $top->get_imagemap("example", "a.png");
 343 print STDERR "</body></html>";