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 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 = 0;
  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;
 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         my $serviceid_sql = "('${serviceid}_IN','${serviceid}_OUT')";
 259         my @records;
 260         my $dbh = dbh;
 261         if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
 262             @records = qsearch({
 263                 'table' => 'srvexport',
 264                 'select' => "*, date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) as _date",
 265                 'extra_sql' => "where serviceid in $serviceid_sql and
 266                     date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) >= $start
 267                     and date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) <= $end",
 268                 'order_by' => "order by date_part('epoch',to_timestamp(srv_date||' '||srv_time,'YYYY-MM-DD HH:MI:SS')) asc",
 269              });
 270          } elsif ( $dbh->{Driver}->{Name} eq 'mysql' ) {
 271                 @records = qsearch({
 272                     'table' => 'srvexport',
 273                     'select' => "*, unix_timestamp(srv_date||' '||srv_time) as _date",
 274                     'extra_sql' => "where serviceid in $serviceid_sql and
 275                         unix_timestamp(srv_date||' '||srv_time) >= $start
 276                         and unix_timestamp(srv_date||' '||srv_time) <= $end",
 277                     'order_by' => "order by unix_timestamp(srv_date||' '||srv_time) asc",
 278                  });
 279         } else {
 280               return 'Unsupported DBMS';
 281         }
 282
 283
 284         # assume data in DB is correct,
 285         # assume always _IN and _OUT pair, assume intvl = 300
 286
 287         my @times;
 288         my @in;
 289         my @out;
 290         foreach my $rec ( @records ) {
 291             push @times, $rec->_date
 292                 unless grep { $_ eq $rec->_date } @times;
 293             push @in, $rec->value if $rec->serviceid =~ /_IN$/;
 294             push @out, $rec->value if $rec->serviceid =~ /_OUT$/;
 295         }
 296
 297         my $timediff = $times[-1] - $times[0]; # they're sorted ascending
 298
 299         my $y_min = 999999999999; # ~1Tbps
 300         my $y_max = 0;
 301         my $in_sum = 0;
 302         my $out_sum = 0;
 303         my $in_min = 999999999999;
 304         my $in_max = 0;
 305         my $out_min = 999999999999;
 306         my $out_max = 0;
 307         foreach my $in ( @in ) {
 308             $y_max = $in if $in > $y_max;
 309             $y_min = $in if $in < $y_min;
 310             $in_sum += $in;
 311             $in_max = $in if $in > $in_max;
 312             $in_min = $in if $in < $in_min;
 313         }
 314         foreach my $out ( @out ) {
 315             $y_max = $out if $out > $y_max;
 316             $y_min = $out if $out < $y_min;
 317             $out_sum += $out;
 318             $out_max = $out if $out > $out_max;
 319             $out_min = $out if $out < $out_min;
 320         }
 321         my $bwdiff = $y_max - $y_min;
 322         $in_min = $self->_format_bandwidth($in_min);
 323         $out_min = $self->_format_bandwidth($out_min);
 324         $in_max = $self->_format_bandwidth($in_max);
 325         $out_max = $self->_format_bandwidth($out_max);
 326         my $in_curr = $self->_format_bandwidth($in[-1]);
 327         my $out_curr = $self->_format_bandwidth($out[-1]);
 328         my $numsamples = scalar(@records)/2;
 329         my $in_avg = $self->_format_bandwidth($in_sum/$numsamples);
 330         my $out_avg = $self->_format_bandwidth($out_sum/$numsamples);
 331
 332       warn "$me timediff=$timediff bwdiff=$bwdiff start=$start end=$end "
 333             . "in_min=$in_min out_min=$out_min in_max=$in_max "
 334             . "out_max=$out_max in_avg=$in_avg out_avg=$out_avg "
 335             . " # records = " . scalar(@records) . "\n\ntimes:\n"
 336             . Dumper(@times) . "\n\nin:\n" . Dumper(@in) . "\n\nout:\n"
 337             . Dumper(@out) if $DEBUG;
 338
 339       my @data = ( \@times, \@in, \@out );
 340
 341       # hardcoded size, colour, etc.
 342       my $graph = new GD::Graph::mixed(600,400);
 343       $graph->set(
 344         types => ['area','lines'],
 345         dclrs => ['green','blue'],
 346         x_label => "(In Out)  Current: $in_curr $out_curr  Average: $in_avg $out_avg  Maximum: $in_max $out_max  Minimum: $in_min $out_min",
 347         x_tick_number => 'auto',
 348         x_number_format => sub {
 349             my $value = shift;
 350             if ( $timediff < 86401 ) { # one day
 351                 $value = time2str("%a %H:%M",$value)
 352             } elsif ( $timediff < 86401*7 ) { # one week
 353                 $value = time2str("%d",$value)
 354             } elsif ( $timediff < 86401*30 ) { # one month
 355                 $value = time2str("Week %U",$value)
 356             } elsif ( $timediff < 86401*366 ) { # one year
 357                 $value = time2str("%b",$value)
 358             }
 359             $value;
 360         },
 361         y_number_format => sub {
 362             my $value = shift;
 363             $self->_format_bandwidth($value,1);
 364         },
 365         y_label => 'bps',
 366         legend_placement => 'BR',
 367         title => $self->serviceid,
 368       ) or return "can't create graph: ".$graph->error;
 369
 370       $graph->set_text_clr('black')
 371         or return "can't set text colour: ".$graph->error;
 372       $graph->set_legend(('In','Out'))
 373         or return "can't set legend: ".$graph->error;
 374
 375       my $gd = $graph->plot(\@data);
 376       return "graph error: ".$graph->error unless($gd);
 377       return $gd->png;
 378   }
 379
 380   '';
 381 }
 382
 383 =back
 384
 385 =head1 BUGS
 386
 387 =head1 SEE ALSO
 388
 389 L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
 390 L<FS::cust_pkg>, schema.html from the base documentation.
 391
 392 =cut
 393
 394 1;
 395