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;
--- /dev/null
+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;
'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', '', '', '',
$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;
|| $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';
|| $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')
$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) = @_;
--- /dev/null
+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;
+
--- /dev/null
+#!/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
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 );
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 () {
% 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>
projects / freeside.git / commitdiff