95th percentile line?

1 files changed, 165 insertions, 153 deletions

diff --git a/FS/FS/svc_port.pm b/FS/FS/svc_port.pm
index ad92e68f6..b5f88fda9 100644
--- a/FS/FS/svc_port.pm
+++ b/FS/FS/svc_port.pm
@@ -3,15 +3,16 @@ package FS::svc_port;
 use strict;
 use vars qw($conf $system $DEBUG $me );
 use base qw( FS::svc_Common );
+use List::Util qw(max);
+use Date::Format qw(time2str);
+use Data::Dumper;
+use GD;
+use GD::Graph;
+use GD::Graph::mixed;
 use FS::UID qw( driver_name );
 use FS::Record qw( qsearch qsearchs
                    str2time_sql str2time_sql_closing concat_sql );
 use FS::cust_svc;
-use GD::Graph;
-use GD::Graph::mixed;
-use GD;
-use Date::Format qw(time2str);
-use Data::Dumper;
 
 $DEBUG = 1;
 $me = '[FS::svc_port]';
@@ -242,171 +243,182 @@ sub _format_bandwidth {
     $value;
 }
 
+sub _percentile {
+  my $self = shift;
+  my @values = sort { $a <=> $b } @{$_[0]};
+  $values[ int(.95 * $#values) ];
+}
+
 sub graph_png {
   my($self, %opt) = @_;
   my $serviceid = $self->serviceid;
 
-  if($serviceid && $system eq 'Torrus_Internal') {
-      my $start = -1;
-      my $end = -1;
-        my $now = time;
+  return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
 
-        $start = $opt{start} if $opt{start};
-        $end = $opt{end} if $opt{end};
+  my $start = -1;
+  my $end = -1;
+  my $now = time;
 
-	$end = $now if $end > $now;
+  $start = $opt{start} if $opt{start};
+  $end = $opt{end} if $opt{end};
 
-        return 'Invalid date range' if ($start < 0 || $start >= $end 
-            || $end <= $start || $end < 0 || $end > $now || $start > $now
-            || $end-$start > 86400*366 );
+        $end = $now if $end > $now;
 
-        my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
-        $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
-        $_date = str2time_sql. $_date.  str2time_sql_closing;
+  return 'Invalid date range' if ($start < 0 || $start >= $end 
+      || $end <= $start || $end < 0 || $end > $now || $start > $now
+      || $end-$start > 86400*366 );
 
-        my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
+  my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
+  $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
+  $_date = str2time_sql. $_date.  str2time_sql_closing;
 
-        local($FS::Record::nowarn_classload) = 1;
-        my @records = qsearch({
-          'table'     => 'srvexport',
-          'select'    => "*, $_date as _date",
-          'extra_sql' => "where serviceid in $serviceid_sql
-                            and $_date >= $start
-                            and $_date <= $end",
-          'order_by'  => "order by $_date asc",
-        });
+  my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
 
-        if ( ! scalar(@records) ) {
-          warn "$me no records returned for $serviceid\n";
-          return ''; #should actually return a blank png (or, even better, the
-                     # error message in the image)
-        }
+  local($FS::Record::nowarn_classload) = 1;
+  my @records = qsearch({
+    'table'     => 'srvexport',
+    'select'    => "*, $_date as _date",
+    'extra_sql' => "where serviceid in $serviceid_sql
+                      and $_date >= $start
+                      and $_date <= $end",
+    'order_by'  => "order by $_date asc",
+  });
 
-        warn "$me ". scalar(@records). " records returned for $serviceid\n"
-          if $DEBUG;
+  if ( ! scalar(@records) ) {
+    warn "$me no records returned for $serviceid\n";
+    return ''; #should actually return a blank png (or, even better, the
+               # error message in the image)
+  }
 
-        # assume data in DB is correct,
-        # assume always _IN and _OUT pair, assume intvl = 300
+  warn "$me ". scalar(@records). " records returned for $serviceid\n"
+    if $DEBUG;
 
-        my @times;
-        my @in;
-        my @out;
-        foreach my $rec ( @records ) {
-            push @times, $rec->_date 
-                unless grep { $_ eq $rec->_date } @times;
-            push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
-            push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
-        }
+  # assume data in DB is correct,
+  # assume always _IN and _OUT pair, assume intvl = 300
 
-        my $timediff = $times[-1] - $times[0]; # they're sorted ascending
-
-        my $y_min = 999999999999; # ~1Tbps
-        my $y_max = 0;
-        my $in_sum = 0;
-        my $out_sum = 0;
-        my $in_min = 999999999999;
-        my $in_max = 0;
-        my $out_min = 999999999999;
-        my $out_max = 0;
-        foreach my $in ( @in ) {
-            $y_max = $in if $in > $y_max;
-            $y_min = $in if $in < $y_min;
-            $in_sum += $in;
-            $in_max = $in if $in > $in_max;
-            $in_min = $in if $in < $in_min;
-        }
-        foreach my $out ( @out ) {
-            $y_max = $out if $out > $y_max;
-            $y_min = $out if $out < $y_min;
-            $out_sum += $out;
-            $out_max = $out if $out > $out_max;
-            $out_min = $out if $out < $out_min;
-        }
-        my $bwdiff = $y_max - $y_min;
-        $in_min = $self->_format_bandwidth($in_min);
-        $out_min = $self->_format_bandwidth($out_min);
-        $in_max = $self->_format_bandwidth($in_max);
-        $out_max = $self->_format_bandwidth($out_max);
-        my $in_curr = $self->_format_bandwidth($in[-1]);
-        my $out_curr = $self->_format_bandwidth($out[-1]);
-        my $numsamples = scalar(@records)/2;
-        my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
-        my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
-
-      warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
-            . "in_min=$in_min out_min=$out_min in_max=$in_max "
-            . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
-            . " # records = " . scalar(@records) . "\n\ntimes:\n" 
-            . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
-            . Dumper(@out) if $DEBUG > 1;
-
-      my @data = ( \@times, \@in, \@out );
-
-      
-      # hardcoded size, colour, etc.
-
-      # don't change width/height other than through here; breaks legend otherwise
-      my $width = 600;
-      my $height = 360;
-
-      my $graph = new GD::Graph::mixed($width,$height);  
-      $graph->set(
-        types => ['area','lines'],
-        dclrs => ['green','blue'],
-        x_label => '   ',
-        x_tick_number => 'auto',
-        x_number_format => sub {
-            my $value = shift;
-            if ( $timediff < 86401 ) { # one day
-                $value = time2str("%a %H:%M",$value) 
-            } elsif ( $timediff < 86401*7 ) { # one week
-                $value = time2str("%d",$value) 
-            } elsif ( $timediff < 86401*30 ) { # one month
-                $value = time2str("Week %U",$value) 
-            } elsif ( $timediff < 86401*366 ) { # one year
-                $value = time2str("%b",$value)
-            }
-            $value;
-        },
-        y_number_format => sub {
-            my $value = shift;
-            $self->_format_bandwidth($value,1);
-        },
-	y_tick_number => 'auto',
-        y_label => 'bps',
-        legend_placement => 'BR',
-	lg_cols => 1,
-        title => $self->serviceid,
-      ) or return "can't create graph: ".$graph->error;
-      
-      $graph->set_text_clr('black') 
-        or return "can't set text colour: ".$graph->error;
-      $graph->set_legend(('In','Out')) 
-        or return "can't set legend: ".$graph->error;
-      $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
-	or return "can't set title font: ".$graph->error;
-      $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
-	or return "can't set legend font: ".$graph->error;
-      $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
-	or return "can't set font: ".$graph->error;
-      $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
-	or return "can't set font: ".$graph->error;
-      $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
-	or return "can't set font: ".$graph->error;
-
-      my $gd = $graph->plot(\@data);
-      return "graph error: ".$graph->error unless($gd);
-
-      my $black = $gd->colorAllocate(0,0,0);       
-      $gd->string(gdMediumBoldFont,50,$height-35,
-	    "Current: $in_curr   Average: $in_avg   Maximum: $in_max   Minimum: $in_min",$black);
-      $gd->string(gdMediumBoldFont,50,$height-15,
-	    "Current: $out_curr   Average: $out_avg   Maximum: $out_max   Minimum: $out_min",$black);
-
-      return $gd->png;
+  my @times;
+  my @in;
+  my @out;
+  foreach my $rec ( @records ) {
+      push @times, $rec->_date 
+          unless grep { $_ eq $rec->_date } @times;
+      push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
+      push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
   }
 
-  '';
+  my $timediff = $times[-1] - $times[0]; # they're sorted ascending
+
+  my $y_min = 999999999999; # ~1Tbps
+  my $y_max = 0;
+  my $in_sum = 0;
+  my $out_sum = 0;
+  my $in_min = 999999999999;
+  my $in_max = 0;
+  my $out_min = 999999999999;
+  my $out_max = 0;
+  foreach my $in ( @in ) {
+      $y_max = $in if $in > $y_max;
+      $y_min = $in if $in < $y_min;
+      $in_sum += $in;
+      $in_max = $in if $in > $in_max;
+      $in_min = $in if $in < $in_min;
+  }
+  foreach my $out ( @out ) {
+      $y_max = $out if $out > $y_max;
+      $y_min = $out if $out < $y_min;
+      $out_sum += $out;
+      $out_max = $out if $out > $out_max;
+      $out_min = $out if $out < $out_min;
+  }
+  my $bwdiff = $y_max - $y_min;
+  $in_min = $self->_format_bandwidth($in_min);
+  $out_min = $self->_format_bandwidth($out_min);
+  $in_max = $self->_format_bandwidth($in_max);
+  $out_max = $self->_format_bandwidth($out_max);
+  my $in_curr = $self->_format_bandwidth($in[-1]);
+  my $out_curr = $self->_format_bandwidth($out[-1]);
+  my $numsamples = scalar(@records)/2;
+  my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
+  my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
+
+  my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
+  my @percentile = ( $percentile x scalar(@in) );
+  $percentile = $self->_format_bandwidth($percentile); #for below
+
+  warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end ".
+       "in_min=$in_min out_min=$out_min in_max=$in_max ".
+       "out_max=$out_max in_avg=$in_avg out_avg=$out_avg ".
+       "percentile=$percentile ".
+       " # records = " . scalar(@records) . "\n\ntimes:\n".
+       Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n". Dumper(@out)
+    if $DEBUG > 1;
+
+  my @data = ( \@times, \@in, \@out, \@percentile );
+
+  
+  # hardcoded size, colour, etc.
+
+  #don't change width/height other than through here; breaks legend otherwise
+  my $width = 600;
+  my $height = 360;
+
+  my $graph = new GD::Graph::mixed($width,$height);  
+  $graph->set(
+    types => ['area','lines','lines'],
+    dclrs => ['green','blue','red',],
+    x_label => '   ',
+    x_tick_number => 'auto',
+    x_number_format => sub {
+        my $value = shift;
+        if ( $timediff < 86401 ) { # one day
+            $value = time2str("%a %H:%M",$value) 
+        } elsif ( $timediff < 86401*7 ) { # one week
+            $value = time2str("%d",$value) 
+        } elsif ( $timediff < 86401*30 ) { # one month
+            $value = time2str("Week %U",$value) 
+        } elsif ( $timediff < 86401*366 ) { # one year
+            $value = time2str("%b",$value)
+        }
+        $value;
+    },
+    y_number_format => sub {
+        my $value = shift;
+        $self->_format_bandwidth($value,1);
+    },
+        y_tick_number => 'auto',
+    y_label => 'bps',
+    legend_placement => 'BR',
+        lg_cols => 1,
+    title => $self->serviceid,
+  ) or return "can't create graph: ".$graph->error;
+  
+  $graph->set_text_clr('black') 
+    or return "can't set text colour: ".$graph->error;
+  $graph->set_legend(('In','Out','95th')) 
+    or return "can't set legend: ".$graph->error;
+  $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
+        or return "can't set title font: ".$graph->error;
+  $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
+        or return "can't set legend font: ".$graph->error;
+  $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
+        or return "can't set font: ".$graph->error;
+  $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
+        or return "can't set font: ".$graph->error;
+  $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
+        or return "can't set font: ".$graph->error;
+
+  my $gd = $graph->plot(\@data);
+  return "graph error: ".$graph->error unless($gd);
+
+  my $black = $gd->colorAllocate(0,0,0);       
+  $gd->string(gdMediumBoldFont,50,$height-55,
+    "Current: $in_curr   Average: $in_avg   Maximum: $in_max   Minimum: $in_min",$black);
+  $gd->string(gdMediumBoldFont,50,$height-35,
+    "Current: $out_curr   Average: $out_avg   Maximum: $out_max   Minimum: $out_min",$black);
+  $gd->string(gdMediumBoldFont,50,$height-15,
+    "95th percentile: $percentile", $black);
+
+  return $gd->png;
 }
 
 =back