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