svc_broadband rewrite

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

diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm
index ab92fb3..45f6c36 100755 (executable)
--- a/FS/FS/svc_broadband.pm
+++ b/FS/FS/svc_broadband.pm
@@ -2,10 +2,10 @@ package FS::svc_broadband;
 
 use strict;
 use vars qw(@ISA $conf);
 
 use strict;
 use vars qw(@ISA $conf);

-#use FS::Record qw( qsearch qsearchs );

 use FS::Record qw( qsearchs qsearch dbh );
 use FS::svc_Common;
 use FS::cust_svc;
 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 NetAddr::IP;
 
 @ISA = qw( FS::svc_Common );


@@ -45,25 +45,6 @@ An FS::svc_broadband object represents a 'broadband' Internet connection, such
 as a DSL, cable modem, or fixed wireless link.  These services are assumed to
 have the following properties:
 
 as a DSL, cable modem, or fixed wireless link.  These services are assumed to
 have the following properties:
 

-=over 2
-
-=item
-The network consists of one or more 'Access Concentrators' (ACs), such as
-DSLAMs or wireless access points.  (See L<FS::ac>.)
-
-=item
-Each AC provides connectivity to one or more contiguous blocks of IP addresses,
-each described by a gateway address and a netmask.  (See L<FS::ac_block>.)
-
-=item
-Each connection has one or more static IP addresses within one of these blocks.
-
-=item
-The details of configuring routers and other devices are to be handled by a 
-site-specific L<FS::part_export> subclass.
-
-=back
-

 FS::svc_broadband inherits from FS::svc_Common.  The following fields are
 currently supported:
 
 FS::svc_broadband inherits from FS::svc_Common.  The following fields are
 currently supported:
 


@@ -71,14 +52,7 @@ currently supported:
 
 =item svcnum - primary key
 
 
 =item svcnum - primary key
 

-=item
-actypenum - access concentrator type; see L<FS::ac_type>.  This is included here
-so that a part_svc can specifically be a 'wireless' or 'DSL' service by
-designating actypenum as a fixed field.  It does create a redundant functional
-dependency between this table and ac_type, in that the matching ac_type could
-be found by looking up the IP address in ac_block and then finding the block's
-AC, but part_svc can't do that, and we don't feel like hacking it so that it
-can.
+=item blocknum - see FS::addr_block

 
 =item
 speed_up - maximum upload speed, in bits per second.  If set to zero, upload
 
 =item
 speed_up - maximum upload speed, in bits per second.  If set to zero, upload


@@ -89,28 +63,12 @@ connection.
 =item
 speed_down - maximum download speed, as above
 
 =item
 speed_down - maximum download speed, as above
 

-=item
-ip_addr - the customer's IP address.  If the customer needs more than one IP
-address, set this to the address of the customer's router.  As a result, the
-customer's router will have the same address for both it's internal and external
+=item ip_addr - the customer's IP address.  If the customer needs more than one
+IP address, set this to the address of the customer's router.  As a result, the
+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.
 
 interfaces thus saving address space.  This has been found to work on most NAT
 routers available.
 

-=item
-ip_netmask - the customer's netmask, as a single integer in the range 0-32.
-(E.g. '24', not '255.255.255.0'.  We assume that address blocks are contiguous.)
-This should be 32 unless the customer has multiple IP addresses.
-
-=item
-mac_addr - the MAC address of the customer's router or other device directly
-connected to the network, if needed.  Some systems (e.g. DHCP, MAC address-based
-access control) may need this.  If not, you may leave it blank.
-
-=item
-location - a human-readable description of the location of the connected site,
-such as its address.  This should not be used for billing or contact purposes;
-that information is stored in L<FS::cust_main>.
-

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -120,7 +78,7 @@ that information is stored in L<FS::cust_main>.
 =item new HASHREF
 
 Creates a new svc_broadband.  To add the record to the database, see
 =item new HASHREF
 
 Creates a new svc_broadband.  To add the record to the database, see

-L<"insert">.
+"insert".

 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.
 
 Note that this stores the hash reference, not a distinct copy of the hash it
 points to.  You can ask the object for a copy with the I<hash> method.


@@ -134,14 +92,12 @@ sub table { 'svc_broadband'; }
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 

-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be 
+The additional fields pkgnum and svcpart (see FS::cust_svc) should be 

 defined.  An FS::cust_svc record will be created and inserted.
 
 =cut
 
 defined.  An FS::cust_svc record will be created and inserted.
 
 =cut
 

-# sub insert {}

 # Standard FS::svc_Common::insert
 # Standard FS::svc_Common::insert

-# (any necessary Deep Magic is handled by exports)

 
 =item delete
 
 
 =item delete
 


@@ -159,19 +115,62 @@ returns the error, otherwise returns false.
 =cut
 
 # Standard FS::svc_Common::replace
 =cut
 
 # Standard FS::svc_Common::replace

-# Notice a pattern here?
+
+=item sb_field
+
+Returns a list of FS::sb_field objects assigned to this object.
+
+=cut
+
+sub sb_field {
+  my $self = shift;
+
+  return qsearch( 'sb_field', { svcnum => $self->svcnum } );
+}
+
+=item sb_field_hashref
+
+Returns a hashref of the FS::sb_field key/value pairs for this object.
+
+Deprecated.  Please don't use it.
+
+=cut
+
+# Kristian wrote this, but don't hold it against him.  He was under a powerful
+# distracting influence whom he evidently found much more interesting than
+# svc_broadband.pm.  I can't say I blame him.
+
+sub sb_field_hashref {
+  my $self = shift;
+  my $svcpart = shift;
+
+  if ((not $svcpart) && ($self->cust_svc)) {
+    $svcpart = $self->cust_svc->svcpart;
+  }
+
+  my $hashref = {};
+
+  map {
+    my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart,
+                                          svcnum => $self->svcnum });
+    $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : '';
+  } qsearch('part_sb_field', { svcpart => $svcpart });
+
+  return $hashref;
+
+}

 
 =item suspend
 
 
 =item suspend
 

-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+Called by the suspend method of FS::cust_pkg (see FS::cust_pkg).

 
 =item unsuspend
 
 
 =item unsuspend
 

-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg).

 
 =item cancel
 
 
 =item cancel
 

-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+Called by the cancel method of FS::cust_pkg (see FS::cust_pkg).

 
 =item check
 
 
 =item check
 


@@ -189,105 +188,99 @@ sub check {
 
   my $error =
     $self->ut_numbern('svcnum')
 
   my $error =
     $self->ut_numbern('svcnum')

-    || $self->ut_foreign_key('actypenum', 'ac_type', 'actypenum')
+    || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum')

     || $self->ut_number('speed_up')
     || $self->ut_number('speed_down')
     || $self->ut_number('speed_up')
     || $self->ut_number('speed_down')

-    || $self->ut_ip('ip_addr')
-    || $self->ut_numbern('ip_netmask')
-    || $self->ut_textn('mac_addr')
-    || $self->ut_textn('location')
+    || $self->ut_ipn('ip_addr')

   ;
   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'; }
 
   ;
   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'; }
 

-  # This should catch errors in the ip_addr and ip_netmask.  If it doesn't,
-  # they'll almost certainly not map into a valid block anyway.
-  my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask);
-  return 'Cannot parse address: ' . $self->ip_addr . '/' . $self->ip_netmask unless $self_addr;
-
-  my @block = grep { 
-    my $block_addr = new NetAddr::IP ($_->ip_gateway, $_->ip_netmask);
-    if ($block_addr->contains($self_addr)) { $_ };
-  } qsearch( 'ac_block', { acnum => $self->acnum });
-
-  if(scalar @block == 0) {
-    return 'Block not found for address '.$self->ip_addr.' in actype '.$self->actypenum;
-  } elsif(scalar @block > 1) {
-    return 'ERROR: Intersecting blocks found for address '.$self->ip_addr.' :'.
-        join ', ', map {$_->ip_addr . '/' . $_->ip_netmask} @block;
+  if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') {
+    $self->ip_addr($self->addr_block->next_free_addr->addr);
+    if (not $self->ip_addr) {
+      return "No free addresses in addr_block (blocknum: ".$self->blocknum.")";
+    }

   }
   }

-  # OK, we've found a valid block.  We don't actually _do_ anything with it, though; we 
-  # just take comfort in the knowledge that it exists.

 
 

-  # A simple qsearchs won't work here.  Since we can assign blocks to customers,
-  # we have to make sure the new address doesn't fall within someone else's
-  # block.  Ugh.
+  # 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;

 
 

-  my @conflicts = grep {
-    my $cust_addr = new NetAddr::IP($_->ip_addr, $_->ip_netmask);
-    if (($cust_addr->contains($self_addr)) and
-        ($_->svcnum ne $self->svcnum)) { $_; };
-  } qsearch('svc_broadband', {});
-
-  if (scalar @conflicts > 0) {
-    return 'Address in use by existing service';
+  my $block_addr = $self->addr_block->NetAddr;
+  unless ($block_addr->contains($self_addr)) {
+    return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr;

   }
 
   }
 

-  # Are we trying to use a network, broadcast, or the AC's address?
-  foreach (qsearch('ac_block', { acnum => $self->acnum })) {
-    my $block_addr = new NetAddr::IP($_->ip_gateway, $_->ip_netmask);
-    if ($block_addr->network->addr eq $self_addr->addr) {
-      return 'Address is network address for block '. $block_addr->network;
-    }
-    if ($block_addr->broadcast->addr eq $self_addr->addr) {
-      return 'Address is broadcast address for block '. $block_addr->network;
-    }
-    if ($block_addr->addr eq $self_addr->addr) {
-      return 'Address belongs to the access concentrator: '. $block_addr->addr;
-    }
+  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
+  else {
+    return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart;

   }
 
   }
 

+

   ''; #no error
 }
 
   ''; #no error
 }
 

-=item ac_block
+=item NetAddr

 
 

-Returns the FS::ac_block record (i.e. the address block) for this broadband service.
+Returns a NetAddr::IP object containing the IP address of this service.  The netmask 
+is /32.

 
 =cut
 
 
 =cut
 

-sub ac_block {
+sub NetAddr {

   my $self = shift;
   my $self = shift;

-  my $self_addr = new NetAddr::IP ($self->ip_addr, $self->ip_netmask);
-
-  foreach my $block (qsearch( 'ac_block', {} )) {
-    my $block_addr = new NetAddr::IP ($block->ip_addr, $block->ip_netmask);
-    if($block_addr->contains($self_addr)) { return $block; }
-  }
-  return '';
+  return new NetAddr::IP ($self->ip_addr);

 }
 
 }
 

-=item ac_type
+=item addr_block

 
 

-Returns the FS::ac_type record for this broadband service.
+Returns the FS::addr_block record (i.e. the address block) for this broadband service.

 
 =cut
 
 
 =cut
 

-sub ac_type {
+sub addr_block {

   my $self = shift;
   my $self = shift;

-  return qsearchs('ac_type', { actypenum => $self->actypenum });
+
+  return qsearchs('addr_block', { blocknum => $self->blocknum });

 }
 
 =back
 
 }
 
 =back
 

+=item allowed_routers
+
+Returns a list of allowed FS::router objects.
+
+=cut
+
+sub allowed_routers {
+  my $self = shift;
+
+  return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart });
+}
+

 =head1 BUGS
 
 =head1 BUGS
 

+I think there's one place in the code where we actually use sb_field_hashref.
+That's a bug in itself.
+
+The real problem with it is that we're still grappling with the question of how
+tightly xfields should be integrated with real fields.  There are a few
+different directions we could go with it--we I<could> override several
+functions in Record so that xfields behave almost exactly like real fields (can
+be set with setfield(), appear in fields() and hash(), used as criteria in
+qsearch(), etc.).
+

 =head1 SEE ALSO
 
 =head1 SEE ALSO
 

-L<FS::svc_Common>, L<FS::Record>, L<FS::ac_type>, L<FS::ac_block>,
-L<FS::part_svc>, schema.html from the base documentation.
+FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field,
+FS::part_svc, schema.html from the base documentation.

 
 =cut
 
 
 =cut