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;
39 while (my $token = $p->get_tag('input') ) {
40 next unless $token->[1]->{name} eq '__VIEWSTATE';
41 $viewstate = $token->[1]->{value};
47 $error = "no __VIEWSTATE found";
51 my($zip5, $zip4) = split('-',$arg{zip});
54 __VIEWSTATE => $viewstate,
55 ddlbYear => $arg{year},
56 txtAddress => $arg{address},
57 txtCity => $arg{city},
58 ddlbState => $arg{state},
60 btnSearch => 'Search',
62 warn join("\n", @ffiec_args )
65 $res = $ua->request( POST( $url, \@ffiec_args ) );
69 unless ($res->code eq '200') {
71 $error = $res->message;
75 my @id = qw( MSACode StateCode CountyCode TractCode );
76 $content = $res->content;
77 $p = new HTML::TokeParser \$content;
78 my $prefix = 'UcGeoResult11_lb';
80 sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
82 while (my $token = $p->get_tag('span') ) {
83 next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
84 $token->[1]->{id} =~ /^$prefix(\w+)$/;
85 $return->{lc($1)} = $p->get_trimmed_text("/span");
88 $error = "No census tract found" unless $return->{tractcode};
89 $return->{tractcode} .= ' '
90 unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
92 } #unless ($res->code eq '200')
94 } #unless ($viewstate)
96 } #unless ($res->code eq '200')
98 $error = "FFIEC Geocoding error: $error" if $error;
99 $return->{'error'} = $error;