FS/FS/deploy_zone.pm

   1 package FS::deploy_zone;
   2
   3 use strict;
   4 use base qw( FS::o2m_Common FS::Record );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use Storable qw(thaw);
   7 use MIME::Base64;
   8
   9 use Cpanel::JSON::XS;
  10 use LWP::UserAgent;
  11 use HTTP::Request::Common;
  12
  13 # update this in 2020, along with the URL for the TIGERweb service
  14 our $CENSUS_YEAR = 2010;
  15
  16 =head1 NAME
  17
  18 FS::deploy_zone - Object methods for deploy_zone records
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::deploy_zone;
  23
  24   $record = new FS::deploy_zone \%hash;
  25   $record = new FS::deploy_zone { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35 =head1 DESCRIPTION
  36
  37 An FS::deploy_zone object represents a geographic zone where a certain kind
  38 of service is available.  Currently we store this information to generate
  39 the FCC Form 477 deployment reports, but it may find other uses later.
  40
  41 FS::deploy_zone inherits from FS::Record.  The following fields are currently
  42 supported:
  43
  44 =over 4
  45
  46 =item zonenum
  47
  48 primary key
  49
  50 =item description
  51
  52 Optional text describing the zone.
  53
  54 =item agentnum
  55
  56 The agent that serves this zone.
  57
  58 =item censusyear
  59
  60 The census map year for which this zone was last updated. May be null for
  61 zones that contain no census blocks (mobile zones, or fixed zones that haven't
  62 had their block lists filled in yet).
  63
  64 =item dbaname
  65
  66 The name under which service is marketed in this zone.  If null, will
  67 default to the agent name.
  68
  69 =item zonetype
  70
  71 The way the zone geography is defined: "B" for a list of census blocks
  72 (used by the FCC for fixed broadband service), "P" for a polygon (for
  73 mobile services).  See L<FS::deploy_zone_block> and L<FS::deploy_zone_vertex>.
  74 Note that block-type zones are still allowed to have a vertex list, for
  75 use by the map editor.
  76
  77 =item technology
  78
  79 The FCC technology code for the type of service available.
  80
  81 =item spectrum
  82
  83 For mobile service zones, the FCC code for the RF band.
  84
  85 =item adv_speed_up
  86
  87 For broadband, the advertised upstream bandwidth in the zone.  If multiple
  88 speed tiers are advertised, use the highest.
  89
  90 =item adv_speed_down
  91
  92 For broadband, the advertised downstream bandwidth in the zone.
  93
  94 =item cir_speed_up
  95
  96 For broadband, the contractually guaranteed upstream bandwidth, if that type
  97 of service is sold.
  98
  99 =item cir_speed_down
 100
 101 For broadband, the contractually guaranteed downstream bandwidth, if that
 102 type of service is sold.
 103
 104 =item is_consumer
 105
 106 'Y' if this service is sold for consumer/household use.
 107
 108 =item is_business
 109
 110 'Y' if this service is sold to business or institutional use.  Not mutually
 111 exclusive with is_consumer.
 112
 113 =item is_broadband
 114
 115 'Y' if this service includes broadband Internet.
 116
 117 =item is_voice
 118
 119 'Y' if this service includes voice communication.
 120
 121 =item active_date
 122
 123 The date this zone became active.
 124
 125 =item expire_date
 126
 127 The date this zone became inactive, if any.
 128
 129 =back
 130
 131 =head1 METHODS
 132
 133 =over 4
 134
 135 =item new HASHREF
 136
 137 Creates a new zone.  To add the zone to the database, see L<"insert">.
 138
 139 =cut
 140
 141 # the new method can be inherited from FS::Record, if a table method is defined
 142
 143 sub table { 'deploy_zone'; }
 144
 145 =item insert ELEMENTS
 146
 147 Adds this record to the database.  If there is an error, returns the error,
 148 otherwise returns false.
 149
 150 =cut
 151
 152 # the insert method can be inherited from FS::Record
 153
 154 =item delete
 155
 156 Delete this record from the database.
 157
 158 =cut
 159
 160 sub delete {
 161   my $oldAutoCommit = $FS::UID::AutoCommit;
 162   local $FS::UID::AutoCommit = 0;
 163   # clean up linked records
 164   my $self = shift;
 165   my $error;
 166   foreach (qw(deploy_zone_block deploy_zone_vertex)) {
 167     $error ||= $self->process_o2m(
 168       'table'   => $_,
 169       'num_col' => 'zonenum',
 170       'fields'  => 'zonenum',
 171       'params'  => {},
 172     );
 173   }
 174   $error ||= $self->SUPER::delete(@_);
 175
 176   if ($error) {
 177     dbh->rollback if $oldAutoCommit;
 178     return $error;
 179   }
 180   '';
 181 }
 182
 183 =item replace OLD_RECORD
 184
 185 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 186 returns the error, otherwise returns false.
 187
 188 =cut
 189
 190 sub replace {
 191   my $self = shift;
 192   my $old = shift || $self->replace_old;
 193
 194   $self->expire_date(time)
 195     if $self->disabled eq 'Y' && ! $old->disabled && ! $self->expire_date;
 196
 197   $self->SUPER::replace($old, @_);
 198 }
 199 =item check
 200
 201 Checks all fields to make sure this is a valid zone record.  If there is
 202 an error, returns the error, otherwise returns false.  Called by the insert
 203 and replace methods.
 204
 205 =cut
 206
 207 sub check {
 208   my $self = shift;
 209
 210   my $error =
 211     $self->ut_numbern('zonenum')
 212     || $self->ut_text('description')
 213     || $self->ut_number('agentnum')
 214     || $self->ut_numbern('censusyear')
 215     || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
 216     || $self->ut_textn('dbaname')
 217     || $self->ut_enum('zonetype', [ 'B', 'P' ])
 218     || $self->ut_number('technology')
 219     || $self->ut_numbern('spectrum')
 220     || $self->ut_decimaln('adv_speed_up', 3)
 221     || $self->ut_decimaln('adv_speed_down', 3)
 222     || $self->ut_decimaln('cir_speed_up', 3)
 223     || $self->ut_decimaln('cir_speed_down', 3)
 224     || $self->ut_flag('is_consumer')
 225     || $self->ut_flag('is_business')
 226     || $self->ut_flag('is_broadband')
 227     || $self->ut_flag('is_voice')
 228     || $self->ut_numbern('active_date')
 229     || $self->ut_numbern('expire_date')
 230   ;
 231   return $error if $error;
 232
 233   foreach(qw(adv_speed_down adv_speed_up cir_speed_down cir_speed_up)) {
 234     if ($self->get('is_broadband')) {
 235       if (!$self->get($_)) {
 236         $self->set($_, 0);
 237       }
 238     } else {
 239       $self->set($_, '');
 240     }
 241   }
 242   if (!$self->get('active_date')) {
 243     $self->set('active_date', time);
 244   }
 245
 246   $self->SUPER::check;
 247 }
 248
 249 =item deploy_zone_block
 250
 251 Returns the census block records in this zone, in order by census block
 252 number.  Only appropriate to block-type zones.
 253
 254 =item deploy_zone_vertex
 255
 256 Returns the vertex records for this zone, in order by sequence number.
 257
 258 =cut
 259
 260 sub deploy_zone_block {
 261   my $self = shift;
 262   qsearch({
 263       table     => 'deploy_zone_block',
 264       hashref   => { zonenum => $self->zonenum },
 265       order_by  => ' ORDER BY censusblock',
 266   });
 267 }
 268
 269 sub deploy_zone_vertex {
 270   my $self = shift;
 271   qsearch({
 272       table     => 'deploy_zone_vertex',
 273       hashref   => { zonenum => $self->zonenum },
 274       order_by  => ' ORDER BY vertexnum',
 275   });
 276 }
 277
 278 =item vertices_json
 279
 280 Returns the vertex list for this zone, as a JSON string of
 281
 282 [ [ latitude0, longitude0 ], [ latitude1, longitude1 ] ... ]
 283
 284 =cut
 285
 286 sub vertices_json {
 287   my $self = shift;
 288   my @vertices = map { [ $_->latitude, $_->longitude ] } $self->deploy_zone_vertex;
 289   encode_json(\@vertices);
 290 }
 291
 292 =head2 SUBROUTINES
 293
 294 =over 4
 295
 296 =item process_batch_import JOB, PARAMS
 297
 298 =cut
 299
 300 sub process_batch_import {
 301   eval {
 302     use FS::deploy_zone_block;
 303     use FS::deploy_zone_vertex;
 304   };
 305   my $job = shift;
 306   my $param = shift;
 307   if (!ref($param)) {
 308     $param = thaw(decode_base64($param));
 309   }
 310
 311   # even if creating a new zone, the deploy_zone object should already
 312   # be inserted by this point
 313   my $zonenum = $param->{zonenum}
 314     or die "zonenum required";
 315   my $zone = FS::deploy_zone->by_key($zonenum)
 316     or die "deploy_zone #$zonenum not found";
 317   my $opt;
 318   if ( $zone->zonetype eq 'B' ) {
 319     $opt = { 'table'    => 'deploy_zone_block',
 320              'params'   => [ 'zonenum', 'censusyear' ],
 321              'formats'  => { 'plain' => [ 'censusblock' ] },
 322              'default_csv' => 1,
 323            };
 324     $job->update_statustext('1,Inserting census blocks');
 325   } elsif ( $zone->zonetype eq 'P' ) {
 326     $opt = { 'table'    => 'deploy_zone_vertex',
 327              'params'   => [ 'zonenum' ],
 328              'formats'  => { 'plain' => [ 'latitude', 'longitude' ] },
 329              'default_csv' => 1,
 330            };
 331   } else {
 332     die "don't know how to import to zonetype ".$zone->zonetype;
 333   }
 334
 335   FS::Record::process_batch_import( $job, $opt, $param );
 336
 337 }
 338
 339 =item process_block_lookup JOB, ZONENUM
 340
 341 Look up all the census blocks in the zone's footprint, and insert them.
 342 This will replace any existing block list.
 343
 344 =cut
 345
 346 sub process_block_lookup {
 347   my $job = shift;
 348   my $param = shift;
 349   if (!ref($param)) {
 350     $param = thaw(decode_base64($param));
 351   }
 352   my $zonenum = $param->{zonenum};
 353   my $zone = FS::deploy_zone->by_key($zonenum)
 354     or die "zone $zonenum not found\n";
 355
 356   # wipe the existing list of blocks
 357   my $error = $zone->process_o2m(
 358     'table'   => 'deploy_zone_block',
 359     'num_col' => 'zonenum',
 360     'fields'  => 'zonenum',
 361     'params'  => {},
 362   );
 363   die $error if $error;
 364
 365   $job->update_statustext('0,querying census database') if $job;
 366
 367   # negotiate the rugged jungle trails of the ArcGIS REST protocol:
 368   # 1. unlike most places, longitude first.
 369   my @zone_vertices = map { [ $_->longitude, $_->latitude ] }
 370     $zone->deploy_zone_vertex;
 371
 372   return if scalar(@zone_vertices) < 3; # then don't bother
 373
 374   # 2. package this as "rings", inside a JSON geometry object
 375   # 3. announce loudly and frequently that we are using spatial reference
 376   #    4326, "true GPS coordinates"
 377   my $geometry = encode_json({
 378       'rings' => [ \@zone_vertices ],
 379       'wkid'  => 4326,
 380   });
 381
 382   my %query = (
 383     f               => 'json', # duh
 384     geometry        => $geometry,
 385     geometryType    => 'esriGeometryPolygon', # as opposed to a bounding box
 386     inSR            => 4326,
 387     outSR           => 4326,
 388     spatialRel      => 'esriSpatialRelIntersects', # the test to perform
 389     outFields       => 'OID,GEOID',
 390     returnGeometry  => 'false',
 391     orderByFields   => 'OID',
 392   );
 393   my $url = 'https://tigerweb.geo.census.gov/arcgis/rest/services/TIGERweb/Tracts_Blocks/MapServer/12/query';
 394   my $ua = LWP::UserAgent->new;
 395
 396   # first find out how many of these we're dealing with
 397   my $response = $ua->request(
 398     POST $url, Content => [
 399       %query,
 400       returnCountOnly => 1,
 401     ]
 402   );
 403   die $response->status_line unless $response->is_success;
 404   my $data = decode_json($response->content);
 405   # their error messages are mostly useless, but don't just blindly continue
 406   die $data->{error}{message} if $data->{error};
 407
 408   my $count = $data->{count};
 409   my $inserted = 0;
 410
 411   #warn "Census block lookup: $count\n";
 412
 413   # we have to do our own pagination on this, because the census bureau
 414   # doesn't support resultOffset (maybe they don't have ArcGIS 10.3 yet).
 415   # that's why we're ordering by OID, it's globally unique
 416   my $last_oid = 0;
 417   my $done = 0;
 418   while (!$done) {
 419     $response = $ua->request(
 420       POST $url, Content => [
 421         %query,
 422         where => "OID>$last_oid",
 423       ]
 424     );
 425     die $response->status_line unless $response->is_success;
 426     $data = decode_json($response->content);
 427     die $data->{error}{message} if $data->{error};
 428     last unless scalar @{$data->{features}}; #Nothing to insert
 429
 430     foreach my $feature (@{ $data->{features} }) {
 431       my $geoid = $feature->{attributes}{GEOID}; # the prize
 432       my $block = FS::deploy_zone_block->new({
 433           zonenum     => $zonenum,
 434           censusblock => $geoid
 435       });
 436       $error = $block->insert;
 437       die "$error (inserting census block $geoid)" if $error;
 438
 439       $inserted++;
 440       if ($job and $inserted % 100 == 0) {
 441         my $percent = sprintf('%.0f', $inserted / $count * 100);
 442         $job->update_statustext("$percent,creating block records");
 443       }
 444     }
 445
 446     #warn "Inserted $inserted records\n";
 447     $last_oid = $data->{features}[-1]{attributes}{OID};
 448     $done = 1 unless $data->{exceededTransferLimit};
 449   }
 450
 451   $zone->set('censusyear', $CENSUS_YEAR);
 452   $error = $zone->replace;
 453   warn "$error (updating zone census year)" if $error; # whatever, continue
 454
 455   return;
 456 }
 457
 458 =head1 BUGS
 459
 460 =head1 SEE ALSO
 461
 462 L<FS::Record>
 463
 464 =cut
 465
 466 1;
 467