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       my @ffiec_args = (
  59         __VIEWSTATE => $viewstate,
  60         __EVENTVALIDATION => $eventvalidation,
  61         ddlbYear    => $arg{year},
  62         txtAddress  => $arg{address},
  63         txtCity     => $arg{city},
  64         ddlbState   => $arg{state},
  65         txtZipCode  => $zip5,
  66         btnSearch   => 'Search',
  67       );
  68       warn join("\n", @ffiec_args )
  69         if $DEBUG;
  70
  71       push @{ $ua->requests_redirectable }, 'POST';
  72       $res = $ua->request( POST( $url, \@ffiec_args ) );
  73       warn $res->as_string
  74         if $DEBUG > 1;
  75
  76       unless ($res->code  eq '200') {
  77
  78         $error = $res->message;
  79
  80       } else {
  81
  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';
  87         my $compare =
  88           sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
  89
  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");
  94         }
  95
  96         $error = "No census tract found" unless $return->{tractcode};
  97         $return->{tractcode} .= ' '
  98           unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround
  99
 100       } #unless ($res->code  eq '200')
 101
 102     } #unless ($viewstate)
 103
 104   } #unless ($res->code  eq '200')
 105
 106   $error = "FFIEC Geocoding error: $error" if $error;
 107   $return->{'error'} = $error;
 108
 109   $return;
 110
 111 }
 112
 113 </%init>