eliminate some false laziness in FS::Misc::send_email vs. msg_template/email.pm send_...

[freeside.git] / FS / FS / svc_IP_Mixin.pm

diff --git a/FS/FS/svc_IP_Mixin.pm b/FS/FS/svc_IP_Mixin.pm
index abafe86..4c2180e 100644 (file)
--- a/FS/FS/svc_IP_Mixin.pm
+++ b/FS/FS/svc_IP_Mixin.pm
@@ -3,7 +3,8 @@ use base 'FS::IP_Mixin';
 
 use strict;
 use NEXT;
-use FS::Record qw(qsearchs qsearch);
+use Carp qw(croak carp);
+use FS::Record qw(qsearchs qsearch dbh);
 use FS::Conf;
 use FS::router;
 use FS::part_svc_router;
@@ -80,7 +81,7 @@ sub svc_ip_check {
   my $error = $self->ip_check;
   return $error if $error;
   if ( my $router = $self->router ) {
-    if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) {
+    if ( grep { $_->routernum == $router->routernum } $self->allowed_routers ) {
       return '';
     } else {
       return 'Router '.$router->routername.' not available for this service';
@@ -90,21 +91,71 @@ sub svc_ip_check {
 }
 
 sub _used_addresses {
-  my ($class, $block, $exclude) = @_;
-  my $ip_field = $class->table_info->{'ip_field'}
-    or return ();
-  # if the service doesn't have an ip_field, then it has no IP addresses 
-  # in use, yes? 
-
-  my %hash = ( $ip_field => { op => '!=', value => '' } );
-  #$hash{'blocknum'} = $block->blocknum if $block;
-  $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude;
-  map { my $na = $_->NetAddr; $na ? $na->addr : () }
-    qsearch({
-        table     => $class->table,
-        hashref   => \%hash,
-        extra_sql => " AND $ip_field != '0e0'",
-    });
+  my ($class, $block, $exclude_svc) = @_;
+
+  croak "_used_addresses() requires an FS::addr_block parameter"
+    unless ref $block && $block->isa('FS::addr_block');
+
+  my $ip_field = $class->table_info->{'ip_field'};
+  if ( !$ip_field ) {
+    carp "_used_addresses() skipped, no ip_field";
+    return;
+  }
+
+  my %qsearch = ( $ip_field => { op => '!=', value => '' });
+  $qsearch{svcnum} = { op => '!=', value => $exclude_svc->svcnum }
+    if ref $exclude_svc && $exclude_svc->svcnum;
+
+  my $block_na = $block->NetAddr;
+
+  my $octets;
+  if ($block->ip_netmask >= 24) {
+    $octets = 3;
+  } elsif ($block->ip_netmask >= 16) {
+    $octets = 2;
+  } elsif ($block->ip_netmask >= 8) {
+    $octets = 1;
+  }
+
+  #  e.g.
+  # SELECT ip_addr
+  # FROM svc_broadband
+  # WHERE ip_addr != ''
+  #   AND ip_addr != '0e0'
+  #   AND ip_addr LIKE '10.0.2.%';
+  #
+  # For /24, /16 and /8 this approach is fast, even when svc_broadband table
+  # contains 650,000+ ip records.  For other allocations, this approach is
+  # not speedy, but usable.
+  #
+  # Note: A use case like this would could greatly benefit from a qsearch()
+  #       parameter to bypass FS::Record objects creation and just
+  #       return hashrefs from DBI.  200,000 hashrefs are many seconds faster
+  #       than 200,000 FS::Record objects
+  my %qsearch_param = (
+      table     => $class->table,
+      select    => $ip_field,
+      hashref   => \%qsearch,
+      extra_sql => " AND $ip_field != '0e0' ",
+  );
+  if ( $octets ) {
+    my $block_str = join('.', (split(/\D/, $block_na->first))[0..$octets-1]);
+    $qsearch_param{extra_sql}
+      .= " AND $ip_field LIKE ".dbh->quote("${block_str}.%");
+  }
+
+  if ( $block->ip_netmask % 8 ) {
+    # Some addresses returned by qsearch may be outside the network block,
+    # so each ip address is tested to be in the block before it's returned.
+    return
+      grep { $block_na->contains( NetAddr::IP->new( $_ ) ) }
+      map { $_->$ip_field }
+      qsearch( \%qsearch );
+  }
+
+  return
+    map { $_->$ip_field }
+    qsearch( \%qsearch_param );
 }
 
 sub _is_used {
@@ -186,7 +237,9 @@ means "Framed-Route" if there's an attached router.
 
 sub radius_reply {
   my $self = shift;
+
   my %reply = ();
+
   if ( my $block = $self->attached_block ) {
     # block routed over dynamic IP: "192.168.100.0/29 0.0.0.0 1"
     # or
@@ -196,21 +249,9 @@ sub radius_reply {
                              ($self->ip_addr || '0.0.0.0') . ' 1';
   }
 
-  if ( $self->router_routernum && FS::Conf->new->exists('radius-canopy') ) {
- 
-    my @addr_block =
-      qsearch('addr_block', { routernum => $self->router_routernum } );
-    if ( @addr_block ) {
-
-      #?
-      warn "Multiple address blocks attached to this service's router; using first"
-        if scalar(@addr_block) > 1;
+  $reply{'Motorola-Canopy-Gateway'} = $self->addr_block->ip_gateway
+    if FS::Conf->new->exists('radius-canopy') && $self->addr_block;
 
-      $reply{'Motorola-Canopy-Gateway'} = $addr_block[0]->ip_gateway
-
-    }
-    
-  }
   %reply;
 }
 
@@ -232,4 +273,41 @@ sub replace_check {
   ref($err_or_ref) ? '' : $err_or_ref;
 }
 
+=item addr_status
+
+Returns the ping status record for this service's address, if there
+is one.
+
+=cut
+
+sub addr_status {
+  my $self = shift;
+  my $addr = $self->ip_addr or return;
+  qsearchs('addr_status', { 'ip_addr'  => $addr });
+}
+
+=item addr_status_color
+
+Returns the CSS color for the ping status of this service.
+
+=cut
+
+# subject to change; should also show high/low latency (yellow?) and
+# staleness of data (probably means the daemon is not running) and packet
+# loss (once we measure that)
+
+sub addr_status_color {
+  my $self = shift;
+  if ( my $addr_status = $self->addr_status ) {
+    if ( $addr_status->up ) {
+      return 'green';
+    } else {
+      return 'red';
+    }
+  } else {
+    return 'gray';
+  }
+}
+  
+
 1;