4 use base qw( Exporter );
5 use vars qw( $DEBUG @EXPORT_OK );
8 use HTTP::Request::Common qw( GET POST );
14 @EXPORT_OK = qw( get_censustract );
18 FS::Misc::Geo - routines to fetch geographic information
24 =item censustract LOCATION YEAR
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.
36 warn Dumper($location, $year) if $DEBUG;
38 my $url='http://www.ffiec.gov/Geocode/default.aspx';
43 my $ua = new LWP::UserAgent;
44 my $res = $ua->request( GET( $url ) );
49 unless ($res->code eq '200') {
51 $error = $res->message;
55 my $content = $res->content;
56 my $p = new HTML::TokeParser \$content;
59 while (my $token = $p->get_tag('input') ) {
60 if ($token->[1]->{name} eq '__VIEWSTATE') {
61 $viewstate = $token->[1]->{value};
63 if ($token->[1]->{name} eq '__EVENTVALIDATION') {
64 $eventvalidation = $token->[1]->{value};
66 last if $viewstate && $eventvalidation;
69 unless ($viewstate && $eventvalidation ) {
71 $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
75 my($zip5, $zip4) = split('-',$location->{zip});
78 #ugh workaround a mess at ffiec
79 $year = " $year" if $year ne '2011';
81 __VIEWSTATE => $viewstate,
82 __EVENTVALIDATION => $eventvalidation,
84 ddlbYear => '2011', #' 2009',
85 txtAddress => $location->{address1},
86 txtCity => $location->{city},
87 ddlbState => $location->{state},
89 btnSearch => 'Search',
91 warn join("\n", @ffiec_args )
94 push @{ $ua->requests_redirectable }, 'POST';
95 $res = $ua->request( POST( $url, \@ffiec_args ) );
99 unless ($res->code eq '200') {
101 $error = $res->message;
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';
111 sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
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");
119 $error = "No census tract found" unless $return->{tractcode};
120 $return->{tractcode} .= ' '
121 unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
123 } #unless ($res->code eq '200')
125 } #unless ($viewstate)
127 } #unless ($res->code eq '200')
129 return "FFIEC Geocoding error: $error" if $error;
131 $return->{'statecode'} . $return->{'countycode'} . $return->{'tractcode'};