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 =cut
  16
  17 our $VERSION = '0.02';
  18 our $DEBUG = 0;
  19
  20 =head1 SYNOPSIS
  21
  22     use Geo::USCensus::Geocoding;
  23
  24     my $request = {
  25       # required fields
  26       street  => '123 Main Street',
  27       city    => 'San Francisco',   # city
  28       state   => 'CA',              # state
  29       # optional fields
  30       zip     => '93102',           # zip code
  31       benchmark => 'Public_AR_ACS2013', # default is "Public_AR_Current"
  32       vintage   => 'Census2010_ACS2013', # default is "Current_Current"
  33
  34       debug => 1,                   # will print the URL and some other info
  35     };
  36     my $result = Geo::USCensus::Geocoding->query($request);
  37
  38     if ($result->is_match) {
  39       print $result->address,"\n",
  40             $result->latitude,", ",$result->longitude,"\n",
  41             $result->censustract,"\n";
  42     } else {
  43       print "No match.\n";
  44     }
  45
  46 =head1 CLASS METHODS
  47
  48 =head2 query HASHREF
  49
  50 Send a request to the web service.  See
  51 L<http://geocoding.geo.census.gov/geocoder> for API documentation. This
  52 package will always use the batch method (which seems to be more reliable,
  53 as of 2015) and the Geographies return type.
  54
  55 Returns an object of class Geo::USCensus::Geocoding::Result.
  56
  57 =cut
  58
  59 my $ua = LWP::UserAgent->new;
  60 my $url = 'https://geocoding.geo.census.gov/geocoder/geographies/addressbatch';
  61
  62 my $csv = Text::CSV->new({eol => "\n", binary => 1});
  63
  64 # for a current list of benchmark/vintage IDs, download
  65 # http://geocoding.geo.census.gov/geocoder/benchmarks
  66 # http://geocoding.geo.census.gov/geocoder/vintages?benchmark=<id>
  67 # with Accept: application/json
  68
  69 sub query {
  70   my $class = shift;
  71   my %opt = (
  72     returntype => 'geographies',
  73     benchmark => 4, # "Current"
  74     vintage   => 4, # "Current"
  75   );
  76   if (ref $_[0] eq 'HASH') {
  77     %opt = (%opt, %{ $_[0] });
  78   } else {
  79     %opt = (%opt, @_);
  80   }
  81
  82   $DEBUG = $opt{debug} || 0;
  83
  84   my $result = Geo::USCensus::Geocoding::Result->new;
  85
  86   my @row = ( 1 ); # first element = row identifier
  87   # at some point support multiple rows in a single query?
  88   if (!$opt{street}) {
  89     $result->error_message("Street address is required.");
  90     return $result;
  91   }
  92   if (!$opt{zip} and (!$opt{city} or !$opt{state})) {
  93     $result->error_message("Either city/state or zip code is required.");
  94     return $result;
  95   }
  96   foreach (qw(street city state zip)) {
  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 ($long, $lat) = split(',', $fields[5]);
 128       $result->longitude($long);
 129       $result->latitude($lat);
 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       $result->match_level($fields[2]); # "No_Match", "Tie"
 137     }
 138   } else {
 139     $result->error_message( $resp->status_line );
 140   }
 141
 142   return $result;
 143 }
 144
 145 =head1 AUTHOR
 146
 147 Mark Wells, C<< <mark at freeside.biz> >>
 148
 149 =head1 SUPPORT
 150
 151 Commercial support for this module is available from Freeside Internet
 152 Services:
 153
 154     L<http://www.freeside.biz/>
 155
 156 =back
 157
 158
 159 =head1 LICENSE AND COPYRIGHT
 160
 161 Copyright (C) 2014 Mark Wells.
 162 Copyright (C) 2016 Freeside Internet Services, Inc.
 163
 164 This program is free software; you can redistribute it and/or modify it
 165 under the terms of either: the GNU General Public License as published
 166 by the Free Software Foundation; or the Artistic License.
 167
 168 See http://dev.perl.org/licenses/ for more information.
 169
 170 =cut
 171
 172 1;