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 'sorts' => [ 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
85 'display_weight' => 75,
86 'cancel_weight' => 10,
88 'serviceid' => 'Torrus serviceid',
93 =item search_sql STRING
95 Class method which returns an SQL fragment to search for the given string.
99 #or something more complicated if necessary
101 my($class, $string) = @_;
102 $class->search_sql_field('serviceid', $string);
107 Returns a meaningful identifier for this port
113 $self->serviceid; #or something more complicated if necessary
118 Adds this record to the database. If there is an error, returns the error,
119 otherwise returns false.
121 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
122 defined. An FS::cust_svc record will be created and inserted.
130 $error = $self->SUPER::insert;
131 return $error if $error;
138 Delete this record from the database.
146 $error = $self->SUPER::delete;
147 return $error if $error;
153 =item replace OLD_RECORD
155 Replaces the OLD_RECORD with this one in the database. If there is an error,
156 returns the error, otherwise returns false.
161 my ( $new, $old ) = ( shift, shift );
164 $error = $new->SUPER::replace($old);
165 return $error if $error;
172 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
176 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
180 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
184 Checks all fields to make sure this is a valid port. If there is
185 an error, returns the error, otherwise returns false. Called by the insert
193 my $x = $self->setfixed;
194 return $x unless ref($x);
197 my $error = $self->ut_textn('serviceid'); #too lenient?
198 return $error if $error;
205 Returns a PNG graph for this port.
207 The following options must be specified:
218 sub _format_bandwidth {
222 $space = ' ' if $space;
226 warn "$me _format_bandwidth $value" if $DEBUG > 1;
228 if ( $value >= 1000 && $value < 1000000 ) {
229 $value = ($value/1000);
230 $suffix = $space. "k";
232 elsif( $value >= 1000000 && $value < 1000000000 ) {
233 $value = ($value/1000/1000);
234 $suffix = $space . "M";
236 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
237 $value = ($value/1000/1000/1000);
238 $suffix = $space . "G";
240 # and hopefully we don't have folks doing Tbps on a single port :)
242 $value = sprintf("%6.2f$suffix",$value) if $value >= 0;
249 my @values = sort { $a <=> $b } @{$_[0]};
250 $values[ int(.95 * $#values) ];
254 my($self, %opt) = @_;
255 my $serviceid = $self->serviceid;
257 return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
263 $start = $opt{start} if $opt{start};
264 $end = $opt{end} if $opt{end};
266 $end = $now if $end > $now;
268 return 'Invalid date range' if ($start < 0 || $start >= $end
269 || $end <= $start || $end < 0 || $end > $now || $start > $now
270 || $end-$start > 86400*366 );
272 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
273 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
274 $_date = str2time_sql. $_date. str2time_sql_closing;
276 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
278 local($FS::Record::nowarn_classload) = 1;
279 my @records = qsearch({
280 'table' => 'srvexport',
281 'select' => "*, $_date as _date",
282 'extra_sql' => "where serviceid in $serviceid_sql
285 'order_by' => "order by $_date asc",
288 if ( ! scalar(@records) ) {
289 warn "$me no records returned for $serviceid\n";
290 return ''; #should actually return a blank png (or, even better, the
291 # error message in the image)
294 warn "$me ". scalar(@records). " records returned for $serviceid\n"
297 # assume data in DB is correct,
298 # assume always _IN and _OUT pair, assume intvl = 300
303 foreach my $rec ( @records ) {
304 push @times, $rec->_date
305 unless grep { $_ eq $rec->_date } @times;
306 push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
307 push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
310 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
312 my $y_min = 999999999999; # ~1Tbps
316 my $in_min = 999999999999;
318 my $out_min = 999999999999;
320 foreach my $in ( @in ) {
321 $y_max = $in if $in > $y_max;
322 $y_min = $in if $in < $y_min;
324 $in_max = $in if $in > $in_max;
325 $in_min = $in if $in < $in_min;
327 foreach my $out ( @out ) {
328 $y_max = $out if $out > $y_max;
329 $y_min = $out if $out < $y_min;
331 $out_max = $out if $out > $out_max;
332 $out_min = $out if $out < $out_min;
334 my $bwdiff = $y_max - $y_min;
335 $in_min = $self->_format_bandwidth($in_min);
336 $out_min = $self->_format_bandwidth($out_min);
337 $in_max = $self->_format_bandwidth($in_max);
338 $out_max = $self->_format_bandwidth($out_max);
339 my $in_curr = $self->_format_bandwidth($in[-1]);
340 my $out_curr = $self->_format_bandwidth($out[-1]);
341 my $numsamples = scalar(@records)/2;
342 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
343 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
345 my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
346 my @percentile = map $percentile, @in;
347 $percentile = $self->_format_bandwidth($percentile); #for below
349 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end ".
350 "in_min=$in_min out_min=$out_min in_max=$in_max ".
351 "out_max=$out_max in_avg=$in_avg out_avg=$out_avg ".
352 "percentile=$percentile ".
353 " # records = " . scalar(@records) . "\n\ntimes:\n".
354 Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n". Dumper(@out)
357 my @data = ( \@times, \@in, \@out, \@percentile );
360 # hardcoded size, colour, etc.
362 #don't change width/height other than through here; breaks legend otherwise
366 my $graph = new GD::Graph::mixed($width,$height);
368 types => ['area','lines','lines'],
369 dclrs => ['green','blue','red',],
371 x_tick_number => 'auto',
372 x_number_format => sub {
374 if ( $timediff < 86401 ) { # one day
375 $value = time2str("%a %H:%M",$value)
376 } elsif ( $timediff < 86401*7 ) { # one week
377 $value = time2str("%d",$value)
378 } elsif ( $timediff < 86401*30 ) { # one month
379 $value = time2str("Week %U",$value)
380 } elsif ( $timediff < 86401*366 ) { # one year
381 $value = time2str("%b",$value)
385 y_number_format => sub {
387 $self->_format_bandwidth($value,1);
389 y_tick_number => 'auto',
391 legend_placement => 'BR',
393 title => $self->serviceid,
394 ) or return "can't create graph: ".$graph->error;
396 $graph->set_text_clr('black')
397 or return "can't set text colour: ".$graph->error;
398 $graph->set_legend(('In','Out','95th'))
399 or return "can't set legend: ".$graph->error;
400 $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
401 or return "can't set title font: ".$graph->error;
402 $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
403 or return "can't set legend font: ".$graph->error;
404 $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
405 or return "can't set font: ".$graph->error;
406 $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
407 or return "can't set font: ".$graph->error;
408 $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
409 or return "can't set font: ".$graph->error;
411 my $gd = $graph->plot(\@data);
412 return "graph error: ".$graph->error unless($gd);
414 my $black = $gd->colorAllocate(0,0,0);
415 $gd->string(gdMediumBoldFont,50,$height-55,
416 "Current:$in_curr Average:$in_avg Maximum:$in_max Minimum:$in_min",$black);
417 $gd->string(gdMediumBoldFont,50,$height-35,
418 "Current:$out_curr Average:$out_avg Maximum:$out_max Minimum:$out_min",$black);
419 $gd->string(gdMediumBoldFont,50,$height-15,
420 "95th percentile:$percentile", $black);
431 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
432 L<FS::cust_pkg>, schema.html from the base documentation.