4 use vars qw($conf $system $DEBUG $me );
5 use base qw( FS::svc_Common );
6 use FS::UID qw( driver_name );
7 use FS::Record qw( qsearch qsearchs
8 str2time_sql str2time_sql_closing concat_sql );
13 use Date::Format qw(time2str);
17 $me = '[FS::svc_port]';
19 FS::UID->install_callback( sub {
21 $system = $conf->config('network_monitoring_system');
26 FS::svc_port - Object methods for svc_port records
32 $record = new FS::svc_port \%hash;
33 $record = new FS::svc_port { 'column' => 'value' };
35 $error = $record->insert;
37 $error = $new_record->replace($old_record);
39 $error = $record->delete;
41 $error = $record->check;
43 $error = $record->suspend;
45 $error = $record->unsuspend;
47 $error = $record->cancel;
51 An FS::svc_port object represents a router port. FS::table_name inherits from
52 FS::svc_Common. The following fields are currently supported:
58 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
68 Creates a new port. To add the port to the database, see L<"insert">.
70 Note that this stores the hash reference, not a distinct copy of the hash it
71 points to. You can ask the object for a copy with the I<hash> method.
75 sub table { 'svc_port'; }
80 #'name_plural' => 'Ports', #optional,
81 #'longname_plural' => 'Ports', #optional
82 'sorts' => [ 'svcnum', 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
83 'display_weight' => 75,
84 'cancel_weight' => 10,
86 'serviceid' => 'Torrus serviceid',
91 =item search_sql STRING
93 Class method which returns an SQL fragment to search for the given string.
97 #or something more complicated if necessary
99 my($class, $string) = @_;
100 $class->search_sql_field('serviceid', $string);
105 Returns a meaningful identifier for this port
111 $self->serviceid; #or something more complicated if necessary
116 Adds this record to the database. If there is an error, returns the error,
117 otherwise returns false.
119 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
120 defined. An FS::cust_svc record will be created and inserted.
128 $error = $self->SUPER::insert;
129 return $error if $error;
136 Delete this record from the database.
144 $error = $self->SUPER::delete;
145 return $error if $error;
151 =item replace OLD_RECORD
153 Replaces the OLD_RECORD with this one in the database. If there is an error,
154 returns the error, otherwise returns false.
159 my ( $new, $old ) = ( shift, shift );
162 $error = $new->SUPER::replace($old);
163 return $error if $error;
170 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
174 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
178 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
182 Checks all fields to make sure this is a valid port. If there is
183 an error, returns the error, otherwise returns false. Called by the insert
191 my $x = $self->setfixed;
192 return $x unless ref($x);
195 my $error = $self->ut_textn('serviceid'); #too lenient?
196 return $error if $error;
203 Returns a PNG graph for this port.
205 The following options must be specified:
216 sub _format_bandwidth {
220 $space = ' ' if $space;
224 warn "$me _format_bandwidth $value" if $DEBUG > 1;
226 if ( $value >= 1000 && $value < 1000000 ) {
227 $value = ($value/1000);
228 $suffix = $space. "k";
230 elsif( $value >= 1000000 && $value < 1000000000 ) {
231 $value = ($value/1000/1000);
232 $suffix = $space . "M";
234 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
235 $value = ($value/1000/1000/1000);
236 $suffix = $space . "G";
238 # and hopefully we don't have folks doing Tbps on a single port :)
240 $value = sprintf("%.2f$suffix",$value) if $value >= 0;
246 my($self, %opt) = @_;
247 my $serviceid = $self->serviceid;
249 if($serviceid && $system eq 'Torrus_Internal') {
254 $start = $opt{start} if $opt{start};
255 $end = $opt{end} if $opt{end};
257 $end = $now if $end > $now;
259 return 'Invalid date range' if ($start < 0 || $start >= $end
260 || $end <= $start || $end < 0 || $end > $now || $start > $now
261 || $end-$start > 86400*366 );
263 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
264 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
265 $_date = str2time_sql. $_date. str2time_sql_closing;
267 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
269 local($FS::Record::nowarn_classload) = 1;
270 my @records = qsearch({
271 'table' => 'srvexport',
272 'select' => "*, $_date as _date",
273 'extra_sql' => "where serviceid in $serviceid_sql
276 'order_by' => "order by $_date asc",
279 if ( ! scalar(@records) ) {
280 warn "$me no records returned for $serviceid\n";
281 return ''; #should actually return a blank png (or, even better, the
282 # error message in the image)
285 warn "$me ". scalar(@records). " records returned for $serviceid\n"
288 # assume data in DB is correct,
289 # assume always _IN and _OUT pair, assume intvl = 300
294 foreach my $rec ( @records ) {
295 push @times, $rec->_date
296 unless grep { $_ eq $rec->_date } @times;
297 push @in, $rec->value*8 if $rec->serviceid =~ /_IN$/;
298 push @out, $rec->value*8 if $rec->serviceid =~ /_OUT$/;
301 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
303 my $y_min = 999999999999; # ~1Tbps
307 my $in_min = 999999999999;
309 my $out_min = 999999999999;
311 foreach my $in ( @in ) {
312 $y_max = $in if $in > $y_max;
313 $y_min = $in if $in < $y_min;
315 $in_max = $in if $in > $in_max;
316 $in_min = $in if $in < $in_min;
318 foreach my $out ( @out ) {
319 $y_max = $out if $out > $y_max;
320 $y_min = $out if $out < $y_min;
322 $out_max = $out if $out > $out_max;
323 $out_min = $out if $out < $out_min;
325 my $bwdiff = $y_max - $y_min;
326 $in_min = $self->_format_bandwidth($in_min);
327 $out_min = $self->_format_bandwidth($out_min);
328 $in_max = $self->_format_bandwidth($in_max);
329 $out_max = $self->_format_bandwidth($out_max);
330 my $in_curr = $self->_format_bandwidth($in[-1]);
331 my $out_curr = $self->_format_bandwidth($out[-1]);
332 my $numsamples = scalar(@records)/2;
333 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
334 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
336 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
337 . "in_min=$in_min out_min=$out_min in_max=$in_max "
338 . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
339 . " # records = " . scalar(@records) . "\n\ntimes:\n"
340 . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
341 . Dumper(@out) if $DEBUG > 1;
343 my @data = ( \@times, \@in, \@out );
346 # hardcoded size, colour, etc.
348 # don't change width/height other than through here; breaks legend otherwise
352 my $graph = new GD::Graph::mixed($width,$height);
354 types => ['area','lines'],
355 dclrs => ['green','blue'],
357 x_tick_number => 'auto',
358 x_number_format => sub {
360 if ( $timediff < 86401 ) { # one day
361 $value = time2str("%a %H:%M",$value)
362 } elsif ( $timediff < 86401*7 ) { # one week
363 $value = time2str("%d",$value)
364 } elsif ( $timediff < 86401*30 ) { # one month
365 $value = time2str("Week %U",$value)
366 } elsif ( $timediff < 86401*366 ) { # one year
367 $value = time2str("%b",$value)
371 y_number_format => sub {
373 $self->_format_bandwidth($value,1);
375 y_tick_number => 'auto',
377 legend_placement => 'BR',
379 title => $self->serviceid,
380 ) or return "can't create graph: ".$graph->error;
382 $graph->set_text_clr('black')
383 or return "can't set text colour: ".$graph->error;
384 $graph->set_legend(('In','Out'))
385 or return "can't set legend: ".$graph->error;
386 $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
387 or return "can't set title font: ".$graph->error;
388 $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
389 or return "can't set legend font: ".$graph->error;
390 $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
391 or return "can't set font: ".$graph->error;
392 $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
393 or return "can't set font: ".$graph->error;
394 $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
395 or return "can't set font: ".$graph->error;
397 my $gd = $graph->plot(\@data);
398 return "graph error: ".$graph->error unless($gd);
400 my $black = $gd->colorAllocate(0,0,0);
401 $gd->string(gdMediumBoldFont,50,$height-35,
402 "Current: $in_curr Average: $in_avg Maximum: $in_max Minimum: $in_min",$black);
403 $gd->string(gdMediumBoldFont,50,$height-15,
404 "Current: $out_curr Average: $out_avg Maximum: $out_max Minimum: $out_min",$black);
418 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
419 L<FS::cust_pkg>, schema.html from the base documentation.