1 package FS::svc_Torrus_Mixin;
4 use vars qw($conf $system $DEBUG $me );
5 use List::Util qw(max);
6 use Date::Format qw(time2str);
11 use FS::UID qw( driver_name );
12 use FS::Record qw( qsearch str2time_sql str2time_sql_closing concat_sql );
15 $me = '[FS::svc_Torrus_Mixin]';
17 FS::UID->install_callback( sub {
19 $system = $conf->config('network_monitoring_system');
24 FS::svc_Torrus_Mixin - Mixin class for svc_classes with a Torrus serviceid field
28 package FS::svc_table;
29 use base qw( FS::svc_Torrus_Mixin FS::svc_Common );
33 This is a mixin class for svc_ classes that contain a serviceid field linking
34 to the torrus srvexport / reportfields tables.
42 Returns a PNG graph for this port.
44 The following options must be specified:
55 sub _format_bandwidth {
59 $space = ' ' if $space;
63 warn "$me _format_bandwidth $value" if $DEBUG > 1;
65 if ( $value >= 1000 && $value < 1000000 ) {
66 $value = ($value/1000);
67 $suffix = $space. "k";
69 elsif( $value >= 1000000 && $value < 1000000000 ) {
70 $value = ($value/1000/1000);
71 $suffix = $space . "M";
73 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
74 $value = ($value/1000/1000/1000);
75 $suffix = $space . "G";
77 # and hopefully we don't have folks doing Tbps on a single port :)
79 $value = sprintf("%6.2f$suffix",$value) if $value >= 0;
86 my @values = sort { $a <=> $b } @{$_[0]};
87 $values[ int(.95 * $#values) ];
92 my $serviceid = $self->serviceid;
94 return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
100 $start = $opt{start} if $opt{start};
101 $end = $opt{end} if $opt{end};
103 $end = $now if $end > $now;
105 return 'Invalid date range' if ($start < 0 || $start >= $end
106 || $end <= $start || $end < 0 || $end > $now || $start > $now
107 || $end-$start > 86400*366 );
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;
113 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
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
122 'order_by' => "order by $_date asc",
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)
131 warn "$me ". scalar(@records). " records returned for $serviceid\n"
134 # assume data in DB is correct,
135 # assume always _IN and _OUT pair, assume intvl = 300
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$/;
147 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
149 my $y_min = 999999999999; # ~1Tbps
153 my $in_min = 999999999999;
155 my $out_min = 999999999999;
157 foreach my $in ( @in ) {
158 $y_max = $in if $in > $y_max;
159 $y_min = $in if $in < $y_min;
161 $in_max = $in if $in > $in_max;
162 $in_min = $in if $in < $in_min;
164 foreach my $out ( @out ) {
165 $y_max = $out if $out > $y_max;
166 $y_min = $out if $out < $y_min;
168 $out_max = $out if $out > $out_max;
169 $out_min = $out if $out < $out_min;
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);
182 my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
183 my @percentile = map $percentile, @in;
184 $percentile = $self->_format_bandwidth($percentile); #for below
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)
194 my @data = ( \@times, \@in, \@out, \@percentile );
197 # hardcoded size, colour, etc.
199 #don't change width/height other than through here; breaks legend otherwise
203 my $graph = new GD::Graph::mixed($width,$height);
205 types => ['area','lines','lines'],
206 dclrs => ['green','blue','red',],
208 x_tick_number => 'auto',
209 x_number_format => sub {
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)
222 y_number_format => sub {
224 $self->_format_bandwidth($value,1);
226 y_tick_number => 'auto',
228 legend_placement => 'BR',
230 title => $self->serviceid,
231 ) or return "can't create graph: ".$graph->error;
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;
248 my $gd = $graph->plot(\@data);
249 return "graph error: ".$graph->error unless($gd);
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);
269 L<FS::svc_port>, L<FS::svc_broadband>, Torrus documentation