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