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 'svcnum' => 'Service',
89 'serviceid' => 'Torrus serviceid',
94 =item search_sql STRING
96 Class method which returns an SQL fragment to search for the given string.
100 #or something more complicated if necessary
102 my($class, $string) = @_;
103 $class->search_sql_field('serviceid', $string);
108 Returns a meaningful identifier for this port
114 $self->serviceid; #or something more complicated if necessary
119 Adds this record to the database. If there is an error, returns the error,
120 otherwise returns false.
122 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
123 defined. An FS::cust_svc record will be created and inserted.
131 $error = $self->SUPER::insert;
132 return $error if $error;
139 Delete this record from the database.
147 $error = $self->SUPER::delete;
148 return $error if $error;
154 =item replace OLD_RECORD
156 Replaces the OLD_RECORD with this one in the database. If there is an error,
157 returns the error, otherwise returns false.
162 my ( $new, $old ) = ( shift, shift );
165 $error = $new->SUPER::replace($old);
166 return $error if $error;
173 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
177 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
181 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
185 Checks all fields to make sure this is a valid port. If there is
186 an error, returns the error, otherwise returns false. Called by the insert
194 my $x = $self->setfixed;
195 return $x unless ref($x);
198 my $error = $self->ut_textn('serviceid'); #too lenient?
199 return $error if $error;
206 Returns a PNG graph for this port.
208 The following options must be specified:
219 sub _format_bandwidth {
223 $space = ' ' if $space;
227 warn "$me _format_bandwidth $value" if $DEBUG > 1;
229 if ( $value >= 1000 && $value < 1000000 ) {
230 $value = ($value/1000);
231 $suffix = $space. "k";
233 elsif( $value >= 1000000 && $value < 1000000000 ) {
234 $value = ($value/1000/1000);
235 $suffix = $space . "M";
237 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
238 $value = ($value/1000/1000/1000);
239 $suffix = $space . "G";
241 # and hopefully we don't have folks doing Tbps on a single port :)
243 $value = sprintf("%6.2f$suffix",$value) if $value >= 0;
250 my @values = sort { $a <=> $b } @{$_[0]};
251 $values[ int(.95 * $#values) ];
255 my($self, %opt) = @_;
256 my $serviceid = $self->serviceid;
258 return '' unless $serviceid && $system eq 'Torrus_Internal'; #empty/error png?
264 $start = $opt{start} if $opt{start};
265 $end = $opt{end} if $opt{end};
267 $end = $now if $end > $now;
269 return 'Invalid date range' if ($start < 0 || $start >= $end
270 || $end <= $start || $end < 0 || $end > $now || $start > $now
271 || $end-$start > 86400*366 );
273 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
274 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
275 $_date = str2time_sql. $_date. str2time_sql_closing;
277 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
279 local($FS::Record::nowarn_classload) = 1;
280 my @records = qsearch({
281 'table' => 'srvexport',
282 'select' => "*, $_date as _date",
283 'extra_sql' => "where serviceid in $serviceid_sql
286 'order_by' => "order by $_date asc",
289 if ( ! scalar(@records) ) {
290 warn "$me no records returned for $serviceid\n";
291 return ''; #should actually return a blank png (or, even better, the
292 # error message in the image)
295 warn "$me ". scalar(@records). " records returned for $serviceid\n"
298 # assume data in DB is correct,
299 # assume always _IN and _OUT pair, assume intvl = 300
304 foreach my $rec ( @records ) {
305 push @times, $rec->_date
306 unless grep { $_ eq $rec->_date } @times;
307 push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
308 push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
311 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
313 my $y_min = 999999999999; # ~1Tbps
317 my $in_min = 999999999999;
319 my $out_min = 999999999999;
321 foreach my $in ( @in ) {
322 $y_max = $in if $in > $y_max;
323 $y_min = $in if $in < $y_min;
325 $in_max = $in if $in > $in_max;
326 $in_min = $in if $in < $in_min;
328 foreach my $out ( @out ) {
329 $y_max = $out if $out > $y_max;
330 $y_min = $out if $out < $y_min;
332 $out_max = $out if $out > $out_max;
333 $out_min = $out if $out < $out_min;
335 my $bwdiff = $y_max - $y_min;
336 $in_min = $self->_format_bandwidth($in_min);
337 $out_min = $self->_format_bandwidth($out_min);
338 $in_max = $self->_format_bandwidth($in_max);
339 $out_max = $self->_format_bandwidth($out_max);
340 my $in_curr = $self->_format_bandwidth($in[-1]);
341 my $out_curr = $self->_format_bandwidth($out[-1]);
342 my $numsamples = scalar(@records)/2;
343 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
344 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
346 my $percentile = max( $self->_percentile(\@in), $self->_percentile(\@out) );
347 my @percentile = map $percentile, @in;
348 $percentile = $self->_format_bandwidth($percentile); #for below
350 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end ".
351 "in_min=$in_min out_min=$out_min in_max=$in_max ".
352 "out_max=$out_max in_avg=$in_avg out_avg=$out_avg ".
353 "percentile=$percentile ".
354 " # records = " . scalar(@records) . "\n\ntimes:\n".
355 Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n". Dumper(@out)
358 my @data = ( \@times, \@in, \@out, \@percentile );
361 # hardcoded size, colour, etc.
363 #don't change width/height other than through here; breaks legend otherwise
367 my $graph = new GD::Graph::mixed($width,$height);
369 types => ['area','lines','lines'],
370 dclrs => ['green','blue','red',],
372 x_tick_number => 'auto',
373 x_number_format => sub {
375 if ( $timediff < 86401 ) { # one day
376 $value = time2str("%a %H:%M",$value)
377 } elsif ( $timediff < 86401*7 ) { # one week
378 $value = time2str("%d",$value)
379 } elsif ( $timediff < 86401*30 ) { # one month
380 $value = time2str("Week %U",$value)
381 } elsif ( $timediff < 86401*366 ) { # one year
382 $value = time2str("%b",$value)
386 y_number_format => sub {
388 $self->_format_bandwidth($value,1);
390 y_tick_number => 'auto',
392 legend_placement => 'BR',
394 title => $self->serviceid,
395 ) or return "can't create graph: ".$graph->error;
397 $graph->set_text_clr('black')
398 or return "can't set text colour: ".$graph->error;
399 $graph->set_legend(('In','Out','95th'))
400 or return "can't set legend: ".$graph->error;
401 $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
402 or return "can't set title font: ".$graph->error;
403 $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
404 or return "can't set legend font: ".$graph->error;
405 $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
406 or return "can't set font: ".$graph->error;
407 $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
408 or return "can't set font: ".$graph->error;
409 $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
410 or return "can't set font: ".$graph->error;
412 my $gd = $graph->plot(\@data);
413 return "graph error: ".$graph->error unless($gd);
415 my $black = $gd->colorAllocate(0,0,0);
416 $gd->string(gdMediumBoldFont,50,$height-55,
417 "Current:$in_curr Average:$in_avg Maximum:$in_max Minimum:$in_min",$black);
418 $gd->string(gdMediumBoldFont,50,$height-35,
419 "Current:$out_curr Average:$out_avg Maximum:$out_max Minimum:$out_min",$black);
420 $gd->string(gdMediumBoldFont,50,$height-15,
421 "95th percentile:$percentile", $black);
432 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
433 L<FS::cust_pkg>, schema.html from the base documentation.