'rssi', 'int', 'NULL', '', '', '',
'suid', 'int', 'NULL', '', '', '',
'shared_svcnum', 'int', 'NULL', '', '', '',
+ 'serviceid', 'varchar', 'NULL', 64, '', '',#srvexport/reportfields
],
'primary_key' => 'svcnum',
'unique' => [ [ 'ip_addr' ], [ 'mac_addr' ] ],
--- /dev/null
+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<FS::svc_port>, L<FS::svc_broadband>, Torrus documentation
+
+=cut
+
+1;
+
+
use base qw(
FS::svc_Radius_Mixin
FS::svc_Tower_Mixin
+ FS::svc_Torrus_Mixin
FS::svc_IP_Mixin
FS::MAC_Mixin
FS::svc_Common
- );
+);
use strict;
use vars qw($conf);
type => 'search-svc_broadband',
disable_inventory => 1,
},
+ 'serviceid' => 'Torrus serviceid', #but is should be hidden
},
};
}
|| $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;
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
$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
t/sched_item.t
FS/sched_avail.pm
t/sched_avail.t
+FS/svc_Torrus_Mixin.pm
projects / freeside.git / commitdiff