From e33b3f4ae5f63db6f734ef38049092911ea9961b Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 17 Nov 2016 00:57:40 -0800 Subject: [PATCH 1/1] initial version --- .gitignore | 6 ++ Changes | 4 ++ MANIFEST | 12 ++++ Makefile.PL | 23 +++++++ README | 31 +++++++++ TIGERweb.pm | 174 +++++++++++++++++++++++++++++++++++++++++++++++++++ TIGERweb/Layer.pm | 38 +++++++++++ TIGERweb/Service.pm | 22 +++++++ debian/changelog | 5 ++ debian/compat | 1 + debian/control | 14 +++++ debian/copyright | 24 +++++++ debian/rules | 4 ++ debian/source/format | 1 + debian/watch | 2 + ignore.txt | 12 ++++ t/00-load.t | 9 +++ t/01-lookup.t | 16 +++++ 18 files changed, 398 insertions(+) create mode 100644 .gitignore create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 TIGERweb.pm create mode 100644 TIGERweb/Layer.pm create mode 100644 TIGERweb/Service.pm create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/rules create mode 100644 debian/source/format create mode 100644 debian/watch create mode 100644 ignore.txt create mode 100644 t/00-load.t create mode 100644 t/01-lookup.t diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9788afa --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +blib/ +*.sw? +Makefile +Makefile.old +MYMETA.yml +pm_to_blib diff --git a/Changes b/Changes new file mode 100644 index 0000000..dc2bdd2 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Geo-USCensus-TIGERweb + +0.01 Nov 17 2016 + - initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..b84c92b --- /dev/null +++ b/MANIFEST @@ -0,0 +1,12 @@ +MANIFEST +README +Makefile.old +t/00-load.t +t/01-lookup.t +Makefile.PL +Changes +TIGERweb +TIGERweb/Service.pm +TIGERweb/Layer.pm +TIGERweb.pm +ignore.txt diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..18fabd6 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,23 @@ +use 5.006; +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Geo::USCensus::TIGERweb', + AUTHOR => q{Mark Wells }, + VERSION_FROM => 'TIGERweb.pm', + ABSTRACT_FROM => 'TIGERweb.pm', + ($ExtUtils::MakeMaker::VERSION >= 6.3002 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'LWP::UserAgent' => 0, + 'HTTP::Request::Common' => 0, + 'JSON::MaybeXS' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Geo-USCensus-TIGERweb-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..752c295 --- /dev/null +++ b/README @@ -0,0 +1,31 @@ +Geo-USCensus-TIGERweb + +Interface to the U.S. Census Bureau TIGER data services + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Geo::USCensus::TIGERweb + +LICENSE AND COPYRIGHT + +Copyright (C) 2016 Mark Wells +Copyright (C) 2016 Freeside Internet Services + +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. + diff --git a/TIGERweb.pm b/TIGERweb.pm new file mode 100644 index 0000000..553e3ed --- /dev/null +++ b/TIGERweb.pm @@ -0,0 +1,174 @@ +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 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; diff --git a/TIGERweb/Layer.pm b/TIGERweb/Layer.pm new file mode 100644 index 0000000..c416ef1 --- /dev/null +++ b/TIGERweb/Layer.pm @@ -0,0 +1,38 @@ +package Geo::USCensus::TIGERweb::Layer; + +use strict; +use warnings; +use base 'Geo::USCensus::TIGERweb'; + +my %geometryTypeGuess = ( + 'x' => 'esriGeometryPoint', + 'points' => 'esriGeometryMultiPoint', + 'paths' => 'esriGeometryPolyLine', + 'rings' => 'esriGeometryPolygon', +); + +sub query { + my ($self, %param) = @_; + my $g = $param{geometry} or die 'query: geometry required'; + if (!$param{geometryType}) { + foreach (keys %geometryTypeGuess) { + if (exists $g->{$_}) { + $param{geometryType} = $geometryTypeGuess{$_}; + last; + } + } + } + my $fields = delete $param{fields}; + die 'query: fields required' if !$fields; + $param{outFields} = $fields; + # set a spatial reference in a sensible way + my $wkid = $param{inSR} ||= '4326'; + $param{outSR} ||= $wkid; + $g->{wkid} ||= $wkid; + # default to find features that intersect + $param{'spatialRel'} ||= 'esriSpatialRelIntersects'; + + return $self->request('query', \%param); +} + +1; diff --git a/TIGERweb/Service.pm b/TIGERweb/Service.pm new file mode 100644 index 0000000..65cc8c6 --- /dev/null +++ b/TIGERweb/Service.pm @@ -0,0 +1,22 @@ +package Geo::USCensus::TIGERweb::Service; + +use strict; +use warnings; +use base 'Geo::USCensus::TIGERweb'; +use Geo::USCensus::TIGERweb::Layer; + +use List::Util qw(first); + +sub layer { + my $self = shift; + my $id_or_name = shift; + my $def = first { $_->{id} eq $id_or_name or $_->{name} eq $id_or_name } + @{ $self->info->{layers} }; + if (!$def) { + $self->{error} = "TIGERweb layer name/id '$id_or_name' not found"; + return; + } + return $self->create('Layer', $def->{id}); +} + +1; diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..6c859cb --- /dev/null +++ b/debian/changelog @@ -0,0 +1,5 @@ +libgeo-uscensus-tigerweb-perl (0.01-1) unstable; urgency=low + + * Initial Release. + + -- Mark Wells Thu, 17 Nov 2016 00:37:21 -0800 diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..ec63514 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +9 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..6c42bce --- /dev/null +++ b/debian/control @@ -0,0 +1,14 @@ +Source: libgeo-uscensus-tigerweb-perl +Section: perl +Priority: optional +Maintainer: Mark Wells +Build-Depends: debhelper (>= 9) +Build-Depends-Indep: perl +Standards-Version: 3.9.6 +Homepage: https://metacpan.org/release/Geo-USCensus-TIGERweb + +Package: libgeo-uscensus-tigerweb-perl +Architecture: all +Depends: ${misc:Depends}, ${perl:Depends} +Description: Interface to the U.S. Census Bureau TIGER data services. + . diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..731d22b --- /dev/null +++ b/debian/copyright @@ -0,0 +1,24 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Source: https://metacpan.org/release/Geo-USCensus-TIGERweb +Upstream-Contact: Mark Wells +Upstream-Name: Geo-USCensus-TIGERweb + +Files: * +Copyright: 2016, Mark Wells +License: Artistic or GPL-1+ + +License: Artistic + This program is free software; you can redistribute it and/or modify + it under the terms of the Artistic License, which comes with Perl. + . + On Debian systems, the complete text of the Artistic License can be + found in `/usr/share/common-licenses/Artistic'. + +License: GPL-1+ + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + . + On Debian systems, the complete text of version 1 of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL-1'. diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..2d33f6a --- /dev/null +++ b/debian/rules @@ -0,0 +1,4 @@ +#!/usr/bin/make -f + +%: + dh $@ diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..f8e1ffc --- /dev/null +++ b/debian/watch @@ -0,0 +1,2 @@ +version=3 +https://metacpan.org/release/Geo-USCensus-TIGERweb .*/Geo-USCensus-TIGERweb-v?(\d[\d.-]*)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ diff --git a/ignore.txt b/ignore.txt new file mode 100644 index 0000000..f08d1d7 --- /dev/null +++ b/ignore.txt @@ -0,0 +1,12 @@ +blib* +Makefile +Makefile.old +Build +Build.bat +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +cover_db +pod2htm*.tmp +Geo-USCensus-Geocoding-* diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..3fc3283 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Geo::USCensus::TIGERweb' ) || print "Bail out!\n"; +} + +diag( "Testing Geo::USCensus::TIGERweb $Geo::USCensus::TIGERweb, Perl $], $^X" ); diff --git a/t/01-lookup.t b/t/01-lookup.t new file mode 100644 index 0000000..937dca6 --- /dev/null +++ b/t/01-lookup.t @@ -0,0 +1,16 @@ +#!perl + +use Test::More tests => 1; +use Data::Dumper; +use Geo::USCensus::TIGERweb; + +diag( "Testing lookup of a census block" ); +my $result = Geo::USCensus::TIGERweb->census_block_at_point( + lat => 38.578793, + lon => -121.48778, + debug => 1, +); + +ok( $result, 'Found a census block'); +diag($result); + -- 2.11.0