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 );
23 use FS::cust_bill_pkg;
24 use FS::cust_tax_location;
25 use FS::tax_rate_location;
26 use FS::part_pkg_taxrate;
27 use FS::part_pkg_taxproduct;
29 use FS::Misc qw( csv_from_fixed );
33 @ISA = qw( FS::Record );
36 $me = '[FS::tax_rate]';
41 FS::tax_rate - Object methods for tax_rate objects
47 $record = new FS::tax_rate \%hash;
48 $record = new FS::tax_rate { 'column' => 'value' };
50 $error = $record->insert;
52 $error = $new_record->replace($old_record);
54 $error = $record->delete;
56 $error = $record->check;
60 An FS::tax_rate object represents a tax rate, defined by locale.
61 FS::tax_rate inherits from FS::Record. The following fields are
68 primary key (assigned automatically for new tax rates)
72 a geographic location code provided by a tax data vendor
80 a location code provided by a tax authority
84 a foreign key into FS::tax_class - the type of tax
85 referenced but FS::part_pkg_taxrate
88 the time after which the tax applies
96 second bracket percentage
100 the amount to which the tax applies (first bracket)
104 a cap on the amount of tax if a cap exists
108 percentage on out of jurisdiction purchases
112 second bracket percentage on out of jurisdiction purchases
116 one of the values in %tax_unittypes
120 amount of tax per unit
124 second bracket amount of tax per unit
128 the number of units to which the fee applies (first bracket)
132 the most units to which fees apply (first and second brackets)
136 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
140 if defined, printed on invoices instead of "Tax"
144 a value from %tax_authorities
148 a value from %tax_basetypes indicating the tax basis
152 a value from %tax_passtypes indicating how the tax should displayed to the customer
156 'Y', 'N', or blank indicating the tax can be passed to the customer
160 if 'Y', this tax does not apply to setup fees
164 if 'Y', this tax does not apply to recurring fees
168 if 'Y', has been manually edited
178 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
182 sub table { 'tax_rate'; }
186 Adds this tax rate to the database. If there is an error, returns the error,
187 otherwise returns false.
191 Deletes this tax rate from the database. If there is an error, returns the
192 error, otherwise returns false.
194 =item replace OLD_RECORD
196 Replaces the OLD_RECORD with this one in the database. If there is an error,
197 returns the error, otherwise returns false.
201 Checks all fields to make sure this is a valid tax rate. If there is an error,
202 returns the error, otherwise returns false. Called by the insert and replace
210 foreach (qw( taxbase taxmax )) {
211 $self->$_(0) unless $self->$_;
214 $self->ut_numbern('taxnum')
215 || $self->ut_text('geocode')
216 || $self->ut_textn('data_vendor')
217 || $self->ut_textn('location')
218 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
219 || $self->ut_snumbern('effective_date')
220 || $self->ut_float('tax')
221 || $self->ut_floatn('excessrate')
222 || $self->ut_money('taxbase')
223 || $self->ut_money('taxmax')
224 || $self->ut_floatn('usetax')
225 || $self->ut_floatn('useexcessrate')
226 || $self->ut_numbern('unittype')
227 || $self->ut_floatn('fee')
228 || $self->ut_floatn('excessfee')
229 || $self->ut_floatn('feemax')
230 || $self->ut_numbern('maxtype')
231 || $self->ut_textn('taxname')
232 || $self->ut_numbern('taxauth')
233 || $self->ut_numbern('basetype')
234 || $self->ut_numbern('passtype')
235 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
236 || $self->ut_enum('setuptax', [ '', 'Y' ] )
237 || $self->ut_enum('recurtax', [ '', 'Y' ] )
238 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
239 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
240 || $self->ut_enum('manual', [ '', 'Y' ] )
241 || $self->ut_enum('disabled', [ '', 'Y' ] )
242 || $self->SUPER::check
247 =item taxclass_description
249 Returns the human understandable value associated with the related
254 sub taxclass_description {
256 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
257 $tax_class ? $tax_class->description : '';
262 Returns the human understandable value associated with the unittype column
266 %tax_unittypes = ( '0' => 'access line',
273 $tax_unittypes{$self->unittype};
278 Returns the human understandable value associated with the maxtype column
282 %tax_maxtypes = ( '0' => 'receipts per invoice',
283 '1' => 'receipts per item',
284 '2' => 'total utility charges per utility tax year',
285 '3' => 'total charges per utility tax year',
286 '4' => 'receipts per access line',
287 '9' => 'monthly receipts per location',
292 $tax_maxtypes{$self->maxtype};
297 Returns the human understandable value associated with the basetype column
301 %tax_basetypes = ( '0' => 'sale price',
302 '1' => 'gross receipts',
303 '2' => 'sales taxable telecom revenue',
304 '3' => 'minutes carried',
305 '4' => 'minutes billed',
306 '5' => 'gross operating revenue',
307 '6' => 'access line',
309 '8' => 'gross revenue',
310 '9' => 'portion gross receipts attributable to interstate service',
311 '10' => 'access line',
312 '11' => 'gross profits',
313 '12' => 'tariff rate',
315 '15' => 'prior year gross receipts',
320 $tax_basetypes{$self->basetype};
325 Returns the human understandable value associated with the taxauth column
329 %tax_authorities = ( '0' => 'federal',
334 '5' => 'county administered by state',
335 '6' => 'city administered by state',
336 '7' => 'city administered by county',
337 '8' => 'local administered by state',
338 '9' => 'local administered by county',
343 $tax_authorities{$self->taxauth};
348 Returns the human understandable value associated with the passtype column
352 %tax_passtypes = ( '0' => 'separate tax line',
353 '1' => 'separate surcharge line',
354 '2' => 'surcharge not separated',
355 '3' => 'included in base rate',
360 $tax_passtypes{$self->passtype};
363 =item taxline TAXABLES, [ OPTIONSHASH ]
365 Returns a listref of a name and an amount of tax calculated for the list
366 of packages/amounts referenced by TAXABLES. If an error occurs, a message
367 is returned as a scalar.
377 if (ref($_[0]) eq 'ARRAY') {
382 #exemptions would be broken in this case
385 my $name = $self->taxname;
386 $name = 'Other surcharges'
387 if ($self->passtype == 2);
390 if ( $self->disabled ) { # we always know how to handle disabled taxes
397 my $taxable_charged = 0;
398 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
401 warn "calculating taxes for ". $self->taxnum. " on ".
402 join (",", map { $_->pkgnum } @cust_bill_pkg)
405 if ($self->passflag eq 'N') {
406 # return "fatal: can't (yet) handle taxes not passed to the customer";
407 # until someone needs to track these in freeside
414 my $maxtype = $self->maxtype || 0;
415 if ($maxtype != 0 && $maxtype != 9) {
416 return $self->_fatal_or_null( 'tax with "'.
417 $self->maxtype_name. '" threshold'
423 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
427 # we treat gross revenue as gross receipts and expect the tax data
428 # to DTRT (i.e. tax on tax rules)
429 if ($self->basetype != 0 && $self->basetype != 1 &&
430 $self->basetype != 5 && $self->basetype != 6 &&
431 $self->basetype != 7 && $self->basetype != 8 &&
432 $self->basetype != 14
435 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
438 unless ($self->setuptax =~ /^Y$/i) {
439 $taxable_charged += $_->setup foreach @cust_bill_pkg;
441 unless ($self->recurtax =~ /^Y$/i) {
442 $taxable_charged += $_->recur foreach @cust_bill_pkg;
445 my $taxable_units = 0;
446 unless ($self->recurtax =~ /^Y$/i) {
448 if (( $self->unittype || 0 ) == 0) { #access line
450 foreach (@cust_bill_pkg) {
451 $taxable_units += $_->units
452 unless $seen{$_->pkgnum}++;
455 } elsif ($self->unittype == 1) { #minute
456 return $self->_fatal_or_null( 'fee with minute unit type' );
458 } elsif ($self->unittype == 2) { #account
460 my $conf = new FS::Conf;
461 if ( $conf->exists('tax-pkg_address') ) {
462 #number of distinct locations
464 foreach (@cust_bill_pkg) {
466 unless $seen{$_->cust_pkg->locationnum}++;
473 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
479 # XXX insert exemption handling here
481 # the tax or fee is applied to taxbase or feebase and then
482 # the excessrate or excess fee is applied to taxmax or feemax
485 $amount += $taxable_charged * $self->tax;
486 $amount += $taxable_units * $self->fee;
488 warn "calculated taxes as [ $name, $amount ]\n"
499 my ($self, $error) = @_;
501 my $conf = new FS::Conf;
503 $error = "can't yet handle ". $error;
504 my $name = $self->taxname;
505 $name = 'Other surcharges'
506 if ($self->passtype == 2);
508 if ($conf->exists('ignore_incalculable_taxes')) {
509 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
510 return { name => $name, amount => 0 };
512 return "fatal: $error";
516 =item tax_on_tax CUST_MAIN
518 Returns a list of taxes which are candidates for taxing taxes for the
519 given customer (see L<FS::cust_main>)
527 my $cust_main = shift;
529 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
533 my $geocode = $cust_main->geocode($self->data_vendor);
537 my $extra_sql = ' AND ('.
538 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
543 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
544 my $select = 'DISTINCT ON(taxclassnum) *';
546 # should qsearch preface columns with the table to facilitate joins?
547 my @taxclassnums = map { $_->taxclassnum }
548 qsearch( { 'table' => 'part_pkg_taxrate',
550 'hashref' => { 'data_vendor' => $self->data_vendor,
551 'taxclassnumtaxed' => $self->taxclassnum,
553 'extra_sql' => $extra_sql,
554 'order_by' => $order_by,
557 return () unless @taxclassnums;
560 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
562 qsearch({ 'table' => 'tax_rate',
563 'hashref' => { 'geocode' => $geocode, },
564 'extra_sql' => $extra_sql,
569 =item tax_rate_location
571 Returns an object representing the location associated with this tax
572 (see L<FS::tax_rate_location>)
576 sub tax_rate_location {
579 qsearchs({ 'table' => 'tax_rate_location',
580 'hashref' => { 'data_vendor' => $self->data_vendor,
581 'geocode' => $self->geocode,
585 new FS::tax_rate_location;
599 sub _progressbar_foo {
604 my ($param, $job) = @_;
606 my $fh = $param->{filehandle};
607 my $format = $param->{'format'};
615 my @column_lengths = ();
616 my @column_callbacks = ();
617 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
618 $format =~ s/-fixed//;
619 my $date_format = sub { my $r='';
620 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
623 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
624 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 );
625 push @column_lengths, 1 if $format eq 'cch-update';
626 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
627 $column_callbacks[8] = $date_format;
631 my ( $count, $last, $min_sec ) = _progressbar_foo();
632 if ( $job || scalar(@column_callbacks) ) {
634 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
635 return $error if $error;
639 if ( $format eq 'cch' || $format eq 'cch-update' ) {
640 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
641 excessrate effective_date taxauth taxtype taxcat taxname
642 usetax useexcessrate fee unittype feemax maxtype passflag
644 push @fields, 'actionflag' if $format eq 'cch-update';
649 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
650 $hash->{'data_vendor'} ='cch';
651 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
652 time_zone => 'floating',
654 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
655 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
657 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
658 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
661 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
663 my %tax_class = ( 'data_vendor' => 'cch',
664 'taxclass' => $taxclassid,
667 my $tax_class = qsearchs( 'tax_class', \%tax_class );
668 return "Error updating tax rate: no tax class $taxclassid"
671 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
673 foreach (qw( taxtype taxcat )) {
677 my %passflagmap = ( '0' => '',
681 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
682 if exists $passflagmap{$hash->{'passflag'}};
684 foreach (keys %$hash) {
685 $hash->{$_} = substr($hash->{$_}, 0, 80)
686 if length($hash->{$_}) > 80;
689 my $actionflag = delete($hash->{'actionflag'});
691 $hash->{'taxname'} =~ s/`/'/g;
692 $hash->{'taxname'} =~ s|\\|/|g;
694 return '' if $format eq 'cch'; # but not cch-update
696 if ($actionflag eq 'I') {
697 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
698 }elsif ($actionflag eq 'D') {
699 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
701 return "Unexpected action flag: ". $hash->{'actionflag'};
704 delete($hash->{$_}) for keys %$hash;
710 } elsif ( $format eq 'extended' ) {
711 die "unimplemented\n";
715 die "unknown format $format";
718 eval "use Text::CSV_XS;";
721 my $csv = new Text::CSV_XS;
725 local $SIG{HUP} = 'IGNORE';
726 local $SIG{INT} = 'IGNORE';
727 local $SIG{QUIT} = 'IGNORE';
728 local $SIG{TERM} = 'IGNORE';
729 local $SIG{TSTP} = 'IGNORE';
730 local $SIG{PIPE} = 'IGNORE';
732 my $oldAutoCommit = $FS::UID::AutoCommit;
733 local $FS::UID::AutoCommit = 0;
736 while ( defined($line=<$fh>) ) {
737 $csv->parse($line) or do {
738 $dbh->rollback if $oldAutoCommit;
739 return "can't parse: ". $csv->error_input();
742 if ( $job ) { # progress bar
743 if ( time - $min_sec > $last ) {
744 my $error = $job->update_statustext(
745 int( 100 * $imported / $count ). ",Importing tax rates"
748 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
755 my @columns = $csv->fields();
757 my %tax_rate = ( 'data_vendor' => $format );
758 foreach my $field ( @fields ) {
759 $tax_rate{$field} = shift @columns;
761 if ( scalar( @columns ) ) {
762 $dbh->rollback if $oldAutoCommit;
763 return "Unexpected trailing columns in line (wrong format?): $line";
766 my $error = &{$hook}(\%tax_rate);
768 $dbh->rollback if $oldAutoCommit;
772 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
774 my $tax_rate = new FS::tax_rate( \%tax_rate );
775 $error = $tax_rate->insert;
778 $dbh->rollback if $oldAutoCommit;
779 return "can't insert tax_rate for $line: $error";
788 for (grep { !exists($delete{$_}) } keys %insert) {
789 if ( $job ) { # progress bar
790 if ( time - $min_sec > $last ) {
791 my $error = $job->update_statustext(
792 int( 100 * $imported / $count ). ",Importing tax rates"
795 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
802 my $tax_rate = new FS::tax_rate( $insert{$_} );
803 my $error = $tax_rate->insert;
806 $dbh->rollback if $oldAutoCommit;
807 my $hashref = $insert{$_};
808 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
809 return "can't insert tax_rate for $line: $error";
815 for (grep { exists($delete{$_}) } keys %insert) {
816 if ( $job ) { # progress bar
817 if ( time - $min_sec > $last ) {
818 my $error = $job->update_statustext(
819 int( 100 * $imported / $count ). ",Importing tax rates"
822 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
829 my $old = qsearchs( 'tax_rate', $delete{$_} );
831 $dbh->rollback if $oldAutoCommit;
833 return "can't find tax_rate to replace for: ".
834 #join(" ", map { "$_ => ". $old->{$_} } @fields);
835 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
837 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
838 $new->taxnum($old->taxnum);
839 my $error = $new->replace($old);
842 $dbh->rollback if $oldAutoCommit;
843 my $hashref = $insert{$_};
844 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
845 return "can't replace tax_rate for $line: $error";
852 for (grep { !exists($insert{$_}) } keys %delete) {
853 if ( $job ) { # progress bar
854 if ( time - $min_sec > $last ) {
855 my $error = $job->update_statustext(
856 int( 100 * $imported / $count ). ",Importing tax rates"
859 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
866 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
868 $dbh->rollback if $oldAutoCommit;
869 $tax_rate = $delete{$_};
870 return "can't find tax_rate to delete for: ".
871 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
872 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
874 my $error = $tax_rate->delete;
877 $dbh->rollback if $oldAutoCommit;
878 my $hashref = $delete{$_};
879 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
880 return "can't delete tax_rate for $line: $error";
886 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
888 return "Empty file!" unless ($imported || $format eq 'cch-update');
894 =item process_batch_import
896 Load a batch import as a queued JSRPC job
900 sub process_batch_import {
903 my $oldAutoCommit = $FS::UID::AutoCommit;
904 local $FS::UID::AutoCommit = 0;
907 my $param = thaw(decode_base64(shift));
908 my $args = '$job, encode_base64( nfreeze( $param ) )';
910 my $method = '_perform_batch_import';
911 if ( $param->{reload} ) {
912 $method = 'process_batch_reload';
915 eval "$method($args);";
917 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
922 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
925 sub _perform_batch_import {
928 my $param = thaw(decode_base64(shift));
929 my $format = $param->{'format'}; #well... this is all cch specific
931 my $files = $param->{'uploaded_files'}
932 or die "No files provided.";
934 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
937 if ( $format eq 'cch' || $format eq 'cch-fixed'
938 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
941 my $oldAutoCommit = $FS::UID::AutoCommit;
942 local $FS::UID::AutoCommit = 0;
945 my @insert_list = ();
946 my @delete_list = ();
947 my @predelete_list = ();
950 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
952 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
953 'CODE', \&FS::tax_class::batch_import,
954 'PLUS4', \&FS::cust_tax_location::batch_import,
955 'ZIP', \&FS::cust_tax_location::batch_import,
956 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
957 'DETAIL', \&FS::tax_rate::batch_import,
959 while( scalar(@list) ) {
960 my ( $name, $import_sub ) = splice( @list, 0, 2 );
961 my $file = lc($name). 'file';
963 unless ($files{$file}) {
964 $error = "No $name supplied";
967 next if $name eq 'DETAIL' && $format =~ /update/;
969 my $filename = "$dir/". $files{$file};
971 if ( $format =~ /update/ ) {
973 ( $error, $insertname, $deletename ) =
974 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
978 unlink $filename or warn "Can't delete $filename: $!"
979 unless $keep_cch_files;
980 push @insert_list, $name, $insertname, $import_sub, $format;
981 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
982 unshift @predelete_list, $name, $deletename, $import_sub, $format;
984 unshift @delete_list, $name, $deletename, $import_sub, $format;
989 push @insert_list, $name, $filename, $import_sub, $format;
996 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
997 if $format =~ /update/;
999 $error ||= _perform_cch_tax_import( $job,
1000 [ @predelete_list ],
1006 @list = ( @predelete_list, @insert_list, @delete_list );
1007 while( !$keep_cch_files && scalar(@list) ) {
1008 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1009 unlink $file or warn "Can't delete $file: $!";
1013 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1016 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1020 die "Unknown format: $format";
1026 sub _perform_cch_tax_import {
1027 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1030 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1031 while( scalar(@$list) ) {
1032 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1033 my $fmt = "$format-update";
1034 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1035 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1036 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1044 sub _perform_cch_insert_delete_split {
1045 my ($name, $filename, $dir, $format) = @_;
1049 open my $fh, "< $filename"
1050 or $error ||= "Can't open $name file $filename: $!";
1052 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1055 ) or die "can't open temp file: $!\n";
1056 my $insertname = $ifh->filename;
1058 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1061 ) or die "can't open temp file: $!\n";
1062 my $deletename = $dfh->filename;
1064 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1065 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1068 $handle = $ifh if $_ =~ /$insert_pattern/;
1069 $handle = $dfh if $_ =~ /$delete_pattern/;
1071 $error = "bad input line: $_" unless $handle;
1080 return ($error, $insertname, $deletename);
1083 sub _perform_cch_diff {
1084 my ($name, $newdir, $olddir) = @_;
1089 open my $oldcsvfh, "$olddir/$name.txt"
1090 or die "failed to open $olddir/$name.txt: $!\n";
1092 while(<$oldcsvfh>) {
1099 open my $newcsvfh, "$newdir/$name.txt"
1100 or die "failed to open $newdir/$name.txt: $!\n";
1102 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1105 ) or die "can't open temp file: $!\n";
1106 my $diffname = $dfh->filename;
1108 while(<$newcsvfh>) {
1110 if (exists($oldlines{$_})) {
1113 print $dfh $_, ',"I"', "\n";
1118 for (keys %oldlines) {
1119 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1127 sub _cch_fetch_and_unzip {
1128 my ( $job, $urls, $secret, $dir ) = @_;
1130 my $ua = new LWP::UserAgent;
1131 foreach my $url (split ',', $urls) {
1132 my @name = split '/', $url; #somewhat restrictive
1133 my $name = pop @name;
1134 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1137 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1139 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1140 my $res = $ua->request(
1141 new HTTP::Request( GET => $url ),
1143 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1144 my $content_length = $_[1]->content_length;
1145 $imported += length($_[0]);
1146 if ( time - $min_sec > $last ) {
1147 my $error = $job->update_statustext(
1148 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1149 ",Downloading data from CCH"
1151 die $error if $error;
1156 die "download of $url failed: ". $res->status_line
1157 unless $res->is_success;
1160 my $error = $job->update_statustext( "0,Unpacking data" );
1161 die $error if $error;
1162 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1164 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1165 or die "unzip -P $secret -d $dir $dir/$name failed";
1166 #unlink "$dir/$name";
1170 sub _cch_extract_csv_from_dbf {
1171 my ( $job, $dir, $name ) = @_;
1173 eval "use Text::CSV_XS;";
1179 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1180 my $error = $job->update_statustext( "0,Unpacking $name" );
1181 die $error if $error;
1182 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1183 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1184 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1185 unless defined($table);
1186 my $count = $table->last_record; # approximately;
1187 open my $csvfh, ">$dir.new/$name.txt"
1188 or die "failed to open $dir.new/$name.txt: $!\n";
1190 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1191 my @fields = $table->field_names;
1192 my $cursor = $table->prepare_select;
1194 sub { my $date = shift;
1195 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1198 while (my $row = $cursor->fetch_hashref) {
1199 $csv->combine( map { my $type = $table->field_type($_);
1201 &{$format_date}($row->{$_}) ;
1202 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1203 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1210 print $csvfh $csv->string, "\n";
1212 if ( time - $min_sec > $last ) {
1213 my $error = $job->update_statustext(
1214 int(100 * $imported/$count). ",Unpacking $name"
1216 die $error if $error;
1224 sub _remember_disabled_taxes {
1225 my ( $job, $format, $disabled_tax_rate ) = @_;
1229 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1231 my @items = qsearch( { table => 'tax_rate',
1232 hashref => { disabled => 'Y',
1233 data_vendor => $format,
1235 select => 'geocode, taxclassnum',
1238 my $count = scalar(@items);
1239 foreach my $tax_rate ( @items ) {
1240 if ( time - $min_sec > $last ) {
1241 $job->update_statustext(
1242 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1248 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1249 unless ( $tax_class ) {
1250 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1253 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1257 sub _remember_tax_products {
1258 my ( $job, $format, $taxproduct ) = @_;
1260 # XXX FIXME this loop only works when cch is the only data provider
1262 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1264 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1265 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1266 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1267 " optionname LIKE 'usage_taxproductnum_%' AND ".
1268 " optionvalue != '' )";
1269 my @items = qsearch( { table => 'part_pkg',
1270 select => 'DISTINCT pkgpart,taxproductnum',
1272 extra_sql => $extra_sql,
1275 my $count = scalar(@items);
1276 foreach my $part_pkg ( @items ) {
1277 if ( time - $min_sec > $last ) {
1278 $job->update_statustext(
1279 int( 100 * $imported / $count ). ",Remembering tax products"
1284 warn "working with package part ". $part_pkg->pkgpart.
1285 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1286 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1287 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1288 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1290 foreach my $option ( $part_pkg->part_pkg_option ) {
1291 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1294 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1295 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1296 $part_pkg_taxproduct->taxproduct
1297 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1302 sub _restore_remembered_tax_products {
1303 my ( $job, $format, $taxproduct ) = @_;
1307 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1308 my $count = scalar(keys %$taxproduct);
1309 foreach my $pkgpart ( keys %$taxproduct ) {
1310 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1311 if ( time - $min_sec > $last ) {
1312 $job->update_statustext(
1313 int( 100 * $imported / $count ). ",Restoring tax products"
1319 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1320 unless ( $part_pkg ) {
1321 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1324 my %options = $part_pkg->options;
1325 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1326 my $primary_svc = $part_pkg->svcpart;
1327 my $new = new FS::part_pkg { $part_pkg->hash };
1329 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1330 warn "working with class '$class'\n" if $DEBUG;
1331 my $part_pkg_taxproduct =
1332 qsearchs( 'part_pkg_taxproduct',
1333 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1334 data_vendor => $format,
1338 unless ( $part_pkg_taxproduct ) {
1339 return "failed to find part_pkg_taxproduct (".
1340 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1343 if ( $class eq '' ) {
1344 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1348 $options{"usage_taxproductnum_$class"} =
1349 $part_pkg_taxproduct->taxproductnum;
1353 my $error = $new->replace( $part_pkg,
1354 'pkg_svc' => \%pkg_svc,
1355 'primary_svc' => $primary_svc,
1356 'options' => \%options,
1359 return $error if $error;
1366 sub _restore_remembered_disabled_taxes {
1367 my ( $job, $format, $disabled_tax_rate ) = @_;
1369 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1370 my $count = scalar(keys %$disabled_tax_rate);
1371 foreach my $key (keys %$disabled_tax_rate) {
1372 if ( time - $min_sec > $last ) {
1373 $job->update_statustext(
1374 int( 100 * $imported / $count ). ",Disabling tax rates"
1379 my ($geocode,$taxclass) = split /:/, $key, 2;
1380 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1381 taxclass => $taxclass,
1383 return "found multiple tax_class records for format $format class $taxclass"
1384 if scalar(@tax_class) > 1;
1386 unless (scalar(@tax_class)) {
1387 warn "no tax_class for format $format class $taxclass\n";
1392 qsearch('tax_rate', { data_vendor => $format,
1393 geocode => $geocode,
1394 taxclassnum => $tax_class[0]->taxclassnum,
1398 if (scalar(@tax_rate) > 1) {
1399 return "found multiple tax_rate records for format $format geocode ".
1400 "$geocode and taxclass $taxclass ( taxclassnum ".
1401 $tax_class[0]->taxclassnum. " )";
1404 if (scalar(@tax_rate)) {
1405 $tax_rate[0]->disabled('Y');
1406 my $error = $tax_rate[0]->replace;
1407 return $error if $error;
1412 sub _remove_old_tax_data {
1413 my ( $job, $format ) = @_;
1416 my $error = $job->update_statustext( "0,Removing old tax data" );
1417 die $error if $error;
1419 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1420 "WHERE data_vendor = ". $dbh->quote($format);
1421 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1424 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1426 foreach my $table ( @table ) {
1427 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1428 $dbh->quote($format);
1429 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1432 if ( $format eq 'cch' ) {
1433 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1434 $dbh->quote("$format-zip");
1435 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1441 sub _create_temporary_tables {
1442 my ( $job, $format ) = @_;
1445 my $error = $job->update_statustext( "0,Creating temporary tables" );
1446 die $error if $error;
1448 my @table = qw( tax_rate
1455 foreach my $table ( @table ) {
1457 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1458 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1464 sub _copy_from_temp {
1465 my ( $job, $format ) = @_;
1468 my $error = $job->update_statustext( "0,Making permanent" );
1469 die $error if $error;
1471 my @table = qw( tax_rate
1478 foreach my $table ( @table ) {
1480 "INSERT INTO public.$table SELECT * from $table";
1481 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1487 =item process_download_and_reload
1489 Download and process a tax update as a queued JSRPC job after wiping the
1490 existing wipable tax data.
1494 sub process_download_and_reload {
1495 _process_reload('process_download_and_update', @_);
1499 =item process_batch_reload
1501 Load and process a tax update from the provided files as a queued JSRPC job
1502 after wiping the existing wipable tax data.
1506 sub process_batch_reload {
1507 _process_reload('_perform_batch_import', @_);
1511 sub _process_reload {
1512 my ( $method, $job ) = ( shift, shift );
1514 my $param = thaw(decode_base64($_[0]));
1515 my $format = $param->{'format'}; #well... this is all cch specific
1517 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1519 if ( $job ) { # progress bar
1520 my $error = $job->update_statustext( 0 );
1521 die $error if $error;
1524 my $oldAutoCommit = $FS::UID::AutoCommit;
1525 local $FS::UID::AutoCommit = 0;
1530 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1531 "USING (taxclassnum) WHERE data_vendor = '$format'";
1532 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1534 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1535 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1536 if $sth->fetchrow_arrayref->[0];
1538 # really should get a table EXCLUSIVE lock here
1540 #remember disabled taxes
1541 my %disabled_tax_rate = ();
1542 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1544 #remember tax products
1545 my %taxproduct = ();
1546 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1549 $error ||= _create_temporary_tables( $job, $format );
1553 my $args = '$job, @_';
1554 eval "$method($args);";
1558 #restore taxproducts
1559 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1563 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1565 #wipe out the old data
1566 $error ||= _remove_old_tax_data( $job, $format );
1569 $error ||= _copy_from_temp( $job, $format );
1572 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1577 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1581 =item process_download_and_update
1583 Download and process a tax update as a queued JSRPC job
1587 sub process_download_and_update {
1590 my $param = thaw(decode_base64(shift));
1591 my $format = $param->{'format'}; #well... this is all cch specific
1593 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1595 if ( $job ) { # progress bar
1596 my $error = $job->update_statustext( 0);
1597 die $error if $error;
1600 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1601 my $dir = $cache_dir. 'taxdata';
1603 mkdir $dir or die "can't create $dir: $!\n";
1606 if ($format eq 'cch') {
1608 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1610 my $conf = new FS::Conf;
1611 die "direct download of tax data not enabled\n"
1612 unless $conf->exists('taxdatadirectdownload');
1613 my ( $urls, $username, $secret, $states ) =
1614 $conf->config('taxdatadirectdownload');
1615 die "No tax download URL provided. ".
1616 "Did you set the taxdatadirectdownload configuration value?\n"
1624 # really should get a table EXCLUSIVE lock here
1625 # check if initial import or update
1627 # relying on mkdir "$dir.new" as a mutex
1629 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1630 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1631 $sth->execute() or die $sth->errstr;
1632 my $update = $sth->fetchrow_arrayref->[0];
1634 # create cache and/or rotate old tax data
1639 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1640 foreach my $file (readdir($dirh)) {
1641 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1648 if ( -e "$dir.$_" ) {
1649 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1652 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1656 die "can't find previous tax data\n" if $update;
1660 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1662 # fetch and unpack the zip files
1664 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1666 # extract csv files from the dbf files
1668 foreach my $name ( @namelist ) {
1669 _cch_extract_csv_from_dbf( $job, $dir, $name );
1672 # generate the diff files
1675 foreach my $name ( @namelist ) {
1676 my $difffile = "$dir.new/$name.txt";
1678 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1679 die $error if $error;
1680 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1681 my $olddir = $update ? "$dir.1" : "";
1682 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1684 $difffile =~ s/^$cache_dir//;
1685 push @list, "${name}file:$difffile";
1688 # perform the import
1689 local $keep_cch_files = 1;
1690 $param->{uploaded_files} = join( ',', @list );
1691 $param->{format} .= '-update' if $update;
1693 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1695 rename "$dir.new", "$dir"
1696 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1699 die "Unknown format: $format";
1703 =item browse_queries PARAMS
1705 Returns a list consisting of a hashref suited for use as the argument
1706 to qsearch, and sql query string. Each is based on the PARAMS hashref
1707 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1708 from a form. This conveniently creates the query hashref and count_query
1709 string required by the browse and search elements. As a side effect,
1710 the PARAMS hashref is untainted and keys with unexpected values are removed.
1714 sub browse_queries {
1718 'table' => 'tax_rate',
1720 'order_by' => 'ORDER BY geocode, taxclassnum',
1725 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1726 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1728 delete $params->{data_vendor};
1731 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1732 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1733 'geocode LIKE '. dbh->quote($1.'%');
1735 delete $params->{geocode};
1738 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1739 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1742 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1743 ' taxclassnum = '. dbh->quote($1)
1745 delete $params->{taxclassnun};
1749 if ( $params->{tax_type} =~ /^(\d+)$/ );
1750 delete $params->{tax_type}
1754 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1755 delete $params->{tax_cat}
1758 my @taxclassnum = ();
1759 if ($tax_type || $tax_cat ) {
1760 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1761 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1762 @taxclassnum = map { $_->taxclassnum }
1763 qsearch({ 'table' => 'tax_class',
1765 'extra_sql' => "WHERE taxclass $compare",
1769 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1770 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1771 if ( @taxclassnum );
1773 unless ($params->{'showdisabled'}) {
1774 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1775 "( disabled = '' OR disabled IS NULL )";
1778 $query->{extra_sql} = $extra_sql;
1780 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1783 =item queue_liability_report PARAMS
1785 Launches a tax liability report.
1788 sub queue_liability_report {
1790 my $param = thaw(decode_base64(shift));
1793 $cgi->param('beginning', $param->{beginning});
1794 $cgi->param('ending', $param->{ending});
1795 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1796 my $agentnum = $param->{agentnum};
1797 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1798 generate_liability_report(
1799 'beginning' => $beginning,
1800 'ending' => $ending,
1801 'agentnum' => $agentnum,
1802 'p' => $param->{RootURL},
1807 =item generate_liability_report PARAMS
1809 Generates a tax liability report. Provide a hash including desired
1810 agentnum, beginning, and ending
1814 #shit, all sorts of false laxiness w/report_newtax.cgi
1815 sub generate_liability_report {
1818 my ( $count, $last, $min_sec ) = _progressbar_foo();
1820 #let us open the temp file early
1821 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1822 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1824 UNLINK => 0, # not so temp
1825 ) or die "can't open report file: $!\n";
1827 my $conf = new FS::Conf;
1828 my $money_char = $conf->config('money_char') || '$';
1831 JOIN cust_bill USING ( invnum )
1832 LEFT JOIN cust_main USING ( custnum )
1836 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1837 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1839 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1841 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1844 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1845 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1846 die "agent not found" unless $agent;
1847 $agentname = $agent->agent;
1848 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1851 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1852 my @taxparams = qw( city county state locationtaxid );
1853 my @params = ('itemdesc', @taxparams);
1855 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1857 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1858 #to FS::Report or FS::Record or who the fuck knows where)
1859 my $scalar_sql = sub {
1860 my( $r, $param, $sql ) = @_;
1861 my $sth = dbh->prepare($sql) or die dbh->errstr;
1862 $sth->execute( map $r->$_(), @$param )
1863 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1864 $sth->fetchrow_arrayref->[0] || 0;
1872 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1874 hashref => { pkgpart => 0 },
1875 addl_from => $addl_from,
1876 extra_sql => $where,
1878 $count = scalar(@tax_and_location);
1879 foreach my $t ( @tax_and_location ) {
1882 if ( time - $min_sec > $last ) {
1883 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1890 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1891 my $label = join('~', map { $t->$_ } @params);
1892 $label = 'Tax'. $label if $label =~ /^~/;
1893 unless ( exists( $taxes{$label} ) ) {
1894 my ($baselabel, @trash) = split /~/, $label;
1896 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1897 $taxes{$label}->{'url_param'} =
1898 join(';', map { "$_=". uri_escape($t->$_) } @params);
1900 my $payby_itemdesc_loc =
1901 " payby != 'COMP' ".
1902 "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1903 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1908 "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1910 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1912 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1914 $taxes{$label}->{'tax'} += $x;
1917 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1919 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1921 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1922 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1924 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1926 $taxes{$label}->{'credit'} += $y;
1928 unless ( exists( $taxes{$baselabel} ) ) {
1930 $basetaxes{$baselabel}->{'label'} = $baselabel;
1931 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1932 $basetaxes{$baselabel}->{'base'} = 1;
1936 $basetaxes{$baselabel}->{'tax'} += $x;
1937 $basetaxes{$baselabel}->{'credit'} += $y;
1941 # calculate customer-exemption for this tax
1942 # calculate package-exemption for this tax
1943 # calculate monthly exemption (texas tax) for this tax
1944 # count up all the cust_tax_exempt_pkg records associated with
1945 # the actual line items.
1952 $args{job}->update_statustext( "0,Sorted" );
1958 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1959 my ($base, @trash) = split '~', $tax;
1960 my $basetax = delete( $basetaxes{$base} );
1962 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1963 $taxes{$tax}->{base} = 1;
1965 push @taxes, $basetax;
1968 push @taxes, $taxes{$tax};
1975 'credit' => $credit,
1980 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1981 $dateagentlink .= ';agentnum='. $args{agentnum}
1982 if length($agentname);
1983 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1984 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
1986 print $report <<EOF;
1988 <% include("/elements/header.html", "$agentname Tax Report - ".
1990 ? time2str('%h %o %Y ', $args{beginning} )
1994 ( $args{ending} == 4294967295
1996 : time2str('%h %o %Y', $args{ending} )
2001 <% include('/elements/table-grid.html') %>
2004 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2005 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2006 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2007 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2008 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2009 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2013 my $bgcolor1 = '#eeeeee';
2014 my $bgcolor2 = '#ffffff';
2017 $count = scalar(@taxes);
2019 foreach my $tax ( @taxes ) {
2022 if ( time - $min_sec > $last ) {
2023 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2030 if ( $bgcolor eq $bgcolor1 ) {
2031 $bgcolor = $bgcolor2;
2033 $bgcolor = $bgcolor1;
2037 if ( $tax->{'label'} ne 'Total' ) {
2038 $link = ';'. $tax->{'url_param'};
2041 print $report <<EOF;
2043 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2044 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2045 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2046 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2048 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2049 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2050 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2051 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2052 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2054 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2059 print $report <<EOF;
2066 my $reportname = $report->filename;
2069 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2070 $reportname =~ s/^$dropstring//;
2072 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2073 die "<a href=$reporturl>view</a>\n";
2083 Mixing automatic and manual editing works poorly at present.
2085 Tax liability calculations take too long and arguably don't belong here.
2086 Tax liability report generation not entirely safe (escaped).
2090 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base