1 <% objToJson($return) %>
6 my $url='http://www.ffiec.gov/Geocode/default.aspx';
8 my $sub = $cgi->param('sub');
15 use HTTP::Request::Common qw( GET POST );
18 if ( $sub eq 'censustract' ) {
20 my %arg = $cgi->param('arg');
21 warn join('', map "$_: $arg{$_}\n", keys %arg )
24 my $ua = new LWP::UserAgent;
25 my $res = $ua->request( GET( $url ) );
30 unless ($res->code eq '200') {
32 $error = $res->message;
36 my $content = $res->content;
37 my $p = new HTML::TokeParser \$content;
40 while (my $token = $p->get_tag('input') ) {
41 if ($token->[1]->{name} eq '__VIEWSTATE') {
42 $viewstate = $token->[1]->{value};
44 if ($token->[1]->{name} eq '__EVENTVALIDATION') {
45 $eventvalidation = $token->[1]->{value};
47 last if $viewstate && $eventvalidation;
50 unless ($viewstate && $eventvalidation) {
52 $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
56 my($zip5, $zip4) = split('-',$arg{zip});
59 __VIEWSTATE => $viewstate,
60 __EVENTVALIDATION => $eventvalidation,
61 ddlbYear => $arg{year},
62 txtAddress => $arg{address},
63 txtCity => $arg{city},
64 ddlbState => $arg{state},
66 btnSearch => 'Search',
68 warn join("\n", @ffiec_args )
71 push @{ $ua->requests_redirectable }, 'POST';
72 $res = $ua->request( POST( $url, \@ffiec_args ) );
76 unless ($res->code eq '200') {
78 $error = $res->message;
82 my @id = qw( MSACode StateCode CountyCode TractCode );
83 $content = $res->content;
84 warn $res->content if $DEBUG > 1;
85 $p = new HTML::TokeParser \$content;
86 my $prefix = 'UcGeoResult11_lb';
88 sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
90 while (my $token = $p->get_tag('span') ) {
91 next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
92 $token->[1]->{id} =~ /^$prefix(\w+)$/;
93 $return->{lc($1)} = $p->get_trimmed_text("/span");
96 $error = "No census tract found" unless $return->{tractcode};
97 $return->{tractcode} .= ' '
98 unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
100 } #unless ($res->code eq '200')
102 } #unless ($viewstate)
104 } #unless ($res->code eq '200')
106 $error = "FFIEC Geocoding error: $error" if $error;
107 $return->{'error'} = $error;