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