FS/FS/svc_Torrus_Mixin.pm

   1 package FS::svc_Torrus_Mixin;
   2
   3 use strict;
   4 use vars qw($conf $system $DEBUG $me );
   5 use List::Util qw(max);
   6 use Date::Format qw(time2str);
   7 use Data::Dumper;
   8 use GD;
   9 use GD::Graph;
  10 use GD::Graph::mixed;
  11 use FS::UID qw( driver_name );
  12 use FS::Record qw( qsearch str2time_sql str2time_sql_closing concat_sql );
  13
  14 $DEBUG = 1;
  15 $me = '[FS::svc_Torrus_Mixin]';
  16
  17 FS::UID->install_callback( sub {
  18   $conf = new FS::Conf;
  19   $system = $conf->config('network_monitoring_system');
  20 } );
  21
  22 =head1 NAME
  23
  24 FS::svc_Torrus_Mixin - Mixin class for svc_classes with a Torrus serviceid field
  25
  26 =head1 SYNOPSIS
  27
  28 package FS::svc_table;
  29 use base qw( FS::svc_Torrus_Mixin FS::svc_Common );
  30
  31 =head1 DESCRIPTION
  32
  33 This is a mixin class for svc_ classes that contain a serviceid field linking
  34 to the torrus srvexport / reportfields tables.
  35
  36 =head1 METHODS
  37
  38 =over 4
  39
  40 =item graph_png
  41
  42 Returns a PNG graph for this port.
  43
  44 The following options must be specified:
  45
  46 =over 4
  47
  48 =item start
  49 =item end
  50
  51 =back
  52
  53 =cut
  54
  55 sub _format_bandwidth {
  56     my $self = shift;
  57     my $value = shift;
  58     my $space = shift;
  59     $space = ' ' if $space;
  60
  61     my $suffix = '';
  62
  63     warn "$me _format_bandwidth $value" if $DEBUG > 1;
  64
  65     if ( $value >= 1000 && $value < 1000000 ) {
  66         $value = ($value/1000);
  67         $suffix = $space. "k";
  68     }
  69     elsif( $value >= 1000000 && $value < 1000000000 ) {
  70         $value = ($value/1000/1000);
  71         $suffix = $space . "M";
  72     }
  73     elsif( $value >= 1000000000 && $value < 1000000000000 ) {
  74         $value = ($value/1000/1000/1000);
  75         $suffix = $space . "G";
  76     }
  77     # and hopefully we don't have folks doing Tbps on a single port :)
  78
  79     $value = sprintf("%6.2f$suffix",$value) if $value >= 0;
  80
  81     $value;
  82 }
  83
  84 sub _percentile {
  85   my $self = shift;
  86   my @values = sort { $a <=> $b } @{$_[0]};
  87   $values[ int(.95 * $#values) ];
  88 }
  89
  90 sub graph_png {
  91   my($self, %opt) = @_;
  92   my $serviceid = $self->serviceid;
  93
  94   return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
  95
  96   my $start = -1;
  97   my $end = -1;
  98   my $now = time;
  99
 100   $start = $opt{start} if $opt{start};
 101   $end = $opt{end} if $opt{end};
 102
 103         $end = $now if $end > $now;
 104
 105   return 'Invalid date range' if ($start < 0 || $start >= $end
 106       || $end <= $start || $end < 0 || $end > $now || $start > $now
 107       || $end-$start > 86400*366 );
 108
 109   my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
 110   $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
 111   $_date = str2time_sql. $_date.  str2time_sql_closing;
 112
 113   my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
 114
 115   local($FS::Record::nowarn_classload) = 1;
 116   my @records = qsearch({
 117     'table'     => 'srvexport',
 118     'select'    => "*, $_date as _date",
 119     'extra_sql' => "where serviceid in $serviceid_sql
 120                       and $_date >= $start
 121                       and $_date <= $end",
 122     'order_by'  => "order by $_date asc",
 123   });
 124
 125   if ( ! scalar(@records) ) {
 126     warn "$me no records returned for $serviceid\n";
 127     return ''; #should actually return a blank png (or, even better, the
 128                # error message in the image)
 129   }
 130
 131   warn "$me ". scalar(@records). " records returned for $serviceid\n"
 132     if $DEBUG;
 133
 134   # assume data in DB is correct,
 135   # assume always _IN and _OUT pair, assume intvl = 300
 136
 137   my @times;
 138   my @in;
 139   my @out;
 140   foreach my $rec ( @records ) {
 141       push @times, $rec->_date
 142           unless grep { $_ eq $rec->_date } @times;
 143       push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
 144       push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
 145   }
 146
 147   my $timediff = $times[-1] - $times[0]; # they're sorted ascending
 148
 149   my $y_min = 999999999999; # ~1Tbps
 150   my $y_max = 0;
 151   my $in_sum = 0;
 152   my $out_sum = 0;
 153   my $in_min = 999999999999;
 154   my $in_max = 0;
 155   my $out_min = 999999999999;
 156   my $out_max = 0;
 157   foreach my $in ( @in ) {
 158       $y_max = $in if $in > $y_max;
 159       $y_min = $in if $in < $y_min;
 160       $in_sum += $in;
 161       $in_max = $in if $in > $in_max;
 162       $in_min = $in if $in < $in_min;
 163   }
 164   foreach my $out ( @out ) {
 165       $y_max = $out if $out > $y_max;
 166       $y_min = $out if $out < $y_min;
 167       $out_sum += $out;
 168       $out_max = $out if $out > $out_max;
 169       $out_min = $out if $out < $out_min;
 170   }
 171   my $bwdiff = $y_max - $y_min;
 172   $in_min = $self->_format_bandwidth($in_min);
 173   $out_min = $self->_format_bandwidth($out_min);
 174   $in_max = $self->_format_bandwidth($in_max);
 175   $out_max = $self->_format_bandwidth($out_max);
 176   my $in_curr = $self->_format_bandwidth($in[-1]);
 177   my $out_curr = $self->_format_bandwidth($out[-1]);
 178   my $numsamples = scalar(@records)/2;
 179   my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
 180   my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
 181
 182   my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
 183   my @percentile = map $percentile, @in;
 184   $percentile = $self->_format_bandwidth($percentile); #for below
 185
 186   warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end ".
 187        "in_min=$in_min out_min=$out_min in_max=$in_max ".
 188        "out_max=$out_max in_avg=$in_avg out_avg=$out_avg ".
 189        "percentile=$percentile ".
 190        " # records = " . scalar(@records) . "\n\ntimes:\n".
 191        Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n". Dumper(@out)
 192     if $DEBUG > 1;
 193
 194   my @data = ( \@times, \@in, \@out, \@percentile );
 195
 196
 197   # hardcoded size, colour, etc.
 198
 199   #don't change width/height other than through here; breaks legend otherwise
 200   my $width = 600;
 201   my $height = 360;
 202
 203   my $graph = new GD::Graph::mixed($width,$height);
 204   $graph->set(
 205     types => ['area','lines','lines'],
 206     dclrs => ['green','blue','red',],
 207     x_label => '   ',
 208     x_tick_number => 'auto',
 209     x_number_format => sub {
 210         my $value = shift;
 211         if ( $timediff < 86401 ) { # one day
 212             $value = time2str("%a %H:%M",$value)
 213         } elsif ( $timediff < 86401*7 ) { # one week
 214             $value = time2str("%d",$value)
 215         } elsif ( $timediff < 86401*30 ) { # one month
 216             $value = time2str("Week %U",$value)
 217         } elsif ( $timediff < 86401*366 ) { # one year
 218             $value = time2str("%b",$value)
 219         }
 220         $value;
 221     },
 222     y_number_format => sub {
 223         my $value = shift;
 224         $self->_format_bandwidth($value,1);
 225     },
 226         y_tick_number => 'auto',
 227     y_label => 'bps',
 228     legend_placement => 'BR',
 229         lg_cols => 1,
 230     title => $self->serviceid,
 231   ) or return "can't create graph: ".$graph->error;
 232
 233   $graph->set_text_clr('black')
 234     or return "can't set text colour: ".$graph->error;
 235   $graph->set_legend(('In','Out','95th'))
 236     or return "can't set legend: ".$graph->error;
 237   $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
 238         or return "can't set title font: ".$graph->error;
 239   $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
 240         or return "can't set legend font: ".$graph->error;
 241   $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
 242         or return "can't set font: ".$graph->error;
 243   $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
 244         or return "can't set font: ".$graph->error;
 245   $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
 246         or return "can't set font: ".$graph->error;
 247
 248   my $gd = $graph->plot(\@data);
 249   return "graph error: ".$graph->error unless($gd);
 250
 251   my $black = $gd->colorAllocate(0,0,0);
 252   $gd->string(gdMediumBoldFont,50,$height-55,
 253     "Current:$in_curr   Average:$in_avg   Maximum:$in_max   Minimum:$in_min",$black);
 254   $gd->string(gdMediumBoldFont,50,$height-35,
 255     "Current:$out_curr   Average:$out_avg   Maximum:$out_max   Minimum:$out_min",$black);
 256   $gd->string(gdMediumBoldFont,50,$height-15,
 257     "95th percentile:$percentile", $black);
 258
 259   return $gd->png;
 260 }
 261
 262
 263 =back
 264
 265 =head1 BUGS
 266
 267 =head1 SEE ALSO
 268
 269 L<FS::svc_port>, L<FS::svc_broadband>, Torrus documentation
 270
 271 =cut
 272
 273 1;
 274
 275