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;
