FS/FS/Misc/Geo.pm

   1 package FS::Misc::Geo;
   2
   3 use strict;
   4 use base qw( Exporter );
   5 use vars qw( $DEBUG @EXPORT_OK $conf );
   6 use LWP::UserAgent;
   7 use HTTP::Request;
   8 use HTTP::Request::Common qw( GET POST );
   9 use IO::Socket::SSL;
  10 use HTML::TokeParser;
  11 use Cpanel::JSON::XS;
  12 use URI::Escape 3.31;
  13 use Data::Dumper;
  14 use FS::Conf;
  15 use FS::Log;
  16 use Locale::Country;
  17 use XML::LibXML;
  18
  19 FS::UID->install_callback( sub {
  20   $conf = new FS::Conf;
  21 } );
  22
  23 $DEBUG = 0;
  24
  25 @EXPORT_OK = qw( get_district );
  26
  27 =head1 NAME
  28
  29 FS::Misc::Geo - routines to fetch geographic information
  30
  31 =head1 CLASS METHODS
  32
  33 =over 4
  34
  35 =item get_censustract_ffiec LOCATION YEAR
  36
  37 Given a location hash (see L<FS::location_Mixin>) and a census map year,
  38 returns a census tract code (consisting of state, county, and tract
  39 codes) or an error message.
  40
  41 Data source: Federal Financial Institutions Examination Council
  42
  43 Note: This is the old method for pre-2022 (census year 2020) reporting.
  44
  45 =cut
  46
  47 sub get_censustract_ffiec {
  48   my $class = shift;
  49   my $location = shift;
  50   my $year  = shift;
  51   $year ||= 2013;
  52
  53   if ( length($location->{country}) and uc($location->{country}) ne 'US' ) {
  54     return '';
  55   }
  56
  57   warn Dumper($location, $year) if $DEBUG;
  58
  59   # the old FFIEC geocoding service was shut down December 1, 2014.
  60   # welcome to the future.
  61   my $url = 'https://geomap.ffiec.gov/FFIECGeocMap/GeocodeMap1.aspx/GetGeocodeData';
  62   # build the single-line query
  63   my $single_line = join(', ', $location->{address1},
  64                                $location->{city},
  65                                $location->{state}
  66                         );
  67   my $hashref = { sSingleLine => $single_line, iCensusYear => $year };
  68   my $request = POST( $url,
  69     'Content-Type' => 'application/json; charset=utf-8',
  70     'Accept' => 'application/json',
  71     'Content' => encode_json($hashref)
  72   );
  73
  74   my $ua = new LWP::UserAgent;
  75   my $res = $ua->request( $request );
  76
  77   warn $res->as_string
  78     if $DEBUG > 2;
  79
  80   if (!$res->is_success) {
  81
  82     die "Census tract lookup error: ".$res->message;
  83
  84   }
  85
  86   local $@;
  87   my $content = eval { decode_json($res->content) };
  88   die "Census tract JSON error: $@\n" if $@;
  89
  90   if ( !exists $content->{d}->{sStatus} ) {
  91     die "Census tract response is missing a status indicator.\nThis is an FFIEC problem.\n";
  92   }
  93   if ( $content->{d}->{sStatus} eq 'Y' ) {
  94     # success
  95     # this also contains the (partial) standardized address, correct zip
  96     # code, coordinates, etc., and we could get all of them, but right now
  97     # we only want the census tract
  98     my $tract = join('', $content->{d}->{sStateCode},
  99                          $content->{d}->{sCountyCode},
 100                          $content->{d}->{sTractCode});
 101     return $tract;
 102
 103   } else {
 104
 105     my $error = $content->{d}->{sMsg}
 106             ||  'FFIEC lookup failed, but with no status message.';
 107     die "$error\n";
 108
 109   }
 110 }
 111
 112 =item get_censustract_uscensus LOCATION YEAR
 113
 114 Given a location hash (see L<FS::location_Mixin>) and a census map year,
 115 returns a census tract code (consisting of state, county, tract, and block
 116 codes) or an error message.
 117
 118 Data source: US Census Bureau
 119
 120 This is the new method for 2022+ (census year 2020) reporting.
 121
 122 =cut
 123
 124 sub get_censustract_uscensus {
 125   my $class    = shift;
 126   my $location = shift;
 127   my $year     = shift || 2020;
 128
 129   if ( length($location->{country}) and uc($location->{country}) ne 'US' ) {
 130     return '';
 131   }
 132
 133   warn Dumper($location, $year) if $DEBUG;
 134
 135   my $url = 'https://geocoding.geo.census.gov/geocoder/geographies/address?';
 136
 137   my $address1 = $location->{address1};
 138   $address1 =~ s/(apt|ste|suite|unit)[\s\d]\w*\s*$//i;
 139
 140   my $query_hash = {
 141                      street     => $address1,
 142                      city       => $location->{city},
 143                      state      => $location->{state},
 144                      benchmark  => 'Public_AR_Current',
 145                      vintage    => 'Census'.$year.'_Current',
 146                      format     => 'json',
 147                    };
 148
 149   my $full_url = URI->new($url);
 150   $full_url->query_form($query_hash);
 151
 152   warn "Full Request URL: \n".$full_url if $DEBUG;
 153
 154   my $ua = new LWP::UserAgent;
 155   my $res = $ua->get( $full_url );
 156
 157   warn $res->as_string if $DEBUG > 2;
 158
 159   if (!$res->is_success) {
 160     die 'Census tract lookup error: '.$res->message;
 161   }
 162
 163   local $@;
 164   my $content = eval { decode_json($res->content) };
 165   die "Census tract JSON error: $@\n" if $@;
 166
 167   warn Dumper($content) if $DEBUG;
 168
 169   my $addressMatches_ref = $content->{result}->{addressMatches};
 170
 171   if ( $addressMatches_ref && scalar @{$addressMatches_ref} ) {
 172
 173     my $tract = $addressMatches_ref->[0]->{geographies}->{'Census Blocks'}[0]->{GEOID};
 174     return $tract;
 175
 176   } else {
 177
 178     my $error = 'Lookup failed, but with no status message.';
 179
 180     if ( $content->{errors} ) {
 181       $error = join("\n", $content->{errors});
 182     }
 183
 184     die "$error\n";
 185
 186   }
 187 }
 188
 189
 190 #sub get_district_methods {
 191 #  ''         => '',
 192 #  'wa_sales' => 'Washington sales tax',
 193 #};
 194
 195 =item get_district LOCATION METHOD
 196
 197 For the location hash in LOCATION, using lookup method METHOD, fetch
 198 tax district information.  Currently the only available method is
 199 'wa_sales' (the Washington Department of Revenue sales tax lookup).
 200
 201 Returns a hash reference containing the following fields:
 202
 203 - district
 204 - tax (percentage)
 205 - taxname
 206 - exempt_amount (currently zero)
 207 - city, county, state, country (from
 208
 209 The intent is that you can assign this to an L<FS::cust_main_county>
 210 object and insert it if there's not yet a tax rate defined for that
 211 district.
 212
 213 get_district will die on error.
 214
 215 =over 4
 216
 217 =cut
 218
 219 sub get_district {
 220   no strict 'refs';
 221   my $location = shift;
 222   my $method = shift or return '';
 223   warn Dumper($location, $method) if $DEBUG;
 224   &$method($location);
 225 }
 226
 227
 228 =head2 wa_sales location_hash
 229
 230 Expects output of location_hash() as parameter
 231
 232 Returns undef on error, or if tax rate cannot be found using given address
 233
 234 Query the WA State Dept of Revenue API with an address, and return
 235 tax district information for that address.
 236
 237 Documentation for the API can be found here:
 238
 239 L<https://dor.wa.gov/find-taxes-rates/retail-sales-tax/destination-based-sales-tax-and-streamlined-sales-tax/wa-sales-tax-rate-lookup-url-interface>
 240
 241 This API does not return consistent usable county names, as the county
 242 name may include appreviations or labels referring to PTBA (public transport
 243 benefit area) or CEZ (community empowerment zone).  It's recommended to use
 244 the tool freeside-wa-tax-table-update to fully populate the
 245 city/county/districts for WA state every financial quarter.
 246
 247 Returns a hashref with the following keys:
 248
 249   - district        the wa state tax district id
 250   - tax             the combined total tax rate, as a percentage
 251   - city            the API rate name
 252   - county          The API address PTBA
 253   - state           WA
 254   - country         US
 255   - exempt_amount   0
 256
 257 If api returns no district for address, generates system log error
 258 and returns undef
 259
 260 =cut
 261
 262 sub wa_sales {
 263
 264   #
 265   # no die():
 266   # freeside-queued will issue dbh->rollback on die() ... this will
 267   # also roll back system log messages about errors :/  freeside-queued
 268   # doesn't propgate die messages into the system log.
 269   #
 270
 271   my $location_hash = shift;
 272
 273   # Return when called with pointless context
 274   return
 275     unless $location_hash
 276         && ref $location_hash
 277         && $location_hash->{state} eq 'WA'
 278         && $location_hash->{address1}
 279         && $location_hash->{zip}
 280         && $location_hash->{city};
 281
 282   my $log = FS::Log->new('wa_sales');
 283
 284   warn "wa_sales() called with location_hash:\n".Dumper( $location_hash)."\n"
 285     if $DEBUG;
 286
 287   my $api_url = 'http://webgis.dor.wa.gov/webapi/AddressRates.aspx';
 288   my @api_response_codes = (
 289     'The address was found',
 290     'The address was not found, but the ZIP+4 was located.',
 291     'The address was updated and found, the user should validate the address record',
 292     'The address was updated and Zip+4 located, the user should validate the address record',
 293     'The address was corrected and found, the user should validate the address record',
 294     'Neither the address or ZIP+4 was found, but the 5-digit ZIP was located.',
 295     'The address, ZIP+4, and ZIP could not be found.',
 296     'Invalid Latitude/Longitude',
 297     'Internal error'
 298   );
 299
 300   my %get_query = (
 301     output => 'xml',
 302     addr   => $location_hash->{address1},
 303     city   => $location_hash->{city},
 304     zip    => substr( $location_hash->{zip}, 0, 5 ),
 305   );
 306   my $get_string = join '&' => (
 307     map{ sprintf "%s=%s", $_, uri_escape( $get_query{$_} ) }
 308     keys %get_query
 309   );
 310
 311   my $prepared_url = "${api_url}?$get_string";
 312
 313   warn "API call to URL: $prepared_url\n"
 314     if $DEBUG;
 315
 316   my $dom;
 317   local $@;
 318   eval { $dom = XML::LibXML->load_xml( location => $prepared_url ); };
 319   if ( $@ ) {
 320     my $error =
 321       sprintf "Problem parsing XML from API URL(%s): %s",
 322       $prepared_url, $@;
 323
 324     $log->error( $error );
 325     warn $error;
 326     return;
 327   }
 328
 329   my ($res_root)        = $dom->findnodes('/response');
 330   my ($res_addressline) = $dom->findnodes('/response/addressline');
 331   my ($res_rate)        = $dom->findnodes('/response/rate');
 332
 333   my $res_code = $res_root->getAttribute('code')
 334     if $res_root;
 335
 336   unless (
 337        ref $res_root
 338     && ref $res_addressline
 339     && ref $res_rate
 340     && $res_code <= 5
 341     && $res_root->getAttribute('rate') > 0
 342   ) {
 343     my $error =
 344       sprintf
 345         "Problem querying WA DOR tax district - " .
 346         "code( %s %s ) " .
 347         "address( %s ) " .
 348         "url( %s )",
 349           $res_code || 'n/a',
 350           $res_code ? $api_response_codes[$res_code] : 'n/a',
 351           $location_hash->{address1},
 352           $prepared_url;
 353
 354       $log->error( $error );
 355       warn "$error\n";
 356       return;
 357   }
 358
 359   my %response = (
 360     exempt_amount => 0,
 361     state         => 'WA',
 362     country       => 'US',
 363     district      => $res_root->getAttribute('loccode'),
 364     tax           => $res_root->getAttribute('rate') * 100,
 365     county        => uc $res_addressline->getAttribute('ptba'),
 366     city          => uc $res_rate->getAttribute('name')
 367   );
 368
 369   $response{county} =~ s/ PTBA//i;
 370
 371   if ( $DEBUG ) {
 372     warn "XML document: $dom\n";
 373     warn "API parsed response: ".Dumper( \%response )."\n";
 374   }
 375
 376   my $info_message =
 377     sprintf
 378       "Tax district(%s) selected for address(%s %s %s %s)",
 379       $response{district},
 380       $location_hash->{address1},
 381       $location_hash->{city},
 382       $location_hash->{state},
 383       $location_hash->{zip};
 384
 385   $log->info( $info_message );
 386   warn "$info_message\n"
 387     if $DEBUG;
 388
 389   \%response;
 390
 391 }
 392
 393 ###### USPS Standardization ######
 394
 395 sub standardize_usps {
 396   my $class = shift;
 397
 398   eval "use Business::US::USPS::WebTools::AddressStandardization";
 399   die $@ if $@;
 400
 401   my $location = shift;
 402   if ( $location->{country} ne 'US' ) {
 403     # soft failure
 404     warn "standardize_usps not for use in country ".$location->{country}."\n";
 405     $location->{addr_clean} = '';
 406     return $location;
 407   }
 408   my $userid   = $conf->config('usps_webtools-userid');
 409   my $password = $conf->config('usps_webtools-password');
 410   my $verifier = Business::US::USPS::WebTools::AddressStandardization->new( {
 411       UserID => $userid,
 412       Password => $password,
 413       Testing => 0,
 414   } ) or die "error starting USPS WebTools\n";
 415
 416   my($zip5, $zip4) = split('-',$location->{'zip'});
 417
 418   my %usps_args = (
 419     FirmName => $location->{company},
 420     Address2 => $location->{address1},
 421     Address1 => $location->{address2},
 422     City     => $location->{city},
 423     State    => $location->{state},
 424     Zip5     => $zip5,
 425     Zip4     => $zip4,
 426   );
 427   warn join('', map "$_: $usps_args{$_}\n", keys %usps_args )
 428     if $DEBUG > 1;
 429
 430   my $hash = $verifier->verify_address( %usps_args );
 431
 432   warn $verifier->response
 433     if $DEBUG > 1;
 434
 435   die "USPS WebTools error: ".$verifier->{error}{description} ."\n"
 436     if $verifier->is_error;
 437
 438   my $zip = $hash->{Zip5};
 439   $zip .= '-' . $hash->{Zip4} if $hash->{Zip4} =~ /\d/;
 440
 441   { company   => $hash->{FirmName},
 442     address1  => $hash->{Address2},
 443     address2  => $hash->{Address1},
 444     city      => $hash->{City},
 445     state     => $hash->{State},
 446     zip       => $zip,
 447     country   => 'US',
 448     addr_clean=> 'Y' }
 449 }
 450
 451 ###### U.S. Census Bureau ######
 452
 453 sub standardize_uscensus {
 454   my $self = shift;
 455   my $location = shift;
 456   my $log = FS::Log->new('FS::Misc::Geo::standardize_uscensus');
 457   $log->debug(join("\n", @{$location}{'address1', 'city', 'state', 'zip'}));
 458
 459   eval "use Geo::USCensus::Geocoding";
 460   die $@ if $@;
 461
 462   if ( $location->{country} ne 'US' ) {
 463     # soft failure
 464     warn "standardize_uscensus not for use in country ".$location->{country}."\n";
 465     $location->{addr_clean} = '';
 466     return $location;
 467   }
 468
 469   my $request = {
 470     street  => $location->{address1},
 471     city    => $location->{city},
 472     state   => $location->{state},
 473     zip     => $location->{zip},
 474     debug   => ($DEBUG || 0),
 475   };
 476
 477   my $result = Geo::USCensus::Geocoding->query($request);
 478   if ( $result->is_match ) {
 479     # unfortunately we get the address back as a single line
 480     $log->debug($result->address);
 481     if ($result->address =~ /^(.*), (.*), ([A-Z]{2}), (\d{5}.*)$/) {
 482       return +{
 483         address1    => $1,
 484         city        => $2,
 485         state       => $3,
 486         zip         => $4,
 487         address2    => uc($location->{address2}),
 488         latitude    => $result->latitude,
 489         longitude   => $result->longitude,
 490         censustract => $result->censustract,
 491       };
 492     } else {
 493       die "Geocoding returned '".$result->address."', which does not seem to be a valid address.\n";
 494     }
 495   } elsif ( $result->match_level eq 'Tie' ) {
 496     die "Geocoding was not able to identify a unique matching address.\n";
 497   } elsif ( $result->match_level ) {
 498     die "Geocoding did not find a matching address.\n";
 499   } else {
 500     $log->error($result->error_message);
 501     return; # for internal errors, don't return anything
 502   }
 503 }
 504
 505 ####### EZLOCATE (obsolete) #######
 506
 507 sub _tomtom_query { # helper method for the below
 508   my %args = @_;
 509   my $result = Geo::TomTom::Geocoding->query(%args);
 510   die "TomTom geocoding error: ".$result->message."\n"
 511     unless ( $result->is_success );
 512   my ($match) = $result->locations;
 513   my $type = $match->{type};
 514   # match levels below "intersection" should not be considered clean
 515   my $clean = ($type eq 'addresspoint'  ||
 516                $type eq 'poi'           ||
 517                $type eq 'house'         ||
 518                $type eq 'intersection'
 519               ) ? 'Y' : '';
 520   warn "tomtom returned $type match\n" if $DEBUG;
 521   warn Dumper($match) if $DEBUG > 1;
 522   ($match, $clean);
 523 }
 524
 525 sub standardize_tomtom {
 526   # post-2013 TomTom API
 527   # much better, but incompatible with ezlocate
 528   my $self = shift;
 529   my $location = shift;
 530   eval "use Geo::TomTom::Geocoding; use Geo::StreetAddress::US";
 531   die $@ if $@;
 532
 533   my $key = $conf->config('tomtom-userid')
 534     or die "no tomtom-userid configured\n";
 535
 536   my $country = code2country($location->{country});
 537   my ($address1, $address2) = ($location->{address1}, $location->{address2});
 538   my $subloc = '';
 539
 540   # trim whitespace
 541   $address1 =~ s/^\s+//;
 542   $address1 =~ s/\s+$//;
 543   $address2 =~ s/^\s+//;
 544   $address2 =~ s/\s+$//;
 545
 546   # try to fix some cases of the address fields being switched
 547   if ( $address2 =~ /^\d/ and $address1 !~ /^\d/ ) {
 548     $address2 = $address1;
 549     $address1 = $location->{address2};
 550   }
 551   # parse sublocation part (unit/suite/apartment...) and clean up
 552   # non-sublocation address2
 553   ($subloc, $address2) =
 554     subloc_address2($address1, $address2, $location->{country});
 555   # ask TomTom to standardize address1:
 556   my %args = (
 557     key => $key,
 558     T   => $address1,
 559     L   => $location->{city},
 560     AA  => $location->{state},
 561     PC  => $location->{zip},
 562     CC  => country2code($country, LOCALE_CODE_ALPHA_3),
 563   );
 564
 565   my ($match, $clean) = _tomtom_query(%args);
 566
 567   if (!$match or !$clean) {
 568     # Then try cleaning up the input; TomTom is picky about junk in the
 569     # address.  Any of these can still be a clean match.
 570     my $h = Geo::StreetAddress::US->parse_location($address1);
 571     # First conservatively:
 572     if ( $h->{sec_unit_type} ) {
 573       my $strip = '\s+' . $h->{sec_unit_type};
 574       $strip .= '\s*' . $h->{sec_unit_num} if $h->{sec_unit_num};
 575       $strip .= '$';
 576       $args{T} =~ s/$strip//;
 577       ($match, $clean) = _tomtom_query(%args);
 578     }
 579     if ( !$match or !$clean ) {
 580       # Then more aggressively:
 581       $args{T} = uc( join(' ', @$h{'number', 'street', 'type'}) );
 582       ($match, $clean) = _tomtom_query(%args);
 583     }
 584   }
 585
 586   if ( !$match or !$clean ) { # partial matches are not useful
 587     die "Address not found\n";
 588   }
 589   my $tract = '';
 590   if ( defined $match->{censusTract} ) {
 591     $tract = $match->{censusStateCode}. $match->{censusFipsCountyCode}.
 592              join('.', $match->{censusTract} =~ /(....)(..)/);
 593   }
 594   $address1 = '';
 595   $address1 = $match->{houseNumber} . ' ' if length($match->{houseNumber});
 596   $address1 .= $match->{street} if $match->{street};
 597   $address1 .= ' '.$subloc if $subloc;
 598   $address1 = uc($address1); # USPS standards
 599
 600   return +{
 601     address1    => $address1,
 602     address2    => $address2,
 603     city        => uc($match->{city}),
 604     state       => uc($location->{state}),
 605     country     => uc($location->{country}),
 606     zip         => ($match->{standardPostalCode} || $match->{postcode}),
 607     latitude    => $match->{latitude},
 608     longitude   => $match->{longitude},
 609     censustract => $tract,
 610     addr_clean  => $clean,
 611   };
 612 }
 613
 614 =iten subloc_address2 ADDRESS1, ADDRESS2, COUNTRY
 615
 616 Given 'address1' and 'address2' strings, extract the sublocation part
 617 (from either one) and return it.  If the sublocation was found in ADDRESS1,
 618 also return ADDRESS2 (cleaned up for postal standards) as it's assumed to
 619 contain something relevant.
 620
 621 =cut
 622
 623 my %subloc_forms = (
 624   # Postal Addressing Standards, Appendix C
 625   # (plus correction of "hanger" to "hangar")
 626   US => {qw(
 627     APARTMENT     APT
 628     BASEMENT      BSMT
 629     BUILDING      BLDG
 630     DEPARTMENT    DEPT
 631     FLOOR         FL
 632     FRONT         FRNT
 633     HANGAR        HNGR
 634     HANGER        HNGR
 635     KEY           KEY
 636     LOBBY         LBBY
 637     LOT           LOT
 638     LOWER         LOWR
 639     OFFICE        OFC
 640     PENTHOUSE     PH
 641     PIER          PIER
 642     REAR          REAR
 643     ROOM          RM
 644     SIDE          SIDE
 645     SLIP          SLIP
 646     SPACE         SPC
 647     STOP          STOP
 648     SUITE         STE
 649     TRAILER       TRLR
 650     UNIT          UNIT
 651     UPPER         UPPR
 652   )},
 653   # Canada Post Addressing Guidelines 4.3
 654   CA => {qw(
 655     APARTMENT     APT
 656     APPARTEMENT   APP
 657     BUREAU        BUREAU
 658     SUITE         SUITE
 659     UNIT          UNIT
 660     UNITÉ         UNITÉ
 661   )},
 662 );
 663
 664 sub subloc_address2 {
 665   # Some things seen in the address2 field:
 666   # Whitespace
 667   # The complete address (with address1 containing part of the company name,
 668   # or an ATTN or DBA line, or P.O. Box, or department name, or building/suite
 669   # number, etc.)
 670
 671   # try to parse sublocation parts from address1; if they are present we'll
 672   # append them back to address1 after standardizing
 673   my $subloc = '';
 674   my ($addr1, $addr2, $country) = map uc, @_;
 675   my $dict = $subloc_forms{$country} or return('', $addr2);
 676
 677   my $found_in = 0; # which address is the sublocation
 678   my $h;
 679   foreach my $string (
 680     # patterns to try to parse
 681     $addr1,
 682     "$addr1 Nullcity, CA"
 683   ) {
 684     $h = Geo::StreetAddress::US->parse_location($addr1);
 685     last if exists($h->{sec_unit_type});
 686   }
 687   if (exists($h->{sec_unit_type})) {
 688     $found_in = 1
 689   } else {
 690     foreach my $string (
 691       # more patterns
 692       $addr2,
 693       "$addr1, $addr2",
 694       "$addr1, $addr2 Nullcity, CA"
 695     ) {
 696       $h = Geo::StreetAddress::US->parse_location("$addr1, $addr2");
 697       last if exists($h->{sec_unit_type});
 698     }
 699     if (exists($h->{sec_unit_type})) {
 700       $found_in = 2;
 701     }
 702   }
 703   if ( $found_in ) {
 704     $subloc = $h->{sec_unit_type};
 705     # special case: do not combine P.O. box sublocs with address1
 706     if ( $h->{sec_unit_type} =~ /^P *O *BOX/i ) {
 707       if ( $found_in == 2 ) {
 708         $addr2 = "PO BOX ".$h->{sec_unit_num};
 709       } # else it's in addr1, and leave it alone
 710       return ('', $addr2);
 711     } elsif ( exists($dict->{$subloc}) ) {
 712       # substitute the official abbreviation
 713       $subloc = $dict->{$subloc};
 714     }
 715     $subloc .= ' ' . $h->{sec_unit_num} if length($h->{sec_unit_num});
 716   } # otherwise $subloc = ''
 717
 718   if ( $found_in == 2 ) {
 719     # address2 should be fully combined into address1
 720     return ($subloc, '');
 721   }
 722   # else address2 is not the canonical sublocation, but do our best to
 723   # clean it up
 724   #
 725   # protect this
 726   $addr2 =~ s/#\s*(\d)/NUMBER$1/; # /g?
 727   my @words;
 728   # remove all punctuation and spaces
 729   foreach my $w (split(/\W+/, $addr2)) {
 730     if ( exists($dict->{$w}) ) {
 731       push @words, $dict->{$w};
 732     } else {
 733       push @words, $w;
 734     }
 735     my $result = join(' ', @words);
 736     # correct spacing of pound sign + number
 737     $result =~ s/NUMBER(\d)/# $1/;
 738     warn "normalizing '$addr2' to '$result'\n" if $DEBUG > 1;
 739     $addr2 = $result;
 740   }
 741   $addr2 = '' if $addr2 eq $subloc; # if it was entered redundantly
 742   ($subloc, $addr2);
 743 }
 744
 745 #is anyone still using this?
 746 sub standardize_melissa {
 747   my $class = shift;
 748   my $location = shift;
 749
 750   local $@;
 751   eval "use Geo::Melissa::WebSmart";
 752   die $@ if $@;
 753
 754   my $id = $conf->config('melissa-userid')
 755     or die "no melissa-userid configured\n";
 756   my $geocode = $conf->exists('melissa-enable_geocoding') ? 1 : 0;
 757
 758   my $request = {
 759     id      => $id,
 760     a1      => $location->{address1},
 761     a2      => $location->{address2},
 762     city    => $location->{city},
 763     state   => $location->{state},
 764     ctry    => $location->{country},
 765     zip     => $location->{zip},
 766     geocode => $geocode,
 767   };
 768   my $result = Geo::Melissa::WebSmart->query($request);
 769   if ( $result->code =~ /AS01/ ) { # always present on success
 770     my $addr = $result->address;
 771     warn Dumper $addr if $DEBUG > 1;
 772     my $out = {
 773       address1    => $addr->{Address1},
 774       address2    => $addr->{Address2},
 775       city        => $addr->{City}->{Name},
 776       state       => $addr->{State}->{Abbreviation},
 777       country     => $addr->{Country}->{Abbreviation},
 778       zip         => $addr->{Zip},
 779       latitude    => $addr->{Latitude},
 780       longitude   => $addr->{Longitude},
 781       addr_clean  => 'Y',
 782     };
 783     if ( $addr->{Census}->{Tract} ) {
 784       my $censustract = $addr->{County}->{Fips} . $addr->{Census}->{Tract};
 785       # insert decimal point two digits from the end
 786       $censustract =~ s/(\d\d)$/\.$1/;
 787       $out->{censustract} = $censustract;
 788       $out->{censusyear} = $conf->config('census_year');
 789     }
 790     # we could do a lot more nuanced reporting of the warning/status codes,
 791     # but the UI doesn't support that yet.
 792     return $out;
 793   } else {
 794     die $result->status_message;
 795   }
 796 }
 797
 798 sub standardize_freeside {
 799   my $class = shift;
 800   my $location = shift;
 801
 802   my $url = 'https://ws.freeside.biz/normalize';
 803
 804   #free freeside.biz normalization only for US
 805   if ( $location->{country} ne 'US' ) {
 806     # soft failure
 807     #why? something else could have cleaned it $location->{addr_clean} = '';
 808     return $location;
 809   }
 810
 811   my $ua = LWP::UserAgent->new(
 812              'ssl_opts' => {
 813                verify_hostname => 0,
 814                SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
 815              },
 816            );
 817   my $response = $ua->request( POST $url, [
 818     'support-key' => scalar($conf->config('support-key')),
 819     %$location,
 820   ]);
 821
 822   die "Address normalization error: ". $response->message
 823     unless $response->is_success;
 824
 825   local $@;
 826   my $content = eval { decode_json($response->content) };
 827   if ( $@ ) {
 828     warn $response->content;
 829     die "Address normalization JSON error : $@\n";
 830   }
 831
 832   die $content->{error}."\n"
 833     if $content->{error};
 834
 835   { 'addr_clean' => 'Y',
 836     map { $_ => $content->{$_} }
 837       qw( address1 address2 city state zip country )
 838   };
 839
 840 }
 841
 842 =back
 843
 844 =cut
 845
 846 1;