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