use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common qw( GET POST );
+use HTTP::Cookies;
use HTML::TokeParser;
use URI::Escape 3.31;
use Data::Dumper;
+use FS::Conf;
+use Locale::Country;
FS::UID->install_callback( sub {
$conf = new FS::Conf;
my $return = {};
my $error = '';
- my $ua = new LWP::UserAgent;
+ my $ua = new LWP::UserAgent('cookie_jar' => HTTP::Cookies->new);
my $res = $ua->request( GET( $url ) );
warn $res->as_string
if $DEBUG > 2;
- unless ($res->code eq '200') {
+ if (!$res->is_success) {
$error = $res->message;
} else {
my $content = $res->content;
+
my $p = new HTML::TokeParser \$content;
my $viewstate;
my $eventvalidation;
last if $viewstate && $eventvalidation;
}
- unless ($viewstate && $eventvalidation ) {
+ if (!$viewstate or !$eventvalidation ) {
$error = "either no __VIEWSTATE or __EVENTVALIDATION found";
my($zip5, $zip4) = split('-',$location->{zip});
- $year ||= '2011'; #2012 per http://transition.fcc.gov/form477/techfaqs.html soon/now?
+ $year ||= '2012';
my @ffiec_args = (
__VIEWSTATE => $viewstate,
__EVENTVALIDATION => $eventvalidation,
+ __VIEWSTATEENCRYPTED => '',
ddlbYear => $year,
txtAddress => $location->{address1},
txtCity => $location->{city},
$return->{'statecode'} . $return->{'countycode'} . $return->{'tractcode'};
}
-sub get_district_methods {
- '' => '',
- 'wa_sales' => 'Washington sales tax',
-};
+#sub get_district_methods {
+# '' => '',
+# 'wa_sales' => 'Washington sales tax',
+#};
=item get_district LOCATION METHOD
#}
$class = 'Geo::EZLocate'; # use our own library
- eval "use $class";
+ eval "use $class 0.02"; #Geo::EZLocate 0.02 for error handling
die $@ if $@;
my $userid = $conf->config('ezlocate-userid')
die $ezlocate_error{$match->{MAT_STAT}}."\n"
unless $match->{MAT_STAT} =~ /^B\d$/;
- {
- address1 => $match->{STD_ADDR},
+ my %result = (
+ address1 => $match->{MAT_ADDR},
address2 => $location->{address2},
- city => $match->{STD_CITY},
- state => $match->{STD_ST},
+ city => $match->{MAT_CITY},
+ state => $match->{MAT_ST},
country => $location->{country},
- zip => $match->{STD_ZIP}.'-'.$match->{STD_P4},
+ zip => $match->{MAT_ZIP},
latitude => $match->{MAT_LAT},
longitude => $match->{MAT_LON},
censustract => $match->{FIPS_ST}.$match->{FIPS_CTY}.
- sprintf('%04.2f',$match->{CEN_TRCT}),
+ sprintf('%07.2f',$match->{CEN_TRCT}),
addr_clean => 'Y',
+ );
+ if ( $match->{STD_ADDR} ) {
+ # then they have a postal standardized address for us
+ %result = ( %result,
+ address1 => $match->{STD_ADDR},
+ address2 => $location->{address2},
+ city => $match->{STD_CITY},
+ state => $match->{STD_ST},
+ zip => $match->{STD_ZIP}.'-'.$match->{STD_P4},
+ );
+ }
+
+ \%result;
+}
+
+sub standardize_tomtom {
+ # post-2013 TomTom API
+ # much better, but incompatible with ezlocate
+ my $self = shift;
+ my $location = shift;
+ my $class = 'Geo::TomTom::Geocoding';
+ eval "use $class";
+ die $@ if $@;
+
+ my $key = $conf->config('tomtom-userid')
+ or die "no tomtom-userid configured\n";
+
+ my $country = code2country($location->{country});
+ my ($address1, $address2) = ($location->{address1}, $location->{address2});
+ # try to fix some cases of the address fields being switched
+ if ( $address2 =~ /^\d/ and $address1 !~ /^\d/ ) {
+ $address2 = $address1;
+ $address1 = $location->{address2};
+ }
+ my $result = $class->query(
+ key => $key,
+ T => $address1,
+ L => $location->{city},
+ AA => $location->{state},
+ PC => $location->{zip},
+ CC => country2code($country, LOCALE_CODE_ALPHA_3),
+ );
+ unless ( $result->is_success ) {
+ die "TomTom geocoding error: ".$result->message."\n";
+ }
+ my ($match) = $result->locations;
+ if (!$match) {
+ die "Location not found.\n";
+ }
+ my $type = $match->{type};
+ warn "tomtom returned $type match\n" if $DEBUG;
+ warn Dumper($match) if $DEBUG > 1;
+ my $tract = '';
+ if ( defined $match->{censusTract} ) {
+ $tract = $match->{censusStateCode}. $match->{censusFipsCountyCode}.
+ join('.', $match->{censusTract} =~ /(....)(..)/);
+ }
+ # match levels below "intersection" should not be considered clean
+ my $clean = ($type eq 'addresspoint' ||
+ $type eq 'poi' ||
+ $type eq 'house' ||
+ $type eq 'intersection'
+ ) ? 'Y' : '';
+
+ $address2 = normalize_address2($address2, $location->{country});
+
+ $address1 = '';
+ $address1 = $match->{houseNumber} . ' ' if length($match->{houseNumber});
+ $address1 .= $match->{street} if $match->{street};
+
+ return +{
+ address1 => $address1,
+ address2 => $address2,
+ city => $match->{city},
+ state => $location->{state}, # this will never change
+ country => $location->{country}, # ditto
+ zip => ($match->{standardPostalCode} || $match->{postcode}),
+ latitude => $match->{latitude},
+ longitude => $match->{longitude},
+ censustract => $tract,
+ addr_clean => $clean,
};
}
+=iten normalize_address2 STRING, COUNTRY
+
+Given an 'address2' STRING, normalize it for COUNTRY postal standards.
+Currently only works for US and CA.
+
+=cut
+
+# XXX really ought to be a separate module
+my %address2_forms = (
+ # Postal Addressing Standards, Appendix C
+ # (plus correction of "hanger" to "hangar")
+ US => {qw(
+ APARTMENT APT
+ BASEMENT BSMT
+ BUILDING BLDG
+ DEPARTMENT DEPT
+ FLOOR FL
+ FRONT FRNT
+ HANGAR HNGR
+ HANGER HNGR
+ KEY KEY
+ LOBBY LBBY
+ LOT LOT
+ LOWER LOWR
+ OFFICE OFC
+ PENTHOUSE PH
+ PIER PIER
+ REAR REAR
+ ROOM RM
+ SIDE SIDE
+ SLIP SLIP
+ SPACE SPC
+ STOP STOP
+ SUITE STE
+ TRAILER TRLR
+ UNIT UNIT
+ UPPER UPPR
+ )},
+ # Canada Post Addressing Guidelines 4.3
+ CA => {qw(
+ APARTMENT APT
+ APPARTEMENT APP
+ BUREAU BUREAU
+ SUITE SUITE
+ UNIT UNIT
+ UNITÉ UNITÉ
+ )},
+);
+
+sub normalize_address2 {
+ # Some things seen in the address2 field:
+ # Whitespace
+ # The complete address (with address1 containing part of the company name,
+ # or an ATTN or DBA line, or P.O. Box, or department name, or building/suite
+ # number, etc.)
+ my ($addr2, $country) = @_;
+ $addr2 = uc($addr2);
+ if ( exists($address2_forms{$country}) ) {
+ my $dict = $address2_forms{$country};
+ # protect this
+ $addr2 =~ s/#\s*(\d)/NUMBER$1/; # /g?
+ my @words;
+ # remove all punctuation and spaces
+ foreach my $w (split(/\W+/, $addr2)) {
+ if ( exists($dict->{$w}) ) {
+ push @words, $dict->{$w};
+ } else {
+ push @words, $w;
+ }
+ }
+ my $result = join(' ', @words);
+ # correct spacing of pound sign + number
+ $result =~ s/NUMBER(\d)/# $1/;
+ warn "normalizing '$addr2' to '$result'\n" if $DEBUG > 1;
+ $addr2 = $result;
+ }
+ $addr2;
+}
+
+
=back
=cut