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();
1369 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1370 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1371 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1372 " optionname LIKE 'usage_taxproductnum_%' AND ".
1373 " optionvalue != '' )";
1374 my @items = qsearch( { table => 'part_pkg',
1375 select => 'DISTINCT pkgpart,taxproductnum',
1377 extra_sql => $extra_sql,
1380 my $count = scalar(@items);
1381 foreach my $part_pkg ( @items ) {
1382 if ( time - $min_sec > $last ) {
1383 $job->update_statustext(
1384 int( 100 * $imported / $count ). ",Remembering tax products"
1389 warn "working with package part ". $part_pkg->pkgpart.
1390 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1391 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1392 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1393 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1395 foreach my $option ( $part_pkg->part_pkg_option ) {
1396 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1399 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1400 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1401 $part_pkg_taxproduct->taxproduct
1402 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1407 sub _restore_remembered_tax_products {
1408 my ( $job, $format, $taxproduct ) = @_;
1412 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1413 my $count = scalar(keys %$taxproduct);
1414 foreach my $pkgpart ( keys %$taxproduct ) {
1415 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1416 if ( time - $min_sec > $last ) {
1417 $job->update_statustext(
1418 int( 100 * $imported / $count ). ",Restoring tax products"
1424 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1425 unless ( $part_pkg ) {
1426 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1429 my %options = $part_pkg->options;
1430 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1431 my $primary_svc = $part_pkg->svcpart;
1432 my $new = new FS::part_pkg { $part_pkg->hash };
1434 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1435 warn "working with class '$class'\n" if $DEBUG;
1436 my $part_pkg_taxproduct =
1437 qsearchs( 'part_pkg_taxproduct',
1438 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1439 data_vendor => $format,
1443 unless ( $part_pkg_taxproduct ) {
1444 return "failed to find part_pkg_taxproduct (".
1445 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1448 if ( $class eq '' ) {
1449 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1453 $options{"usage_taxproductnum_$class"} =
1454 $part_pkg_taxproduct->taxproductnum;
1458 my $error = $new->replace( $part_pkg,
1459 'pkg_svc' => \%pkg_svc,
1460 'primary_svc' => $primary_svc,
1461 'options' => \%options,
1464 return $error if $error;
1471 sub _restore_remembered_disabled_taxes {
1472 my ( $job, $format, $disabled_tax_rate ) = @_;
1474 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1475 my $count = scalar(keys %$disabled_tax_rate);
1476 foreach my $key (keys %$disabled_tax_rate) {
1477 if ( time - $min_sec > $last ) {
1478 $job->update_statustext(
1479 int( 100 * $imported / $count ). ",Disabling tax rates"
1484 my ($geocode,$taxclass) = split /:/, $key, 2;
1485 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1486 taxclass => $taxclass,
1488 return "found multiple tax_class records for format $format class $taxclass"
1489 if scalar(@tax_class) > 1;
1491 unless (scalar(@tax_class)) {
1492 warn "no tax_class for format $format class $taxclass\n";
1497 qsearch('tax_rate', { data_vendor => $format,
1498 geocode => $geocode,
1499 taxclassnum => $tax_class[0]->taxclassnum,
1503 if (scalar(@tax_rate) > 1) {
1504 return "found multiple tax_rate records for format $format geocode ".
1505 "$geocode and taxclass $taxclass ( taxclassnum ".
1506 $tax_class[0]->taxclassnum. " )";
1509 if (scalar(@tax_rate)) {
1510 $tax_rate[0]->disabled('Y');
1511 my $error = $tax_rate[0]->replace;
1512 return $error if $error;
1517 sub _remove_old_tax_data {
1518 my ( $job, $format ) = @_;
1521 my $error = $job->update_statustext( "0,Removing old tax data" );
1522 die $error if $error;
1524 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1525 "WHERE data_vendor = ". $dbh->quote($format);
1526 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1529 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1531 foreach my $table ( @table ) {
1532 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1533 $dbh->quote($format);
1534 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1537 if ( $format eq 'cch' ) {
1538 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1539 $dbh->quote("$format-zip");
1540 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1546 sub _create_temporary_tables {
1547 my ( $job, $format ) = @_;
1550 my $error = $job->update_statustext( "0,Creating temporary tables" );
1551 die $error if $error;
1553 my @table = qw( tax_rate
1560 foreach my $table ( @table ) {
1562 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1563 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1569 sub _copy_from_temp {
1570 my ( $job, $format ) = @_;
1573 my $error = $job->update_statustext( "0,Making permanent" );
1574 die $error if $error;
1576 my @table = qw( tax_rate
1583 foreach my $table ( @table ) {
1585 "INSERT INTO public.$table SELECT * from $table";
1586 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1592 =item process_download_and_reload
1594 Download and process a tax update as a queued JSRPC job after wiping the
1595 existing wipeable tax data.
1599 sub process_download_and_reload {
1600 _process_reload(\&process_download_and_update, @_);
1609 =item process_batch_reload
1611 Load and process a tax update from the provided files as a queued JSRPC job
1612 after wiping the existing wipable tax data.
1616 sub process_batch_reload {
1617 _process_reload(\&_perform_batch_import, @_);
1620 sub _process_reload {
1621 my ( $continuation, $job, $param ) = @_;
1622 my $format = $param->{'format'};
1624 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1626 if ( $job ) { # progress bar
1627 my $error = $job->update_statustext( 0 );
1628 die $error if $error;
1631 my $oldAutoCommit = $FS::UID::AutoCommit;
1632 local $FS::UID::AutoCommit = 0;
1636 if ( $format =~ /^cch/ ) {
1637 # no, THIS part is CCH specific
1640 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1641 "USING (taxclassnum) WHERE data_vendor = '$format'";
1642 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1644 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1645 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1646 if $sth->fetchrow_arrayref->[0];
1648 # really should get a table EXCLUSIVE lock here
1650 #remember disabled taxes
1651 my %disabled_tax_rate = ();
1652 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1654 #remember tax products
1655 my %taxproduct = ();
1656 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1659 $error ||= _create_temporary_tables( $job, $format );
1663 eval { &{$continuation}( $job, $param ) };
1667 #restore taxproducts
1668 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1672 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1674 #wipe out the old data
1675 $error ||= _remove_old_tax_data( $job, $format );
1678 $error ||= _copy_from_temp( $job, $format );
1680 } elsif ( $format =~ /^billsoft-(\w+)/ ) {
1684 if ( $mode eq 'pcode' ) {
1686 "DELETE FROM cust_tax_location WHERE data_vendor = 'billsoft'",
1687 "UPDATE tax_rate_location SET disabled = 'Y' WHERE data_vendor = 'billsoft'";
1688 } elsif ( $mode eq 'taxclass' ) {
1690 "DELETE FROM tax_class WHERE data_vendor = 'billsoft'";
1691 } elsif ( $mode eq 'taxproduct' ) {
1693 "DELETE FROM part_pkg_taxproduct WHERE data_vendor = 'billsoft'";
1697 if (!$dbh->do($_)) {
1698 $error = $dbh->errstr;
1705 eval { &{ $continuation }($job, $param) };
1708 } # if ($format ...)
1711 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1716 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1720 =item process_download_and_update
1722 Download and process a tax update as a queued JSRPC job
1726 sub process_download_and_update {
1730 my $format = $param->{'format'}; #well... this is all cch specific
1732 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1734 if ( $job ) { # progress bar
1735 my $error = $job->update_statustext( 0);
1736 die $error if $error;
1739 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1740 my $dir = $cache_dir. 'taxdata';
1742 mkdir $dir or die "can't create $dir: $!\n";
1745 if ($format eq 'cch') {
1747 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1749 my $conf = new FS::Conf;
1750 die "direct download of tax data not enabled\n"
1751 unless $conf->exists('taxdatadirectdownload');
1752 my ( $urls, $username, $secret, $states ) =
1753 $conf->config('taxdatadirectdownload');
1754 die "No tax download URL provided. ".
1755 "Did you set the taxdatadirectdownload configuration value?\n"
1763 # really should get a table EXCLUSIVE lock here
1764 # check if initial import or update
1766 # relying on mkdir "$dir.new" as a mutex
1768 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1769 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1770 $sth->execute() or die $sth->errstr;
1771 my $update = $sth->fetchrow_arrayref->[0];
1773 # create cache and/or rotate old tax data
1778 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1779 foreach my $file (readdir($dirh)) {
1780 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1786 for (8, 7, 6, 5, 4, 3, 2, 1) {
1787 if ( -e "$dir.$_" ) {
1788 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1791 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1795 die "can't find previous tax data\n" if $update;
1799 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1801 # fetch and unpack the zip files
1803 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1805 # extract csv files from the dbf files
1807 foreach my $name ( @namelist ) {
1808 _cch_extract_csv_from_dbf( $job, $dir, $name );
1811 # generate the diff files
1814 foreach my $name ( @namelist ) {
1815 my $difffile = "$dir.new/$name.txt";
1817 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1818 die $error if $error;
1819 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1820 my $olddir = $update ? "$dir.1" : "";
1821 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1823 $difffile =~ s/^$cache_dir//;
1824 push @list, "${name}file:$difffile";
1827 # perform the import
1828 local $keep_cch_files = 1;
1829 $param->{uploaded_files} = join( ',', @list );
1830 $param->{format} .= '-update' if $update;
1832 _perform_batch_import( $job, $param );
1834 rename "$dir.new", "$dir"
1835 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1838 die "Unknown format: $format";
1842 =item browse_queries PARAMS
1844 Returns a list consisting of a hashref suited for use as the argument
1845 to qsearch, and sql query string. Each is based on the PARAMS hashref
1846 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1847 from a form. This conveniently creates the query hashref and count_query
1848 string required by the browse and search elements. As a side effect,
1849 the PARAMS hashref is untainted and keys with unexpected values are removed.
1853 sub browse_queries {
1857 'table' => 'tax_rate',
1859 'order_by' => 'ORDER BY geocode, taxclassnum',
1864 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1865 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1867 delete $params->{data_vendor};
1870 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1871 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1872 'geocode LIKE '. dbh->quote($1.'%');
1874 delete $params->{geocode};
1877 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1878 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1881 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1882 ' taxclassnum = '. dbh->quote($1)
1884 delete $params->{taxclassnun};
1888 if ( $params->{tax_type} =~ /^(\d+)$/ );
1889 delete $params->{tax_type}
1893 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1894 delete $params->{tax_cat}
1897 my @taxclassnum = ();
1898 if ($tax_type || $tax_cat ) {
1899 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1900 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1901 @taxclassnum = map { $_->taxclassnum }
1902 qsearch({ 'table' => 'tax_class',
1904 'extra_sql' => "WHERE taxclass $compare",
1908 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1909 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1910 if ( @taxclassnum );
1912 unless ($params->{'showdisabled'}) {
1913 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1914 "( disabled = '' OR disabled IS NULL )";
1917 $query->{extra_sql} = $extra_sql;
1919 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1922 =item queue_liability_report PARAMS
1924 Launches a tax liability report.
1926 PARAMS needs to be a base64-encoded Storable hash containing:
1927 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1928 - end: the end date of the report, likewise.
1929 - agentnum: the agent to limit the report to, if any.
1933 sub queue_liability_report {
1938 $cgi->param('beginning', $param->{beginning});
1939 $cgi->param('ending', $param->{ending});
1940 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1941 my $agentnum = $param->{agentnum};
1942 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1943 generate_liability_report(
1944 'beginning' => $beginning,
1945 'ending' => $ending,
1946 'agentnum' => $agentnum,
1947 'p' => $param->{RootURL},
1952 =item generate_liability_report PARAMS
1954 Generates a tax liability report. PARAMS must include:
1956 - beginning, as a timestamp
1957 - ending, as a timestamp
1958 - p: the Freeside root URL, for generating links
1959 - agentnum (optional)
1963 #shit, all sorts of false laxiness w/report_newtax.cgi
1964 sub generate_liability_report {
1967 my ( $count, $last, $min_sec ) = _progressbar_foo();
1969 #let us open the temp file early
1970 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1971 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1973 UNLINK => 0, # not so temp
1974 ) or die "can't open report file: $!\n";
1976 my $conf = new FS::Conf;
1977 my $money_char = $conf->config('money_char') || '$';
1980 JOIN cust_bill USING ( invnum )
1981 LEFT JOIN cust_main USING ( custnum )
1985 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1986 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1988 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1990 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1993 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1994 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1995 die "agent not found" unless $agent;
1996 $agentname = $agent->agent;
1997 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
2000 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
2001 my @taxparams = qw( city county state locationtaxid );
2002 my @params = ('itemdesc', @taxparams);
2004 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
2006 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
2007 #to FS::Report or FS::Record or who the fuck knows where)
2008 my $scalar_sql = sub {
2009 my( $r, $param, $sql ) = @_;
2010 my $sth = dbh->prepare($sql) or die dbh->errstr;
2011 $sth->execute( map $r->$_(), @$param )
2012 or die "Unexpected error executing statement $sql: ". $sth->errstr;
2013 $sth->fetchrow_arrayref->[0] || 0;
2022 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
2023 # for taxes that have been charged
2024 # (state, county, city are from tax_rate_location, not from customer data)
2025 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
2027 hashref => { pkgpart => 0 },
2028 addl_from => $addl_from,
2029 extra_sql => $where,
2032 $count = scalar(@tax_and_location);
2033 foreach my $t ( @tax_and_location ) {
2036 if ( time - $min_sec > $last ) {
2037 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2044 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
2045 my $label = join('~', map { $t->$_ } @params);
2046 $label = 'Tax'. $label if $label =~ /^~/;
2047 unless ( exists( $taxes{$label} ) ) {
2048 my ($baselabel, @trash) = split /~/, $label;
2050 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
2051 $taxes{$label}->{'url_param'} =
2052 join(';', map { "$_=". uri_escape($t->$_) } @params);
2055 # " payby != 'COMP' ". # breaks the entire report under 4.x
2056 # # and unnecessary since COMP accounts don't
2057 # # get taxes calculated in the first place
2058 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
2059 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
2064 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
2066 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
2068 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2070 $taxes{$label}->{'tax'} += $x;
2073 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2075 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2077 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2078 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2080 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2082 $taxes{$label}->{'credit'} += $y;
2084 unless ( exists( $taxes{$baselabel} ) ) {
2086 $basetaxes{$baselabel}->{'label'} = $baselabel;
2087 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2088 $basetaxes{$baselabel}->{'base'} = 1;
2092 $basetaxes{$baselabel}->{'tax'} += $x;
2093 $basetaxes{$baselabel}->{'credit'} += $y;
2097 # calculate customer-exemption for this tax
2098 # calculate package-exemption for this tax
2099 # calculate monthly exemption (texas tax) for this tax
2100 # count up all the cust_tax_exempt_pkg records associated with
2101 # the actual line items.
2108 $args{job}->update_statustext( "0,Sorted" );
2114 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2115 my ($base, @trash) = split '~', $tax;
2116 my $basetax = delete( $basetaxes{$base} );
2118 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2119 $taxes{$tax}->{base} = 1;
2121 push @taxes, $basetax;
2124 push @taxes, $taxes{$tax};
2131 'credit' => $credit,
2136 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2137 $dateagentlink .= ';agentnum='. $args{agentnum}
2138 if length($agentname);
2139 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2141 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2143 print $report <<EOF;
2145 <% include("/elements/header.html", "$agentname Tax Report - ".
2147 ? time2str('%h %o %Y ', $args{beginning} )
2151 ( $args{ending} == 4294967295
2153 : time2str('%h %o %Y', $args{ending} )
2158 <% include('/elements/table-grid.html') %>
2161 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2162 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2163 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2164 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2165 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2166 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2170 my $bgcolor1 = '#eeeeee';
2171 my $bgcolor2 = '#ffffff';
2174 $count = scalar(@taxes);
2176 foreach my $tax ( @taxes ) {
2179 if ( time - $min_sec > $last ) {
2180 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2187 if ( $bgcolor eq $bgcolor1 ) {
2188 $bgcolor = $bgcolor2;
2190 $bgcolor = $bgcolor1;
2194 if ( $tax->{'label'} ne 'Total' ) {
2195 $link = ';'. $tax->{'url_param'};
2198 print $report <<EOF;
2200 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2201 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2202 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2203 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2205 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2206 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2207 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2208 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2209 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2211 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2216 print $report <<EOF;
2223 my $reportname = $report->filename;
2226 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2227 $reportname =~ s/^$dropstring//;
2229 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2230 die "<a href=$reporturl>view</a>\n";
2240 Highly specific to CCH taxes. This should arguably go in some kind of
2241 subclass (FS::tax_rate::CCH) with auto-reblessing, similar to part_pkg
2242 subclasses. But currently there aren't any other options, so.
2244 Mixing automatic and manual editing works poorly at present.
2246 Tax liability calculations take too long and arguably don't belong here.
2247 Tax liability report generation not entirely safe (escaped).
2249 Sparse documentation.
2253 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>