summaryrefslogtreecommitdiff
path: root/FS/FS/Misc/Geo.pm
diff options
context:
space:
mode:
authormark <mark>2012-01-13 10:13:56 +0000
committermark <mark>2012-01-13 10:13:56 +0000
commit5e76ae4e7a11bd28478ed68eef8124fb7ff0767c (patch)
tree958bb1b1e855c3e4204fc23d76f1f81f5fa00cf9 /FS/FS/Misc/Geo.pm
parentf5d62095722c3756c897db1903bddb1a9aad3a06 (diff)
sales tax districts, #15089
Diffstat (limited to 'FS/FS/Misc/Geo.pm')
-rw-r--r--FS/FS/Misc/Geo.pm145
1 files changed, 143 insertions, 2 deletions
diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm
index c193f33..acfeabf 100644
--- a/FS/FS/Misc/Geo.pm
+++ b/FS/FS/Misc/Geo.pm
@@ -7,11 +7,12 @@ use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common qw( GET POST );
use HTML::TokeParser;
+use URI::Escape;
use Data::Dumper;
$DEBUG = 0;
-@EXPORT_OK = qw( get_censustract );
+@EXPORT_OK = qw( get_censustract get_district );
=head1 NAME
@@ -21,7 +22,7 @@ FS::Misc::Geo - routines to fetch geographic information
=over 4
-=item censustract LOCATION YEAR
+=item get_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
@@ -131,4 +132,144 @@ sub get_censustract {
$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<FS::cust_main_county>
+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;
+
+ my $res = $ua->request( GET( "$url?$query_string" ) );
+
+ warn $res->as_string
+ if $DEBUG > 1;
+
+ 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 </script> 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/(?<!\\)'.*//s; # (?<!\\) means "not preceded by a backslash"
+ warn "\n\n innerHTML:\n$js\n\n" if $DEBUG > 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;
+ return $return;
+ }
+ else {
+ $error = 'district code/tax rate not found';
+ }
+ }
+ else {
+ $error = "failed to parse document";
+ }
+
+ die "WA tax district lookup error: $error";
+}
+
+=back
+
+=cut
+
+
1;