diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Conf.pm | 9 | ||||
| -rw-r--r-- | FS/FS/Mason.pm | 2 | ||||
| -rw-r--r-- | FS/FS/Misc/Geo.pm | 145 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 12 | ||||
| -rw-r--r-- | FS/FS/cust_location.pm | 49 | ||||
| -rw-r--r-- | FS/FS/cust_main.pm | 39 | ||||
| -rw-r--r-- | FS/FS/cust_main/Billing.pm | 4 | ||||
| -rw-r--r-- | FS/FS/cust_main_county.pm | 3 | ||||
| -rw-r--r-- | FS/FS/geocode_Mixin.pm | 56 | ||||
| -rw-r--r-- | FS/bin/freeside-tax-district-update | 78 |
10 files changed, 385 insertions, 12 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 6a0b2e963..06b72e203 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -13,6 +13,7 @@ use FS::payby; use FS::conf; use FS::Record qw(qsearch qsearchs); use FS::UID qw(dbh datasrc use_confcompat); +use FS::Misc::Geo; $base_dir = '%%%FREESIDE_CONF%%%'; @@ -3748,6 +3749,14 @@ and customer address. Include units.', }, { + 'key' => 'tax_district_method', + 'section' => 'UI', + 'description' => 'The method to use to look up tax district codes.', + 'type' => 'select', + 'select_hash' => [ FS::Misc::Geo::get_district_methods() ], + }, + + { 'key' => 'company_latitude', 'section' => 'UI', 'description' => 'Your company latitude (-90 through 90)', diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index d8e394887..6cc32bd04 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -64,7 +64,7 @@ if ( -e $addl_handler_use_file ) { use DateTime; use DateTime::Format::Strptime; use FS::Misc::DateTime qw( parse_datetime ); - use FS::Misc::Geo qw( get_censustract ); + use FS::Misc::Geo qw( get_censustract get_district ); use Lingua::EN::Inflect qw(PL); Lingua::EN::Inflect::classical names=>0; #Categorys use Tie::IxHash; diff --git a/FS/FS/Misc/Geo.pm b/FS/FS/Misc/Geo.pm index c193f33bc..acfeabf3b 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; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a592efd6b..414891990 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -896,6 +896,7 @@ sub tables_hashref { 'geocode', 'varchar', 'NULL', 20, '', '', 'censustract', 'varchar', 'NULL', 20, '', '', # 7 to save space? 'censusyear', 'char', 'NULL', 4, '', '', + 'district', 'varchar', 'NULL', 20, '', '', 'tax', 'char', 'NULL', 1, '', '', 'otaker', 'varchar', 'NULL', 32, '', '', 'usernum', 'int', 'NULL', '', '', '', @@ -1054,6 +1055,7 @@ sub tables_hashref { 'coord_auto', 'char', 'NULL', 1, '', '', 'country', 'char', '', 2, '', '', 'geocode', 'varchar', 'NULL', 20, '', '', + 'district', 'varchar', 'NULL', 20, '', '', 'location_type', 'varchar', 'NULL', 20, '', '', 'location_number', 'varchar', 'NULL', 20, '', '', 'location_kind', 'char', 'NULL', 1, '', '', @@ -1178,11 +1180,12 @@ sub tables_hashref { 'index' => [ [ 'custnum' ], [ 'billpkgnum' ] ], }, - 'cust_main_county' => { #county+state+country are checked off the - #cust_main_county for validation and to provide - # a tax rate. + 'cust_main_county' => { #district+city+county+state+country are checked + #off the cust_main_county for validation and to + #provide a tax rate. 'columns' => [ 'taxnum', 'serial', '', '', '', '', + 'district', 'varchar', 'NULL', 20, '', '', 'city', 'varchar', 'NULL', $char_d, '', '', 'county', 'varchar', 'NULL', $char_d, '', '', 'state', 'varchar', 'NULL', $char_d, '', '', @@ -1197,7 +1200,8 @@ sub tables_hashref { 'primary_key' => 'taxnum', 'unique' => [], # 'unique' => [ ['taxnum'], ['state', 'county'] ], - 'index' => [ [ 'city' ], [ 'county' ], [ 'state' ], [ 'country' ], + 'index' => [ [ 'district' ], [ 'city' ], [ 'county' ], [ 'state' ], + [ 'country' ], [ 'taxclass' ], ], }, diff --git a/FS/FS/cust_location.pm b/FS/FS/cust_location.pm index a3d5bcb3e..f863b1020 100644 --- a/FS/FS/cust_location.pm +++ b/FS/FS/cust_location.pm @@ -76,6 +76,10 @@ Country (see L<FS::cust_main_county>) Geocode +=item district + +Tax district code (optional) + =item disabled Disabled flag; set to 'Y' to disable the location. @@ -102,6 +106,26 @@ sub table { 'cust_location'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + my $error = $self->SUPER::insert(@_); + + #false laziness with cust_main, will go away eventually + my $conf = new FS::Conf; + if ( !$error and $conf->config('tax_district_method') ) { + + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update' + }; + $error = $queue->insert( ref($self), $self->locationnum ); + + } + + $error || ''; +} + =item delete Delete this record from the database. @@ -111,6 +135,30 @@ Delete this record from the database. Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub replace { + my $self = shift; + my $old = shift; + $old ||= $self->replace_old; + my $error = $self->SUPER::replace($old); + + #false laziness with cust_main, will go away eventually + my $conf = new FS::Conf; + if ( !$error and $conf->config('tax_district_method') + and $self->get('address1') ne $old->get('address1') ) { + + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update' + }; + $error = $queue->insert( ref($self), $self->locationnum ); + + } + + $error || ''; +} + + =item check Checks all fields to make sure this is a valid location. If there is @@ -142,6 +190,7 @@ sub check { || $self->ut_textn('location_number') || $self->ut_enum('location_kind', [ '', 'R', 'B' ] ) || $self->ut_alphan('geocode') + || $self->ut_alphan('district') ; return $error if $error; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7937a00b3..eaf70cf64 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -609,6 +609,20 @@ sub insert { } } + # FS::geocode_Mixin::after_insert or something? + if ( $conf->config('tax_district_method') and !$import ) { + # if anything non-empty, try to look it up + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update', + 'custnum' => $self->custnum, + }; + my $error = $queue->insert( ref($self), $self->custnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing tax district update: $error"; + } + } + # cust_main exports! warn " exporting\n" if $DEBUG > 1; @@ -1633,6 +1647,25 @@ sub replace { } } + # FS::geocode_Mixin::after_replace ? + # though this will go away anyway once we move customer bill/service + # locations into cust_location + # We can trigger this on any address change--just have to make sure + # not to trigger it on itself. + if ( $conf->config('tax_district_method') and !$import + and ( $self->get('ship_address1') ne $old->get('ship_address1') + or $self->get('address1') ne $old->get('address1') ) ) { + my $queue = new FS::queue { + 'job' => 'FS::geocode_Mixin::process_district_update', + 'custnum' => $self->custnum, + }; + my $error = $queue->insert( ref($self), $self->custnum ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing tax district update: $error"; + } + } + # cust_main exports! my $export_args = $options{'export_args'} || []; @@ -1739,6 +1772,7 @@ sub check { || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') + || $self->ut_alphan('district') || $self->ut_floatn('cdr_termination_percentage') || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') @@ -2143,8 +2177,9 @@ sub has_ship_address { =item location_hash -Returns a list of key/value pairs, with the following keys: address1, adddress2, -city, county, state, zip, country, and geocode. The shipping address is used if present. +Returns a list of key/value pairs, with the following keys: address1, +adddress2, city, county, state, zip, country, district, and geocode. The +shipping address is used if present. =cut diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm index 205180481..850ffaa3a 100644 --- a/FS/FS/cust_main/Billing.pm +++ b/FS/FS/cust_main/Billing.pm @@ -1165,7 +1165,7 @@ sub _handle_taxes { } else { - my @loc_keys = qw( city county state country ); + my @loc_keys = qw( district city county state country ); my %taxhash; if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { my $cust_location = $cust_pkg->cust_location; @@ -1182,7 +1182,7 @@ sub _handle_taxes { my @taxes = (); my %taxhash_elim = %taxhash; - my @elim = qw( city county state ); + my @elim = qw( district city county state ); do { #first try a match with taxclass diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index e84fa98f9..e01e1d2af 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -56,6 +56,8 @@ currently supported: =item taxnum - primary key (assigned automatically for new tax rates) +=item district - tax district (optional) + =item city =item county @@ -119,6 +121,7 @@ sub check { $self->exempt_amount(0) unless $self->exempt_amount; $self->ut_numbern('taxnum') + || $self->ut_alphan('district') || $self->ut_textn('city') || $self->ut_textn('county') || $self->ut_anything('state') diff --git a/FS/FS/geocode_Mixin.pm b/FS/FS/geocode_Mixin.pm index d821c8031..29491db61 100644 --- a/FS/FS/geocode_Mixin.pm +++ b/FS/FS/geocode_Mixin.pm @@ -132,7 +132,13 @@ sub location_label { $line; } -=item set_coord +=item set_coord [ PREFIX ] + +Look up the coordinates of the location using (currently) the Google Maps +API and set the 'latitude' and 'longitude' fields accordingly. + +PREFIX, if specified, will be prepended to all location field names, +including latitude and longitude. =cut @@ -213,6 +219,54 @@ sub geocode { $geocode; } +=item process_district_update CLASS ID + +Queueable function to update the tax district code using the selected method +(config 'tax_district_method'). CLASS is either 'FS::cust_main' or +'FS::cust_location'; ID is the key in one of those tables. + +=cut + +sub process_district_update { + my $class = shift; + my $id = shift; + + eval "use FS::Misc::Geo qw(get_district); use FS::Conf; use $class;"; + die $@ if $@; + die "$class has no location data" if !$class->can('location_hash'); + + my $conf = FS::Conf->new; + my $method = $conf->config('tax_district_method') + or return; #nothing to do if null + my $self = $class->by_key($id) or die "object $id not found"; + + # dies on error, fine + my $tax_info = get_district({ $self->location_hash }, $method); + + if ( $tax_info ) { + $self->set('district', $tax_info->{'district'} ); + my $error = $self->replace; + die $error if $error; + + my %hash = map { $_ => $tax_info->{$_} } + qw( district city county state country ); + my $old = qsearchs('cust_main_county', \%hash); + if ( $old ) { + my $new = new FS::cust_main_county { $old->hash, %$tax_info }; + warn "updating tax rate for district ".$tax_info->{'district'} if $DEBUG; + $error = $new->replace($old); + } + else { + my $new = new FS::cust_main_county $tax_info; + warn "creating tax rate for district ".$tax_info->{'district'} if $DEBUG; + $error = $new->insert; + } + die $error if $error; + + } + return; +} + =back =head1 BUGS diff --git a/FS/bin/freeside-tax-district-update b/FS/bin/freeside-tax-district-update new file mode 100644 index 000000000..e32bc9df5 --- /dev/null +++ b/FS/bin/freeside-tax-district-update @@ -0,0 +1,78 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Parse 'str2time'; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch dbh); +use FS::Conf; +use FS::cust_main; +use FS::h_cust_main; + +my %opt; +getopts('n', \%opt); + +my $user = shift or die &usage; +adminsuidsetup($user); +$FS::UID::AutoCommit = 0; +my $dbh = dbh; + +my $conf = FS::Conf->new; +my $method = $conf->config('tax_district_method') + or die "no tax district lookup method configured.\n"; + +my %limit; +%limit = ( district => '' ) if $opt{'n'}; +my @location = qsearch( 'cust_main', \%limit ), + qsearch( 'cust_location', { disabled => '', %limit } ); + +# breaking the rules somewhat by modifying cust_location records in place +# instead of doing a proper package change, but we're not changing the +# actual address +warn scalar(@location)." records found.\n"; +my $queued = 0; my $updated = 0; +foreach my $location (@location) { + my $error; + my $job = FS::queue->new({ + job => 'FS::geocode_Mixin::process_district_update' + }); + my $class = ref($location); + my $id = $class eq 'FS::cust_main' ? + $location->custnum : + $location->locationnum; + $error = $job->insert($class, $id); + if ( $error ) { + $dbh->rollback; + die "error queueing update for $class $id\n"; + } + $queued++; +} +warn "Queued $queued tax district lookups.\n"; +$dbh->commit; + +sub usage { + "Usage:\n\n freeside-tax-district-update [ -n ] user\n\n" +} + +=head1 NAME + +freeside-tax-district-update - Update tax district codes from a lookup source. + +=head1 SYNOPSIS + + freeside-tax-district-update [ -n ] user + +=head1 DESCRIPTION + +Updates the 'district' field for all customers and service locations +using an online tax information lookup method. Currently the only +one supported is the Washington Department of Revenue sales tax table, +and looking up the tax district will create a cust_main_county record +with the tax rate for that district. + +The -n option tells the script to ignore customers and locations that +already have a district code. + +The actual lookup operation will run from the job queue. + +=cut |