sqlradius data volume report improvements, #18823
[freeside.git] / FS / FS / svc_broadband.pm
index 473cd57..26659d5 100755 (executable)
@@ -1,14 +1,15 @@
 package FS::svc_broadband;
+use base qw(FS::svc_Radius_Mixin FS::svc_Tower_Mixin FS::svc_Common);
 
 use strict;
-use vars qw(@ISA $conf);
+use vars qw($conf);
+
+{ no warnings 'redefine'; use NetAddr::IP; }
 use FS::Record qw( qsearchs qsearch dbh );
-use FS::svc_Common;
 use FS::cust_svc;
 use FS::addr_block;
-use NetAddr::IP;
-
-@ISA = qw( FS::svc_Common );
+use FS::part_svc_router;
+use FS::tower_sector;
 
 $FS::UID::callback{'FS::svc_broadband'} = sub { 
   $conf = new FS::Conf;
@@ -69,6 +70,8 @@ customer's router will have the same address for both its internal and external
 interfaces thus saving address space.  This has been found to work on most NAT
 routers available.
 
+=item plan_id
+
 =back
 
 =head1 METHODS
@@ -87,23 +90,197 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table_info {
   {
-    'name' => 'Broadband',
-    'name_plural' => 'Broadband services',
-    'longname_plural' => 'Fixed (username-less) broadband services',
+    'name' => 'Wireless broadband',
+    'name_plural' => 'Wireless broadband services',
+    'longname_plural' => 'Fixed wireless broadband services',
     'display_weight' => 50,
     'cancel_weight'  => 70,
+    'ip_field' => 'ip_addr',
     'fields' => {
-      'description' => 'Descriptive label for this particular device.',
+      'svcnum'      => 'Service',
+      'description' => 'Descriptive label for this particular device',
       'speed_down'  => 'Maximum download speed for this service in Kbps.  0 denotes unlimited.',
       'speed_up'    => 'Maximum upload speed for this service in Kbps.  0 denotes unlimited.',
       'ip_addr'     => 'IP address.  Leave blank for automatic assignment.',
-      'blocknum'    => 'Address block.',
+      'blocknum'    => 
+      { 'label' => 'Address block',
+                         'type'  => 'select',
+                         'select_table' => 'addr_block',
+                          'select_key'   => 'blocknum',
+                         'select_label' => 'cidr',
+                         'disable_inventory' => 1,
+                       },
+     'plan_id' => 'Service Plan Id',
+     'performance_profile' => 'Peformance Profile',
+     'authkey'      => 'Authentication key',
+     'mac_addr'     => 'MAC address',
+     'latitude'     => 'Latitude',
+     'longitude'    => 'Longitude',
+     'altitude'     => 'Altitude',
+     'vlan_profile' => 'VLAN profile',
+     'sectornum'    => 'Tower/sector',
+     'routernum'    => 'Router/block',
+     'usergroup'    => { 
+                         label => 'RADIUS groups',
+                         type  => 'select-radius_group.html',
+                         #select_table => 'radius_group',
+                         #select_key   => 'groupnum',
+                         #select_label => 'groupname',
+                         disable_inventory => 1,
+                         multiple => 1,
+                       },
     },
   };
 }
 
 sub table { 'svc_broadband'; }
 
+sub table_dupcheck_fields { ( 'ip_addr', 'mac_addr' ); }
+
+=item search HASHREF
+
+Class method which returns a qsearch hash expression to search for parameters
+specified in HASHREF.
+
+Parameters:
+
+=over 4
+
+=item unlinked - set to search for all unlinked services.  Overrides all other options.
+
+=item agentnum
+
+=item custnum
+
+=item svcpart
+
+=item ip_addr
+
+=item pkgpart - arrayref
+
+=item routernum - arrayref
+
+=item sectornum - arrayref
+
+=item towernum - arrayref
+
+=item order_by
+
+=back
+
+=cut
+
+sub search {
+  my ($class, $params) = @_;
+  my @where = ();
+  my @from = (
+    'LEFT JOIN cust_svc  USING ( svcnum  )',
+    'LEFT JOIN part_svc  USING ( svcpart )',
+    'LEFT JOIN cust_pkg  USING ( pkgnum  )',
+    'LEFT JOIN cust_main USING ( custnum )',
+  );
+
+  # based on FS::svc_acct::search, probably the most mature of the bunch
+  #unlinked
+  push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
+  
+  #agentnum
+  if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+    push @where, "cust_main.agentnum = $1";
+  }
+  push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
+    'null_right' => 'View/link unlinked services',
+    'table' => 'cust_main'
+  );
+
+  #custnum
+  if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
+    push @where, "custnum = $1";
+  }
+
+  #pkgpart, now properly untainted, can be arrayref
+  for my $pkgpart ( $params->{'pkgpart'} ) {
+    if ( ref $pkgpart ) {
+      my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
+      push @where, "cust_pkg.pkgpart IN ($where)" if $where;
+    }
+    elsif ( $pkgpart =~ /^(\d+)$/ ) {
+      push @where, "cust_pkg.pkgpart = $1";
+    }
+  }
+
+  #routernum, can be arrayref
+  for my $routernum ( $params->{'routernum'} ) {
+    # this no longer uses addr_block
+    if ( ref $routernum and grep { $_ } @$routernum ) {
+      my $in = join(',', map { /^(\d+)$/ ? $1 : () } @$routernum );
+      my @orwhere;
+      push @orwhere, "svc_broadband.routernum IN ($in)" if $in;
+      push @orwhere, "svc_broadband.routernum IS NULL" 
+        if grep /^none$/, @$routernum;
+      push @where, '( '.join(' OR ', @orwhere).' )';
+    }
+    elsif ( $routernum =~ /^(\d+)$/ ) {
+      push @where, "svc_broadband.routernum = $1";
+    }
+    elsif ( $routernum eq 'none' ) {
+      push @where, "svc_broadband.routernum IS NULL";
+    }
+  }
+
+  #sector and tower, as above
+  my @where_sector = $class->tower_sector_sql($params);
+  if ( @where_sector ) {
+    push @where, @where_sector;
+    push @from, 'LEFT JOIN tower_sector USING ( sectornum )';
+  }
+  #svcnum
+  if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
+    push @where, "svcnum = $1";
+  }
+
+  #svcpart
+  if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
+    push @where, "svcpart = $1";
+  }
+
+  #exportnum
+  if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
+    push @from, 'LEFT JOIN export_svc USING ( svcpart )';
+    push @where, "exportnum = $1";
+  }
+
+  #ip_addr
+  if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) {
+    push @where, "ip_addr = '$1'";
+  }
+
+  #custnum
+  if ( $params->{'custnum'} =~ /^(\d+)$/ and $1) {
+    push @where, "custnum = $1";
+  }
+  
+  my $addl_from = join(' ', @from);
+  my $extra_sql = '';
+  $extra_sql = 'WHERE '.join(' AND ', @where) if @where;
+  my $count_query = "SELECT COUNT(*) FROM svc_broadband $addl_from $extra_sql";
+  return( {
+      'table'   => 'svc_broadband',
+      'hashref' => {},
+      'select'  => join(', ',
+        'svc_broadband.*',
+        'part_svc.svc',
+        'cust_main.custnum',
+        FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
+      ),
+      'extra_sql' => $extra_sql,
+      'addl_from' => $addl_from,
+      'order_by'  => "ORDER BY ".($params->{'order_by'} || 'svcnum'),
+      'count_query' => $count_query,
+    } );
+}
+
 =item search_sql STRING
 
 Class method which returns an SQL fragment to search for the given string.
@@ -114,6 +291,10 @@ sub search_sql {
   my( $class, $string ) = @_;
   if ( $string =~ /^(\d{1,3}\.){3}\d{1,3}$/ ) {
     $class->search_sql_field('ip_addr', $string );
+  }elsif ( $string =~ /^([a-fA-F0-9]{12})$/ ) {
+    $class->search_sql_field('mac_addr', uc($string));
+  }elsif ( $string =~ /^(([a-fA-F0-9]{1,2}:){5}([a-fA-F0-9]{1,2}))$/ ) {
+    $class->search_sql_field('mac_addr', uc("$2$3$4$5$6$7") );
   } else {
     '1 = 0'; #false
   }
@@ -161,8 +342,6 @@ Delete this record from the database.
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
-=cut
-
 # Standard FS::svc_Common::replace
 
 =item suspend
@@ -191,55 +370,202 @@ sub check {
 
   return $x unless ref($x);
 
+  # remove delimiters
+  my $mac_addr = uc($self->get('mac_addr'));
+  $mac_addr =~ s/[-: ]//g;
+  $self->set('mac_addr', $mac_addr);
+
   my $error =
     $self->ut_numbern('svcnum')
-    || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum')
+    || $self->ut_numbern('blocknum')
+    || $self->ut_foreign_keyn('routernum', 'router', 'routernum')
+    || $self->ut_foreign_keyn('sectornum', 'tower_sector', 'sectornum')
     || $self->ut_textn('description')
-    || $self->ut_number('speed_up')
-    || $self->ut_number('speed_down')
+    || $self->ut_numbern('speed_up')
+    || $self->ut_numbern('speed_down')
     || $self->ut_ipn('ip_addr')
     || $self->ut_hexn('mac_addr')
     || $self->ut_hexn('auth_key')
-    || $self->ut_coordn('latitude', -90, 90)
-    || $self->ut_coordn('longitude', -180, 180)
+    || $self->ut_coordn('latitude')
+    || $self->ut_coordn('longitude')
     || $self->ut_sfloatn('altitude')
     || $self->ut_textn('vlan_profile')
+    || $self->ut_textn('plan_id')
   ;
   return $error if $error;
 
-  if($self->speed_up < 0) { return 'speed_up must be positive'; }
-  if($self->speed_down < 0) { return 'speed_down must be positive'; }
+  if(($self->speed_up || 0) < 0) { return 'speed_up must be positive'; }
+  if(($self->speed_down || 0) < 0) { return 'speed_down must be positive'; }
+
+  my $cust_svc = $self->svcnum
+                 ? qsearchs('cust_svc', { 'svcnum' => $self->svcnum } )
+                 : '';
+  my $cust_pkg;
+  my $svcpart;
+  if ($cust_svc) {
+    $cust_pkg = $cust_svc->cust_pkg;
+    $svcpart = $cust_svc->svcpart;
+  }else{
+    $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );
+    return "Invalid pkgnum" unless $cust_pkg;
+    $svcpart = $self->svcpart;
+  }
+  my $agentnum = $cust_pkg->cust_main->agentnum if $cust_pkg;
 
-  if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') {
-    my $next_addr = $self->addr_block->next_free_addr;
-    if ($next_addr) {
-      $self->ip_addr($next_addr->addr);
-    } else {
-      return "No free addresses in addr_block (blocknum: ".$self->blocknum.")";
+  if ( $conf->exists('auto_router') and $self->ip_addr and !$self->routernum ) {
+    # assign_router is guaranteed to provide a router that's legal
+    # for this agent and svcpart
+    my $error = $self->_check_ip_addr || $self->assign_router;
+    return $error if $error;
+  }
+  elsif ($self->routernum) {
+    return "Router ".$self->routernum." does not provide this service"
+      unless qsearchs('part_svc_router', { 
+        svcpart => $svcpart,
+        routernum => $self->routernum
+    });
+  
+    my $router = $self->router;
+    return "Router ".$self->routernum." does not serve this customer"
+      if $router->agentnum and $agentnum and $router->agentnum != $agentnum;
+
+    if ( $router->manual_addr ) {
+      $self->blocknum('');
+    }
+    else {
+      my $addr_block = $self->addr_block;
+      if ( $self->ip_addr eq '' 
+           and not ( $addr_block and $addr_block->manual_flag ) ) {
+        my $error = $self->assign_ip_addr;
+        return $error if $error;
+      }
+    }
+    my $error = $self->_check_ip_addr;
+    return $error if $error;
+  } # if $self->routernum
+
+  if ( $cust_pkg && ! $self->latitude && ! $self->longitude ) {
+    my $l = $cust_pkg->cust_location_or_main;
+    if ( $l->ship_latitude && $l->ship_longitude ) {
+      $self->latitude(  $l->ship_latitude  );
+      $self->longitude( $l->ship_longitude );
+    } elsif ( $l->latitude && $l->longitude ) {
+      $self->latitude(  $l->latitude  );
+      $self->longitude( $l->longitude );
     }
   }
 
-  # This should catch errors in the ip_addr.  If it doesn't,
-  # they'll almost certainly not map into the block anyway.
-  my $self_addr = $self->NetAddr; #netmask is /32
-  return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr;
+  $self->SUPER::check;
+}
+
+=item assign_ip_addr
+
+Assign an IP address matching the selected router, and the selected block
+if there is one.
+
+=cut
+
+sub assign_ip_addr {
+  my $self = shift;
+  my @blocks;
+  my $ip_addr;
 
-  my $block_addr = $self->addr_block->NetAddr;
-  unless ($block_addr->contains($self_addr)) {
-    return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr;
+  if ( $self->addr_block and $self->addr_block->routernum == $self->routernum ) {
+    # simple case: user chose a block, find an address in that block
+    # (this overrides an existing IP address if it's not in the block)
+    @blocks = ($self->addr_block);
+  }
+  elsif ( $self->routernum ) {
+    @blocks = $self->router->auto_addr_block;
   }
+  else { 
+    return '';
+  }
+#warn "assigning ip address in blocks\n".join("\n",map{$_->cidr} @blocks)."\n";
+
+  foreach my $block ( @blocks ) {
+    if ( $self->ip_addr and $block->NetAddr->contains($self->NetAddr) ) {
+      # don't change anything
+      return '';
+    }
+    $ip_addr = $block->next_free_addr;
+    if ( $ip_addr ) {
+      $self->set(ip_addr => $ip_addr->addr);
+      $self->set(blocknum => $block->blocknum);
+      return '';
+    }
+  }
+  return 'No IP address available on this router';
+}
+
+=item assign_router
+
+Assign an address block and router matching the selected IP address.
+Does nothing if IP address is null.
+
+=cut
+
+sub assign_router {
+  my $self = shift;
+  return '' if !$self->ip_addr;
+  #warn "assigning router/block for ".$self->ip_addr."\n";
+  foreach my $router ($self->allowed_routers) {
+    foreach my $block ($router->addr_block) {
+      if ( $block->NetAddr->contains($self->NetAddr) ) {
+        $self->blocknum($block->blocknum);
+        $self->routernum($block->routernum);
+        return '';
+      }
+    }
+  }
+  return $self->ip_addr.' is not in an allowed block.';
+}
+
+sub _check_ip_addr {
+  my $self = shift;
 
-  my $router = $self->addr_block->router 
-    or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum;
-  if(grep { $_->routernum == $router->routernum} $self->allowed_routers) {
-  } # do nothing
+  if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') {
+    return '' if $conf->exists('svc_broadband-allow_null_ip_addr'); 
+    return 'IP address required';
+  }
   else {
-    return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;
+    return 'Cannot parse address: '.$self->ip_addr unless $self->NetAddr;
   }
 
-  $self->SUPER::check;
+  if ( $self->addr_block 
+      and not $self->addr_block->NetAddr->contains($self->NetAddr) ) {
+    return 'Address '.$self->ip_addr.' not in block '.$self->addr_block->cidr;
+  }
+
+#  if (my $dup = qsearchs('svc_broadband', {
+#        ip_addr => $self->ip_addr,
+#        svcnum  => {op=>'!=', value => $self->svcnum}
+#      }) ) {
+#    return 'IP address conflicts with svcnum '.$dup->svcnum;
+#  }
+  '';
+}
+
+sub _check_duplicate {
+  my $self = shift;
+  # Not a reliable check because the table isn't locked, but 
+  # that's why we have a unique index.  This is just to give a
+  # friendlier error message.
+  my @dup;
+  @dup = $self->find_duplicates('global', 'ip_addr');
+  if ( @dup ) {
+    return "IP address in use (svcnum ".$dup[0]->svcnum.")";
+  }
+  @dup = $self->find_duplicates('global', 'mac_addr');
+  if ( @dup ) {
+    return "MAC address in use (svcnum ".$dup[0]->svcnum.")";
+  }
+
+  '';
 }
 
+
 =item NetAddr
 
 Returns a NetAddr::IP object containing the IP address of this service.  The netmask 
@@ -249,7 +575,7 @@ is /32.
 
 sub NetAddr {
   my $self = shift;
-  return new NetAddr::IP ($self->ip_addr);
+  new NetAddr::IP ($self->ip_addr);
 }
 
 =item addr_block
@@ -260,11 +586,19 @@ Returns the FS::addr_block record (i.e. the address block) for this broadband se
 
 sub addr_block {
   my $self = shift;
-
-  return qsearchs('addr_block', { blocknum => $self->blocknum });
+  qsearchs('addr_block', { blocknum => $self->blocknum });
 }
 
-=back
+=item router
+
+Returns the FS::router record for this service.
+
+=cut
+
+sub router {
+  my $self = shift;
+  qsearchs('router', { routernum => $self->routernum });
+}
 
 =item allowed_routers
 
@@ -274,14 +608,123 @@ Returns a list of allowed FS::router objects.
 
 sub allowed_routers {
   my $self = shift;
+  my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart;
+  my @r = map { $_->router } qsearch('part_svc_router', 
+    { svcpart => $svcpart });
+  if ( $self->cust_main ) {
+    my $agentnum = $self->cust_main->agentnum;
+    return grep { !$_->agentnum or $_->agentnum == $agentnum } @r;
+  }
+  else {
+    return @r;
+  }
+}
+
+=back
+
+
+=item mac_addr_formatted CASE DELIMITER
+
+Format the MAC address (for use by exports).  If CASE starts with "l"
+(for "lowercase"), it's returned in lowercase.  DELIMITER is inserted
+between octets.
+
+=cut
 
-  return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart });
+sub mac_addr_formatted {
+  my $self = shift;
+  my ($case, $delim) = @_;
+  my $addr = $self->mac_addr;
+  $addr = lc($addr) if $case =~ /^l/i;
+  join( $delim || '', $addr =~ /../g );
 }
 
+#class method
+sub _upgrade_data {
+  my $class = shift;
+
+  local($FS::svc_Common::noexport_hack) = 1;
+
+  # set routernum to addr_block.routernum
+  foreach my $self (qsearch('svc_broadband', {
+      blocknum => {op => '!=', value => ''},
+      routernum => ''
+    })) {
+    my $addr_block = $self->addr_block;
+    if ( !$addr_block ) {
+      # super paranoid mode
+      warn "WARNING: svcnum ".$self->svcnum." is assigned to addr_block ".$self->blocknum.", which does not exist; skipped.\n";
+      next;
+    }
+    my $ip_addr = $self->ip_addr;
+    my $routernum = $addr_block->routernum;
+    if ( $routernum ) {
+      $self->set(routernum => $routernum);
+      my $error = $self->check;
+      # sanity check: don't allow this to change IP address or block
+      # (other than setting blocknum to null for a non-auto-assigned router)
+      if ( $self->ip_addr ne $ip_addr 
+        or ($self->blocknum and $self->blocknum != $addr_block->blocknum)) {
+        warn "WARNING: Upgrading service ".$self->svcnum." would change its block/address; skipped.\n";
+        next;
+      }
+
+      $error ||= $self->replace;
+      warn "WARNING: error assigning routernum $routernum to service ".$self->svcnum.
+          ":\n$error; skipped\n"
+        if $error;
+    }
+    else {
+      warn "svcnum ".$self->svcnum.
+        ": no routernum in address block ".$addr_block->cidr.", skipped\n";
+    }
+  }
+
+  # assign blocknums to services that should have them
+  my @all_blocks = qsearch('addr_block', { });
+  SVC: foreach my $self ( 
+    qsearch({
+        'select' => 'svc_broadband.*',
+        'table' => 'svc_broadband',
+        'addl_from' => 'JOIN router USING (routernum)',
+        'hashref' => {},
+        'extra_sql' => 'WHERE svc_broadband.blocknum IS NULL '.
+                       'AND router.manual_addr IS NULL',
+    }) 
+  ) {
+   
+    next SVC if $self->ip_addr eq '';
+    my $NetAddr = $self->NetAddr;
+    # inefficient, but should only need to run once
+    foreach my $block (@all_blocks) {
+      if ($block->NetAddr->contains($NetAddr)) {
+        $self->set(blocknum => $block->blocknum);
+        my $error = $self->replace;
+        warn "WARNING: error assigning blocknum ".$block->blocknum.
+        " to service ".$self->svcnum."\n$error; skipped\n"
+          if $error;
+        next SVC;
+      }
+    }
+    warn "WARNING: no block found containing ".$NetAddr->addr." for service ".
+      $self->svcnum;
+    #next SVC;
+  }
+
+  '';
+}
+
+=back
+
 =head1 BUGS
 
 The business with sb_field has been 'fixed', in a manner of speaking.
 
+allowed_routers isn't agent virtualized because part_svc isn't agent
+virtualized
+
+Having both routernum and blocknum as foreign keys is somewhat dubious.
+
 =head1 SEE ALSO
 
 FS::svc_Common, FS::Record, FS::addr_block,