From 69ca9d73711e89661a929f5f98d62b605a437354 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 23 Apr 2014 00:11:22 -0700 Subject: [PATCH] svc_broadband torrus, RT#14133 --- FS/FS/Schema.pm | 1 + FS/FS/svc_Torrus_Mixin.pm | 275 ++++++++++++++++++++++++++++++++++++++++++++++ FS/FS/svc_broadband.pm | 5 +- FS/FS/svc_port.pm | 247 +---------------------------------------- FS/MANIFEST | 1 + 5 files changed, 286 insertions(+), 243 deletions(-) create mode 100644 FS/FS/svc_Torrus_Mixin.pm diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 9804008ba..f2256587a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -3130,6 +3130,7 @@ sub tables_hashref { 'rssi', 'int', 'NULL', '', '', '', 'suid', 'int', 'NULL', '', '', '', 'shared_svcnum', 'int', 'NULL', '', '', '', + 'serviceid', 'varchar', 'NULL', 64, '', '',#srvexport/reportfields ], 'primary_key' => 'svcnum', 'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ], diff --git a/FS/FS/svc_Torrus_Mixin.pm b/FS/FS/svc_Torrus_Mixin.pm new file mode 100644 index 000000000..21e635fc0 --- /dev/null +++ b/FS/FS/svc_Torrus_Mixin.pm @@ -0,0 +1,275 @@ +package FS::svc_Torrus_Mixin; + +use strict; +use vars qw($conf $system $DEBUG $me ); +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 str2time_sql str2time_sql_closing concat_sql ); + +$DEBUG = 1; +$me = '[FS::svc_Torrus_Mixin]'; + +FS::UID->install_callback( sub { + $conf = new FS::Conf; + $system = $conf->config('network_monitoring_system'); +} ); + +=head1 NAME + +FS::svc_Torrus_Mixin - Mixin class for svc_classes with a Torrus serviceid field + +=head1 SYNOPSIS + +package FS::svc_table; +use base qw( FS::svc_Torrus_Mixin FS::svc_Common ); + +=head1 DESCRIPTION + +This is a mixin class for svc_ classes that contain a serviceid field linking +to the torrus srvexport / reportfields tables. + +=head1 METHODS + +=over 4 + +=item graph_png + +Returns a PNG graph for this port. + +The following options must be specified: + +=over 4 + +=item start +=item end + +=back + +=cut + +sub _format_bandwidth { + my $self = shift; + my $value = shift; + my $space = shift; + $space = ' ' if $space; + + my $suffix = ''; + + warn "$me _format_bandwidth $value" if $DEBUG > 1; + + if ( $value >= 1000 && $value < 1000000 ) { + $value = ($value/1000); + $suffix = $space. "k"; + } + elsif( $value >= 1000000 && $value < 1000000000 ) { + $value = ($value/1000/1000); + $suffix = $space . "M"; + } + elsif( $value >= 1000000000 && $value < 1000000000000 ) { + $value = ($value/1000/1000/1000); + $suffix = $space . "G"; + } + # and hopefully we don't have folks doing Tbps on a single port :) + + $value = sprintf("%6.2f$suffix",$value) if $value >= 0; + + $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; + + return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png? + + my $start = -1; + my $end = -1; + my $now = time; + + $start = $opt{start} if $opt{start}; + $end = $opt{end} if $opt{end}; + + $end = $now if $end > $now; + + return 'Invalid date range' if ($start < 0 || $start >= $end + || $end <= $start || $end < 0 || $end > $now || $start > $now + || $end-$start > 86400*366 ); + + 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; + + my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')"; + + 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", + }); + + 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) + } + + warn "$me ". scalar(@records). " records returned for $serviceid\n" + if $DEBUG; + + # assume data in DB is correct, + # assume always _IN and _OUT pair, assume intvl = 300 + + 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 = map $percentile, @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 + +=head1 BUGS + +=head1 SEE ALSO + +L, L, Torrus documentation + +=cut + +1; + + diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index b9c89cef7..40f2c9b2d 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -2,10 +2,11 @@ package FS::svc_broadband; use base qw( FS::svc_Radius_Mixin FS::svc_Tower_Mixin + FS::svc_Torrus_Mixin FS::svc_IP_Mixin FS::svc_MAC_Mixin FS::svc_Common - ); +); use strict; use vars qw($conf); @@ -144,6 +145,7 @@ sub table_info { type => 'search-svc_broadband', disable_inventory => 1, }, + 'serviceid' => 'Torrus serviceid', #but is should be hidden }, }; } @@ -363,6 +365,7 @@ sub check { || $self->ut_snumbern('rssi') || $self->ut_numbern('suid') || $self->ut_foreign_keyn('shared_svcnum', 'svc_broadband', 'svcnum') + || $self->ut_textn('serviceid') #too lenient? ; return $error if $error; diff --git a/FS/FS/svc_port.pm b/FS/FS/svc_port.pm index 4e74661fb..9d2dae8c8 100644 --- a/FS/FS/svc_port.pm +++ b/FS/FS/svc_port.pm @@ -1,26 +1,11 @@ package FS::svc_port; +use base qw( FS::svc_Torrus_Mixin FS::svc_Common ); 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; - -$DEBUG = 1; -$me = '[FS::svc_port]'; - -FS::UID->install_callback( sub { - $conf = new FS::Conf; - $system = $conf->config('network_monitoring_system'); -} ); +#use vars qw( $DEBUG $me ); + +#$DEBUG = 0; +#$me = '[FS::svc_port]'; =head1 NAME @@ -201,228 +186,6 @@ sub check { $self->SUPER::check; } -=item graph_png - -Returns a PNG graph for this port. - -The following options must be specified: - -=over 4 - -=item start -=item end - -=back - -=cut - -sub _format_bandwidth { - my $self = shift; - my $value = shift; - my $space = shift; - $space = ' ' if $space; - - my $suffix = ''; - - warn "$me _format_bandwidth $value" if $DEBUG > 1; - - if ( $value >= 1000 && $value < 1000000 ) { - $value = ($value/1000); - $suffix = $space. "k"; - } - elsif( $value >= 1000000 && $value < 1000000000 ) { - $value = ($value/1000/1000); - $suffix = $space . "M"; - } - elsif( $value >= 1000000000 && $value < 1000000000000 ) { - $value = ($value/1000/1000/1000); - $suffix = $space . "G"; - } - # and hopefully we don't have folks doing Tbps on a single port :) - - $value = sprintf("%6.2f$suffix",$value) if $value >= 0; - - $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; - - return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png? - - my $start = -1; - my $end = -1; - my $now = time; - - $start = $opt{start} if $opt{start}; - $end = $opt{end} if $opt{end}; - - $end = $now if $end > $now; - - return 'Invalid date range' if ($start < 0 || $start >= $end - || $end <= $start || $end < 0 || $end > $now || $start > $now - || $end-$start > 86400*366 ); - - 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; - - my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')"; - - 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", - }); - - 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) - } - - warn "$me ". scalar(@records). " records returned for $serviceid\n" - if $DEBUG; - - # assume data in DB is correct, - # assume always _IN and _OUT pair, assume intvl = 300 - - 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 = map $percentile, @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 =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 250f46452..92369e353 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -733,3 +733,4 @@ FS/sched_item.pm t/sched_item.t FS/sched_avail.pm t/sched_avail.t +FS/svc_Torrus_Mixin.pm -- 2.11.0