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