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