Geocoding.pm

   1 package Geo::USCensus::Geocoding;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LWP::UserAgent;
   7 use HTTP::Request::Common;
   8 use Geo::USCensus::Geocoding::Result;
   9 use Text::CSV;
  10
  11 =head1 NAME
  12
  13 Geo::USCensus::Geocoding - The U.S. Census Bureau geocoding service
  14
  15 =head1 VERSION
  16
  17 Version 0.01
  18
  19 =cut
  20
  21 our $VERSION = '0.01';
  22 our $DEBUG = 0;
  23
  24 =head1 SYNOPSIS
  25
  26     use Geo::USCensus::Geocoding;
  27
  28     my $request = {
  29       # required fields
  30       street  => '123 Main Street',
  31       city    => 'San Francisco',   # city
  32       state   => 'CA',              # state
  33       # optional fields
  34       zip     => '93102',           # zip code
  35       benchmark => 'Public_AR_ACS2013', # default is "Public_AR_Current"
  36       vintage   => 'Census2010_ACS2013', # default is "Current_Current"
  37
  38       debug => 1,                   # will print the URL and some other info
  39     };
  40     my $result = Geo::USCensus::Geocoding->query($request);
  41
  42     if ($result->is_match) {
  43       print $result->address,"\n",
  44             $result->latitude,", ",$result->longitude,"\n",
  45             $result->censustract,"\n";
  46     } else {
  47       print "No match.\n";
  48     }
  49
  50 =head1 CLASS METHODS
  51
  52 =head2 query HASHREF
  53
  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.
  58
  59 Returns an object of class Geo::USCensus::Geocoding::Result.
  60
  61 =cut
  62
  63 my $ua = LWP::UserAgent->new;
  64 my $url = 'http://geocoding.geo.census.gov/geocoder/geographies/addressbatch';
  65
  66 my $csv = Text::CSV->new({eol => "\n", binary => 1});
  67
  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
  72
  73 sub query {
  74   my $class = shift;
  75   my %opt = (
  76     returntype => 'geographies',
  77     benchmark => 4, # "Current"
  78     vintage   => 4, # "Current"
  79   );
  80   if (ref $_[0] eq 'HASH') {
  81     %opt = (%opt, %{ $_[0] });
  82   } else {
  83     %opt = (%opt, @_);
  84   }
  85
  86   $DEBUG = $opt{debug} || 0;
  87
  88   my $result = Geo::USCensus::Geocoding::Result->new;
  89
  90   my @row = ( 1 ); # first element = row identifier
  91   # at some point support multiple rows in a single query?
  92   if (!$opt{street}) {
  93     $result->error_message("Street address is required.");
  94     return $result;
  95   }
  96   if (!$opt{zip} and (!$opt{city} or !$opt{state})) {
  97     $result->error_message("Either city/state or zip code is required.");
  98     return $result;
  99   }
 100   foreach (qw(street city state zip)) {
 101     push @row, $opt{$_} || '';
 102   }
 103
 104   $csv->combine(@row);
 105   warn "Sending:\n".$csv->string."\n" if $DEBUG;
 106
 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
 116                                           ],
 117                        ],
 118   );
 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);
 125       return $result;
 126     }
 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]);
 138     } else {
 139       $result->is_match(0);
 140       $result->match_level($fields[2]); # "No_Match", "Tie"
 141     }
 142   } else {
 143     $result->error_message( $resp->status_line );
 144   }
 145
 146   return $result;
 147 }
 148
 149 =head1 AUTHOR
 150
 151 Mark Wells, C<< <mark at freeside.biz> >>
 152
 153 =head1 SUPPORT
 154
 155 Commercial support for this module is available from Freeside Internet
 156 Services:
 157
 158     L<http://www.freeside.biz/>
 159
 160 =back
 161
 162
 163 =head1 LICENSE AND COPYRIGHT
 164
 165 Copyright (C) 2014 Mark Wells.
 166
 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.
 170
 171 See http://dev.perl.org/licenses/ for more information.
 172
 173 =cut
 174
 175 1;