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