FS/FS/svc_port.pm

   1 package FS::svc_port;
   2
   3 use strict;
   4 use vars qw($conf $system $DEBUG $me );
   5 use base qw( FS::svc_Common );
   6 use FS::Record qw( qsearch qsearchs dbh
   7                    str2time_sql str2time_sql_closing concat_sql ); #dbh
   8 use FS::cust_svc;
   9 use GD::Graph;
  10 use GD::Graph::mixed;
  11 use Date::Format qw(time2str);
  12 use Data::Dumper;
  13
  14 $DEBUG = 1;
  15 $me = '[FS::svc_port]';
  16
  17 FS::UID->install_callback( sub {
  18   $conf = new FS::Conf;
  19   $system = $conf->config('network_monitoring_system');
  20 } );
  21
  22 =head1 NAME
  23
  24 FS::svc_port - Object methods for svc_port records
  25
  26 =head1 SYNOPSIS
  27
  28   use FS::svc_port;
  29
  30   $record = new FS::svc_port \%hash;
  31   $record = new FS::svc_port { 'column' => 'value' };
  32
  33   $error = $record->insert;
  34
  35   $error = $new_record->replace($old_record);
  36
  37   $error = $record->delete;
  38
  39   $error = $record->check;
  40
  41   $error = $record->suspend;
  42
  43   $error = $record->unsuspend;
  44
  45   $error = $record->cancel;
  46
  47 =head1 DESCRIPTION
  48
  49 An FS::svc_port object represents a router port.  FS::table_name inherits from
  50 FS::svc_Common.  The following fields are currently supported:
  51
  52 =over 4
  53
  54 =item svcnum -
  55
  56 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
  57
  58 =back
  59
  60 =head1 METHODS
  61
  62 =over 4
  63
  64 =item new HASHREF
  65
  66 Creates a new port.  To add the port to the database, see L<"insert">.
  67
  68 Note that this stores the hash reference, not a distinct copy of the hash it
  69 points to.  You can ask the object for a copy with the I<hash> method.
  70
  71 =cut
  72
  73 sub table { 'svc_port'; }
  74
  75 sub table_info {
  76   {
  77     'name' => 'Port',
  78     #'name_plural' => 'Ports', #optional,
  79     #'longname_plural' => 'Ports', #optional
  80     'sorts' => [ 'svcnum', 'serviceid' ], # optional sort field (or arrayref of sort fields, main first)
  81     'display_weight' => 75,
  82     'cancel_weight'  => 10,
  83     'fields' => {
  84       'serviceid'         => 'Torrus serviceid',
  85     },
  86   };
  87 }
  88
  89 =item search_sql STRING
  90
  91 Class method which returns an SQL fragment to search for the given string.
  92
  93 =cut
  94
  95 #or something more complicated if necessary
  96 sub search_sql {
  97   my($class, $string) = @_;
  98   $class->search_sql_field('serviceid', $string);
  99 }
 100
 101 =item label
 102
 103 Returns a meaningful identifier for this port
 104
 105 =cut
 106
 107 sub label {
 108   my $self = shift;
 109   $self->serviceid; #or something more complicated if necessary
 110 }
 111
 112 =item insert
 113
 114 Adds this record to the database.  If there is an error, returns the error,
 115 otherwise returns false.
 116
 117 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 118 defined.  An FS::cust_svc record will be created and inserted.
 119
 120 =cut
 121
 122 sub insert {
 123   my $self = shift;
 124   my $error;
 125
 126   $error = $self->SUPER::insert;
 127   return $error if $error;
 128
 129   '';
 130 }
 131
 132 =item delete
 133
 134 Delete this record from the database.
 135
 136 =cut
 137
 138 sub delete {
 139   my $self = shift;
 140   my $error;
 141
 142   $error = $self->SUPER::delete;
 143   return $error if $error;
 144
 145   '';
 146 }
 147
 148
 149 =item replace OLD_RECORD
 150
 151 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 152 returns the error, otherwise returns false.
 153
 154 =cut
 155
 156 sub replace {
 157   my ( $new, $old ) = ( shift, shift );
 158   my $error;
 159
 160   $error = $new->SUPER::replace($old);
 161   return $error if $error;
 162
 163   '';
 164 }
 165
 166 =item suspend
 167
 168 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 169
 170 =item unsuspend
 171
 172 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 173
 174 =item cancel
 175
 176 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 177
 178 =item check
 179
 180 Checks all fields to make sure this is a valid port.  If there is
 181 an error, returns the error, otherwise returns false.  Called by the insert
 182 and repalce methods.
 183
 184 =cut
 185
 186 sub check {
 187   my $self = shift;
 188
 189   my $x = $self->setfixed;
 190   return $x unless ref($x);
 191   my $part_svc = $x;
 192
 193   my $error = $self->ut_textn('serviceid'); #too lenient?
 194   return $error if $error;
 195
 196   $self->SUPER::check;
 197 }
 198
 199 =item graph_png
 200
 201 Returns a PNG graph for this port.
 202
 203 The following options must be specified:
 204
 205 =over 4
 206
 207 =item start
 208 =item end
 209
 210 =back
 211
 212 =cut
 213
 214 sub _format_bandwidth {
 215     my $self = shift;
 216     my $value = shift;
 217     my $space = shift;
 218     $space = ' ' if $space;
 219
 220     my $suffix = '';
 221
 222     warn "$me _format_bandwidth $value" if $DEBUG > 1;
 223
 224     if ( $value >= 1000 && $value < 1000000 ) {
 225         $value = ($value/1000);
 226         $suffix = $space. "k";
 227     }
 228     elsif( $value >= 1000000 && $value < 1000000000 ) {
 229         $value = ($value/1000/1000);
 230         $suffix = $space . "M";
 231     }
 232     elsif( $value >= 1000000000 && $value < 1000000000000 ) {
 233         $value = ($value/1000/1000/1000);
 234         $suffix = $space . "G";
 235     }
 236     # and hopefully we don't have folks doing Tbps on a single port :)
 237
 238     $value = sprintf("%.2f$suffix",$value) if $value >= 0;
 239
 240     $value;
 241 }
 242
 243 sub graph_png {
 244   my($self, %opt) = @_;
 245   my $serviceid = $self->serviceid;
 246
 247   if($serviceid && $system eq 'Torrus_Internal') {
 248       my $start = -1;
 249       my $end = -1;
 250         my $now = time;
 251
 252         $start = $opt{start} if $opt{start};
 253         $end = $opt{end} if $opt{end};
 254
 255         return 'Invalid date range' if ($start < 0 || $start >= $end
 256             || $end <= $start || $end < 0 || $end > $now || $start > $now
 257             || $end-$start > 86400*366 );
 258
 259         my $_date = str2time_sql. concat_sql([ 'srv_date', "' '", 'srv_time' ]).
 260                     str2time_sql_closing;
 261
 262         my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
 263
 264         local($FS::Record::nowarn_classload) = 1;
 265         my @records = qsearch({
 266           'table'     => 'srvexport',
 267           'select'    => "*, $_date as _date",
 268           'extra_sql' => "where serviceid in $serviceid_sql
 269                             and $_date >= $start
 270                             and $_date <= $end",
 271           'order_by'  => "order by $_date asc",
 272         });
 273
 274         warn "$me ". scalar(@records). " records returned for $serviceid\n"
 275           if $DEBUG;
 276
 277         # assume data in DB is correct,
 278         # assume always _IN and _OUT pair, assume intvl = 300
 279
 280         my @times;
 281         my @in;
 282         my @out;
 283         foreach my $rec ( @records ) {
 284             push @times, $rec->_date
 285                 unless grep { $_ eq $rec->_date } @times;
 286             push @in, $rec->value if $rec->serviceid =~ /_IN$/;
 287             push @out, $rec->value if $rec->serviceid =~ /_OUT$/;
 288         }
 289
 290         my $timediff = $times[-1] - $times[0]; # they're sorted ascending
 291
 292         my $y_min = 999999999999; # ~1Tbps
 293         my $y_max = 0;
 294         my $in_sum = 0;
 295         my $out_sum = 0;
 296         my $in_min = 999999999999;
 297         my $in_max = 0;
 298         my $out_min = 999999999999;
 299         my $out_max = 0;
 300         foreach my $in ( @in ) {
 301             $y_max = $in if $in > $y_max;
 302             $y_min = $in if $in < $y_min;
 303             $in_sum += $in;
 304             $in_max = $in if $in > $in_max;
 305             $in_min = $in if $in < $in_min;
 306         }
 307         foreach my $out ( @out ) {
 308             $y_max = $out if $out > $y_max;
 309             $y_min = $out if $out < $y_min;
 310             $out_sum += $out;
 311             $out_max = $out if $out > $out_max;
 312             $out_min = $out if $out < $out_min;
 313         }
 314         my $bwdiff = $y_max - $y_min;
 315         $in_min = $self->_format_bandwidth($in_min);
 316         $out_min = $self->_format_bandwidth($out_min);
 317         $in_max = $self->_format_bandwidth($in_max);
 318         $out_max = $self->_format_bandwidth($out_max);
 319         my $in_curr = $self->_format_bandwidth($in[-1]);
 320         my $out_curr = $self->_format_bandwidth($out[-1]);
 321         my $numsamples = scalar(@records)/2;
 322         my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
 323         my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
 324
 325       warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
 326             . "in_min=$in_min out_min=$out_min in_max=$in_max "
 327             . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
 328             . " # records = " . scalar(@records) . "\n\ntimes:\n"
 329             . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
 330             . Dumper(@out) if $DEBUG > 1;
 331
 332       my @data = ( \@times, \@in, \@out );
 333
 334       # hardcoded size, colour, etc.
 335       my $graph = new GD::Graph::mixed(600,400);
 336       $graph->set(
 337         types => ['area','lines'],
 338         dclrs => ['green','blue'],
 339         x_label => "(In Out)  Current: $in_curr $out_curr  Average: $in_avg $out_avg  Maximum: $in_max $out_max  Minimum: $in_min $out_min",
 340         x_tick_number => 'auto',
 341         x_number_format => sub {
 342             my $value = shift;
 343             if ( $timediff < 86401 ) { # one day
 344                 $value = time2str("%a %H:%M",$value)
 345             } elsif ( $timediff < 86401*7 ) { # one week
 346                 $value = time2str("%d",$value)
 347             } elsif ( $timediff < 86401*30 ) { # one month
 348                 $value = time2str("Week %U",$value)
 349             } elsif ( $timediff < 86401*366 ) { # one year
 350                 $value = time2str("%b",$value)
 351             }
 352             $value;
 353         },
 354         y_number_format => sub {
 355             my $value = shift;
 356             $self->_format_bandwidth($value,1);
 357         },
 358         y_label => 'bps',
 359         legend_placement => 'BR',
 360         title => $self->serviceid,
 361       ) or return "can't create graph: ".$graph->error;
 362
 363       $graph->set_text_clr('black')
 364         or return "can't set text colour: ".$graph->error;
 365       $graph->set_legend(('In','Out'))
 366         or return "can't set legend: ".$graph->error;
 367
 368       my $gd = $graph->plot(\@data);
 369       return "graph error: ".$graph->error unless($gd);
 370       return $gd->png;
 371   }
 372
 373   '';
 374 }
 375
 376 =back
 377
 378 =head1 BUGS
 379
 380 =head1 SEE ALSO
 381
 382 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
 383 L<FS::cust_pkg>, schema.html from the base documentation.
 384
 385 =cut
 386
 387 1;
 388