2 use base qw( FS::Record );
5 use vars qw( $DEBUG $me
6 %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
7 %tax_passtypes %GetInfoType $keep_cch_files );
10 use DateTime::Format::Strptime;
19 use DBIx::DBSchema::Table;
20 use DBIx::DBSchema::Column;
22 use FS::Record qw( qsearch qsearchs dbh dbdef );
25 use FS::cust_bill_pkg;
26 use FS::cust_tax_location;
27 use FS::tax_rate_location;
28 use FS::part_pkg_taxrate;
29 use FS::part_pkg_taxproduct;
31 use FS::Misc qw( csv_from_fixed );
34 $me = '[FS::tax_rate]';
39 FS::tax_rate - Object methods for tax_rate objects
45 $record = new FS::tax_rate \%hash;
46 $record = new FS::tax_rate { 'column' => 'value' };
48 $error = $record->insert;
50 $error = $new_record->replace($old_record);
52 $error = $record->delete;
54 $error = $record->check;
58 An FS::tax_rate object represents a tax rate, defined by locale.
59 FS::tax_rate inherits from FS::Record. The following fields are
66 primary key (assigned automatically for new tax rates)
70 a geographic location code provided by a tax data vendor
78 a location code provided by a tax authority
82 a foreign key into FS::tax_class - the type of tax referenced by
87 the time after which the tax applies
95 second bracket percentage
99 the amount to which the tax applies (first bracket)
103 a cap on the amount of tax if a cap exists
107 percentage on out of jurisdiction purchases
111 second bracket percentage on out of jurisdiction purchases
115 one of the values in %tax_unittypes
119 amount of tax per unit
123 second bracket amount of tax per unit
127 the number of units to which the fee applies (first bracket)
131 the most units to which fees apply (first and second brackets)
135 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
139 if defined, printed on invoices instead of "Tax"
143 a value from %tax_authorities
147 a value from %tax_basetypes indicating the tax basis
151 a value from %tax_passtypes indicating how the tax should displayed to the customer
155 'Y', 'N', or blank indicating the tax can be passed to the customer
159 if 'Y', this tax does not apply to setup fees
163 if 'Y', this tax does not apply to recurring fees
167 if 'Y', has been manually edited
177 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
181 sub table { 'tax_rate'; }
185 Adds this tax rate to the database. If there is an error, returns the error,
186 otherwise returns false.
190 Deletes this tax rate from the database. If there is an error, returns the
191 error, otherwise returns false.
193 =item replace OLD_RECORD
195 Replaces the OLD_RECORD with this one in the database. If there is an error,
196 returns the error, otherwise returns false.
200 Checks all fields to make sure this is a valid tax rate. If there is an error,
201 returns the error, otherwise returns false. Called by the insert and replace
209 foreach (qw( taxbase taxmax )) {
210 $self->$_(0) unless $self->$_;
213 $self->ut_numbern('taxnum')
214 || $self->ut_text('geocode')
215 || $self->ut_textn('data_vendor')
216 || $self->ut_cch_textn('location')
217 || $self->ut_foreign_keyn('taxclassnum', 'tax_class', 'taxclassnum')
218 || $self->ut_snumbern('effective_date')
219 || $self->ut_float('tax')
220 || $self->ut_floatn('excessrate')
221 || $self->ut_money('taxbase')
222 || $self->ut_money('taxmax')
223 || $self->ut_floatn('usetax')
224 || $self->ut_floatn('useexcessrate')
225 || $self->ut_numbern('unittype')
226 || $self->ut_floatn('fee')
227 || $self->ut_floatn('excessfee')
228 || $self->ut_floatn('feemax')
229 || $self->ut_numbern('maxtype')
230 || $self->ut_textn('taxname')
231 || $self->ut_numbern('taxauth')
232 || $self->ut_numbern('basetype')
233 || $self->ut_numbern('passtype')
234 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
235 || $self->ut_enum('setuptax', [ '', 'Y' ] )
236 || $self->ut_enum('recurtax', [ '', 'Y' ] )
237 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
238 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
239 || $self->ut_enum('manual', [ '', 'Y' ] )
240 || $self->ut_enum('disabled', [ '', 'Y' ] )
241 || $self->SUPER::check
246 #ut_text / ut_textn w/ ` added cause now that's in the data
249 $self->getfield($field)
250 =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
251 or return gettext('illegal_or_empty_text'). " $field: ".
252 $self->getfield($field);
253 $self->setfield($field,$1);
258 =item taxclass_description
260 Returns the human understandable value associated with the related
265 sub taxclass_description {
267 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
268 $tax_class ? $tax_class->description : '';
273 Returns the human understandable value associated with the unittype column
277 %tax_unittypes = ( '0' => 'access line',
284 $tax_unittypes{$self->unittype};
289 Returns the human understandable value associated with the maxtype column.
293 # XXX these are non-functional, and most of them are horrible to implement
294 # in our current model
296 %tax_maxtypes = ( '0' => 'receipts per invoice',
297 '1' => 'receipts per item',
298 '2' => 'total utility charges per utility tax year',
299 '3' => 'total charges per utility tax year',
300 '4' => 'receipts per access line',
301 '7' => 'total utility charges per calendar year',
302 '9' => 'monthly receipts per location',
303 '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
304 '11' => 'receipts/units per access line',
305 '14' => 'units per invoice',
306 '15' => 'units per month',
307 '18' => 'units per account',
312 $tax_maxtypes{$self->maxtype};
317 Returns the human understandable value associated with the basetype column
321 %tax_basetypes = ( '0' => 'sale price',
322 '1' => 'gross receipts',
323 '2' => 'sales taxable telecom revenue',
324 '3' => 'minutes carried',
325 '4' => 'minutes billed',
326 '5' => 'gross operating revenue',
327 '6' => 'access line',
329 '8' => 'gross revenue',
330 '9' => 'portion gross receipts attributable to interstate service',
331 '10' => 'access line',
332 '11' => 'gross profits',
333 '12' => 'tariff rate',
335 '15' => 'prior year gross receipts',
340 $tax_basetypes{$self->basetype};
345 Returns the human understandable value associated with the taxauth column
349 %tax_authorities = ( '0' => 'federal',
354 '5' => 'county administered by state',
355 '6' => 'city administered by state',
356 '7' => 'city administered by county',
357 '8' => 'local administered by state',
358 '9' => 'local administered by county',
363 $tax_authorities{$self->taxauth};
368 Returns the human understandable value associated with the passtype column
372 %tax_passtypes = ( '0' => 'separate tax line',
373 '1' => 'separate surcharge line',
374 '2' => 'surcharge not separated',
375 '3' => 'included in base rate',
380 $tax_passtypes{$self->passtype};
383 =item taxline_cch TAXABLES, CLASSES
385 Takes an arrayref of L<FS::cust_bill_pkg> objects representing taxable line
386 items, and an arrayref of charge classes ('setup', 'recur', '' for
387 unclassified usage, or an L<FS::usage_class> number). Calculates the tax on
388 each item under this tax definition and returns a list of new
389 L<FS::cust_bill_pkg_tax_rate_location> objects for the taxes charged.
391 If the taxable objects are linked to an invoice, this will also calculate
392 per-customer exemptions (cust_exempt and cust_taxname_exempt) and attach them
393 to the line items in the 'cust_tax_exempt_pkg' pseudo-field.
395 For accurate calculation of per-customer or per-location taxes, ALL items
396 appearing on the invoice (and subject to this tax) MUST be passed to this
397 method together, and NO items from any other invoice should be included.
403 # this used to accept a hash of options but none of them did anything
404 # so it's been removed.
406 my $taxables = shift;
407 my $classes = shift || [];
409 my $name = $self->taxname;
410 $name = 'Other surcharges'
411 if ($self->passtype == 2);
414 return unless @$taxables; # nothing to do
415 return if $self->disabled;
416 return if $self->passflag eq 'N'; # tax can't be passed to the customer
417 # but should probably still appear on the liability report--create a
418 # cust_tax_exempt_pkg record for it?
420 # in 4.x, the invoice is _already inserted_ before we try to calculate
421 # tax on it. though it may be a quotation, so be careful.
424 my $cust_bill = $taxables->[0]->cust_bill;
425 $cust_main = $cust_bill->cust_main if $cust_bill;
427 my $taxable_charged = 0;
428 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
431 my $taxratelocationnum = $self->tax_rate_location->taxratelocationnum;
433 warn "calculating taxes for ". $self->taxnum. " on ".
434 join (",", map { $_->pkgnum } @cust_bill_pkg)
437 my $maxtype = $self->maxtype || 0;
438 if ($maxtype != 0 && $maxtype != 1
439 && $maxtype != 14 && $maxtype != 15
440 && $maxtype != 18 # sigh
442 return $self->_fatal_or_null( 'tax with "'.
443 $self->maxtype_name. '" threshold'
445 } # I don't know why, it's not like there are maxtypes that we DO support
447 # we treat gross revenue as gross receipts and expect the tax data
448 # to DTRT (i.e. tax on tax rules)
449 if ($self->basetype != 0 && $self->basetype != 1 &&
450 $self->basetype != 5 && $self->basetype != 6 &&
451 $self->basetype != 7 && $self->basetype != 8 &&
452 $self->basetype != 14
455 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
458 my @tax_links; # for output
459 my %seen; # locationnum or pkgnum => 1
461 my $taxable_cents = 0;
462 my $taxable_units = 0;
466 my $cust_bill_pkg = shift @$taxables;
467 my $class = shift @$classes;
468 $class = 'all' if !defined($class);
470 my %usage_map = map { $_ => $cust_bill_pkg->usage($_) }
471 $cust_bill_pkg->usage_classes;
472 my $usage_total = sum( values(%usage_map), 0 );
474 # determine if the item has exemptions that apply to this tax def
475 my @exemptions = grep { $_->taxnum == $self->taxnum }
476 @{ $cust_bill_pkg->cust_tax_exempt_pkg };
478 if ( $self->tax > 0 ) {
480 my $taxable_charged = 0;
481 if ($class eq 'all') {
482 $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur;
483 } elsif ($class eq 'setup') {
484 $taxable_charged = $cust_bill_pkg->setup;
485 } elsif ($class eq 'recur') {
486 $taxable_charged = $cust_bill_pkg->recur - $usage_total;
488 $taxable_charged = $usage_map{$class} || 0;
491 foreach my $ex (@exemptions) {
492 # the only cases where the exemption doesn't apply:
493 # if it's a setup exemption and $class is not 'setup' or 'all'
494 # if it's a recur exemption and $class is 'setup'
495 if ( ( $ex->exempt_recur and $class eq 'setup' )
496 or ( $ex->exempt_setup and $class ne 'setup' and $class ne 'all' )
501 $taxable_charged -= $ex->amount;
503 # cust_main_county handles monthly capped exemptions; this doesn't.
505 # $taxable_charged can also be less than zero at this point
506 # (recur exemption + usage class breakdown); treat that as zero.
507 next if $taxable_charged <= 0;
509 # yeah, some false laziness with cust_main_county
510 my $this_tax_cents = int(100 * $taxable_charged * $self->tax);
511 my $tax_link = FS::cust_bill_pkg_tax_rate_location->new({
512 'taxnum' => $self->taxnum,
513 'taxtype' => ref($self),
514 'cents' => $this_tax_cents, # not a real field
515 'locationtaxid' => $self->location, # fundamentally silly
516 'taxable_billpkgnum' => $cust_bill_pkg->billpkgnum,
517 'taxable_cust_bill_pkg' => $cust_bill_pkg,
518 'taxratelocationnum' => $taxratelocationnum,
519 'taxclass' => $class,
521 push @tax_links, $tax_link;
523 $taxable_cents += 100 * $taxable_charged;
524 $tax_cents += $this_tax_cents;
526 } elsif ( $self->fee > 0 ) {
527 # most CCH taxes are this type, because nearly every county has a 911
531 # since we don't support partial exemptions (except setup/recur),
532 # if there's an exemption that applies to this package and taxrate,
533 # don't charge ANY per-unit fees
536 # don't apply fees to usage classes (maybe if we ever get per-minute
538 next unless $class eq 'setup'
542 if ( $self->unittype == 0 ) {
543 if ( !$seen{$cust_bill_pkg->pkgnum} ) {
545 $units = $cust_bill_pkg->units;
546 $seen{$cust_bill_pkg->pkgnum} = 1;
547 } # else it's been seen, leave it at zero units
549 } elsif ($self->unittype == 1) { # per minute
550 # STILL not supported...fortunately these only exist if you happen
551 # to be in Idaho or Little Rock, Arkansas
553 # though a voip_cdr package could easily report minutes of usage...
554 return $self->_fatal_or_null( 'fee with minute unit type' );
556 } elsif ( $self->unittype == 2 ) {
559 my $locationnum = $cust_bill_pkg->tax_locationnum;
560 if (!$locationnum and $cust_main) {
561 $locationnum = $cust_main->ship_locationnum;
563 # the other case is that it's a quotation
565 $units = 1 unless $seen{$cust_bill_pkg->tax_locationnum};
566 $seen{$cust_bill_pkg->tax_locationnum} = 1;
569 # Unittype 19 is used for prepaid wireless E911 charges in many states.
570 # Apparently "per retail purchase", which for us would mean per invoice.
571 # Unittype 20 is used for some 911 surcharges and I have no idea what
573 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
575 my $this_tax_cents = int($units * $self->fee * 100);
576 my $tax_link = FS::cust_bill_pkg_tax_rate_location->new({
577 'taxnum' => $self->taxnum,
578 'taxtype' => ref($self),
579 'cents' => $this_tax_cents,
580 'locationtaxid' => $self->location,
581 'taxable_billpkgnum' => $cust_bill_pkg->billpkgnum,
582 'taxable_cust_bill_pkg' => $cust_bill_pkg,
583 'taxratelocationnum' => $taxratelocationnum,
584 'taxclass' => $class,
586 push @tax_links, $tax_link;
588 $taxable_units += $units;
589 $tax_cents += $this_tax_cents;
592 } # foreach $cust_bill_pkg
594 # check bracket maxima; throw an error if we've gone over, because
595 # we don't really implement them
597 if ( ($self->taxmax > 0 and $taxable_cents > $self->taxmax*100 ) or
598 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
600 # (why not just cap taxable_charged/units at the taxmax/feemax? because
601 # it's way more complicated than that. this won't even catch every case
602 # where a bracket maximum should apply.)
603 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
606 # round and distribute
607 my $total_tax_cents = sprintf('%.0f',
608 ($taxable_cents * $self->tax) + ($taxable_units * $self->fee * 100)
610 my $extra_cents = sprintf('%.0f', $total_tax_cents - $tax_cents);
611 $tax_cents += $extra_cents;
613 foreach (@tax_links) { # can never require more than a single pass, yes?
614 my $cents = $_->get('cents');
615 if ( $extra_cents > 0 ) {
619 $_->set('amount', sprintf('%.2f', $cents/100));
626 my ($self, $error) = @_;
628 $DB::single = 1; # not a mistake
630 my $conf = new FS::Conf;
632 $error = "can't yet handle ". $error;
633 my $name = $self->taxname;
634 $name = 'Other surcharges'
635 if ($self->passtype == 2);
637 if ($conf->exists('ignore_incalculable_taxes')) {
638 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
639 return { name => $name, amount => 0 };
641 return "fatal: $error";
645 =item tax_on_tax CUST_LOCATION
647 Returns a list of taxes which are candidates for taxing taxes for the
648 given service location (see L<FS::cust_location>)
656 my $cust_location = shift;
658 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
659 $cust_location->custnum
662 my $geocode = $cust_location->geocode($self->data_vendor);
666 my $extra_sql = ' AND ('.
667 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
672 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
673 my $select = 'DISTINCT ON(taxclassnum) *';
675 # should qsearch preface columns with the table to facilitate joins?
676 my @taxclassnums = map { $_->taxclassnum }
677 qsearch( { 'table' => 'part_pkg_taxrate',
679 'hashref' => { 'data_vendor' => $self->data_vendor,
680 'taxclassnumtaxed' => $self->taxclassnum,
682 'extra_sql' => $extra_sql,
683 'order_by' => $order_by,
686 return () unless @taxclassnums;
689 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
691 qsearch({ 'table' => 'tax_rate',
692 'hashref' => { 'geocode' => $geocode, },
693 'extra_sql' => $extra_sql,
698 =item tax_rate_location
700 Returns an object representing the location associated with this tax
701 (see L<FS::tax_rate_location>)
705 sub tax_rate_location {
708 qsearchs({ 'table' => 'tax_rate_location',
709 'hashref' => { 'data_vendor' => $self->data_vendor,
710 'geocode' => $self->geocode,
714 new FS::tax_rate_location;
721 Finds an existing tax definition matching the data_vendor, taxname,
722 taxclassnum, and geocode of this one, if one exists, and sets the contents of
723 this tax rate equal to that one (including its taxnum). If an existing
724 definition is not found, inserts this one. Returns an error string if
725 inserting a record failed.
731 # this doesn't uniquely identify CCH taxes (kinda goofy, I know)
732 die "find_or_insert is not compatible with CCH taxes\n"
733 if $self->data_vendor eq 'cch';
735 my @keys = (qw(data_vendor taxname taxclassnum geocode));
736 my %hash = map { $_ => $self->get($_) } @keys;
737 my $existing = qsearchs('tax_rate', \%hash);
739 foreach ($self->fields) {
740 $self->set($_, $existing->get($_));
744 return $self->insert;
758 sub _progressbar_foo {
763 my ($param, $job) = @_;
765 my $fh = $param->{filehandle};
766 my $format = $param->{'format'};
774 my @column_lengths = ();
775 my @column_callbacks = ();
776 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
777 $format =~ s/-fixed//;
778 my $date_format = sub { my $r='';
779 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
782 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
783 push @column_lengths, qw( 10 1 1 8 8 5 8 8 8 1 2 2 30 8 8 10 2 8 2 1 2 2 );
784 push @column_lengths, 1 if $format eq 'cch-update';
785 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
786 $column_callbacks[8] = $date_format;
790 my ( $count, $last, $min_sec ) = _progressbar_foo();
791 if ( $job || scalar(@column_callbacks) ) {
793 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
794 return $error if $error;
798 if ( $format eq 'cch' || $format eq 'cch-update' ) {
799 #false laziness w/below (sub _perform_cch_diff)
800 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
801 excessrate effective_date taxauth taxtype taxcat taxname
802 usetax useexcessrate fee unittype feemax maxtype passflag
804 push @fields, 'actionflag' if $format eq 'cch-update';
809 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
810 $hash->{'data_vendor'} ='cch';
811 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
812 time_zone => 'floating',
814 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
815 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
817 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
818 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
821 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
823 my %tax_class = ( 'data_vendor' => 'cch',
824 'taxclass' => $taxclassid,
827 my $tax_class = qsearchs( 'tax_class', \%tax_class );
828 return "Error updating tax rate: no tax class $taxclassid"
831 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
833 foreach (qw( taxtype taxcat )) {
837 my %passflagmap = ( '0' => '',
841 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
842 if exists $passflagmap{$hash->{'passflag'}};
844 foreach (keys %$hash) {
845 $hash->{$_} = substr($hash->{$_}, 0, 80)
846 if length($hash->{$_}) > 80;
849 my $actionflag = delete($hash->{'actionflag'});
851 $hash->{'taxname'} =~ s/`/'/g;
852 $hash->{'taxname'} =~ s|\\|/|g;
854 return '' if $format eq 'cch'; # but not cch-update
856 if ($actionflag eq 'I') {
857 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
858 }elsif ($actionflag eq 'D') {
859 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
861 return "Unexpected action flag: ". $hash->{'actionflag'};
864 delete($hash->{$_}) for keys %$hash;
870 } elsif ( $format eq 'extended' ) {
871 die "unimplemented\n";
875 die "unknown format $format";
878 my $csv = new Text::CSV_XS;
882 local $SIG{HUP} = 'IGNORE';
883 local $SIG{INT} = 'IGNORE';
884 local $SIG{QUIT} = 'IGNORE';
885 local $SIG{TERM} = 'IGNORE';
886 local $SIG{TSTP} = 'IGNORE';
887 local $SIG{PIPE} = 'IGNORE';
889 my $oldAutoCommit = $FS::UID::AutoCommit;
890 local $FS::UID::AutoCommit = 0;
893 while ( defined($line=<$fh>) ) {
894 $csv->parse($line) or do {
895 $dbh->rollback if $oldAutoCommit;
896 return "can't parse: ". $csv->error_input();
899 if ( $job ) { # progress bar
900 if ( time - $min_sec > $last ) {
901 my $error = $job->update_statustext(
902 int( 100 * $imported / $count ). ",Importing tax rates"
905 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
912 my @columns = $csv->fields();
914 my %tax_rate = ( 'data_vendor' => $format );
915 foreach my $field ( @fields ) {
916 $tax_rate{$field} = shift @columns;
919 if ( scalar( @columns ) ) {
920 $dbh->rollback if $oldAutoCommit;
921 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
924 my $error = &{$hook}(\%tax_rate);
926 $dbh->rollback if $oldAutoCommit;
930 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
932 my $tax_rate = new FS::tax_rate( \%tax_rate );
933 $error = $tax_rate->insert;
936 $dbh->rollback if $oldAutoCommit;
937 return "can't insert tax_rate for $line: $error";
946 my @replace = grep { exists($delete{$_}) } keys %insert;
948 if ( $job ) { # progress bar
949 if ( time - $min_sec > $last ) {
950 my $error = $job->update_statustext(
951 int( 100 * $imported / $count ). ",Importing tax rates"
954 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
961 my $old = qsearchs( 'tax_rate', $delete{$_} );
965 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
966 $new->taxnum($old->taxnum);
967 my $error = $new->replace($old);
970 $dbh->rollback if $oldAutoCommit;
971 my $hashref = $insert{$_};
972 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
973 return "can't replace tax_rate for $line: $error";
980 $old = delete $delete{$_};
981 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
982 #join(" ", map { "$_ => ". $old->{$_} } @fields);
983 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
989 for (grep { !exists($delete{$_}) } keys %insert) {
990 if ( $job ) { # progress bar
991 if ( time - $min_sec > $last ) {
992 my $error = $job->update_statustext(
993 int( 100 * $imported / $count ). ",Importing tax rates"
996 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1003 my $tax_rate = new FS::tax_rate( $insert{$_} );
1004 my $error = $tax_rate->insert;
1007 $dbh->rollback if $oldAutoCommit;
1008 my $hashref = $insert{$_};
1009 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1010 return "can't insert tax_rate for $line: $error";
1016 for (grep { !exists($insert{$_}) } keys %delete) {
1017 if ( $job ) { # progress bar
1018 if ( time - $min_sec > $last ) {
1019 my $error = $job->update_statustext(
1020 int( 100 * $imported / $count ). ",Importing tax rates"
1023 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1030 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
1032 $dbh->rollback if $oldAutoCommit;
1033 $tax_rate = $delete{$_};
1034 warn "WARNING: can't find tax_rate to delete for: ".
1035 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
1038 my $error = $tax_rate->delete; # XXX we really should not do this
1039 # (it orphans CBPTRL records)
1042 $dbh->rollback if $oldAutoCommit;
1043 my $hashref = $delete{$_};
1044 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1045 return "can't delete tax_rate for $line: $error";
1052 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1054 return "Empty file!" unless ($imported || $format eq 'cch-update');
1060 =item process_batch_import
1062 Load a batch import as a queued JSRPC job
1066 sub process_batch_import {
1067 my ($job, $param) = @_;
1069 if ( $param->{reload} ) {
1070 process_batch_reload($job, $param);
1073 _perform_batch_import($job, $param);
1078 sub _perform_batch_import {
1079 my ($job, $param) = @_;
1081 my $oldAutoCommit = $FS::UID::AutoCommit;
1082 local $FS::UID::AutoCommit = 0;
1085 my $format = $param->{'format'};
1087 my $files = $param->{'uploaded_files'}
1088 or die "No files provided.";
1090 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
1093 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1096 if ( $format eq 'cch' || $format eq 'cch-fixed'
1097 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
1100 my @insert_list = ();
1101 my @delete_list = ();
1102 my @predelete_list = ();
1103 my $insertname = '';
1104 my $deletename = '';
1106 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
1107 'CODE', \&FS::tax_class::batch_import,
1108 'PLUS4', \&FS::cust_tax_location::batch_import,
1109 'ZIP', \&FS::cust_tax_location::batch_import,
1110 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
1111 'DETAIL', \&FS::tax_rate::batch_import,
1113 while( scalar(@list) ) {
1114 my ( $name, $import_sub ) = splice( @list, 0, 2 );
1115 my $file = lc($name). 'file';
1117 unless ($files{$file}) {
1118 #$error = "No $name supplied";
1121 next if $name eq 'DETAIL' && $format =~ /update/;
1123 my $filename = "$dir/". $files{$file};
1125 if ( $format =~ /update/ ) {
1127 ( $error, $insertname, $deletename ) =
1128 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1132 unlink $filename or warn "Can't delete $filename: $!"
1133 unless $keep_cch_files;
1134 push @insert_list, $name, $insertname, $import_sub, $format;
1135 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1136 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1138 unshift @delete_list, $name, $deletename, $import_sub, $format;
1143 push @insert_list, $name, $filename, $import_sub, $format;
1150 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1151 if $format =~ /update/;
1153 my %addl_param = ();
1154 if ( $param->{'delete_only'} ) {
1155 $addl_param{'delete_only'} = $param->{'delete_only'};
1159 $error ||= _perform_cch_tax_import( $job,
1160 [ @predelete_list ],
1167 @list = ( @predelete_list, @insert_list, @delete_list );
1168 while( !$keep_cch_files && scalar(@list) ) {
1169 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1170 unlink $file or warn "Can't delete $file: $!";
1173 } elsif ( $format =~ /^billsoft-(\w+)$/ ) {
1175 my $file = $dir.'/'.$files{'file'};
1176 open my $fh, "< $file" or $error ||= "Can't open file $file: $!";
1180 format => 'billsoft',
1182 if ( $mode eq 'pcode' ) {
1183 $error ||= FS::cust_tax_location::batch_import(@param);
1185 $error ||= FS::tax_rate_location::batch_import(@param);
1186 } elsif ( $mode eq 'taxclass' ) {
1187 $error ||= FS::tax_class::batch_import(@param);
1188 } elsif ( $mode eq 'taxproduct' ) {
1189 $error ||= FS::part_pkg_taxproduct::batch_import(@param);
1191 die "unknown import mode 'billsoft-$mode'\n";
1195 die "Unknown format: $format";
1199 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1202 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1209 # EVERYTHING THAT FOLLOWS IS CCH-SPECIFIC.
1213 sub _perform_cch_tax_import {
1214 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1218 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1219 while( scalar(@$list) ) {
1220 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1221 my $fmt = "$format-update";
1222 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1223 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1224 my $param = { 'filehandle' => $fh,
1228 $error ||= &{$method}($param, $job);
1236 sub _perform_cch_insert_delete_split {
1237 my ($name, $filename, $dir, $format) = @_;
1241 open my $fh, "< $filename"
1242 or $error ||= "Can't open $name file $filename: $!";
1244 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1247 ) or die "can't open temp file: $!\n";
1248 my $insertname = $ifh->filename;
1250 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1253 ) or die "can't open temp file: $!\n";
1254 my $deletename = $dfh->filename;
1256 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1257 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1260 $handle = $ifh if $_ =~ /$insert_pattern/;
1261 $handle = $dfh if $_ =~ /$delete_pattern/;
1263 $error = "bad input line: $_" unless $handle;
1272 return ($error, $insertname, $deletename);
1275 sub _perform_cch_diff {
1276 my ($name, $newdir, $olddir) = @_;
1281 open my $oldcsvfh, "$olddir/$name.txt"
1282 or die "failed to open $olddir/$name.txt: $!\n";
1284 while(<$oldcsvfh>) {
1291 open my $newcsvfh, "$newdir/$name.txt"
1292 or die "failed to open $newdir/$name.txt: $!\n";
1294 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1297 ) or die "can't open temp file: $!\n";
1298 my $diffname = $dfh->filename;
1300 while(<$newcsvfh>) {
1302 if (exists($oldlines{$_})) {
1305 print $dfh $_, ',"I"', "\n";
1310 #false laziness w/above (sub batch_import)
1311 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1312 excessrate effective_date taxauth taxtype taxcat taxname
1313 usetax useexcessrate fee unittype feemax maxtype passflag
1314 passtype basetype );
1315 my $numfields = scalar(@fields);
1317 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1319 for my $line (grep $oldlines{$_}, keys %oldlines) {
1321 $csv->parse($line) or do {
1322 #$dbh->rollback if $oldAutoCommit;
1323 die "can't parse: ". $csv->error_input();
1325 my @columns = $csv->fields();
1327 $csv->combine( splice(@columns, 0, $numfields) );
1329 print $dfh $csv->string, ',"D"', "\n";
1337 sub _cch_fetch_and_unzip {
1338 my ( $job, $urls, $secret, $dir ) = @_;
1340 my $ua = new LWP::UserAgent;
1341 foreach my $url (split ',', $urls) {
1342 my @name = split '/', $url; #somewhat restrictive
1343 my $name = pop @name;
1344 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1347 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1349 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1350 my $res = $ua->request(
1351 new HTTP::Request( GET => $url ),
1353 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1354 my $content_length = $_[1]->content_length;
1355 $imported += length($_[0]);
1356 if ( time - $min_sec > $last ) {
1357 my $error = $job->update_statustext(
1358 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1359 ",Downloading data from CCH"
1361 die $error if $error;
1366 die "download of $url failed: ". $res->status_line
1367 unless $res->is_success;
1370 my $error = $job->update_statustext( "0,Unpacking data" );
1371 die $error if $error;
1372 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1374 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1375 or die "unzip -P $secret -d $dir $dir/$name failed";
1376 #unlink "$dir/$name";
1380 sub _cch_extract_csv_from_dbf {
1381 my ( $job, $dir, $name ) = @_;
1386 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1387 my $error = $job->update_statustext( "0,Unpacking $name" );
1388 die $error if $error;
1389 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1390 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1391 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1392 unless defined($table);
1393 my $count = $table->last_record; # approximately;
1394 open my $csvfh, ">$dir.new/$name.txt"
1395 or die "failed to open $dir.new/$name.txt: $!\n";
1397 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1398 my @fields = $table->field_names;
1399 my $cursor = $table->prepare_select;
1401 sub { my $date = shift;
1402 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1405 while (my $row = $cursor->fetch_hashref) {
1406 $csv->combine( map { my $type = $table->field_type($_);
1408 &{$format_date}($row->{$_}) ;
1409 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1410 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1417 print $csvfh $csv->string, "\n";
1419 if ( time - $min_sec > $last ) {
1420 my $error = $job->update_statustext(
1421 int(100 * $imported/$count). ",Unpacking $name"
1423 die $error if $error;
1431 sub _remember_disabled_taxes {
1432 my ( $job, $format, $disabled_tax_rate ) = @_;
1436 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1438 my @items = qsearch( { table => 'tax_rate',
1439 hashref => { disabled => 'Y',
1440 data_vendor => $format,
1442 select => 'geocode, taxclassnum',
1445 my $count = scalar(@items);
1446 foreach my $tax_rate ( @items ) {
1447 if ( time - $min_sec > $last ) {
1448 $job->update_statustext(
1449 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1455 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1456 unless ( $tax_class ) {
1457 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1460 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1464 sub _remember_tax_products {
1465 my ( $job, $format, $taxproduct ) = @_;
1467 # XXX FIXME this loop only works when cch is the only data provider
1469 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1472 WHERE taxproductnum IS NOT NULL
1473 OR EXISTS ( SELECT 1 from part_pkg_option
1474 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
1475 AND optionname LIKE 'usage_taxproductnum_%'
1476 AND optionvalue != ''
1479 my @items = qsearch( { table => 'part_pkg',
1480 select => 'DISTINCT pkgpart,taxproductnum',
1482 extra_sql => $extra_sql,
1485 my $count = scalar(@items);
1486 foreach my $part_pkg ( @items ) {
1487 if ( time - $min_sec > $last ) {
1488 $job->update_statustext(
1489 int( 100 * $imported / $count ). ",Remembering tax products"
1494 warn "working with package part ". $part_pkg->pkgpart.
1495 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1496 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1497 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1498 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1500 foreach my $option ( $part_pkg->part_pkg_option ) {
1501 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1504 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1505 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1506 $part_pkg_taxproduct->taxproduct
1507 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1512 sub _restore_remembered_tax_products {
1513 my ( $job, $format, $taxproduct ) = @_;
1517 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1518 my $count = scalar(keys %$taxproduct);
1519 foreach my $pkgpart ( keys %$taxproduct ) {
1520 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1521 if ( time - $min_sec > $last ) {
1522 $job->update_statustext(
1523 int( 100 * $imported / $count ). ",Restoring tax products"
1529 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1530 unless ( $part_pkg ) {
1531 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1534 my %options = $part_pkg->options;
1535 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1536 my $primary_svc = $part_pkg->svcpart;
1537 my $new = new FS::part_pkg { $part_pkg->hash };
1539 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1540 warn "working with class '$class'\n" if $DEBUG;
1541 my $part_pkg_taxproduct =
1542 qsearchs( 'part_pkg_taxproduct',
1543 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1544 data_vendor => $format,
1548 unless ( $part_pkg_taxproduct ) {
1549 return "failed to find part_pkg_taxproduct (".
1550 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1553 if ( $class eq '' ) {
1554 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1558 $options{"usage_taxproductnum_$class"} =
1559 $part_pkg_taxproduct->taxproductnum;
1563 my $error = $new->replace( $part_pkg,
1564 'pkg_svc' => \%pkg_svc,
1565 'primary_svc' => $primary_svc,
1566 'options' => \%options,
1569 return $error if $error;
1576 sub _restore_remembered_disabled_taxes {
1577 my ( $job, $format, $disabled_tax_rate ) = @_;
1579 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1580 my $count = scalar(keys %$disabled_tax_rate);
1581 foreach my $key (keys %$disabled_tax_rate) {
1582 if ( time - $min_sec > $last ) {
1583 $job->update_statustext(
1584 int( 100 * $imported / $count ). ",Disabling tax rates"
1589 my ($geocode,$taxclass) = split /:/, $key, 2;
1590 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1591 taxclass => $taxclass,
1593 return "found multiple tax_class records for format $format class $taxclass"
1594 if scalar(@tax_class) > 1;
1596 unless (scalar(@tax_class)) {
1597 warn "no tax_class for format $format class $taxclass\n";
1602 qsearch('tax_rate', { data_vendor => $format,
1603 geocode => $geocode,
1604 taxclassnum => $tax_class[0]->taxclassnum,
1608 if (scalar(@tax_rate) > 1) {
1609 return "found multiple tax_rate records for format $format geocode ".
1610 "$geocode and taxclass $taxclass ( taxclassnum ".
1611 $tax_class[0]->taxclassnum. " )";
1614 if (scalar(@tax_rate)) {
1615 $tax_rate[0]->disabled('Y');
1616 my $error = $tax_rate[0]->replace;
1617 return $error if $error;
1622 sub _remove_old_tax_data {
1623 my ( $job, $format ) = @_;
1626 my $error = $job->update_statustext( "0,Removing old tax data" );
1627 die $error if $error;
1629 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1630 "WHERE data_vendor = ". $dbh->quote($format);
1631 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1634 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1636 foreach my $table ( @table ) {
1637 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1638 $dbh->quote($format);
1639 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1642 if ( $format eq 'cch' ) {
1643 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1644 $dbh->quote("$format-zip");
1645 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1651 sub _create_temporary_tables {
1652 my ( $job, $format ) = @_;
1655 my $error = $job->update_statustext( "0,Creating temporary tables" );
1656 die $error if $error;
1658 my @table = qw( tax_rate
1665 foreach my $table ( @table ) {
1667 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1668 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1674 sub _copy_from_temp {
1675 my ( $job, $format ) = @_;
1678 my $error = $job->update_statustext( "0,Making permanent" );
1679 die $error if $error;
1681 my @table = qw( tax_rate
1688 foreach my $table ( @table ) {
1690 "INSERT INTO public.$table SELECT * from $table";
1691 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1697 =item process_download_and_reload
1699 Download and process a tax update as a queued JSRPC job after wiping the
1700 existing wipeable tax data.
1704 sub process_download_and_reload {
1705 _process_reload(\&process_download_and_update, @_);
1714 =item process_batch_reload
1716 Load and process a tax update from the provided files as a queued JSRPC job
1717 after wiping the existing wipable tax data.
1721 sub process_batch_reload {
1722 _process_reload(\&_perform_batch_import, @_);
1725 sub _process_reload {
1726 my ( $continuation, $job, $param ) = @_;
1727 my $format = $param->{'format'};
1729 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1731 if ( $job ) { # progress bar
1732 my $error = $job->update_statustext( 0 );
1733 die $error if $error;
1736 my $oldAutoCommit = $FS::UID::AutoCommit;
1737 local $FS::UID::AutoCommit = 0;
1741 if ( $format =~ /^cch/ ) {
1742 # no, THIS part is CCH specific
1745 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1746 "USING (taxclassnum) WHERE data_vendor = '$format'";
1747 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1749 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1750 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1751 if $sth->fetchrow_arrayref->[0];
1753 # really should get a table EXCLUSIVE lock here
1755 #remember disabled taxes
1756 my %disabled_tax_rate = ();
1757 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1759 #remember tax products
1760 my %taxproduct = ();
1761 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1764 $error ||= _create_temporary_tables( $job, $format );
1768 eval { &{$continuation}( $job, $param ) };
1772 #restore taxproducts
1773 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1777 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1779 #wipe out the old data
1780 $error ||= _remove_old_tax_data( $job, $format );
1783 $error ||= _copy_from_temp( $job, $format );
1785 } elsif ( $format =~ /^billsoft-(\w+)/ ) {
1789 if ( $mode eq 'pcode' ) {
1791 "DELETE FROM cust_tax_location WHERE data_vendor = 'billsoft'",
1792 "UPDATE tax_rate_location SET disabled = 'Y' WHERE data_vendor = 'billsoft'";
1793 } elsif ( $mode eq 'taxclass' ) {
1795 "DELETE FROM tax_class WHERE data_vendor = 'billsoft'";
1796 } elsif ( $mode eq 'taxproduct' ) {
1798 "DELETE FROM part_pkg_taxproduct WHERE data_vendor = 'billsoft'";
1802 if (!$dbh->do($_)) {
1803 $error = $dbh->errstr;
1810 eval { &{ $continuation }($job, $param) };
1813 } # if ($format ...)
1816 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1821 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1825 =item process_download_and_update
1827 Download and process a tax update as a queued JSRPC job
1831 sub process_download_and_update {
1835 my $format = $param->{'format'}; #well... this is all cch specific
1837 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1839 if ( $job ) { # progress bar
1840 my $error = $job->update_statustext( 0);
1841 die $error if $error;
1844 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1845 my $dir = $cache_dir. 'taxdata';
1847 mkdir $dir or die "can't create $dir: $!\n";
1850 if ($format eq 'cch') {
1852 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1854 my $conf = new FS::Conf;
1855 die "direct download of tax data not enabled\n"
1856 unless $conf->exists('taxdatadirectdownload');
1857 my ( $urls, $username, $secret, $states ) =
1858 $conf->config('taxdatadirectdownload');
1859 die "No tax download URL provided. ".
1860 "Did you set the taxdatadirectdownload configuration value?\n"
1868 # really should get a table EXCLUSIVE lock here
1869 # check if initial import or update
1871 # relying on mkdir "$dir.new" as a mutex
1873 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1874 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1875 $sth->execute() or die $sth->errstr;
1876 my $update = $sth->fetchrow_arrayref->[0];
1878 # create cache and/or rotate old tax data
1883 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1884 foreach my $file (readdir($dirh)) {
1885 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1891 for (8, 7, 6, 5, 4, 3, 2, 1) {
1892 if ( -e "$dir.$_" ) {
1893 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1896 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1900 die "can't find previous tax data\n" if $update;
1904 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1906 # fetch and unpack the zip files
1908 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1910 # extract csv files from the dbf files
1912 foreach my $name ( @namelist ) {
1913 _cch_extract_csv_from_dbf( $job, $dir, $name );
1916 # generate the diff files
1919 foreach my $name ( @namelist ) {
1920 my $difffile = "$dir.new/$name.txt";
1922 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1923 die $error if $error;
1924 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1925 my $olddir = $update ? "$dir.1" : "";
1926 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1928 $difffile =~ s/^$cache_dir//;
1929 push @list, "${name}file:$difffile";
1932 # perform the import
1933 local $keep_cch_files = 1;
1934 $param->{uploaded_files} = join( ',', @list );
1935 $param->{format} .= '-update' if $update;
1937 _perform_batch_import( $job, $param );
1939 rename "$dir.new", "$dir"
1940 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1943 die "Unknown format: $format";
1947 =item browse_queries PARAMS
1949 Returns a list consisting of a hashref suited for use as the argument
1950 to qsearch, and sql query string. Each is based on the PARAMS hashref
1951 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1952 from a form. This conveniently creates the query hashref and count_query
1953 string required by the browse and search elements. As a side effect,
1954 the PARAMS hashref is untainted and keys with unexpected values are removed.
1958 sub browse_queries {
1962 'table' => 'tax_rate',
1964 'order_by' => 'ORDER BY geocode, taxclassnum',
1969 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1970 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1972 delete $params->{data_vendor};
1975 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1976 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1977 'geocode LIKE '. dbh->quote($1.'%');
1979 delete $params->{geocode};
1982 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1983 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1986 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1987 ' taxclassnum = '. dbh->quote($1)
1989 delete $params->{taxclassnun};
1993 if ( $params->{tax_type} =~ /^(\d+)$/ );
1994 delete $params->{tax_type}
1998 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1999 delete $params->{tax_cat}
2002 my @taxclassnum = ();
2003 if ($tax_type || $tax_cat ) {
2004 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
2005 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
2006 @taxclassnum = map { $_->taxclassnum }
2007 qsearch({ 'table' => 'tax_class',
2009 'extra_sql' => "WHERE taxclass $compare",
2013 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
2014 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
2015 if ( @taxclassnum );
2017 unless ($params->{'showdisabled'}) {
2018 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
2019 "( disabled = '' OR disabled IS NULL )";
2022 $query->{extra_sql} = $extra_sql;
2024 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
2027 =item queue_liability_report PARAMS
2029 Launches a tax liability report.
2031 PARAMS needs to be a base64-encoded Storable hash containing:
2032 - beginning: the start date, as a I<user-readable string> (not a timestamp).
2033 - end: the end date of the report, likewise.
2034 - agentnum: the agent to limit the report to, if any.
2038 sub queue_liability_report {
2043 $cgi->param('beginning', $param->{beginning});
2044 $cgi->param('ending', $param->{ending});
2045 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
2046 my $agentnum = $param->{agentnum};
2047 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
2048 generate_liability_report(
2049 'beginning' => $beginning,
2050 'ending' => $ending,
2051 'agentnum' => $agentnum,
2052 'p' => $param->{RootURL},
2057 =item generate_liability_report PARAMS
2059 Generates a tax liability report. PARAMS must include:
2061 - beginning, as a timestamp
2062 - ending, as a timestamp
2063 - p: the Freeside root URL, for generating links
2064 - agentnum (optional)
2068 #shit, all sorts of false laxiness w/report_newtax.cgi
2069 sub generate_liability_report {
2072 my ( $count, $last, $min_sec ) = _progressbar_foo();
2074 #let us open the temp file early
2075 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
2076 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
2078 UNLINK => 0, # not so temp
2079 ) or die "can't open report file: $!\n";
2081 my $conf = new FS::Conf;
2082 my $money_char = $conf->config('money_char') || '$';
2085 JOIN cust_bill USING ( invnum )
2086 LEFT JOIN cust_main USING ( custnum )
2090 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
2091 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
2093 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
2095 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
2098 if ( $args{agentnum} =~ /^(\d+)$/ ) {
2099 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
2100 die "agent not found" unless $agent;
2101 $agentname = $agent->agent;
2102 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
2105 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
2106 my @taxparams = qw( city county state locationtaxid );
2107 my @params = ('itemdesc', @taxparams);
2109 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
2111 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
2112 #to FS::Report or FS::Record or who the fuck knows where)
2113 my $scalar_sql = sub {
2114 my( $r, $param, $sql ) = @_;
2115 my $sth = dbh->prepare($sql) or die dbh->errstr;
2116 $sth->execute( map $r->$_(), @$param )
2117 or die "Unexpected error executing statement $sql: ". $sth->errstr;
2118 $sth->fetchrow_arrayref->[0] || 0;
2127 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
2128 # for taxes that have been charged
2129 # (state, county, city are from tax_rate_location, not from customer data)
2130 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
2132 hashref => { pkgpart => 0 },
2133 addl_from => $addl_from,
2134 extra_sql => $where,
2137 $count = scalar(@tax_and_location);
2138 foreach my $t ( @tax_and_location ) {
2141 if ( time - $min_sec > $last ) {
2142 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2149 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
2150 my $label = join('~', map { $t->$_ } @params);
2151 $label = 'Tax'. $label if $label =~ /^~/;
2152 unless ( exists( $taxes{$label} ) ) {
2153 my ($baselabel, @trash) = split /~/, $label;
2155 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
2156 $taxes{$label}->{'url_param'} =
2157 join(';', map { "$_=". uri_escape($t->$_) } @params);
2160 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
2161 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
2166 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
2168 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
2170 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2172 $taxes{$label}->{'tax'} += $x;
2175 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2177 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2179 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2180 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2182 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2184 $taxes{$label}->{'credit'} += $y;
2186 unless ( exists( $taxes{$baselabel} ) ) {
2188 $basetaxes{$baselabel}->{'label'} = $baselabel;
2189 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2190 $basetaxes{$baselabel}->{'base'} = 1;
2194 $basetaxes{$baselabel}->{'tax'} += $x;
2195 $basetaxes{$baselabel}->{'credit'} += $y;
2199 # calculate customer-exemption for this tax
2200 # calculate package-exemption for this tax
2201 # calculate monthly exemption (texas tax) for this tax
2202 # count up all the cust_tax_exempt_pkg records associated with
2203 # the actual line items.
2210 $args{job}->update_statustext( "0,Sorted" );
2216 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2217 my ($base, @trash) = split '~', $tax;
2218 my $basetax = delete( $basetaxes{$base} );
2220 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2221 $taxes{$tax}->{base} = 1;
2223 push @taxes, $basetax;
2226 push @taxes, $taxes{$tax};
2233 'credit' => $credit,
2238 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2239 $dateagentlink .= ';agentnum='. $args{agentnum}
2240 if length($agentname);
2241 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2243 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2245 print $report <<EOF;
2247 <% include("/elements/header.html", "$agentname Tax Report - ".
2249 ? time2str('%h %o %Y ', $args{beginning} )
2253 ( $args{ending} == 4294967295
2255 : time2str('%h %o %Y', $args{ending} )
2260 <% include('/elements/table-grid.html') %>
2263 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2264 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2265 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2266 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2267 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2268 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2272 my $bgcolor1 = '#eeeeee';
2273 my $bgcolor2 = '#ffffff';
2276 $count = scalar(@taxes);
2278 foreach my $tax ( @taxes ) {
2281 if ( time - $min_sec > $last ) {
2282 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2289 if ( $bgcolor eq $bgcolor1 ) {
2290 $bgcolor = $bgcolor2;
2292 $bgcolor = $bgcolor1;
2296 if ( $tax->{'label'} ne 'Total' ) {
2297 $link = ';'. $tax->{'url_param'};
2300 print $report <<EOF;
2302 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2303 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2304 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2305 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2307 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2308 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2309 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2310 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2311 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2313 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2318 print $report <<EOF;
2325 my $reportname = $report->filename;
2328 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2329 $reportname =~ s/^$dropstring//;
2331 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2332 die "<a href=$reporturl>view</a>\n";
2342 Highly specific to CCH taxes. This should arguably go in some kind of
2343 subclass (FS::tax_rate::CCH) with auto-reblessing, similar to part_pkg
2344 subclasses. But currently there aren't any other options, so.
2346 Mixing automatic and manual editing works poorly at present.
2348 Tax liability calculations take too long and arguably don't belong here.
2349 Tax liability report generation not entirely safe (escaped).
2351 Sparse documentation.
2355 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>