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