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       $arg{year} ||= '2011';
  59       #ugh  workaround a mess at ffiec
  60       $arg{year} = " $arg{year}" if $arg{year} ne '2011';
  61       my @ffiec_args = (
  62         __VIEWSTATE => $viewstate,
  63         __EVENTVALIDATION => $eventvalidation,
  64         ddlbYear    => $arg{year},
  65         ddlbYear    => '2011', #' 2009',
  66         txtAddress  => $arg{address},
  67         txtCity     => $arg{city},
  68         ddlbState   => $arg{state},
  69         txtZipCode  => $zip5,
  70         btnSearch   => 'Search',
  71       );
  72       warn join("\n", @ffiec_args )
  73         if $DEBUG;
  74
  75       push @{ $ua->requests_redirectable }, 'POST';
  76       $res = $ua->request( POST( $url, \@ffiec_args ) );
  77       warn $res->as_string
  78         if $DEBUG > 1;
  79
  80       unless ($res->code  eq '200') {
  81
  82         $error = $res->message;
  83
  84       } else {
  85
  86         my @id = qw( MSACode StateCode CountyCode TractCode );
  87         $content = $res->content;
  88         warn $res->content if $DEBUG > 1;
  89         $p = new HTML::TokeParser \$content;
  90         my $prefix = 'UcGeoResult11_lb';
  91         my $compare =
  92           sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
  93
  94         while (my $token = $p->get_tag('span') ) {
  95           next unless ( $token->[1]->{id} && &$compare( $token->[1]->{id} ) );
  96           $token->[1]->{id} =~ /^$prefix(\w+)$/;
  97           $return->{lc($1)} = $p->get_trimmed_text("/span");
  98         }
  99
 100         $error = "No census tract found" unless $return->{tractcode};
 101         $return->{tractcode} .= ' '
 102           unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
 103
 104       } #unless ($res->code  eq '200')
 105
 106     } #unless ($viewstate)
 107
 108   } #unless ($res->code  eq '200')
 109
 110   $error = "FFIEC Geocoding error: $error" if $error;
 111   $return->{'error'} = $error;
 112
 113   $return;
 114
 115 }
 116
 117 </%init>