track/update census codes by year, #15381

5 files changed, 200 insertions, 0 deletions

diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index fc45b9958..d8e394887 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -64,6 +64,7 @@ if ( -e $addl_handler_use_file ) {
   use DateTime;
   use DateTime::Format::Strptime;
   use FS::Misc::DateTime qw( parse_datetime );
+  use FS::Misc::Geo qw( get_censustract );
   use Lingua::EN::Inflect qw(PL);
   Lingua::EN::Inflect::classical names=>0; #Categorys
   use Tie::IxHash;
diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm
new file mode 100644
index 000000000..3031b65d4
--- /dev/null
+++ b/FS/FS/Misc/Geo.pm
@@ -0,0 +1,134 @@
+package FS::Misc::Geo;
+
+use strict;
+use base qw( Exporter );
+use vars qw( $DEBUG @EXPORT_OK );
+use LWP::UserAgent;
+use HTTP::Request;
+use HTTP::Request::Common qw( GET POST );
+use HTML::TokeParser;
+use Data::Dumper;
+
+$DEBUG = 1;
+
+@EXPORT_OK = qw( get_censustract );
+
+=head1 NAME
+
+FS::Misc::Geo - routines to fetch geographic information
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item censustract LOCATION YEAR
+
+Given a location hash (see L<FS::location_Mixin>) and a census map year,
+returns a census tract code (consisting of state, county, and tract 
+codes) or an error message.
+
+=cut
+
+sub get_censustract {
+  my $location = shift;
+  my $year  = shift;
+
+  warn Dumper($location, $year) if $DEBUG;
+
+  my $url='http://www.ffiec.gov/Geocode/default.aspx';
+
+  my $return = {};
+  my $error = '';
+
+  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;
+    my $eventvalidation;
+    while (my $token = $p->get_tag('input') ) {
+      if ($token->[1]->{name} eq '__VIEWSTATE') {
+        $viewstate = $token->[1]->{value};
+      }
+      if ($token->[1]->{name} eq '__EVENTVALIDATION') {
+        $eventvalidation = $token->[1]->{value};
+      }
+      last if $viewstate && $eventvalidation;
+    }
+
+    unless ($viewstate && $eventvalidation ) {
+
+      $error = "either no __VIEWSTATE or __EVENTVALIDATION found";
+
+    } else {
+
+      my($zip5, $zip4) = split('-',$location->{zip});
+
+      $year ||= '2011';
+      #ugh  workaround a mess at ffiec
+      $year = " $year" if $year ne '2011';
+      my @ffiec_args = (
+        __VIEWSTATE => $viewstate,
+        __EVENTVALIDATION => $eventvalidation,
+        ddlbYear    => $year,
+        ddlbYear    => '2011', #' 2009',
+        txtAddress  => $location->{address1},
+        txtCity     => $location->{city},  
+        ddlbState   => $location->{state},
+        txtZipCode  => $zip5,
+        btnSearch   => 'Search',
+      );
+      warn join("\n", @ffiec_args )
+        if $DEBUG;
+
+      push @{ $ua->requests_redirectable }, 'POST';
+      $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;
+        warn $res->content if $DEBUG > 1;
+        $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')
+
+  return "FFIEC Geocoding error: $error" if $error;
+
+  $return->{'statecode'} .  $return->{'countycode'} .  $return->{'tractcode'};
+}
+
+1;
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 5ab7a27f4..c2f40f64e 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -895,6 +895,7 @@ sub tables_hashref {
         'payip',    'varchar', 'NULL', 15, '', '', 
         'geocode',  'varchar', 'NULL', 20,  '', '',
         'censustract', 'varchar', 'NULL', 20,  '', '', # 7 to save space?
+        'censusyear', 'char', 'NULL', 4, '', '',
         'tax',      'char', 'NULL', 1, '', '', 
         'otaker',   'varchar', 'NULL',    32, '', '', 
         'usernum',   'int', 'NULL', '', '', '',
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 5c78d8a1f..1cb2b0ac1 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -465,6 +465,8 @@ sub insert {
 
   $self->signupdate(time) unless $self->signupdate;
 
+  $self->censusyear($conf->config('census_year')) if $self->censustract;
+
   $self->auto_agent_custid()
     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 
@@ -1514,6 +1516,12 @@ sub replace {
          || $old->payby  =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
 
+  if ( $self->censustract ne '' and $self->censustract ne $old->censustract ) {
+    # update censusyear whenever tract code changes
+    $self->censusyear($conf->config('census_year'));
+  }
+
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -1722,6 +1730,7 @@ sub check {
     || $self->ut_coordn('latitude')
     || $self->ut_coordn('longitude')
     || $self->ut_enum('coord_auto', [ '', 'Y' ])
+    || $self->ut_numbern('censusyear')
     || $self->ut_anything('comments')
     || $self->ut_numbern('referral_custnum')
     || $self->ut_textn('stateid')
@@ -4969,6 +4978,36 @@ sub process_bill_and_collect {
   $cust_main->bill_and_collect( %$param );
 }
 
+=item process_censustract_update CUSTNUM
+
+Queueable function to update the census tract to the current year (as set in 
+the 'census_year' configuration variable) and retrieve the new tract code.
+
+=cut
+
+sub process_censustract_update { 
+  eval "use FS::Misc::Geo qw(get_censustract)";
+  die $@ if $@;
+  my $custnum = shift;
+  my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
+      or die "custnum '$custnum' not found!\n";
+
+  my $new_year = $conf->config('census_year') or return;
+  my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
+  if ( $new_tract =~ /^\d/ ) {
+    # then it's a tract code
+        $cust_main->set('censustract', $new_tract);
+    $cust_main->set('censusyear',  $new_year);
+    my $error = $cust_main->replace;
+    die $error if $error;
+  }
+  else {
+    # it's an error message
+    die $new_tract;
+  }
+  return;
+}
+
 sub _upgrade_data { #class method
   my ($class, %opts) = @_;
 
diff --git a/FS/FS/h_cust_main.pm b/FS/FS/h_cust_main.pm
new file mode 100644
index 000000000..5aea27bbd
--- /dev/null
+++ b/FS/FS/h_cust_main.pm
@@ -0,0 +1,25 @@
+package FS::h_cust_main;
+
+use strict;
+use base qw( FS::h_Common FS::cust_main );
+
+sub table { 'h_cust_main' };
+
+=head1 NAME
+
+FS::h_cust_main - Historical customer information records.
+
+=head1 DESCRIPTION
+
+An FS::h_cust_main object represents historical changes to a 
+customer record (L<FS::cust_main>).
+
+=head1 SEE ALSO
+
+L<FS::cust_main>,  L<FS::h_Common>, L<FS::Record>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+