4 use vars qw( @ISA $DEBUG $me
5 %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
6 %tax_passtypes %GetInfoType $keep_cch_files );
9 use DateTime::Format::Strptime;
10 use Storable qw( thaw nfreeze );
18 use DBIx::DBSchema::Table;
19 use DBIx::DBSchema::Column;
20 use FS::Record qw( qsearch qsearchs dbh dbdef );
22 use FS::cust_bill_pkg;
23 use FS::cust_tax_location;
24 use FS::tax_rate_location;
25 use FS::part_pkg_taxrate;
26 use FS::part_pkg_taxproduct;
28 use FS::Misc qw( csv_from_fixed );
32 @ISA = qw( FS::Record );
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_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 =item taxclass_description
248 Returns the human understandable value associated with the related
253 sub taxclass_description {
255 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
256 $tax_class ? $tax_class->description : '';
261 Returns the human understandable value associated with the unittype column
265 %tax_unittypes = ( '0' => 'access line',
272 $tax_unittypes{$self->unittype};
277 Returns the human understandable value associated with the maxtype column
281 %tax_maxtypes = ( '0' => 'receipts per invoice',
282 '1' => 'receipts per item',
283 '2' => 'total utility charges per utility tax year',
284 '3' => 'total charges per utility tax year',
285 '4' => 'receipts per access line',
286 '9' => 'monthly receipts per location',
291 $tax_maxtypes{$self->maxtype};
296 Returns the human understandable value associated with the basetype column
300 %tax_basetypes = ( '0' => 'sale price',
301 '1' => 'gross receipts',
302 '2' => 'sales taxable telecom revenue',
303 '3' => 'minutes carried',
304 '4' => 'minutes billed',
305 '5' => 'gross operating revenue',
306 '6' => 'access line',
308 '8' => 'gross revenue',
309 '9' => 'portion gross receipts attributable to interstate service',
310 '10' => 'access line',
311 '11' => 'gross profits',
312 '12' => 'tariff rate',
314 '15' => 'prior year gross receipts',
319 $tax_basetypes{$self->basetype};
324 Returns the human understandable value associated with the taxauth column
328 %tax_authorities = ( '0' => 'federal',
333 '5' => 'county administered by state',
334 '6' => 'city administered by state',
335 '7' => 'city administered by county',
336 '8' => 'local administered by state',
337 '9' => 'local administered by county',
342 $tax_authorities{$self->taxauth};
347 Returns the human understandable value associated with the passtype column
351 %tax_passtypes = ( '0' => 'separate tax line',
352 '1' => 'separate surcharge line',
353 '2' => 'surcharge not separated',
354 '3' => 'included in base rate',
359 $tax_passtypes{$self->passtype};
362 =item taxline TAXABLES, [ OPTIONSHASH ]
364 Returns a listref of a name and an amount of tax calculated for the list
365 of packages/amounts referenced by TAXABLES. If an error occurs, a message
366 is returned as a scalar.
376 if (ref($_[0]) eq 'ARRAY') {
381 #exemptions would be broken in this case
384 my $name = $self->taxname;
385 $name = 'Other surcharges'
386 if ($self->passtype == 2);
389 if ( $self->disabled ) { # we always know how to handle disabled taxes
396 my $taxable_charged = 0;
397 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
400 warn "calculating taxes for ". $self->taxnum. " on ".
401 join (",", map { $_->pkgnum } @cust_bill_pkg)
404 if ($self->passflag eq 'N') {
405 # return "fatal: can't (yet) handle taxes not passed to the customer";
406 # until someone needs to track these in freeside
413 my $maxtype = $self->maxtype || 0;
414 if ($maxtype != 0 && $maxtype != 9) {
415 return $self->_fatal_or_null( 'tax with "'.
416 $self->maxtype_name. '" threshold'
422 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
426 # we treat gross revenue as gross receipts and expect the tax data
427 # to DTRT (i.e. tax on tax rules)
428 if ($self->basetype != 0 && $self->basetype != 1 &&
429 $self->basetype != 5 && $self->basetype != 6 &&
430 $self->basetype != 7 && $self->basetype != 8 &&
431 $self->basetype != 14
434 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
437 unless ($self->setuptax =~ /^Y$/i) {
438 $taxable_charged += $_->setup foreach @cust_bill_pkg;
440 unless ($self->recurtax =~ /^Y$/i) {
441 $taxable_charged += $_->recur foreach @cust_bill_pkg;
444 my $taxable_units = 0;
445 unless ($self->recurtax =~ /^Y$/i) {
446 if (( $self->unittype || 0 ) == 0) {
448 foreach (@cust_bill_pkg) {
449 $taxable_units += $_->units
450 unless $seen{$_->pkgnum};
453 }elsif ($self->unittype == 1) {
454 return $self->_fatal_or_null( 'fee with minute unit type' );
455 }elsif ($self->unittype == 2) {
458 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
463 # XXX insert exemption handling here
465 # the tax or fee is applied to taxbase or feebase and then
466 # the excessrate or excess fee is applied to taxmax or feemax
469 $amount += $taxable_charged * $self->tax;
470 $amount += $taxable_units * $self->fee;
472 warn "calculated taxes as [ $name, $amount ]\n"
483 my ($self, $error) = @_;
485 my $conf = new FS::Conf;
487 $error = "can't yet handle ". $error;
488 my $name = $self->taxname;
489 $name = 'Other surcharges'
490 if ($self->passtype == 2);
492 if ($conf->exists('ignore_incalculable_taxes')) {
493 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
494 return { name => $name, amount => 0 };
496 return "fatal: $error";
500 =item tax_on_tax CUST_MAIN
502 Returns a list of taxes which are candidates for taxing taxes for the
503 given customer (see L<FS::cust_main>)
511 my $cust_main = shift;
513 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
517 my $geocode = $cust_main->geocode($self->data_vendor);
521 my $extra_sql = ' AND ('.
522 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
527 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
528 my $select = 'DISTINCT ON(taxclassnum) *';
530 # should qsearch preface columns with the table to facilitate joins?
531 my @taxclassnums = map { $_->taxclassnum }
532 qsearch( { 'table' => 'part_pkg_taxrate',
534 'hashref' => { 'data_vendor' => $self->data_vendor,
535 'taxclassnumtaxed' => $self->taxclassnum,
537 'extra_sql' => $extra_sql,
538 'order_by' => $order_by,
541 return () unless @taxclassnums;
544 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
546 qsearch({ 'table' => 'tax_rate',
547 'hashref' => { 'geocode' => $geocode, },
548 'extra_sql' => $extra_sql,
553 =item tax_rate_location
555 Returns an object representing the location associated with this tax
556 (see L<FS::tax_rate_location>)
560 sub tax_rate_location {
563 qsearchs({ 'table' => 'tax_rate_location',
564 'hashref' => { 'data_vendor' => $self->data_vendor,
565 'geocode' => $self->geocode,
569 new FS::tax_rate_location;
583 sub _progressbar_foo {
588 my ($param, $job) = @_;
590 my $fh = $param->{filehandle};
591 my $format = $param->{'format'};
599 my @column_lengths = ();
600 my @column_callbacks = ();
601 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
602 $format =~ s/-fixed//;
603 my $date_format = sub { my $r='';
604 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
607 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
608 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 );
609 push @column_lengths, 1 if $format eq 'cch-update';
610 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
611 $column_callbacks[8] = $date_format;
615 my ( $count, $last, $min_sec ) = _progressbar_foo();
616 if ( $job || scalar(@column_callbacks) ) {
618 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
619 return $error if $error;
623 if ( $format eq 'cch' || $format eq 'cch-update' ) {
624 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
625 excessrate effective_date taxauth taxtype taxcat taxname
626 usetax useexcessrate fee unittype feemax maxtype passflag
628 push @fields, 'actionflag' if $format eq 'cch-update';
633 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
634 $hash->{'data_vendor'} ='cch';
635 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
636 time_zone => 'floating',
638 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
639 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
641 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
642 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
645 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
647 my %tax_class = ( 'data_vendor' => 'cch',
648 'taxclass' => $taxclassid,
651 my $tax_class = qsearchs( 'tax_class', \%tax_class );
652 return "Error updating tax rate: no tax class $taxclassid"
655 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
657 foreach (qw( taxtype taxcat )) {
661 my %passflagmap = ( '0' => '',
665 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
666 if exists $passflagmap{$hash->{'passflag'}};
668 foreach (keys %$hash) {
669 $hash->{$_} = substr($hash->{$_}, 0, 80)
670 if length($hash->{$_}) > 80;
673 my $actionflag = delete($hash->{'actionflag'});
675 $hash->{'taxname'} =~ s/`/'/g;
676 $hash->{'taxname'} =~ s|\\|/|g;
678 return '' if $format eq 'cch'; # but not cch-update
680 if ($actionflag eq 'I') {
681 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
682 }elsif ($actionflag eq 'D') {
683 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
685 return "Unexpected action flag: ". $hash->{'actionflag'};
688 delete($hash->{$_}) for keys %$hash;
694 } elsif ( $format eq 'extended' ) {
695 die "unimplemented\n";
699 die "unknown format $format";
702 eval "use Text::CSV_XS;";
705 my $csv = new Text::CSV_XS;
709 local $SIG{HUP} = 'IGNORE';
710 local $SIG{INT} = 'IGNORE';
711 local $SIG{QUIT} = 'IGNORE';
712 local $SIG{TERM} = 'IGNORE';
713 local $SIG{TSTP} = 'IGNORE';
714 local $SIG{PIPE} = 'IGNORE';
716 my $oldAutoCommit = $FS::UID::AutoCommit;
717 local $FS::UID::AutoCommit = 0;
720 while ( defined($line=<$fh>) ) {
721 $csv->parse($line) or do {
722 $dbh->rollback if $oldAutoCommit;
723 return "can't parse: ". $csv->error_input();
726 if ( $job ) { # progress bar
727 if ( time - $min_sec > $last ) {
728 my $error = $job->update_statustext(
729 int( 100 * $imported / $count ). ",Importing tax rates"
732 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
739 my @columns = $csv->fields();
741 my %tax_rate = ( 'data_vendor' => $format );
742 foreach my $field ( @fields ) {
743 $tax_rate{$field} = shift @columns;
745 if ( scalar( @columns ) ) {
746 $dbh->rollback if $oldAutoCommit;
747 return "Unexpected trailing columns in line (wrong format?): $line";
750 my $error = &{$hook}(\%tax_rate);
752 $dbh->rollback if $oldAutoCommit;
756 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
758 my $tax_rate = new FS::tax_rate( \%tax_rate );
759 $error = $tax_rate->insert;
762 $dbh->rollback if $oldAutoCommit;
763 return "can't insert tax_rate for $line: $error";
772 for (grep { !exists($delete{$_}) } keys %insert) {
773 if ( $job ) { # progress bar
774 if ( time - $min_sec > $last ) {
775 my $error = $job->update_statustext(
776 int( 100 * $imported / $count ). ",Importing tax rates"
779 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
786 my $tax_rate = new FS::tax_rate( $insert{$_} );
787 my $error = $tax_rate->insert;
790 $dbh->rollback if $oldAutoCommit;
791 my $hashref = $insert{$_};
792 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
793 return "can't insert tax_rate for $line: $error";
799 for (grep { exists($delete{$_}) } keys %insert) {
800 if ( $job ) { # progress bar
801 if ( time - $min_sec > $last ) {
802 my $error = $job->update_statustext(
803 int( 100 * $imported / $count ). ",Importing tax rates"
806 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
813 my $old = qsearchs( 'tax_rate', $delete{$_} );
815 $dbh->rollback if $oldAutoCommit;
817 return "can't find tax_rate to replace for: ".
818 #join(" ", map { "$_ => ". $old->{$_} } @fields);
819 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
821 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
822 $new->taxnum($old->taxnum);
823 my $error = $new->replace($old);
826 $dbh->rollback if $oldAutoCommit;
827 my $hashref = $insert{$_};
828 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
829 return "can't replace tax_rate for $line: $error";
836 for (grep { !exists($insert{$_}) } keys %delete) {
837 if ( $job ) { # progress bar
838 if ( time - $min_sec > $last ) {
839 my $error = $job->update_statustext(
840 int( 100 * $imported / $count ). ",Importing tax rates"
843 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
850 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
852 $dbh->rollback if $oldAutoCommit;
853 $tax_rate = $delete{$_};
854 return "can't find tax_rate to delete for: ".
855 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
856 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
858 my $error = $tax_rate->delete;
861 $dbh->rollback if $oldAutoCommit;
862 my $hashref = $delete{$_};
863 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
864 return "can't delete tax_rate for $line: $error";
870 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
872 return "Empty file!" unless ($imported || $format eq 'cch-update');
878 =item process_batch_import
880 Load a batch import as a queued JSRPC job
884 sub process_batch_import {
887 my $oldAutoCommit = $FS::UID::AutoCommit;
888 local $FS::UID::AutoCommit = 0;
891 my $param = thaw(decode_base64(shift));
892 my $args = '$job, encode_base64( nfreeze( $param ) )';
894 my $method = '_perform_batch_import';
895 if ( $param->{reload} ) {
896 $method = 'process_batch_reload';
899 eval "$method($args);";
901 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
906 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
909 sub _perform_batch_import {
912 my $param = thaw(decode_base64(shift));
913 my $format = $param->{'format'}; #well... this is all cch specific
915 my $files = $param->{'uploaded_files'}
916 or die "No files provided.";
918 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
921 if ( $format eq 'cch' || $format eq 'cch-fixed'
922 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
925 my $oldAutoCommit = $FS::UID::AutoCommit;
926 local $FS::UID::AutoCommit = 0;
929 my @insert_list = ();
930 my @delete_list = ();
931 my @predelete_list = ();
934 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
936 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
937 'CODE', \&FS::tax_class::batch_import,
938 'PLUS4', \&FS::cust_tax_location::batch_import,
939 'ZIP', \&FS::cust_tax_location::batch_import,
940 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
941 'DETAIL', \&FS::tax_rate::batch_import,
943 while( scalar(@list) ) {
944 my ( $name, $import_sub ) = splice( @list, 0, 2 );
945 my $file = lc($name). 'file';
947 unless ($files{$file}) {
948 $error = "No $name supplied";
951 next if $name eq 'DETAIL' && $format =~ /update/;
953 my $filename = "$dir/". $files{$file};
955 if ( $format =~ /update/ ) {
957 ( $error, $insertname, $deletename ) =
958 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
962 unlink $filename or warn "Can't delete $filename: $!"
963 unless $keep_cch_files;
964 push @insert_list, $name, $insertname, $import_sub, $format;
965 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
966 unshift @predelete_list, $name, $deletename, $import_sub, $format;
968 unshift @delete_list, $name, $deletename, $import_sub, $format;
973 push @insert_list, $name, $filename, $import_sub, $format;
980 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
981 if $format =~ /update/;
983 $error ||= _perform_cch_tax_import( $job,
990 @list = ( @predelete_list, @insert_list, @delete_list );
991 while( !$keep_cch_files && scalar(@list) ) {
992 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
993 unlink $file or warn "Can't delete $file: $!";
997 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1000 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1004 die "Unknown format: $format";
1010 sub _perform_cch_tax_import {
1011 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1014 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1015 while( scalar(@$list) ) {
1016 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1017 my $fmt = "$format-update";
1018 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1019 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1020 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1028 sub _perform_cch_insert_delete_split {
1029 my ($name, $filename, $dir, $format) = @_;
1033 open my $fh, "< $filename"
1034 or $error ||= "Can't open $name file $filename: $!";
1036 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1039 ) or die "can't open temp file: $!\n";
1040 my $insertname = $ifh->filename;
1042 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1045 ) or die "can't open temp file: $!\n";
1046 my $deletename = $dfh->filename;
1048 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1049 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1052 $handle = $ifh if $_ =~ /$insert_pattern/;
1053 $handle = $dfh if $_ =~ /$delete_pattern/;
1055 $error = "bad input line: $_" unless $handle;
1064 return ($error, $insertname, $deletename);
1067 sub _perform_cch_diff {
1068 my ($name, $newdir, $olddir) = @_;
1073 open my $oldcsvfh, "$olddir/$name.txt"
1074 or die "failed to open $olddir/$name.txt: $!\n";
1076 while(<$oldcsvfh>) {
1083 open my $newcsvfh, "$newdir/$name.txt"
1084 or die "failed to open $newdir/$name.txt: $!\n";
1086 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1089 ) or die "can't open temp file: $!\n";
1090 my $diffname = $dfh->filename;
1092 while(<$newcsvfh>) {
1094 if (exists($oldlines{$_})) {
1097 print $dfh $_, ',"I"', "\n";
1102 for (keys %oldlines) {
1103 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1111 sub _cch_fetch_and_unzip {
1112 my ( $job, $urls, $secret, $dir ) = @_;
1114 my $ua = new LWP::UserAgent;
1115 foreach my $url (split ',', $urls) {
1116 my @name = split '/', $url; #somewhat restrictive
1117 my $name = pop @name;
1118 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1121 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1123 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1124 my $res = $ua->request(
1125 new HTTP::Request( GET => $url ),
1127 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1128 my $content_length = $_[1]->content_length;
1129 $imported += length($_[0]);
1130 if ( time - $min_sec > $last ) {
1131 my $error = $job->update_statustext(
1132 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1133 ",Downloading data from CCH"
1135 die $error if $error;
1140 die "download of $url failed: ". $res->status_line
1141 unless $res->is_success;
1144 my $error = $job->update_statustext( "0,Unpacking data" );
1145 die $error if $error;
1146 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1148 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1149 or die "unzip -P $secret -d $dir $dir/$name failed";
1150 #unlink "$dir/$name";
1154 sub _cch_extract_csv_from_dbf {
1155 my ( $job, $dir, $name ) = @_;
1157 eval "use Text::CSV_XS;";
1163 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1164 my $error = $job->update_statustext( "0,Unpacking $name" );
1165 die $error if $error;
1166 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1167 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1168 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1169 unless defined($table);
1170 my $count = $table->last_record; # approximately;
1171 open my $csvfh, ">$dir.new/$name.txt"
1172 or die "failed to open $dir.new/$name.txt: $!\n";
1174 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1175 my @fields = $table->field_names;
1176 my $cursor = $table->prepare_select;
1178 sub { my $date = shift;
1179 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1182 while (my $row = $cursor->fetch_hashref) {
1183 $csv->combine( map { ($table->field_type($_) eq 'D')
1184 ? &{$format_date}($row->{$_})
1189 print $csvfh $csv->string, "\n";
1191 if ( time - $min_sec > $last ) {
1192 my $error = $job->update_statustext(
1193 int(100 * $imported/$count). ",Unpacking $name"
1195 die $error if $error;
1203 sub _remember_disabled_taxes {
1204 my ( $job, $format, $disabled_tax_rate ) = @_;
1208 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1210 my @items = qsearch( { table => 'tax_rate',
1211 hashref => { disabled => 'Y',
1212 data_vendor => $format,
1214 select => 'geocode, taxclassnum',
1217 my $count = scalar(@items);
1218 foreach my $tax_rate ( @items ) {
1219 if ( time - $min_sec > $last ) {
1220 $job->update_statustext(
1221 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1227 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1228 unless ( $tax_class ) {
1229 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1232 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1236 sub _remember_tax_products {
1237 my ( $job, $format, $taxproduct ) = @_;
1239 # XXX FIXME this loop only works when cch is the only data provider
1241 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1243 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1244 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1245 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1246 " optionname LIKE 'usage_taxproductnum_%' AND ".
1247 " optionvalue != '' )";
1248 my @items = qsearch( { table => 'part_pkg',
1249 select => 'DISTINCT pkgpart,taxproductnum',
1251 extra_sql => $extra_sql,
1254 my $count = scalar(@items);
1255 foreach my $part_pkg ( @items ) {
1256 if ( time - $min_sec > $last ) {
1257 $job->update_statustext(
1258 int( 100 * $imported / $count ). ",Remembering tax products"
1263 warn "working with package part ". $part_pkg->pkgpart.
1264 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1265 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1266 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1267 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1269 foreach my $option ( $part_pkg->part_pkg_option ) {
1270 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1273 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1274 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1275 $part_pkg_taxproduct->taxproduct
1276 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1281 sub _restore_remembered_tax_products {
1282 my ( $job, $format, $taxproduct ) = @_;
1286 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1287 my $count = scalar(keys %$taxproduct);
1288 foreach my $pkgpart ( keys %$taxproduct ) {
1289 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1290 if ( time - $min_sec > $last ) {
1291 $job->update_statustext(
1292 int( 100 * $imported / $count ). ",Restoring tax products"
1298 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1299 unless ( $part_pkg ) {
1300 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1303 my %options = $part_pkg->options;
1304 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1305 my $primary_svc = $part_pkg->svcpart;
1306 my $new = new FS::part_pkg { $part_pkg->hash };
1308 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1309 warn "working with class '$class'\n" if $DEBUG;
1310 my $part_pkg_taxproduct =
1311 qsearchs( 'part_pkg_taxproduct',
1312 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1313 data_vendor => $format,
1317 unless ( $part_pkg_taxproduct ) {
1318 return "failed to find part_pkg_taxproduct (".
1319 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1322 if ( $class eq '' ) {
1323 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1327 $options{"usage_taxproductnum_$class"} =
1328 $part_pkg_taxproduct->taxproductnum;
1332 my $error = $new->replace( $part_pkg,
1333 'pkg_svc' => \%pkg_svc,
1334 'primary_svc' => $primary_svc,
1335 'options' => \%options,
1338 return $error if $error;
1345 sub _restore_remembered_disabled_taxes {
1346 my ( $job, $format, $disabled_tax_rate ) = @_;
1348 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1349 my $count = scalar(keys %$disabled_tax_rate);
1350 foreach my $key (keys %$disabled_tax_rate) {
1351 if ( time - $min_sec > $last ) {
1352 $job->update_statustext(
1353 int( 100 * $imported / $count ). ",Disabling tax rates"
1358 my ($geocode,$taxclass) = split /:/, $key, 2;
1359 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1360 taxclass => $taxclass,
1362 return "found multiple tax_class records for format $format class $taxclass"
1363 if scalar(@tax_class) > 1;
1365 unless (scalar(@tax_class)) {
1366 warn "no tax_class for format $format class $taxclass\n";
1371 qsearch('tax_rate', { data_vendor => $format,
1372 geocode => $geocode,
1373 taxclassnum => $tax_class[0]->taxclassnum,
1377 if (scalar(@tax_rate) > 1) {
1378 return "found multiple tax_rate records for format $format geocode ".
1379 "$geocode and taxclass $taxclass ( taxclassnum ".
1380 $tax_class[0]->taxclassnum. " )";
1383 if (scalar(@tax_rate)) {
1384 $tax_rate[0]->disabled('Y');
1385 my $error = $tax_rate[0]->replace;
1386 return $error if $error;
1391 sub _remove_old_tax_data {
1392 my ( $job, $format ) = @_;
1395 my $error = $job->update_statustext( "0,Removing old tax data" );
1396 die $error if $error;
1398 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1399 "WHERE data_vendor = ". $dbh->quote($format);
1400 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1403 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1405 foreach my $table ( @table ) {
1406 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1407 $dbh->quote($format);
1408 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1411 if ( $format eq 'cch' ) {
1412 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1413 $dbh->quote("$format-zip");
1414 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1420 sub _create_temporary_tables {
1421 my ( $job, $format ) = @_;
1424 my $error = $job->update_statustext( "0,Creating temporary tables" );
1425 die $error if $error;
1427 my @table = qw( tax_rate
1434 foreach my $table ( @table ) {
1436 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1437 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1443 sub _copy_from_temp {
1444 my ( $job, $format ) = @_;
1447 my $error = $job->update_statustext( "0,Making permanent" );
1448 die $error if $error;
1450 my @table = qw( tax_rate
1457 foreach my $table ( @table ) {
1459 "INSERT INTO public.$table SELECT * from $table";
1460 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1466 =item process_download_and_reload
1468 Download and process a tax update as a queued JSRPC job after wiping the
1469 existing wipable tax data.
1473 sub process_download_and_reload {
1474 _process_reload('process_download_and_update', @_);
1478 =item process_batch_reload
1480 Load and process a tax update from the provided files as a queued JSRPC job
1481 after wiping the existing wipable tax data.
1485 sub process_batch_reload {
1486 _process_reload('_perform_batch_import', @_);
1490 sub _process_reload {
1491 my ( $method, $job ) = ( shift, shift );
1493 my $param = thaw(decode_base64($_[0]));
1494 my $format = $param->{'format'}; #well... this is all cch specific
1496 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1498 if ( $job ) { # progress bar
1499 my $error = $job->update_statustext( 0 );
1500 die $error if $error;
1503 my $oldAutoCommit = $FS::UID::AutoCommit;
1504 local $FS::UID::AutoCommit = 0;
1509 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1510 "USING (taxclassnum) WHERE data_vendor = '$format'";
1511 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1513 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1514 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1515 if $sth->fetchrow_arrayref->[0];
1517 # really should get a table EXCLUSIVE lock here
1519 #remember disabled taxes
1520 my %disabled_tax_rate = ();
1521 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1523 #remember tax products
1524 my %taxproduct = ();
1525 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1528 $error ||= _create_temporary_tables( $job, $format );
1532 my $args = '$job, @_';
1533 eval "$method($args);";
1537 #restore taxproducts
1538 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1542 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1544 #wipe out the old data
1545 $error ||= _remove_old_tax_data( $job, $format );
1548 $error ||= _copy_from_temp( $job, $format );
1551 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1556 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1560 =item process_download_and_update
1562 Download and process a tax update as a queued JSRPC job
1566 sub process_download_and_update {
1569 my $param = thaw(decode_base64(shift));
1570 my $format = $param->{'format'}; #well... this is all cch specific
1572 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1574 if ( $job ) { # progress bar
1575 my $error = $job->update_statustext( 0);
1576 die $error if $error;
1579 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1580 my $dir = $cache_dir. 'taxdata';
1582 mkdir $dir or die "can't create $dir: $!\n";
1585 if ($format eq 'cch') {
1587 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1589 my $conf = new FS::Conf;
1590 die "direct download of tax data not enabled\n"
1591 unless $conf->exists('taxdatadirectdownload');
1592 my ( $urls, $username, $secret, $states ) =
1593 $conf->config('taxdatadirectdownload');
1594 die "No tax download URL provided. ".
1595 "Did you set the taxdatadirectdownload configuration value?\n"
1603 # really should get a table EXCLUSIVE lock here
1604 # check if initial import or update
1606 # relying on mkdir "$dir.new" as a mutex
1608 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1609 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1610 $sth->execute() or die $sth->errstr;
1611 my $update = $sth->fetchrow_arrayref->[0];
1613 # create cache and/or rotate old tax data
1618 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1619 foreach my $file (readdir($dirh)) {
1620 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1627 if ( -e "$dir.$_" ) {
1628 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1631 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1635 die "can't find previous tax data\n" if $update;
1639 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1641 # fetch and unpack the zip files
1643 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1645 # extract csv files from the dbf files
1647 foreach my $name ( @namelist ) {
1648 _cch_extract_csv_from_dbf( $job, $dir, $name );
1651 # generate the diff files
1654 foreach my $name ( @namelist ) {
1655 my $difffile = "$dir.new/$name.txt";
1657 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1658 die $error if $error;
1659 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1660 my $olddir = $update ? "$dir.1" : "";
1661 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1663 $difffile =~ s/^$cache_dir//;
1664 push @list, "${name}file:$difffile";
1667 # perform the import
1668 local $keep_cch_files = 1;
1669 $param->{uploaded_files} = join( ',', @list );
1670 $param->{format} .= '-update' if $update;
1672 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1674 rename "$dir.new", "$dir"
1675 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1678 die "Unknown format: $format";
1682 =item browse_queries PARAMS
1684 Returns a list consisting of a hashref suited for use as the argument
1685 to qsearch, and sql query string. Each is based on the PARAMS hashref
1686 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1687 from a form. This conveniently creates the query hashref and count_query
1688 string required by the browse and search elements. As a side effect,
1689 the PARAMS hashref is untainted and keys with unexpected values are removed.
1693 sub browse_queries {
1697 'table' => 'tax_rate',
1699 'order_by' => 'ORDER BY geocode, taxclassnum',
1704 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1705 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1707 delete $params->{data_vendor};
1710 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1711 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1712 'geocode LIKE '. dbh->quote($1.'%');
1714 delete $params->{geocode};
1717 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1718 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1721 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1722 ' taxclassnum = '. dbh->quote($1)
1724 delete $params->{taxclassnun};
1728 if ( $params->{tax_type} =~ /^(\d+)$/ );
1729 delete $params->{tax_type}
1733 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1734 delete $params->{tax_cat}
1737 my @taxclassnum = ();
1738 if ($tax_type || $tax_cat ) {
1739 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1740 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1741 @taxclassnum = map { $_->taxclassnum }
1742 qsearch({ 'table' => 'tax_class',
1744 'extra_sql' => "WHERE taxclass $compare",
1748 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1749 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1750 if ( @taxclassnum );
1752 unless ($params->{'showdisabled'}) {
1753 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1754 "( disabled = '' OR disabled IS NULL )";
1757 $query->{extra_sql} = $extra_sql;
1759 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1762 =item queue_liability_report PARAMS
1764 Launches a tax liability report.
1767 sub queue_liability_report {
1769 my $param = thaw(decode_base64(shift));
1772 $cgi->param('beginning', $param->{beginning});
1773 $cgi->param('ending', $param->{ending});
1774 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1775 my $agentnum = $param->{agentnum};
1776 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1777 generate_liability_report(
1778 'beginning' => $beginning,
1779 'ending' => $ending,
1780 'agentnum' => $agentnum,
1781 'p' => $param->{RootURL},
1786 =item generate_liability_report PARAMS
1788 Generates a tax liability report. Provide a hash including desired
1789 agentnum, beginning, and ending
1793 sub generate_liability_report {
1796 my ( $count, $last, $min_sec ) = _progressbar_foo();
1798 #let us open the temp file early
1799 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1800 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1802 UNLINK => 0, # not so temp
1803 ) or die "can't open report file: $!\n";
1805 my $conf = new FS::Conf;
1806 my $money_char = $conf->config('money_char') || '$';
1809 JOIN cust_bill USING ( invnum )
1810 LEFT JOIN cust_main USING ( custnum )
1814 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1815 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1817 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1819 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1822 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1823 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1824 die "agent not found" unless $agent;
1825 $agentname = $agent->agent;
1826 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1829 # my ( $location_sql, @location_param ) = FS::cust_pkg->location_sql;
1830 # $where .= " AND $location_sql";
1831 #my @taxparam = ( 'itemdesc', @location_param );
1832 # now something along the lines of geocode matching ?
1833 #$where .= FS::cust_pkg->_location_sql_where('cust_tax_location');;
1834 my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1836 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1838 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1839 #to FS::Report or FS::Record or who the fuck knows where)
1840 my $scalar_sql = sub {
1841 my( $r, $param, $sql ) = @_;
1842 my $sth = dbh->prepare($sql) or die dbh->errstr;
1843 $sth->execute( map $r->$_(), @$param )
1844 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1845 $sth->fetchrow_arrayref->[0] || 0;
1853 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1855 hashref => { pkgpart => 0 },
1856 addl_from => $addl_from,
1857 extra_sql => $where,
1859 $count = scalar(@tax_and_location);
1860 foreach my $t ( @tax_and_location ) {
1863 if ( time - $min_sec > $last ) {
1864 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1871 my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1872 my $label = join('~', map { $t->$_ } @params);
1873 $label = 'Tax'. $label if $label =~ /^~/;
1874 unless ( exists( $taxes{$label} ) ) {
1875 my ($baselabel, @trash) = split /~/, $label;
1877 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1878 $taxes{$label}->{'url_param'} =
1879 join(';', map { "$_=". uri_escape($t->$_) } @params);
1881 my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND payby != 'COMP' ".
1882 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1884 my $sql = "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) ".
1885 " $taxwhere AND cust_bill_pkg.pkgnum = 0";
1887 my $x = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1889 $taxes{$label}->{'tax'} += $x;
1891 my $creditfrom = " JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum) ";
1892 my $creditwhere = "FROM cust_bill_pkg $addl_from $creditfrom $where ".
1893 "AND payby != 'COMP' ".
1894 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1896 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1897 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1899 my $y = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1901 $taxes{$label}->{'credit'} += $y;
1903 unless ( exists( $taxes{$baselabel} ) ) {
1905 $basetaxes{$baselabel}->{'label'} = $baselabel;
1906 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1907 $basetaxes{$baselabel}->{'base'} = 1;
1911 $basetaxes{$baselabel}->{'tax'} += $x;
1912 $basetaxes{$baselabel}->{'credit'} += $y;
1916 # calculate customer-exemption for this tax
1917 # calculate package-exemption for this tax
1918 # calculate monthly exemption (texas tax) for this tax
1919 # count up all the cust_tax_exempt_pkg records associated with
1920 # the actual line items.
1927 $args{job}->update_statustext( "0,Sorted" );
1933 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1934 my ($base, @trash) = split '~', $tax;
1935 my $basetax = delete( $basetaxes{$base} );
1937 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1938 $taxes{$tax}->{base} = 1;
1940 push @taxes, $basetax;
1943 push @taxes, $taxes{$tax};
1950 'credit' => $credit,
1955 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1956 $dateagentlink .= ';agentnum='. $args{agentnum}
1957 if length($agentname);
1958 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1961 print $report <<EOF;
1963 <% include("/elements/header.html", "$agentname Tax Report - ".
1965 ? time2str('%h %o %Y ', $args{beginning} )
1969 ( $args{ending} == 4294967295
1971 : time2str('%h %o %Y', $args{ending} )
1976 <% include('/elements/table-grid.html') %>
1979 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1980 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1981 <TH CLASS="grid" BGCOLOR="#cccccc">Tax collected</TH>
1982 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
1983 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1984 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
1988 my $bgcolor1 = '#eeeeee';
1989 my $bgcolor2 = '#ffffff';
1992 $count = scalar(@taxes);
1994 foreach my $tax ( @taxes ) {
1997 if ( time - $min_sec > $last ) {
1998 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2005 if ( $bgcolor eq $bgcolor1 ) {
2006 $bgcolor = $bgcolor2;
2008 $bgcolor = $bgcolor1;
2012 if ( $tax->{'label'} ne 'Total' ) {
2013 $link = ';'. $tax->{'url_param'};
2016 print $report <<EOF;
2018 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2019 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2020 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2021 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2023 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2024 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2025 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2026 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2027 <A HREF="<% '$baselink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2029 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2034 print $report <<EOF;
2041 my $reportname = $report->filename;
2044 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2045 $reportname =~ s/^$dropstring//;
2047 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2048 die "<a href=$reporturl>view</a>\n";
2058 Mixing automatic and manual editing works poorly at present.
2060 Tax liability calculations take too long and arguably don't belong here.
2061 Tax liability report generation not entirely safe (escaped).
2065 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base