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) {
447 if (( $self->unittype || 0 ) == 0) { #access line
449 foreach (@cust_bill_pkg) {
450 $taxable_units += $_->units
451 unless $seen{$_->pkgnum}++;
454 } elsif ($self->unittype == 1) { #minute
455 return $self->_fatal_or_null( 'fee with minute unit type' );
457 } elsif ($self->unittype == 2) { #account
459 #number of distinct locations
461 foreach (@cust_bill_pkg) {
463 unless $seen{$_->cust_pkg->locationnum}++;
467 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
473 # XXX insert exemption handling here
475 # the tax or fee is applied to taxbase or feebase and then
476 # the excessrate or excess fee is applied to taxmax or feemax
479 $amount += $taxable_charged * $self->tax;
480 $amount += $taxable_units * $self->fee;
482 warn "calculated taxes as [ $name, $amount ]\n"
493 my ($self, $error) = @_;
495 my $conf = new FS::Conf;
497 $error = "can't yet handle ". $error;
498 my $name = $self->taxname;
499 $name = 'Other surcharges'
500 if ($self->passtype == 2);
502 if ($conf->exists('ignore_incalculable_taxes')) {
503 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
504 return { name => $name, amount => 0 };
506 return "fatal: $error";
510 =item tax_on_tax CUST_MAIN
512 Returns a list of taxes which are candidates for taxing taxes for the
513 given customer (see L<FS::cust_main>)
521 my $cust_main = shift;
523 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
527 my $geocode = $cust_main->geocode($self->data_vendor);
531 my $extra_sql = ' AND ('.
532 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
537 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
538 my $select = 'DISTINCT ON(taxclassnum) *';
540 # should qsearch preface columns with the table to facilitate joins?
541 my @taxclassnums = map { $_->taxclassnum }
542 qsearch( { 'table' => 'part_pkg_taxrate',
544 'hashref' => { 'data_vendor' => $self->data_vendor,
545 'taxclassnumtaxed' => $self->taxclassnum,
547 'extra_sql' => $extra_sql,
548 'order_by' => $order_by,
551 return () unless @taxclassnums;
554 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
556 qsearch({ 'table' => 'tax_rate',
557 'hashref' => { 'geocode' => $geocode, },
558 'extra_sql' => $extra_sql,
563 =item tax_rate_location
565 Returns an object representing the location associated with this tax
566 (see L<FS::tax_rate_location>)
570 sub tax_rate_location {
573 qsearchs({ 'table' => 'tax_rate_location',
574 'hashref' => { 'data_vendor' => $self->data_vendor,
575 'geocode' => $self->geocode,
579 new FS::tax_rate_location;
593 sub _progressbar_foo {
598 my ($param, $job) = @_;
600 my $fh = $param->{filehandle};
601 my $format = $param->{'format'};
609 my @column_lengths = ();
610 my @column_callbacks = ();
611 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
612 $format =~ s/-fixed//;
613 my $date_format = sub { my $r='';
614 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
617 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
618 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 );
619 push @column_lengths, 1 if $format eq 'cch-update';
620 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
621 $column_callbacks[8] = $date_format;
625 my ( $count, $last, $min_sec ) = _progressbar_foo();
626 if ( $job || scalar(@column_callbacks) ) {
628 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
629 return $error if $error;
633 if ( $format eq 'cch' || $format eq 'cch-update' ) {
634 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
635 excessrate effective_date taxauth taxtype taxcat taxname
636 usetax useexcessrate fee unittype feemax maxtype passflag
638 push @fields, 'actionflag' if $format eq 'cch-update';
643 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
644 $hash->{'data_vendor'} ='cch';
645 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
646 time_zone => 'floating',
648 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
649 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
651 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
652 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
655 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
657 my %tax_class = ( 'data_vendor' => 'cch',
658 'taxclass' => $taxclassid,
661 my $tax_class = qsearchs( 'tax_class', \%tax_class );
662 return "Error updating tax rate: no tax class $taxclassid"
665 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
667 foreach (qw( taxtype taxcat )) {
671 my %passflagmap = ( '0' => '',
675 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
676 if exists $passflagmap{$hash->{'passflag'}};
678 foreach (keys %$hash) {
679 $hash->{$_} = substr($hash->{$_}, 0, 80)
680 if length($hash->{$_}) > 80;
683 my $actionflag = delete($hash->{'actionflag'});
685 $hash->{'taxname'} =~ s/`/'/g;
686 $hash->{'taxname'} =~ s|\\|/|g;
688 return '' if $format eq 'cch'; # but not cch-update
690 if ($actionflag eq 'I') {
691 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
692 }elsif ($actionflag eq 'D') {
693 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
695 return "Unexpected action flag: ". $hash->{'actionflag'};
698 delete($hash->{$_}) for keys %$hash;
704 } elsif ( $format eq 'extended' ) {
705 die "unimplemented\n";
709 die "unknown format $format";
712 eval "use Text::CSV_XS;";
715 my $csv = new Text::CSV_XS;
719 local $SIG{HUP} = 'IGNORE';
720 local $SIG{INT} = 'IGNORE';
721 local $SIG{QUIT} = 'IGNORE';
722 local $SIG{TERM} = 'IGNORE';
723 local $SIG{TSTP} = 'IGNORE';
724 local $SIG{PIPE} = 'IGNORE';
726 my $oldAutoCommit = $FS::UID::AutoCommit;
727 local $FS::UID::AutoCommit = 0;
730 while ( defined($line=<$fh>) ) {
731 $csv->parse($line) or do {
732 $dbh->rollback if $oldAutoCommit;
733 return "can't parse: ". $csv->error_input();
736 if ( $job ) { # progress bar
737 if ( time - $min_sec > $last ) {
738 my $error = $job->update_statustext(
739 int( 100 * $imported / $count ). ",Importing tax rates"
742 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
749 my @columns = $csv->fields();
751 my %tax_rate = ( 'data_vendor' => $format );
752 foreach my $field ( @fields ) {
753 $tax_rate{$field} = shift @columns;
755 if ( scalar( @columns ) ) {
756 $dbh->rollback if $oldAutoCommit;
757 return "Unexpected trailing columns in line (wrong format?): $line";
760 my $error = &{$hook}(\%tax_rate);
762 $dbh->rollback if $oldAutoCommit;
766 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
768 my $tax_rate = new FS::tax_rate( \%tax_rate );
769 $error = $tax_rate->insert;
772 $dbh->rollback if $oldAutoCommit;
773 return "can't insert tax_rate for $line: $error";
782 for (grep { !exists($delete{$_}) } keys %insert) {
783 if ( $job ) { # progress bar
784 if ( time - $min_sec > $last ) {
785 my $error = $job->update_statustext(
786 int( 100 * $imported / $count ). ",Importing tax rates"
789 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
796 my $tax_rate = new FS::tax_rate( $insert{$_} );
797 my $error = $tax_rate->insert;
800 $dbh->rollback if $oldAutoCommit;
801 my $hashref = $insert{$_};
802 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
803 return "can't insert tax_rate for $line: $error";
809 for (grep { exists($delete{$_}) } keys %insert) {
810 if ( $job ) { # progress bar
811 if ( time - $min_sec > $last ) {
812 my $error = $job->update_statustext(
813 int( 100 * $imported / $count ). ",Importing tax rates"
816 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
823 my $old = qsearchs( 'tax_rate', $delete{$_} );
825 $dbh->rollback if $oldAutoCommit;
827 return "can't find tax_rate to replace for: ".
828 #join(" ", map { "$_ => ". $old->{$_} } @fields);
829 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
831 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
832 $new->taxnum($old->taxnum);
833 my $error = $new->replace($old);
836 $dbh->rollback if $oldAutoCommit;
837 my $hashref = $insert{$_};
838 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
839 return "can't replace tax_rate for $line: $error";
846 for (grep { !exists($insert{$_}) } keys %delete) {
847 if ( $job ) { # progress bar
848 if ( time - $min_sec > $last ) {
849 my $error = $job->update_statustext(
850 int( 100 * $imported / $count ). ",Importing tax rates"
853 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
860 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
862 $dbh->rollback if $oldAutoCommit;
863 $tax_rate = $delete{$_};
864 return "can't find tax_rate to delete for: ".
865 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
866 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
868 my $error = $tax_rate->delete;
871 $dbh->rollback if $oldAutoCommit;
872 my $hashref = $delete{$_};
873 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
874 return "can't delete tax_rate for $line: $error";
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
882 return "Empty file!" unless ($imported || $format eq 'cch-update');
888 =item process_batch_import
890 Load a batch import as a queued JSRPC job
894 sub process_batch_import {
897 my $oldAutoCommit = $FS::UID::AutoCommit;
898 local $FS::UID::AutoCommit = 0;
901 my $param = thaw(decode_base64(shift));
902 my $args = '$job, encode_base64( nfreeze( $param ) )';
904 my $method = '_perform_batch_import';
905 if ( $param->{reload} ) {
906 $method = 'process_batch_reload';
909 eval "$method($args);";
911 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
916 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
919 sub _perform_batch_import {
922 my $param = thaw(decode_base64(shift));
923 my $format = $param->{'format'}; #well... this is all cch specific
925 my $files = $param->{'uploaded_files'}
926 or die "No files provided.";
928 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
931 if ( $format eq 'cch' || $format eq 'cch-fixed'
932 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
935 my $oldAutoCommit = $FS::UID::AutoCommit;
936 local $FS::UID::AutoCommit = 0;
939 my @insert_list = ();
940 my @delete_list = ();
941 my @predelete_list = ();
944 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
946 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
947 'CODE', \&FS::tax_class::batch_import,
948 'PLUS4', \&FS::cust_tax_location::batch_import,
949 'ZIP', \&FS::cust_tax_location::batch_import,
950 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
951 'DETAIL', \&FS::tax_rate::batch_import,
953 while( scalar(@list) ) {
954 my ( $name, $import_sub ) = splice( @list, 0, 2 );
955 my $file = lc($name). 'file';
957 unless ($files{$file}) {
958 $error = "No $name supplied";
961 next if $name eq 'DETAIL' && $format =~ /update/;
963 my $filename = "$dir/". $files{$file};
965 if ( $format =~ /update/ ) {
967 ( $error, $insertname, $deletename ) =
968 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
972 unlink $filename or warn "Can't delete $filename: $!"
973 unless $keep_cch_files;
974 push @insert_list, $name, $insertname, $import_sub, $format;
975 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
976 unshift @predelete_list, $name, $deletename, $import_sub, $format;
978 unshift @delete_list, $name, $deletename, $import_sub, $format;
983 push @insert_list, $name, $filename, $import_sub, $format;
990 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
991 if $format =~ /update/;
993 $error ||= _perform_cch_tax_import( $job,
1000 @list = ( @predelete_list, @insert_list, @delete_list );
1001 while( !$keep_cch_files && scalar(@list) ) {
1002 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1003 unlink $file or warn "Can't delete $file: $!";
1007 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1010 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1014 die "Unknown format: $format";
1020 sub _perform_cch_tax_import {
1021 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1024 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1025 while( scalar(@$list) ) {
1026 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1027 my $fmt = "$format-update";
1028 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1029 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1030 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1038 sub _perform_cch_insert_delete_split {
1039 my ($name, $filename, $dir, $format) = @_;
1043 open my $fh, "< $filename"
1044 or $error ||= "Can't open $name file $filename: $!";
1046 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1049 ) or die "can't open temp file: $!\n";
1050 my $insertname = $ifh->filename;
1052 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1055 ) or die "can't open temp file: $!\n";
1056 my $deletename = $dfh->filename;
1058 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1059 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1062 $handle = $ifh if $_ =~ /$insert_pattern/;
1063 $handle = $dfh if $_ =~ /$delete_pattern/;
1065 $error = "bad input line: $_" unless $handle;
1074 return ($error, $insertname, $deletename);
1077 sub _perform_cch_diff {
1078 my ($name, $newdir, $olddir) = @_;
1083 open my $oldcsvfh, "$olddir/$name.txt"
1084 or die "failed to open $olddir/$name.txt: $!\n";
1086 while(<$oldcsvfh>) {
1093 open my $newcsvfh, "$newdir/$name.txt"
1094 or die "failed to open $newdir/$name.txt: $!\n";
1096 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1099 ) or die "can't open temp file: $!\n";
1100 my $diffname = $dfh->filename;
1102 while(<$newcsvfh>) {
1104 if (exists($oldlines{$_})) {
1107 print $dfh $_, ',"I"', "\n";
1112 for (keys %oldlines) {
1113 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1121 sub _cch_fetch_and_unzip {
1122 my ( $job, $urls, $secret, $dir ) = @_;
1124 my $ua = new LWP::UserAgent;
1125 foreach my $url (split ',', $urls) {
1126 my @name = split '/', $url; #somewhat restrictive
1127 my $name = pop @name;
1128 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1131 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1133 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1134 my $res = $ua->request(
1135 new HTTP::Request( GET => $url ),
1137 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1138 my $content_length = $_[1]->content_length;
1139 $imported += length($_[0]);
1140 if ( time - $min_sec > $last ) {
1141 my $error = $job->update_statustext(
1142 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1143 ",Downloading data from CCH"
1145 die $error if $error;
1150 die "download of $url failed: ". $res->status_line
1151 unless $res->is_success;
1154 my $error = $job->update_statustext( "0,Unpacking data" );
1155 die $error if $error;
1156 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1158 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1159 or die "unzip -P $secret -d $dir $dir/$name failed";
1160 #unlink "$dir/$name";
1164 sub _cch_extract_csv_from_dbf {
1165 my ( $job, $dir, $name ) = @_;
1167 eval "use Text::CSV_XS;";
1173 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1174 my $error = $job->update_statustext( "0,Unpacking $name" );
1175 die $error if $error;
1176 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1177 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1178 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1179 unless defined($table);
1180 my $count = $table->last_record; # approximately;
1181 open my $csvfh, ">$dir.new/$name.txt"
1182 or die "failed to open $dir.new/$name.txt: $!\n";
1184 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1185 my @fields = $table->field_names;
1186 my $cursor = $table->prepare_select;
1188 sub { my $date = shift;
1189 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1192 while (my $row = $cursor->fetch_hashref) {
1193 $csv->combine( map { ($table->field_type($_) eq 'D')
1194 ? &{$format_date}($row->{$_})
1199 print $csvfh $csv->string, "\n";
1201 if ( time - $min_sec > $last ) {
1202 my $error = $job->update_statustext(
1203 int(100 * $imported/$count). ",Unpacking $name"
1205 die $error if $error;
1213 sub _remember_disabled_taxes {
1214 my ( $job, $format, $disabled_tax_rate ) = @_;
1218 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1220 my @items = qsearch( { table => 'tax_rate',
1221 hashref => { disabled => 'Y',
1222 data_vendor => $format,
1224 select => 'geocode, taxclassnum',
1227 my $count = scalar(@items);
1228 foreach my $tax_rate ( @items ) {
1229 if ( time - $min_sec > $last ) {
1230 $job->update_statustext(
1231 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1237 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1238 unless ( $tax_class ) {
1239 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1242 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1246 sub _remember_tax_products {
1247 my ( $job, $format, $taxproduct ) = @_;
1249 # XXX FIXME this loop only works when cch is the only data provider
1251 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1253 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1254 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1255 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1256 " optionname LIKE 'usage_taxproductnum_%' AND ".
1257 " optionvalue != '' )";
1258 my @items = qsearch( { table => 'part_pkg',
1259 select => 'DISTINCT pkgpart,taxproductnum',
1261 extra_sql => $extra_sql,
1264 my $count = scalar(@items);
1265 foreach my $part_pkg ( @items ) {
1266 if ( time - $min_sec > $last ) {
1267 $job->update_statustext(
1268 int( 100 * $imported / $count ). ",Remembering tax products"
1273 warn "working with package part ". $part_pkg->pkgpart.
1274 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1275 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1276 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1277 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1279 foreach my $option ( $part_pkg->part_pkg_option ) {
1280 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1283 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1284 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1285 $part_pkg_taxproduct->taxproduct
1286 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1291 sub _restore_remembered_tax_products {
1292 my ( $job, $format, $taxproduct ) = @_;
1296 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1297 my $count = scalar(keys %$taxproduct);
1298 foreach my $pkgpart ( keys %$taxproduct ) {
1299 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1300 if ( time - $min_sec > $last ) {
1301 $job->update_statustext(
1302 int( 100 * $imported / $count ). ",Restoring tax products"
1308 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1309 unless ( $part_pkg ) {
1310 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1313 my %options = $part_pkg->options;
1314 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1315 my $primary_svc = $part_pkg->svcpart;
1316 my $new = new FS::part_pkg { $part_pkg->hash };
1318 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1319 warn "working with class '$class'\n" if $DEBUG;
1320 my $part_pkg_taxproduct =
1321 qsearchs( 'part_pkg_taxproduct',
1322 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1323 data_vendor => $format,
1327 unless ( $part_pkg_taxproduct ) {
1328 return "failed to find part_pkg_taxproduct (".
1329 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1332 if ( $class eq '' ) {
1333 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1337 $options{"usage_taxproductnum_$class"} =
1338 $part_pkg_taxproduct->taxproductnum;
1342 my $error = $new->replace( $part_pkg,
1343 'pkg_svc' => \%pkg_svc,
1344 'primary_svc' => $primary_svc,
1345 'options' => \%options,
1348 return $error if $error;
1355 sub _restore_remembered_disabled_taxes {
1356 my ( $job, $format, $disabled_tax_rate ) = @_;
1358 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1359 my $count = scalar(keys %$disabled_tax_rate);
1360 foreach my $key (keys %$disabled_tax_rate) {
1361 if ( time - $min_sec > $last ) {
1362 $job->update_statustext(
1363 int( 100 * $imported / $count ). ",Disabling tax rates"
1368 my ($geocode,$taxclass) = split /:/, $key, 2;
1369 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1370 taxclass => $taxclass,
1372 return "found multiple tax_class records for format $format class $taxclass"
1373 if scalar(@tax_class) > 1;
1375 unless (scalar(@tax_class)) {
1376 warn "no tax_class for format $format class $taxclass\n";
1381 qsearch('tax_rate', { data_vendor => $format,
1382 geocode => $geocode,
1383 taxclassnum => $tax_class[0]->taxclassnum,
1387 if (scalar(@tax_rate) > 1) {
1388 return "found multiple tax_rate records for format $format geocode ".
1389 "$geocode and taxclass $taxclass ( taxclassnum ".
1390 $tax_class[0]->taxclassnum. " )";
1393 if (scalar(@tax_rate)) {
1394 $tax_rate[0]->disabled('Y');
1395 my $error = $tax_rate[0]->replace;
1396 return $error if $error;
1401 sub _remove_old_tax_data {
1402 my ( $job, $format ) = @_;
1405 my $error = $job->update_statustext( "0,Removing old tax data" );
1406 die $error if $error;
1408 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1409 "WHERE data_vendor = ". $dbh->quote($format);
1410 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1413 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1415 foreach my $table ( @table ) {
1416 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1417 $dbh->quote($format);
1418 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1421 if ( $format eq 'cch' ) {
1422 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1423 $dbh->quote("$format-zip");
1424 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1430 sub _create_temporary_tables {
1431 my ( $job, $format ) = @_;
1434 my $error = $job->update_statustext( "0,Creating temporary tables" );
1435 die $error if $error;
1437 my @table = qw( tax_rate
1444 foreach my $table ( @table ) {
1446 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1447 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1453 sub _copy_from_temp {
1454 my ( $job, $format ) = @_;
1457 my $error = $job->update_statustext( "0,Making permanent" );
1458 die $error if $error;
1460 my @table = qw( tax_rate
1467 foreach my $table ( @table ) {
1469 "INSERT INTO public.$table SELECT * from $table";
1470 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1476 =item process_download_and_reload
1478 Download and process a tax update as a queued JSRPC job after wiping the
1479 existing wipable tax data.
1483 sub process_download_and_reload {
1484 _process_reload('process_download_and_update', @_);
1488 =item process_batch_reload
1490 Load and process a tax update from the provided files as a queued JSRPC job
1491 after wiping the existing wipable tax data.
1495 sub process_batch_reload {
1496 _process_reload('_perform_batch_import', @_);
1500 sub _process_reload {
1501 my ( $method, $job ) = ( shift, shift );
1503 my $param = thaw(decode_base64($_[0]));
1504 my $format = $param->{'format'}; #well... this is all cch specific
1506 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1508 if ( $job ) { # progress bar
1509 my $error = $job->update_statustext( 0 );
1510 die $error if $error;
1513 my $oldAutoCommit = $FS::UID::AutoCommit;
1514 local $FS::UID::AutoCommit = 0;
1519 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1520 "USING (taxclassnum) WHERE data_vendor = '$format'";
1521 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1523 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1524 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1525 if $sth->fetchrow_arrayref->[0];
1527 # really should get a table EXCLUSIVE lock here
1529 #remember disabled taxes
1530 my %disabled_tax_rate = ();
1531 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1533 #remember tax products
1534 my %taxproduct = ();
1535 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1538 $error ||= _create_temporary_tables( $job, $format );
1542 my $args = '$job, @_';
1543 eval "$method($args);";
1547 #restore taxproducts
1548 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1552 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1554 #wipe out the old data
1555 $error ||= _remove_old_tax_data( $job, $format );
1558 $error ||= _copy_from_temp( $job, $format );
1561 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1566 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1570 =item process_download_and_update
1572 Download and process a tax update as a queued JSRPC job
1576 sub process_download_and_update {
1579 my $param = thaw(decode_base64(shift));
1580 my $format = $param->{'format'}; #well... this is all cch specific
1582 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1584 if ( $job ) { # progress bar
1585 my $error = $job->update_statustext( 0);
1586 die $error if $error;
1589 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1590 my $dir = $cache_dir. 'taxdata';
1592 mkdir $dir or die "can't create $dir: $!\n";
1595 if ($format eq 'cch') {
1597 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1599 my $conf = new FS::Conf;
1600 die "direct download of tax data not enabled\n"
1601 unless $conf->exists('taxdatadirectdownload');
1602 my ( $urls, $username, $secret, $states ) =
1603 $conf->config('taxdatadirectdownload');
1604 die "No tax download URL provided. ".
1605 "Did you set the taxdatadirectdownload configuration value?\n"
1613 # really should get a table EXCLUSIVE lock here
1614 # check if initial import or update
1616 # relying on mkdir "$dir.new" as a mutex
1618 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1619 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1620 $sth->execute() or die $sth->errstr;
1621 my $update = $sth->fetchrow_arrayref->[0];
1623 # create cache and/or rotate old tax data
1628 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1629 foreach my $file (readdir($dirh)) {
1630 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1637 if ( -e "$dir.$_" ) {
1638 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1641 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1645 die "can't find previous tax data\n" if $update;
1649 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1651 # fetch and unpack the zip files
1653 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1655 # extract csv files from the dbf files
1657 foreach my $name ( @namelist ) {
1658 _cch_extract_csv_from_dbf( $job, $dir, $name );
1661 # generate the diff files
1664 foreach my $name ( @namelist ) {
1665 my $difffile = "$dir.new/$name.txt";
1667 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1668 die $error if $error;
1669 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1670 my $olddir = $update ? "$dir.1" : "";
1671 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1673 $difffile =~ s/^$cache_dir//;
1674 push @list, "${name}file:$difffile";
1677 # perform the import
1678 local $keep_cch_files = 1;
1679 $param->{uploaded_files} = join( ',', @list );
1680 $param->{format} .= '-update' if $update;
1682 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1684 rename "$dir.new", "$dir"
1685 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1688 die "Unknown format: $format";
1692 =item browse_queries PARAMS
1694 Returns a list consisting of a hashref suited for use as the argument
1695 to qsearch, and sql query string. Each is based on the PARAMS hashref
1696 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1697 from a form. This conveniently creates the query hashref and count_query
1698 string required by the browse and search elements. As a side effect,
1699 the PARAMS hashref is untainted and keys with unexpected values are removed.
1703 sub browse_queries {
1707 'table' => 'tax_rate',
1709 'order_by' => 'ORDER BY geocode, taxclassnum',
1714 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1715 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1717 delete $params->{data_vendor};
1720 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1721 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1722 'geocode LIKE '. dbh->quote($1.'%');
1724 delete $params->{geocode};
1727 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1728 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1731 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1732 ' taxclassnum = '. dbh->quote($1)
1734 delete $params->{taxclassnun};
1738 if ( $params->{tax_type} =~ /^(\d+)$/ );
1739 delete $params->{tax_type}
1743 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1744 delete $params->{tax_cat}
1747 my @taxclassnum = ();
1748 if ($tax_type || $tax_cat ) {
1749 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1750 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1751 @taxclassnum = map { $_->taxclassnum }
1752 qsearch({ 'table' => 'tax_class',
1754 'extra_sql' => "WHERE taxclass $compare",
1758 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1759 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1760 if ( @taxclassnum );
1762 unless ($params->{'showdisabled'}) {
1763 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1764 "( disabled = '' OR disabled IS NULL )";
1767 $query->{extra_sql} = $extra_sql;
1769 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1772 =item queue_liability_report PARAMS
1774 Launches a tax liability report.
1777 sub queue_liability_report {
1779 my $param = thaw(decode_base64(shift));
1782 $cgi->param('beginning', $param->{beginning});
1783 $cgi->param('ending', $param->{ending});
1784 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1785 my $agentnum = $param->{agentnum};
1786 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1787 generate_liability_report(
1788 'beginning' => $beginning,
1789 'ending' => $ending,
1790 'agentnum' => $agentnum,
1791 'p' => $param->{RootURL},
1796 =item generate_liability_report PARAMS
1798 Generates a tax liability report. Provide a hash including desired
1799 agentnum, beginning, and ending
1803 sub generate_liability_report {
1806 my ( $count, $last, $min_sec ) = _progressbar_foo();
1808 #let us open the temp file early
1809 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1810 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1812 UNLINK => 0, # not so temp
1813 ) or die "can't open report file: $!\n";
1815 my $conf = new FS::Conf;
1816 my $money_char = $conf->config('money_char') || '$';
1819 JOIN cust_bill USING ( invnum )
1820 LEFT JOIN cust_main USING ( custnum )
1824 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1825 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1827 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1829 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1832 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1833 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1834 die "agent not found" unless $agent;
1835 $agentname = $agent->agent;
1836 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1839 # my ( $location_sql, @location_param ) = FS::cust_pkg->location_sql;
1840 # $where .= " AND $location_sql";
1841 #my @taxparam = ( 'itemdesc', @location_param );
1842 # now something along the lines of geocode matching ?
1843 #$where .= FS::cust_pkg->_location_sql_where('cust_tax_location');;
1844 my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1846 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1848 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1849 #to FS::Report or FS::Record or who the fuck knows where)
1850 my $scalar_sql = sub {
1851 my( $r, $param, $sql ) = @_;
1852 my $sth = dbh->prepare($sql) or die dbh->errstr;
1853 $sth->execute( map $r->$_(), @$param )
1854 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1855 $sth->fetchrow_arrayref->[0] || 0;
1863 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1865 hashref => { pkgpart => 0 },
1866 addl_from => $addl_from,
1867 extra_sql => $where,
1869 $count = scalar(@tax_and_location);
1870 foreach my $t ( @tax_and_location ) {
1873 if ( time - $min_sec > $last ) {
1874 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1881 my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1882 my $label = join('~', map { $t->$_ } @params);
1883 $label = 'Tax'. $label if $label =~ /^~/;
1884 unless ( exists( $taxes{$label} ) ) {
1885 my ($baselabel, @trash) = split /~/, $label;
1887 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1888 $taxes{$label}->{'url_param'} =
1889 join(';', map { "$_=". uri_escape($t->$_) } @params);
1891 my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND payby != 'COMP' ".
1892 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1894 my $sql = "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) ".
1895 " $taxwhere AND cust_bill_pkg.pkgnum = 0";
1897 my $x = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1899 $taxes{$label}->{'tax'} += $x;
1901 my $creditfrom = " JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum) ";
1902 my $creditwhere = "FROM cust_bill_pkg $addl_from $creditfrom $where ".
1903 "AND payby != 'COMP' ".
1904 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1906 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1907 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1909 my $y = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1911 $taxes{$label}->{'credit'} += $y;
1913 unless ( exists( $taxes{$baselabel} ) ) {
1915 $basetaxes{$baselabel}->{'label'} = $baselabel;
1916 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1917 $basetaxes{$baselabel}->{'base'} = 1;
1921 $basetaxes{$baselabel}->{'tax'} += $x;
1922 $basetaxes{$baselabel}->{'credit'} += $y;
1926 # calculate customer-exemption for this tax
1927 # calculate package-exemption for this tax
1928 # calculate monthly exemption (texas tax) for this tax
1929 # count up all the cust_tax_exempt_pkg records associated with
1930 # the actual line items.
1937 $args{job}->update_statustext( "0,Sorted" );
1943 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1944 my ($base, @trash) = split '~', $tax;
1945 my $basetax = delete( $basetaxes{$base} );
1947 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1948 $taxes{$tax}->{base} = 1;
1950 push @taxes, $basetax;
1953 push @taxes, $taxes{$tax};
1960 'credit' => $credit,
1965 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1966 $dateagentlink .= ';agentnum='. $args{agentnum}
1967 if length($agentname);
1968 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1971 print $report <<EOF;
1973 <% include("/elements/header.html", "$agentname Tax Report - ".
1975 ? time2str('%h %o %Y ', $args{beginning} )
1979 ( $args{ending} == 4294967295
1981 : time2str('%h %o %Y', $args{ending} )
1986 <% include('/elements/table-grid.html') %>
1989 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1990 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1991 <TH CLASS="grid" BGCOLOR="#cccccc">Tax collected</TH>
1992 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
1993 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1994 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
1998 my $bgcolor1 = '#eeeeee';
1999 my $bgcolor2 = '#ffffff';
2002 $count = scalar(@taxes);
2004 foreach my $tax ( @taxes ) {
2007 if ( time - $min_sec > $last ) {
2008 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2015 if ( $bgcolor eq $bgcolor1 ) {
2016 $bgcolor = $bgcolor2;
2018 $bgcolor = $bgcolor1;
2022 if ( $tax->{'label'} ne 'Total' ) {
2023 $link = ';'. $tax->{'url_param'};
2026 print $report <<EOF;
2028 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2029 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2030 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2031 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2033 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2034 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2035 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2036 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2037 <A HREF="<% '$baselink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2039 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2044 print $report <<EOF;
2051 my $reportname = $report->filename;
2054 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2055 $reportname =~ s/^$dropstring//;
2057 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2058 die "<a href=$reporturl>view</a>\n";
2068 Mixing automatic and manual editing works poorly at present.
2070 Tax liability calculations take too long and arguably don't belong here.
2071 Tax liability report generation not entirely safe (escaped).
2075 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base