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 { ($table->field_type($_) eq 'D')
1200 ? &{$format_date}($row->{$_})
1205 print $csvfh $csv->string, "\n";
1207 if ( time - $min_sec > $last ) {
1208 my $error = $job->update_statustext(
1209 int(100 * $imported/$count). ",Unpacking $name"
1211 die $error if $error;
1219 sub _remember_disabled_taxes {
1220 my ( $job, $format, $disabled_tax_rate ) = @_;
1224 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1226 my @items = qsearch( { table => 'tax_rate',
1227 hashref => { disabled => 'Y',
1228 data_vendor => $format,
1230 select => 'geocode, taxclassnum',
1233 my $count = scalar(@items);
1234 foreach my $tax_rate ( @items ) {
1235 if ( time - $min_sec > $last ) {
1236 $job->update_statustext(
1237 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1243 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1244 unless ( $tax_class ) {
1245 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1248 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1252 sub _remember_tax_products {
1253 my ( $job, $format, $taxproduct ) = @_;
1255 # XXX FIXME this loop only works when cch is the only data provider
1257 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1259 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1260 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1261 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1262 " optionname LIKE 'usage_taxproductnum_%' AND ".
1263 " optionvalue != '' )";
1264 my @items = qsearch( { table => 'part_pkg',
1265 select => 'DISTINCT pkgpart,taxproductnum',
1267 extra_sql => $extra_sql,
1270 my $count = scalar(@items);
1271 foreach my $part_pkg ( @items ) {
1272 if ( time - $min_sec > $last ) {
1273 $job->update_statustext(
1274 int( 100 * $imported / $count ). ",Remembering tax products"
1279 warn "working with package part ". $part_pkg->pkgpart.
1280 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1281 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1282 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1283 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1285 foreach my $option ( $part_pkg->part_pkg_option ) {
1286 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1289 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1290 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1291 $part_pkg_taxproduct->taxproduct
1292 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1297 sub _restore_remembered_tax_products {
1298 my ( $job, $format, $taxproduct ) = @_;
1302 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1303 my $count = scalar(keys %$taxproduct);
1304 foreach my $pkgpart ( keys %$taxproduct ) {
1305 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1306 if ( time - $min_sec > $last ) {
1307 $job->update_statustext(
1308 int( 100 * $imported / $count ). ",Restoring tax products"
1314 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1315 unless ( $part_pkg ) {
1316 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1319 my %options = $part_pkg->options;
1320 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1321 my $primary_svc = $part_pkg->svcpart;
1322 my $new = new FS::part_pkg { $part_pkg->hash };
1324 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1325 warn "working with class '$class'\n" if $DEBUG;
1326 my $part_pkg_taxproduct =
1327 qsearchs( 'part_pkg_taxproduct',
1328 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1329 data_vendor => $format,
1333 unless ( $part_pkg_taxproduct ) {
1334 return "failed to find part_pkg_taxproduct (".
1335 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1338 if ( $class eq '' ) {
1339 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1343 $options{"usage_taxproductnum_$class"} =
1344 $part_pkg_taxproduct->taxproductnum;
1348 my $error = $new->replace( $part_pkg,
1349 'pkg_svc' => \%pkg_svc,
1350 'primary_svc' => $primary_svc,
1351 'options' => \%options,
1354 return $error if $error;
1361 sub _restore_remembered_disabled_taxes {
1362 my ( $job, $format, $disabled_tax_rate ) = @_;
1364 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1365 my $count = scalar(keys %$disabled_tax_rate);
1366 foreach my $key (keys %$disabled_tax_rate) {
1367 if ( time - $min_sec > $last ) {
1368 $job->update_statustext(
1369 int( 100 * $imported / $count ). ",Disabling tax rates"
1374 my ($geocode,$taxclass) = split /:/, $key, 2;
1375 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1376 taxclass => $taxclass,
1378 return "found multiple tax_class records for format $format class $taxclass"
1379 if scalar(@tax_class) > 1;
1381 unless (scalar(@tax_class)) {
1382 warn "no tax_class for format $format class $taxclass\n";
1387 qsearch('tax_rate', { data_vendor => $format,
1388 geocode => $geocode,
1389 taxclassnum => $tax_class[0]->taxclassnum,
1393 if (scalar(@tax_rate) > 1) {
1394 return "found multiple tax_rate records for format $format geocode ".
1395 "$geocode and taxclass $taxclass ( taxclassnum ".
1396 $tax_class[0]->taxclassnum. " )";
1399 if (scalar(@tax_rate)) {
1400 $tax_rate[0]->disabled('Y');
1401 my $error = $tax_rate[0]->replace;
1402 return $error if $error;
1407 sub _remove_old_tax_data {
1408 my ( $job, $format ) = @_;
1411 my $error = $job->update_statustext( "0,Removing old tax data" );
1412 die $error if $error;
1414 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1415 "WHERE data_vendor = ". $dbh->quote($format);
1416 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1419 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1421 foreach my $table ( @table ) {
1422 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1423 $dbh->quote($format);
1424 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1427 if ( $format eq 'cch' ) {
1428 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1429 $dbh->quote("$format-zip");
1430 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1436 sub _create_temporary_tables {
1437 my ( $job, $format ) = @_;
1440 my $error = $job->update_statustext( "0,Creating temporary tables" );
1441 die $error if $error;
1443 my @table = qw( tax_rate
1450 foreach my $table ( @table ) {
1452 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1453 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1459 sub _copy_from_temp {
1460 my ( $job, $format ) = @_;
1463 my $error = $job->update_statustext( "0,Making permanent" );
1464 die $error if $error;
1466 my @table = qw( tax_rate
1473 foreach my $table ( @table ) {
1475 "INSERT INTO public.$table SELECT * from $table";
1476 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1482 =item process_download_and_reload
1484 Download and process a tax update as a queued JSRPC job after wiping the
1485 existing wipable tax data.
1489 sub process_download_and_reload {
1490 _process_reload('process_download_and_update', @_);
1494 =item process_batch_reload
1496 Load and process a tax update from the provided files as a queued JSRPC job
1497 after wiping the existing wipable tax data.
1501 sub process_batch_reload {
1502 _process_reload('_perform_batch_import', @_);
1506 sub _process_reload {
1507 my ( $method, $job ) = ( shift, shift );
1509 my $param = thaw(decode_base64($_[0]));
1510 my $format = $param->{'format'}; #well... this is all cch specific
1512 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1514 if ( $job ) { # progress bar
1515 my $error = $job->update_statustext( 0 );
1516 die $error if $error;
1519 my $oldAutoCommit = $FS::UID::AutoCommit;
1520 local $FS::UID::AutoCommit = 0;
1525 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1526 "USING (taxclassnum) WHERE data_vendor = '$format'";
1527 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1529 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1530 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1531 if $sth->fetchrow_arrayref->[0];
1533 # really should get a table EXCLUSIVE lock here
1535 #remember disabled taxes
1536 my %disabled_tax_rate = ();
1537 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1539 #remember tax products
1540 my %taxproduct = ();
1541 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1544 $error ||= _create_temporary_tables( $job, $format );
1548 my $args = '$job, @_';
1549 eval "$method($args);";
1553 #restore taxproducts
1554 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1558 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1560 #wipe out the old data
1561 $error ||= _remove_old_tax_data( $job, $format );
1564 $error ||= _copy_from_temp( $job, $format );
1567 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1572 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1576 =item process_download_and_update
1578 Download and process a tax update as a queued JSRPC job
1582 sub process_download_and_update {
1585 my $param = thaw(decode_base64(shift));
1586 my $format = $param->{'format'}; #well... this is all cch specific
1588 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1590 if ( $job ) { # progress bar
1591 my $error = $job->update_statustext( 0);
1592 die $error if $error;
1595 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1596 my $dir = $cache_dir. 'taxdata';
1598 mkdir $dir or die "can't create $dir: $!\n";
1601 if ($format eq 'cch') {
1603 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1605 my $conf = new FS::Conf;
1606 die "direct download of tax data not enabled\n"
1607 unless $conf->exists('taxdatadirectdownload');
1608 my ( $urls, $username, $secret, $states ) =
1609 $conf->config('taxdatadirectdownload');
1610 die "No tax download URL provided. ".
1611 "Did you set the taxdatadirectdownload configuration value?\n"
1619 # really should get a table EXCLUSIVE lock here
1620 # check if initial import or update
1622 # relying on mkdir "$dir.new" as a mutex
1624 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1625 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1626 $sth->execute() or die $sth->errstr;
1627 my $update = $sth->fetchrow_arrayref->[0];
1629 # create cache and/or rotate old tax data
1634 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1635 foreach my $file (readdir($dirh)) {
1636 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1643 if ( -e "$dir.$_" ) {
1644 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1647 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1651 die "can't find previous tax data\n" if $update;
1655 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1657 # fetch and unpack the zip files
1659 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1661 # extract csv files from the dbf files
1663 foreach my $name ( @namelist ) {
1664 _cch_extract_csv_from_dbf( $job, $dir, $name );
1667 # generate the diff files
1670 foreach my $name ( @namelist ) {
1671 my $difffile = "$dir.new/$name.txt";
1673 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1674 die $error if $error;
1675 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1676 my $olddir = $update ? "$dir.1" : "";
1677 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1679 $difffile =~ s/^$cache_dir//;
1680 push @list, "${name}file:$difffile";
1683 # perform the import
1684 local $keep_cch_files = 1;
1685 $param->{uploaded_files} = join( ',', @list );
1686 $param->{format} .= '-update' if $update;
1688 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1690 rename "$dir.new", "$dir"
1691 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1694 die "Unknown format: $format";
1698 =item browse_queries PARAMS
1700 Returns a list consisting of a hashref suited for use as the argument
1701 to qsearch, and sql query string. Each is based on the PARAMS hashref
1702 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1703 from a form. This conveniently creates the query hashref and count_query
1704 string required by the browse and search elements. As a side effect,
1705 the PARAMS hashref is untainted and keys with unexpected values are removed.
1709 sub browse_queries {
1713 'table' => 'tax_rate',
1715 'order_by' => 'ORDER BY geocode, taxclassnum',
1720 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1721 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1723 delete $params->{data_vendor};
1726 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1727 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1728 'geocode LIKE '. dbh->quote($1.'%');
1730 delete $params->{geocode};
1733 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1734 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1737 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1738 ' taxclassnum = '. dbh->quote($1)
1740 delete $params->{taxclassnun};
1744 if ( $params->{tax_type} =~ /^(\d+)$/ );
1745 delete $params->{tax_type}
1749 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1750 delete $params->{tax_cat}
1753 my @taxclassnum = ();
1754 if ($tax_type || $tax_cat ) {
1755 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1756 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1757 @taxclassnum = map { $_->taxclassnum }
1758 qsearch({ 'table' => 'tax_class',
1760 'extra_sql' => "WHERE taxclass $compare",
1764 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1765 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1766 if ( @taxclassnum );
1768 unless ($params->{'showdisabled'}) {
1769 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1770 "( disabled = '' OR disabled IS NULL )";
1773 $query->{extra_sql} = $extra_sql;
1775 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1778 =item queue_liability_report PARAMS
1780 Launches a tax liability report.
1783 sub queue_liability_report {
1785 my $param = thaw(decode_base64(shift));
1788 $cgi->param('beginning', $param->{beginning});
1789 $cgi->param('ending', $param->{ending});
1790 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1791 my $agentnum = $param->{agentnum};
1792 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1793 generate_liability_report(
1794 'beginning' => $beginning,
1795 'ending' => $ending,
1796 'agentnum' => $agentnum,
1797 'p' => $param->{RootURL},
1802 =item generate_liability_report PARAMS
1804 Generates a tax liability report. Provide a hash including desired
1805 agentnum, beginning, and ending
1809 sub generate_liability_report {
1812 my ( $count, $last, $min_sec ) = _progressbar_foo();
1814 #let us open the temp file early
1815 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1816 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1818 UNLINK => 0, # not so temp
1819 ) or die "can't open report file: $!\n";
1821 my $conf = new FS::Conf;
1822 my $money_char = $conf->config('money_char') || '$';
1825 JOIN cust_bill USING ( invnum )
1826 LEFT JOIN cust_main USING ( custnum )
1830 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1831 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1833 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1835 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1838 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1839 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1840 die "agent not found" unless $agent;
1841 $agentname = $agent->agent;
1842 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1845 # my ( $location_sql, @location_param ) = FS::cust_pkg->location_sql;
1846 # $where .= " AND $location_sql";
1847 #my @taxparam = ( 'itemdesc', @location_param );
1848 # now something along the lines of geocode matching ?
1849 #$where .= FS::cust_pkg->_location_sql_where('cust_tax_location');;
1850 my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1852 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1854 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1855 #to FS::Report or FS::Record or who the fuck knows where)
1856 my $scalar_sql = sub {
1857 my( $r, $param, $sql ) = @_;
1858 my $sth = dbh->prepare($sql) or die dbh->errstr;
1859 $sth->execute( map $r->$_(), @$param )
1860 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1861 $sth->fetchrow_arrayref->[0] || 0;
1869 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1871 hashref => { pkgpart => 0 },
1872 addl_from => $addl_from,
1873 extra_sql => $where,
1875 $count = scalar(@tax_and_location);
1876 foreach my $t ( @tax_and_location ) {
1879 if ( time - $min_sec > $last ) {
1880 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1887 my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1888 my $label = join('~', map { $t->$_ } @params);
1889 $label = 'Tax'. $label if $label =~ /^~/;
1890 unless ( exists( $taxes{$label} ) ) {
1891 my ($baselabel, @trash) = split /~/, $label;
1893 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1894 $taxes{$label}->{'url_param'} =
1895 join(';', map { "$_=". uri_escape($t->$_) } @params);
1897 my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND payby != 'COMP' ".
1898 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1900 my $sql = "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) ".
1901 " $taxwhere AND cust_bill_pkg.pkgnum = 0";
1903 my $x = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1905 $taxes{$label}->{'tax'} += $x;
1907 my $creditfrom = " JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum) ";
1908 my $creditwhere = "FROM cust_bill_pkg $addl_from $creditfrom $where ".
1909 "AND payby != 'COMP' ".
1910 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1912 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1913 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1915 my $y = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1917 $taxes{$label}->{'credit'} += $y;
1919 unless ( exists( $taxes{$baselabel} ) ) {
1921 $basetaxes{$baselabel}->{'label'} = $baselabel;
1922 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1923 $basetaxes{$baselabel}->{'base'} = 1;
1927 $basetaxes{$baselabel}->{'tax'} += $x;
1928 $basetaxes{$baselabel}->{'credit'} += $y;
1932 # calculate customer-exemption for this tax
1933 # calculate package-exemption for this tax
1934 # calculate monthly exemption (texas tax) for this tax
1935 # count up all the cust_tax_exempt_pkg records associated with
1936 # the actual line items.
1943 $args{job}->update_statustext( "0,Sorted" );
1949 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1950 my ($base, @trash) = split '~', $tax;
1951 my $basetax = delete( $basetaxes{$base} );
1953 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1954 $taxes{$tax}->{base} = 1;
1956 push @taxes, $basetax;
1959 push @taxes, $taxes{$tax};
1966 'credit' => $credit,
1971 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1972 $dateagentlink .= ';agentnum='. $args{agentnum}
1973 if length($agentname);
1974 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1977 print $report <<EOF;
1979 <% include("/elements/header.html", "$agentname Tax Report - ".
1981 ? time2str('%h %o %Y ', $args{beginning} )
1985 ( $args{ending} == 4294967295
1987 : time2str('%h %o %Y', $args{ending} )
1992 <% include('/elements/table-grid.html') %>
1995 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1996 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1997 <TH CLASS="grid" BGCOLOR="#cccccc">Tax collected</TH>
1998 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
1999 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2000 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2004 my $bgcolor1 = '#eeeeee';
2005 my $bgcolor2 = '#ffffff';
2008 $count = scalar(@taxes);
2010 foreach my $tax ( @taxes ) {
2013 if ( time - $min_sec > $last ) {
2014 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2021 if ( $bgcolor eq $bgcolor1 ) {
2022 $bgcolor = $bgcolor2;
2024 $bgcolor = $bgcolor1;
2028 if ( $tax->{'label'} ne 'Total' ) {
2029 $link = ';'. $tax->{'url_param'};
2032 print $report <<EOF;
2034 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></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"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2039 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2040 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2041 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2042 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2043 <A HREF="<% '$baselink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2045 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2050 print $report <<EOF;
2057 my $reportname = $report->filename;
2060 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2061 $reportname =~ s/^$dropstring//;
2063 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2064 die "<a href=$reporturl>view</a>\n";
2074 Mixing automatic and manual editing works poorly at present.
2076 Tax liability calculations take too long and arguably don't belong here.
2077 Tax liability report generation not entirely safe (escaped).
2081 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base