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;
11 use Storable qw( thaw nfreeze );
21 use DBIx::DBSchema::Table;
22 use DBIx::DBSchema::Column;
23 use FS::Record qw( qsearch qsearchs dbh dbdef );
26 use FS::cust_bill_pkg;
27 use FS::cust_tax_location;
28 use FS::tax_rate_location;
29 use FS::part_pkg_taxrate;
30 use FS::part_pkg_taxproduct;
32 use FS::Misc qw( csv_from_fixed );
35 $me = '[FS::tax_rate]';
40 FS::tax_rate - Object methods for tax_rate objects
46 $record = new FS::tax_rate \%hash;
47 $record = new FS::tax_rate { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
59 An FS::tax_rate object represents a tax rate, defined by locale.
60 FS::tax_rate inherits from FS::Record. The following fields are
67 primary key (assigned automatically for new tax rates)
71 a geographic location code provided by a tax data vendor
79 a location code provided by a tax authority
83 a foreign key into FS::tax_class - the type of tax
84 referenced but FS::part_pkg_taxrate
87 the time after which the tax applies
95 second bracket percentage
99 the amount to which the tax applies (first bracket)
103 a cap on the amount of tax if a cap exists
107 percentage on out of jurisdiction purchases
111 second bracket percentage on out of jurisdiction purchases
115 one of the values in %tax_unittypes
119 amount of tax per unit
123 second bracket amount of tax per unit
127 the number of units to which the fee applies (first bracket)
131 the most units to which fees apply (first and second brackets)
135 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
139 if defined, printed on invoices instead of "Tax"
143 a value from %tax_authorities
147 a value from %tax_basetypes indicating the tax basis
151 a value from %tax_passtypes indicating how the tax should displayed to the customer
155 'Y', 'N', or blank indicating the tax can be passed to the customer
159 if 'Y', this tax does not apply to setup fees
163 if 'Y', this tax does not apply to recurring fees
167 if 'Y', has been manually edited
177 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
181 sub table { 'tax_rate'; }
185 Adds this tax rate to the database. If there is an error, returns the error,
186 otherwise returns false.
190 Deletes this tax rate from the database. If there is an error, returns the
191 error, otherwise returns false.
193 =item replace OLD_RECORD
195 Replaces the OLD_RECORD with this one in the database. If there is an error,
196 returns the error, otherwise returns false.
200 Checks all fields to make sure this is a valid tax rate. If there is an error,
201 returns the error, otherwise returns false. Called by the insert and replace
209 foreach (qw( taxbase taxmax )) {
210 $self->$_(0) unless $self->$_;
213 $self->ut_numbern('taxnum')
214 || $self->ut_text('geocode')
215 || $self->ut_textn('data_vendor')
216 || $self->ut_cch_textn('location')
217 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
218 || $self->ut_snumbern('effective_date')
219 || $self->ut_float('tax')
220 || $self->ut_floatn('excessrate')
221 || $self->ut_money('taxbase')
222 || $self->ut_money('taxmax')
223 || $self->ut_floatn('usetax')
224 || $self->ut_floatn('useexcessrate')
225 || $self->ut_numbern('unittype')
226 || $self->ut_floatn('fee')
227 || $self->ut_floatn('excessfee')
228 || $self->ut_floatn('feemax')
229 || $self->ut_numbern('maxtype')
230 || $self->ut_textn('taxname')
231 || $self->ut_numbern('taxauth')
232 || $self->ut_numbern('basetype')
233 || $self->ut_numbern('passtype')
234 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
235 || $self->ut_enum('setuptax', [ '', 'Y' ] )
236 || $self->ut_enum('recurtax', [ '', 'Y' ] )
237 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
238 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
239 || $self->ut_enum('manual', [ '', 'Y' ] )
240 || $self->ut_enum('disabled', [ '', 'Y' ] )
241 || $self->SUPER::check
246 #ut_text / ut_textn w/ ` added cause now that's in the data
249 $self->getfield($field)
250 =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
251 or return gettext('illegal_or_empty_text'). " $field: ".
252 $self->getfield($field);
253 $self->setfield($field,$1);
258 =item taxclass_description
260 Returns the human understandable value associated with the related
265 sub taxclass_description {
267 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
268 $tax_class ? $tax_class->description : '';
273 Returns the human understandable value associated with the unittype column
277 %tax_unittypes = ( '0' => 'access line',
284 $tax_unittypes{$self->unittype};
289 Returns the human understandable value associated with the maxtype column.
293 # XXX these are non-functional, and most of them are horrible to implement
294 # in our current model
296 %tax_maxtypes = ( '0' => 'receipts per invoice',
297 '1' => 'receipts per item',
298 '2' => 'total utility charges per utility tax year',
299 '3' => 'total charges per utility tax year',
300 '4' => 'receipts per access line',
301 '7' => 'total utility charges per calendar year',
302 '9' => 'monthly receipts per location',
303 '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
304 '11' => 'receipts/units per access line',
305 '14' => 'units per invoice',
306 '15' => 'units per month',
307 '18' => 'units per account',
312 $tax_maxtypes{$self->maxtype};
317 Returns the human understandable value associated with the basetype column
321 %tax_basetypes = ( '0' => 'sale price',
322 '1' => 'gross receipts',
323 '2' => 'sales taxable telecom revenue',
324 '3' => 'minutes carried',
325 '4' => 'minutes billed',
326 '5' => 'gross operating revenue',
327 '6' => 'access line',
329 '8' => 'gross revenue',
330 '9' => 'portion gross receipts attributable to interstate service',
331 '10' => 'access line',
332 '11' => 'gross profits',
333 '12' => 'tariff rate',
335 '15' => 'prior year gross receipts',
340 $tax_basetypes{$self->basetype};
345 Returns the human understandable value associated with the taxauth column
349 %tax_authorities = ( '0' => 'federal',
354 '5' => 'county administered by state',
355 '6' => 'city administered by state',
356 '7' => 'city administered by county',
357 '8' => 'local administered by state',
358 '9' => 'local administered by county',
363 $tax_authorities{$self->taxauth};
368 Returns the human understandable value associated with the passtype column
372 %tax_passtypes = ( '0' => 'separate tax line',
373 '1' => 'separate surcharge line',
374 '2' => 'surcharge not separated',
375 '3' => 'included in base rate',
380 $tax_passtypes{$self->passtype};
383 =item taxline TAXABLES
385 Returns a listref of a name and an amount of tax calculated for the list
386 of packages/amounts referenced by TAXABLES. If an error occurs, a message
387 is returned as a scalar.
393 # this used to accept a hash of options but none of them did anything
394 # so it's been removed.
398 if (ref($_[0]) eq 'ARRAY') {
402 #exemptions would be broken in this case
405 my $name = $self->taxname;
406 $name = 'Other surcharges'
407 if ($self->passtype == 2);
410 if ( $self->disabled ) { # we always know how to handle disabled taxes
417 my $taxable_charged = 0;
418 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
421 warn "calculating taxes for ". $self->taxnum. " on ".
422 join (",", map { $_->pkgnum } @cust_bill_pkg)
425 if ($self->passflag eq 'N') {
426 # return "fatal: can't (yet) handle taxes not passed to the customer";
427 # until someone needs to track these in freeside
434 my $maxtype = $self->maxtype || 0;
435 if ($maxtype != 0 && $maxtype != 1
436 && $maxtype != 14 && $maxtype != 15) {
437 return $self->_fatal_or_null( 'tax with "'.
438 $self->maxtype_name. '" threshold'
440 } # I don't know why, it's not like there are maxtypes that we DO support
442 # we treat gross revenue as gross receipts and expect the tax data
443 # to DTRT (i.e. tax on tax rules)
444 if ($self->basetype != 0 && $self->basetype != 1 &&
445 $self->basetype != 5 && $self->basetype != 6 &&
446 $self->basetype != 7 && $self->basetype != 8 &&
447 $self->basetype != 14
450 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
453 unless ($self->setuptax =~ /^Y$/i) {
454 $taxable_charged += $_->setup foreach @cust_bill_pkg;
456 unless ($self->recurtax =~ /^Y$/i) {
457 $taxable_charged += $_->recur foreach @cust_bill_pkg;
460 my $taxable_units = 0;
461 unless ($self->recurtax =~ /^Y$/i) {
463 if (( $self->unittype || 0 ) == 0) { #access line
465 foreach (@cust_bill_pkg) {
466 $taxable_units += $_->units
467 unless $seen{$_->pkgnum}++;
470 } elsif ($self->unittype == 1) { #minute
471 return $self->_fatal_or_null( 'fee with minute unit type' );
473 } elsif ($self->unittype == 2) { #account
475 my $conf = new FS::Conf;
476 if ( $conf->exists('tax-pkg_address') ) {
477 #number of distinct locations
479 foreach (@cust_bill_pkg) {
481 unless $seen{$_->cust_pkg->locationnum}++;
488 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
493 # XXX handle excessrate (use_excessrate) / excessfee /
494 # taxbase/feebase / taxmax/feemax
495 # and eventually exemptions
497 # the tax or fee is applied to taxbase or feebase and then
498 # the excessrate or excess fee is applied to taxmax or feemax
500 if ( ($self->taxmax > 0 and $taxable_charged > $self->taxmax) or
501 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
503 # (why not just cap taxable_charged/units at the taxmax/feemax? because
504 # it's way more complicated than that. this won't even catch every case
505 # where a bracket maximum should apply.)
506 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
509 $amount += $taxable_charged * $self->tax;
510 $amount += $taxable_units * $self->fee;
512 warn "calculated taxes as [ $name, $amount ]\n"
523 my ($self, $error) = @_;
525 $DB::single = 1; # not a mistake
527 my $conf = new FS::Conf;
529 $error = "can't yet handle ". $error;
530 my $name = $self->taxname;
531 $name = 'Other surcharges'
532 if ($self->passtype == 2);
534 if ($conf->exists('ignore_incalculable_taxes')) {
535 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
536 return { name => $name, amount => 0 };
538 return "fatal: $error";
542 =item tax_on_tax CUST_LOCATION
544 Returns a list of taxes which are candidates for taxing taxes for the
545 given service location (see L<FS::cust_location>)
553 my $cust_location = shift;
555 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
556 $cust_location->custnum
559 my $geocode = $cust_location->geocode($self->data_vendor);
563 my $extra_sql = ' AND ('.
564 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
569 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
570 my $select = 'DISTINCT ON(taxclassnum) *';
572 # should qsearch preface columns with the table to facilitate joins?
573 my @taxclassnums = map { $_->taxclassnum }
574 qsearch( { 'table' => 'part_pkg_taxrate',
576 'hashref' => { 'data_vendor' => $self->data_vendor,
577 'taxclassnumtaxed' => $self->taxclassnum,
579 'extra_sql' => $extra_sql,
580 'order_by' => $order_by,
583 return () unless @taxclassnums;
586 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
588 qsearch({ 'table' => 'tax_rate',
589 'hashref' => { 'geocode' => $geocode, },
590 'extra_sql' => $extra_sql,
595 =item tax_rate_location
597 Returns an object representing the location associated with this tax
598 (see L<FS::tax_rate_location>)
602 sub tax_rate_location {
605 qsearchs({ 'table' => 'tax_rate_location',
606 'hashref' => { 'data_vendor' => $self->data_vendor,
607 'geocode' => $self->geocode,
611 new FS::tax_rate_location;
625 sub _progressbar_foo {
630 my ($param, $job) = @_;
632 my $fh = $param->{filehandle};
633 my $format = $param->{'format'};
641 my @column_lengths = ();
642 my @column_callbacks = ();
643 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
644 $format =~ s/-fixed//;
645 my $date_format = sub { my $r='';
646 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
649 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
650 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 );
651 push @column_lengths, 1 if $format eq 'cch-update';
652 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
653 $column_callbacks[8] = $date_format;
657 my ( $count, $last, $min_sec ) = _progressbar_foo();
658 if ( $job || scalar(@column_callbacks) ) {
660 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
661 return $error if $error;
665 if ( $format eq 'cch' || $format eq 'cch-update' ) {
666 #false laziness w/below (sub _perform_cch_diff)
667 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
668 excessrate effective_date taxauth taxtype taxcat taxname
669 usetax useexcessrate fee unittype feemax maxtype passflag
671 push @fields, 'actionflag' if $format eq 'cch-update';
676 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
677 $hash->{'data_vendor'} ='cch';
678 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
679 time_zone => 'floating',
681 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
682 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
684 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
685 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
688 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
690 my %tax_class = ( 'data_vendor' => 'cch',
691 'taxclass' => $taxclassid,
694 my $tax_class = qsearchs( 'tax_class', \%tax_class );
695 return "Error updating tax rate: no tax class $taxclassid"
698 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
700 foreach (qw( taxtype taxcat )) {
704 my %passflagmap = ( '0' => '',
708 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
709 if exists $passflagmap{$hash->{'passflag'}};
711 foreach (keys %$hash) {
712 $hash->{$_} = substr($hash->{$_}, 0, 80)
713 if length($hash->{$_}) > 80;
716 my $actionflag = delete($hash->{'actionflag'});
718 $hash->{'taxname'} =~ s/`/'/g;
719 $hash->{'taxname'} =~ s|\\|/|g;
721 return '' if $format eq 'cch'; # but not cch-update
723 if ($actionflag eq 'I') {
724 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
725 }elsif ($actionflag eq 'D') {
726 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
728 return "Unexpected action flag: ". $hash->{'actionflag'};
731 delete($hash->{$_}) for keys %$hash;
737 } elsif ( $format eq 'extended' ) {
738 die "unimplemented\n";
742 die "unknown format $format";
745 my $csv = new Text::CSV_XS;
749 local $SIG{HUP} = 'IGNORE';
750 local $SIG{INT} = 'IGNORE';
751 local $SIG{QUIT} = 'IGNORE';
752 local $SIG{TERM} = 'IGNORE';
753 local $SIG{TSTP} = 'IGNORE';
754 local $SIG{PIPE} = 'IGNORE';
756 my $oldAutoCommit = $FS::UID::AutoCommit;
757 local $FS::UID::AutoCommit = 0;
760 while ( defined($line=<$fh>) ) {
761 $csv->parse($line) or do {
762 $dbh->rollback if $oldAutoCommit;
763 return "can't parse: ". $csv->error_input();
766 if ( $job ) { # progress bar
767 if ( time - $min_sec > $last ) {
768 my $error = $job->update_statustext(
769 int( 100 * $imported / $count ). ",Importing tax rates"
772 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
779 my @columns = $csv->fields();
781 my %tax_rate = ( 'data_vendor' => $format );
782 foreach my $field ( @fields ) {
783 $tax_rate{$field} = shift @columns;
786 if ( scalar( @columns ) ) {
787 $dbh->rollback if $oldAutoCommit;
788 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
791 my $error = &{$hook}(\%tax_rate);
793 $dbh->rollback if $oldAutoCommit;
797 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
799 my $tax_rate = new FS::tax_rate( \%tax_rate );
800 $error = $tax_rate->insert;
803 $dbh->rollback if $oldAutoCommit;
804 return "can't insert tax_rate for $line: $error";
813 my @replace = grep { exists($delete{$_}) } keys %insert;
815 if ( $job ) { # progress bar
816 if ( time - $min_sec > $last ) {
817 my $error = $job->update_statustext(
818 int( 100 * $imported / $count ). ",Importing tax rates"
821 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
828 my $old = qsearchs( 'tax_rate', $delete{$_} );
832 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
833 $new->taxnum($old->taxnum);
834 my $error = $new->replace($old);
837 $dbh->rollback if $oldAutoCommit;
838 my $hashref = $insert{$_};
839 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
840 return "can't replace tax_rate for $line: $error";
847 $old = delete $delete{$_};
848 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
849 #join(" ", map { "$_ => ". $old->{$_} } @fields);
850 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
856 for (grep { !exists($delete{$_}) } keys %insert) {
857 if ( $job ) { # progress bar
858 if ( time - $min_sec > $last ) {
859 my $error = $job->update_statustext(
860 int( 100 * $imported / $count ). ",Importing tax rates"
863 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
870 my $tax_rate = new FS::tax_rate( $insert{$_} );
871 my $error = $tax_rate->insert;
874 $dbh->rollback if $oldAutoCommit;
875 my $hashref = $insert{$_};
876 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
877 return "can't insert tax_rate for $line: $error";
883 for (grep { !exists($insert{$_}) } keys %delete) {
884 if ( $job ) { # progress bar
885 if ( time - $min_sec > $last ) {
886 my $error = $job->update_statustext(
887 int( 100 * $imported / $count ). ",Importing tax rates"
890 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
897 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
899 $dbh->rollback if $oldAutoCommit;
900 $tax_rate = $delete{$_};
901 warn "WARNING: can't find tax_rate to delete for: ".
902 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
905 my $error = $tax_rate->delete; # XXX we really should not do this
906 # (it orphans CBPTRL records)
909 $dbh->rollback if $oldAutoCommit;
910 my $hashref = $delete{$_};
911 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
912 return "can't delete tax_rate for $line: $error";
919 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
921 return "Empty file!" unless ($imported || $format eq 'cch-update');
927 =item process_batch_import
929 Load a batch import as a queued JSRPC job
933 sub process_batch_import {
936 my $oldAutoCommit = $FS::UID::AutoCommit;
937 local $FS::UID::AutoCommit = 0;
940 my $param = thaw(decode_base64(shift));
941 my $args = '$job, encode_base64( nfreeze( $param ) )';
943 my $method = '_perform_batch_import';
944 if ( $param->{reload} ) {
945 $method = 'process_batch_reload';
948 eval "$method($args);";
950 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
955 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
958 sub _perform_batch_import {
961 my $param = thaw(decode_base64(shift));
962 my $format = $param->{'format'}; #well... this is all cch specific
964 my $files = $param->{'uploaded_files'}
965 or die "No files provided.";
967 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
970 if ( $format eq 'cch' || $format eq 'cch-fixed'
971 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
974 my $oldAutoCommit = $FS::UID::AutoCommit;
975 local $FS::UID::AutoCommit = 0;
978 my @insert_list = ();
979 my @delete_list = ();
980 my @predelete_list = ();
983 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
985 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
986 'CODE', \&FS::tax_class::batch_import,
987 'PLUS4', \&FS::cust_tax_location::batch_import,
988 'ZIP', \&FS::cust_tax_location::batch_import,
989 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
990 'DETAIL', \&FS::tax_rate::batch_import,
992 while( scalar(@list) ) {
993 my ( $name, $import_sub ) = splice( @list, 0, 2 );
994 my $file = lc($name). 'file';
996 unless ($files{$file}) {
997 #$error = "No $name supplied";
1000 next if $name eq 'DETAIL' && $format =~ /update/;
1002 my $filename = "$dir/". $files{$file};
1004 if ( $format =~ /update/ ) {
1006 ( $error, $insertname, $deletename ) =
1007 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1011 unlink $filename or warn "Can't delete $filename: $!"
1012 unless $keep_cch_files;
1013 push @insert_list, $name, $insertname, $import_sub, $format;
1014 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1015 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1017 unshift @delete_list, $name, $deletename, $import_sub, $format;
1022 push @insert_list, $name, $filename, $import_sub, $format;
1029 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1030 if $format =~ /update/;
1032 my %addl_param = ();
1033 if ( $param->{'delete_only'} ) {
1034 $addl_param{'delete_only'} = $param->{'delete_only'};
1038 $error ||= _perform_cch_tax_import( $job,
1039 [ @predelete_list ],
1046 @list = ( @predelete_list, @insert_list, @delete_list );
1047 while( !$keep_cch_files && scalar(@list) ) {
1048 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1049 unlink $file or warn "Can't delete $file: $!";
1053 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1056 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1060 die "Unknown format: $format";
1066 sub _perform_cch_tax_import {
1067 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1071 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1072 while( scalar(@$list) ) {
1073 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1074 my $fmt = "$format-update";
1075 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1076 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1077 my $param = { 'filehandle' => $fh,
1081 $error ||= &{$method}($param, $job);
1089 sub _perform_cch_insert_delete_split {
1090 my ($name, $filename, $dir, $format) = @_;
1094 open my $fh, "< $filename"
1095 or $error ||= "Can't open $name file $filename: $!";
1097 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1100 ) or die "can't open temp file: $!\n";
1101 my $insertname = $ifh->filename;
1103 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1106 ) or die "can't open temp file: $!\n";
1107 my $deletename = $dfh->filename;
1109 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1110 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1113 $handle = $ifh if $_ =~ /$insert_pattern/;
1114 $handle = $dfh if $_ =~ /$delete_pattern/;
1116 $error = "bad input line: $_" unless $handle;
1125 return ($error, $insertname, $deletename);
1128 sub _perform_cch_diff {
1129 my ($name, $newdir, $olddir) = @_;
1134 open my $oldcsvfh, "$olddir/$name.txt"
1135 or die "failed to open $olddir/$name.txt: $!\n";
1137 while(<$oldcsvfh>) {
1144 open my $newcsvfh, "$newdir/$name.txt"
1145 or die "failed to open $newdir/$name.txt: $!\n";
1147 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1150 ) or die "can't open temp file: $!\n";
1151 my $diffname = $dfh->filename;
1153 while(<$newcsvfh>) {
1155 if (exists($oldlines{$_})) {
1158 print $dfh $_, ',"I"', "\n";
1163 #false laziness w/above (sub batch_import)
1164 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1165 excessrate effective_date taxauth taxtype taxcat taxname
1166 usetax useexcessrate fee unittype feemax maxtype passflag
1167 passtype basetype );
1168 my $numfields = scalar(@fields);
1170 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1172 for my $line (grep $oldlines{$_}, keys %oldlines) {
1174 $csv->parse($line) or do {
1175 #$dbh->rollback if $oldAutoCommit;
1176 die "can't parse: ". $csv->error_input();
1178 my @columns = $csv->fields();
1180 $csv->combine( splice(@columns, 0, $numfields) );
1182 print $dfh $csv->string, ',"D"', "\n";
1190 sub _cch_fetch_and_unzip {
1191 my ( $job, $urls, $secret, $dir ) = @_;
1193 my $ua = new LWP::UserAgent;
1194 foreach my $url (split ',', $urls) {
1195 my @name = split '/', $url; #somewhat restrictive
1196 my $name = pop @name;
1197 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1200 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1202 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1203 my $res = $ua->request(
1204 new HTTP::Request( GET => $url ),
1206 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1207 my $content_length = $_[1]->content_length;
1208 $imported += length($_[0]);
1209 if ( time - $min_sec > $last ) {
1210 my $error = $job->update_statustext(
1211 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1212 ",Downloading data from CCH"
1214 die $error if $error;
1219 die "download of $url failed: ". $res->status_line
1220 unless $res->is_success;
1223 my $error = $job->update_statustext( "0,Unpacking data" );
1224 die $error if $error;
1225 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1227 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1228 or die "unzip -P $secret -d $dir $dir/$name failed";
1229 #unlink "$dir/$name";
1233 sub _cch_extract_csv_from_dbf {
1234 my ( $job, $dir, $name ) = @_;
1239 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1240 my $error = $job->update_statustext( "0,Unpacking $name" );
1241 die $error if $error;
1242 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1243 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1244 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1245 unless defined($table);
1246 my $count = $table->last_record; # approximately;
1247 open my $csvfh, ">$dir.new/$name.txt"
1248 or die "failed to open $dir.new/$name.txt: $!\n";
1250 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1251 my @fields = $table->field_names;
1252 my $cursor = $table->prepare_select;
1254 sub { my $date = shift;
1255 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1258 while (my $row = $cursor->fetch_hashref) {
1259 $csv->combine( map { my $type = $table->field_type($_);
1261 &{$format_date}($row->{$_}) ;
1262 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1263 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1270 print $csvfh $csv->string, "\n";
1272 if ( time - $min_sec > $last ) {
1273 my $error = $job->update_statustext(
1274 int(100 * $imported/$count). ",Unpacking $name"
1276 die $error if $error;
1284 sub _remember_disabled_taxes {
1285 my ( $job, $format, $disabled_tax_rate ) = @_;
1289 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1291 my @items = qsearch( { table => 'tax_rate',
1292 hashref => { disabled => 'Y',
1293 data_vendor => $format,
1295 select => 'geocode, taxclassnum',
1298 my $count = scalar(@items);
1299 foreach my $tax_rate ( @items ) {
1300 if ( time - $min_sec > $last ) {
1301 $job->update_statustext(
1302 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1308 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1309 unless ( $tax_class ) {
1310 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1313 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1317 sub _remember_tax_products {
1318 my ( $job, $format, $taxproduct ) = @_;
1320 # XXX FIXME this loop only works when cch is the only data provider
1322 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1324 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1325 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1326 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1327 " optionname LIKE 'usage_taxproductnum_%' AND ".
1328 " optionvalue != '' )";
1329 my @items = qsearch( { table => 'part_pkg',
1330 select => 'DISTINCT pkgpart,taxproductnum',
1332 extra_sql => $extra_sql,
1335 my $count = scalar(@items);
1336 foreach my $part_pkg ( @items ) {
1337 if ( time - $min_sec > $last ) {
1338 $job->update_statustext(
1339 int( 100 * $imported / $count ). ",Remembering tax products"
1344 warn "working with package part ". $part_pkg->pkgpart.
1345 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1346 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1347 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1348 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1350 foreach my $option ( $part_pkg->part_pkg_option ) {
1351 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1354 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1355 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1356 $part_pkg_taxproduct->taxproduct
1357 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1362 sub _restore_remembered_tax_products {
1363 my ( $job, $format, $taxproduct ) = @_;
1367 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1368 my $count = scalar(keys %$taxproduct);
1369 foreach my $pkgpart ( keys %$taxproduct ) {
1370 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1371 if ( time - $min_sec > $last ) {
1372 $job->update_statustext(
1373 int( 100 * $imported / $count ). ",Restoring tax products"
1379 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1380 unless ( $part_pkg ) {
1381 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1384 my %options = $part_pkg->options;
1385 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1386 my $primary_svc = $part_pkg->svcpart;
1387 my $new = new FS::part_pkg { $part_pkg->hash };
1389 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1390 warn "working with class '$class'\n" if $DEBUG;
1391 my $part_pkg_taxproduct =
1392 qsearchs( 'part_pkg_taxproduct',
1393 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1394 data_vendor => $format,
1398 unless ( $part_pkg_taxproduct ) {
1399 return "failed to find part_pkg_taxproduct (".
1400 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1403 if ( $class eq '' ) {
1404 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1408 $options{"usage_taxproductnum_$class"} =
1409 $part_pkg_taxproduct->taxproductnum;
1413 my $error = $new->replace( $part_pkg,
1414 'pkg_svc' => \%pkg_svc,
1415 'primary_svc' => $primary_svc,
1416 'options' => \%options,
1419 return $error if $error;
1426 sub _restore_remembered_disabled_taxes {
1427 my ( $job, $format, $disabled_tax_rate ) = @_;
1429 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1430 my $count = scalar(keys %$disabled_tax_rate);
1431 foreach my $key (keys %$disabled_tax_rate) {
1432 if ( time - $min_sec > $last ) {
1433 $job->update_statustext(
1434 int( 100 * $imported / $count ). ",Disabling tax rates"
1439 my ($geocode,$taxclass) = split /:/, $key, 2;
1440 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1441 taxclass => $taxclass,
1443 return "found multiple tax_class records for format $format class $taxclass"
1444 if scalar(@tax_class) > 1;
1446 unless (scalar(@tax_class)) {
1447 warn "no tax_class for format $format class $taxclass\n";
1452 qsearch('tax_rate', { data_vendor => $format,
1453 geocode => $geocode,
1454 taxclassnum => $tax_class[0]->taxclassnum,
1458 if (scalar(@tax_rate) > 1) {
1459 return "found multiple tax_rate records for format $format geocode ".
1460 "$geocode and taxclass $taxclass ( taxclassnum ".
1461 $tax_class[0]->taxclassnum. " )";
1464 if (scalar(@tax_rate)) {
1465 $tax_rate[0]->disabled('Y');
1466 my $error = $tax_rate[0]->replace;
1467 return $error if $error;
1472 sub _remove_old_tax_data {
1473 my ( $job, $format ) = @_;
1476 my $error = $job->update_statustext( "0,Removing old tax data" );
1477 die $error if $error;
1479 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1480 "WHERE data_vendor = ". $dbh->quote($format);
1481 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1484 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1486 foreach my $table ( @table ) {
1487 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1488 $dbh->quote($format);
1489 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1492 if ( $format eq 'cch' ) {
1493 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1494 $dbh->quote("$format-zip");
1495 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1501 sub _create_temporary_tables {
1502 my ( $job, $format ) = @_;
1505 my $error = $job->update_statustext( "0,Creating temporary tables" );
1506 die $error if $error;
1508 my @table = qw( tax_rate
1515 foreach my $table ( @table ) {
1517 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1518 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1524 sub _copy_from_temp {
1525 my ( $job, $format ) = @_;
1528 my $error = $job->update_statustext( "0,Making permanent" );
1529 die $error if $error;
1531 my @table = qw( tax_rate
1538 foreach my $table ( @table ) {
1540 "INSERT INTO public.$table SELECT * from $table";
1541 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1547 =item process_download_and_reload
1549 Download and process a tax update as a queued JSRPC job after wiping the
1550 existing wipable tax data.
1554 sub process_download_and_reload {
1555 _process_reload('process_download_and_update', @_);
1559 =item process_batch_reload
1561 Load and process a tax update from the provided files as a queued JSRPC job
1562 after wiping the existing wipable tax data.
1566 sub process_batch_reload {
1567 _process_reload('_perform_batch_import', @_);
1571 sub _process_reload {
1572 my ( $method, $job ) = ( shift, shift );
1574 my $param = thaw(decode_base64($_[0]));
1575 my $format = $param->{'format'}; #well... this is all cch specific
1577 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1579 if ( $job ) { # progress bar
1580 my $error = $job->update_statustext( 0 );
1581 die $error if $error;
1584 my $oldAutoCommit = $FS::UID::AutoCommit;
1585 local $FS::UID::AutoCommit = 0;
1590 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1591 "USING (taxclassnum) WHERE data_vendor = '$format'";
1592 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1594 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1595 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1596 if $sth->fetchrow_arrayref->[0];
1598 # really should get a table EXCLUSIVE lock here
1600 #remember disabled taxes
1601 my %disabled_tax_rate = ();
1602 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1604 #remember tax products
1605 my %taxproduct = ();
1606 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1609 $error ||= _create_temporary_tables( $job, $format );
1613 my $args = '$job, @_';
1614 eval "$method($args);";
1618 #restore taxproducts
1619 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1623 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1625 #wipe out the old data
1626 $error ||= _remove_old_tax_data( $job, $format );
1629 $error ||= _copy_from_temp( $job, $format );
1632 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1637 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1641 =item process_download_and_update
1643 Download and process a tax update as a queued JSRPC job
1647 sub process_download_and_update {
1650 my $param = thaw(decode_base64(shift));
1651 my $format = $param->{'format'}; #well... this is all cch specific
1653 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1655 if ( $job ) { # progress bar
1656 my $error = $job->update_statustext( 0);
1657 die $error if $error;
1660 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1661 my $dir = $cache_dir. 'taxdata';
1663 mkdir $dir or die "can't create $dir: $!\n";
1666 if ($format eq 'cch') {
1668 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1670 my $conf = new FS::Conf;
1671 die "direct download of tax data not enabled\n"
1672 unless $conf->exists('taxdatadirectdownload');
1673 my ( $urls, $username, $secret, $states ) =
1674 $conf->config('taxdatadirectdownload');
1675 die "No tax download URL provided. ".
1676 "Did you set the taxdatadirectdownload configuration value?\n"
1684 # really should get a table EXCLUSIVE lock here
1685 # check if initial import or update
1687 # relying on mkdir "$dir.new" as a mutex
1689 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1690 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1691 $sth->execute() or die $sth->errstr;
1692 my $update = $sth->fetchrow_arrayref->[0];
1694 # create cache and/or rotate old tax data
1699 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1700 foreach my $file (readdir($dirh)) {
1701 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1707 for (8, 7, 6, 5, 4, 3, 2, 1) {
1708 if ( -e "$dir.$_" ) {
1709 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1712 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1716 die "can't find previous tax data\n" if $update;
1720 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1722 # fetch and unpack the zip files
1724 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1726 # extract csv files from the dbf files
1728 foreach my $name ( @namelist ) {
1729 _cch_extract_csv_from_dbf( $job, $dir, $name );
1732 # generate the diff files
1735 foreach my $name ( @namelist ) {
1736 my $difffile = "$dir.new/$name.txt";
1738 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1739 die $error if $error;
1740 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1741 my $olddir = $update ? "$dir.1" : "";
1742 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1744 $difffile =~ s/^$cache_dir//;
1745 push @list, "${name}file:$difffile";
1748 # perform the import
1749 local $keep_cch_files = 1;
1750 $param->{uploaded_files} = join( ',', @list );
1751 $param->{format} .= '-update' if $update;
1753 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1755 rename "$dir.new", "$dir"
1756 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1759 die "Unknown format: $format";
1763 =item browse_queries PARAMS
1765 Returns a list consisting of a hashref suited for use as the argument
1766 to qsearch, and sql query string. Each is based on the PARAMS hashref
1767 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1768 from a form. This conveniently creates the query hashref and count_query
1769 string required by the browse and search elements. As a side effect,
1770 the PARAMS hashref is untainted and keys with unexpected values are removed.
1774 sub browse_queries {
1778 'table' => 'tax_rate',
1780 'order_by' => 'ORDER BY geocode, taxclassnum',
1785 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1786 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1788 delete $params->{data_vendor};
1791 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1792 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1793 'geocode LIKE '. dbh->quote($1.'%');
1795 delete $params->{geocode};
1798 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1799 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1802 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1803 ' taxclassnum = '. dbh->quote($1)
1805 delete $params->{taxclassnun};
1809 if ( $params->{tax_type} =~ /^(\d+)$/ );
1810 delete $params->{tax_type}
1814 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1815 delete $params->{tax_cat}
1818 my @taxclassnum = ();
1819 if ($tax_type || $tax_cat ) {
1820 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1821 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1822 @taxclassnum = map { $_->taxclassnum }
1823 qsearch({ 'table' => 'tax_class',
1825 'extra_sql' => "WHERE taxclass $compare",
1829 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1830 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1831 if ( @taxclassnum );
1833 unless ($params->{'showdisabled'}) {
1834 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1835 "( disabled = '' OR disabled IS NULL )";
1838 $query->{extra_sql} = $extra_sql;
1840 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1843 =item queue_liability_report PARAMS
1845 Launches a tax liability report.
1847 PARAMS needs to be a base64-encoded Storable hash containing:
1848 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1849 - end: the end date of the report, likewise.
1850 - agentnum: the agent to limit the report to, if any.
1854 sub queue_liability_report {
1856 my $param = thaw(decode_base64(shift));
1859 $cgi->param('beginning', $param->{beginning});
1860 $cgi->param('ending', $param->{ending});
1861 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1862 my $agentnum = $param->{agentnum};
1863 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1864 generate_liability_report(
1865 'beginning' => $beginning,
1866 'ending' => $ending,
1867 'agentnum' => $agentnum,
1868 'p' => $param->{RootURL},
1873 =item generate_liability_report PARAMS
1875 Generates a tax liability report. PARAMS must include:
1877 - beginning, as a timestamp
1878 - ending, as a timestamp
1879 - p: the Freeside root URL, for generating links
1880 - agentnum (optional)
1884 #shit, all sorts of false laxiness w/report_newtax.cgi
1885 sub generate_liability_report {
1888 my ( $count, $last, $min_sec ) = _progressbar_foo();
1890 #let us open the temp file early
1891 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1892 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1894 UNLINK => 0, # not so temp
1895 ) or die "can't open report file: $!\n";
1897 my $conf = new FS::Conf;
1898 my $money_char = $conf->config('money_char') || '$';
1901 JOIN cust_bill USING ( invnum )
1902 LEFT JOIN cust_main USING ( custnum )
1906 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1907 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1909 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1911 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1914 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1915 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1916 die "agent not found" unless $agent;
1917 $agentname = $agent->agent;
1918 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1921 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1922 my @taxparams = qw( city county state locationtaxid );
1923 my @params = ('itemdesc', @taxparams);
1925 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1927 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1928 #to FS::Report or FS::Record or who the fuck knows where)
1929 my $scalar_sql = sub {
1930 my( $r, $param, $sql ) = @_;
1931 my $sth = dbh->prepare($sql) or die dbh->errstr;
1932 $sth->execute( map $r->$_(), @$param )
1933 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1934 $sth->fetchrow_arrayref->[0] || 0;
1943 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1944 # for taxes that have been charged
1945 # (state, county, city are from tax_rate_location, not from customer data)
1946 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1948 hashref => { pkgpart => 0 },
1949 addl_from => $addl_from,
1950 extra_sql => $where,
1953 $count = scalar(@tax_and_location);
1954 foreach my $t ( @tax_and_location ) {
1957 if ( time - $min_sec > $last ) {
1958 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1965 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1966 my $label = join('~', map { $t->$_ } @params);
1967 $label = 'Tax'. $label if $label =~ /^~/;
1968 unless ( exists( $taxes{$label} ) ) {
1969 my ($baselabel, @trash) = split /~/, $label;
1971 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1972 $taxes{$label}->{'url_param'} =
1973 join(';', map { "$_=". uri_escape($t->$_) } @params);
1976 # " payby != 'COMP' ". # breaks the entire report under 4.x
1977 # # and unnecessary since COMP accounts don't
1978 # # get taxes calculated in the first place
1979 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1980 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1985 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1987 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1989 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1991 $taxes{$label}->{'tax'} += $x;
1994 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1996 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
1998 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1999 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2001 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2003 $taxes{$label}->{'credit'} += $y;
2005 unless ( exists( $taxes{$baselabel} ) ) {
2007 $basetaxes{$baselabel}->{'label'} = $baselabel;
2008 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2009 $basetaxes{$baselabel}->{'base'} = 1;
2013 $basetaxes{$baselabel}->{'tax'} += $x;
2014 $basetaxes{$baselabel}->{'credit'} += $y;
2018 # calculate customer-exemption for this tax
2019 # calculate package-exemption for this tax
2020 # calculate monthly exemption (texas tax) for this tax
2021 # count up all the cust_tax_exempt_pkg records associated with
2022 # the actual line items.
2029 $args{job}->update_statustext( "0,Sorted" );
2035 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2036 my ($base, @trash) = split '~', $tax;
2037 my $basetax = delete( $basetaxes{$base} );
2039 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2040 $taxes{$tax}->{base} = 1;
2042 push @taxes, $basetax;
2045 push @taxes, $taxes{$tax};
2052 'credit' => $credit,
2057 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2058 $dateagentlink .= ';agentnum='. $args{agentnum}
2059 if length($agentname);
2060 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2062 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2064 print $report <<EOF;
2066 <% include("/elements/header.html", "$agentname Tax Report - ".
2068 ? time2str('%h %o %Y ', $args{beginning} )
2072 ( $args{ending} == 4294967295
2074 : time2str('%h %o %Y', $args{ending} )
2079 <% include('/elements/table-grid.html') %>
2082 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2083 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2084 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2085 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2086 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2087 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2091 my $bgcolor1 = '#eeeeee';
2092 my $bgcolor2 = '#ffffff';
2095 $count = scalar(@taxes);
2097 foreach my $tax ( @taxes ) {
2100 if ( time - $min_sec > $last ) {
2101 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2108 if ( $bgcolor eq $bgcolor1 ) {
2109 $bgcolor = $bgcolor2;
2111 $bgcolor = $bgcolor1;
2115 if ( $tax->{'label'} ne 'Total' ) {
2116 $link = ';'. $tax->{'url_param'};
2119 print $report <<EOF;
2121 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2122 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2123 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2124 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2126 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2127 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2128 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2129 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2130 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2132 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2137 print $report <<EOF;
2144 my $reportname = $report->filename;
2147 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2148 $reportname =~ s/^$dropstring//;
2150 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2151 die "<a href=$reporturl>view</a>\n";
2161 Mixing automatic and manual editing works poorly at present.
2163 Tax liability calculations take too long and arguably don't belong here.
2164 Tax liability report generation not entirely safe (escaped).
2168 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>