summaryrefslogtreecommitdiff
path: root/httemplate/misc/xmlhttp-cust_main-censustract.html
blob: 9d588d7125ff99544bc5ccd85a30b326f0f36a1b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
<% objToJson($return) %>
<%init>

my $DEBUG = 0;

my $url='http://www.ffiec.gov/Geocode/default.aspx';

my $sub = $cgi->param('sub');

my $return = {};
my $error = '';

use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common qw( GET POST );
use HTML::TokeParser;

if ( $sub eq 'censustract' ) {

  my %arg = $cgi->param('arg');
  warn join('', map "$_: $arg{$_}\n", keys %arg )
    if $DEBUG;

  my $ua = new LWP::UserAgent;
  my $res = $ua->request( GET( $url ) );

  warn $res->as_string
    if $DEBUG > 1;

  unless ($res->code  eq '200') {

    $error = $res->message;

  } else {

    my $content = $res->content;
    my $p = new HTML::TokeParser \$content;
    my $viewstate;
    while (my $token = $p->get_tag('input') ) {
      next unless $token->[1]->{name} eq '__VIEWSTATE';
      $viewstate = $token->[1]->{value};
      last;
    }

    unless ($viewstate) {

      $error = "no __VIEWSTATE found";

    } else {

      my($zip5, $zip4) = split('-',$arg{zip});

      my @ffiec_args = (
        __VIEWSTATE => $viewstate,
        ddlbYear    => $arg{year},
        txtAddress  => $arg{address},
        txtCity     => $arg{city},  
        ddlbState   => $arg{state},
        txtZipCode  => $zip5,
        btnSearch   => 'Search',
      );
      warn join("\n", @ffiec_args )
        if $DEBUG;

      $res = $ua->request( POST( $url, \@ffiec_args ) );
      warn $res->as_string
        if $DEBUG > 1;

      unless ($res->code  eq '200') {

        $error = $res->message;

      } else {

        my @id = qw( MSACode StateCode CountyCode TractCode );
        $content = $res->content;
        $p = new HTML::TokeParser \$content;
        my $prefix = 'UcGeoResult11_lb';
        my $compare =
          sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };

        while (my $token = $p->get_tag('span') ) {
          next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
          $token->[1]->{id} =~ /^$prefix(\w+)$/;
          $return->{lc($1)} = $p->get_trimmed_text("/span");
        }

        $error = "No census tract found" unless $return->{tractcode};
        $return->{tractcode} .= ' '
          unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround

      } #unless ($res->code  eq '200')

    } #unless ($viewstate)

  } #unless ($res->code  eq '200')

  $error = "FFIEC Geocoding error: $error" if $error;
  $return->{'error'} = $error;

  $return;

}

</%init>