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