track/update census codes by year, #15381

8 files changed, 303 insertions, 9 deletions

diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index fc45b99..d8e3948 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 0000000..3031b65
--- /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 5ab7a27..c2f40f6 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 5c78d8a..1cb2b0a 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 0000000..5aea27b
--- /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;
+
diff --git a/FS/bin/freeside-censustract-update b/FS/bin/freeside-censustract-update
new file mode 100644
index 0000000..8c6721b
--- /dev/null
+++ b/FS/bin/freeside-censustract-update
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+
+use strict;
+use Getopt::Std;
+use Date::Parse 'str2time';
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch dbh);
+use FS::Conf;
+use FS::cust_main;
+use FS::h_cust_main;
+
+my %opt;
+getopts('d:', \%opt);
+
+my $user = shift or die &usage;
+adminsuidsetup($user);
+$FS::UID::AutoCommit = 0;
+my $dbh = dbh;
+
+my $conf = FS::Conf->new;
+my $current_year = $conf->config('census_year') 
+  or die "No current census year configured.\n";
+my $date = str2time($opt{d}) if $opt{d};
+$date ||= time;
+my %h_cust_main = map { $_->custnum => $_ }
+  qsearch(
+    'h_cust_main',
+    { censusyear => { op => '!=', value => $current_year } },
+    FS::h_cust_main->sql_h_search($date),
+  ) ; #the state of these customers as of $date
+
+my @cust_main = qsearch( 'cust_main',
+  { censusyear => { op => '!=', value => $current_year } },
+); # all possibly interesting customers
+
+warn scalar(@cust_main)." records found.\n";
+my $queued = 0; my $updated = 0;
+foreach my $cust_main (@cust_main) {
+  my $error;
+  my $h = $h_cust_main{$cust_main->custnum};
+  if ( defined($h) and $h->censustract eq $cust_main->censustract ) {
+    # the tract code hasn't been changed since $date
+    # so update it now
+    my $job = FS::queue->new({
+        job => 'FS::cust_main::process_censustract_update'
+    });
+    $error = $job->insert($cust_main->custnum);
+    $queued++;
+  }
+  elsif ($cust_main->censusyear eq '') {
+    # the tract number is assumed current, so just set the year
+    $cust_main->set('censusyear', $current_year);
+    $error = $cust_main->replace;
+    $updated++;
+  }
+  if ( $error ) {
+    $dbh->rollback;
+    die "error updating ".$cust_main->custnum.": $error\n";
+  }
+}
+warn "Queued $queued census code lookups, updated year in $updated records.\n";
+$dbh->commit;
+
+sub usage {
+    "Usage:\n\n  freeside-censustract-update [ -d date ] user\n\n"
+  }
+
+=head1 NAME
+
+freeside-censustract-update - Update census tract codes to the current year.
+
+=head1 SYNOPSIS
+
+  freeside-censustract-update [ -d date ] user
+
+=head1 DESCRIPTION
+
+Finds all customers whose census tract codes don't appear to be current 
+and updates them to the current year.  The "current year" is defined by 
+the I<census_tract> configuration variable, not the calendar year.
+
+The -d option tells the script to assume that tract codes last modified
+after some date are already current.  Those customers will just have 
+their 'censusyear' field set to the current year.  For all other 
+customers with non-current censusyear values, the current tract code 
+will be looked up externally and stored in the censustract field.
+
+The actual tract code lookup runs from the job queue, because it's slow.
+A separate job will be created for each customer.
+
+=cut
diff --git a/httemplate/edit/cust_main/bottomfixup.js b/httemplate/edit/cust_main/bottomfixup.js
index a031f46..9d1f1e1 100644
--- a/httemplate/edit/cust_main/bottomfixup.js
+++ b/httemplate/edit/cust_main/bottomfixup.js
@@ -37,11 +37,11 @@ function post_geocode() {
   var cf = document.CustomerForm;
   var state_el = cf.elements['ship_state'];
   var census_data = new Array(
-    'year',   <% $conf->config('census_year') || '2011' %>,
-    'address', cf.elements['ship_address1'].value,
-    'city',    cf.elements['ship_city'].value,
-    'state',   state_el.options[ state_el.selectedIndex ].value,
-    'zip',     cf.elements['ship_zip'].value
+    'year',     <% $conf->config('census_year') || '2011' %>,
+    'address1', cf.elements['ship_address1'].value,
+    'city',     cf.elements['ship_city'].value,
+    'state',    state_el.options[ state_el.selectedIndex ].value,
+    'zip',      cf.elements['ship_zip'].value
   );
 
   censustract( census_data, update_censustract );
@@ -62,16 +62,17 @@ function update_censustract(arg) {
 
   var cf = document.CustomerForm;
 
-  var msacode    = argsHash['msacode'];
+/*  var msacode    = argsHash['msacode'];
   var statecode  = argsHash['statecode'];
   var countycode = argsHash['countycode'];
   var tractcode  = argsHash['tractcode'];
-  var error      = argsHash['error'];
   
   var newcensus = 
     new String(statecode)  +
     new String(countycode) +
-    new String(tractcode).replace(/\s$/, '');  // JSON 1 workaround
+    new String(tractcode).replace(/\s$/, '');  // JSON 1 workaround */
+  var error      = argsHash['error'];
+  var newcensus  = argsHash['censustract'];
 
   set_censustract = function () {
 
diff --git a/httemplate/view/cust_main/misc.html b/httemplate/view/cust_main/misc.html
index c59f6af..f664ae2 100644
--- a/httemplate/view/cust_main/misc.html
+++ b/httemplate/view/cust_main/misc.html
@@ -119,7 +119,9 @@
 % if ( $conf->exists('cust_main-require_censustract') ) {
 
   <TR>
-    <TD ALIGN="right"><% mt('Census tract') |h %></TD>
+    <TD ALIGN="right">
+      <% mt('Census tract ([_1])', $cust_main->censusyear) |h %>
+    </TD>
     <TD BGCOLOR="#ffffff"><% $cust_main->censustract  %></TD>
   </TR>