4 use vars qw( @ISA $DEBUG $me
5 %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
6 %tax_passtypes %GetInfoType $keep_cch_files );
9 use DateTime::Format::Strptime;
10 use Storable qw( thaw nfreeze );
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 );
35 @ISA = qw( FS::Record );
38 $me = '[FS::tax_rate]';
43 FS::tax_rate - Object methods for tax_rate objects
49 $record = new FS::tax_rate \%hash;
50 $record = new FS::tax_rate { 'column' => 'value' };
52 $error = $record->insert;
54 $error = $new_record->replace($old_record);
56 $error = $record->delete;
58 $error = $record->check;
62 An FS::tax_rate object represents a tax rate, defined by locale.
63 FS::tax_rate inherits from FS::Record. The following fields are
70 primary key (assigned automatically for new tax rates)
74 a geographic location code provided by a tax data vendor
82 a location code provided by a tax authority
86 a foreign key into FS::tax_class - the type of tax
87 referenced but FS::part_pkg_taxrate
90 the time after which the tax applies
98 second bracket percentage
102 the amount to which the tax applies (first bracket)
106 a cap on the amount of tax if a cap exists
110 percentage on out of jurisdiction purchases
114 second bracket percentage on out of jurisdiction purchases
118 one of the values in %tax_unittypes
122 amount of tax per unit
126 second bracket amount of tax per unit
130 the number of units to which the fee applies (first bracket)
134 the most units to which fees apply (first and second brackets)
138 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
142 if defined, printed on invoices instead of "Tax"
146 a value from %tax_authorities
150 a value from %tax_basetypes indicating the tax basis
154 a value from %tax_passtypes indicating how the tax should displayed to the customer
158 'Y', 'N', or blank indicating the tax can be passed to the customer
162 if 'Y', this tax does not apply to setup fees
166 if 'Y', this tax does not apply to recurring fees
170 if 'Y', has been manually edited
180 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
184 sub table { 'tax_rate'; }
188 Adds this tax rate to the database. If there is an error, returns the error,
189 otherwise returns false.
193 Deletes this tax rate from the database. If there is an error, returns the
194 error, otherwise returns false.
196 =item replace OLD_RECORD
198 Replaces the OLD_RECORD with this one in the database. If there is an error,
199 returns the error, otherwise returns false.
203 Checks all fields to make sure this is a valid tax rate. If there is an error,
204 returns the error, otherwise returns false. Called by the insert and replace
212 foreach (qw( taxbase taxmax )) {
213 $self->$_(0) unless $self->$_;
216 $self->ut_numbern('taxnum')
217 || $self->ut_text('geocode')
218 || $self->ut_textn('data_vendor')
219 || $self->ut_cch_textn('location')
220 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
221 || $self->ut_snumbern('effective_date')
222 || $self->ut_float('tax')
223 || $self->ut_floatn('excessrate')
224 || $self->ut_money('taxbase')
225 || $self->ut_money('taxmax')
226 || $self->ut_floatn('usetax')
227 || $self->ut_floatn('useexcessrate')
228 || $self->ut_numbern('unittype')
229 || $self->ut_floatn('fee')
230 || $self->ut_floatn('excessfee')
231 || $self->ut_floatn('feemax')
232 || $self->ut_numbern('maxtype')
233 || $self->ut_textn('taxname')
234 || $self->ut_numbern('taxauth')
235 || $self->ut_numbern('basetype')
236 || $self->ut_numbern('passtype')
237 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
238 || $self->ut_enum('setuptax', [ '', 'Y' ] )
239 || $self->ut_enum('recurtax', [ '', 'Y' ] )
240 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
241 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
242 || $self->ut_enum('manual', [ '', 'Y' ] )
243 || $self->ut_enum('disabled', [ '', 'Y' ] )
244 || $self->SUPER::check
249 #ut_text / ut_textn w/ ` added cause now that's in the data
252 $self->getfield($field)
253 =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
254 or return gettext('illegal_or_empty_text'). " $field: ".
255 $self->getfield($field);
256 $self->setfield($field,$1);
261 =item taxclass_description
263 Returns the human understandable value associated with the related
268 sub taxclass_description {
270 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
271 $tax_class ? $tax_class->description : '';
276 Returns the human understandable value associated with the unittype column
280 %tax_unittypes = ( '0' => 'access line',
287 $tax_unittypes{$self->unittype};
292 Returns the human understandable value associated with the maxtype column.
296 # XXX these are non-functional, and most of them are horrible to implement
297 # in our current model
299 %tax_maxtypes = ( '0' => 'receipts per invoice',
300 '1' => 'receipts per item',
301 '2' => 'total utility charges per utility tax year',
302 '3' => 'total charges per utility tax year',
303 '4' => 'receipts per access line',
304 '7' => 'total utility charges per calendar year',
305 '9' => 'monthly receipts per location',
306 '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
307 '11' => 'receipts/units per access line',
308 '14' => 'units per invoice',
309 '15' => 'units per month',
310 '18' => 'units per account',
315 $tax_maxtypes{$self->maxtype};
320 Returns the human understandable value associated with the basetype column
324 %tax_basetypes = ( '0' => 'sale price',
325 '1' => 'gross receipts',
326 '2' => 'sales taxable telecom revenue',
327 '3' => 'minutes carried',
328 '4' => 'minutes billed',
329 '5' => 'gross operating revenue',
330 '6' => 'access line',
332 '8' => 'gross revenue',
333 '9' => 'portion gross receipts attributable to interstate service',
334 '10' => 'access line',
335 '11' => 'gross profits',
336 '12' => 'tariff rate',
338 '15' => 'prior year gross receipts',
343 $tax_basetypes{$self->basetype};
348 Returns the human understandable value associated with the taxauth column
352 %tax_authorities = ( '0' => 'federal',
357 '5' => 'county administered by state',
358 '6' => 'city administered by state',
359 '7' => 'city administered by county',
360 '8' => 'local administered by state',
361 '9' => 'local administered by county',
366 $tax_authorities{$self->taxauth};
371 Returns the human understandable value associated with the passtype column
375 %tax_passtypes = ( '0' => 'separate tax line',
376 '1' => 'separate surcharge line',
377 '2' => 'surcharge not separated',
378 '3' => 'included in base rate',
383 $tax_passtypes{$self->passtype};
386 #Returns a listref of a name and an amount of tax calculated for the list
387 #of packages/amounts referenced by TAXABLES. If an error occurs, a message
388 #is returned as a scalar.
390 =item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ]
392 Takes an arrayref of L<FS::cust_bill_pkg> objects representing taxable
393 line items, and returns some number of new L<FS::cust_bill_pkg> objects
394 representing the tax on them under this tax rate. Each returned object
395 will correspond to a single input line item.
397 For accurate calculation of per-customer or per-location taxes, ALL items
398 appearing on the invoice MUST be passed to this method together.
400 Optionally, any of the L<FS::cust_bill_pkg> objects may be followed in the
401 array by a charge class: 'setup', 'recur', '' (for unclassified usage), or an
402 integer denoting an L<FS::usage_class> number. In this case, the tax will
403 only be charged on that portion of the line item.
405 Each returned object will have a pseudo-field,
406 "cust_bill_pkg_tax_rate_location", containing a single
407 L<FS::cust_bill_pkg_tax_rate_location> object. This will in turn
408 have a "taxable_cust_bill_pkg" pseudo-field linking it to one of the taxable
409 items. All of these links must be resolved as the objects are inserted.
411 If the tax is disabled, this method will return nothing. Be prepared for
414 In addition to calculating the tax for the line items, this will calculate
415 tax exemptions and attach them to the line items. I<Currently this only
416 supports customer exemptions.>
418 Options may include 'custnum' and 'invoice_time' in case the cust_bill_pkg
419 objects belong to an invoice that hasn't been inserted yet.
421 The 'exemptions' option allowed in L<FS::cust_main_county::taxline> does
422 nothing here, since monthly exemptions aren't supported.
427 my( $self, $taxables, %opt) = @_;
428 $taxables = [ $taxables ] unless ref($taxables) eq 'ARRAY';
430 my $name = $self->taxname;
431 $name = 'Other surcharges'
432 if ($self->passtype == 2);
435 return unless @$taxables; # nothing to do
436 return if $self->disabled; # tax is disabled, skip it
437 return if $self->passflag eq 'N'; # tax can't be passed to the customer
438 # but should probably still appear on the liability report--create a
439 # cust_tax_exempt_pkg record for it?
441 # XXX a certain amount of false laziness with FS::cust_main_county
442 my $cust_bill = $taxables->[0]->cust_bill;
443 my $custnum = $cust_bill ? $cust_bill->custnum : $opt{'custnum'};
444 my $cust_main = FS::cust_main->by_key($custnum) if $custnum > 0;
446 die "unable to calculate taxes for an unknown customer\n";
449 my $taxratelocationnum = $self->tax_rate_location->taxratelocationnum
450 or die "no tax_rate_location linked to tax_rate #".$self->taxnum."\n";
452 warn "calculating taxes for ". $self->taxnum. " on ".
453 join (",", map { $_->pkgnum } @$taxables)
456 my $maxtype = $self->maxtype || 0;
457 if ($maxtype != 0 && $maxtype != 1
458 && $maxtype != 14 && $maxtype != 15
459 && $maxtype != 18 # sigh
461 return $self->_fatal_or_null( 'tax with "'.
462 $self->maxtype_name. '" threshold'
464 } # I don't know why, it's not like there are maxtypes that we DO support
466 # we treat gross revenue as gross receipts and expect the tax data
467 # to DTRT (i.e. tax on tax rules)
468 if ($self->basetype != 0 && $self->basetype != 1 &&
469 $self->basetype != 5 && $self->basetype != 6 &&
470 $self->basetype != 7 && $self->basetype != 8 &&
471 $self->basetype != 14
474 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
478 my %seen; # locationnum or pkgnum => 1
480 my $taxable_cents = 0;
481 my $taxable_units = 0;
485 my $cust_bill_pkg = shift @$taxables;
487 if ( defined($taxables->[0]) and !ref($taxables->[0]) ) {
488 $class = shift @$taxables;
491 my %usage_map = map { $_ => $cust_bill_pkg->usage($_) }
492 $cust_bill_pkg->usage_classes;
493 my $usage_total = sum( values(%usage_map), 0 );
495 # determine if the item has exemptions that apply to this tax def
496 my @exemptions = grep { $_->taxnum == $self->taxnum }
497 @{ $cust_bill_pkg->cust_tax_exempt_pkg };
499 if ( $self->tax > 0 ) {
501 my $taxable_charged = 0;
502 if ($class eq 'all') {
503 $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur;
504 } elsif ($class eq 'setup') {
505 $taxable_charged = $cust_bill_pkg->setup;
506 } elsif ($class eq 'recur') {
507 $taxable_charged = $cust_bill_pkg->recur - $usage_total;
509 $taxable_charged = $usage_map{$class} || 0;
512 foreach my $ex (@exemptions) {
513 # the only cases where the exemption doesn't apply:
514 # if it's a setup exemption and $class is not 'setup' or 'all'
515 # if it's a recur exemption and $class is 'setup'
516 if ( ( $ex->exempt_recur and $class eq 'setup' )
517 or ( $ex->exempt_setup and $class ne 'setup' and $class ne 'all' )
522 $taxable_charged -= $ex->amount;
524 # cust_main_county handles monthly capped exemptions; this doesn't.
526 # $taxable_charged can also be less than zero at this point
527 # (recur exemption + usage class breakdown); treat that as zero.
528 next if $taxable_charged <= 0;
530 # yeah, some false laziness with cust_main_county
531 my $this_tax_cents = int(100 * $taxable_charged * $self->tax);
532 my $tax_location = FS::cust_bill_pkg_tax_rate_location->new({
533 'taxnum' => $self->taxnum,
534 'taxtype' => ref($self),
535 'cents' => $this_tax_cents, # not a real field
536 'locationtaxid' => $self->location, # fundamentally silly
537 'taxable_cust_bill_pkg' => $cust_bill_pkg,
538 'taxratelocationnum' => $taxratelocationnum,
539 'taxclass' => $class,
541 push @tax_locations, $tax_location;
543 $taxable_cents += 100 * $taxable_charged;
544 $tax_cents += $this_tax_cents;
546 } elsif ( $self->fee > 0 ) {
547 # most CCH taxes are this type, because nearly every county has a 911
551 # since we don't support partial exemptions (except setup/recur),
552 # if there's an exemption that applies to this package and taxrate,
553 # don't charge ANY per-unit fees
556 # don't apply fees to usage classes (maybe if we ever get per-minute
558 next unless $class eq 'setup'
562 if ( $self->unittype == 0 ) {
563 if ( !$seen{$cust_bill_pkg->pkgnum} ) {
565 $units = $cust_bill_pkg->units;
566 $seen{$cust_bill_pkg->pkgnum} = 1;
567 } # else it's been seen, leave it at zero units
569 } elsif ($self->unittype == 1) { # per minute
570 # STILL not supported...fortunately these only exist if you happen
571 # to be in Idaho or Little Rock, Arkansas
573 # though a voip_cdr package could easily report minutes of usage...
574 return $self->_fatal_or_null( 'fee with minute unit type' );
576 } elsif ( $self->unittype == 2 ) {
578 my $locationnum = $cust_bill_pkg->tax_locationnum
579 || $cust_main->ship_locationnum;
581 $units = 1 unless $seen{$locationnum};
582 $seen{$locationnum} = 1;
585 # Unittype 19 is used for prepaid wireless E911 charges in many states.
586 # Apparently "per retail purchase", which for us would mean per invoice.
587 # Unittype 20 is used for some 911 surcharges and I have no idea what
589 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
591 my $this_tax_cents = int($units * $self->fee * 100);
592 my $tax_location = FS::cust_bill_pkg_tax_rate_location->new({
593 'taxnum' => $self->taxnum,
594 'taxtype' => ref($self),
595 'cents' => $this_tax_cents,
596 'locationtaxid' => $self->location,
597 'taxable_cust_bill_pkg' => $cust_bill_pkg,
598 'taxratelocationnum' => $taxratelocationnum,
599 'taxclass' => $class,
601 push @tax_locations, $tax_location;
603 $taxable_units += $units;
604 $tax_cents += $this_tax_cents;
607 } # foreach $cust_bill_pkg
609 # check bracket maxima; throw an error if we've gone over, because
610 # we don't really implement them
612 if ( ($self->taxmax > 0 and $taxable_cents > $self->taxmax*100 ) or
613 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
615 # (why not just cap taxable_charged/units at the taxmax/feemax? because
616 # it's way more complicated than that. this won't even catch every case
617 # where a bracket maximum should apply.)
618 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
621 # round and distribute
622 my $total_tax_cents = sprintf('%.0f',
623 ($taxable_cents * $self->tax) + ($taxable_units * $self->fee * 100)
625 my $extra_cents = sprintf('%.0f', $total_tax_cents - $tax_cents);
626 $tax_cents += $extra_cents;
628 foreach (@tax_locations) { # can never require more than a single pass, yes?
629 my $cents = $_->get('cents');
630 if ( $extra_cents > 0 ) {
634 $_->set('amount', sprintf('%.2f', $cents/100));
637 # just transform each CBPTRL record into a tax line item.
638 # calculate_taxes will consolidate them, but before that happens we have
639 # to do tax on tax calculation.
641 foreach (@tax_locations) {
642 next if $_->amount == 0;
643 my $tax_item = FS::cust_bill_pkg->new({
646 'setup' => $_->amount,
647 'sdate' => '', # $_->sdate?
650 'cust_bill_pkg_tax_rate_location' => [ $_ ],
651 # Make the charge class easily accessible; we need it for tax-on-tax
652 # applicability. RT#36830.
653 '_class' => $_->taxclass,
655 $_->set('tax_cust_bill_pkg' => $tax_item);
656 push @tax_items, $tax_item;
663 my ($self, $error) = @_;
665 $DB::single = 1; # not a mistake
667 my $conf = new FS::Conf;
669 $error = "can't yet handle ". $error;
670 my $name = $self->taxname;
671 $name = 'Other surcharges'
672 if ($self->passtype == 2);
674 if ($conf->exists('ignore_incalculable_taxes')) {
675 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
676 return { name => $name, amount => 0 };
678 return "fatal: $error";
682 =item tax_on_tax CUST_LOCATION
684 Returns a list of taxes which are candidates for taxing taxes for the
685 given service location (see L<FS::cust_location>)
693 my $cust_location = shift;
695 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
696 $cust_location->custnum
699 my $geocode = $cust_location->geocode($self->data_vendor);
703 my $extra_sql = ' AND ('.
704 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
709 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
710 my $select = 'DISTINCT ON(taxclassnum) *';
712 # should qsearch preface columns with the table to facilitate joins?
713 my @taxclassnums = map { $_->taxclassnum }
714 qsearch( { 'table' => 'part_pkg_taxrate',
716 'hashref' => { 'data_vendor' => $self->data_vendor,
717 'taxclassnumtaxed' => $self->taxclassnum,
719 'extra_sql' => $extra_sql,
720 'order_by' => $order_by,
723 return () unless @taxclassnums;
726 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
728 qsearch({ 'table' => 'tax_rate',
729 'hashref' => { 'geocode' => $geocode, },
730 'extra_sql' => $extra_sql,
735 =item tax_rate_location
737 Returns an object representing the location associated with this tax
738 (see L<FS::tax_rate_location>)
742 sub tax_rate_location {
745 qsearchs({ 'table' => 'tax_rate_location',
746 'hashref' => { 'data_vendor' => $self->data_vendor,
747 'geocode' => $self->geocode,
751 new FS::tax_rate_location;
765 sub _progressbar_foo {
770 my ($param, $job) = @_;
772 my $fh = $param->{filehandle};
773 my $format = $param->{'format'};
781 my @column_lengths = ();
782 my @column_callbacks = ();
783 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
784 $format =~ s/-fixed//;
785 my $date_format = sub { my $r='';
786 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
789 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
790 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 );
791 push @column_lengths, 1 if $format eq 'cch-update';
792 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
793 $column_callbacks[8] = $date_format;
797 my ( $count, $last, $min_sec ) = _progressbar_foo();
798 if ( $job || scalar(@column_callbacks) ) {
800 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
801 return $error if $error;
805 if ( $format eq 'cch' || $format eq 'cch-update' ) {
806 #false laziness w/below (sub _perform_cch_diff)
807 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
808 excessrate effective_date taxauth taxtype taxcat taxname
809 usetax useexcessrate fee unittype feemax maxtype passflag
811 push @fields, 'actionflag' if $format eq 'cch-update';
816 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
817 $hash->{'data_vendor'} ='cch';
818 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
819 time_zone => 'floating',
821 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
822 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
824 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
825 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
828 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
830 my %tax_class = ( 'data_vendor' => 'cch',
831 'taxclass' => $taxclassid,
834 my $tax_class = qsearchs( 'tax_class', \%tax_class );
835 return "Error updating tax rate: no tax class $taxclassid"
838 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
840 foreach (qw( taxtype taxcat )) {
844 my %passflagmap = ( '0' => '',
848 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
849 if exists $passflagmap{$hash->{'passflag'}};
851 foreach (keys %$hash) {
852 $hash->{$_} = substr($hash->{$_}, 0, 80)
853 if length($hash->{$_}) > 80;
856 my $actionflag = delete($hash->{'actionflag'});
858 $hash->{'taxname'} =~ s/`/'/g;
859 $hash->{'taxname'} =~ s|\\|/|g;
861 return '' if $format eq 'cch'; # but not cch-update
863 if ($actionflag eq 'I') {
864 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
865 }elsif ($actionflag eq 'D') {
866 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
868 return "Unexpected action flag: ". $hash->{'actionflag'};
871 delete($hash->{$_}) for keys %$hash;
877 } elsif ( $format eq 'extended' ) {
878 die "unimplemented\n";
882 die "unknown format $format";
885 my $csv = new Text::CSV_XS;
889 local $SIG{HUP} = 'IGNORE';
890 local $SIG{INT} = 'IGNORE';
891 local $SIG{QUIT} = 'IGNORE';
892 local $SIG{TERM} = 'IGNORE';
893 local $SIG{TSTP} = 'IGNORE';
894 local $SIG{PIPE} = 'IGNORE';
896 my $oldAutoCommit = $FS::UID::AutoCommit;
897 local $FS::UID::AutoCommit = 0;
900 while ( defined($line=<$fh>) ) {
901 $csv->parse($line) or do {
902 $dbh->rollback if $oldAutoCommit;
903 return "can't parse: ". $csv->error_input();
906 if ( $job ) { # progress bar
907 if ( time - $min_sec > $last ) {
908 my $error = $job->update_statustext(
909 int( 100 * $imported / $count ). ",Importing tax rates"
912 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
919 my @columns = $csv->fields();
921 my %tax_rate = ( 'data_vendor' => $format );
922 foreach my $field ( @fields ) {
923 $tax_rate{$field} = shift @columns;
926 if ( scalar( @columns ) ) {
927 $dbh->rollback if $oldAutoCommit;
928 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
931 my $error = &{$hook}(\%tax_rate);
933 $dbh->rollback if $oldAutoCommit;
937 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
939 my $tax_rate = new FS::tax_rate( \%tax_rate );
940 $error = $tax_rate->insert;
943 $dbh->rollback if $oldAutoCommit;
944 return "can't insert tax_rate for $line: $error";
953 my @replace = grep { exists($delete{$_}) } keys %insert;
955 if ( $job ) { # progress bar
956 if ( time - $min_sec > $last ) {
957 my $error = $job->update_statustext(
958 int( 100 * $imported / $count ). ",Importing tax rates"
961 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
968 my $old = qsearchs( 'tax_rate', $delete{$_} );
972 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
973 $new->taxnum($old->taxnum);
974 my $error = $new->replace($old);
977 $dbh->rollback if $oldAutoCommit;
978 my $hashref = $insert{$_};
979 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
980 return "can't replace tax_rate for $line: $error";
987 $old = delete $delete{$_};
988 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
989 #join(" ", map { "$_ => ". $old->{$_} } @fields);
990 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
996 for (grep { !exists($delete{$_}) } keys %insert) {
997 if ( $job ) { # progress bar
998 if ( time - $min_sec > $last ) {
999 my $error = $job->update_statustext(
1000 int( 100 * $imported / $count ). ",Importing tax rates"
1003 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1010 my $tax_rate = new FS::tax_rate( $insert{$_} );
1011 my $error = $tax_rate->insert;
1014 $dbh->rollback if $oldAutoCommit;
1015 my $hashref = $insert{$_};
1016 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1017 return "can't insert tax_rate for $line: $error";
1023 for (grep { !exists($insert{$_}) } keys %delete) {
1024 if ( $job ) { # progress bar
1025 if ( time - $min_sec > $last ) {
1026 my $error = $job->update_statustext(
1027 int( 100 * $imported / $count ). ",Importing tax rates"
1030 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1037 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
1039 $dbh->rollback if $oldAutoCommit;
1040 $tax_rate = $delete{$_};
1041 warn "WARNING: can't find tax_rate to delete for: ".
1042 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
1045 my $error = $tax_rate->delete; # XXX we really should not do this
1046 # (it orphans CBPTRL records)
1049 $dbh->rollback if $oldAutoCommit;
1050 my $hashref = $delete{$_};
1051 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1052 return "can't delete tax_rate for $line: $error";
1059 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1061 return "Empty file!" unless ($imported || $format eq 'cch-update');
1067 =item process_batch_import
1069 Load a batch import as a queued JSRPC job
1073 sub process_batch_import {
1076 my $oldAutoCommit = $FS::UID::AutoCommit;
1077 local $FS::UID::AutoCommit = 0;
1080 my $param = thaw(decode_base64(shift));
1081 my $args = '$job, encode_base64( nfreeze( $param ) )';
1083 my $method = '_perform_batch_import';
1084 if ( $param->{reload} ) {
1085 $method = 'process_batch_reload';
1088 eval "$method($args);";
1090 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1095 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1098 sub _perform_batch_import {
1101 my $param = thaw(decode_base64(shift));
1102 my $format = $param->{'format'}; #well... this is all cch specific
1104 my $files = $param->{'uploaded_files'}
1105 or die "No files provided.";
1107 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
1110 if ( $format eq 'cch' || $format eq 'cch-fixed'
1111 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
1114 my $oldAutoCommit = $FS::UID::AutoCommit;
1115 local $FS::UID::AutoCommit = 0;
1118 my @insert_list = ();
1119 my @delete_list = ();
1120 my @predelete_list = ();
1121 my $insertname = '';
1122 my $deletename = '';
1123 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1125 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
1126 'CODE', \&FS::tax_class::batch_import,
1127 'PLUS4', \&FS::cust_tax_location::batch_import,
1128 'ZIP', \&FS::cust_tax_location::batch_import,
1129 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
1130 'DETAIL', \&FS::tax_rate::batch_import,
1132 while( scalar(@list) ) {
1133 my ( $name, $import_sub ) = splice( @list, 0, 2 );
1134 my $file = lc($name). 'file';
1136 unless ($files{$file}) {
1137 #$error = "No $name supplied";
1140 next if $name eq 'DETAIL' && $format =~ /update/;
1142 my $filename = "$dir/". $files{$file};
1144 if ( $format =~ /update/ ) {
1146 ( $error, $insertname, $deletename ) =
1147 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1151 unlink $filename or warn "Can't delete $filename: $!"
1152 unless $keep_cch_files;
1153 push @insert_list, $name, $insertname, $import_sub, $format;
1154 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1155 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1157 unshift @delete_list, $name, $deletename, $import_sub, $format;
1162 push @insert_list, $name, $filename, $import_sub, $format;
1169 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1170 if $format =~ /update/;
1172 my %addl_param = ();
1173 if ( $param->{'delete_only'} ) {
1174 $addl_param{'delete_only'} = $param->{'delete_only'};
1178 $error ||= _perform_cch_tax_import( $job,
1179 [ @predelete_list ],
1186 @list = ( @predelete_list, @insert_list, @delete_list );
1187 while( !$keep_cch_files && scalar(@list) ) {
1188 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1189 unlink $file or warn "Can't delete $file: $!";
1193 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1200 die "Unknown format: $format";
1206 sub _perform_cch_tax_import {
1207 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1211 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1212 while( scalar(@$list) ) {
1213 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1214 my $fmt = "$format-update";
1215 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1216 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1217 my $param = { 'filehandle' => $fh,
1221 $error ||= &{$method}($param, $job);
1229 sub _perform_cch_insert_delete_split {
1230 my ($name, $filename, $dir, $format) = @_;
1234 open my $fh, "< $filename"
1235 or $error ||= "Can't open $name file $filename: $!";
1237 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1240 ) or die "can't open temp file: $!\n";
1241 my $insertname = $ifh->filename;
1243 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1246 ) or die "can't open temp file: $!\n";
1247 my $deletename = $dfh->filename;
1249 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1250 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1253 $handle = $ifh if $_ =~ /$insert_pattern/;
1254 $handle = $dfh if $_ =~ /$delete_pattern/;
1256 $error = "bad input line: $_" unless $handle;
1265 return ($error, $insertname, $deletename);
1268 sub _perform_cch_diff {
1269 my ($name, $newdir, $olddir) = @_;
1274 open my $oldcsvfh, "$olddir/$name.txt"
1275 or die "failed to open $olddir/$name.txt: $!\n";
1277 while(<$oldcsvfh>) {
1284 open my $newcsvfh, "$newdir/$name.txt"
1285 or die "failed to open $newdir/$name.txt: $!\n";
1287 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1290 ) or die "can't open temp file: $!\n";
1291 my $diffname = $dfh->filename;
1293 while(<$newcsvfh>) {
1295 if (exists($oldlines{$_})) {
1298 print $dfh $_, ',"I"', "\n";
1303 #false laziness w/above (sub batch_import)
1304 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1305 excessrate effective_date taxauth taxtype taxcat taxname
1306 usetax useexcessrate fee unittype feemax maxtype passflag
1307 passtype basetype );
1308 my $numfields = scalar(@fields);
1310 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1312 for my $line (grep $oldlines{$_}, keys %oldlines) {
1314 $csv->parse($line) or do {
1315 #$dbh->rollback if $oldAutoCommit;
1316 die "can't parse: ". $csv->error_input();
1318 my @columns = $csv->fields();
1320 $csv->combine( splice(@columns, 0, $numfields) );
1322 print $dfh $csv->string, ',"D"', "\n";
1330 sub _cch_fetch_and_unzip {
1331 my ( $job, $urls, $secret, $dir ) = @_;
1333 my $ua = new LWP::UserAgent;
1334 foreach my $url (split ',', $urls) {
1335 my @name = split '/', $url; #somewhat restrictive
1336 my $name = pop @name;
1337 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1340 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1342 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1343 my $res = $ua->request(
1344 new HTTP::Request( GET => $url ),
1346 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1347 my $content_length = $_[1]->content_length;
1348 $imported += length($_[0]);
1349 if ( time - $min_sec > $last ) {
1350 my $error = $job->update_statustext(
1351 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1352 ",Downloading data from CCH"
1354 die $error if $error;
1359 die "download of $url failed: ". $res->status_line
1360 unless $res->is_success;
1363 my $error = $job->update_statustext( "0,Unpacking data" );
1364 die $error if $error;
1365 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1367 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1368 or die "unzip -P $secret -d $dir $dir/$name failed";
1369 #unlink "$dir/$name";
1373 sub _cch_extract_csv_from_dbf {
1374 my ( $job, $dir, $name ) = @_;
1379 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1380 my $error = $job->update_statustext( "0,Unpacking $name" );
1381 die $error if $error;
1382 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1383 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1384 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1385 unless defined($table);
1386 my $count = $table->last_record; # approximately;
1387 open my $csvfh, ">$dir.new/$name.txt"
1388 or die "failed to open $dir.new/$name.txt: $!\n";
1390 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1391 my @fields = $table->field_names;
1392 my $cursor = $table->prepare_select;
1394 sub { my $date = shift;
1395 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1398 while (my $row = $cursor->fetch_hashref) {
1399 $csv->combine( map { my $type = $table->field_type($_);
1401 &{$format_date}($row->{$_}) ;
1402 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1403 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1410 print $csvfh $csv->string, "\n";
1412 if ( time - $min_sec > $last ) {
1413 my $error = $job->update_statustext(
1414 int(100 * $imported/$count). ",Unpacking $name"
1416 die $error if $error;
1424 sub _remember_disabled_taxes {
1425 my ( $job, $format, $disabled_tax_rate ) = @_;
1429 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1431 my @items = qsearch( { table => 'tax_rate',
1432 hashref => { disabled => 'Y',
1433 data_vendor => $format,
1435 select => 'geocode, taxclassnum',
1438 my $count = scalar(@items);
1439 foreach my $tax_rate ( @items ) {
1440 if ( time - $min_sec > $last ) {
1441 $job->update_statustext(
1442 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1448 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1449 unless ( $tax_class ) {
1450 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1453 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1457 sub _remember_tax_products {
1458 my ( $job, $format, $taxproduct ) = @_;
1460 # XXX FIXME this loop only works when cch is the only data provider
1462 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1464 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1465 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1466 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1467 " optionname LIKE 'usage_taxproductnum_%' AND ".
1468 " optionvalue != '' )";
1469 my @items = qsearch( { table => 'part_pkg',
1470 select => 'DISTINCT pkgpart,taxproductnum',
1472 extra_sql => $extra_sql,
1475 my $count = scalar(@items);
1476 foreach my $part_pkg ( @items ) {
1477 if ( time - $min_sec > $last ) {
1478 $job->update_statustext(
1479 int( 100 * $imported / $count ). ",Remembering tax products"
1484 warn "working with package part ". $part_pkg->pkgpart.
1485 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1486 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1487 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1488 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1490 foreach my $option ( $part_pkg->part_pkg_option ) {
1491 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1494 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1495 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1496 $part_pkg_taxproduct->taxproduct
1497 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1502 sub _restore_remembered_tax_products {
1503 my ( $job, $format, $taxproduct ) = @_;
1507 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1508 my $count = scalar(keys %$taxproduct);
1509 foreach my $pkgpart ( keys %$taxproduct ) {
1510 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1511 if ( time - $min_sec > $last ) {
1512 $job->update_statustext(
1513 int( 100 * $imported / $count ). ",Restoring tax products"
1519 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1520 unless ( $part_pkg ) {
1521 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1524 my %options = $part_pkg->options;
1525 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1526 my $primary_svc = $part_pkg->svcpart;
1527 my $new = new FS::part_pkg { $part_pkg->hash };
1529 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1530 warn "working with class '$class'\n" if $DEBUG;
1531 my $part_pkg_taxproduct =
1532 qsearchs( 'part_pkg_taxproduct',
1533 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1534 data_vendor => $format,
1538 unless ( $part_pkg_taxproduct ) {
1539 return "failed to find part_pkg_taxproduct (".
1540 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1543 if ( $class eq '' ) {
1544 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1548 $options{"usage_taxproductnum_$class"} =
1549 $part_pkg_taxproduct->taxproductnum;
1553 my $error = $new->replace( $part_pkg,
1554 'pkg_svc' => \%pkg_svc,
1555 'primary_svc' => $primary_svc,
1556 'options' => \%options,
1559 return $error if $error;
1566 sub _restore_remembered_disabled_taxes {
1567 my ( $job, $format, $disabled_tax_rate ) = @_;
1569 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1570 my $count = scalar(keys %$disabled_tax_rate);
1571 foreach my $key (keys %$disabled_tax_rate) {
1572 if ( time - $min_sec > $last ) {
1573 $job->update_statustext(
1574 int( 100 * $imported / $count ). ",Disabling tax rates"
1579 my ($geocode,$taxclass) = split /:/, $key, 2;
1580 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1581 taxclass => $taxclass,
1583 return "found multiple tax_class records for format $format class $taxclass"
1584 if scalar(@tax_class) > 1;
1586 unless (scalar(@tax_class)) {
1587 warn "no tax_class for format $format class $taxclass\n";
1592 qsearch('tax_rate', { data_vendor => $format,
1593 geocode => $geocode,
1594 taxclassnum => $tax_class[0]->taxclassnum,
1598 if (scalar(@tax_rate) > 1) {
1599 return "found multiple tax_rate records for format $format geocode ".
1600 "$geocode and taxclass $taxclass ( taxclassnum ".
1601 $tax_class[0]->taxclassnum. " )";
1604 if (scalar(@tax_rate)) {
1605 $tax_rate[0]->disabled('Y');
1606 my $error = $tax_rate[0]->replace;
1607 return $error if $error;
1612 sub _remove_old_tax_data {
1613 my ( $job, $format ) = @_;
1616 my $error = $job->update_statustext( "0,Removing old tax data" );
1617 die $error if $error;
1619 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1620 "WHERE data_vendor = ". $dbh->quote($format);
1621 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1624 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1626 foreach my $table ( @table ) {
1627 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1628 $dbh->quote($format);
1629 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1632 if ( $format eq 'cch' ) {
1633 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1634 $dbh->quote("$format-zip");
1635 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1641 sub _create_temporary_tables {
1642 my ( $job, $format ) = @_;
1645 my $error = $job->update_statustext( "0,Creating temporary tables" );
1646 die $error if $error;
1648 my @table = qw( tax_rate
1655 foreach my $table ( @table ) {
1657 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1658 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1664 sub _copy_from_temp {
1665 my ( $job, $format ) = @_;
1668 my $error = $job->update_statustext( "0,Making permanent" );
1669 die $error if $error;
1671 my @table = qw( tax_rate
1678 foreach my $table ( @table ) {
1680 "INSERT INTO public.$table SELECT * from $table";
1681 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1687 =item process_download_and_reload
1689 Download and process a tax update as a queued JSRPC job after wiping the
1690 existing wipable tax data.
1694 sub process_download_and_reload {
1695 _process_reload('process_download_and_update', @_);
1699 =item process_batch_reload
1701 Load and process a tax update from the provided files as a queued JSRPC job
1702 after wiping the existing wipable tax data.
1706 sub process_batch_reload {
1707 _process_reload('_perform_batch_import', @_);
1711 sub _process_reload {
1712 my ( $method, $job ) = ( shift, shift );
1714 my $param = thaw(decode_base64($_[0]));
1715 my $format = $param->{'format'}; #well... this is all cch specific
1717 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1719 if ( $job ) { # progress bar
1720 my $error = $job->update_statustext( 0 );
1721 die $error if $error;
1724 my $oldAutoCommit = $FS::UID::AutoCommit;
1725 local $FS::UID::AutoCommit = 0;
1730 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1731 "USING (taxclassnum) WHERE data_vendor = '$format'";
1732 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1734 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1735 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1736 if $sth->fetchrow_arrayref->[0];
1738 # really should get a table EXCLUSIVE lock here
1740 #remember disabled taxes
1741 my %disabled_tax_rate = ();
1742 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1744 #remember tax products
1745 my %taxproduct = ();
1746 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1749 $error ||= _create_temporary_tables( $job, $format );
1753 my $args = '$job, @_';
1754 eval "$method($args);";
1758 #restore taxproducts
1759 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1763 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1765 #wipe out the old data
1766 $error ||= _remove_old_tax_data( $job, $format );
1769 $error ||= _copy_from_temp( $job, $format );
1772 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1777 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1781 =item process_download_and_update
1783 Download and process a tax update as a queued JSRPC job
1787 sub process_download_and_update {
1790 my $param = thaw(decode_base64(shift));
1791 my $format = $param->{'format'}; #well... this is all cch specific
1793 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1795 if ( $job ) { # progress bar
1796 my $error = $job->update_statustext( 0);
1797 die $error if $error;
1800 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1801 my $dir = $cache_dir. 'taxdata';
1803 mkdir $dir or die "can't create $dir: $!\n";
1806 if ($format eq 'cch') {
1808 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1810 my $conf = new FS::Conf;
1811 die "direct download of tax data not enabled\n"
1812 unless $conf->exists('taxdatadirectdownload');
1813 my ( $urls, $username, $secret, $states ) =
1814 $conf->config('taxdatadirectdownload');
1815 die "No tax download URL provided. ".
1816 "Did you set the taxdatadirectdownload configuration value?\n"
1824 # really should get a table EXCLUSIVE lock here
1825 # check if initial import or update
1827 # relying on mkdir "$dir.new" as a mutex
1829 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1830 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1831 $sth->execute() or die $sth->errstr;
1832 my $update = $sth->fetchrow_arrayref->[0];
1834 # create cache and/or rotate old tax data
1839 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1840 foreach my $file (readdir($dirh)) {
1841 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1847 for (8, 7, 6, 5, 4, 3, 2, 1) {
1848 if ( -e "$dir.$_" ) {
1849 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1852 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1856 die "can't find previous tax data\n" if $update;
1860 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1862 # fetch and unpack the zip files
1864 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1866 # extract csv files from the dbf files
1868 foreach my $name ( @namelist ) {
1869 _cch_extract_csv_from_dbf( $job, $dir, $name );
1872 # generate the diff files
1875 foreach my $name ( @namelist ) {
1876 my $difffile = "$dir.new/$name.txt";
1878 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1879 die $error if $error;
1880 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1881 my $olddir = $update ? "$dir.1" : "";
1882 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1884 $difffile =~ s/^$cache_dir//;
1885 push @list, "${name}file:$difffile";
1888 # perform the import
1889 local $keep_cch_files = 1;
1890 $param->{uploaded_files} = join( ',', @list );
1891 $param->{format} .= '-update' if $update;
1893 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1895 rename "$dir.new", "$dir"
1896 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1899 die "Unknown format: $format";
1903 =item browse_queries PARAMS
1905 Returns a list consisting of a hashref suited for use as the argument
1906 to qsearch, and sql query string. Each is based on the PARAMS hashref
1907 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1908 from a form. This conveniently creates the query hashref and count_query
1909 string required by the browse and search elements. As a side effect,
1910 the PARAMS hashref is untainted and keys with unexpected values are removed.
1914 sub browse_queries {
1918 'table' => 'tax_rate',
1920 'order_by' => 'ORDER BY geocode, taxclassnum',
1925 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1926 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1928 delete $params->{data_vendor};
1931 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1932 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1933 'geocode LIKE '. dbh->quote($1.'%');
1935 delete $params->{geocode};
1938 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1939 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1942 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1943 ' taxclassnum = '. dbh->quote($1)
1945 delete $params->{taxclassnun};
1949 if ( $params->{tax_type} =~ /^(\d+)$/ );
1950 delete $params->{tax_type}
1954 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1955 delete $params->{tax_cat}
1958 my @taxclassnum = ();
1959 if ($tax_type || $tax_cat ) {
1960 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1961 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1962 @taxclassnum = map { $_->taxclassnum }
1963 qsearch({ 'table' => 'tax_class',
1965 'extra_sql' => "WHERE taxclass $compare",
1969 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1970 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1971 if ( @taxclassnum );
1973 unless ($params->{'showdisabled'}) {
1974 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1975 "( disabled = '' OR disabled IS NULL )";
1978 $query->{extra_sql} = $extra_sql;
1980 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1983 =item queue_liability_report PARAMS
1985 Launches a tax liability report.
1987 PARAMS needs to be a base64-encoded Storable hash containing:
1988 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1989 - end: the end date of the report, likewise.
1990 - agentnum: the agent to limit the report to, if any.
1994 sub queue_liability_report {
1996 my $param = thaw(decode_base64(shift));
1999 $cgi->param('beginning', $param->{beginning});
2000 $cgi->param('ending', $param->{ending});
2001 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
2002 my $agentnum = $param->{agentnum};
2003 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
2004 generate_liability_report(
2005 'beginning' => $beginning,
2006 'ending' => $ending,
2007 'agentnum' => $agentnum,
2008 'p' => $param->{RootURL},
2013 =item generate_liability_report PARAMS
2015 Generates a tax liability report. PARAMS must include:
2017 - beginning, as a timestamp
2018 - ending, as a timestamp
2019 - p: the Freeside root URL, for generating links
2020 - agentnum (optional)
2024 #shit, all sorts of false laxiness w/report_newtax.cgi
2025 sub generate_liability_report {
2028 my ( $count, $last, $min_sec ) = _progressbar_foo();
2030 #let us open the temp file early
2031 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
2032 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
2034 UNLINK => 0, # not so temp
2035 ) or die "can't open report file: $!\n";
2037 my $conf = new FS::Conf;
2038 my $money_char = $conf->config('money_char') || '$';
2041 JOIN cust_bill USING ( invnum )
2042 LEFT JOIN cust_main USING ( custnum )
2046 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
2047 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
2049 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
2051 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
2054 if ( $args{agentnum} =~ /^(\d+)$/ ) {
2055 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
2056 die "agent not found" unless $agent;
2057 $agentname = $agent->agent;
2058 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
2061 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
2062 my @taxparams = qw( city county state locationtaxid );
2063 my @params = ('itemdesc', @taxparams);
2065 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
2067 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
2068 #to FS::Report or FS::Record or who the fuck knows where)
2069 my $scalar_sql = sub {
2070 my( $r, $param, $sql ) = @_;
2071 my $sth = dbh->prepare($sql) or die dbh->errstr;
2072 $sth->execute( map $r->$_(), @$param )
2073 or die "Unexpected error executing statement $sql: ". $sth->errstr;
2074 $sth->fetchrow_arrayref->[0] || 0;
2083 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
2084 # for taxes that have been charged
2085 # (state, county, city are from tax_rate_location, not from customer data)
2086 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
2088 hashref => { pkgpart => 0 },
2089 addl_from => $addl_from,
2090 extra_sql => $where,
2093 $count = scalar(@tax_and_location);
2094 foreach my $t ( @tax_and_location ) {
2097 if ( time - $min_sec > $last ) {
2098 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2105 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
2106 my $label = join('~', map { $t->$_ } @params);
2107 $label = 'Tax'. $label if $label =~ /^~/;
2108 unless ( exists( $taxes{$label} ) ) {
2109 my ($baselabel, @trash) = split /~/, $label;
2111 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
2112 $taxes{$label}->{'url_param'} =
2113 join(';', map { "$_=". uri_escape($t->$_) } @params);
2116 # " payby != 'COMP' ". # breaks the entire report under 4.x
2117 # # and unnecessary since COMP accounts don't
2118 # # get taxes calculated in the first place
2119 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
2120 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
2125 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
2127 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
2129 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2131 $taxes{$label}->{'tax'} += $x;
2134 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2136 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2138 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2139 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2141 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2143 $taxes{$label}->{'credit'} += $y;
2145 unless ( exists( $taxes{$baselabel} ) ) {
2147 $basetaxes{$baselabel}->{'label'} = $baselabel;
2148 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2149 $basetaxes{$baselabel}->{'base'} = 1;
2153 $basetaxes{$baselabel}->{'tax'} += $x;
2154 $basetaxes{$baselabel}->{'credit'} += $y;
2158 # calculate customer-exemption for this tax
2159 # calculate package-exemption for this tax
2160 # calculate monthly exemption (texas tax) for this tax
2161 # count up all the cust_tax_exempt_pkg records associated with
2162 # the actual line items.
2169 $args{job}->update_statustext( "0,Sorted" );
2175 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2176 my ($base, @trash) = split '~', $tax;
2177 my $basetax = delete( $basetaxes{$base} );
2179 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2180 $taxes{$tax}->{base} = 1;
2182 push @taxes, $basetax;
2185 push @taxes, $taxes{$tax};
2192 'credit' => $credit,
2197 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2198 $dateagentlink .= ';agentnum='. $args{agentnum}
2199 if length($agentname);
2200 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2202 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2204 print $report <<EOF;
2206 <% include("/elements/header.html", "$agentname Tax Report - ".
2208 ? time2str('%h %o %Y ', $args{beginning} )
2212 ( $args{ending} == 4294967295
2214 : time2str('%h %o %Y', $args{ending} )
2219 <% include('/elements/table-grid.html') %>
2222 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2223 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2224 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2225 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2226 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2227 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2231 my $bgcolor1 = '#eeeeee';
2232 my $bgcolor2 = '#ffffff';
2235 $count = scalar(@taxes);
2237 foreach my $tax ( @taxes ) {
2240 if ( time - $min_sec > $last ) {
2241 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2248 if ( $bgcolor eq $bgcolor1 ) {
2249 $bgcolor = $bgcolor2;
2251 $bgcolor = $bgcolor1;
2255 if ( $tax->{'label'} ne 'Total' ) {
2256 $link = ';'. $tax->{'url_param'};
2259 print $report <<EOF;
2261 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2262 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2263 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2264 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2266 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2267 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2268 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2269 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2270 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2272 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2277 print $report <<EOF;
2284 my $reportname = $report->filename;
2287 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2288 $reportname =~ s/^$dropstring//;
2290 my $reporturl = "%%%ROOTURL%%%/misc/queued_report.html?report=$reportname";
2291 die "<a href=$reporturl>view</a>\n";
2301 Mixing automatic and manual editing works poorly at present.
2303 Tax liability calculations take too long and arguably don't belong here.
2304 Tax liability report generation not entirely safe (escaped).
2308 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>