initial version
authorMark Wells <mark@freeside.biz>
Thu, 17 Nov 2016 08:57:40 +0000 (00:57 -0800)
committerMark Wells <mark@freeside.biz>
Thu, 17 Nov 2016 08:57:40 +0000 (00:57 -0800)
18 files changed:
.gitignore [new file with mode: 0644]
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
TIGERweb.pm [new file with mode: 0644]
TIGERweb/Layer.pm [new file with mode: 0644]
TIGERweb/Service.pm [new file with mode: 0644]
debian/changelog [new file with mode: 0644]
debian/compat [new file with mode: 0644]
debian/control [new file with mode: 0644]
debian/copyright [new file with mode: 0644]
debian/rules [new file with mode: 0755]
debian/source/format [new file with mode: 0644]
debian/watch [new file with mode: 0644]
ignore.txt [new file with mode: 0644]
t/00-load.t [new file with mode: 0644]
t/01-lookup.t [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..9788afa
--- /dev/null
@@ -0,0 +1,6 @@
+blib/
+*.sw?
+Makefile
+Makefile.old
+MYMETA.yml
+pm_to_blib
diff --git a/Changes b/Changes
new file mode 100644 (file)
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 (file)
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 (file)
index 0000000..18fabd6
--- /dev/null
@@ -0,0 +1,23 @@
+use 5.006;
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Geo::USCensus::TIGERweb',
+    AUTHOR              => q{Mark Wells <mark@freeside.biz>},
+    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 (file)
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 (file)
index 0000000..553e3ed
--- /dev/null
@@ -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<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;
diff --git a/TIGERweb/Layer.pm b/TIGERweb/Layer.pm
new file mode 100644 (file)
index 0000000..c416ef1
--- /dev/null
@@ -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 (file)
index 0000000..65cc8c6
--- /dev/null
@@ -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 (file)
index 0000000..6c859cb
--- /dev/null
@@ -0,0 +1,5 @@
+libgeo-uscensus-tigerweb-perl (0.01-1) unstable; urgency=low
+
+  * Initial Release.
+
+ -- Mark Wells <mark@freeside.biz>  Thu, 17 Nov 2016 00:37:21 -0800
diff --git a/debian/compat b/debian/compat
new file mode 100644 (file)
index 0000000..ec63514
--- /dev/null
@@ -0,0 +1 @@
+9
diff --git a/debian/control b/debian/control
new file mode 100644 (file)
index 0000000..6c42bce
--- /dev/null
@@ -0,0 +1,14 @@
+Source: libgeo-uscensus-tigerweb-perl
+Section: perl
+Priority: optional
+Maintainer: Mark Wells <mark@freeside.biz>
+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 (file)
index 0000000..731d22b
--- /dev/null
@@ -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 <mark@freeside.biz>
+Upstream-Name: Geo-USCensus-TIGERweb
+
+Files: *
+Copyright: 2016, Mark Wells <mark@freeside.biz>
+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 (executable)
index 0000000..2d33f6a
--- /dev/null
@@ -0,0 +1,4 @@
+#!/usr/bin/make -f
+
+%:
+       dh $@
diff --git a/debian/source/format b/debian/source/format
new file mode 100644 (file)
index 0000000..163aaf8
--- /dev/null
@@ -0,0 +1 @@
+3.0 (quilt)
diff --git a/debian/watch b/debian/watch
new file mode 100644 (file)
index 0000000..f8e1ffc
--- /dev/null
@@ -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 (file)
index 0000000..f08d1d7
--- /dev/null
@@ -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 (file)
index 0000000..3fc3283
--- /dev/null
@@ -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 (file)
index 0000000..937dca6
--- /dev/null
@@ -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);
+