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