4 use vars qw($conf $system $DEBUG $me );
5 use base qw( FS::svc_Common );
6 use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
10 use Date::Format qw(time2str);
14 $me = '[FS::svc_port]';
16 FS::UID->install_callback( sub {
18 $system = $conf->config('network_monitoring_system');
23 FS::svc_port - Object methods for svc_port records
29 $record = new FS::svc_port \%hash;
30 $record = new FS::svc_port { 'column' => 'value' };
32 $error = $record->insert;
34 $error = $new_record->replace($old_record);
36 $error = $record->delete;
38 $error = $record->check;
40 $error = $record->suspend;
42 $error = $record->unsuspend;
44 $error = $record->cancel;
48 An FS::svc_port object represents a router port. FS::table_name inherits from
49 FS::svc_Common. The following fields are currently supported:
55 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
65 Creates a new port. To add the port to the database, see L<"insert">.
67 Note that this stores the hash reference, not a distinct copy of the hash it
68 points to. You can ask the object for a copy with the I<hash> method.
72 sub table { 'svc_port'; }
77 #'name_plural' => 'Ports', #optional,
78 #'longname_plural' => 'Ports', #optional
79 'sorts' => [ 'svcnum', 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
80 'display_weight' => 75,
81 'cancel_weight' => 10,
83 'serviceid' => 'Torrus serviceid',
88 =item search_sql STRING
90 Class method which returns an SQL fragment to search for the given string.
94 #or something more complicated if necessary
96 my($class, $string) = @_;
97 $class->search_sql_field('serviceid', $string);
102 Returns a meaningful identifier for this port
108 $self->serviceid; #or something more complicated if necessary
113 Adds this record to the database. If there is an error, returns the error,
114 otherwise returns false.
116 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
117 defined. An FS::cust_svc record will be created and inserted.
125 $error = $self->SUPER::insert;
126 return $error if $error;
133 Delete this record from the database.
141 $error = $self->SUPER::delete;
142 return $error if $error;
148 =item replace OLD_RECORD
150 Replaces the OLD_RECORD with this one in the database. If there is an error,
151 returns the error, otherwise returns false.
156 my ( $new, $old ) = ( shift, shift );
159 $error = $new->SUPER::replace($old);
160 return $error if $error;
167 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
171 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
175 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
179 Checks all fields to make sure this is a valid port. If there is
180 an error, returns the error, otherwise returns false. Called by the insert
188 my $x = $self->setfixed;
189 return $x unless ref($x);
192 my $error = $self->ut_textn('serviceid'); #too lenient?
193 return $error if $error;
200 Returns a PNG graph for this port.
202 The following options must be specified:
213 sub _format_bandwidth {
217 $space = ' ' if $space;
221 warn "$me _format_bandwidth $value" if $DEBUG > 1;
223 if ( $value >= 1000 && $value < 1000000 ) {
224 $value = ($value/1000);
225 $suffix = $space. "k";
227 elsif( $value >= 1000000 && $value < 1000000000 ) {
228 $value = ($value/1000/1000);
229 $suffix = $space . "M";
231 elsif( $value >= 1000000000 && $value < 1000000000000 ) {
232 $value = ($value/1000/1000/1000);
233 $suffix = $space . "G";
235 # and hopefully we don't have folks doing Tbps on a single port :)
237 $value = sprintf("%.2f$suffix",$value) if $value >= 0;
243 my($self, %opt) = @_;
244 my $serviceid = $self->serviceid;
246 if($serviceid && $system eq 'Torrus_Internal') {
251 $start = $opt{start} if $opt{start};
252 $end = $opt{end} if $opt{end};
254 return 'Invalid date range' if ($start < 0 || $start >= $end
255 || $end <= $start || $end < 0 || $end > $now || $start > $now
256 || $end-$start > 86400*366 );
258 local($FS::Record::nowarn_classload) = 1;
260 my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
264 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
266 'table' => 'srvexport',
267 'select' => "*, date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) as _date",
268 'extra_sql' => "where serviceid in $serviceid_sql and
269 date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) >= $start
270 and date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) <= $end",
271 'order_by' => "order by date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) asc",
273 } elsif ( $dbh->{Driver}->{Name} eq 'mysql' ) {
275 'table' => 'srvexport',
276 'select' => "*, unix_timestamp(srv_date||' '||srv_time) as _date",
277 'extra_sql' => "where serviceid in $serviceid_sql and
278 unix_timestamp(srv_date||' '||srv_time) >= $start
279 and unix_timestamp(srv_date||' '||srv_time) <= $end",
280 'order_by' => "order by unix_timestamp(srv_date||' '||srv_time) asc",
283 return 'Unsupported DBMS';
286 #my $_date = str2time_sql. "srv_date||' '||srv_time".
287 # str2time_sql_closing;
289 #my @records = qsearch({
290 # 'table' => 'srvexport',
291 # 'select' => "*, $_date as _date",
292 # 'extra_sql' => "where serviceid in $serviceid_sql
293 # and $_date >= $start
294 # and $_date <= $end",
295 # 'order_by' => "order by $_date asc",
298 warn "$me ". scalar(@records). " records returned for $serviceid\n"
302 # assume data in DB is correct,
303 # assume always _IN and _OUT pair, assume intvl = 300
308 foreach my $rec ( @records ) {
309 push @times, $rec->_date
310 unless grep { $_ eq $rec->_date } @times;
311 push @in, $rec->value if $rec->serviceid =~ /_IN$/;
312 push @out, $rec->value if $rec->serviceid =~ /_OUT$/;
315 my $timediff = $times[-1] - $times[0]; # they're sorted ascending
317 my $y_min = 999999999999; # ~1Tbps
321 my $in_min = 999999999999;
323 my $out_min = 999999999999;
325 foreach my $in ( @in ) {
326 $y_max = $in if $in > $y_max;
327 $y_min = $in if $in < $y_min;
329 $in_max = $in if $in > $in_max;
330 $in_min = $in if $in < $in_min;
332 foreach my $out ( @out ) {
333 $y_max = $out if $out > $y_max;
334 $y_min = $out if $out < $y_min;
336 $out_max = $out if $out > $out_max;
337 $out_min = $out if $out < $out_min;
339 my $bwdiff = $y_max - $y_min;
340 $in_min = $self->_format_bandwidth($in_min);
341 $out_min = $self->_format_bandwidth($out_min);
342 $in_max = $self->_format_bandwidth($in_max);
343 $out_max = $self->_format_bandwidth($out_max);
344 my $in_curr = $self->_format_bandwidth($in[-1]);
345 my $out_curr = $self->_format_bandwidth($out[-1]);
346 my $numsamples = scalar(@records)/2;
347 my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
348 my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
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 . " # records = " . scalar(@records) . "\n\ntimes:\n"
354 . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
355 . Dumper(@out) if $DEBUG > 1;
357 my @data = ( \@times, \@in, \@out );
359 # hardcoded size, colour, etc.
360 my $graph = new GD::Graph::mixed(600,400);
362 types => ['area','lines'],
363 dclrs => ['green','blue'],
364 x_label => "(In Out) Current: $in_curr $out_curr Average: $in_avg $out_avg Maximum: $in_max $out_max Minimum: $in_min $out_min",
365 x_tick_number => 'auto',
366 x_number_format => sub {
368 if ( $timediff < 86401 ) { # one day
369 $value = time2str("%a %H:%M",$value)
370 } elsif ( $timediff < 86401*7 ) { # one week
371 $value = time2str("%d",$value)
372 } elsif ( $timediff < 86401*30 ) { # one month
373 $value = time2str("Week %U",$value)
374 } elsif ( $timediff < 86401*366 ) { # one year
375 $value = time2str("%b",$value)
379 y_number_format => sub {
381 $self->_format_bandwidth($value,1);
384 legend_placement => 'BR',
385 title => $self->serviceid,
386 ) or return "can't create graph: ".$graph->error;
388 $graph->set_text_clr('black')
389 or return "can't set text colour: ".$graph->error;
390 $graph->set_legend(('In','Out'))
391 or return "can't set legend: ".$graph->error;
393 my $gd = $graph->plot(\@data);
394 return "graph error: ".$graph->error unless($gd);
407 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
408 L<FS::cust_pkg>, schema.html from the base documentation.