X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FMisc%2FGeo.pm;h=bc020a22d403567ca1f329b856fa6e107ac3d22c;hp=dbc383a14637f12708b22a1c057fb56fe2492412;hb=690d877102bcbddb20806995c549ed35b7b36647;hpb=06b7b4024abdd67573dcceb896f3e982d85eaffe diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index dbc383a14..bc020a22d 100644 --- a/FS/FS/Misc/Geo.pm +++ b/FS/FS/Misc/Geo.pm @@ -6,11 +6,15 @@ use vars qw( $DEBUG @EXPORT_OK $conf ); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common qw( GET POST ); -use JSON; +use IO::Socket::SSL; +use HTML::TokeParser; +use Cpanel::JSON::XS; use URI::Escape 3.31; use Data::Dumper; use FS::Conf; +use FS::Log; use Locale::Country; +use XML::LibXML; FS::UID->install_callback( sub { $conf = new FS::Conf; @@ -138,104 +142,174 @@ sub get_district { &$method($location); } + +=head2 wa_sales location_hash + +Expects output of location_hash() as parameter + +Returns undef on error, or if tax rate cannot be found using given address + +Query the WA State Dept of Revenue API with an address, and return +tax district information for that address. + +Documentation for the API can be found here: + +L + +This API does not return consistent usable county names, as the county +name may include appreviations or labels referring to PTBA (public transport +benefit area) or CEZ (community empowerment zone). It's recommended to use +the tool freeside-wa-tax-table-update to fully populate the +city/county/districts for WA state every financial quarter. + +Returns a hashref with the following keys: + + - district the wa state tax district id + - tax the combined total tax rate, as a percentage + - city the API rate name + - county The API address PTBA + - state WA + - country US + - exempt_amount 0 + +If api returns no district for address, generates system log error +and returns undef + +=cut + sub wa_sales { - my $location = shift; - my $error = ''; - return '' if $location->{state} ne 'WA'; - my $return = { %$location }; - $return->{'exempt_amount'} = 0.00; + # + # no die(): + # freeside-queued will issue dbh->rollback on die() ... this will + # also roll back system log messages about errors :/ freeside-queued + # doesn't propgate die messages into the system log. + # - my $url = 'http://webgis2.dor.wa.gov/TaxRateLookup_AGS/TaxReport.aspx'; - my $ua = new LWP::UserAgent; + my $location_hash = shift; + + # Return when called with pointless context + return + unless $location_hash + && ref $location_hash + && $location_hash->{state} eq 'WA' + && $location_hash->{address1} + && $location_hash->{zip} + && $location_hash->{city}; + + my $log = FS::Log->new('wa_sales'); + + warn "wa_sales() called with location_hash:\n".Dumper( $location_hash)."\n" + if $DEBUG; + + my $api_url = 'http://webgis.dor.wa.gov/webapi/AddressRates.aspx'; + my @api_response_codes = ( + 'The address was found', + 'The address was not found, but the ZIP+4 was located.', + 'The address was updated and found, the user should validate the address record', + 'The address was updated and Zip+4 located, the user should validate the address record', + 'The address was corrected and found, the user should validate the address record', + 'Neither the address or ZIP+4 was found, but the 5-digit ZIP was located.', + 'The address, ZIP+4, and ZIP could not be found.', + 'Invalid Latitude/Longitude', + 'Internal error' + ); - 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 %get_query = ( + output => 'xml', + addr => $location_hash->{address1}, + city => $location_hash->{city}, + zip => substr( $location_hash->{zip}, 0, 5 ), + ); + my $get_string = join '&' => ( + map{ sprintf "%s=%s", $_, uri_escape( $get_query{$_} ) } + keys %get_query ); - - 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" ) ); + my $prepared_url = "${api_url}?$get_string"; - warn $res->as_string - if $DEBUG > 2; + warn "API call to URL: $prepared_url\n" + if $DEBUG; - if ($res->code ne '200') { - $error = $res->message; + my $dom; + local $@; + eval { $dom = XML::LibXML->load_xml( location => $prepared_url ); }; + if ( $@ ) { + my $error = + sprintf "Problem parsing XML from API URL(%s): %s", + $prepared_url, $@; + + $log->error( $error ); + warn $error; + return; } - 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'; - } + my ($res_root) = $dom->findnodes('/response'); + my ($res_addressline) = $dom->findnodes('/response/addressline'); + my ($res_rate) = $dom->findnodes('/response/rate'); + + my $res_code = $res_root->getAttribute('code') + if $res_root; + + unless ( + ref $res_root + && ref $res_addressline + && ref $res_rate + && $res_code <= 5 + && $res_root->getAttribute('rate') > 0 + ) { + my $error = + sprintf + "Problem querying WA DOR tax district - " . + "code( %s %s ) " . + "address( %s ) " . + "url( %s )", + $res_code || 'n/a', + $res_code ? $api_response_codes[$res_code] : 'n/a', + $location_hash->{address1}, + $prepared_url; + + $log->error( $error ); + warn "$error\n"; + return; } - else { - $error = "failed to parse document"; + + my %response = ( + exempt_amount => 0, + state => 'WA', + country => 'US', + district => $res_root->getAttribute('loccode'), + tax => $res_root->getAttribute('rate') * 100, + county => uc $res_addressline->getAttribute('ptba'), + city => uc $res_rate->getAttribute('name') + ); + + $response{county} =~ s/ PTBA//i; + + if ( $DEBUG ) { + warn "XML document: $dom\n"; + warn "API parsed response: ".Dumper( \%response )."\n"; } - die "WA tax district lookup error: $error"; + my $info_message = + sprintf + "Tax district(%s) selected for address(%s %s %s %s)", + $response{district}, + $location_hash->{address1}, + $location_hash->{city}, + $location_hash->{state}, + $location_hash->{zip}; + + $log->info( $info_message ); + warn "$info_message\n" + if $DEBUG; + + \%response; + } +###### USPS Standardization ###### + sub standardize_usps { my $class = shift; @@ -292,6 +366,62 @@ sub standardize_usps { addr_clean=> 'Y' } } +###### U.S. Census Bureau ###### + +sub standardize_uscensus { + my $self = shift; + my $location = shift; + my $log = FS::Log->new('FS::Misc::Geo::standardize_uscensus'); + $log->debug(join("\n", @{$location}{'address1', 'city', 'state', 'zip'})); + + eval "use Geo::USCensus::Geocoding"; + die $@ if $@; + + if ( $location->{country} ne 'US' ) { + # soft failure + warn "standardize_uscensus not for use in country ".$location->{country}."\n"; + $location->{addr_clean} = ''; + return $location; + } + + my $request = { + street => $location->{address1}, + city => $location->{city}, + state => $location->{state}, + zip => $location->{zip}, + debug => ($DEBUG || 0), + }; + + my $result = Geo::USCensus::Geocoding->query($request); + if ( $result->is_match ) { + # unfortunately we get the address back as a single line + $log->debug($result->address); + if ($result->address =~ /^(.*), (.*), ([A-Z]{2}), (\d{5}.*)$/) { + return +{ + address1 => $1, + city => $2, + state => $3, + zip => $4, + address2 => uc($location->{address2}), + latitude => $result->latitude, + longitude => $result->longitude, + censustract => $result->censustract, + }; + } else { + die "Geocoding returned '".$result->address."', which does not seem to be a valid address.\n"; + } + } elsif ( $result->match_level eq 'Tie' ) { + die "Geocoding was not able to identify a unique matching address.\n"; + } elsif ( $result->match_level ) { + die "Geocoding did not find a matching address.\n"; + } else { + $log->error($result->error_message); + return; # for internal errors, don't return anything + } +} + +####### EZLOCATE (obsolete) ####### + sub _tomtom_query { # helper method for the below my %args = @_; my $result = Geo::TomTom::Geocoding->query(%args); @@ -582,6 +712,50 @@ sub standardize_melissa { } } +sub standardize_freeside { + my $class = shift; + my $location = shift; + + my $url = 'https://ws.freeside.biz/normalize'; + + #free freeside.biz normalization only for US + if ( $location->{country} ne 'US' ) { + # soft failure + #why? something else could have cleaned it $location->{addr_clean} = ''; + return $location; + } + + my $ua = LWP::UserAgent->new( + 'ssl_opts' => { + verify_hostname => 0, + SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, + }, + ); + my $response = $ua->request( POST $url, [ + 'support-key' => scalar($conf->config('support-key')), + %$location, + ]); + + die "Address normalization error: ". $response->message + unless $response->is_success; + + local $@; + my $content = eval { decode_json($response->content) }; + if ( $@ ) { + warn $response->content; + die "Address normalization JSON error : $@\n"; + } + + die $content->{error}."\n" + if $content->{error}; + + { 'addr_clean' => 'Y', + map { $_ => $content->{$_} } + qw( address1 address2 city state zip country ) + }; + +} + =back =cut