httemplate/misc/xmlhttp-cust_main-censustract.html

   1 <% objToJson($return) %>
   2 <%init>
   3
   4 my $DEBUG = 0;
   5
   6 my $url='http://www.ffiec.gov/Geocode/default.aspx';
   7
   8 my $sub = $cgi->param('sub');
   9
  10 my $return = {};
  11 my $error = '';
  12
  13 use LWP::UserAgent;
  14 use HTTP::Request;
  15 use HTTP::Request::Common qw( GET POST );
  16 use HTML::TokeParser;
  17
  18 if ( $sub eq 'censustract' ) {
  19
  20   my %arg = $cgi->param('arg');
  21   warn join('', map "$_: $arg{$_}\n", keys %arg )
  22     if $DEBUG;
  23
  24   my $ua = new LWP::UserAgent;
  25   my $res = $ua->request( GET( $url ) );
  26
  27   warn $res->as_string
  28     if $DEBUG > 1;
  29
  30   unless ($res->code  eq '200') {
  31
  32     $error = $res->message;
  33
  34   } else {
  35
  36     my $content = $res->content;
  37     my $p = new HTML::TokeParser \$content;
  38     my $viewstate;
  39     my $eventvalidation;
  40     while (my $token = $p->get_tag('input') ) {
  41       if ($token->[1]->{name} eq '__VIEWSTATE') {
  42         $viewstate = $token->[1]->{value};
  43       }
  44       if ($token->[1]->{name} eq '__EVENTVALIDATION') {
  45         $eventvalidation = $token->[1]->{value};
  46       }
  47       last if $viewstate && $eventvalidation;
  48     }
  49
  50     unless ($viewstate && $eventvalidation ) {
  51
  52       $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
  53
  54     } else {
  55
  56       my($zip5, $zip4) = split('-',$arg{zip});
  57
  58       #ugh  workaround a mess at ffiec
  59       $arg{year} = " $arg{year}" unless $arg{year} = "2010";
  60       my @ffiec_args = (
  61         __VIEWSTATE => $viewstate,
  62         __EVENTVALIDATION => $eventvalidation,
  63         ddlbYear    => $arg{year},
  64         ddlbYear    => ' 2009',
  65         txtAddress  => $arg{address},
  66         txtCity     => $arg{city},
  67         ddlbState   => $arg{state},
  68         txtZipCode  => $zip5,
  69         btnSearch   => 'Search',
  70       );
  71       warn join("\n", @ffiec_args )
  72         if $DEBUG;
  73
  74       push @{ $ua->requests_redirectable }, 'POST';
  75       $res = $ua->request( POST( $url, \@ffiec_args ) );
  76       warn $res->as_string
  77         if $DEBUG > 1;
  78
  79       unless ($res->code  eq '200') {
  80
  81         $error = $res->message;
  82
  83       } else {
  84
  85         my @id = qw( MSACode StateCode CountyCode TractCode );
  86         $content = $res->content;
  87         warn $res->content if $DEBUG > 1;
  88         $p = new HTML::TokeParser \$content;
  89         my $prefix = 'UcGeoResult11_lb';
  90         my $compare =
  91           sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
  92
  93         while (my $token = $p->get_tag('span') ) {
  94           next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
  95           $token->[1]->{id} =~ /^$prefix(\w+)$/;
  96           $return->{lc($1)} = $p->get_trimmed_text("/span");
  97         }
  98
  99         $error = "No census tract found" unless $return->{tractcode};
 100         $return->{tractcode} .= ' '
 101           unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
 102
 103       } #unless ($res->code  eq '200')
 104
 105     } #unless ($viewstate)
 106
 107   } #unless ($res->code  eq '200')
 108
 109   $error = "FFIEC Geocoding error: $error" if $error;
 110   $return->{'error'} = $error;
 111
 112   $return;
 113
 114 }
 115
 116 </%init>