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