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 );
12 use Date::Format qw(time2str);
16 $me = '[FS::svc_port]';
18 FS::UID->install_callback( sub {
20 $system = $conf->config('network_monitoring_system');
25 FS::svc_port - Object methods for svc_port records
31 $record = new FS::svc_port \%hash;
32 $record = new FS::svc_port { 'column' => 'value' };
34 $error = $record->insert;
36 $error = $new_record->replace($old_record);
38 $error = $record->delete;
40 $error = $record->check;
42 $error = $record->suspend;
44 $error = $record->unsuspend;
46 $error = $record->cancel;
50 An FS::svc_port object represents a router port. FS::table_name inherits from
51 FS::svc_Common. The following fields are currently supported:
57 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
67 Creates a new port. To add the port to the database, see L<"insert">.
69 Note that this stores the hash reference, not a distinct copy of the hash it
70 points to. You can ask the object for a copy with the I<hash> method.
74 sub table { 'svc_port'; }
79 #'name_plural' => 'Ports', #optional,
80 #'longname_plural' => 'Ports', #optional
81 'sorts' => [ 'svcnum', 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
82 'display_weight' => 75,
83 'cancel_weight' => 10,
85 'serviceid' => 'Torrus serviceid',
90 =item search_sql STRING
92 Class method which returns an SQL fragment to search for the given string.
96 #or something more complicated if necessary
98 my($class, $string) = @_;
99 $class->search_sql_field('serviceid', $string);
104 Returns a meaningful identifier for this port
110 $self->serviceid; #or something more complicated if necessary
115 Adds this record to the database. If there is an error, returns the error,
116 otherwise returns false.
118 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
119 defined. An FS::cust_svc record will be created and inserted.
127 $error = $self->SUPER::insert;
128 return $error if $error;
135 Delete this record from the database.
143 $error = $self->SUPER::delete;
144 return $error if $error;
150 =item replace OLD_RECORD
152 Replaces the OLD_RECORD with this one in the database. If there is an error,
153 returns the error, otherwise returns false.
158 my ( $new, $old ) = ( shift, shift );
161 $error = $new->SUPER::replace($old);
162 return $error if $error;
169 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
173 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
177 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
181 Checks all fields to make sure this is a valid port. If there is
182 an error, returns the error, otherwise returns false. Called by the insert
190 my $x = $self->setfixed;
191 return $x unless ref($x);
194 my $error = $self->ut_textn('serviceid'); #too lenient?
195 return $error if $error;
202 Returns a PNG graph for this port.
204 The following options must be specified:
215 sub _format_bandwidth {
219 $space = ' ' if $space;
223 warn "$me _format_bandwidth $value" if $DEBUG > 1;
225 if ( $value >= 1000 && $value < 1000000 ) {
226 $value = ($value/1000);
227 $suffix = $space. "k";
229 elsif( $value >= 1000000 && $value < 1000000000 ) {
230 $value = ($value/1000/1000);
231 $suffix = $space . "M";
233 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
234 $value = ($value/1000/1000/1000);
235 $suffix = $space . "G";
237 # and hopefully we don't have folks doing Tbps on a single port :)
239 $value = sprintf("%.2f$suffix",$value) if $value >= 0;
245 my($self, %opt) = @_;
246 my $serviceid = $self->serviceid;
248 if($serviceid && $system eq 'Torrus_Internal') {
253 $start = $opt{start} if $opt{start};
254 $end = $opt{end} if $opt{end};
256 return 'Invalid date range' if ($start < 0 || $start >= $end
257 || $end <= $start || $end < 0 || $end > $now || $start > $now
258 || $end-$start > 86400*366 );
260 my $_date = concat_sql([ 'srv_date', "' '", 'srv_time' ]);
261 $_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i;
262 $_date = str2time_sql. $_date. str2time_sql_closing;
264 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
266 local($FS::Record::nowarn_classload) = 1;
267 my @records = qsearch({
268 'table' => 'srvexport',
269 'select' => "*, $_date as _date",
270 'extra_sql' => "where serviceid in $serviceid_sql
273 'order_by' => "order by $_date asc",
276 if ( ! scalar(@records) ) {
277 warn "$me no records returned for $serviceid\n";
278 return ''; #should actually return a blank png (or, even better, the
279 # error message in the image)
282 warn "$me ". scalar(@records). " records returned for $serviceid\n"
285 # assume data in DB is correct,
286 # assume always _IN and _OUT pair, assume intvl = 300
291 foreach my $rec ( @records ) {
292 push @times, $rec->_date
293 unless grep { $_ eq $rec->_date } @times;
294 push @in, $rec->value if $rec->serviceid =~ /_IN$/;
295 push @out, $rec->value if $rec->serviceid =~ /_OUT$/;
298 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
300 my $y_min = 999999999999; # ~1Tbps
304 my $in_min = 999999999999;
306 my $out_min = 999999999999;
308 foreach my $in ( @in ) {
309 $y_max = $in if $in > $y_max;
310 $y_min = $in if $in < $y_min;
312 $in_max = $in if $in > $in_max;
313 $in_min = $in if $in < $in_min;
315 foreach my $out ( @out ) {
316 $y_max = $out if $out > $y_max;
317 $y_min = $out if $out < $y_min;
319 $out_max = $out if $out > $out_max;
320 $out_min = $out if $out < $out_min;
322 my $bwdiff = $y_max - $y_min;
323 $in_min = $self->_format_bandwidth($in_min);
324 $out_min = $self->_format_bandwidth($out_min);
325 $in_max = $self->_format_bandwidth($in_max);
326 $out_max = $self->_format_bandwidth($out_max);
327 my $in_curr = $self->_format_bandwidth($in[-1]);
328 my $out_curr = $self->_format_bandwidth($out[-1]);
329 my $numsamples = scalar(@records)/2;
330 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
331 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
333 warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
334 . "in_min=$in_min out_min=$out_min in_max=$in_max "
335 . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
336 . " # records = " . scalar(@records) . "\n\ntimes:\n"
337 . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
338 . Dumper(@out) if $DEBUG > 1;
340 my @data = ( \@times, \@in, \@out );
342 # hardcoded size, colour, etc.
343 my $graph = new GD::Graph::mixed(600,320); #600,400
345 types => ['area','lines'],
346 dclrs => ['green','blue'],
347 x_label => "(In Out) Current: $in_curr $out_curr Average: $in_avg $out_avg Maximum: $in_max $out_max Minimum: $in_min $out_min",
348 x_tick_number => 'auto',
349 x_number_format => sub {
351 if ( $timediff < 86401 ) { # one day
352 $value = time2str("%a %H:%M",$value)
353 } elsif ( $timediff < 86401*7 ) { # one week
354 $value = time2str("%d",$value)
355 } elsif ( $timediff < 86401*30 ) { # one month
356 $value = time2str("Week %U",$value)
357 } elsif ( $timediff < 86401*366 ) { # one year
358 $value = time2str("%b",$value)
362 y_number_format => sub {
364 $self->_format_bandwidth($value,1);
367 legend_placement => 'BR',
368 title => $self->serviceid,
369 ) or return "can't create graph: ".$graph->error;
371 $graph->set_text_clr('black')
372 or return "can't set text colour: ".$graph->error;
373 $graph->set_legend(('In','Out'))
374 or return "can't set legend: ".$graph->error;
376 my $gd = $graph->plot(\@data);
377 return "graph error: ".$graph->error unless($gd);
390 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
391 L<FS::cust_pkg>, schema.html from the base documentation.