disable fcc 477 deployment zones, RT#85668
[freeside.git] / FS / FS / deploy_zone.pm
index 38dd7dc..723b491 100644 (file)
@@ -6,6 +6,13 @@ use FS::Record qw( qsearch qsearchs dbh );
 use Storable qw(thaw);
 use MIME::Base64;
 
+use Cpanel::JSON::XS;
+use LWP::UserAgent;
+use HTTP::Request::Common;
+
+# update this in 2020, along with the URL for the TIGERweb service
+our $CENSUS_YEAR = 2010;
+
 =head1 NAME
 
 FS::deploy_zone - Object methods for deploy_zone records
@@ -48,6 +55,12 @@ Optional text describing the zone.
 
 The agent that serves this zone.
 
+=item censusyear
+
+The census map year for which this zone was last updated. May be null for
+zones that contain no census blocks (mobile zones, or fixed zones that haven't
+had their block lists filled in yet).
+
 =item dbaname
 
 The name under which service is marketed in this zone.  If null, will 
@@ -58,6 +71,8 @@ default to the agent name.
 The way the zone geography is defined: "B" for a list of census blocks
 (used by the FCC for fixed broadband service), "P" for a polygon (for 
 mobile services).  See L<FS::deploy_zone_block> and L<FS::deploy_zone_vertex>.
+Note that block-type zones are still allowed to have a vertex list, for
+use by the map editor.
 
 =item technology
 
@@ -147,12 +162,16 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   # clean up linked records
   my $self = shift;
-  my $error = $self->process_o2m(
-    'table'   => $self->element_table,
-    'num_col' => 'zonenum',
-    'fields'  => 'zonenum',
-    'params'  => {},
-  ) || $self->SUPER::delete(@_);
+  my $error;
+  foreach (qw(deploy_zone_block deploy_zone_vertex)) {
+    $error ||= $self->process_o2m(
+      'table'   => $_,
+      'num_col' => 'zonenum',
+      'fields'  => 'zonenum',
+      'params'  => {},
+    );
+  }
+  $error ||= $self->SUPER::delete(@_);
   
   if ($error) {
     dbh->rollback if $oldAutoCommit;
@@ -168,8 +187,15 @@ returns the error, otherwise returns false.
 
 =cut
 
-# the replace method can be inherited from FS::Record
+sub replace {
+  my $self = shift;
+  my $old = shift || $self->replace_old;
+
+  $self->expire_date(time)
+    if $self->disabled eq 'Y' && ! $old->disabled && ! $self->expire_date;
 
+  $self->SUPER::replace($old, @_);
+}
 =item check
 
 Checks all fields to make sure this is a valid zone record.  If there is
@@ -185,6 +211,7 @@ sub check {
     $self->ut_numbern('zonenum')
     || $self->ut_text('description')
     || $self->ut_number('agentnum')
+    || $self->ut_numbern('censusyear')
     || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
     || $self->ut_textn('dbaname')
     || $self->ut_enum('zonetype', [ 'B', 'P' ])
@@ -219,24 +246,6 @@ sub check {
   $self->SUPER::check;
 }
 
-=item element_table
-
-Returns the name of the table that contains the zone's elements (blocks or
-vertices).
-
-=cut
-
-sub element_table {
-  my $self = shift;
-  if ($self->zonetype eq 'B') {
-    return 'deploy_zone_block';
-  } elsif ( $self->zonetype eq 'P') {
-    return 'deploy_zone_vertex';
-  } else {
-    die 'unknown zonetype';
-  }
-}
-
 =item deploy_zone_block
 
 Returns the census block records in this zone, in order by census block
@@ -244,8 +253,7 @@ number.  Only appropriate to block-type zones.
 
 =item deploy_zone_vertex
 
-Returns the vertex records for this zone, in order by sequence number.  Only
-appropriate to polygon-type zones.
+Returns the vertex records for this zone, in order by sequence number.
 
 =cut
 
@@ -267,7 +275,19 @@ sub deploy_zone_vertex {
   });
 }
 
-=back
+=item vertices_json
+
+Returns the vertex list for this zone, as a JSON string of
+
+[ [ latitude0, longitude0 ], [ latitude1, longitude1 ] ... ]
+
+=cut
+
+sub vertices_json {
+  my $self = shift;
+  my @vertices = map { [ $_->latitude, $_->longitude ] } $self->deploy_zone_vertex;
+  encode_json(\@vertices);
+}
 
 =head2 SUBROUTINES
 
@@ -315,7 +335,126 @@ sub process_batch_import {
   FS::Record::process_batch_import( $job, $opt, $param );
 
 }
-        
+
+=item process_block_lookup JOB, ZONENUM
+
+Look up all the census blocks in the zone's footprint, and insert them.
+This will replace any existing block list.
+
+=cut
+
+sub process_block_lookup {
+  my $job = shift;
+  my $param = shift;
+  if (!ref($param)) {
+    $param = thaw(decode_base64($param));
+  }
+  my $zonenum = $param->{zonenum};
+  my $zone = FS::deploy_zone->by_key($zonenum)
+    or die "zone $zonenum not found\n";
+
+  # wipe the existing list of blocks
+  my $error = $zone->process_o2m(
+    'table'   => 'deploy_zone_block',
+    'num_col' => 'zonenum', 
+    'fields'  => 'zonenum',
+    'params'  => {},
+  );
+  die $error if $error;
+
+  $job->update_statustext('0,querying census database') if $job;
+
+  # negotiate the rugged jungle trails of the ArcGIS REST protocol:
+  # 1. unlike most places, longitude first.
+  my @zone_vertices = map { [ $_->longitude, $_->latitude ] }
+    $zone->deploy_zone_vertex;
+
+  return if scalar(@zone_vertices) < 3; # then don't bother
+
+  # 2. package this as "rings", inside a JSON geometry object
+  # 3. announce loudly and frequently that we are using spatial reference 
+  #    4326, "true GPS coordinates"
+  my $geometry = encode_json({
+      'rings' => [ \@zone_vertices ],
+      'wkid'  => 4326,
+  });
+
+  my %query = (
+    f               => 'json', # duh
+    geometry        => $geometry,
+    geometryType    => 'esriGeometryPolygon', # as opposed to a bounding box
+    inSR            => 4326,
+    outSR           => 4326,
+    spatialRel      => 'esriSpatialRelIntersects', # the test to perform
+    outFields       => 'OID,GEOID',
+    returnGeometry  => 'false',
+    orderByFields   => 'OID',
+  );
+  my $url = 'https://tigerweb.geo.census.gov/arcgis/rest/services/TIGERweb/Tracts_Blocks/MapServer/12/query';
+  my $ua = LWP::UserAgent->new;
+
+  # first find out how many of these we're dealing with
+  my $response = $ua->request(
+    POST $url, Content => [
+      %query,
+      returnCountOnly => 1,
+    ]
+  );
+  die $response->status_line unless $response->is_success;
+  my $data = decode_json($response->content);
+  # their error messages are mostly useless, but don't just blindly continue
+  die $data->{error}{message} if $data->{error};
+
+  my $count = $data->{count};
+  my $inserted = 0;
+
+  #warn "Census block lookup: $count\n";
+
+  # we have to do our own pagination on this, because the census bureau
+  # doesn't support resultOffset (maybe they don't have ArcGIS 10.3 yet).
+  # that's why we're ordering by OID, it's globally unique
+  my $last_oid = 0;
+  my $done = 0;
+  while (!$done) {
+    $response = $ua->request(
+      POST $url, Content => [
+        %query,
+        where => "OID>$last_oid",
+      ]
+    );
+    die $response->status_line unless $response->is_success;
+    $data = decode_json($response->content);
+    die $data->{error}{message} if $data->{error};
+    last unless scalar @{$data->{features}}; #Nothing to insert
+
+    foreach my $feature (@{ $data->{features} }) {
+      my $geoid = $feature->{attributes}{GEOID}; # the prize
+      my $block = FS::deploy_zone_block->new({
+          zonenum     => $zonenum,
+          censusblock => $geoid
+      });
+      $error = $block->insert;
+      die "$error (inserting census block $geoid)" if $error;
+
+      $inserted++;
+      if ($job and $inserted % 100 == 0) {
+        my $percent = sprintf('%.0f', $inserted / $count * 100);
+        $job->update_statustext("$percent,creating block records");
+      }
+    }
+
+    #warn "Inserted $inserted records\n";
+    $last_oid = $data->{features}[-1]{attributes}{OID};
+    $done = 1 unless $data->{exceededTransferLimit};
+  }
+
+  $zone->set('censusyear', $CENSUS_YEAR);  
+  $error = $zone->replace;
+  warn "$error (updating zone census year)" if $error; # whatever, continue
+
+  return;
+}
+
 =head1 BUGS
 
 =head1 SEE ALSO