FS/FS/Misc/Geo.pm

   1 package FS::Misc::Geo;
   2
   3 use strict;
   4 use base qw( Exporter );
   5 use vars qw( $DEBUG @EXPORT_OK );
   6 use LWP::UserAgent;
   7 use HTTP::Request;
   8 use HTTP::Request::Common qw( GET POST );
   9 use HTML::TokeParser;
  10 use Data::Dumper;
  11
  12 $DEBUG = 1;
  13
  14 @EXPORT_OK = qw( get_censustract );
  15
  16 =head1 NAME
  17
  18 FS::Misc::Geo - routines to fetch geographic information
  19
  20 =head1 FUNCTIONS
  21
  22 =over 4
  23
  24 =item censustract LOCATION YEAR
  25
  26 Given a location hash (see L<FS::location_Mixin>) and a census map year,
  27 returns a census tract code (consisting of state, county, and tract
  28 codes) or an error message.
  29
  30 =cut
  31
  32 sub get_censustract {
  33   my $location = shift;
  34   my $year  = shift;
  35
  36   warn Dumper($location, $year) if $DEBUG;
  37
  38   my $url='http://www.ffiec.gov/Geocode/default.aspx';
  39
  40   my $return = {};
  41   my $error = '';
  42
  43   my $ua = new LWP::UserAgent;
  44   my $res = $ua->request( GET( $url ) );
  45
  46   warn $res->as_string
  47     if $DEBUG > 1;
  48
  49   unless ($res->code  eq '200') {
  50
  51     $error = $res->message;
  52
  53   } else {
  54
  55     my $content = $res->content;
  56     my $p = new HTML::TokeParser \$content;
  57     my $viewstate;
  58     my $eventvalidation;
  59     while (my $token = $p->get_tag('input') ) {
  60       if ($token->[1]->{name} eq '__VIEWSTATE') {
  61         $viewstate = $token->[1]->{value};
  62       }
  63       if ($token->[1]->{name} eq '__EVENTVALIDATION') {
  64         $eventvalidation = $token->[1]->{value};
  65       }
  66       last if $viewstate && $eventvalidation;
  67     }
  68
  69     unless ($viewstate && $eventvalidation ) {
  70
  71       $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
  72
  73     } else {
  74
  75       my($zip5, $zip4) = split('-',$location->{zip});
  76
  77       $year ||= '2011';
  78       #ugh  workaround a mess at ffiec
  79       $year = " $year" if $year ne '2011';
  80       my @ffiec_args = (
  81         __VIEWSTATE => $viewstate,
  82         __EVENTVALIDATION => $eventvalidation,
  83         ddlbYear    => $year,
  84         ddlbYear    => '2011', #' 2009',
  85         txtAddress  => $location->{address1},
  86         txtCity     => $location->{city},
  87         ddlbState   => $location->{state},
  88         txtZipCode  => $zip5,
  89         btnSearch   => 'Search',
  90       );
  91       warn join("\n", @ffiec_args )
  92         if $DEBUG;
  93
  94       push @{ $ua->requests_redirectable }, 'POST';
  95       $res = $ua->request( POST( $url, \@ffiec_args ) );
  96       warn $res->as_string
  97         if $DEBUG > 1;
  98
  99       unless ($res->code  eq '200') {
 100
 101         $error = $res->message;
 102
 103       } else {
 104
 105         my @id = qw( MSACode StateCode CountyCode TractCode );
 106         $content = $res->content;
 107         warn $res->content if $DEBUG > 1;
 108         $p = new HTML::TokeParser \$content;
 109         my $prefix = 'UcGeoResult11_lb';
 110         my $compare =
 111           sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
 112
 113         while (my $token = $p->get_tag('span') ) {
 114           next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
 115           $token->[1]->{id} =~ /^$prefix(\w+)$/;
 116           $return->{lc($1)} = $p->get_trimmed_text("/span");
 117         }
 118
 119         $error = "No census tract found" unless $return->{tractcode};
 120         $return->{tractcode} .= ' '
 121           unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
 122
 123       } #unless ($res->code  eq '200')
 124
 125     } #unless ($viewstate)
 126
 127   } #unless ($res->code  eq '200')
 128
 129   return "FFIEC Geocoding error: $error" if $error;
 130
 131   $return->{'statecode'} .  $return->{'countycode'} .  $return->{'tractcode'};
 132 }
 133
 134 1;