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 HTML::TokeParser;
  10 use JSON;
  11 use URI::Escape 3.31;
  12 use Data::Dumper;
  13 use FS::Conf;
  14 use Locale::Country;
  15
  16 FS::UID->install_callback( sub {
  17   $conf = new FS::Conf;
  18 } );
  19
  20 $DEBUG = 1;
  21
  22 @EXPORT_OK = qw( get_district );
  23
  24 =head1 NAME
  25
  26 FS::Misc::Geo - routines to fetch geographic information
  27
  28 =head1 CLASS METHODS
  29
  30 =over 4
  31
  32 =item get_censustract_ffiec LOCATION YEAR
  33
  34 Given a location hash (see L<FS::location_Mixin>) and a census map year,
  35 returns a census tract code (consisting of state, county, and tract
  36 codes) or an error message.
  37
  38 =cut
  39
  40 sub get_censustract_ffiec {
  41   my $class = shift;
  42   my $location = shift;
  43   my $year  = shift;
  44   $year ||= 2012;
  45
  46   if ( length($location->{country}) and uc($location->{country}) ne 'US' ) {
  47     return '';
  48   }
  49
  50   warn Dumper($location, $year) if $DEBUG;
  51
  52   # the old FFIEC geocoding service was shut down December 1, 2014.
  53   # welcome to the future.
  54   my $url = 'https://geomap.ffiec.gov/FFIECGeocMap/GeocodeMap1.aspx/GetGeocodeData';
  55   # build the single-line query
  56   my $single_line = join(', ', $location->{address1},
  57                                $location->{city},
  58                                $location->{state}
  59                         );
  60   my $hashref = { sSingleLine => $single_line, iCensusYear => $year };
  61   my $request = POST( $url,
  62     'Content-Type' => 'application/json; charset=utf-8',
  63     'Accept' => 'application/json',
  64     'Content' => encode_json($hashref)
  65   );
  66
  67   my $ua = new LWP::UserAgent;
  68   my $res = $ua->request( $request );
  69
  70   warn $res->as_string
  71     if $DEBUG > 2;
  72
  73   if (!$res->is_success) {
  74
  75     die "Census tract lookup error: ".$res->message;
  76
  77   }
  78
  79   local $@;
  80   my $content = eval { decode_json($res->content) };
  81   die "Census tract JSON error: $@\n" if $@;
  82
  83   if ( !exists $content->{d}->{sStatus} ) {
  84     die "Census tract response is missing a status indicator.\nThis is an FFIEC problem.\n";
  85   }
  86   if ( $content->{d}->{sStatus} eq 'Y' ) {
  87     # success
  88     # this also contains the (partial) standardized address, correct zip
  89     # code, coordinates, etc., and we could get all of them, but right now
  90     # we only want the census tract
  91     my $tract = join('', $content->{d}->{sStateCode},
  92                          $content->{d}->{sCountyCode},
  93                          $content->{d}->{sTractCode});
  94     return $tract;
  95
  96   } else {
  97
  98     my $error = $content->{d}->{sMsg}
  99             ||  'FFIEC lookup failed, but with no status message.';
 100     die "$error\n";
 101
 102   }
 103 }
 104
 105 #sub get_district_methods {
 106 #  ''         => '',
 107 #  'wa_sales' => 'Washington sales tax',
 108 #};
 109
 110 =item get_district LOCATION METHOD
 111
 112 For the location hash in LOCATION, using lookup method METHOD, fetch
 113 tax district information.  Currently the only available method is
 114 'wa_sales' (the Washington Department of Revenue sales tax lookup).
 115
 116 Returns a hash reference containing the following fields:
 117
 118 - district
 119 - tax (percentage)
 120 - taxname
 121 - exempt_amount (currently zero)
 122 - city, county, state, country (from
 123
 124 The intent is that you can assign this to an L<FS::cust_main_county>
 125 object and insert it if there's not yet a tax rate defined for that
 126 district.
 127
 128 get_district will die on error.
 129
 130 =over 4
 131
 132 =cut
 133
 134 sub get_district {
 135   no strict 'refs';
 136   my $location = shift;
 137   my $method = shift or return '';
 138   warn Dumper($location, $method) if $DEBUG;
 139   &$method($location);
 140 }
 141
 142 sub wa_sales {
 143   my $location = shift;
 144   my $error = '';
 145   return '' if $location->{state} ne 'WA';
 146
 147   my $return = { %$location };
 148   $return->{'exempt_amount'} = 0.00;
 149
 150   my $url = 'http://webgis2.dor.wa.gov/TaxRateLookup_AGS/TaxReport.aspx';
 151   my $ua = new LWP::UserAgent;
 152
 153   my $delim = '<|>'; # yes, <|>
 154   my $year  = (localtime)[5] + 1900;
 155   my $month = (localtime)[4] + 1;
 156   my @zip = split('-', $location->{zip});
 157
 158   my @args = (
 159     'TaxType=S',  #sales; 'P' = property
 160     'Src=0',      #does something complicated
 161     'TAXABLE=',
 162     'Addr='.uri_escape($location->{address1}),
 163     'City='.uri_escape($location->{city}),
 164     'Zip='.$zip[0],
 165     'Zip1='.($zip[1] || ''), #optional
 166     'Year='.$year,
 167     'SYear='.$year,
 168     'Month='.$month,
 169     'EMon='.$month,
 170   );
 171
 172   my $query_string = join($delim, @args );
 173   $url .= "?$query_string";
 174   warn "\nrequest:  $url\n\n" if $DEBUG > 1;
 175
 176   my $res = $ua->request( GET( "$url?$query_string" ) );
 177
 178   warn $res->as_string
 179   if $DEBUG > 2;
 180
 181   if ($res->code ne '200') {
 182     $error = $res->message;
 183   }
 184
 185   my $content = $res->content;
 186   my $p = new HTML::TokeParser \$content;
 187   my $js = '';
 188   while ( my $t = $p->get_tag('script') ) {
 189     my $u = $p->get_token; #either enclosed text or the </script> tag
 190     if ( $u->[0] eq 'T' and $u->[1] =~ /tblSales/ ) {
 191       $js = $u->[1];
 192       last;
 193     }
 194   }
 195   if ( $js ) { #found it
 196     # strip down to the quoted string, which contains escaped single quotes.
 197     $js =~ s/.*\('tblSales'\);c.innerHTML='//s;
 198     $js =~ s/(?<!\\)'.*//s; # (?<!\\) means "not preceded by a backslash"
 199     warn "\n\n  innerHTML:\n$js\n\n" if $DEBUG > 2;
 200
 201     $p = new HTML::TokeParser \$js;
 202     TD: while ( my $td = $p->get_tag('td') ) {
 203       while ( my $u = $p->get_token ) {
 204         next TD if $u->[0] eq 'E' and $u->[1] eq 'td';
 205         next if $u->[0] ne 'T'; # skip non-text
 206         my $text = $u->[1];
 207
 208         if ( lc($text) eq 'location code' ) {
 209           $p->get_tag('td'); # skip to the next column
 210           undef $u;
 211           $u = $p->get_token until $u->[0] eq 'T'; # and then skip non-text
 212           $return->{'district'} = $u->[1];
 213         }
 214         elsif ( lc($text) eq 'total tax rate' ) {
 215           $p->get_tag('td');
 216           undef $u;
 217           $u = $p->get_token until $u->[0] eq 'T';
 218           $return->{'tax'} = $u->[1];
 219         }
 220       } # get_token
 221     } # TD
 222
 223     # just to make sure
 224     if ( $return->{'district'} =~ /^\d+$/ and $return->{'tax'} =~ /^.\d+$/ ) {
 225       $return->{'tax'} *= 100; #percentage
 226       warn Dumper($return) if $DEBUG > 1;
 227       return $return;
 228     }
 229     else {
 230       $error = 'district code/tax rate not found';
 231     }
 232   }
 233   else {
 234     $error = "failed to parse document";
 235   }
 236
 237   die "WA tax district lookup error: $error";
 238 }
 239
 240 ###### USPS Standardization ######
 241
 242 sub standardize_usps {
 243   my $class = shift;
 244
 245   eval "use Business::US::USPS::WebTools::AddressStandardization";
 246   die $@ if $@;
 247
 248   my $location = shift;
 249   if ( $location->{country} ne 'US' ) {
 250     # soft failure
 251     warn "standardize_usps not for use in country ".$location->{country}."\n";
 252     $location->{addr_clean} = '';
 253     return $location;
 254   }
 255   my $userid   = $conf->config('usps_webtools-userid');
 256   my $password = $conf->config('usps_webtools-password');
 257   my $verifier = Business::US::USPS::WebTools::AddressStandardization->new( {
 258       UserID => $userid,
 259       Password => $password,
 260       Testing => 0,
 261   } ) or die "error starting USPS WebTools\n";
 262
 263   my($zip5, $zip4) = split('-',$location->{'zip'});
 264
 265   my %usps_args = (
 266     FirmName => $location->{company},
 267     Address2 => $location->{address1},
 268     Address1 => $location->{address2},
 269     City     => $location->{city},
 270     State    => $location->{state},
 271     Zip5     => $zip5,
 272     Zip4     => $zip4,
 273   );
 274   warn join('', map "$_: $usps_args{$_}\n", keys %usps_args )
 275     if $DEBUG > 1;
 276
 277   my $hash = $verifier->verify_address( %usps_args );
 278
 279   warn $verifier->response
 280     if $DEBUG > 1;
 281
 282   die "USPS WebTools error: ".$verifier->{error}{description} ."\n"
 283     if $verifier->is_error;
 284
 285   my $zip = $hash->{Zip5};
 286   $zip .= '-' . $hash->{Zip4} if $hash->{Zip4} =~ /\d/;
 287
 288   { company   => $hash->{FirmName},
 289     address1  => $hash->{Address2},
 290     address2  => $hash->{Address1},
 291     city      => $hash->{City},
 292     state     => $hash->{State},
 293     zip       => $zip,
 294     country   => 'US',
 295     addr_clean=> 'Y' }
 296 }
 297
 298 ###### U.S. Census Bureau ######
 299
 300 sub standardize_uscensus {
 301   my $self = shift;
 302   my $location = shift;
 303
 304   eval "use Geo::USCensus::Geocoding";
 305   die $@ if $@;
 306
 307   if ( $location->{country} ne 'US' ) {
 308     # soft failure
 309     warn "standardize_uscensus not for use in country ".$location->{country}."\n";
 310     $location->{addr_clean} = '';
 311     return $location;
 312   }
 313
 314   my $request = {
 315     street  => $location->{address1},
 316     city    => $location->{city},
 317     state   => $location->{state},
 318     zip     => $location->{zip},
 319     debug   => ($DEBUG || 0),
 320   };
 321
 322   my $result = Geo::USCensus::Geocoding->query($request);
 323   if ( $result->is_match ) {
 324     # unfortunately we get the address back as a single line
 325     if ($result->address =~ /^(.*), (.*), ([A-Z]{2}), (\d{5}.*)$/) {
 326       return +{
 327         address1    => $1,
 328         city        => $2,
 329         state       => $3,
 330         zip         => $4,
 331         address2    => uc($location->{address2}),
 332         latitude    => $result->latitude,
 333         longitude   => $result->longitude,
 334         censustract => $result->censustract,
 335       };
 336     } else {
 337       die "Geocoding returned '".$result->address."', which does not seem to be a valid address.\n";
 338     }
 339   } elsif ( $result->match_level eq 'Tie' ) {
 340     die "Geocoding was not able to identify a unique matching address.\n";
 341   } elsif ( $result->match_level ) {
 342     die "Geocoding did not find a matching address.\n";
 343   } else {
 344     warn Dumper($result) if $DEBUG;
 345     die $result->error_message;
 346   }
 347 }
 348
 349 ####### EZLOCATE (obsolete) #######
 350
 351 my %ezlocate_error = ( # USA_Geo_002 documentation
 352   10  => 'State not found',
 353   11  => 'City not found',
 354   12  => 'Invalid street address',
 355   14  => 'Street name not found',
 356   15  => 'Address range does not exist',
 357   16  => 'Ambiguous address',
 358   17  => 'Intersection not found', #unused?
 359 );
 360
 361 sub standardize_ezlocate {
 362   my $self = shift;
 363   my $location = shift;
 364   my $class;
 365   #if ( $location->{country} eq 'US' ) {
 366   #  $class = 'USA_Geo_004Tool';
 367   #}
 368   #elsif ( $location->{country} eq 'CA' ) {
 369   #  $class = 'CAN_Geo_001Tool';
 370   #}
 371   #else { # shouldn't be a fatal error, just pass through unverified address
 372   #  warn "standardize_teleatlas: address lookup in '".$location->{country}.
 373   #       "' not available\n";
 374   #  return $location;
 375   #}
 376   #my $path = $conf->config('teleatlas-path') || '';
 377   #local @INC = (@INC, $path);
 378   #eval "use $class;";
 379   #if ( $@ ) {
 380   #  die "Loading $class failed:\n$@".
 381   #      "\nMake sure the TeleAtlas Perl SDK is installed correctly.\n";
 382   #}
 383
 384   $class = 'Geo::EZLocate'; # use our own library
 385   eval "use $class 0.02"; #Geo::EZLocate 0.02 for error handling
 386   die $@ if $@;
 387
 388   my $userid = $conf->config('ezlocate-userid')
 389     or die "no ezlocate-userid configured\n";
 390   my $password = $conf->config('ezlocate-password')
 391     or die "no ezlocate-password configured\n";
 392
 393   my $tool = $class->new($userid, $password);
 394   my $match = $tool->findAddress(
 395     $location->{address1},
 396     $location->{city},
 397     $location->{state},
 398     $location->{zip}, #12345-6789 format is allowed
 399   );
 400   warn "ezlocate returned match:\n".Dumper($match) if $DEBUG > 1;
 401   # error handling - B codes indicate success
 402   die $ezlocate_error{$match->{MAT_STAT}}."\n"
 403     unless $match->{MAT_STAT} =~ /^B\d$/;
 404
 405   my %result = (
 406     address1    => $match->{MAT_ADDR},
 407     address2    => $location->{address2},
 408     city        => $match->{MAT_CITY},
 409     state       => $match->{MAT_ST},
 410     country     => $location->{country},
 411     zip         => $match->{MAT_ZIP},
 412     latitude    => $match->{MAT_LAT},
 413     longitude   => $match->{MAT_LON},
 414     censustract => $match->{FIPS_ST}.$match->{FIPS_CTY}.
 415                    sprintf('%07.2f',$match->{CEN_TRCT}),
 416     addr_clean  => 'Y',
 417   );
 418   if ( $match->{STD_ADDR} ) {
 419     # then they have a postal standardized address for us
 420     %result = ( %result,
 421       address1    => $match->{STD_ADDR},
 422       address2    => $location->{address2},
 423       city        => $match->{STD_CITY},
 424       state       => $match->{STD_ST},
 425       zip         => $match->{STD_ZIP}.'-'.$match->{STD_P4},
 426     );
 427   }
 428
 429   \%result;
 430 }
 431
 432 sub _tomtom_query { # helper method for the below
 433   my %args = @_;
 434   my $result = Geo::TomTom::Geocoding->query(%args);
 435   die "TomTom geocoding error: ".$result->message."\n"
 436     unless ( $result->is_success );
 437   my ($match) = $result->locations;
 438   my $type = $match->{type};
 439   # match levels below "intersection" should not be considered clean
 440   my $clean = ($type eq 'addresspoint'  ||
 441                $type eq 'poi'           ||
 442                $type eq 'house'         ||
 443                $type eq 'intersection'
 444               ) ? 'Y' : '';
 445   warn "tomtom returned $type match\n" if $DEBUG;
 446   warn Dumper($match) if $DEBUG > 1;
 447   ($match, $clean);
 448 }
 449
 450 sub standardize_tomtom {
 451   # post-2013 TomTom API
 452   # much better, but incompatible with ezlocate
 453   my $self = shift;
 454   my $location = shift;
 455   eval "use Geo::TomTom::Geocoding; use Geo::StreetAddress::US";
 456   die $@ if $@;
 457
 458   my $key = $conf->config('tomtom-userid')
 459     or die "no tomtom-userid configured\n";
 460
 461   my $country = code2country($location->{country});
 462   my ($address1, $address2) = ($location->{address1}, $location->{address2});
 463   my $subloc = '';
 464
 465   # trim whitespace
 466   $address1 =~ s/^\s+//;
 467   $address1 =~ s/\s+$//;
 468   $address2 =~ s/^\s+//;
 469   $address2 =~ s/\s+$//;
 470
 471   # try to fix some cases of the address fields being switched
 472   if ( $address2 =~ /^\d/ and $address1 !~ /^\d/ ) {
 473     $address2 = $address1;
 474     $address1 = $location->{address2};
 475   }
 476   # parse sublocation part (unit/suite/apartment...) and clean up
 477   # non-sublocation address2
 478   ($subloc, $address2) =
 479     subloc_address2($address1, $address2, $location->{country});
 480   # ask TomTom to standardize address1:
 481   my %args = (
 482     key => $key,
 483     T   => $address1,
 484     L   => $location->{city},
 485     AA  => $location->{state},
 486     PC  => $location->{zip},
 487     CC  => country2code($country, LOCALE_CODE_ALPHA_3),
 488   );
 489
 490   my ($match, $clean) = _tomtom_query(%args);
 491
 492   if (!$match or !$clean) {
 493     # Then try cleaning up the input; TomTom is picky about junk in the
 494     # address.  Any of these can still be a clean match.
 495     my $h = Geo::StreetAddress::US->parse_location($address1);
 496     # First conservatively:
 497     if ( $h->{sec_unit_type} ) {
 498       my $strip = '\s+' . $h->{sec_unit_type};
 499       $strip .= '\s*' . $h->{sec_unit_num} if $h->{sec_unit_num};
 500       $strip .= '$';
 501       $args{T} =~ s/$strip//;
 502       ($match, $clean) = _tomtom_query(%args);
 503     }
 504     if ( !$match or !$clean ) {
 505       # Then more aggressively:
 506       $args{T} = uc( join(' ', @$h{'number', 'street', 'type'}) );
 507       ($match, $clean) = _tomtom_query(%args);
 508     }
 509   }
 510
 511   if ( !$match or !$clean ) { # partial matches are not useful
 512     die "Address not found\n";
 513   }
 514   my $tract = '';
 515   if ( defined $match->{censusTract} ) {
 516     $tract = $match->{censusStateCode}. $match->{censusFipsCountyCode}.
 517              join('.', $match->{censusTract} =~ /(....)(..)/);
 518   }
 519   $address1 = '';
 520   $address1 = $match->{houseNumber} . ' ' if length($match->{houseNumber});
 521   $address1 .= $match->{street} if $match->{street};
 522   $address1 .= ' '.$subloc if $subloc;
 523   $address1 = uc($address1); # USPS standards
 524
 525   return +{
 526     address1    => $address1,
 527     address2    => $address2,
 528     city        => uc($match->{city}),
 529     state       => uc($location->{state}),
 530     country     => uc($location->{country}),
 531     zip         => ($match->{standardPostalCode} || $match->{postcode}),
 532     latitude    => $match->{latitude},
 533     longitude   => $match->{longitude},
 534     censustract => $tract,
 535     addr_clean  => $clean,
 536   };
 537 }
 538
 539 =iten subloc_address2 ADDRESS1, ADDRESS2, COUNTRY
 540
 541 Given 'address1' and 'address2' strings, extract the sublocation part
 542 (from either one) and return it.  If the sublocation was found in ADDRESS1,
 543 also return ADDRESS2 (cleaned up for postal standards) as it's assumed to
 544 contain something relevant.
 545
 546 =cut
 547
 548 my %subloc_forms = (
 549   # Postal Addressing Standards, Appendix C
 550   # (plus correction of "hanger" to "hangar")
 551   US => {qw(
 552     APARTMENT     APT
 553     BASEMENT      BSMT
 554     BUILDING      BLDG
 555     DEPARTMENT    DEPT
 556     FLOOR         FL
 557     FRONT         FRNT
 558     HANGAR        HNGR
 559     HANGER        HNGR
 560     KEY           KEY
 561     LOBBY         LBBY
 562     LOT           LOT
 563     LOWER         LOWR
 564     OFFICE        OFC
 565     PENTHOUSE     PH
 566     PIER          PIER
 567     REAR          REAR
 568     ROOM          RM
 569     SIDE          SIDE
 570     SLIP          SLIP
 571     SPACE         SPC
 572     STOP          STOP
 573     SUITE         STE
 574     TRAILER       TRLR
 575     UNIT          UNIT
 576     UPPER         UPPR
 577   )},
 578   # Canada Post Addressing Guidelines 4.3
 579   CA => {qw(
 580     APARTMENT     APT
 581     APPARTEMENT   APP
 582     BUREAU        BUREAU
 583     SUITE         SUITE
 584     UNIT          UNIT
 585     UNITÉ         UNITÉ
 586   )},
 587 );
 588
 589 sub subloc_address2 {
 590   # Some things seen in the address2 field:
 591   # Whitespace
 592   # The complete address (with address1 containing part of the company name,
 593   # or an ATTN or DBA line, or P.O. Box, or department name, or building/suite
 594   # number, etc.)
 595
 596   # try to parse sublocation parts from address1; if they are present we'll
 597   # append them back to address1 after standardizing
 598   my $subloc = '';
 599   my ($addr1, $addr2, $country) = map uc, @_;
 600   my $dict = $subloc_forms{$country} or return('', $addr2);
 601
 602   my $found_in = 0; # which address is the sublocation
 603   my $h;
 604   foreach my $string (
 605     # patterns to try to parse
 606     $addr1,
 607     "$addr1 Nullcity, CA"
 608   ) {
 609     $h = Geo::StreetAddress::US->parse_location($addr1);
 610     last if exists($h->{sec_unit_type});
 611   }
 612   if (exists($h->{sec_unit_type})) {
 613     $found_in = 1
 614   } else {
 615     foreach my $string (
 616       # more patterns
 617       $addr2,
 618       "$addr1, $addr2",
 619       "$addr1, $addr2 Nullcity, CA"
 620     ) {
 621       $h = Geo::StreetAddress::US->parse_location("$addr1, $addr2");
 622       last if exists($h->{sec_unit_type});
 623     }
 624     if (exists($h->{sec_unit_type})) {
 625       $found_in = 2;
 626     }
 627   }
 628   if ( $found_in ) {
 629     $subloc = $h->{sec_unit_type};
 630     # special case: do not combine P.O. box sublocs with address1
 631     if ( $h->{sec_unit_type} =~ /^P *O *BOX/i ) {
 632       if ( $found_in == 2 ) {
 633         $addr2 = "PO BOX ".$h->{sec_unit_num};
 634       } # else it's in addr1, and leave it alone
 635       return ('', $addr2);
 636     } elsif ( exists($dict->{$subloc}) ) {
 637       # substitute the official abbreviation
 638       $subloc = $dict->{$subloc};
 639     }
 640     $subloc .= ' ' . $h->{sec_unit_num} if length($h->{sec_unit_num});
 641   } # otherwise $subloc = ''
 642
 643   if ( $found_in == 2 ) {
 644     # address2 should be fully combined into address1
 645     return ($subloc, '');
 646   }
 647   # else address2 is not the canonical sublocation, but do our best to
 648   # clean it up
 649   #
 650   # protect this
 651   $addr2 =~ s/#\s*(\d)/NUMBER$1/; # /g?
 652   my @words;
 653   # remove all punctuation and spaces
 654   foreach my $w (split(/\W+/, $addr2)) {
 655     if ( exists($dict->{$w}) ) {
 656       push @words, $dict->{$w};
 657     } else {
 658       push @words, $w;
 659     }
 660     my $result = join(' ', @words);
 661     # correct spacing of pound sign + number
 662     $result =~ s/NUMBER(\d)/# $1/;
 663     warn "normalizing '$addr2' to '$result'\n" if $DEBUG > 1;
 664     $addr2 = $result;
 665   }
 666   $addr2 = '' if $addr2 eq $subloc; # if it was entered redundantly
 667   ($subloc, $addr2);
 668 }
 669
 670 sub standardize_melissa {
 671   my $class = shift;
 672   my $location = shift;
 673
 674   local $@;
 675   eval "use Geo::Melissa::WebSmart";
 676   die $@ if $@;
 677
 678   my $id = $conf->config('melissa-userid')
 679     or die "no melissa-userid configured\n";
 680   my $geocode = $conf->exists('melissa-enable_geocoding') ? 1 : 0;
 681
 682   my $request = {
 683     id      => $id,
 684     a1      => $location->{address1},
 685     a2      => $location->{address2},
 686     city    => $location->{city},
 687     state   => $location->{state},
 688     ctry    => $location->{country},
 689     zip     => $location->{zip},
 690     geocode => $geocode,
 691   };
 692   my $result = Geo::Melissa::WebSmart->query($request);
 693   if ( $result->code =~ /AS01/ ) { # always present on success
 694     my $addr = $result->address;
 695     warn Dumper $addr if $DEBUG > 1;
 696     my $out = {
 697       address1    => $addr->{Address1},
 698       address2    => $addr->{Address2},
 699       city        => $addr->{City}->{Name},
 700       state       => $addr->{State}->{Abbreviation},
 701       country     => $addr->{Country}->{Abbreviation},
 702       zip         => $addr->{Zip},
 703       latitude    => $addr->{Latitude},
 704       longitude   => $addr->{Longitude},
 705       addr_clean  => 'Y',
 706     };
 707     if ( $addr->{Census}->{Tract} ) {
 708       my $censustract = $addr->{County}->{Fips} . $addr->{Census}->{Tract};
 709       # insert decimal point two digits from the end
 710       $censustract =~ s/(\d\d)$/\.$1/;
 711       $out->{censustract} = $censustract;
 712       $out->{censusyear} = $conf->config('census_year');
 713     }
 714     # we could do a lot more nuanced reporting of the warning/status codes,
 715     # but the UI doesn't support that yet.
 716     return $out;
 717   } else {
 718     die $result->status_message;
 719   }
 720 }
 721
 722 =back
 723
 724 =cut
 725
 726 1;