1 package Geo::USCensus::TIGERweb;
7 use HTTP::Request::Common;
10 use List::Util qw(first);
12 use Geo::USCensus::TIGERweb::Service;
16 Geo::USCensus::TIGERweb - The U.S. Census Bureau TIGER data services
20 our $VERSION = '0.01';
25 use Geo::USCensus::TIGERweb;
27 print Dumper(Geo::USCensus::TIGERweb->info); # enumerates services
28 my $service = Geo::USCensus::TIGERweb->service('Tracts_Blocks');
29 print Dumper($service->info);
30 my $layer = $service->layer('Census Blocks'); # id or name
31 print Dumper($layer->info);
32 my $result = $layer->query(
34 geometry => { x => -121.48778, y => 38.578793 }, # see below
35 fields => [ 'OID', 'GEOID', 'STATE', 'COUNTY' ],
37 # spatialRel => 'esriSpatialRelIntersects', # see below
38 # inSR => 4326, # the default, GPS coords
42 # convenience method: given a longitude and latitude, return
43 # the census block containing that point, or dies on error
44 my $blocknum = Geo::USCensus::TIGERweb->census_block_at_point(
55 Returns a description of the available services.
59 Constructor; returns a L<Geo::USCensus::TIGERweb::Service> handle to the
64 my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE });
65 my $url = 'https://tigerweb.geo.census.gov/arcgis/rest/services';
67 our $GLOBAL = bless { debug => 0, info => undef, path => 'TIGERweb' };
69 # in principle this could be turned into a general ArcGIS client
72 my ($self, $path, $params) = @_;
73 $self = $GLOBAL if !ref($self);
74 my $full_path = join('/', $url, $self->{path});
75 $full_path .= "/$path" if $path;
76 $params = [ %$params ] if ref($params) eq 'HASH';
77 push @$params, ( f => 'pjson' ); # always use this
78 warn "POST $full_path\n" if $self->{debug};
79 warn encode_json($params)."\n" if $self->{debug} > 1;
80 my $response = $ua->request(
81 POST $full_path, Content => $params
83 if ( !$response->is_success ) {
84 $self->{error} = $response->status_line;
87 my $data = decode_json($response->decoded_content);
88 if ( $data->{error} ) {
89 $self->{error} = $data->{error}{message};
97 $self = $GLOBAL if !ref($self);
98 return $self->{info} ||= $self->request('');
102 # internal constructor
104 my $subclass = shift;
106 $self = $GLOBAL if !ref($self);
107 my $class = "Geo::USCensus::TIGERweb::$subclass";
108 my $new = { debug => $self->{debug},
110 path => $self->{path} . '/' . $subpath,
118 my $service_name = shift;
119 my $def = first { $_->{name} eq "TIGERweb/$service_name" }
120 @{ $GLOBAL->info->{services} };
121 die "TIGERweb service name '$service_name' not found" if !$def;
122 my $type = $def->{type};
123 return $GLOBAL->create('Service', "$service_name/$type");
126 =item census_block_at_point PARAMS
128 Takes numeric values for "lat" and "lon" and returns the census block number
129 at that location. This is actually the reason for this entire library.
133 sub census_block_at_point {
134 my ($class, %opt) = @_;
135 die "latitude and longitude required\n"
136 unless defined($opt{lat}) and defined($opt{lon});
137 $GLOBAL->{debug} = $opt{debug} if $opt{debug};
138 my $layer = $class->service('Tracts_Blocks')->layer('Census Blocks');
139 my $result = $layer->query(
140 geometry => { x => $opt{lon}, y => $opt{lat} },
141 fields => [ 'GEOID' ],
143 if ($layer->{error}) {
144 warn $layer->{error}."\n";
146 if (my $f = $result->{features}) {
147 if (scalar(@$f) == 0) {
148 warn "no census block found\n";
151 return $f->[0]->{attributes}{GEOID};
154 warn "no features in query result\n";
161 =head1 LICENSE AND COPYRIGHT
163 Copyright (C) 2016 Mark Wells.
164 Copyright (C) 2016 Freeside Internet Services, Inc.
166 This program is free software; you can redistribute it and/or modify it
167 under the terms of either: the GNU General Public License as published
168 by the Free Software Foundation; or the Artistic License.
170 See http://dev.perl.org/licenses/ for more information.