+package Geo::USCensus::TIGERweb;
+
+use strict;
+use warnings;
+
+use LWP::UserAgent;
+use HTTP::Request::Common;
+use JSON::MaybeXS;
+use IO::Socket::SSL;
+use List::Util qw(first);
+
+use Geo::USCensus::TIGERweb::Service;
+
+=head1 NAME
+
+Geo::USCensus::TIGERweb - The U.S. Census Bureau TIGER data services
+
+=cut
+
+our $VERSION = '0.01';
+our $DEBUG = 0;
+
+=head1 SYNOPSIS
+
+ use Geo::USCensus::TIGERweb;
+
+ print Dumper(Geo::USCensus::TIGERweb->info); # enumerates services
+ my $service = Geo::USCensus::TIGERweb->service('Tracts_Blocks');
+ print Dumper($service->info);
+ my $layer = $service->layer('Census Blocks'); # id or name
+ print Dumper($layer->info);
+ my $result = $layer->query(
+ # required fields
+ geometry => { x => -121.48778, y => 38.578793 }, # see below
+ fields => [ 'OID', 'GEOID', 'STATE', 'COUNTY' ],
+ # optional
+ # spatialRel => 'esriSpatialRelIntersects', # see below
+ # inSR => 4326, # the default, GPS coords
+ # outSR => 4326,
+ );
+
+ # convenience method: given a longitude and latitude, return
+ # the census block containing that point, or dies on error
+ my $blocknum = Geo::USCensus::TIGERweb->census_block_at_point(
+ lat => 38.578793,
+ lon => -121.48778
+ );
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item info
+
+Returns a description of the available services.
+
+=item service NAME
+
+Constructor; returns a L<Geo::USCensus::TIGERweb::Service> handle to the
+named service.
+
+=cut
+
+my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0, SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE });
+my $url = 'https://tigerweb.geo.census.gov/arcgis/rest/services';
+
+our $GLOBAL = bless { debug => 0, info => undef, path => 'TIGERweb' };
+
+# in principle this could be turned into a general ArcGIS client
+
+sub request {
+ my ($self, $path, $params) = @_;
+ $self = $GLOBAL if !ref($self);
+ my $full_path = join('/', $url, $self->{path});
+ $full_path .= "/$path" if $path;
+ $params = [ %$params ] if ref($params) eq 'HASH';
+ push @$params, ( f => 'pjson' ); # always use this
+ warn "POST $full_path\n" if $self->{debug};
+ warn encode_json($params)."\n" if $self->{debug} > 1;
+ my $response = $ua->request(
+ POST $full_path, Content => $params
+ );
+ if ( !$response->is_success ) {
+ $self->{error} = $response->status_line;
+ return;
+ }
+ my $data = decode_json($response->decoded_content);
+ if ( $data->{error} ) {
+ $self->{error} = $data->{error}{message};
+ return;
+ }
+ return $data;
+}
+
+sub info {
+ my $self = shift;
+ $self = $GLOBAL if !ref($self);
+ return $self->{info} ||= $self->request('');
+}
+
+sub create {
+ # internal constructor
+ my $self = shift;
+ my $subclass = shift;
+ my $subpath = shift;
+ $self = $GLOBAL if !ref($self);
+ my $class = "Geo::USCensus::TIGERweb::$subclass";
+ my $new = { debug => $self->{debug},
+ info => undef,
+ path => $self->{path} . '/' . $subpath,
+ };
+ bless $new, $class;
+ return $new;
+}
+
+sub service {
+ my $class = shift;
+ my $service_name = shift;
+ my $def = first { $_->{name} eq "TIGERweb/$service_name" }
+ @{ $GLOBAL->info->{services} };
+ die "TIGERweb service name '$service_name' not found" if !$def;
+ my $type = $def->{type};
+ return $GLOBAL->create('Service', "$service_name/$type");
+}
+
+=item census_block_at_point PARAMS
+
+Takes numeric values for "lat" and "lon" and returns the census block number
+at that location. This is actually the reason for this entire library.
+
+=cut
+
+sub census_block_at_point {
+ my ($class, %opt) = @_;
+ die "latitude and longitude required\n"
+ unless defined($opt{lat}) and defined($opt{lon});
+ $GLOBAL->{debug} = $opt{debug} if $opt{debug};
+ my $layer = $class->service('Tracts_Blocks')->layer('Census Blocks');
+ my $result = $layer->query(
+ geometry => { x => $opt{lon}, y => $opt{lat} },
+ fields => [ 'GEOID' ],
+ );
+ if ($layer->{error}) {
+ warn $layer->{error}."\n";
+ }
+ if (my $f = $result->{features}) {
+ if (scalar(@$f) == 0) {
+ warn "no census block found\n";
+ return;
+ } else {
+ return $f->[0]->{attributes}{GEOID};
+ }
+ } else {
+ warn "no features in query result\n";
+ return;
+ }
+}
+
+=back
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2016 Mark Wells.
+Copyright (C) 2016 Freeside Internet Services, Inc.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+=cut
+
+1;