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/province
  33       zip     => '93102',           # zip/postal code
  34       # optional fields
  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   foreach (qw(street city state zip)) {
  93     if (!length($opt{$_})) {
  94       $result->error_message("$_ required");
  95       return $result;
  96     }
  97     push @row, $opt{$_};
  98   }
  99
 100   $csv->combine(@row);
 101   warn "Sending:\n".$csv->string."\n" if $DEBUG;
 102
 103   # they are not picky about content types, Accept headers, etc., but
 104   # the uploaded file must have a _name_.
 105   my $resp = $ua->request(POST $url,
 106     'Content_Type'  => 'form-data',
 107     'Content'       => [ benchmark     => $opt{benchmark},
 108                          vintage       => $opt{vintage},
 109                          returntype    => $opt{returntype},
 110                          addressFile   => [ undef, 'upload.csv',
 111                                             Content => $csv->string
 112                                           ],
 113                        ],
 114   );
 115   if ( $resp->is_success ) {
 116     $result->content($resp->content);
 117     my $status = $csv->parse($resp->content);
 118     my @fields = $csv->fields;
 119     if (!$status or @fields < 3) {
 120       $result->error_message("Unable to parse response:\n" . $resp->content);
 121       return $result;
 122     }
 123     if ( $fields[2] eq 'Match' ) {
 124       $result->is_match(1);
 125       $result->match_level($fields[3]);
 126       $result->address($fields[4]);
 127       my ($lat, $long) = split(',', $fields[5]);
 128       $result->latitude($lat);
 129       $result->longitude($long);
 130       $result->state($fields[8]);
 131       $result->county($fields[9]);
 132       $result->tract($fields[10]);
 133       $result->block($fields[11]);
 134     } else {
 135       $result->is_match(0);
 136     }
 137   } else {
 138     $result->error_message( $resp->status_line );
 139   }
 140
 141   return $result;
 142 }
 143
 144 =head1 AUTHOR
 145
 146 Mark Wells, C<< <mark at freeside.biz> >>
 147
 148 =head1 SUPPORT
 149
 150 Commercial support for this module is available from Freeside Internet
 151 Services:
 152
 153     L<http://www.freeside.biz/>
 154
 155 =back
 156
 157
 158 =head1 LICENSE AND COPYRIGHT
 159
 160 Copyright (C) 2014 Mark Wells.
 161
 162 This program is free software; you can redistribute it and/or modify it
 163 under the terms of either: the GNU General Public License as published
 164 by the Free Software Foundation; or the Artistic License.
 165
 166 See http://dev.perl.org/licenses/ for more information.
 167
 168 =cut
 169
 170 1;