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 return 'Invalid date range' if ($start < 0 || $start >= $end
258 || $end <= $start || $end < 0 || $end > $now || $start > $now
259 || $end-$start > 86400*366 );
261 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
262 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
263 $_date = str2time_sql. $_date. str2time_sql_closing;
265 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
267 local($FS::Record::nowarn_classload) = 1;
268 my @records = qsearch({
269 'table' => 'srvexport',
270 'select' => "*, $_date as _date",
271 'extra_sql' => "where serviceid in $serviceid_sql
274 'order_by' => "order by $_date asc",
277 if ( ! scalar(@records) ) {
278 warn "$me no records returned for $serviceid\n";
279 return ''; #should actually return a blank png (or, even better, the
280 # error message in the image)
283 warn "$me ". scalar(@records). " records returned for $serviceid\n"
286 # assume data in DB is correct,
287 # assume always _IN and _OUT pair, assume intvl = 300
292 foreach my $rec ( @records ) {
293 push @times, $rec->_date
294 unless grep { $_ eq $rec->_date } @times;
295 push @in, $rec->value if $rec->serviceid =~ /_IN$/;
296 push @out, $rec->value if $rec->serviceid =~ /_OUT$/;
299 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
301 my $y_min = 999999999999; # ~1Tbps
305 my $in_min = 999999999999;
307 my $out_min = 999999999999;
309 foreach my $in ( @in ) {
310 $y_max = $in if $in > $y_max;
311 $y_min = $in if $in < $y_min;
313 $in_max = $in if $in > $in_max;
314 $in_min = $in if $in < $in_min;
316 foreach my $out ( @out ) {
317 $y_max = $out if $out > $y_max;
318 $y_min = $out if $out < $y_min;
320 $out_max = $out if $out > $out_max;
321 $out_min = $out if $out < $out_min;
323 my $bwdiff = $y_max - $y_min;
324 $in_min = $self->_format_bandwidth($in_min);
325 $out_min = $self->_format_bandwidth($out_min);
326 $in_max = $self->_format_bandwidth($in_max);
327 $out_max = $self->_format_bandwidth($out_max);
328 my $in_curr = $self->_format_bandwidth($in[-1]);
329 my $out_curr = $self->_format_bandwidth($out[-1]);
330 my $numsamples = scalar(@records)/2;
331 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
332 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
334 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
335 . "in_min=$in_min out_min=$out_min in_max=$in_max "
336 . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
337 . " # records = " . scalar(@records) . "\n\ntimes:\n"
338 . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
339 . Dumper(@out) if $DEBUG > 1;
341 my @data = ( \@times, \@in, \@out );
343 # hardcoded size, colour, etc.
344 my $graph = new GD::Graph::mixed(600,320); #600,400
346 types => ['area','lines'],
347 dclrs => ['green','blue'],
349 x_tick_number => 'auto',
350 x_number_format => sub {
352 if ( $timediff < 86401 ) { # one day
353 $value = time2str("%a %H:%M",$value)
354 } elsif ( $timediff < 86401*7 ) { # one week
355 $value = time2str("%d",$value)
356 } elsif ( $timediff < 86401*30 ) { # one month
357 $value = time2str("Week %U",$value)
358 } elsif ( $timediff < 86401*366 ) { # one year
359 $value = time2str("%b",$value)
363 y_number_format => sub {
365 $self->_format_bandwidth($value,1);
368 legend_placement => 'BR',
370 title => $self->serviceid,
371 ) or return "can't create graph: ".$graph->error;
373 $graph->set_text_clr('black')
374 or return "can't set text colour: ".$graph->error;
375 $graph->set_legend(('In','Out'))
376 or return "can't set legend: ".$graph->error;
377 $graph->set_title_font(['verdana', 'arial', gdGiantFont], 16)
378 or return "can't set title font: ".$graph->error;
379 $graph->set_legend_font(['verdana', 'arial', gdMediumBoldFont], 12)
380 or return "can't set legend font: ".$graph->error;
381 $graph->set_x_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
382 or return "can't set font: ".$graph->error;
383 $graph->set_y_axis_font(['verdana', 'arial', gdMediumBoldFont], 12)
384 or return "can't set font: ".$graph->error;
385 $graph->set_y_label_font(['verdana', 'arial', gdMediumBoldFont], 12)
386 or return "can't set font: ".$graph->error;
388 my $gd = $graph->plot(\@data);
389 return "graph error: ".$graph->error unless($gd);
391 my $black = $gd->colorAllocate(0,0,0);
392 $gd->string(gdMediumBoldFont,50,285,
393 "Current: $in_curr Average: $in_avg Maximum: $in_max Minimum: $in_min",$black);
394 $gd->string(gdMediumBoldFont,50,305,
395 "Current: $out_curr Average: $out_avg Maximum: $out_max Minimum: $out_min",$black);
409 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
410 L<FS::cust_pkg>, schema.html from the base documentation.