switch to CSV API for better reliability, prepare 0.01 release
[Geo-USCensus-Geocoding.git] / Geocoding.pm
index a7e5ba1..04605ad 100644 (file)
@@ -4,9 +4,9 @@ use strict;
 use warnings;
 
 use LWP::UserAgent;
-use JSON;
-use URI;
-use Geo::USCensus::Geocoding::Match;
+use HTTP::Request::Common;
+use Geo::USCensus::Geocoding::Result;
+use Text::CSV;
 
 =head1 NAME
 
@@ -39,11 +39,12 @@ our $DEBUG = 0;
     };
     my $result = Geo::USCensus::Geocoding->query($request);
 
-    if ($result->matches) {
-      my $match = $result->match(0);
-      print $match->matchedAddress,"\n",
-            $match->coordinates->{x},',',$match->coordinates->{y},"\n",
-            $match->censustract,"\n";
+    if ($result->is_match) {
+      print $result->address,"\n",
+            $result->latitude,", ",$result->longitude,"\n",
+            $result->censustract,"\n";
+    } else {
+      print "No match.\n";
     }
 
 =head1 CLASS METHODS
@@ -52,20 +53,29 @@ our $DEBUG = 0;
 
 Send a request to the web service.  See
 L<http://geocoding.geo.census.gov/geocoder> for API documentation. This 
-package will always use the JSON data format and the Geographies return type.
+package will always use the batch method (which seems to be more reliable,
+as of 2015) and the Geographies return type.
 
-Returns an object of class Geo::USCensus::Geocoding.
+Returns an object of class Geo::USCensus::Geocoding::Result.
 
 =cut
 
 my $ua = LWP::UserAgent->new;
-my $api_uri = 'http://geocoding.geo.census.gov/geocoder/geographies/address';
+my $url = 'http://geocoding.geo.census.gov/geocoder/geographies/addressbatch';
+
+my $csv = Text::CSV->new({eol => "\n", binary => 1});
+
+# for a current list of benchmark/vintage IDs, download
+# http://geocoding.geo.census.gov/geocoder/benchmarks
+# http://geocoding.geo.census.gov/geocoder/vintages?benchmark=<id>
+# with Accept: application/json
 
 sub query {
   my $class = shift;
   my %opt = (
-    benchmark => 'Public_AR_Census2010',
-    vintage   => 'Census2010_Census2010',
+    returntype => 'geographies',
+    benchmark => 4, # "Current"
+    vintage   => 4, # "Current"
   );
   if (ref $_[0] eq 'HASH') {
     %opt = (%opt, %{ $_[0] });
@@ -74,86 +84,61 @@ sub query {
   }
 
   $DEBUG = $opt{debug} || 0;
-  $opt{format} = 'json';
 
+  my $result = Geo::USCensus::Geocoding::Result->new;
+
+  my @row = ( 1 ); # first element = row identifier
+  # at some point support multiple rows in a single query?
   foreach (qw(street city state zip)) {
-    die "$_ required\n" unless length($opt{$_});
+    if (!length($opt{$_})) {
+      $result->error_message("$_ required");
+      return $result;
+    }
+    push @row, $opt{$_};
   }
 
-  my $uri = URI->new($api_uri);
-  $uri->query_form(\%opt);
-  warn "$class->query\n$uri\n\n" if $DEBUG;
-  my $http_req = HTTP::Request->new(GET => $uri->as_string);
-  my $resp = $ua->request($http_req);
-  my $self = { addr_response => $resp };
-  bless $self, $class;
+  $csv->combine(@row);
+  warn "Sending:\n".$csv->string."\n" if $DEBUG;
+
+  # they are not picky about content types, Accept headers, etc., but
+  # the uploaded file must have a _name_.
+  my $resp = $ua->request(POST $url,
+    'Content_Type'  => 'form-data',
+    'Content'       => [ benchmark     => $opt{benchmark},
+                         vintage       => $opt{vintage},
+                         returntype    => $opt{returntype},
+                         addressFile   => [ undef, 'upload.csv',
+                                            Content => $csv->string
+                                          ],
+                       ],
+  );
   if ( $resp->is_success ) {
-    local $@;
-    my $tree = eval { from_json($resp->content) };
-    if ($@) {
-      $self->message("Unable to parse response:\n$@");
-      return $self;
+    $result->content($resp->content);
+    my $status = $csv->parse($resp->content);
+    my @fields = $csv->fields;
+    if (!$status or @fields < 3) {
+      $result->error_message("Unable to parse response:\n" . $resp->content);
+      return $result;
     }
-    if (!exists $tree->{result}) {
-      $self->message("Response does not contain geocoding results.");
-      warn $self->message. "\n".$resp->content."\n\n";
-      return $self;
+    if ( $fields[2] eq 'Match' ) {
+      $result->is_match(1);
+      $result->match_level($fields[3]);
+      $result->address($fields[4]);
+      my ($lat, $long) = split(',', $fields[5]);
+      $result->latitude($lat);
+      $result->longitude($long);
+      $result->state($fields[8]);
+      $result->county($fields[9]);
+      $result->tract($fields[10]);
+      $result->block($fields[11]);
+    } else {
+      $result->is_match(0);
     }
-    $tree = $tree->{result};
-
-    my @matches;
-    if (exists( $tree->{addressMatches} )) {
-      foreach my $am (@{ $tree->{addressMatches} }) {
-        push @matches, Geo::USCensus::Geocoding::Match->new($am);
-      }
-    } # else what? does this happen if there's no match? a proper REST 
-      # interface should throw a 404
-    $self->{matches} = \@matches;
   } else {
-    $self->message( $resp->status_line );
-  }
-  $self;
-}
-
-=head1 METHODS
-
-=head2 message
-
-Sets/gets an explicit error status.
-
-=cut
-
-sub message {
-  my $self = shift;
-  if (@_) {
-    $self->{_message} = shift;
+    $result->error_message( $resp->status_line );
   }
-  $self->{_message} || '';
-}
-
-=head2 matches
-
-Returns the number of matches found. 
-
-=cut
-
-sub matches {
-  my $self = shift;
-  $self->{matches} ? scalar @{ $self->{matches} } : 0;
-}
-
-=head2 match NUMBER
-
-Returns a specific match (starting from zero). Matches are returned 
-as L<Geo::USCensus::Geocoding::Match> objects, in the order they were 
-returned by the service.
-
-=cut
 
-sub match {
-  my $self = shift;
-  my $i = shift;
-  $self->{matches}->[$i];
+  return $result;
 }
 
 =head1 AUTHOR