diff options
| -rw-r--r-- | .gitignore | 6 | ||||
| -rw-r--r-- | Changes | 3 | ||||
| -rw-r--r-- | Geocoding.pm | 182 | ||||
| -rw-r--r-- | Geocoding/Match.pm | 43 | ||||
| -rw-r--r-- | MANIFEST | 7 | ||||
| -rw-r--r-- | Makefile.PL | 22 | ||||
| -rw-r--r-- | README | 45 | ||||
| -rw-r--r-- | ignore.txt | 12 | ||||
| -rw-r--r-- | t/00-load.t | 9 | ||||
| -rw-r--r-- | t/01-lookup.t | 19 | ||||
| -rw-r--r-- | t/02-fail.t | 16 |
11 files changed, 364 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9788afa --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +blib/ +*.sw? +Makefile +Makefile.old +MYMETA.yml +pm_to_blib @@ -0,0 +1,3 @@ +Revision history for Geo-USCensus-Geocoding + +unreleased diff --git a/Geocoding.pm b/Geocoding.pm new file mode 100644 index 0000000..c64c590 --- /dev/null +++ b/Geocoding.pm @@ -0,0 +1,182 @@ +package Geo::USCensus::Geocoding; + +use strict; +use warnings; + +use LWP::UserAgent; +use JSON; +use URI; +use Geo::USCensus::Geocoding::Match; + +=head1 NAME + +Geo::USCensus::Geocoding - The U.S. Census Bureau geocoding service + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; +our $DEBUG = 1; + +=head1 SYNOPSIS + + use Geo::USCensus::Geocoding; + + my $request = { + # required fields + street => '123 Main Street', + city => 'San Francisco', # city + state => 'CA', # state/province + zip => '93102', # zip/postal code + # optional fields + benchmark => 'Public_AR_ACS2013', # default is "Public_AR_Current" + vintage => 'Census2010_ACS2013', # default is "Current_Current" + }; + 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"; + } + +=head1 CLASS METHODS + +=head2 query HASHREF + +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. + +Returns an object of class Geo::USCensus::Geocoding. + +=cut + +my $ua = LWP::UserAgent->new; +my $api_uri = 'http://geocoding.geo.census.gov/geocoder/geographies/address'; + +sub query { + my $class = shift; + my %opt = ( + benchmark => 'Public_AR_Current', + vintage => 'Current_Current', + ); + if (ref $_[0] eq 'HASH') { + %opt = (%opt, %{ $_[0] }); + } else { + %opt = (%opt, @_); + } + + $opt{format} = 'json'; + + foreach (qw(street city state zip)) { + die "$_ required\n" unless length($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; + if ( $resp->is_success ) { + local $@; + my $tree = eval { from_json($resp->content) }; + if ($@) { + $self->message("Unable to parse response:\n$@"); + return $self; + } + if (!exists $tree->{result}) { + $self->message("Response does not contain geocoding results."); + warn $self->message. "\n".$resp->content."\n\n"; + return $self; + } + $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; + } + $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]; +} + +=head1 AUTHOR + +Mark Wells, C<< <mark at freeside.biz> >> + +=head1 SUPPORT + +Commercial support for this module is available from Freeside Internet +Services: + + L<http://www.freeside.biz/> + +=back + + +=head1 LICENSE AND COPYRIGHT + +Copyright (C) 2014 Mark Wells. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See http://dev.perl.org/licenses/ for more information. + +=cut + +1; diff --git a/Geocoding/Match.pm b/Geocoding/Match.pm new file mode 100644 index 0000000..6584203 --- /dev/null +++ b/Geocoding/Match.pm @@ -0,0 +1,43 @@ +package Geo::USCensus::Geocoding::Match; + +use strict; + +sub new { + my $class = shift; + my $address = shift; + my $census = shift; + + my $self = { %$address }; + bless $self, $class; +} + +sub matchedAddress { + my $self = shift; + $self->{matchedAddress}; +} + +sub coordinates { + my $self = shift; + $self->{coordinates}; +} + +sub addressComponents { + my $self = shift; + $self->{addressComponents}; +} + +sub geographies { + my $self = shift; + $self->{geographies}; +} + +sub censustract { + my $self = shift; + return '' unless $self->geographies + and exists($self->geographies->{'Census Tracts'}) + and exists($self->geographies->{'Census Tracts'}->[0]); + my $ct = $self->geographies->{'Census Tracts'}->[0]; + return $ct->{STATE} . $ct->{COUNTY} . $ct->{TRACT}; +} + +1; diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..2c57785 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,7 @@ +Changes +Geocoding.pm +Geocoding/Match.pm +Makefile.PL +MANIFEST This list of files +README +t/00-load.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..fa04a9a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,22 @@ +use 5.006; +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Geo::USCensus::Geocoding', + AUTHOR => q{Mark Wells <mark@freeside.biz>}, + VERSION_FROM => 'Geocoding.pm', + ABSTRACT_FROM => 'Geocoding.pm', + ($ExtUtils::MakeMaker::VERSION >= 6.3002 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'XML::LibXML' => 2, + 'LWP::UserAgent' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Geo-USCensus-Geocoding-*' }, +); @@ -0,0 +1,45 @@ +Geo-USCensus-Geocoding + +Interface to the U.S. Census Bureau geocoding service. + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Geo::USCensus::Geocoding + +You can also look for information at: + + RT, CPAN's request tracker (report bugs here) + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Geo-USCensus-Geocoding + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Geo-USCensus-Geocoding + + CPAN Ratings + http://cpanratings.perl.org/d/Geo-USCensus-Geocoding + + Search CPAN + http://search.cpan.org/dist/Geo-USCensus-Geocoding/ + + +LICENSE AND COPYRIGHT + +Copyright (C) 2014 Mark Wells + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See http://dev.perl.org/licenses/ for more information. + diff --git a/ignore.txt b/ignore.txt new file mode 100644 index 0000000..f08d1d7 --- /dev/null +++ b/ignore.txt @@ -0,0 +1,12 @@ +blib* +Makefile +Makefile.old +Build +Build.bat +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +cover_db +pod2htm*.tmp +Geo-USCensus-Geocoding-* diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..46f282f --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Geo::USCensus::Geocoding' ) || print "Bail out!\n"; +} + +diag( "Testing Geo::USCensus::Geocoding $Geo::USCensus::Geocoding, Perl $], $^X" ); diff --git a/t/01-lookup.t b/t/01-lookup.t new file mode 100644 index 0000000..11c8b37 --- /dev/null +++ b/t/01-lookup.t @@ -0,0 +1,19 @@ +#!perl -T + +use Test::More tests => 2; +use Data::Dumper; +use Geo::USCensus::Geocoding; + +diag( "Testing lookup of a known good address" ); +my $result = Geo::USCensus::Geocoding->query( + street => '1526 H St', # the California Governor's Mansion + city => 'Sacramento', + state => 'CA', + zip => '95814', +); + +is( $result->message, '', 'error status' ); +is( $result->matches, 1, 'number of matches' ); +diag($result->match(0)->matchedAddress); +diag('Census tract '.$result->match(0)->censustract); + diff --git a/t/02-fail.t b/t/02-fail.t new file mode 100644 index 0000000..72fc6da --- /dev/null +++ b/t/02-fail.t @@ -0,0 +1,16 @@ +#!perl -T + +use Test::More tests => 1; +use Data::Dumper; +use Geo::USCensus::Geocoding; + +diag( "Testing lookup of a known nonexistent address" ); +my $result = Geo::USCensus::Geocoding->query( + street => '1000 Z St', # there is no Z street + city => 'Sacramento', + state => 'CA', + zip => '95814', +); + +is( $result->matches, 0, 'number of matches' ); + |