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     while (my $token = $p->get_tag('input') ) {
  40       next unless $token->[1]->{name} eq '__VIEWSTATE';
  41       $viewstate = $token->[1]->{value};
  42       last;
  43     }
  44
  45     unless ($viewstate) {
  46
  47       $error = "no __VIEWSTATE found";
  48
  49     } else {
  50
  51       my($zip5, $zip4) = split('-',$arg{zip});
  52
  53       my @ffiec_args = (
  54         __VIEWSTATE => $viewstate,
  55         ddlbYear    => $arg{year},
  56         txtAddress  => $arg{address},
  57         txtCity     => $arg{city},
  58         ddlbState   => $arg{state},
  59         txtZipCode  => $zip5,
  60         btnSearch   => 'Search',
  61       );
  62       warn join("\n", @ffiec_args )
  63         if $DEBUG;
  64
  65       $res = $ua->request( POST( $url, \@ffiec_args ) );
  66       warn $res->as_string
  67         if $DEBUG > 1;
  68
  69       unless ($res->code  eq '200') {
  70
  71         $error = $res->message;
  72
  73       } else {
  74
  75         my @id = qw( MSACode StateCode CountyCode TractCode );
  76         $content = $res->content;
  77         $p = new HTML::TokeParser \$content;
  78         my $prefix = 'UcGeoResult11_lb';
  79         my $compare =
  80           sub { my $t=shift; scalar( grep { lc($t) eq lc("$prefix$_")} @id ) };
  81
  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");
  86         }
  87
  88         $error = "No census tract found" unless $return->{tractcode};
  89
  90       } #unless ($res->code  eq '200')
  91
  92     } #unless ($viewstate)
  93
  94   } #unless ($res->code  eq '200')
  95
  96   $error = "FFIEC Geocoding error: $error" if $error;
  97   $return->{'error'} = $error;
  98
  99   $return;
 100
 101 }
 102
 103 </%init>