1 package Geo::USCensus::Geocoding;
7 use HTTP::Request::Common;
8 use Geo::USCensus::Geocoding::Result;
13 Geo::USCensus::Geocoding - The U.S. Census Bureau geocoding service
21 our $VERSION = '0.01';
26 use Geo::USCensus::Geocoding;
30 street => '123 Main Street',
31 city => 'San Francisco', # city
32 state => 'CA', # state
34 zip => '93102', # zip code
35 benchmark => 'Public_AR_ACS2013', # default is "Public_AR_Current"
36 vintage => 'Census2010_ACS2013', # default is "Current_Current"
38 debug => 1, # will print the URL and some other info
40 my $result = Geo::USCensus::Geocoding->query($request);
42 if ($result->is_match) {
43 print $result->address,"\n",
44 $result->latitude,", ",$result->longitude,"\n",
45 $result->censustract,"\n";
54 Send a request to the web service. See
55 L<http://geocoding.geo.census.gov/geocoder> for API documentation. This
56 package will always use the batch method (which seems to be more reliable,
57 as of 2015) and the Geographies return type.
59 Returns an object of class Geo::USCensus::Geocoding::Result.
63 my $ua = LWP::UserAgent->new;
64 my $url = 'http://geocoding.geo.census.gov/geocoder/geographies/addressbatch';
66 my $csv = Text::CSV->new({eol => "\n", binary => 1});
68 # for a current list of benchmark/vintage IDs, download
69 # http://geocoding.geo.census.gov/geocoder/benchmarks
70 # http://geocoding.geo.census.gov/geocoder/vintages?benchmark=<id>
71 # with Accept: application/json
76 returntype => 'geographies',
77 benchmark => 4, # "Current"
78 vintage => 4, # "Current"
80 if (ref $_[0] eq 'HASH') {
81 %opt = (%opt, %{ $_[0] });
86 $DEBUG = $opt{debug} || 0;
88 my $result = Geo::USCensus::Geocoding::Result->new;
90 my @row = ( 1 ); # first element = row identifier
91 # at some point support multiple rows in a single query?
93 $result->error_message("Street address is required.");
96 if (!$opt{zip} and (!$opt{city} or !$opt{state})) {
97 $result->error_message("Either city/state or zip code is required.");
100 foreach (qw(street city state zip)) {
101 push @row, $opt{$_} || '';
105 warn "Sending:\n".$csv->string."\n" if $DEBUG;
107 # they are not picky about content types, Accept headers, etc., but
108 # the uploaded file must have a _name_.
109 my $resp = $ua->request(POST $url,
110 'Content_Type' => 'form-data',
111 'Content' => [ benchmark => $opt{benchmark},
112 vintage => $opt{vintage},
113 returntype => $opt{returntype},
114 addressFile => [ undef, 'upload.csv',
115 Content => $csv->string
119 if ( $resp->is_success ) {
120 $result->content($resp->content);
121 my $status = $csv->parse($resp->content);
122 my @fields = $csv->fields;
123 if (!$status or @fields < 3) {
124 $result->error_message("Unable to parse response:\n" . $resp->content);
127 if ( $fields[2] eq 'Match' ) {
128 $result->is_match(1);
129 $result->match_level($fields[3]);
130 $result->address($fields[4]);
131 my ($long, $lat) = split(',', $fields[5]);
132 $result->longitude($long);
133 $result->latitude($lat);
134 $result->state($fields[8]);
135 $result->county($fields[9]);
136 $result->tract($fields[10]);
137 $result->block($fields[11]);
139 $result->is_match(0);
140 $result->match_level($fields[2]); # "No_Match", "Tie"
143 $result->error_message( $resp->status_line );
151 Mark Wells, C<< <mark at freeside.biz> >>
155 Commercial support for this module is available from Freeside Internet
158 L<http://www.freeside.biz/>
163 =head1 LICENSE AND COPYRIGHT
165 Copyright (C) 2014 Mark Wells.
167 This program is free software; you can redistribute it and/or modify it
168 under the terms of either: the GNU General Public License as published
169 by the Free Software Foundation; or the Artistic License.
171 See http://dev.perl.org/licenses/ for more information.