[freeside-commits] freeside/FS/FS/Misc Geo.pm,1.2,1.3

[Mark Wells]

Update of /home/cvs/cvsroot/freeside/FS/FS/Misc
In directory wavetail.420.am:/tmp/cvs-serv17776/FS/FS/Misc

Modified Files:
	Geo.pm 
Log Message:
sales tax districts, #15089

Index: Geo.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Misc/Geo.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -d -r1.2 -r1.3
--- Geo.pm	10 Jan 2012 18:36:35 -0000	1.2
+++ Geo.pm	13 Jan 2012 10:13:56 -0000	1.3
@@ -7,11 +7,12 @@
 use HTTP::Request;
 use HTTP::Request::Common qw( GET POST );
 use HTML::TokeParser;
+use URI::Escape;
 use Data::Dumper;
 
 $DEBUG = 0;
 
- at EXPORT_OK = qw( get_censustract );
+ at EXPORT_OK = qw( get_censustract get_district );
 
 =head1 NAME
 
@@ -21,7 +22,7 @@
 
 =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 @@
   $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;