X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FMisc%2FGeo.pm;h=2ad8311d084771675b824c3cc6199413ba248ed5;hb=55e2b73fce4db4aa189b1c102a798c4f7060d109;hp=3031b65d42122a69316ab2a7fb7603ad7c757fba;hpb=399b04d522b22e593a9fa7463851be6d121ae4cf;p=freeside.git diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index 3031b65d4..2ad8311d0 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -2,26 +2,32 @@ 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 ); use HTML::TokeParser; +use URI::Escape 3.31; use Data::Dumper; +use FS::Conf; -$DEBUG = 1; +FS::UID->install_callback( sub { + $conf = new FS::Conf; +} ); -@EXPORT_OK = qw( get_censustract ); +$DEBUG = 0; + +@EXPORT_OK = qw( get_district ); =head1 NAME FS::Misc::Geo - routines to fetch geographic information -=head1 FUNCTIONS +=head1 CLASS METHODS =over 4 -=item censustract LOCATION YEAR +=item get_censustract LOCATION YEAR Given a location hash (see L) and a census map year, returns a census tract code (consisting of state, county, and tract @@ -29,13 +35,14 @@ codes) or an error message. =cut -sub get_censustract { +sub get_censustract_ffiec { + my $class = shift; my $location = shift; my $year = shift; warn Dumper($location, $year) if $DEBUG; - my $url='http://www.ffiec.gov/Geocode/default.aspx'; + my $url = 'http://www.ffiec.gov/Geocode/default.aspx'; my $return = {}; my $error = ''; @@ -44,7 +51,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') { @@ -74,14 +81,11 @@ sub get_censustract { my($zip5, $zip4) = split('-',$location->{zip}); - $year ||= '2011'; - #ugh workaround a mess at ffiec - $year = " $year" if $year ne '2011'; + $year ||= '2012'; my @ffiec_args = ( __VIEWSTATE => $viewstate, __EVENTVALIDATION => $eventvalidation, ddlbYear => $year, - ddlbYear => '2011', #' 2009', txtAddress => $location->{address1}, txtCity => $location->{city}, ddlbState => $location->{state}, @@ -89,12 +93,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') { @@ -104,7 +108,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 = @@ -116,7 +120,10 @@ sub get_censustract { $return->{lc($1)} = $p->get_trimmed_text("/span"); } - $error = "No census tract found" unless $return->{tractcode}; + unless ( $return->{tractcode} ) { + warn "$error: $content ". Dumper($return) if $DEBUG; + $error = "No census tract found"; + } $return->{tractcode} .= ' ' unless $error || $JSON::VERSION >= 2; #broken JSON 1 workaround @@ -126,9 +133,274 @@ 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'}; } +#sub get_district_methods { +# '' => '', +# 'wa_sales' => 'Washington sales tax', +#}; + +=item get_district LOCATION METHOD + +For the location hash in LOCATION, using lookup method METHOD, fetch +tax district information. Currently the only available method is +'wa_sales' (the Washington Department of Revenue sales tax lookup). + +Returns a hash reference containing the following fields: + +- district +- tax (percentage) +- taxname +- exempt_amount (currently zero) +- city, county, state, country (from + +The intent is that you can assign this to an L +object and insert it if there's not yet a tax rate defined for that +district. + +get_district will die on error. + +=over 4 + +=cut + +sub get_district { + no strict 'refs'; + my $location = shift; + my $method = shift or return ''; + warn Dumper($location, $method) if $DEBUG; + &$method($location); +} + +sub wa_sales { + my $location = shift; + my $error = ''; + return '' if $location->{state} ne 'WA'; + + my $return = { %$location }; + $return->{'exempt_amount'} = 0.00; + + my $url = 'http://webgis2.dor.wa.gov/TaxRateLookup_AGS/TaxReport.aspx'; + my $ua = new LWP::UserAgent; + + my $delim = '<|>'; # yes, <|> + my $year = (localtime)[5] + 1900; + my $month = (localtime)[4] + 1; + my @zip = split('-', $location->{zip}); + + my @args = ( + 'TaxType=S', #sales; 'P' = property + 'Src=0', #does something complicated + 'TAXABLE=', + 'Addr='.uri_escape($location->{address1}), + 'City='.uri_escape($location->{city}), + 'Zip='.$zip[0], + 'Zip1='.($zip[1] || ''), #optional + 'Year='.$year, + 'SYear='.$year, + 'Month='.$month, + 'EMon='.$month, + ); + + my $query_string = join($delim, @args ); + $url .= "?$query_string"; + warn "\nrequest: $url\n\n" if $DEBUG > 1; + + my $res = $ua->request( GET( "$url?$query_string" ) ); + + warn $res->as_string + if $DEBUG > 2; + + if ($res->code ne '200') { + $error = $res->message; + } + + my $content = $res->content; + my $p = new HTML::TokeParser \$content; + my $js = ''; + while ( my $t = $p->get_tag('script') ) { + my $u = $p->get_token; #either enclosed text or the tag + if ( $u->[0] eq 'T' and $u->[1] =~ /tblSales/ ) { + $js = $u->[1]; + last; + } + } + if ( $js ) { #found it + # strip down to the quoted string, which contains escaped single quotes. + $js =~ s/.*\('tblSales'\);c.innerHTML='//s; + $js =~ s/(? 2; + + $p = new HTML::TokeParser \$js; + TD: while ( my $td = $p->get_tag('td') ) { + while ( my $u = $p->get_token ) { + next TD if $u->[0] eq 'E' and $u->[1] eq 'td'; + next if $u->[0] ne 'T'; # skip non-text + my $text = $u->[1]; + + if ( lc($text) eq 'location code' ) { + $p->get_tag('td'); # skip to the next column + undef $u; + $u = $p->get_token until $u->[0] eq 'T'; # and then skip non-text + $return->{'district'} = $u->[1]; + } + elsif ( lc($text) eq 'total tax rate' ) { + $p->get_tag('td'); + undef $u; + $u = $p->get_token until $u->[0] eq 'T'; + $return->{'tax'} = $u->[1]; + } + } # get_token + } # TD + + # just to make sure + if ( $return->{'district'} =~ /^\d+$/ and $return->{'tax'} =~ /^.\d+$/ ) { + $return->{'tax'} *= 100; #percentage + warn Dumper($return) if $DEBUG > 1; + return $return; + } + else { + $error = 'district code/tax rate not found'; + } + } + else { + $error = "failed to parse document"; + } + + 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 + + 1;