Geocoding.pm

   1 package Geo::USCensus::Geocoding;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LWP::UserAgent;
   7 use JSON;
   8 use URI;
   9 use Geo::USCensus::Geocoding::Match;
  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->matches) {
  43       my $match = $result->match(0);
  44       print $match->matchedAddress,"\n",
  45             $match->coordinates->{x},',',$match->coordinates->{y},"\n",
  46             $match->censustract,"\n";
  47     }
  48
  49 =head1 CLASS METHODS
  50
  51 =head2 query HASHREF
  52
  53 Send a request to the web service.  See
  54 L<http://geocoding.geo.census.gov/geocoder> for API documentation. This
  55 package will always use the JSON data format and the Geographies return type.
  56
  57 Returns an object of class Geo::USCensus::Geocoding.
  58
  59 =cut
  60
  61 my $ua = LWP::UserAgent->new;
  62 my $api_uri = 'http://geocoding.geo.census.gov/geocoder/geographies/address';
  63
  64 sub query {
  65   my $class = shift;
  66   my %opt = (
  67     benchmark => 'Public_AR_Census2010',
  68     vintage   => 'Census2010_Census2010',
  69   );
  70   if (ref $_[0] eq 'HASH') {
  71     %opt = (%opt, %{ $_[0] });
  72   } else {
  73     %opt = (%opt, @_);
  74   }
  75
  76   $DEBUG = $opt{debug} || 0;
  77   $opt{format} = 'json';
  78
  79   foreach (qw(street city state zip)) {
  80     die "$_ required\n" unless length($opt{$_});
  81   }
  82
  83   my $uri = URI->new($api_uri);
  84   $uri->query_form(\%opt);
  85   warn "$class->query\n$uri\n\n" if $DEBUG;
  86   my $http_req = HTTP::Request->new(GET => $uri->as_string);
  87   my $resp = $ua->request($http_req);
  88   my $self = { addr_response => $resp };
  89   bless $self, $class;
  90   if ( $resp->is_success ) {
  91     local $@;
  92     my $tree = eval { from_json($resp->content) };
  93     if ($@) {
  94       $self->message("Unable to parse response:\n$@");
  95       return $self;
  96     }
  97     if (!exists $tree->{result}) {
  98       $self->message("Response does not contain geocoding results.");
  99       warn $self->message. "\n".$resp->content."\n\n";
 100       return $self;
 101     }
 102     $tree = $tree->{result};
 103
 104     my @matches;
 105     if (exists( $tree->{addressMatches} )) {
 106       foreach my $am (@{ $tree->{addressMatches} }) {
 107         push @matches, Geo::USCensus::Geocoding::Match->new($am);
 108       }
 109     } # else what? does this happen if there's no match? a proper REST
 110       # interface should throw a 404
 111     $self->{matches} = \@matches;
 112   } else {
 113     $self->message( $resp->status_line );
 114   }
 115   $self;
 116 }
 117
 118 =head1 METHODS
 119
 120 =head2 message
 121
 122 Sets/gets an explicit error status.
 123
 124 =cut
 125
 126 sub message {
 127   my $self = shift;
 128   if (@_) {
 129     $self->{_message} = shift;
 130   }
 131   $self->{_message} || '';
 132 }
 133
 134 =head2 matches
 135
 136 Returns the number of matches found.
 137
 138 =cut
 139
 140 sub matches {
 141   my $self = shift;
 142   $self->{matches} ? scalar @{ $self->{matches} } : 0;
 143 }
 144
 145 =head2 match NUMBER
 146
 147 Returns a specific match (starting from zero). Matches are returned
 148 as L<Geo::USCensus::Geocoding::Match> objects, in the order they were
 149 returned by the service.
 150
 151 =cut
 152
 153 sub match {
 154   my $self = shift;
 155   my $i = shift;
 156   $self->{matches}->[$i];
 157 }
 158
 159 =head1 AUTHOR
 160
 161 Mark Wells, C<< <mark at freeside.biz> >>
 162
 163 =head1 SUPPORT
 164
 165 Commercial support for this module is available from Freeside Internet
 166 Services:
 167
 168     L<http://www.freeside.biz/>
 169
 170 =back
 171
 172
 173 =head1 LICENSE AND COPYRIGHT
 174
 175 Copyright (C) 2014 Mark Wells.
 176
 177 This program is free software; you can redistribute it and/or modify it
 178 under the terms of either: the GNU General Public License as published
 179 by the Free Software Foundation; or the Artistic License.
 180
 181 See http://dev.perl.org/licenses/ for more information.
 182
 183 =cut
 184
 185 1;