fix censustract lookup for new FFIEC interface, #32459

1 files changed, 41 insertions, 86 deletions

diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm
index a387aca..dbc383a 100644
--- a/FS/FS/Misc/Geo.pm
+++ b/FS/FS/Misc/Geo.pm
@@ -6,8 +6,7 @@ use vars qw( $DEBUG @EXPORT_OK $conf );
 use LWP::UserAgent;
 use HTTP::Request;
 use HTTP::Request::Common qw( GET POST );
-use HTTP::Cookies;
-use HTML::TokeParser;
+use JSON;
 use URI::Escape 3.31;
 use Data::Dumper;
 use FS::Conf;
@@ -29,7 +28,7 @@ FS::Misc::Geo - routines to fetch geographic information
 
 =over 4
 
-=item get_censustract LOCATION YEAR
+=item get_censustract_ffiec LOCATION YEAR
 
 Given a location hash (see L<FS::location_Mixin>) and a census map year,
 returns a census tract code (consisting of state, county, and tract 
@@ -41,6 +40,7 @@ sub get_censustract_ffiec {
   my $class = shift;
   my $location = shift;
   my $year  = shift;
+  $year ||= 2013;
 
   if ( length($location->{country}) and uc($location->{country}) ne 'US' ) {
     return '';
@@ -48,102 +48,57 @@ sub get_censustract_ffiec {
 
   warn Dumper($location, $year) if $DEBUG;
 
-  my $url = 'http://www.ffiec.gov/Geocode/default.aspx';
-
-  my $return = {};
-  my $error = '';
+  # the old FFIEC geocoding service was shut down December 1, 2014.
+  # welcome to the future.
+  my $url = 'https://geomap.ffiec.gov/FFIECGeocMap/GeocodeMap1.aspx/GetGeocodeData';
+  # build the single-line query
+  my $single_line = join(', ', $location->{address1},
+                               $location->{city},
+                               $location->{state}
+                        );
+  my $hashref = { sSingleLine => $single_line, iCensusYear => $year };
+  my $request = POST( $url,
+    'Content-Type' => 'application/json; charset=utf-8',
+    'Accept' => 'application/json',
+    'Content' => encode_json($hashref)
+  );
 
-  my $ua = new LWP::UserAgent('cookie_jar' => HTTP::Cookies->new);
-  my $res = $ua->request( GET( $url ) );
+  my $ua = new LWP::UserAgent;
+  my $res = $ua->request( $request );
 
   warn $res->as_string
     if $DEBUG > 2;
 
   if (!$res->is_success) {
 
-    $error = $res->message;
-
-  } else {
-
-    my $content = $res->content;
-
-    my $p = new HTML::TokeParser \$content;
-    my $viewstate;
-    my $eventvalidation;
-    while (my $token = $p->get_tag('input') ) {
-      if ($token->[1]->{name} eq '__VIEWSTATE') {
-        $viewstate = $token->[1]->{value};
-      }
-      if ($token->[1]->{name} eq '__EVENTVALIDATION') {
-        $eventvalidation = $token->[1]->{value};
-      }
-      last if $viewstate && $eventvalidation;
-    }
-
-    if (!$viewstate or !$eventvalidation ) {
-
-      $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
+    die "Census tract lookup error: ".$res->message;
 
-    } else {
-
-      my($zip5, $zip4) = split('-',$location->{zip});
-
-      $year ||= '2013';
-      my @ffiec_args = (
-        __VIEWSTATE => $viewstate,
-        __EVENTVALIDATION => $eventvalidation,
-        __VIEWSTATEENCRYPTED => '',
-        ddlbYear    => $year,
-        txtAddress  => $location->{address1},
-        txtCity     => $location->{city},  
-        ddlbState   => $location->{state},
-        txtZipCode  => $zip5,
-        btnSearch   => 'Search',
-      );
-      warn join("\n", @ffiec_args )
-        if $DEBUG > 1;
-
-      push @{ $ua->requests_redirectable }, 'POST';
-      $res = $ua->request( POST( $url, \@ffiec_args ) );
-      warn $res->as_string
-        if $DEBUG > 2;
-
-      unless ($res->code  eq '200') {
-
-        $error = $res->message;
-
-      } else {
-
-        my @id = qw( MSACode StateCode CountyCode TractCode );
-        $content = $res->content;
-        warn $res->content if $DEBUG > 2;
-        $p = new HTML::TokeParser \$content;
-        my $prefix = 'UcGeoResult11_lb';
-        my $compare =
-          sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
-
-        while (my $token = $p->get_tag('span') ) {
-          next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
-          $token->[1]->{id} =~ /^$prefix(\w+)$/;
-          $return->{lc($1)} = $p->get_trimmed_text("/span");
-        }
-
-        unless ( $return->{tractcode} ) {
-          warn "$error: $content ". Dumper($return) if $DEBUG;
-          $error = "No census tract found";
-        }
-        $return->{tractcode} .= ' '
-          unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
+  }
 
-      } #unless ($res->code  eq '200')
+  local $@;
+  my $content = eval { decode_json($res->content) };
+  die "Census tract JSON error: $@\n" if $@;
 
-    } #unless ($viewstate)
+  if ( !exists $content->{d}->{sStatus} ) {
+    die "Census tract response is missing a status indicator.\nThis is an FFIEC problem.\n";
+  }
+  if ( $content->{d}->{sStatus} eq 'Y' ) {
+    # success
+    # this also contains the (partial) standardized address, correct zip 
+    # code, coordinates, etc., and we could get all of them, but right now
+    # we only want the census tract
+    my $tract = join('', $content->{d}->{sStateCode},
+                         $content->{d}->{sCountyCode},
+                         $content->{d}->{sTractCode});
+    return $tract;
 
-  } #unless ($res->code  eq '200')
+  } else {
 
-  die "FFIEC Geocoding error: $error\n" if $error;
+    my $error = $content->{d}->{sMsg}
+            ||  'FFIEC lookup failed, but with no status message.';
+    die "$error\n";
 
-  $return->{'statecode'} .  $return->{'countycode'} .  $return->{'tractcode'};
+  }
 }
 
 #sub get_district_methods {