4 use vars qw($conf $system $DEBUG $me );
5 use base qw( FS::svc_Common );
6 use List::Util qw(max);
7 use Date::Format qw(time2str);
12 use FS::UID qw( driver_name );
13 use FS::Record qw( qsearch qsearchs
14 str2time_sql str2time_sql_closing concat_sql );
18 $me = '[FS::svc_port]';
20 FS::UID->install_callback( sub {
22 $system = $conf->config('network_monitoring_system');
27 FS::svc_port - Object methods for svc_port records
33 $record = new FS::svc_port \%hash;
34 $record = new FS::svc_port { 'column' => 'value' };
36 $error = $record->insert;
38 $error = $new_record->replace($old_record);
40 $error = $record->delete;
42 $error = $record->check;
44 $error = $record->suspend;
46 $error = $record->unsuspend;
48 $error = $record->cancel;
52 An FS::svc_port object represents a router port. FS::table_name inherits from
53 FS::svc_Common. The following fields are currently supported:
59 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
69 Creates a new port. To add the port to the database, see L<"insert">.
71 Note that this stores the hash reference, not a distinct copy of the hash it
72 points to. You can ask the object for a copy with the I<hash> method.
76 sub table { 'svc_port'; }
81 #'name_plural' => 'Ports', #optional,
82 #'longname_plural' => 'Ports', #optional
83 'sorts' => [ 'svcnum', 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
84 'display_weight' => 75,
85 'cancel_weight' => 10,
87 'serviceid' => 'Torrus serviceid',
92 =item search_sql STRING
94 Class method which returns an SQL fragment to search for the given string.
98 #or something more complicated if necessary
100 my($class, $string) = @_;
101 $class->search_sql_field('serviceid', $string);
106 Returns a meaningful identifier for this port
112 $self->serviceid; #or something more complicated if necessary
117 Adds this record to the database. If there is an error, returns the error,
118 otherwise returns false.
120 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
121 defined. An FS::cust_svc record will be created and inserted.
129 $error = $self->SUPER::insert;
130 return $error if $error;
137 Delete this record from the database.
145 $error = $self->SUPER::delete;
146 return $error if $error;
152 =item replace OLD_RECORD
154 Replaces the OLD_RECORD with this one in the database. If there is an error,
155 returns the error, otherwise returns false.
160 my ( $new, $old ) = ( shift, shift );
163 $error = $new->SUPER::replace($old);
164 return $error if $error;
171 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
175 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
179 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
183 Checks all fields to make sure this is a valid port. If there is
184 an error, returns the error, otherwise returns false. Called by the insert
192 my $x = $self->setfixed;
193 return $x unless ref($x);
196 my $error = $self->ut_textn('serviceid'); #too lenient?
197 return $error if $error;
204 Returns a PNG graph for this port.
206 The following options must be specified:
217 sub _format_bandwidth {
221 $space = ' ' if $space;
225 warn "$me _format_bandwidth $value" if $DEBUG > 1;
227 if ( $value >= 1000 && $value < 1000000 ) {
228 $value = ($value/1000);
229 $suffix = $space. "k";
231 elsif( $value >= 1000000 && $value < 1000000000 ) {
232 $value = ($value/1000/1000);
233 $suffix = $space . "M";
235 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
236 $value = ($value/1000/1000/1000);
237 $suffix = $space . "G";
239 # and hopefully we don't have folks doing Tbps on a single port :)
241 $value = sprintf("%6.2f$suffix",$value) if $value >= 0;
248 my @values = sort { $a <=> $b } @{$_[0]};
249 $values[ int(.95 * $#values) ];
253 my($self, %opt) = @_;
254 my $serviceid = $self->serviceid;
256 return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
262 $start = $opt{start} if $opt{start};
263 $end = $opt{end} if $opt{end};
265 $end = $now if $end > $now;
267 return 'Invalid date range' if ($start < 0 || $start >= $end
268 || $end <= $start || $end < 0 || $end > $now || $start > $now
269 || $end-$start > 86400*366 );
271 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
272 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
273 $_date = str2time_sql. $_date. str2time_sql_closing;
275 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
277 local($FS::Record::nowarn_classload) = 1;
278 my @records = qsearch({
279 'table' => 'srvexport',
280 'select' => "*, $_date as _date",
281 'extra_sql' => "where serviceid in $serviceid_sql
284 'order_by' => "order by $_date asc",
287 if ( ! scalar(@records) ) {
288 warn "$me no records returned for $serviceid\n";
289 return ''; #should actually return a blank png (or, even better, the
290 # error message in the image)
293 warn "$me ". scalar(@records). " records returned for $serviceid\n"
296 # assume data in DB is correct,
297 # assume always _IN and _OUT pair, assume intvl = 300
302 foreach my $rec ( @records ) {
303 push @times, $rec->_date
304 unless grep { $_ eq $rec->_date } @times;
305 push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
306 push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
309 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
311 my $y_min = 999999999999; # ~1Tbps
315 my $in_min = 999999999999;
317 my $out_min = 999999999999;
319 foreach my $in ( @in ) {
320 $y_max = $in if $in > $y_max;
321 $y_min = $in if $in < $y_min;
323 $in_max = $in if $in > $in_max;
324 $in_min = $in if $in < $in_min;
326 foreach my $out ( @out ) {
327 $y_max = $out if $out > $y_max;
328 $y_min = $out if $out < $y_min;
330 $out_max = $out if $out > $out_max;
331 $out_min = $out if $out < $out_min;
333 my $bwdiff = $y_max - $y_min;
334 $in_min = $self->_format_bandwidth($in_min);
335 $out_min = $self->_format_bandwidth($out_min);
336 $in_max = $self->_format_bandwidth($in_max);
337 $out_max = $self->_format_bandwidth($out_max);
338 my $in_curr = $self->_format_bandwidth($in[-1]);
339 my $out_curr = $self->_format_bandwidth($out[-1]);
340 my $numsamples = scalar(@records)/2;
341 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
342 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
344 my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
345 my @percentile = map $percentile, @in;
346 $percentile = $self->_format_bandwidth($percentile); #for below
348 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end ".
349 "in_min=$in_min out_min=$out_min in_max=$in_max ".
350 "out_max=$out_max in_avg=$in_avg out_avg=$out_avg ".
351 "percentile=$percentile ".
352 " # records = " . scalar(@records) . "\n\ntimes:\n".
353 Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n". Dumper(@out)
356 my @data = ( \@times, \@in, \@out, \@percentile );
359 # hardcoded size, colour, etc.
361 #don't change width/height other than through here; breaks legend otherwise
365 my $graph = new GD::Graph::mixed($width,$height);
367 types => ['area','lines','lines'],
368 dclrs => ['green','blue','red',],
370 x_tick_number => 'auto',
371 x_number_format => sub {
373 if ( $timediff < 86401 ) { # one day
374 $value = time2str("%a %H:%M",$value)
375 } elsif ( $timediff < 86401*7 ) { # one week
376 $value = time2str("%d",$value)
377 } elsif ( $timediff < 86401*30 ) { # one month
378 $value = time2str("Week %U",$value)
379 } elsif ( $timediff < 86401*366 ) { # one year
380 $value = time2str("%b",$value)
384 y_number_format => sub {
386 $self->_format_bandwidth($value,1);
388 y_tick_number => 'auto',
390 legend_placement => 'BR',
392 title => $self->serviceid,
393 ) or return "can't create graph: ".$graph->error;
395 $graph->set_text_clr('black')
396 or return "can't set text colour: ".$graph->error;
397 $graph->set_legend(('In','Out','95th'))
398 or return "can't set legend: ".$graph->error;
399 $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
400 or return "can't set title font: ".$graph->error;
401 $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
402 or return "can't set legend font: ".$graph->error;
403 $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
404 or return "can't set font: ".$graph->error;
405 $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
406 or return "can't set font: ".$graph->error;
407 $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
408 or return "can't set font: ".$graph->error;
410 my $gd = $graph->plot(\@data);
411 return "graph error: ".$graph->error unless($gd);
413 my $black = $gd->colorAllocate(0,0,0);
414 $gd->string(gdMediumBoldFont,50,$height-55,
415 "Current:$in_curr Average:$in_avg Maximum:$in_max Minimum:$in_min",$black);
416 $gd->string(gdMediumBoldFont,50,$height-35,
417 "Current:$out_curr Average:$out_avg Maximum:$out_max Minimum:$out_min",$black);
418 $gd->string(gdMediumBoldFont,50,$height-15,
419 "95th percentile:$percentile", $black);
430 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
431 L<FS::cust_pkg>, schema.html from the base documentation.