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 str2time_sql str2time_sql_closing );
   7 use FS::cust_svc;
   8 use GD::Graph;
   9 use GD::Graph::mixed;
  10 use Date::Format qw(time2str);
  11 use Data::Dumper;
  12
  13 $DEBUG = 1;
  14 $me = '[FS::svc_port]';
  15
  16 FS::UID->install_callback( sub {
  17   $conf = new FS::Conf;
  18   $system = $conf->config('network_monitoring_system');
  19 } );
  20
  21 =head1 NAME
  22
  23 FS::svc_port - Object methods for svc_port records
  24
  25 =head1 SYNOPSIS
  26
  27   use FS::svc_port;
  28
  29   $record = new FS::svc_port \%hash;
  30   $record = new FS::svc_port { 'column' => 'value' };
  31
  32   $error = $record->insert;
  33
  34   $error = $new_record->replace($old_record);
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40   $error = $record->suspend;
  41
  42   $error = $record->unsuspend;
  43
  44   $error = $record->cancel;
  45
  46 =head1 DESCRIPTION
  47
  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:
  50
  51 =over 4
  52
  53 =item svcnum -
  54
  55 =item serviceid - Torrus serviceid (in srvexport and reportfields tables)
  56
  57 =back
  58
  59 =head1 METHODS
  60
  61 =over 4
  62
  63 =item new HASHREF
  64
  65 Creates a new port.  To add the port to the database, see L<"insert">.
  66
  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.
  69
  70 =cut
  71
  72 sub table { 'svc_port'; }
  73
  74 sub table_info {
  75   {
  76     'name' => '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,
  82     'fields' => {
  83       'serviceid'         => 'Torrus serviceid',
  84     },
  85   };
  86 }
  87
  88 =item search_sql STRING
  89
  90 Class method which returns an SQL fragment to search for the given string.
  91
  92 =cut
  93
  94 #or something more complicated if necessary
  95 sub search_sql {
  96   my($class, $string) = @_;
  97   $class->search_sql_field('serviceid', $string);
  98 }
  99
 100 =item label
 101
 102 Returns a meaningful identifier for this port
 103
 104 =cut
 105
 106 sub label {
 107   my $self = shift;
 108   $self->serviceid; #or something more complicated if necessary
 109 }
 110
 111 =item insert
 112
 113 Adds this record to the database.  If there is an error, returns the error,
 114 otherwise returns false.
 115
 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.
 118
 119 =cut
 120
 121 sub insert {
 122   my $self = shift;
 123   my $error;
 124
 125   $error = $self->SUPER::insert;
 126   return $error if $error;
 127
 128   '';
 129 }
 130
 131 =item delete
 132
 133 Delete this record from the database.
 134
 135 =cut
 136
 137 sub delete {
 138   my $self = shift;
 139   my $error;
 140
 141   $error = $self->SUPER::delete;
 142   return $error if $error;
 143
 144   '';
 145 }
 146
 147
 148 =item replace OLD_RECORD
 149
 150 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 151 returns the error, otherwise returns false.
 152
 153 =cut
 154
 155 sub replace {
 156   my ( $new, $old ) = ( shift, shift );
 157   my $error;
 158
 159   $error = $new->SUPER::replace($old);
 160   return $error if $error;
 161
 162   '';
 163 }
 164
 165 =item suspend
 166
 167 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 168
 169 =item unsuspend
 170
 171 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 172
 173 =item cancel
 174
 175 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 176
 177 =item check
 178
 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
 181 and repalce methods.
 182
 183 =cut
 184
 185 sub check {
 186   my $self = shift;
 187
 188   my $x = $self->setfixed;
 189   return $x unless ref($x);
 190   my $part_svc = $x;
 191
 192   my $error = $self->ut_textn('serviceid'); #too lenient?
 193   return $error if $error;
 194
 195   $self->SUPER::check;
 196 }
 197
 198 =item graph_png
 199
 200 Returns a PNG graph for this port.
 201
 202 The following options must be specified:
 203
 204 =over 4
 205
 206 =item start
 207 =item end
 208
 209 =back
 210
 211 =cut
 212
 213 sub _format_bandwidth {
 214     my $self = shift;
 215     my $value = shift;
 216     my $space = shift;
 217     $space = ' ' if $space;
 218
 219     my $suffix = '';
 220
 221     warn "$me _format_bandwidth $value" if $DEBUG > 1;
 222
 223     if ( $value >= 1000 && $value < 1000000 ) {
 224         $value = ($value/1000);
 225         $suffix = $space. "k";
 226     }
 227     elsif( $value >= 1000000 && $value < 1000000000 ) {
 228         $value = ($value/1000/1000);
 229         $suffix = $space . "M";
 230     }
 231     elsif( $value >= 1000000000 && $value < 1000000000000 ) {
 232         $value = ($value/1000/1000/1000);
 233         $suffix = $space . "G";
 234     }
 235     # and hopefully we don't have folks doing Tbps on a single port :)
 236
 237     $value = sprintf("%.2f$suffix",$value) if $value >= 0;
 238
 239     $value;
 240 }
 241
 242 sub graph_png {
 243   my($self, %opt) = @_;
 244   my $serviceid = $self->serviceid;
 245
 246   if($serviceid && $system eq 'Torrus_Internal') {
 247       my $start = -1;
 248       my $end = -1;
 249         my $now = time;
 250
 251         $start = $opt{start} if $opt{start};
 252         $end = $opt{end} if $opt{end};
 253
 254         return 'Invalid date range' if ($start < 0 || $start >= $end
 255             || $end <= $start || $end < 0 || $end > $now || $start > $now
 256             || $end-$start > 86400*366 );
 257
 258         local($FS::Record::nowarn_classload) = 1;
 259
 260         my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
 261
 262         my @records;
 263         my $dbh = dbh;
 264         if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 265             @records = qsearch({
 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",
 272              });
 273          } elsif ( $dbh->{Driver}->{Name} eq 'mysql' ) {
 274                 @records = qsearch({
 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",
 281                  });
 282         } else {
 283               return 'Unsupported DBMS';
 284         }
 285
 286         #my $_date = str2time_sql. "srv_date||' '||srv_time".
 287         #            str2time_sql_closing;
 288
 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",
 296         #});
 297
 298         warn "$me ". scalar(@records). " records returned for $serviceid\n"
 299           if $DEBUG;
 300
 301
 302         # assume data in DB is correct,
 303         # assume always _IN and _OUT pair, assume intvl = 300
 304
 305         my @times;
 306         my @in;
 307         my @out;
 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$/;
 313         }
 314
 315         my $timediff = $times[-1] - $times[0]; # they're sorted ascending
 316
 317         my $y_min = 999999999999; # ~1Tbps
 318         my $y_max = 0;
 319         my $in_sum = 0;
 320         my $out_sum = 0;
 321         my $in_min = 999999999999;
 322         my $in_max = 0;
 323         my $out_min = 999999999999;
 324         my $out_max = 0;
 325         foreach my $in ( @in ) {
 326             $y_max = $in if $in > $y_max;
 327             $y_min = $in if $in < $y_min;
 328             $in_sum += $in;
 329             $in_max = $in if $in > $in_max;
 330             $in_min = $in if $in < $in_min;
 331         }
 332         foreach my $out ( @out ) {
 333             $y_max = $out if $out > $y_max;
 334             $y_min = $out if $out < $y_min;
 335             $out_sum += $out;
 336             $out_max = $out if $out > $out_max;
 337             $out_min = $out if $out < $out_min;
 338         }
 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);
 349
 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;
 356
 357       my @data = ( \@times, \@in, \@out );
 358
 359       # hardcoded size, colour, etc.
 360       my $graph = new GD::Graph::mixed(600,400);
 361       $graph->set(
 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 {
 367             my $value = shift;
 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)
 376             }
 377             $value;
 378         },
 379         y_number_format => sub {
 380             my $value = shift;
 381             $self->_format_bandwidth($value,1);
 382         },
 383         y_label => 'bps',
 384         legend_placement => 'BR',
 385         title => $self->serviceid,
 386       ) or return "can't create graph: ".$graph->error;
 387
 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;
 392
 393       my $gd = $graph->plot(\@data);
 394       return "graph error: ".$graph->error unless($gd);
 395       return $gd->png;
 396   }
 397
 398   '';
 399 }
 400
 401 =back
 402
 403 =head1 BUGS
 404
 405 =head1 SEE ALSO
 406
 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.
 409
 410 =cut
 411
 412 1;
 413