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 => 0,
  61         y_max => 0,
  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]);
 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     $self->{axis} = \%arg;
 183 }
 184
 185 sub draw_axis
 186 {
 187     my ($self) = @_;
 188     # draw axis
 189     $gd->line($self->{xmarge}, 5,
 190               $self->{xmarge}, $self->{height},
 191               $black);
 192     $gd->line($self->{xmarge}, $self->{height},
 193               $self->{width} - 5, $self->{height}, $black);
 194
 195     $gd->string(GD::Font->Small,
 196                 $self->{width} - 5,
 197                 $self->{height} + 10,
 198                 $self->{axis}->{x_title},
 199                 $black);
 200
 201     $gd->string(GD::Font->Small,
 202                 0,
 203                 10,
 204                 $self->{axis}->{y_title},
 205                 $black);
 206
 207     my $h = $self->{height} ;
 208     my $w = $self->{width}  - $self->{xmarge};
 209
 210     my $i=0;
 211     for (my $p = $self->{xmarge}; $p <= $w; $p = $p + $w/7) {
 212         $gd->string(GD::Font->Small,
 213                     $p,
 214                     $self->{height} + 10,
 215                     $self->{axis}->{x_func}($i),
 216                     $black);
 217
 218         $gd->line($p,
 219                   $self->{height} - 2,
 220                   $p,
 221                   $self->{height} + 2,
 222                   $black);
 223
 224         $i = $i + $self->{x_max}/7;
 225     }
 226
 227     $i=0;
 228     for (my $p = $h; $p >= 0; $p = $p - $h/7) {
 229         $gd->string(GD::Font->Small,
 230                     10, $p,
 231                     $self->{axis}->{y_func}($i),
 232                     $black);
 233
 234         $gd->line($self->{xmarge} - 2,
 235                   $p,
 236                   $self->{xmarge} + 2,
 237                   $p,
 238                   $black);
 239
 240         $i = $i + $self->{y_max}/7;
 241     }
 242 }
 243
 244 sub add_point
 245 {
 246     my ($self, $x_val, $y_val, $z_val, $label, $link) = @_;
 247     return unless ($x_val or $y_val or $z_val or $label);
 248
 249     if ($self->{x_max} < $x_val) {
 250         $self->{x_max} = $x_val;
 251     }
 252     if ($self->{y_max} < $y_val) {
 253         $self->{y_max} = $y_val;
 254     }
 255
 256     if ($self->{x_min} > $x_val) {
 257         $self->{x_min} = $x_val;
 258     }
 259     if ($self->{y_min} > $y_val) {
 260         $self->{y_min} = $y_val;
 261     }
 262
 263     # z will be compute after
 264     push @{$self->{data}}, [$x_val, $y_val, $z_val, $label, $link];
 265 }
 266
 267 1;
 268 __END__
 269
 270 package main ;
 271
 272 # display Mb/Gb/Kb
 273 sub human_size
 274 {
 275     my @unit = qw(B KB MB GB TB);
 276     my $val = shift || 0;
 277     my $i=0;
 278     my $format = '%i %s';
 279     while ($val / 1024 > 1) {
 280         $i++;
 281         $val /= 1024;
 282     }
 283     $format = ($i>0)?'%0.1f %s':'%i %s';
 284     return sprintf($format, $val, $unit[$i]);
 285 }
 286
 287 # display Day, Hour, Year
 288 sub human_sec
 289 {
 290     use integer;
 291
 292     my $val = shift;
 293     $val /= 60;                 # sec -> min
 294
 295     if ($val / 60 <= 1) {
 296         return "$val mins";
 297     }
 298
 299     $val /= 60;                 # min -> hour
 300     if ($val / 24 <= 1) {
 301         return "$val hours";
 302     }
 303
 304     $val /= 24;                 # hour -> day
 305     return "$val days";
 306 }
 307
 308 my $top = new GBalloon(debug => 1) ;
 309 $top->set_legend_axis(x_title => 'Time', x_func => \&human_sec,
 310                       y_title => 'Size', y_func => \&human_size,
 311                       z_title => 'Nb files');
 312
 313 $top->add_point( 13*60+56 , 3518454692 ,        6 , 'PRLISVCS_RMAN');
 314 $top->add_point( 23*60+31 , 2419151398 ,        4 , 'RHREC_BACKUP' );
 315 $top->add_point( 12*60+07 , 1373969860 ,     1044 , '3_DATA');
 316 $top->add_point( 13*60+40 , 2284109956 ,     1121 , '4_DATA');
 317 $top->add_point( 13*60+40 , 2284109956 ,     1 , '1_DATA');
 318 $top->add_point( 13*60+10 , 2284109956 ,     1 , '2_DATA');
 319 $top->add_point( 13*60+10 , 2284109956 ,     2000000 , '7_DATA');
 320
 321
 322
 323 $top->init_gd();
 324 $top->finalize() ;
 325 #$top->draw_labels() ;
 326 # make sure we are writing to a binary stream
 327 binmode STDOUT;
 328
 329 # Convert the image to PNG and print it on standard output
 330 print $gd->png;
 331
 332 print STDERR "<html><body>";
 333 print STDERR $top->get_imagemap("example", "a.png");
 334 print STDERR "</body></html>";