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 );
19 use DBIx::DBSchema::Table;
20 use DBIx::DBSchema::Column;
21 use FS::Record qw( qsearch qsearchs dbh dbdef );
24 use FS::cust_bill_pkg;
25 use FS::cust_tax_location;
26 use FS::tax_rate_location;
27 use FS::part_pkg_taxrate;
28 use FS::part_pkg_taxproduct;
30 use FS::Misc qw( csv_from_fixed );
34 @ISA = qw( FS::Record );
37 $me = '[FS::tax_rate]';
42 FS::tax_rate - Object methods for tax_rate objects
48 $record = new FS::tax_rate \%hash;
49 $record = new FS::tax_rate { 'column' => 'value' };
51 $error = $record->insert;
53 $error = $new_record->replace($old_record);
55 $error = $record->delete;
57 $error = $record->check;
61 An FS::tax_rate object represents a tax rate, defined by locale.
62 FS::tax_rate inherits from FS::Record. The following fields are
69 primary key (assigned automatically for new tax rates)
73 a geographic location code provided by a tax data vendor
81 a location code provided by a tax authority
85 a foreign key into FS::tax_class - the type of tax
86 referenced but FS::part_pkg_taxrate
89 the time after which the tax applies
97 second bracket percentage
101 the amount to which the tax applies (first bracket)
105 a cap on the amount of tax if a cap exists
109 percentage on out of jurisdiction purchases
113 second bracket percentage on out of jurisdiction purchases
117 one of the values in %tax_unittypes
121 amount of tax per unit
125 second bracket amount of tax per unit
129 the number of units to which the fee applies (first bracket)
133 the most units to which fees apply (first and second brackets)
137 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
141 if defined, printed on invoices instead of "Tax"
145 a value from %tax_authorities
149 a value from %tax_basetypes indicating the tax basis
153 a value from %tax_passtypes indicating how the tax should displayed to the customer
157 'Y', 'N', or blank indicating the tax can be passed to the customer
161 if 'Y', this tax does not apply to setup fees
165 if 'Y', this tax does not apply to recurring fees
169 if 'Y', has been manually edited
179 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
183 sub table { 'tax_rate'; }
187 Adds this tax rate to the database. If there is an error, returns the error,
188 otherwise returns false.
192 Deletes this tax rate from the database. If there is an error, returns the
193 error, otherwise returns false.
195 =item replace OLD_RECORD
197 Replaces the OLD_RECORD with this one in the database. If there is an error,
198 returns the error, otherwise returns false.
202 Checks all fields to make sure this is a valid tax rate. If there is an error,
203 returns the error, otherwise returns false. Called by the insert and replace
211 foreach (qw( taxbase taxmax )) {
212 $self->$_(0) unless $self->$_;
215 $self->ut_numbern('taxnum')
216 || $self->ut_text('geocode')
217 || $self->ut_textn('data_vendor')
218 || $self->ut_textn('location')
219 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
220 || $self->ut_snumbern('effective_date')
221 || $self->ut_float('tax')
222 || $self->ut_floatn('excessrate')
223 || $self->ut_money('taxbase')
224 || $self->ut_money('taxmax')
225 || $self->ut_floatn('usetax')
226 || $self->ut_floatn('useexcessrate')
227 || $self->ut_numbern('unittype')
228 || $self->ut_floatn('fee')
229 || $self->ut_floatn('excessfee')
230 || $self->ut_floatn('feemax')
231 || $self->ut_numbern('maxtype')
232 || $self->ut_textn('taxname')
233 || $self->ut_numbern('taxauth')
234 || $self->ut_numbern('basetype')
235 || $self->ut_numbern('passtype')
236 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
237 || $self->ut_enum('setuptax', [ '', 'Y' ] )
238 || $self->ut_enum('recurtax', [ '', 'Y' ] )
239 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
240 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
241 || $self->ut_enum('manual', [ '', 'Y' ] )
242 || $self->ut_enum('disabled', [ '', 'Y' ] )
243 || $self->SUPER::check
248 =item taxclass_description
250 Returns the human understandable value associated with the related
255 sub taxclass_description {
257 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
258 $tax_class ? $tax_class->description : '';
263 Returns the human understandable value associated with the unittype column
267 %tax_unittypes = ( '0' => 'access line',
274 $tax_unittypes{$self->unittype};
279 Returns the human understandable value associated with the maxtype column
283 %tax_maxtypes = ( '0' => 'receipts per invoice',
284 '1' => 'receipts per item',
285 '2' => 'total utility charges per utility tax year',
286 '3' => 'total charges per utility tax year',
287 '4' => 'receipts per access line',
288 '9' => 'monthly receipts per location',
293 $tax_maxtypes{$self->maxtype};
298 Returns the human understandable value associated with the basetype column
302 %tax_basetypes = ( '0' => 'sale price',
303 '1' => 'gross receipts',
304 '2' => 'sales taxable telecom revenue',
305 '3' => 'minutes carried',
306 '4' => 'minutes billed',
307 '5' => 'gross operating revenue',
308 '6' => 'access line',
310 '8' => 'gross revenue',
311 '9' => 'portion gross receipts attributable to interstate service',
312 '10' => 'access line',
313 '11' => 'gross profits',
314 '12' => 'tariff rate',
316 '15' => 'prior year gross receipts',
321 $tax_basetypes{$self->basetype};
326 Returns the human understandable value associated with the taxauth column
330 %tax_authorities = ( '0' => 'federal',
335 '5' => 'county administered by state',
336 '6' => 'city administered by state',
337 '7' => 'city administered by county',
338 '8' => 'local administered by state',
339 '9' => 'local administered by county',
344 $tax_authorities{$self->taxauth};
349 Returns the human understandable value associated with the passtype column
353 %tax_passtypes = ( '0' => 'separate tax line',
354 '1' => 'separate surcharge line',
355 '2' => 'surcharge not separated',
356 '3' => 'included in base rate',
361 $tax_passtypes{$self->passtype};
364 =item taxline TAXABLES, [ OPTIONSHASH ]
366 Returns a listref of a name and an amount of tax calculated for the list
367 of packages/amounts referenced by TAXABLES. If an error occurs, a message
368 is returned as a scalar.
378 if (ref($_[0]) eq 'ARRAY') {
383 #exemptions would be broken in this case
386 my $name = $self->taxname;
387 $name = 'Other surcharges'
388 if ($self->passtype == 2);
391 if ( $self->disabled ) { # we always know how to handle disabled taxes
398 my $taxable_charged = 0;
399 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
402 warn "calculating taxes for ". $self->taxnum. " on ".
403 join (",", map { $_->pkgnum } @cust_bill_pkg)
406 if ($self->passflag eq 'N') {
407 # return "fatal: can't (yet) handle taxes not passed to the customer";
408 # until someone needs to track these in freeside
415 my $maxtype = $self->maxtype || 0;
416 if ($maxtype != 0 && $maxtype != 9) {
417 return $self->_fatal_or_null( 'tax with "'.
418 $self->maxtype_name. '" threshold'
424 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
428 # we treat gross revenue as gross receipts and expect the tax data
429 # to DTRT (i.e. tax on tax rules)
430 if ($self->basetype != 0 && $self->basetype != 1 &&
431 $self->basetype != 5 && $self->basetype != 6 &&
432 $self->basetype != 7 && $self->basetype != 8 &&
433 $self->basetype != 14
436 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
439 unless ($self->setuptax =~ /^Y$/i) {
440 $taxable_charged += $_->setup foreach @cust_bill_pkg;
442 unless ($self->recurtax =~ /^Y$/i) {
443 $taxable_charged += $_->recur foreach @cust_bill_pkg;
446 my $taxable_units = 0;
447 unless ($self->recurtax =~ /^Y$/i) {
449 if (( $self->unittype || 0 ) == 0) { #access line
451 foreach (@cust_bill_pkg) {
452 $taxable_units += $_->units
453 unless $seen{$_->pkgnum}++;
456 } elsif ($self->unittype == 1) { #minute
457 return $self->_fatal_or_null( 'fee with minute unit type' );
459 } elsif ($self->unittype == 2) { #account
461 my $conf = new FS::Conf;
462 if ( $conf->exists('tax-pkg_address') ) {
463 #number of distinct locations
465 foreach (@cust_bill_pkg) {
467 unless $seen{$_->cust_pkg->locationnum}++;
474 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
480 # XXX insert exemption handling here
482 # the tax or fee is applied to taxbase or feebase and then
483 # the excessrate or excess fee is applied to taxmax or feemax
486 $amount += $taxable_charged * $self->tax;
487 $amount += $taxable_units * $self->fee;
489 warn "calculated taxes as [ $name, $amount ]\n"
500 my ($self, $error) = @_;
502 my $conf = new FS::Conf;
504 $error = "can't yet handle ". $error;
505 my $name = $self->taxname;
506 $name = 'Other surcharges'
507 if ($self->passtype == 2);
509 if ($conf->exists('ignore_incalculable_taxes')) {
510 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
511 return { name => $name, amount => 0 };
513 return "fatal: $error";
517 =item tax_on_tax CUST_MAIN
519 Returns a list of taxes which are candidates for taxing taxes for the
520 given customer (see L<FS::cust_main>)
528 my $cust_main = shift;
530 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
534 my $geocode = $cust_main->geocode($self->data_vendor);
538 my $extra_sql = ' AND ('.
539 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
544 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
545 my $select = 'DISTINCT ON(taxclassnum) *';
547 # should qsearch preface columns with the table to facilitate joins?
548 my @taxclassnums = map { $_->taxclassnum }
549 qsearch( { 'table' => 'part_pkg_taxrate',
551 'hashref' => { 'data_vendor' => $self->data_vendor,
552 'taxclassnumtaxed' => $self->taxclassnum,
554 'extra_sql' => $extra_sql,
555 'order_by' => $order_by,
558 return () unless @taxclassnums;
561 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
563 qsearch({ 'table' => 'tax_rate',
564 'hashref' => { 'geocode' => $geocode, },
565 'extra_sql' => $extra_sql,
570 =item tax_rate_location
572 Returns an object representing the location associated with this tax
573 (see L<FS::tax_rate_location>)
577 sub tax_rate_location {
580 qsearchs({ 'table' => 'tax_rate_location',
581 'hashref' => { 'data_vendor' => $self->data_vendor,
582 'geocode' => $self->geocode,
586 new FS::tax_rate_location;
600 sub _progressbar_foo {
605 my ($param, $job) = @_;
607 my $fh = $param->{filehandle};
608 my $format = $param->{'format'};
616 my @column_lengths = ();
617 my @column_callbacks = ();
618 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
619 $format =~ s/-fixed//;
620 my $date_format = sub { my $r='';
621 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
624 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
625 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 );
626 push @column_lengths, 1 if $format eq 'cch-update';
627 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
628 $column_callbacks[8] = $date_format;
632 my ( $count, $last, $min_sec ) = _progressbar_foo();
633 if ( $job || scalar(@column_callbacks) ) {
635 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
636 return $error if $error;
640 if ( $format eq 'cch' || $format eq 'cch-update' ) {
641 #false laziness w/below (sub _perform_cch_diff)
642 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
643 excessrate effective_date taxauth taxtype taxcat taxname
644 usetax useexcessrate fee unittype feemax maxtype passflag
646 push @fields, 'actionflag' if $format eq 'cch-update';
651 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
652 $hash->{'data_vendor'} ='cch';
653 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
654 time_zone => 'floating',
656 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
657 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
659 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
660 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
663 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
665 my %tax_class = ( 'data_vendor' => 'cch',
666 'taxclass' => $taxclassid,
669 my $tax_class = qsearchs( 'tax_class', \%tax_class );
670 return "Error updating tax rate: no tax class $taxclassid"
673 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
675 foreach (qw( taxtype taxcat )) {
679 my %passflagmap = ( '0' => '',
683 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
684 if exists $passflagmap{$hash->{'passflag'}};
686 foreach (keys %$hash) {
687 $hash->{$_} = substr($hash->{$_}, 0, 80)
688 if length($hash->{$_}) > 80;
691 my $actionflag = delete($hash->{'actionflag'});
693 $hash->{'taxname'} =~ s/`/'/g;
694 $hash->{'taxname'} =~ s|\\|/|g;
696 return '' if $format eq 'cch'; # but not cch-update
698 if ($actionflag eq 'I') {
699 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
700 }elsif ($actionflag eq 'D') {
701 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
703 return "Unexpected action flag: ". $hash->{'actionflag'};
706 delete($hash->{$_}) for keys %$hash;
712 } elsif ( $format eq 'extended' ) {
713 die "unimplemented\n";
717 die "unknown format $format";
720 my $csv = new Text::CSV_XS;
724 local $SIG{HUP} = 'IGNORE';
725 local $SIG{INT} = 'IGNORE';
726 local $SIG{QUIT} = 'IGNORE';
727 local $SIG{TERM} = 'IGNORE';
728 local $SIG{TSTP} = 'IGNORE';
729 local $SIG{PIPE} = 'IGNORE';
731 my $oldAutoCommit = $FS::UID::AutoCommit;
732 local $FS::UID::AutoCommit = 0;
735 while ( defined($line=<$fh>) ) {
736 $csv->parse($line) or do {
737 $dbh->rollback if $oldAutoCommit;
738 return "can't parse: ". $csv->error_input();
741 if ( $job ) { # progress bar
742 if ( time - $min_sec > $last ) {
743 my $error = $job->update_statustext(
744 int( 100 * $imported / $count ). ",Importing tax rates"
747 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
754 my @columns = $csv->fields();
756 my %tax_rate = ( 'data_vendor' => $format );
757 foreach my $field ( @fields ) {
758 $tax_rate{$field} = shift @columns;
761 if ( scalar( @columns ) ) {
762 $dbh->rollback if $oldAutoCommit;
763 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $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 my @replace = grep { exists($delete{$_}) } keys %insert;
790 if ( $job ) { # progress bar
791 if ( time - $min_sec > $last ) {
792 my $error = $job->update_statustext(
793 int( 100 * $imported / $count ). ",Importing tax rates"
796 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
803 my $old = qsearchs( 'tax_rate', $delete{$_} );
807 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
808 $new->taxnum($old->taxnum);
809 my $error = $new->replace($old);
812 $dbh->rollback if $oldAutoCommit;
813 my $hashref = $insert{$_};
814 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
815 return "can't replace tax_rate for $line: $error";
822 $old = delete $delete{$_};
823 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
824 #join(" ", map { "$_ => ". $old->{$_} } @fields);
825 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
831 for (grep { !exists($delete{$_}) } keys %insert) {
832 if ( $job ) { # progress bar
833 if ( time - $min_sec > $last ) {
834 my $error = $job->update_statustext(
835 int( 100 * $imported / $count ). ",Importing tax rates"
838 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
845 my $tax_rate = new FS::tax_rate( $insert{$_} );
846 my $error = $tax_rate->insert;
849 $dbh->rollback if $oldAutoCommit;
850 my $hashref = $insert{$_};
851 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
852 return "can't insert tax_rate for $line: $error";
858 for (grep { !exists($insert{$_}) } keys %delete) {
859 if ( $job ) { # progress bar
860 if ( time - $min_sec > $last ) {
861 my $error = $job->update_statustext(
862 int( 100 * $imported / $count ). ",Importing tax rates"
865 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
872 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
874 $dbh->rollback if $oldAutoCommit;
875 $tax_rate = $delete{$_};
876 return "can't find tax_rate to delete for: ".
877 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
878 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
880 my $error = $tax_rate->delete;
883 $dbh->rollback if $oldAutoCommit;
884 my $hashref = $delete{$_};
885 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
886 return "can't delete tax_rate for $line: $error";
892 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
894 return "Empty file!" unless ($imported || $format eq 'cch-update');
900 =item process_batch_import
902 Load a batch import as a queued JSRPC job
906 sub process_batch_import {
909 my $oldAutoCommit = $FS::UID::AutoCommit;
910 local $FS::UID::AutoCommit = 0;
913 my $param = thaw(decode_base64(shift));
914 my $args = '$job, encode_base64( nfreeze( $param ) )';
916 my $method = '_perform_batch_import';
917 if ( $param->{reload} ) {
918 $method = 'process_batch_reload';
921 eval "$method($args);";
923 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
928 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
931 sub _perform_batch_import {
934 my $param = thaw(decode_base64(shift));
935 my $format = $param->{'format'}; #well... this is all cch specific
937 my $files = $param->{'uploaded_files'}
938 or die "No files provided.";
940 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
943 if ( $format eq 'cch' || $format eq 'cch-fixed'
944 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
947 my $oldAutoCommit = $FS::UID::AutoCommit;
948 local $FS::UID::AutoCommit = 0;
951 my @insert_list = ();
952 my @delete_list = ();
953 my @predelete_list = ();
956 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
958 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
959 'CODE', \&FS::tax_class::batch_import,
960 'PLUS4', \&FS::cust_tax_location::batch_import,
961 'ZIP', \&FS::cust_tax_location::batch_import,
962 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
963 'DETAIL', \&FS::tax_rate::batch_import,
965 while( scalar(@list) ) {
966 my ( $name, $import_sub ) = splice( @list, 0, 2 );
967 my $file = lc($name). 'file';
969 unless ($files{$file}) {
970 $error = "No $name supplied";
973 next if $name eq 'DETAIL' && $format =~ /update/;
975 my $filename = "$dir/". $files{$file};
977 if ( $format =~ /update/ ) {
979 ( $error, $insertname, $deletename ) =
980 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
984 unlink $filename or warn "Can't delete $filename: $!"
985 unless $keep_cch_files;
986 push @insert_list, $name, $insertname, $import_sub, $format;
987 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
988 unshift @predelete_list, $name, $deletename, $import_sub, $format;
990 unshift @delete_list, $name, $deletename, $import_sub, $format;
995 push @insert_list, $name, $filename, $import_sub, $format;
1002 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1003 if $format =~ /update/;
1005 $error ||= _perform_cch_tax_import( $job,
1006 [ @predelete_list ],
1012 @list = ( @predelete_list, @insert_list, @delete_list );
1013 while( !$keep_cch_files && scalar(@list) ) {
1014 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1015 unlink $file or warn "Can't delete $file: $!";
1019 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1022 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1026 die "Unknown format: $format";
1032 sub _perform_cch_tax_import {
1033 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1036 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1037 while( scalar(@$list) ) {
1038 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1039 my $fmt = "$format-update";
1040 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1041 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1042 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1050 sub _perform_cch_insert_delete_split {
1051 my ($name, $filename, $dir, $format) = @_;
1055 open my $fh, "< $filename"
1056 or $error ||= "Can't open $name file $filename: $!";
1058 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1061 ) or die "can't open temp file: $!\n";
1062 my $insertname = $ifh->filename;
1064 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1067 ) or die "can't open temp file: $!\n";
1068 my $deletename = $dfh->filename;
1070 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1071 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1074 $handle = $ifh if $_ =~ /$insert_pattern/;
1075 $handle = $dfh if $_ =~ /$delete_pattern/;
1077 $error = "bad input line: $_" unless $handle;
1086 return ($error, $insertname, $deletename);
1089 sub _perform_cch_diff {
1090 my ($name, $newdir, $olddir) = @_;
1095 open my $oldcsvfh, "$olddir/$name.txt"
1096 or die "failed to open $olddir/$name.txt: $!\n";
1098 while(<$oldcsvfh>) {
1105 open my $newcsvfh, "$newdir/$name.txt"
1106 or die "failed to open $newdir/$name.txt: $!\n";
1108 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1111 ) or die "can't open temp file: $!\n";
1112 my $diffname = $dfh->filename;
1114 while(<$newcsvfh>) {
1116 if (exists($oldlines{$_})) {
1119 print $dfh $_, ',"I"', "\n";
1124 #false laziness w/above (sub batch_import)
1125 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1126 excessrate effective_date taxauth taxtype taxcat taxname
1127 usetax useexcessrate fee unittype feemax maxtype passflag
1128 passtype basetype );
1129 my $numfields = scalar(@fields);
1131 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1133 for my $line (grep $oldlines{$_}, keys %oldlines) {
1135 $csv->parse($line) or do {
1136 #$dbh->rollback if $oldAutoCommit;
1137 die "can't parse: ". $csv->error_input();
1139 my @columns = $csv->fields();
1141 $csv->combine( splice(@columns, 0, $numfields) );
1143 print $dfh $csv->string, ',"D"', "\n";
1151 sub _cch_fetch_and_unzip {
1152 my ( $job, $urls, $secret, $dir ) = @_;
1154 my $ua = new LWP::UserAgent;
1155 foreach my $url (split ',', $urls) {
1156 my @name = split '/', $url; #somewhat restrictive
1157 my $name = pop @name;
1158 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1161 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1163 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1164 my $res = $ua->request(
1165 new HTTP::Request( GET => $url ),
1167 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1168 my $content_length = $_[1]->content_length;
1169 $imported += length($_[0]);
1170 if ( time - $min_sec > $last ) {
1171 my $error = $job->update_statustext(
1172 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1173 ",Downloading data from CCH"
1175 die $error if $error;
1180 die "download of $url failed: ". $res->status_line
1181 unless $res->is_success;
1184 my $error = $job->update_statustext( "0,Unpacking data" );
1185 die $error if $error;
1186 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1188 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1189 or die "unzip -P $secret -d $dir $dir/$name failed";
1190 #unlink "$dir/$name";
1194 sub _cch_extract_csv_from_dbf {
1195 my ( $job, $dir, $name ) = @_;
1200 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1201 my $error = $job->update_statustext( "0,Unpacking $name" );
1202 die $error if $error;
1203 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1204 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1205 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1206 unless defined($table);
1207 my $count = $table->last_record; # approximately;
1208 open my $csvfh, ">$dir.new/$name.txt"
1209 or die "failed to open $dir.new/$name.txt: $!\n";
1211 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1212 my @fields = $table->field_names;
1213 my $cursor = $table->prepare_select;
1215 sub { my $date = shift;
1216 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1219 while (my $row = $cursor->fetch_hashref) {
1220 $csv->combine( map { my $type = $table->field_type($_);
1222 &{$format_date}($row->{$_}) ;
1223 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1224 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1231 print $csvfh $csv->string, "\n";
1233 if ( time - $min_sec > $last ) {
1234 my $error = $job->update_statustext(
1235 int(100 * $imported/$count). ",Unpacking $name"
1237 die $error if $error;
1245 sub _remember_disabled_taxes {
1246 my ( $job, $format, $disabled_tax_rate ) = @_;
1250 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1252 my @items = qsearch( { table => 'tax_rate',
1253 hashref => { disabled => 'Y',
1254 data_vendor => $format,
1256 select => 'geocode, taxclassnum',
1259 my $count = scalar(@items);
1260 foreach my $tax_rate ( @items ) {
1261 if ( time - $min_sec > $last ) {
1262 $job->update_statustext(
1263 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1269 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1270 unless ( $tax_class ) {
1271 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1274 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1278 sub _remember_tax_products {
1279 my ( $job, $format, $taxproduct ) = @_;
1281 # XXX FIXME this loop only works when cch is the only data provider
1283 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1285 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1286 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1287 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1288 " optionname LIKE 'usage_taxproductnum_%' AND ".
1289 " optionvalue != '' )";
1290 my @items = qsearch( { table => 'part_pkg',
1291 select => 'DISTINCT pkgpart,taxproductnum',
1293 extra_sql => $extra_sql,
1296 my $count = scalar(@items);
1297 foreach my $part_pkg ( @items ) {
1298 if ( time - $min_sec > $last ) {
1299 $job->update_statustext(
1300 int( 100 * $imported / $count ). ",Remembering tax products"
1305 warn "working with package part ". $part_pkg->pkgpart.
1306 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1307 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1308 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1309 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1311 foreach my $option ( $part_pkg->part_pkg_option ) {
1312 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1315 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1316 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1317 $part_pkg_taxproduct->taxproduct
1318 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1323 sub _restore_remembered_tax_products {
1324 my ( $job, $format, $taxproduct ) = @_;
1328 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1329 my $count = scalar(keys %$taxproduct);
1330 foreach my $pkgpart ( keys %$taxproduct ) {
1331 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1332 if ( time - $min_sec > $last ) {
1333 $job->update_statustext(
1334 int( 100 * $imported / $count ). ",Restoring tax products"
1340 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1341 unless ( $part_pkg ) {
1342 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1345 my %options = $part_pkg->options;
1346 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1347 my $primary_svc = $part_pkg->svcpart;
1348 my $new = new FS::part_pkg { $part_pkg->hash };
1350 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1351 warn "working with class '$class'\n" if $DEBUG;
1352 my $part_pkg_taxproduct =
1353 qsearchs( 'part_pkg_taxproduct',
1354 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1355 data_vendor => $format,
1359 unless ( $part_pkg_taxproduct ) {
1360 return "failed to find part_pkg_taxproduct (".
1361 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1364 if ( $class eq '' ) {
1365 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1369 $options{"usage_taxproductnum_$class"} =
1370 $part_pkg_taxproduct->taxproductnum;
1374 my $error = $new->replace( $part_pkg,
1375 'pkg_svc' => \%pkg_svc,
1376 'primary_svc' => $primary_svc,
1377 'options' => \%options,
1380 return $error if $error;
1387 sub _restore_remembered_disabled_taxes {
1388 my ( $job, $format, $disabled_tax_rate ) = @_;
1390 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1391 my $count = scalar(keys %$disabled_tax_rate);
1392 foreach my $key (keys %$disabled_tax_rate) {
1393 if ( time - $min_sec > $last ) {
1394 $job->update_statustext(
1395 int( 100 * $imported / $count ). ",Disabling tax rates"
1400 my ($geocode,$taxclass) = split /:/, $key, 2;
1401 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1402 taxclass => $taxclass,
1404 return "found multiple tax_class records for format $format class $taxclass"
1405 if scalar(@tax_class) > 1;
1407 unless (scalar(@tax_class)) {
1408 warn "no tax_class for format $format class $taxclass\n";
1413 qsearch('tax_rate', { data_vendor => $format,
1414 geocode => $geocode,
1415 taxclassnum => $tax_class[0]->taxclassnum,
1419 if (scalar(@tax_rate) > 1) {
1420 return "found multiple tax_rate records for format $format geocode ".
1421 "$geocode and taxclass $taxclass ( taxclassnum ".
1422 $tax_class[0]->taxclassnum. " )";
1425 if (scalar(@tax_rate)) {
1426 $tax_rate[0]->disabled('Y');
1427 my $error = $tax_rate[0]->replace;
1428 return $error if $error;
1433 sub _remove_old_tax_data {
1434 my ( $job, $format ) = @_;
1437 my $error = $job->update_statustext( "0,Removing old tax data" );
1438 die $error if $error;
1440 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1441 "WHERE data_vendor = ". $dbh->quote($format);
1442 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1445 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1447 foreach my $table ( @table ) {
1448 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1449 $dbh->quote($format);
1450 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1453 if ( $format eq 'cch' ) {
1454 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1455 $dbh->quote("$format-zip");
1456 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1462 sub _create_temporary_tables {
1463 my ( $job, $format ) = @_;
1466 my $error = $job->update_statustext( "0,Creating temporary tables" );
1467 die $error if $error;
1469 my @table = qw( tax_rate
1476 foreach my $table ( @table ) {
1478 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1479 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1485 sub _copy_from_temp {
1486 my ( $job, $format ) = @_;
1489 my $error = $job->update_statustext( "0,Making permanent" );
1490 die $error if $error;
1492 my @table = qw( tax_rate
1499 foreach my $table ( @table ) {
1501 "INSERT INTO public.$table SELECT * from $table";
1502 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1508 =item process_download_and_reload
1510 Download and process a tax update as a queued JSRPC job after wiping the
1511 existing wipable tax data.
1515 sub process_download_and_reload {
1516 _process_reload('process_download_and_update', @_);
1520 =item process_batch_reload
1522 Load and process a tax update from the provided files as a queued JSRPC job
1523 after wiping the existing wipable tax data.
1527 sub process_batch_reload {
1528 _process_reload('_perform_batch_import', @_);
1532 sub _process_reload {
1533 my ( $method, $job ) = ( shift, shift );
1535 my $param = thaw(decode_base64($_[0]));
1536 my $format = $param->{'format'}; #well... this is all cch specific
1538 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1540 if ( $job ) { # progress bar
1541 my $error = $job->update_statustext( 0 );
1542 die $error if $error;
1545 my $oldAutoCommit = $FS::UID::AutoCommit;
1546 local $FS::UID::AutoCommit = 0;
1551 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1552 "USING (taxclassnum) WHERE data_vendor = '$format'";
1553 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1555 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1556 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1557 if $sth->fetchrow_arrayref->[0];
1559 # really should get a table EXCLUSIVE lock here
1561 #remember disabled taxes
1562 my %disabled_tax_rate = ();
1563 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1565 #remember tax products
1566 my %taxproduct = ();
1567 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1570 $error ||= _create_temporary_tables( $job, $format );
1574 my $args = '$job, @_';
1575 eval "$method($args);";
1579 #restore taxproducts
1580 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1584 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1586 #wipe out the old data
1587 $error ||= _remove_old_tax_data( $job, $format );
1590 $error ||= _copy_from_temp( $job, $format );
1593 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1598 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1602 =item process_download_and_update
1604 Download and process a tax update as a queued JSRPC job
1608 sub process_download_and_update {
1611 my $param = thaw(decode_base64(shift));
1612 my $format = $param->{'format'}; #well... this is all cch specific
1614 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1616 if ( $job ) { # progress bar
1617 my $error = $job->update_statustext( 0);
1618 die $error if $error;
1621 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1622 my $dir = $cache_dir. 'taxdata';
1624 mkdir $dir or die "can't create $dir: $!\n";
1627 if ($format eq 'cch') {
1629 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1631 my $conf = new FS::Conf;
1632 die "direct download of tax data not enabled\n"
1633 unless $conf->exists('taxdatadirectdownload');
1634 my ( $urls, $username, $secret, $states ) =
1635 $conf->config('taxdatadirectdownload');
1636 die "No tax download URL provided. ".
1637 "Did you set the taxdatadirectdownload configuration value?\n"
1645 # really should get a table EXCLUSIVE lock here
1646 # check if initial import or update
1648 # relying on mkdir "$dir.new" as a mutex
1650 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1651 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1652 $sth->execute() or die $sth->errstr;
1653 my $update = $sth->fetchrow_arrayref->[0];
1655 # create cache and/or rotate old tax data
1660 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1661 foreach my $file (readdir($dirh)) {
1662 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1668 for (8, 7, 6, 5, 4, 3, 2, 1) {
1669 if ( -e "$dir.$_" ) {
1670 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1673 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1677 die "can't find previous tax data\n" if $update;
1681 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1683 # fetch and unpack the zip files
1685 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1687 # extract csv files from the dbf files
1689 foreach my $name ( @namelist ) {
1690 _cch_extract_csv_from_dbf( $job, $dir, $name );
1693 # generate the diff files
1696 foreach my $name ( @namelist ) {
1697 my $difffile = "$dir.new/$name.txt";
1699 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1700 die $error if $error;
1701 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1702 my $olddir = $update ? "$dir.1" : "";
1703 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1705 $difffile =~ s/^$cache_dir//;
1706 push @list, "${name}file:$difffile";
1709 # perform the import
1710 local $keep_cch_files = 1;
1711 $param->{uploaded_files} = join( ',', @list );
1712 $param->{format} .= '-update' if $update;
1714 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1716 rename "$dir.new", "$dir"
1717 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1720 die "Unknown format: $format";
1724 =item browse_queries PARAMS
1726 Returns a list consisting of a hashref suited for use as the argument
1727 to qsearch, and sql query string. Each is based on the PARAMS hashref
1728 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1729 from a form. This conveniently creates the query hashref and count_query
1730 string required by the browse and search elements. As a side effect,
1731 the PARAMS hashref is untainted and keys with unexpected values are removed.
1735 sub browse_queries {
1739 'table' => 'tax_rate',
1741 'order_by' => 'ORDER BY geocode, taxclassnum',
1746 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1747 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1749 delete $params->{data_vendor};
1752 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1753 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1754 'geocode LIKE '. dbh->quote($1.'%');
1756 delete $params->{geocode};
1759 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1760 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1763 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1764 ' taxclassnum = '. dbh->quote($1)
1766 delete $params->{taxclassnun};
1770 if ( $params->{tax_type} =~ /^(\d+)$/ );
1771 delete $params->{tax_type}
1775 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1776 delete $params->{tax_cat}
1779 my @taxclassnum = ();
1780 if ($tax_type || $tax_cat ) {
1781 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1782 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1783 @taxclassnum = map { $_->taxclassnum }
1784 qsearch({ 'table' => 'tax_class',
1786 'extra_sql' => "WHERE taxclass $compare",
1790 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1791 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1792 if ( @taxclassnum );
1794 unless ($params->{'showdisabled'}) {
1795 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1796 "( disabled = '' OR disabled IS NULL )";
1799 $query->{extra_sql} = $extra_sql;
1801 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1804 =item queue_liability_report PARAMS
1806 Launches a tax liability report.
1809 sub queue_liability_report {
1811 my $param = thaw(decode_base64(shift));
1814 $cgi->param('beginning', $param->{beginning});
1815 $cgi->param('ending', $param->{ending});
1816 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1817 my $agentnum = $param->{agentnum};
1818 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1819 generate_liability_report(
1820 'beginning' => $beginning,
1821 'ending' => $ending,
1822 'agentnum' => $agentnum,
1823 'p' => $param->{RootURL},
1828 =item generate_liability_report PARAMS
1830 Generates a tax liability report. Provide a hash including desired
1831 agentnum, beginning, and ending
1835 #shit, all sorts of false laxiness w/report_newtax.cgi
1836 sub generate_liability_report {
1839 my ( $count, $last, $min_sec ) = _progressbar_foo();
1841 #let us open the temp file early
1842 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1843 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1845 UNLINK => 0, # not so temp
1846 ) or die "can't open report file: $!\n";
1848 my $conf = new FS::Conf;
1849 my $money_char = $conf->config('money_char') || '$';
1852 JOIN cust_bill USING ( invnum )
1853 LEFT JOIN cust_main USING ( custnum )
1857 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1858 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1860 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1862 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1865 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1866 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1867 die "agent not found" unless $agent;
1868 $agentname = $agent->agent;
1869 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1872 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1873 my @taxparams = qw( city county state locationtaxid );
1874 my @params = ('itemdesc', @taxparams);
1876 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1878 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1879 #to FS::Report or FS::Record or who the fuck knows where)
1880 my $scalar_sql = sub {
1881 my( $r, $param, $sql ) = @_;
1882 my $sth = dbh->prepare($sql) or die dbh->errstr;
1883 $sth->execute( map $r->$_(), @$param )
1884 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1885 $sth->fetchrow_arrayref->[0] || 0;
1893 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1895 hashref => { pkgpart => 0 },
1896 addl_from => $addl_from,
1897 extra_sql => $where,
1899 $count = scalar(@tax_and_location);
1900 foreach my $t ( @tax_and_location ) {
1903 if ( time - $min_sec > $last ) {
1904 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1911 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1912 my $label = join('~', map { $t->$_ } @params);
1913 $label = 'Tax'. $label if $label =~ /^~/;
1914 unless ( exists( $taxes{$label} ) ) {
1915 my ($baselabel, @trash) = split /~/, $label;
1917 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1918 $taxes{$label}->{'url_param'} =
1919 join(';', map { "$_=". uri_escape($t->$_) } @params);
1921 my $payby_itemdesc_loc =
1922 " payby != 'COMP' ".
1923 "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1924 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1929 "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1931 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1933 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1935 $taxes{$label}->{'tax'} += $x;
1938 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1940 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1942 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1943 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1945 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1947 $taxes{$label}->{'credit'} += $y;
1949 unless ( exists( $taxes{$baselabel} ) ) {
1951 $basetaxes{$baselabel}->{'label'} = $baselabel;
1952 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1953 $basetaxes{$baselabel}->{'base'} = 1;
1957 $basetaxes{$baselabel}->{'tax'} += $x;
1958 $basetaxes{$baselabel}->{'credit'} += $y;
1962 # calculate customer-exemption for this tax
1963 # calculate package-exemption for this tax
1964 # calculate monthly exemption (texas tax) for this tax
1965 # count up all the cust_tax_exempt_pkg records associated with
1966 # the actual line items.
1973 $args{job}->update_statustext( "0,Sorted" );
1979 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1980 my ($base, @trash) = split '~', $tax;
1981 my $basetax = delete( $basetaxes{$base} );
1983 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1984 $taxes{$tax}->{base} = 1;
1986 push @taxes, $basetax;
1989 push @taxes, $taxes{$tax};
1996 'credit' => $credit,
2001 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2002 $dateagentlink .= ';agentnum='. $args{agentnum}
2003 if length($agentname);
2004 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
2005 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2007 print $report <<EOF;
2009 <% include("/elements/header.html", "$agentname Tax Report - ".
2011 ? time2str('%h %o %Y ', $args{beginning} )
2015 ( $args{ending} == 4294967295
2017 : time2str('%h %o %Y', $args{ending} )
2022 <% include('/elements/table-grid.html') %>
2025 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2026 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2027 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2028 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2029 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2030 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2034 my $bgcolor1 = '#eeeeee';
2035 my $bgcolor2 = '#ffffff';
2038 $count = scalar(@taxes);
2040 foreach my $tax ( @taxes ) {
2043 if ( time - $min_sec > $last ) {
2044 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2051 if ( $bgcolor eq $bgcolor1 ) {
2052 $bgcolor = $bgcolor2;
2054 $bgcolor = $bgcolor1;
2058 if ( $tax->{'label'} ne 'Total' ) {
2059 $link = ';'. $tax->{'url_param'};
2062 print $report <<EOF;
2064 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2065 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2066 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2067 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2069 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2070 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2071 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2072 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2073 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2075 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2080 print $report <<EOF;
2087 my $reportname = $report->filename;
2090 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2091 $reportname =~ s/^$dropstring//;
2093 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2094 die "<a href=$reporturl>view</a>\n";
2104 Mixing automatic and manual editing works poorly at present.
2106 Tax liability calculations take too long and arguably don't belong here.
2107 Tax liability report generation not entirely safe (escaped).
2111 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base