diff options
Diffstat (limited to 'FS')
-rw-r--r-- | FS/FS/Conf.pm | 25 | ||||
-rw-r--r-- | FS/FS/GeocodeCache.pm | 209 | ||||
-rw-r--r-- | FS/FS/Mason.pm | 3 | ||||
-rw-r--r-- | FS/FS/Misc/Geo.pm | 154 | ||||
-rw-r--r-- | FS/FS/Schema.pm | 3 | ||||
-rw-r--r-- | FS/FS/cust_location.pm | 4 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 16 | ||||
-rw-r--r-- | FS/MANIFEST | 2 | ||||
-rw-r--r-- | FS/t/GeocodeCache.t | 5 |
9 files changed, 389 insertions, 32 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index e74c19faa..02869b16d 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -4065,6 +4065,17 @@ and customer address. Include units.', }, { + 'key' => 'address_standardize_method', + 'section' => 'UI', #??? + 'description' => 'Method for standardizing customer addresses.', + 'type' => 'select', + 'select_hash' => [ '' => '', + 'usps' => 'U.S. Postal Service', + 'ezlocate' => 'EZLocate', + ], + }, + + { 'key' => 'usps_webtools-userid', 'section' => 'UI', 'description' => 'Production UserID for USPS web tools. Enables USPS address standardization. See the <a href="http://www.usps.com/webtools/">USPS website</a>, register and agree not to use the tools for batch purposes.', @@ -4079,6 +4090,20 @@ and customer address. Include units.', }, { + 'key' => 'ezlocate-userid', + 'section' => 'UI', + 'description' => 'User ID for EZ-Locate service. See <a href="http://www.geocode.com/">the TomTom website</a> for access and pricing information.', + 'type' => 'text', + }, + + { + 'key' => 'ezlocate-password', + 'section' => 'UI', + 'description' => 'Password for EZ-Locate service.', + 'type' => 'text' + }, + + { 'key' => 'cust_main-auto_standardize_address', 'section' => 'UI', 'description' => 'When using USPS web tools, automatically standardize the address without asking.', diff --git a/FS/FS/GeocodeCache.pm b/FS/FS/GeocodeCache.pm new file mode 100644 index 000000000..7829c4df2 --- /dev/null +++ b/FS/FS/GeocodeCache.pm @@ -0,0 +1,209 @@ +package FS::GeocodeCache; + +use strict; +use vars qw($conf $DEBUG); +use base qw( FS::geocode_Mixin ); +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::Misc::Geo; + +use Data::Dumper; + +FS::UID->install_callback( sub { $conf = new FS::Conf; } ); + +$DEBUG = 0; + +=head1 NAME + +FS::GeocodeCache - An address undergoing the geocode process. + +=head1 SYNOPSIS + + use FS::GeocodeCache; + + $record = FS::GeocodeCache->standardize(%location_hash); + +=head1 DESCRIPTION + +An FS::GeocodeCache object represents a street address in the process of +being geocoded. FS::GeocodeCache inherits from FS::geocode_Mixin. + +Most methods on this object throw an exception on error. + +FS::GeocodeCache has the following fields, with the same meaning as in +L<FS::cust_location>: + +=over 4 + +=item address1 + +=item address2 + +=item city + +=item county + +=item state + +=item zip + +=item latitude + +=item longitude + +=item addr_clean + +=item country + +=item censustract + +=item geocode + +=item district + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new cache object. For internal use. See C<standardize>. + +=cut + +# minimalist constructor +sub new { + my $class = shift; + my $self = { + company => '', + address1 => '', + address2 => '', + city => '', + state => '', + zip => '', + country => '', + latitude => '', + longitude => '', + addr_clean => '', + censustract => '', + @_ + }; + bless $self, $class; +} + +# minimalist accessor, for compatibility with geocode_Mixin +sub get { + $_[0]->{$_[1]} +} + +sub set { + $_[0]->{$_[1]} = $_[2]; +} + +sub location_hash { %{$_[0]} }; + +=item set_censustract + +Look up the censustract, if it's not already filled in, and return it. +On error, sets 'error' and returns nothing. + +This uses the "get_censustract_*" methods in L<FS::Misc::Geo>; currently +the only one is 'ffiec'. + +=cut + +sub set_censustract { + my $self = shift; + + if ( $self->get('censustract') =~ /^\d{9}\.\d{2}$/ ) { + return $self->get('censustract'); + } + my $censusyear = $conf->config('census_year'); + return if !$censusyear; + + my $method = 'ffiec'; + # configurable censustract-only lookup goes here if it's ever needed. + $method = "get_censustract_$method"; + my $censustract = eval { FS::Misc::Geo->$method($self, $censusyear) }; + $self->set("censustract_error", $@); + $self->set("censustract", $censustract); +} + +=item set_coord + +Set the latitude and longitude fields if they're not already set. Returns +those values, in order. + +=cut + +sub set_coord { # the one in geocode_Mixin will suffice + my $self = shift; + if ( !$self->get('latitude') || !$self->get('longitude') ) { + $self->SUPER::set_coord; + $self->set('coord_error', $@); + } + return $self->get('latitude'), $self->get('longitude'); +} + +=head1 CLASS METHODS + +=over 4 + +=item standardize LOCATION + +Given a location hash or L<FS::geocode_Mixin> object, standardize the +address using the configured method and return an L<FS::GeocodeCache> +object. + +The methods are the "standardize_*" functions in L<FS::Geo::Misc>. + +=cut + +sub standardize { + my $class = shift; + my $location = shift; + $location = { $location->location_hash } + if UNIVERSAL::can($location, 'location_hash'); + + local $Data::Dumper::Terse = 1; + warn "standardizing location:\n".Dumper($location) if $DEBUG; + + my $method = $conf->config('address_standardize_method'); + + if ( $method ) { + $method = "standardize_$method"; + my $new_location = eval { FS::Misc::Geo->$method( $location ) }; + if ( $new_location ) { + $location = { + addr_clean => 'Y', + %$new_location + # standardize_* can return an address with addr_clean => '' if + # the address is somehow questionable + } + } + else { + # XXX need an option to decide what to do on error + $location->{'addr_clean'} = ''; + $location->{'error'} = $@; + } + warn "result:\n".Dumper($location) if $DEBUG; + } + # else $location = $location + my $cache = $class->new(%$location); + return $cache; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index f7d98a156..944a4836c 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -64,7 +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 get_district ); + use FS::Misc::Geo qw( get_district ); use Lingua::EN::Inflect qw(PL); Lingua::EN::Inflect::classical names=>0; #Categorys use Tie::IxHash; @@ -326,6 +326,7 @@ if ( -e $addl_handler_use_file ) { use FS::cust_bill_pkg_discount_void; use FS::agent_pkg_class; use FS::svc_export_machine; + use FS::GeocodeCache; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index 5d6f33cb7..6bc71fc84 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -2,7 +2,7 @@ package FS::Misc::Geo; use strict; use base qw( Exporter ); -use vars qw( $DEBUG @EXPORT_OK ); +use vars qw( $DEBUG @EXPORT_OK $conf ); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); @@ -10,15 +10,19 @@ use HTML::TokeParser; use URI::Escape 3.31; use Data::Dumper; +FS::UID->install_callback( sub { + $conf = new FS::Conf; +} ); + $DEBUG = 0; -@EXPORT_OK = qw( get_censustract get_district ); +@EXPORT_OK = qw( get_district ); =head1 NAME FS::Misc::Geo - routines to fetch geographic information -=head1 FUNCTIONS +=head1 CLASS METHODS =over 4 @@ -30,7 +34,8 @@ codes) or an error message. =cut -sub get_censustract { +sub get_censustract_ffiec { + my $class = shift; my $location = shift; my $year = shift; @@ -45,7 +50,7 @@ sub get_censustract { my $res = $ua->request( GET( $url ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; unless ($res->code eq '200') { @@ -87,12 +92,12 @@ sub get_censustract { btnSearch => 'Search', ); warn join("\n", @ffiec_args ) - if $DEBUG; + if $DEBUG > 1; push @{ $ua->requests_redirectable }, 'POST'; $res = $ua->request( POST( $url, \@ffiec_args ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; unless ($res->code eq '200') { @@ -102,7 +107,7 @@ sub get_censustract { my @id = qw( MSACode StateCode CountyCode TractCode ); $content = $res->content; - warn $res->content if $DEBUG > 1; + warn $res->content if $DEBUG > 2; $p = new HTML::TokeParser \$content; my $prefix = 'UcGeoResult11_lb'; my $compare = @@ -127,7 +132,7 @@ sub get_censustract { } #unless ($res->code eq '200') - return "FFIEC Geocoding error: $error" if $error; + die "FFIEC Geocoding error: $error\n" if $error; $return->{'statecode'} . $return->{'countycode'} . $return->{'tractcode'}; } @@ -201,12 +206,12 @@ sub wa_sales { my $query_string = join($delim, @args ); $url .= "?$query_string"; - warn "\nrequest: $url\n\n" if $DEBUG; + warn "\nrequest: $url\n\n" if $DEBUG > 1; my $res = $ua->request( GET( "$url?$query_string" ) ); warn $res->as_string - if $DEBUG > 1; + if $DEBUG > 2; if ($res->code ne '200') { $error = $res->message; @@ -253,7 +258,7 @@ sub wa_sales { # just to make sure if ( $return->{'district'} =~ /^\d+$/ and $return->{'tax'} =~ /^.\d+$/ ) { $return->{'tax'} *= 100; #percentage - warn Dumper($return) if $DEBUG; + warn Dumper($return) if $DEBUG > 1; return $return; } else { @@ -267,6 +272,131 @@ sub wa_sales { die "WA tax district lookup error: $error"; } +sub standardize_usps { + my $class = shift; + + eval "use Business::US::USPS::WebTools::AddressStandardization"; + die $@ if $@; + + my $location = shift; + if ( $location->{country} ne 'US' ) { + # soft failure + warn "standardize_usps not for use in country ".$location->{country}."\n"; + $location->{addr_clean} = ''; + return $location; + } + my $userid = $conf->config('usps_webtools-userid'); + my $password = $conf->config('usps_webtools-password'); + my $verifier = Business::US::USPS::WebTools::AddressStandardization->new( { + UserID => $userid, + Password => $password, + Testing => 0, + } ) or die "error starting USPS WebTools\n"; + + my($zip5, $zip4) = split('-',$location->{'zip'}); + + my %usps_args = ( + FirmName => $location->{company}, + Address2 => $location->{address1}, + Address1 => $location->{address2}, + City => $location->{city}, + State => $location->{state}, + Zip5 => $zip5, + Zip4 => $zip4, + ); + warn join('', map "$_: $usps_args{$_}\n", keys %usps_args ) + if $DEBUG > 1; + + my $hash = $verifier->verify_address( %usps_args ); + + warn $verifier->response + if $DEBUG > 1; + + die "USPS WebTools error: ".$verifier->{error}{description} ."\n" + if $verifier->is_error; + + my $zip = $hash->{Zip5}; + $zip .= '-' . $hash->{Zip4} if $hash->{Zip4} =~ /\d/; + + { company => $hash->{FirmName}, + address1 => $hash->{Address2}, + address2 => $hash->{Address1}, + city => $hash->{City}, + state => $hash->{State}, + zip => $zip, + country => 'US', + addr_clean=> 'Y' } +} + +my %ezlocate_error = ( # USA_Geo_002 documentation + 10 => 'State not found', + 11 => 'City not found', + 12 => 'Invalid street address', + 14 => 'Street name not found', + 15 => 'Address range does not exist', + 16 => 'Ambiguous address', + 17 => 'Intersection not found', #unused? +); + +sub standardize_ezlocate { + my $self = shift; + my $location = shift; + my $class; + #if ( $location->{country} eq 'US' ) { + # $class = 'USA_Geo_004Tool'; + #} + #elsif ( $location->{country} eq 'CA' ) { + # $class = 'CAN_Geo_001Tool'; + #} + #else { # shouldn't be a fatal error, just pass through unverified address + # warn "standardize_teleatlas: address lookup in '".$location->{country}. + # "' not available\n"; + # return $location; + #} + #my $path = $conf->config('teleatlas-path') || ''; + #local @INC = (@INC, $path); + #eval "use $class;"; + #if ( $@ ) { + # die "Loading $class failed:\n$@". + # "\nMake sure the TeleAtlas Perl SDK is installed correctly.\n"; + #} + + $class = 'Geo::EZLocate'; # use our own library + eval "use $class"; + die $@ if $@; + + my $userid = $conf->config('ezlocate-userid') + or die "no ezlocate-userid configured\n"; + my $password = $conf->config('ezlocate-password') + or die "no ezlocate-password configured\n"; + + my $tool = $class->new($userid, $password); + my $match = $tool->findAddress( + $location->{address1}, + $location->{city}, + $location->{state}, + $location->{zip}, #12345-6789 format is allowed + ); + warn "ezlocate returned match:\n".Dumper($match) if $DEBUG > 1; + # error handling - B codes indicate success + die $ezlocate_error{$match->{MAT_STAT}}."\n" + unless $match->{MAT_STAT} =~ /^B\d$/; + + { + address1 => $match->{STD_ADDR}, + address2 => $location->{address2}, + city => $match->{STD_CITY}, + state => $match->{STD_ST}, + country => $location->{country}, + zip => $match->{STD_ZIP}.'-'.$match->{STD_P4}, + latitude => $match->{MAT_LAT}, + longitude => $match->{MAT_LON}, + censustract => $match->{FIPS_ST}.$match->{FIPS_CTY}. + sprintf('%04.2f',$match->{CEN_TRCT}), + addr_clean => 'Y', + }; +} + =back =cut diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 912f3e269..9eb59a09a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1010,6 +1010,7 @@ sub tables_hashref { 'latitude', 'decimal', 'NULL', '10,7', '', '', 'longitude','decimal', 'NULL', '10,7', '', '', 'coord_auto', 'char', 'NULL', 1, '', '', + 'addr_clean', 'char', 'NULL', 1, '', '', 'daytime', 'varchar', 'NULL', 20, '', '', 'night', 'varchar', 'NULL', 20, '', '', 'fax', 'varchar', 'NULL', 12, '', '', @@ -1028,6 +1029,7 @@ sub tables_hashref { 'ship_latitude', 'decimal', 'NULL', '10,7', '', '', 'ship_longitude','decimal', 'NULL', '10,7', '', '', 'ship_coord_auto', 'char', 'NULL', 1, '', '', + 'ship_addr_clean', 'char', 'NULL', 1, '', '', 'ship_daytime', 'varchar', 'NULL', 20, '', '', 'ship_night', 'varchar', 'NULL', 20, '', '', 'ship_fax', 'varchar', 'NULL', 12, '', '', @@ -1252,6 +1254,7 @@ sub tables_hashref { 'latitude', 'decimal', 'NULL', '10,7', '', '', 'longitude', 'decimal', 'NULL', '10,7', '', '', 'coord_auto', 'char', 'NULL', 1, '', '', + 'addr_clean', 'char', 'NULL', 1, '', '', 'country', 'char', '', 2, '', '', 'geocode', 'varchar', 'NULL', 20, '', '', 'district', 'varchar', 'NULL', 20, '', '', diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index 2810dc957..1521960d4 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -188,6 +188,7 @@ sub check { || $self->ut_coordn('latitude') || $self->ut_coordn('longitude') || $self->ut_enum('coord_auto', [ '', 'Y' ]) + || $self->ut_enum('addr_clean', [ '', 'Y' ]) || $self->ut_alphan('location_type') || $self->ut_textn('location_number') || $self->ut_enum('location_kind', [ '', 'R', 'B' ] ) @@ -208,9 +209,6 @@ sub check { return "Unit # is required"; } - $self->set_coord - unless $import || ($self->latitude && $self->longitude); - # tricky...we have to allow for the customer to not be inserted yet return "No prospect or customer!" unless $self->prospectnum || $self->custnum diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 9e39b3006..4ea4a6b9d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1488,20 +1488,6 @@ sub replace { return "You are not permitted to create complimentary accounts."; } - # should be unnecessary--geocode will default to null on new locations - #if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode') - # && $conf->exists('enable_taxproducts') - # ) - #{ - # my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip) - # ? 'ship_' : ''; - # $self->set('geocode', '') - # if $old->get($pre.'zip') ne $self->get($pre.'zip') - # && length($self->get($pre.'zip')) >= 10; - #} - - # set_coord/coord_auto stuff is now handled by cust_location - local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ @@ -1862,8 +1848,6 @@ sub check { } - #ship_ fields are gone - #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ # or return "Illegal payby: ". $self->payby; #$self->payby($1); diff --git a/FS/MANIFEST b/FS/MANIFEST index f530610e7..9c444be58 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -673,3 +673,5 @@ FS/part_export_machine.pm t/part_export_machine.t FS/svc_export_machine.pm t/svc_export_machine.t +FS/GeocodeCache.pm +t/GeocodeCache.t diff --git a/FS/t/GeocodeCache.t b/FS/t/GeocodeCache.t new file mode 100644 index 000000000..eae6f0d01 --- /dev/null +++ b/FS/t/GeocodeCache.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::GeocodeCache; +$loaded=1; +print "ok 1\n"; |