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 # the replace method can be inherited from FS::Record
 191
 192 =item check
 193
 194 Checks all fields to make sure this is a valid zone record.  If there is
 195 an error, returns the error, otherwise returns false.  Called by the insert
 196 and replace methods.
 197
 198 =cut
 199
 200 sub check {
 201   my $self = shift;
 202
 203   my $error =
 204     $self->ut_numbern('zonenum')
 205     || $self->ut_text('description')
 206     || $self->ut_number('agentnum')
 207     || $self->ut_numbern('censusyear')
 208     || $self->ut_foreign_key('agentnum', 'agent', 'agentnum')
 209     || $self->ut_textn('dbaname')
 210     || $self->ut_enum('zonetype', [ 'B', 'P' ])
 211     || $self->ut_number('technology')
 212     || $self->ut_numbern('spectrum')
 213     || $self->ut_decimaln('adv_speed_up', 3)
 214     || $self->ut_decimaln('adv_speed_down', 3)
 215     || $self->ut_decimaln('cir_speed_up', 3)
 216     || $self->ut_decimaln('cir_speed_down', 3)
 217     || $self->ut_flag('is_consumer')
 218     || $self->ut_flag('is_business')
 219     || $self->ut_flag('is_broadband')
 220     || $self->ut_flag('is_voice')
 221     || $self->ut_numbern('active_date')
 222     || $self->ut_numbern('expire_date')
 223   ;
 224   return $error if $error;
 225
 226   foreach(qw(adv_speed_down adv_speed_up cir_speed_down cir_speed_up)) {
 227     if ($self->get('is_broadband')) {
 228       if (!$self->get($_)) {
 229         $self->set($_, 0);
 230       }
 231     } else {
 232       $self->set($_, '');
 233     }
 234   }
 235   if (!$self->get('active_date')) {
 236     $self->set('active_date', time);
 237   }
 238
 239   $self->SUPER::check;
 240 }
 241
 242 =item deploy_zone_block
 243
 244 Returns the census block records in this zone, in order by census block
 245 number.  Only appropriate to block-type zones.
 246
 247 =item deploy_zone_vertex
 248
 249 Returns the vertex records for this zone, in order by sequence number.
 250
 251 =cut
 252
 253 sub deploy_zone_block {
 254   my $self = shift;
 255   qsearch({
 256       table     => 'deploy_zone_block',
 257       hashref   => { zonenum => $self->zonenum },
 258       order_by  => ' ORDER BY censusblock',
 259   });
 260 }
 261
 262 sub deploy_zone_vertex {
 263   my $self = shift;
 264   qsearch({
 265       table     => 'deploy_zone_vertex',
 266       hashref   => { zonenum => $self->zonenum },
 267       order_by  => ' ORDER BY vertexnum',
 268   });
 269 }
 270
 271 =item vertices_json
 272
 273 Returns the vertex list for this zone, as a JSON string of
 274
 275 [ [ latitude0, longitude0 ], [ latitude1, longitude1 ] ... ]
 276
 277 =cut
 278
 279 sub vertices_json {
 280   my $self = shift;
 281   my @vertices = map { [ $_->latitude, $_->longitude ] } $self->deploy_zone_vertex;
 282   encode_json(\@vertices);
 283 }
 284
 285 =head2 SUBROUTINES
 286
 287 =over 4
 288
 289 =item process_batch_import JOB, PARAMS
 290
 291 =cut
 292
 293 sub process_batch_import {
 294   eval {
 295     use FS::deploy_zone_block;
 296     use FS::deploy_zone_vertex;
 297   };
 298   my $job = shift;
 299   my $param = shift;
 300   if (!ref($param)) {
 301     $param = thaw(decode_base64($param));
 302   }
 303
 304   # even if creating a new zone, the deploy_zone object should already
 305   # be inserted by this point
 306   my $zonenum = $param->{zonenum}
 307     or die "zonenum required";
 308   my $zone = FS::deploy_zone->by_key($zonenum)
 309     or die "deploy_zone #$zonenum not found";
 310   my $opt;
 311   if ( $zone->zonetype eq 'B' ) {
 312     $opt = { 'table'    => 'deploy_zone_block',
 313              'params'   => [ 'zonenum', 'censusyear' ],
 314              'formats'  => { 'plain' => [ 'censusblock' ] },
 315              'default_csv' => 1,
 316            };
 317     $job->update_statustext('1,Inserting census blocks');
 318   } elsif ( $zone->zonetype eq 'P' ) {
 319     $opt = { 'table'    => 'deploy_zone_vertex',
 320              'params'   => [ 'zonenum' ],
 321              'formats'  => { 'plain' => [ 'latitude', 'longitude' ] },
 322              'default_csv' => 1,
 323            };
 324   } else {
 325     die "don't know how to import to zonetype ".$zone->zonetype;
 326   }
 327
 328   FS::Record::process_batch_import( $job, $opt, $param );
 329
 330 }
 331
 332 =item process_block_lookup JOB, ZONENUM
 333
 334 Look up all the census blocks in the zone's footprint, and insert them.
 335 This will replace any existing block list.
 336
 337 =cut
 338
 339 sub process_block_lookup {
 340   my $job = shift;
 341   my $param = shift;
 342   if (!ref($param)) {
 343     $param = thaw(decode_base64($param));
 344   }
 345   my $zonenum = $param->{zonenum};
 346   my $zone = FS::deploy_zone->by_key($zonenum)
 347     or die "zone $zonenum not found\n";
 348
 349   # wipe the existing list of blocks
 350   my $error = $zone->process_o2m(
 351     'table'   => 'deploy_zone_block',
 352     'num_col' => 'zonenum',
 353     'fields'  => 'zonenum',
 354     'params'  => {},
 355   );
 356   die $error if $error;
 357
 358   $job->update_statustext('0,querying census database') if $job;
 359
 360   # negotiate the rugged jungle trails of the ArcGIS REST protocol:
 361   # 1. unlike most places, longitude first.
 362   my @zone_vertices = map { [ $_->longitude, $_->latitude ] }
 363     $zone->deploy_zone_vertex;
 364
 365   return if scalar(@zone_vertices) < 3; # then don't bother
 366
 367   # 2. package this as "rings", inside a JSON geometry object
 368   # 3. announce loudly and frequently that we are using spatial reference
 369   #    4326, "true GPS coordinates"
 370   my $geometry = encode_json({
 371       'rings' => [ \@zone_vertices ],
 372       'wkid'  => 4326,
 373   });
 374
 375   my %query = (
 376     f               => 'json', # duh
 377     geometry        => $geometry,
 378     geometryType    => 'esriGeometryPolygon', # as opposed to a bounding box
 379     inSR            => 4326,
 380     outSR           => 4326,
 381     spatialRel      => 'esriSpatialRelIntersects', # the test to perform
 382     outFields       => 'OID,GEOID',
 383     returnGeometry  => 'false',
 384     orderByFields   => 'OID',
 385   );
 386   my $url = 'https://tigerweb.geo.census.gov/arcgis/rest/services/TIGERweb/Tracts_Blocks/MapServer/12/query';
 387   my $ua = LWP::UserAgent->new;
 388
 389   # first find out how many of these we're dealing with
 390   my $response = $ua->request(
 391     POST $url, Content => [
 392       %query,
 393       returnCountOnly => 1,
 394     ]
 395   );
 396   die $response->status_line unless $response->is_success;
 397   my $data = decode_json($response->content);
 398   # their error messages are mostly useless, but don't just blindly continue
 399   die $data->{error}{message} if $data->{error};
 400
 401   my $count = $data->{count};
 402   my $inserted = 0;
 403
 404   #warn "Census block lookup: $count\n";
 405
 406   # we have to do our own pagination on this, because the census bureau
 407   # doesn't support resultOffset (maybe they don't have ArcGIS 10.3 yet).
 408   # that's why we're ordering by OID, it's globally unique
 409   my $last_oid = 0;
 410   my $done = 0;
 411   while (!$done) {
 412     $response = $ua->request(
 413       POST $url, Content => [
 414         %query,
 415         where => "OID>$last_oid",
 416       ]
 417     );
 418     die $response->status_line unless $response->is_success;
 419     $data = decode_json($response->content);
 420     die $data->{error}{message} if $data->{error};
 421     last unless scalar @{$data->{features}}; #Nothing to insert
 422
 423     foreach my $feature (@{ $data->{features} }) {
 424       my $geoid = $feature->{attributes}{GEOID}; # the prize
 425       my $block = FS::deploy_zone_block->new({
 426           zonenum     => $zonenum,
 427           censusblock => $geoid
 428       });
 429       $error = $block->insert;
 430       die "$error (inserting census block $geoid)" if $error;
 431
 432       $inserted++;
 433       if ($job and $inserted % 100 == 0) {
 434         my $percent = sprintf('%.0f', $inserted / $count * 100);
 435         $job->update_statustext("$percent,creating block records");
 436       }
 437     }
 438
 439     #warn "Inserted $inserted records\n";
 440     $last_oid = $data->{features}[-1]{attributes}{OID};
 441     $done = 1 unless $data->{exceededTransferLimit};
 442   }
 443
 444   $zone->set('censusyear', $CENSUS_YEAR);
 445   $error = $zone->replace;
 446   warn "$error (updating zone census year)" if $error; # whatever, continue
 447
 448   return;
 449 }
 450
 451 =head1 BUGS
 452
 453 =head1 SEE ALSO
 454
 455 L<FS::Record>
 456
 457 =cut
 458
 459 1;
 460