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