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;
21 use FS::Record qw( qsearch qsearchs dbh dbdef );
24 use FS::cust_bill_pkg;
25 use FS::cust_tax_location;
26 use FS::tax_rate_location;
27 use FS::part_pkg_taxrate;
28 use FS::part_pkg_taxproduct;
30 use FS::Misc qw( csv_from_fixed );
33 $me = '[FS::tax_rate]';
38 FS::tax_rate - Object methods for tax_rate objects
44 $record = new FS::tax_rate \%hash;
45 $record = new FS::tax_rate { 'column' => 'value' };
47 $error = $record->insert;
49 $error = $new_record->replace($old_record);
51 $error = $record->delete;
53 $error = $record->check;
57 An FS::tax_rate object represents a tax rate, defined by locale.
58 FS::tax_rate inherits from FS::Record. The following fields are
65 primary key (assigned automatically for new tax rates)
69 a geographic location code provided by a tax data vendor
77 a location code provided by a tax authority
81 a foreign key into FS::tax_class - the type of tax referenced by
86 the time after which the tax applies
94 second bracket percentage
98 the amount to which the tax applies (first bracket)
102 a cap on the amount of tax if a cap exists
106 percentage on out of jurisdiction purchases
110 second bracket percentage on out of jurisdiction purchases
114 one of the values in %tax_unittypes
118 amount of tax per unit
122 second bracket amount of tax per unit
126 the number of units to which the fee applies (first bracket)
130 the most units to which fees apply (first and second brackets)
134 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
138 if defined, printed on invoices instead of "Tax"
142 a value from %tax_authorities
146 a value from %tax_basetypes indicating the tax basis
150 a value from %tax_passtypes indicating how the tax should displayed to the customer
154 'Y', 'N', or blank indicating the tax can be passed to the customer
158 if 'Y', this tax does not apply to setup fees
162 if 'Y', this tax does not apply to recurring fees
166 if 'Y', has been manually edited
176 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
180 sub table { 'tax_rate'; }
184 Adds this tax rate to the database. If there is an error, returns the error,
185 otherwise returns false.
189 Deletes this tax rate from the database. If there is an error, returns the
190 error, otherwise returns false.
192 =item replace OLD_RECORD
194 Replaces the OLD_RECORD with this one in the database. If there is an error,
195 returns the error, otherwise returns false.
199 Checks all fields to make sure this is a valid tax rate. If there is an error,
200 returns the error, otherwise returns false. Called by the insert and replace
208 foreach (qw( taxbase taxmax )) {
209 $self->$_(0) unless $self->$_;
212 $self->ut_numbern('taxnum')
213 || $self->ut_text('geocode')
214 || $self->ut_textn('data_vendor')
215 || $self->ut_cch_textn('location')
216 || $self->ut_foreign_keyn('taxclassnum', 'tax_class', 'taxclassnum')
217 || $self->ut_snumbern('effective_date')
218 || $self->ut_float('tax')
219 || $self->ut_floatn('excessrate')
220 || $self->ut_money('taxbase')
221 || $self->ut_money('taxmax')
222 || $self->ut_floatn('usetax')
223 || $self->ut_floatn('useexcessrate')
224 || $self->ut_numbern('unittype')
225 || $self->ut_floatn('fee')
226 || $self->ut_floatn('excessfee')
227 || $self->ut_floatn('feemax')
228 || $self->ut_numbern('maxtype')
229 || $self->ut_textn('taxname')
230 || $self->ut_numbern('taxauth')
231 || $self->ut_numbern('basetype')
232 || $self->ut_numbern('passtype')
233 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
234 || $self->ut_enum('setuptax', [ '', 'Y' ] )
235 || $self->ut_enum('recurtax', [ '', 'Y' ] )
236 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
237 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
238 || $self->ut_enum('manual', [ '', 'Y' ] )
239 || $self->ut_enum('disabled', [ '', 'Y' ] )
240 || $self->SUPER::check
245 #ut_text / ut_textn w/ ` added cause now that's in the data
248 $self->getfield($field)
249 =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
250 or return gettext('illegal_or_empty_text'). " $field: ".
251 $self->getfield($field);
252 $self->setfield($field,$1);
257 =item taxclass_description
259 Returns the human understandable value associated with the related
264 sub taxclass_description {
266 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
267 $tax_class ? $tax_class->description : '';
272 Returns the human understandable value associated with the unittype column
276 %tax_unittypes = ( '0' => 'access line',
283 $tax_unittypes{$self->unittype};
288 Returns the human understandable value associated with the maxtype column.
292 # XXX these are non-functional, and most of them are horrible to implement
293 # in our current model
295 %tax_maxtypes = ( '0' => 'receipts per invoice',
296 '1' => 'receipts per item',
297 '2' => 'total utility charges per utility tax year',
298 '3' => 'total charges per utility tax year',
299 '4' => 'receipts per access line',
300 '7' => 'total utility charges per calendar year',
301 '9' => 'monthly receipts per location',
302 '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
303 '11' => 'receipts/units per access line',
304 '14' => 'units per invoice',
305 '15' => 'units per month',
306 '18' => 'units per account',
311 $tax_maxtypes{$self->maxtype};
316 Returns the human understandable value associated with the basetype column
320 %tax_basetypes = ( '0' => 'sale price',
321 '1' => 'gross receipts',
322 '2' => 'sales taxable telecom revenue',
323 '3' => 'minutes carried',
324 '4' => 'minutes billed',
325 '5' => 'gross operating revenue',
326 '6' => 'access line',
328 '8' => 'gross revenue',
329 '9' => 'portion gross receipts attributable to interstate service',
330 '10' => 'access line',
331 '11' => 'gross profits',
332 '12' => 'tariff rate',
334 '15' => 'prior year gross receipts',
339 $tax_basetypes{$self->basetype};
344 Returns the human understandable value associated with the taxauth column
348 %tax_authorities = ( '0' => 'federal',
353 '5' => 'county administered by state',
354 '6' => 'city administered by state',
355 '7' => 'city administered by county',
356 '8' => 'local administered by state',
357 '9' => 'local administered by county',
362 $tax_authorities{$self->taxauth};
367 Returns the human understandable value associated with the passtype column
371 %tax_passtypes = ( '0' => 'separate tax line',
372 '1' => 'separate surcharge line',
373 '2' => 'surcharge not separated',
374 '3' => 'included in base rate',
379 $tax_passtypes{$self->passtype};
382 =item taxline_cch TAXABLES, [ OPTIONSHASH ]
384 Returns a listref of a name and an amount of tax calculated for the list
385 of packages/amounts referenced by TAXABLES. If an error occurs, a message
386 is returned as a scalar.
392 # this used to accept a hash of options but none of them did anything
393 # so it's been removed.
397 if (ref($_[0]) eq 'ARRAY') {
401 #exemptions would be broken in this case
404 my $name = $self->taxname;
405 $name = 'Other surcharges'
406 if ($self->passtype == 2);
409 if ( $self->disabled ) { # we always know how to handle disabled taxes
416 my $taxable_charged = 0;
417 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
420 warn "calculating taxes for ". $self->taxnum. " on ".
421 join (",", map { $_->pkgnum } @cust_bill_pkg)
424 if ($self->passflag eq 'N') {
425 # return "fatal: can't (yet) handle taxes not passed to the customer";
426 # until someone needs to track these in freeside
433 my $maxtype = $self->maxtype || 0;
434 if ($maxtype != 0 && $maxtype != 1
435 && $maxtype != 14 && $maxtype != 15
436 && $maxtype != 18 # sigh
438 return $self->_fatal_or_null( 'tax with "'.
439 $self->maxtype_name. '" threshold'
441 } # I don't know why, it's not like there are maxtypes that we DO support
443 # we treat gross revenue as gross receipts and expect the tax data
444 # to DTRT (i.e. tax on tax rules)
445 if ($self->basetype != 0 && $self->basetype != 1 &&
446 $self->basetype != 5 && $self->basetype != 6 &&
447 $self->basetype != 7 && $self->basetype != 8 &&
448 $self->basetype != 14
451 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
454 unless ($self->setuptax =~ /^Y$/i) {
455 $taxable_charged += $_->setup foreach @cust_bill_pkg;
457 unless ($self->recurtax =~ /^Y$/i) {
458 $taxable_charged += $_->recur foreach @cust_bill_pkg;
461 my $taxable_units = 0;
462 unless ($self->recurtax =~ /^Y$/i) {
464 if (( $self->unittype || 0 ) == 0) { #access line
466 foreach (@cust_bill_pkg) {
467 $taxable_units += $_->units
468 unless $seen{$_->pkgnum}++;
471 } elsif ($self->unittype == 1) { #minute
472 return $self->_fatal_or_null( 'fee with minute unit type' );
474 } elsif ($self->unittype == 2) { #account
476 my $conf = new FS::Conf;
477 if ( $conf->exists('tax-pkg_address') ) {
478 #number of distinct locations
480 foreach (@cust_bill_pkg) {
482 unless $seen{$_->cust_pkg->locationnum}++;
489 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
494 # XXX handle excessrate (use_excessrate) / excessfee /
495 # taxbase/feebase / taxmax/feemax
496 # and eventually exemptions
498 # the tax or fee is applied to taxbase or feebase and then
499 # the excessrate or excess fee is applied to taxmax or feemax
501 if ( ($self->taxmax > 0 and $taxable_charged > $self->taxmax) or
502 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
504 # (why not just cap taxable_charged/units at the taxmax/feemax? because
505 # it's way more complicated than that. this won't even catch every case
506 # where a bracket maximum should apply.)
507 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
510 $amount += $taxable_charged * $self->tax;
511 $amount += $taxable_units * $self->fee;
513 warn "calculated taxes as [ $name, $amount ]\n"
524 my ($self, $error) = @_;
526 $DB::single = 1; # not a mistake
528 my $conf = new FS::Conf;
530 $error = "can't yet handle ". $error;
531 my $name = $self->taxname;
532 $name = 'Other surcharges'
533 if ($self->passtype == 2);
535 if ($conf->exists('ignore_incalculable_taxes')) {
536 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
537 return { name => $name, amount => 0 };
539 return "fatal: $error";
543 =item tax_on_tax CUST_LOCATION
545 Returns a list of taxes which are candidates for taxing taxes for the
546 given service location (see L<FS::cust_location>)
554 my $cust_location = shift;
556 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
557 $cust_location->custnum
560 my $geocode = $cust_location->geocode($self->data_vendor);
564 my $extra_sql = ' AND ('.
565 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
570 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
571 my $select = 'DISTINCT ON(taxclassnum) *';
573 # should qsearch preface columns with the table to facilitate joins?
574 my @taxclassnums = map { $_->taxclassnum }
575 qsearch( { 'table' => 'part_pkg_taxrate',
577 'hashref' => { 'data_vendor' => $self->data_vendor,
578 'taxclassnumtaxed' => $self->taxclassnum,
580 'extra_sql' => $extra_sql,
581 'order_by' => $order_by,
584 return () unless @taxclassnums;
587 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
589 qsearch({ 'table' => 'tax_rate',
590 'hashref' => { 'geocode' => $geocode, },
591 'extra_sql' => $extra_sql,
596 =item tax_rate_location
598 Returns an object representing the location associated with this tax
599 (see L<FS::tax_rate_location>)
603 sub tax_rate_location {
606 qsearchs({ 'table' => 'tax_rate_location',
607 'hashref' => { 'data_vendor' => $self->data_vendor,
608 'geocode' => $self->geocode,
612 new FS::tax_rate_location;
619 Finds an existing tax definition matching the data_vendor, taxname,
620 taxclassnum, and geocode of this one, if one exists, and sets the contents of
621 this tax rate equal to that one (including its taxnum). If an existing
622 definition is not found, inserts this one. Returns an error string if
623 inserting a record failed.
629 # this doesn't uniquely identify CCH taxes (kinda goofy, I know)
630 die "find_or_insert is not compatible with CCH taxes\n"
631 if $self->data_vendor eq 'cch';
633 my @keys = (qw(data_vendor taxname taxclassnum geocode));
634 my %hash = map { $_ => $self->get($_) } @keys;
635 my $existing = qsearchs('tax_rate', \%hash);
637 foreach ($self->fields) {
638 $self->set($_, $existing->get($_));
642 return $self->insert;
656 sub _progressbar_foo {
661 my ($param, $job) = @_;
663 my $fh = $param->{filehandle};
664 my $format = $param->{'format'};
672 my @column_lengths = ();
673 my @column_callbacks = ();
674 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
675 $format =~ s/-fixed//;
676 my $date_format = sub { my $r='';
677 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
680 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
681 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 );
682 push @column_lengths, 1 if $format eq 'cch-update';
683 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
684 $column_callbacks[8] = $date_format;
688 my ( $count, $last, $min_sec ) = _progressbar_foo();
689 if ( $job || scalar(@column_callbacks) ) {
691 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
692 return $error if $error;
696 if ( $format eq 'cch' || $format eq 'cch-update' ) {
697 #false laziness w/below (sub _perform_cch_diff)
698 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
699 excessrate effective_date taxauth taxtype taxcat taxname
700 usetax useexcessrate fee unittype feemax maxtype passflag
702 push @fields, 'actionflag' if $format eq 'cch-update';
707 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
708 $hash->{'data_vendor'} ='cch';
709 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
710 time_zone => 'floating',
712 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
713 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
715 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
716 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
719 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
721 my %tax_class = ( 'data_vendor' => 'cch',
722 'taxclass' => $taxclassid,
725 my $tax_class = qsearchs( 'tax_class', \%tax_class );
726 return "Error updating tax rate: no tax class $taxclassid"
729 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
731 foreach (qw( taxtype taxcat )) {
735 my %passflagmap = ( '0' => '',
739 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
740 if exists $passflagmap{$hash->{'passflag'}};
742 foreach (keys %$hash) {
743 $hash->{$_} = substr($hash->{$_}, 0, 80)
744 if length($hash->{$_}) > 80;
747 my $actionflag = delete($hash->{'actionflag'});
749 $hash->{'taxname'} =~ s/`/'/g;
750 $hash->{'taxname'} =~ s|\\|/|g;
752 return '' if $format eq 'cch'; # but not cch-update
754 if ($actionflag eq 'I') {
755 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
756 }elsif ($actionflag eq 'D') {
757 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
759 return "Unexpected action flag: ". $hash->{'actionflag'};
762 delete($hash->{$_}) for keys %$hash;
768 } elsif ( $format eq 'extended' ) {
769 die "unimplemented\n";
773 die "unknown format $format";
776 my $csv = new Text::CSV_XS;
780 local $SIG{HUP} = 'IGNORE';
781 local $SIG{INT} = 'IGNORE';
782 local $SIG{QUIT} = 'IGNORE';
783 local $SIG{TERM} = 'IGNORE';
784 local $SIG{TSTP} = 'IGNORE';
785 local $SIG{PIPE} = 'IGNORE';
787 my $oldAutoCommit = $FS::UID::AutoCommit;
788 local $FS::UID::AutoCommit = 0;
791 while ( defined($line=<$fh>) ) {
792 $csv->parse($line) or do {
793 $dbh->rollback if $oldAutoCommit;
794 return "can't parse: ". $csv->error_input();
797 if ( $job ) { # progress bar
798 if ( time - $min_sec > $last ) {
799 my $error = $job->update_statustext(
800 int( 100 * $imported / $count ). ",Importing tax rates"
803 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
810 my @columns = $csv->fields();
812 my %tax_rate = ( 'data_vendor' => $format );
813 foreach my $field ( @fields ) {
814 $tax_rate{$field} = shift @columns;
817 if ( scalar( @columns ) ) {
818 $dbh->rollback if $oldAutoCommit;
819 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
822 my $error = &{$hook}(\%tax_rate);
824 $dbh->rollback if $oldAutoCommit;
828 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
830 my $tax_rate = new FS::tax_rate( \%tax_rate );
831 $error = $tax_rate->insert;
834 $dbh->rollback if $oldAutoCommit;
835 return "can't insert tax_rate for $line: $error";
844 my @replace = grep { exists($delete{$_}) } keys %insert;
846 if ( $job ) { # progress bar
847 if ( time - $min_sec > $last ) {
848 my $error = $job->update_statustext(
849 int( 100 * $imported / $count ). ",Importing tax rates"
852 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
859 my $old = qsearchs( 'tax_rate', $delete{$_} );
863 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
864 $new->taxnum($old->taxnum);
865 my $error = $new->replace($old);
868 $dbh->rollback if $oldAutoCommit;
869 my $hashref = $insert{$_};
870 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
871 return "can't replace tax_rate for $line: $error";
878 $old = delete $delete{$_};
879 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
880 #join(" ", map { "$_ => ". $old->{$_} } @fields);
881 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
887 for (grep { !exists($delete{$_}) } keys %insert) {
888 if ( $job ) { # progress bar
889 if ( time - $min_sec > $last ) {
890 my $error = $job->update_statustext(
891 int( 100 * $imported / $count ). ",Importing tax rates"
894 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
901 my $tax_rate = new FS::tax_rate( $insert{$_} );
902 my $error = $tax_rate->insert;
905 $dbh->rollback if $oldAutoCommit;
906 my $hashref = $insert{$_};
907 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
908 return "can't insert tax_rate for $line: $error";
914 for (grep { !exists($insert{$_}) } keys %delete) {
915 if ( $job ) { # progress bar
916 if ( time - $min_sec > $last ) {
917 my $error = $job->update_statustext(
918 int( 100 * $imported / $count ). ",Importing tax rates"
921 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
928 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
930 $dbh->rollback if $oldAutoCommit;
931 $tax_rate = $delete{$_};
932 warn "WARNING: can't find tax_rate to delete for: ".
933 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
936 my $error = $tax_rate->delete; # XXX we really should not do this
937 # (it orphans CBPTRL records)
940 $dbh->rollback if $oldAutoCommit;
941 my $hashref = $delete{$_};
942 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
943 return "can't delete tax_rate for $line: $error";
950 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
952 return "Empty file!" unless ($imported || $format eq 'cch-update');
958 =item process_batch_import
960 Load a batch import as a queued JSRPC job
964 sub process_batch_import {
965 my ($job, $param) = @_;
967 if ( $param->{reload} ) {
968 process_batch_reload($job, $param);
971 _perform_batch_import($job, $param);
976 sub _perform_batch_import {
977 my ($job, $param) = @_;
979 my $oldAutoCommit = $FS::UID::AutoCommit;
980 local $FS::UID::AutoCommit = 0;
983 my $format = $param->{'format'};
985 my $files = $param->{'uploaded_files'}
986 or die "No files provided.";
988 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
991 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
994 if ( $format eq 'cch' || $format eq 'cch-fixed'
995 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
998 my @insert_list = ();
999 my @delete_list = ();
1000 my @predelete_list = ();
1001 my $insertname = '';
1002 my $deletename = '';
1004 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
1005 'CODE', \&FS::tax_class::batch_import,
1006 'PLUS4', \&FS::cust_tax_location::batch_import,
1007 'ZIP', \&FS::cust_tax_location::batch_import,
1008 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
1009 'DETAIL', \&FS::tax_rate::batch_import,
1011 while( scalar(@list) ) {
1012 my ( $name, $import_sub ) = splice( @list, 0, 2 );
1013 my $file = lc($name). 'file';
1015 unless ($files{$file}) {
1016 #$error = "No $name supplied";
1019 next if $name eq 'DETAIL' && $format =~ /update/;
1021 my $filename = "$dir/". $files{$file};
1023 if ( $format =~ /update/ ) {
1025 ( $error, $insertname, $deletename ) =
1026 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1030 unlink $filename or warn "Can't delete $filename: $!"
1031 unless $keep_cch_files;
1032 push @insert_list, $name, $insertname, $import_sub, $format;
1033 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1034 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1036 unshift @delete_list, $name, $deletename, $import_sub, $format;
1041 push @insert_list, $name, $filename, $import_sub, $format;
1048 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1049 if $format =~ /update/;
1051 my %addl_param = ();
1052 if ( $param->{'delete_only'} ) {
1053 $addl_param{'delete_only'} = $param->{'delete_only'};
1057 $error ||= _perform_cch_tax_import( $job,
1058 [ @predelete_list ],
1065 @list = ( @predelete_list, @insert_list, @delete_list );
1066 while( !$keep_cch_files && scalar(@list) ) {
1067 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1068 unlink $file or warn "Can't delete $file: $!";
1071 } elsif ( $format =~ /^billsoft-(\w+)$/ ) {
1073 my $file = $dir.'/'.$files{'file'};
1074 open my $fh, "< $file" or $error ||= "Can't open file $file: $!";
1078 format => 'billsoft',
1080 if ( $mode eq 'pcode' ) {
1081 $error ||= FS::cust_tax_location::batch_import(@param);
1083 $error ||= FS::tax_rate_location::batch_import(@param);
1084 } elsif ( $mode eq 'taxclass' ) {
1085 $error ||= FS::tax_class::batch_import(@param);
1086 } elsif ( $mode eq 'taxproduct' ) {
1087 $error ||= FS::part_pkg_taxproduct::batch_import(@param);
1089 die "unknown import mode 'billsoft-$mode'\n";
1093 die "Unknown format: $format";
1097 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1100 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1107 # EVERYTHING THAT FOLLOWS IS CCH-SPECIFIC.
1111 sub _perform_cch_tax_import {
1112 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1116 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1117 while( scalar(@$list) ) {
1118 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1119 my $fmt = "$format-update";
1120 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1121 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1122 my $param = { 'filehandle' => $fh,
1126 $error ||= &{$method}($param, $job);
1134 sub _perform_cch_insert_delete_split {
1135 my ($name, $filename, $dir, $format) = @_;
1139 open my $fh, "< $filename"
1140 or $error ||= "Can't open $name file $filename: $!";
1142 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1145 ) or die "can't open temp file: $!\n";
1146 my $insertname = $ifh->filename;
1148 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1151 ) or die "can't open temp file: $!\n";
1152 my $deletename = $dfh->filename;
1154 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1155 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1158 $handle = $ifh if $_ =~ /$insert_pattern/;
1159 $handle = $dfh if $_ =~ /$delete_pattern/;
1161 $error = "bad input line: $_" unless $handle;
1170 return ($error, $insertname, $deletename);
1173 sub _perform_cch_diff {
1174 my ($name, $newdir, $olddir) = @_;
1179 open my $oldcsvfh, "$olddir/$name.txt"
1180 or die "failed to open $olddir/$name.txt: $!\n";
1182 while(<$oldcsvfh>) {
1189 open my $newcsvfh, "$newdir/$name.txt"
1190 or die "failed to open $newdir/$name.txt: $!\n";
1192 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1195 ) or die "can't open temp file: $!\n";
1196 my $diffname = $dfh->filename;
1198 while(<$newcsvfh>) {
1200 if (exists($oldlines{$_})) {
1203 print $dfh $_, ',"I"', "\n";
1208 #false laziness w/above (sub batch_import)
1209 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1210 excessrate effective_date taxauth taxtype taxcat taxname
1211 usetax useexcessrate fee unittype feemax maxtype passflag
1212 passtype basetype );
1213 my $numfields = scalar(@fields);
1215 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1217 for my $line (grep $oldlines{$_}, keys %oldlines) {
1219 $csv->parse($line) or do {
1220 #$dbh->rollback if $oldAutoCommit;
1221 die "can't parse: ". $csv->error_input();
1223 my @columns = $csv->fields();
1225 $csv->combine( splice(@columns, 0, $numfields) );
1227 print $dfh $csv->string, ',"D"', "\n";
1235 sub _cch_fetch_and_unzip {
1236 my ( $job, $urls, $secret, $dir ) = @_;
1238 my $ua = new LWP::UserAgent;
1239 foreach my $url (split ',', $urls) {
1240 my @name = split '/', $url; #somewhat restrictive
1241 my $name = pop @name;
1242 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1245 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1247 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1248 my $res = $ua->request(
1249 new HTTP::Request( GET => $url ),
1251 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1252 my $content_length = $_[1]->content_length;
1253 $imported += length($_[0]);
1254 if ( time - $min_sec > $last ) {
1255 my $error = $job->update_statustext(
1256 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1257 ",Downloading data from CCH"
1259 die $error if $error;
1264 die "download of $url failed: ". $res->status_line
1265 unless $res->is_success;
1268 my $error = $job->update_statustext( "0,Unpacking data" );
1269 die $error if $error;
1270 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1272 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1273 or die "unzip -P $secret -d $dir $dir/$name failed";
1274 #unlink "$dir/$name";
1278 sub _cch_extract_csv_from_dbf {
1279 my ( $job, $dir, $name ) = @_;
1284 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1285 my $error = $job->update_statustext( "0,Unpacking $name" );
1286 die $error if $error;
1287 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1288 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1289 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1290 unless defined($table);
1291 my $count = $table->last_record; # approximately;
1292 open my $csvfh, ">$dir.new/$name.txt"
1293 or die "failed to open $dir.new/$name.txt: $!\n";
1295 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1296 my @fields = $table->field_names;
1297 my $cursor = $table->prepare_select;
1299 sub { my $date = shift;
1300 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1303 while (my $row = $cursor->fetch_hashref) {
1304 $csv->combine( map { my $type = $table->field_type($_);
1306 &{$format_date}($row->{$_}) ;
1307 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1308 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1315 print $csvfh $csv->string, "\n";
1317 if ( time - $min_sec > $last ) {
1318 my $error = $job->update_statustext(
1319 int(100 * $imported/$count). ",Unpacking $name"
1321 die $error if $error;
1329 sub _remember_disabled_taxes {
1330 my ( $job, $format, $disabled_tax_rate ) = @_;
1334 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1336 my @items = qsearch( { table => 'tax_rate',
1337 hashref => { disabled => 'Y',
1338 data_vendor => $format,
1340 select => 'geocode, taxclassnum',
1343 my $count = scalar(@items);
1344 foreach my $tax_rate ( @items ) {
1345 if ( time - $min_sec > $last ) {
1346 $job->update_statustext(
1347 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1353 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1354 unless ( $tax_class ) {
1355 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1358 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1362 sub _remember_tax_products {
1363 my ( $job, $format, $taxproduct ) = @_;
1365 # XXX FIXME this loop only works when cch is the only data provider
1367 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1370 WHERE taxproductnum IS NOT NULL
1371 OR EXISTS ( SELECT 1 from part_pkg_option
1372 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
1373 AND optionname LIKE 'usage_taxproductnum_%'
1374 AND optionvalue != ''
1377 my @items = qsearch( { table => 'part_pkg',
1378 select => 'DISTINCT pkgpart,taxproductnum',
1380 extra_sql => $extra_sql,
1383 my $count = scalar(@items);
1384 foreach my $part_pkg ( @items ) {
1385 if ( time - $min_sec > $last ) {
1386 $job->update_statustext(
1387 int( 100 * $imported / $count ). ",Remembering tax products"
1392 warn "working with package part ". $part_pkg->pkgpart.
1393 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1394 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1395 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1396 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1398 foreach my $option ( $part_pkg->part_pkg_option ) {
1399 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1402 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1403 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1404 $part_pkg_taxproduct->taxproduct
1405 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1410 sub _restore_remembered_tax_products {
1411 my ( $job, $format, $taxproduct ) = @_;
1415 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1416 my $count = scalar(keys %$taxproduct);
1417 foreach my $pkgpart ( keys %$taxproduct ) {
1418 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1419 if ( time - $min_sec > $last ) {
1420 $job->update_statustext(
1421 int( 100 * $imported / $count ). ",Restoring tax products"
1427 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1428 unless ( $part_pkg ) {
1429 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1432 my %options = $part_pkg->options;
1433 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1434 my $primary_svc = $part_pkg->svcpart;
1435 my $new = new FS::part_pkg { $part_pkg->hash };
1437 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1438 warn "working with class '$class'\n" if $DEBUG;
1439 my $part_pkg_taxproduct =
1440 qsearchs( 'part_pkg_taxproduct',
1441 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1442 data_vendor => $format,
1446 unless ( $part_pkg_taxproduct ) {
1447 return "failed to find part_pkg_taxproduct (".
1448 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1451 if ( $class eq '' ) {
1452 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1456 $options{"usage_taxproductnum_$class"} =
1457 $part_pkg_taxproduct->taxproductnum;
1461 my $error = $new->replace( $part_pkg,
1462 'pkg_svc' => \%pkg_svc,
1463 'primary_svc' => $primary_svc,
1464 'options' => \%options,
1467 return $error if $error;
1474 sub _restore_remembered_disabled_taxes {
1475 my ( $job, $format, $disabled_tax_rate ) = @_;
1477 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1478 my $count = scalar(keys %$disabled_tax_rate);
1479 foreach my $key (keys %$disabled_tax_rate) {
1480 if ( time - $min_sec > $last ) {
1481 $job->update_statustext(
1482 int( 100 * $imported / $count ). ",Disabling tax rates"
1487 my ($geocode,$taxclass) = split /:/, $key, 2;
1488 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1489 taxclass => $taxclass,
1491 return "found multiple tax_class records for format $format class $taxclass"
1492 if scalar(@tax_class) > 1;
1494 unless (scalar(@tax_class)) {
1495 warn "no tax_class for format $format class $taxclass\n";
1500 qsearch('tax_rate', { data_vendor => $format,
1501 geocode => $geocode,
1502 taxclassnum => $tax_class[0]->taxclassnum,
1506 if (scalar(@tax_rate) > 1) {
1507 return "found multiple tax_rate records for format $format geocode ".
1508 "$geocode and taxclass $taxclass ( taxclassnum ".
1509 $tax_class[0]->taxclassnum. " )";
1512 if (scalar(@tax_rate)) {
1513 $tax_rate[0]->disabled('Y');
1514 my $error = $tax_rate[0]->replace;
1515 return $error if $error;
1520 sub _remove_old_tax_data {
1521 my ( $job, $format ) = @_;
1524 my $error = $job->update_statustext( "0,Removing old tax data" );
1525 die $error if $error;
1527 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1528 "WHERE data_vendor = ". $dbh->quote($format);
1529 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1532 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1534 foreach my $table ( @table ) {
1535 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1536 $dbh->quote($format);
1537 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1540 if ( $format eq 'cch' ) {
1541 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1542 $dbh->quote("$format-zip");
1543 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1549 sub _create_temporary_tables {
1550 my ( $job, $format ) = @_;
1553 my $error = $job->update_statustext( "0,Creating temporary tables" );
1554 die $error if $error;
1556 my @table = qw( tax_rate
1563 foreach my $table ( @table ) {
1565 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1566 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1572 sub _copy_from_temp {
1573 my ( $job, $format ) = @_;
1576 my $error = $job->update_statustext( "0,Making permanent" );
1577 die $error if $error;
1579 my @table = qw( tax_rate
1586 foreach my $table ( @table ) {
1588 "INSERT INTO public.$table SELECT * from $table";
1589 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1595 =item process_download_and_reload
1597 Download and process a tax update as a queued JSRPC job after wiping the
1598 existing wipeable tax data.
1602 sub process_download_and_reload {
1603 _process_reload(\&process_download_and_update, @_);
1612 =item process_batch_reload
1614 Load and process a tax update from the provided files as a queued JSRPC job
1615 after wiping the existing wipable tax data.
1619 sub process_batch_reload {
1620 _process_reload(\&_perform_batch_import, @_);
1623 sub _process_reload {
1624 my ( $continuation, $job, $param ) = @_;
1625 my $format = $param->{'format'};
1627 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1629 if ( $job ) { # progress bar
1630 my $error = $job->update_statustext( 0 );
1631 die $error if $error;
1634 my $oldAutoCommit = $FS::UID::AutoCommit;
1635 local $FS::UID::AutoCommit = 0;
1639 if ( $format =~ /^cch/ ) {
1640 # no, THIS part is CCH specific
1643 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1644 "USING (taxclassnum) WHERE data_vendor = '$format'";
1645 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1647 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1648 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1649 if $sth->fetchrow_arrayref->[0];
1651 # really should get a table EXCLUSIVE lock here
1653 #remember disabled taxes
1654 my %disabled_tax_rate = ();
1655 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1657 #remember tax products
1658 my %taxproduct = ();
1659 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1662 $error ||= _create_temporary_tables( $job, $format );
1666 eval { &{$continuation}( $job, $param ) };
1670 #restore taxproducts
1671 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1675 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1677 #wipe out the old data
1678 $error ||= _remove_old_tax_data( $job, $format );
1681 $error ||= _copy_from_temp( $job, $format );
1683 } elsif ( $format =~ /^billsoft-(\w+)/ ) {
1687 if ( $mode eq 'pcode' ) {
1689 "DELETE FROM cust_tax_location WHERE data_vendor = 'billsoft'",
1690 "UPDATE tax_rate_location SET disabled = 'Y' WHERE data_vendor = 'billsoft'";
1691 } elsif ( $mode eq 'taxclass' ) {
1693 "DELETE FROM tax_class WHERE data_vendor = 'billsoft'";
1694 } elsif ( $mode eq 'taxproduct' ) {
1696 "DELETE FROM part_pkg_taxproduct WHERE data_vendor = 'billsoft'";
1700 if (!$dbh->do($_)) {
1701 $error = $dbh->errstr;
1708 eval { &{ $continuation }($job, $param) };
1711 } # if ($format ...)
1714 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1719 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1723 =item process_download_and_update
1725 Download and process a tax update as a queued JSRPC job
1729 sub process_download_and_update {
1733 my $format = $param->{'format'}; #well... this is all cch specific
1735 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1737 if ( $job ) { # progress bar
1738 my $error = $job->update_statustext( 0);
1739 die $error if $error;
1742 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1743 my $dir = $cache_dir. 'taxdata';
1745 mkdir $dir or die "can't create $dir: $!\n";
1748 if ($format eq 'cch') {
1750 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1752 my $conf = new FS::Conf;
1753 die "direct download of tax data not enabled\n"
1754 unless $conf->exists('taxdatadirectdownload');
1755 my ( $urls, $username, $secret, $states ) =
1756 $conf->config('taxdatadirectdownload');
1757 die "No tax download URL provided. ".
1758 "Did you set the taxdatadirectdownload configuration value?\n"
1766 # really should get a table EXCLUSIVE lock here
1767 # check if initial import or update
1769 # relying on mkdir "$dir.new" as a mutex
1771 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1772 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1773 $sth->execute() or die $sth->errstr;
1774 my $update = $sth->fetchrow_arrayref->[0];
1776 # create cache and/or rotate old tax data
1781 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1782 foreach my $file (readdir($dirh)) {
1783 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1789 for (8, 7, 6, 5, 4, 3, 2, 1) {
1790 if ( -e "$dir.$_" ) {
1791 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1794 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1798 die "can't find previous tax data\n" if $update;
1802 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1804 # fetch and unpack the zip files
1806 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1808 # extract csv files from the dbf files
1810 foreach my $name ( @namelist ) {
1811 _cch_extract_csv_from_dbf( $job, $dir, $name );
1814 # generate the diff files
1817 foreach my $name ( @namelist ) {
1818 my $difffile = "$dir.new/$name.txt";
1820 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1821 die $error if $error;
1822 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1823 my $olddir = $update ? "$dir.1" : "";
1824 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1826 $difffile =~ s/^$cache_dir//;
1827 push @list, "${name}file:$difffile";
1830 # perform the import
1831 local $keep_cch_files = 1;
1832 $param->{uploaded_files} = join( ',', @list );
1833 $param->{format} .= '-update' if $update;
1835 _perform_batch_import( $job, $param );
1837 rename "$dir.new", "$dir"
1838 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1841 die "Unknown format: $format";
1845 =item browse_queries PARAMS
1847 Returns a list consisting of a hashref suited for use as the argument
1848 to qsearch, and sql query string. Each is based on the PARAMS hashref
1849 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1850 from a form. This conveniently creates the query hashref and count_query
1851 string required by the browse and search elements. As a side effect,
1852 the PARAMS hashref is untainted and keys with unexpected values are removed.
1856 sub browse_queries {
1860 'table' => 'tax_rate',
1862 'order_by' => 'ORDER BY geocode, taxclassnum',
1867 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1868 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1870 delete $params->{data_vendor};
1873 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1874 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1875 'geocode LIKE '. dbh->quote($1.'%');
1877 delete $params->{geocode};
1880 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1881 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1884 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1885 ' taxclassnum = '. dbh->quote($1)
1887 delete $params->{taxclassnun};
1891 if ( $params->{tax_type} =~ /^(\d+)$/ );
1892 delete $params->{tax_type}
1896 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1897 delete $params->{tax_cat}
1900 my @taxclassnum = ();
1901 if ($tax_type || $tax_cat ) {
1902 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1903 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1904 @taxclassnum = map { $_->taxclassnum }
1905 qsearch({ 'table' => 'tax_class',
1907 'extra_sql' => "WHERE taxclass $compare",
1911 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1912 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1913 if ( @taxclassnum );
1915 unless ($params->{'showdisabled'}) {
1916 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1917 "( disabled = '' OR disabled IS NULL )";
1920 $query->{extra_sql} = $extra_sql;
1922 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1925 =item queue_liability_report PARAMS
1927 Launches a tax liability report.
1929 PARAMS needs to be a base64-encoded Storable hash containing:
1930 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1931 - end: the end date of the report, likewise.
1932 - agentnum: the agent to limit the report to, if any.
1936 sub queue_liability_report {
1941 $cgi->param('beginning', $param->{beginning});
1942 $cgi->param('ending', $param->{ending});
1943 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1944 my $agentnum = $param->{agentnum};
1945 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1946 generate_liability_report(
1947 'beginning' => $beginning,
1948 'ending' => $ending,
1949 'agentnum' => $agentnum,
1950 'p' => $param->{RootURL},
1955 =item generate_liability_report PARAMS
1957 Generates a tax liability report. PARAMS must include:
1959 - beginning, as a timestamp
1960 - ending, as a timestamp
1961 - p: the Freeside root URL, for generating links
1962 - agentnum (optional)
1966 #shit, all sorts of false laxiness w/report_newtax.cgi
1967 sub generate_liability_report {
1970 my ( $count, $last, $min_sec ) = _progressbar_foo();
1972 #let us open the temp file early
1973 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1974 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1976 UNLINK => 0, # not so temp
1977 ) or die "can't open report file: $!\n";
1979 my $conf = new FS::Conf;
1980 my $money_char = $conf->config('money_char') || '$';
1983 JOIN cust_bill USING ( invnum )
1984 LEFT JOIN cust_main USING ( custnum )
1988 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1989 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1991 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1993 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1996 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1997 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1998 die "agent not found" unless $agent;
1999 $agentname = $agent->agent;
2000 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
2003 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
2004 my @taxparams = qw( city county state locationtaxid );
2005 my @params = ('itemdesc', @taxparams);
2007 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
2009 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
2010 #to FS::Report or FS::Record or who the fuck knows where)
2011 my $scalar_sql = sub {
2012 my( $r, $param, $sql ) = @_;
2013 my $sth = dbh->prepare($sql) or die dbh->errstr;
2014 $sth->execute( map $r->$_(), @$param )
2015 or die "Unexpected error executing statement $sql: ". $sth->errstr;
2016 $sth->fetchrow_arrayref->[0] || 0;
2025 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
2026 # for taxes that have been charged
2027 # (state, county, city are from tax_rate_location, not from customer data)
2028 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
2030 hashref => { pkgpart => 0 },
2031 addl_from => $addl_from,
2032 extra_sql => $where,
2035 $count = scalar(@tax_and_location);
2036 foreach my $t ( @tax_and_location ) {
2039 if ( time - $min_sec > $last ) {
2040 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2047 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
2048 my $label = join('~', map { $t->$_ } @params);
2049 $label = 'Tax'. $label if $label =~ /^~/;
2050 unless ( exists( $taxes{$label} ) ) {
2051 my ($baselabel, @trash) = split /~/, $label;
2053 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
2054 $taxes{$label}->{'url_param'} =
2055 join(';', map { "$_=". uri_escape($t->$_) } @params);
2058 # " payby != 'COMP' ". # breaks the entire report under 4.x
2059 # # and unnecessary since COMP accounts don't
2060 # # get taxes calculated in the first place
2061 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
2062 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
2067 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
2069 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
2071 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2073 $taxes{$label}->{'tax'} += $x;
2076 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2078 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2080 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2081 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2083 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2085 $taxes{$label}->{'credit'} += $y;
2087 unless ( exists( $taxes{$baselabel} ) ) {
2089 $basetaxes{$baselabel}->{'label'} = $baselabel;
2090 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2091 $basetaxes{$baselabel}->{'base'} = 1;
2095 $basetaxes{$baselabel}->{'tax'} += $x;
2096 $basetaxes{$baselabel}->{'credit'} += $y;
2100 # calculate customer-exemption for this tax
2101 # calculate package-exemption for this tax
2102 # calculate monthly exemption (texas tax) for this tax
2103 # count up all the cust_tax_exempt_pkg records associated with
2104 # the actual line items.
2111 $args{job}->update_statustext( "0,Sorted" );
2117 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2118 my ($base, @trash) = split '~', $tax;
2119 my $basetax = delete( $basetaxes{$base} );
2121 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2122 $taxes{$tax}->{base} = 1;
2124 push @taxes, $basetax;
2127 push @taxes, $taxes{$tax};
2134 'credit' => $credit,
2139 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2140 $dateagentlink .= ';agentnum='. $args{agentnum}
2141 if length($agentname);
2142 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2144 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2146 print $report <<EOF;
2148 <% include("/elements/header.html", "$agentname Tax Report - ".
2150 ? time2str('%h %o %Y ', $args{beginning} )
2154 ( $args{ending} == 4294967295
2156 : time2str('%h %o %Y', $args{ending} )
2161 <% include('/elements/table-grid.html') %>
2164 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2165 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2166 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2167 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2168 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2169 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2173 my $bgcolor1 = '#eeeeee';
2174 my $bgcolor2 = '#ffffff';
2177 $count = scalar(@taxes);
2179 foreach my $tax ( @taxes ) {
2182 if ( time - $min_sec > $last ) {
2183 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2190 if ( $bgcolor eq $bgcolor1 ) {
2191 $bgcolor = $bgcolor2;
2193 $bgcolor = $bgcolor1;
2197 if ( $tax->{'label'} ne 'Total' ) {
2198 $link = ';'. $tax->{'url_param'};
2201 print $report <<EOF;
2203 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2204 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2205 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2206 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2208 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2209 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2210 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2211 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2212 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2214 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2219 print $report <<EOF;
2226 my $reportname = $report->filename;
2229 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2230 $reportname =~ s/^$dropstring//;
2232 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2233 die "<a href=$reporturl>view</a>\n";
2243 Highly specific to CCH taxes. This should arguably go in some kind of
2244 subclass (FS::tax_rate::CCH) with auto-reblessing, similar to part_pkg
2245 subclasses. But currently there aren't any other options, so.
2247 Mixing automatic and manual editing works poorly at present.
2249 Tax liability calculations take too long and arguably don't belong here.
2250 Tax liability report generation not entirely safe (escaped).
2252 Sparse documentation.
2256 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>