X-Git-Url: http://git.freeside.biz/gitweb/?p=Geo-USCensus-Geocoding.git;a=blobdiff_plain;f=Geocoding.pm;h=04605ad438befb2bf33c6702a40785a267a49118;hp=c64c5902ca5f06f7e62c80642dfc83beb5872544;hb=c16e8ca7ab01db1321d407a8eba212440b0c97c9;hpb=792fa56fe32dfea38ab824183dc130bc926480df diff --git a/Geocoding.pm b/Geocoding.pm index c64c590..04605ad 100644 --- a/Geocoding.pm +++ b/Geocoding.pm @@ -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 @@ -19,7 +19,7 @@ Version 0.01 =cut our $VERSION = '0.01'; -our $DEBUG = 1; +our $DEBUG = 0; =head1 SYNOPSIS @@ -34,14 +34,17 @@ our $DEBUG = 1; # optional fields benchmark => 'Public_AR_ACS2013', # default is "Public_AR_Current" vintage => 'Census2010_ACS2013', # default is "Current_Current" + + debug => 1, # will print the URL and some other info }; 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 @@ -50,20 +53,29 @@ our $DEBUG = 1; Send a request to the web service. See L 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= +# with Accept: application/json sub query { my $class = shift; my %opt = ( - benchmark => 'Public_AR_Current', - vintage => 'Current_Current', + returntype => 'geographies', + benchmark => 4, # "Current" + vintage => 4, # "Current" ); if (ref $_[0] eq 'HASH') { %opt = (%opt, %{ $_[0] }); @@ -71,86 +83,62 @@ sub query { %opt = (%opt, @_); } - $opt{format} = 'json'; + $DEBUG = $opt{debug} || 0; + + 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 ); + $result->error_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; - } - $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 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