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 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{detailfile}, \&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 #false laziness w/above (sub batch_import)
1119 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1120 excessrate effective_date taxauth taxtype taxcat taxname
1121 usetax useexcessrate fee unittype feemax maxtype passflag
1122 passtype basetype );
1123 my $numfields = scalar(@fields);
1125 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1127 for my $line (grep $oldlines{$_}, keys %oldlines) {
1129 $csv->parse($line) or do {
1130 #$dbh->rollback if $oldAutoCommit;
1131 die "can't parse: ". $csv->error_input();
1133 my @columns = $csv->fields();
1135 $csv->combine( splice(@columns, 0, $numfields) );
1137 print $dfh $csv->string, ',"D"', "\n";
1145 sub _cch_fetch_and_unzip {
1146 my ( $job, $urls, $secret, $dir ) = @_;
1148 my $ua = new LWP::UserAgent;
1149 foreach my $url (split ',', $urls) {
1150 my @name = split '/', $url; #somewhat restrictive
1151 my $name = pop @name;
1152 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1155 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1157 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1158 my $res = $ua->request(
1159 new HTTP::Request( GET => $url ),
1161 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1162 my $content_length = $_[1]->content_length;
1163 $imported += length($_[0]);
1164 if ( time - $min_sec > $last ) {
1165 my $error = $job->update_statustext(
1166 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1167 ",Downloading data from CCH"
1169 die $error if $error;
1174 die "download of $url failed: ". $res->status_line
1175 unless $res->is_success;
1178 my $error = $job->update_statustext( "0,Unpacking data" );
1179 die $error if $error;
1180 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1182 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1183 or die "unzip -P $secret -d $dir $dir/$name failed";
1184 #unlink "$dir/$name";
1188 sub _cch_extract_csv_from_dbf {
1189 my ( $job, $dir, $name ) = @_;
1194 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1195 my $error = $job->update_statustext( "0,Unpacking $name" );
1196 die $error if $error;
1197 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1198 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1199 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1200 unless defined($table);
1201 my $count = $table->last_record; # approximately;
1202 open my $csvfh, ">$dir.new/$name.txt"
1203 or die "failed to open $dir.new/$name.txt: $!\n";
1205 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1206 my @fields = $table->field_names;
1207 my $cursor = $table->prepare_select;
1209 sub { my $date = shift;
1210 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1213 while (my $row = $cursor->fetch_hashref) {
1214 $csv->combine( map { my $type = $table->field_type($_);
1216 &{$format_date}($row->{$_}) ;
1217 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1218 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1225 print $csvfh $csv->string, "\n";
1227 if ( time - $min_sec > $last ) {
1228 my $error = $job->update_statustext(
1229 int(100 * $imported/$count). ",Unpacking $name"
1231 die $error if $error;
1239 sub _remember_disabled_taxes {
1240 my ( $job, $format, $disabled_tax_rate ) = @_;
1244 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1246 my @items = qsearch( { table => 'tax_rate',
1247 hashref => { disabled => 'Y',
1248 data_vendor => $format,
1250 select => 'geocode, taxclassnum',
1253 my $count = scalar(@items);
1254 foreach my $tax_rate ( @items ) {
1255 if ( time - $min_sec > $last ) {
1256 $job->update_statustext(
1257 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1263 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1264 unless ( $tax_class ) {
1265 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1268 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1272 sub _remember_tax_products {
1273 my ( $job, $format, $taxproduct ) = @_;
1275 # XXX FIXME this loop only works when cch is the only data provider
1277 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1279 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1280 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1281 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1282 " optionname LIKE 'usage_taxproductnum_%' AND ".
1283 " optionvalue != '' )";
1284 my @items = qsearch( { table => 'part_pkg',
1285 select => 'DISTINCT pkgpart,taxproductnum',
1287 extra_sql => $extra_sql,
1290 my $count = scalar(@items);
1291 foreach my $part_pkg ( @items ) {
1292 if ( time - $min_sec > $last ) {
1293 $job->update_statustext(
1294 int( 100 * $imported / $count ). ",Remembering tax products"
1299 warn "working with package part ". $part_pkg->pkgpart.
1300 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1301 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1302 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1303 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1305 foreach my $option ( $part_pkg->part_pkg_option ) {
1306 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1309 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1310 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1311 $part_pkg_taxproduct->taxproduct
1312 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1317 sub _restore_remembered_tax_products {
1318 my ( $job, $format, $taxproduct ) = @_;
1322 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1323 my $count = scalar(keys %$taxproduct);
1324 foreach my $pkgpart ( keys %$taxproduct ) {
1325 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1326 if ( time - $min_sec > $last ) {
1327 $job->update_statustext(
1328 int( 100 * $imported / $count ). ",Restoring tax products"
1334 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1335 unless ( $part_pkg ) {
1336 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1339 my %options = $part_pkg->options;
1340 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1341 my $primary_svc = $part_pkg->svcpart;
1342 my $new = new FS::part_pkg { $part_pkg->hash };
1344 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1345 warn "working with class '$class'\n" if $DEBUG;
1346 my $part_pkg_taxproduct =
1347 qsearchs( 'part_pkg_taxproduct',
1348 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1349 data_vendor => $format,
1353 unless ( $part_pkg_taxproduct ) {
1354 return "failed to find part_pkg_taxproduct (".
1355 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1358 if ( $class eq '' ) {
1359 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1363 $options{"usage_taxproductnum_$class"} =
1364 $part_pkg_taxproduct->taxproductnum;
1368 my $error = $new->replace( $part_pkg,
1369 'pkg_svc' => \%pkg_svc,
1370 'primary_svc' => $primary_svc,
1371 'options' => \%options,
1374 return $error if $error;
1381 sub _restore_remembered_disabled_taxes {
1382 my ( $job, $format, $disabled_tax_rate ) = @_;
1384 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1385 my $count = scalar(keys %$disabled_tax_rate);
1386 foreach my $key (keys %$disabled_tax_rate) {
1387 if ( time - $min_sec > $last ) {
1388 $job->update_statustext(
1389 int( 100 * $imported / $count ). ",Disabling tax rates"
1394 my ($geocode,$taxclass) = split /:/, $key, 2;
1395 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1396 taxclass => $taxclass,
1398 return "found multiple tax_class records for format $format class $taxclass"
1399 if scalar(@tax_class) > 1;
1401 unless (scalar(@tax_class)) {
1402 warn "no tax_class for format $format class $taxclass\n";
1407 qsearch('tax_rate', { data_vendor => $format,
1408 geocode => $geocode,
1409 taxclassnum => $tax_class[0]->taxclassnum,
1413 if (scalar(@tax_rate) > 1) {
1414 return "found multiple tax_rate records for format $format geocode ".
1415 "$geocode and taxclass $taxclass ( taxclassnum ".
1416 $tax_class[0]->taxclassnum. " )";
1419 if (scalar(@tax_rate)) {
1420 $tax_rate[0]->disabled('Y');
1421 my $error = $tax_rate[0]->replace;
1422 return $error if $error;
1427 sub _remove_old_tax_data {
1428 my ( $job, $format ) = @_;
1431 my $error = $job->update_statustext( "0,Removing old tax data" );
1432 die $error if $error;
1434 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1435 "WHERE data_vendor = ". $dbh->quote($format);
1436 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1439 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1441 foreach my $table ( @table ) {
1442 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1443 $dbh->quote($format);
1444 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1447 if ( $format eq 'cch' ) {
1448 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1449 $dbh->quote("$format-zip");
1450 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1456 sub _create_temporary_tables {
1457 my ( $job, $format ) = @_;
1460 my $error = $job->update_statustext( "0,Creating temporary tables" );
1461 die $error if $error;
1463 my @table = qw( tax_rate
1470 foreach my $table ( @table ) {
1472 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1473 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1479 sub _copy_from_temp {
1480 my ( $job, $format ) = @_;
1483 my $error = $job->update_statustext( "0,Making permanent" );
1484 die $error if $error;
1486 my @table = qw( tax_rate
1493 foreach my $table ( @table ) {
1495 "INSERT INTO public.$table SELECT * from $table";
1496 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1502 =item process_download_and_reload
1504 Download and process a tax update as a queued JSRPC job after wiping the
1505 existing wipable tax data.
1509 sub process_download_and_reload {
1510 _process_reload('process_download_and_update', @_);
1514 =item process_batch_reload
1516 Load and process a tax update from the provided files as a queued JSRPC job
1517 after wiping the existing wipable tax data.
1521 sub process_batch_reload {
1522 _process_reload('_perform_batch_import', @_);
1526 sub _process_reload {
1527 my ( $method, $job ) = ( shift, shift );
1529 my $param = thaw(decode_base64($_[0]));
1530 my $format = $param->{'format'}; #well... this is all cch specific
1532 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1534 if ( $job ) { # progress bar
1535 my $error = $job->update_statustext( 0 );
1536 die $error if $error;
1539 my $oldAutoCommit = $FS::UID::AutoCommit;
1540 local $FS::UID::AutoCommit = 0;
1545 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1546 "USING (taxclassnum) WHERE data_vendor = '$format'";
1547 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1549 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1550 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1551 if $sth->fetchrow_arrayref->[0];
1553 # really should get a table EXCLUSIVE lock here
1555 #remember disabled taxes
1556 my %disabled_tax_rate = ();
1557 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1559 #remember tax products
1560 my %taxproduct = ();
1561 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1564 $error ||= _create_temporary_tables( $job, $format );
1568 my $args = '$job, @_';
1569 eval "$method($args);";
1573 #restore taxproducts
1574 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1578 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1580 #wipe out the old data
1581 $error ||= _remove_old_tax_data( $job, $format );
1584 $error ||= _copy_from_temp( $job, $format );
1587 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1592 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1596 =item process_download_and_update
1598 Download and process a tax update as a queued JSRPC job
1602 sub process_download_and_update {
1605 my $param = thaw(decode_base64(shift));
1606 my $format = $param->{'format'}; #well... this is all cch specific
1608 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1610 if ( $job ) { # progress bar
1611 my $error = $job->update_statustext( 0);
1612 die $error if $error;
1615 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1616 my $dir = $cache_dir. 'taxdata';
1618 mkdir $dir or die "can't create $dir: $!\n";
1621 if ($format eq 'cch') {
1623 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1625 my $conf = new FS::Conf;
1626 die "direct download of tax data not enabled\n"
1627 unless $conf->exists('taxdatadirectdownload');
1628 my ( $urls, $username, $secret, $states ) =
1629 $conf->config('taxdatadirectdownload');
1630 die "No tax download URL provided. ".
1631 "Did you set the taxdatadirectdownload configuration value?\n"
1639 # really should get a table EXCLUSIVE lock here
1640 # check if initial import or update
1642 # relying on mkdir "$dir.new" as a mutex
1644 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1645 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1646 $sth->execute() or die $sth->errstr;
1647 my $update = $sth->fetchrow_arrayref->[0];
1649 # create cache and/or rotate old tax data
1654 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1655 foreach my $file (readdir($dirh)) {
1656 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1662 for (8, 7, 6, 5, 4, 3, 2, 1) {
1663 if ( -e "$dir.$_" ) {
1664 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1667 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1671 die "can't find previous tax data\n" if $update;
1675 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1677 # fetch and unpack the zip files
1679 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1681 # extract csv files from the dbf files
1683 foreach my $name ( @namelist ) {
1684 _cch_extract_csv_from_dbf( $job, $dir, $name );
1687 # generate the diff files
1690 foreach my $name ( @namelist ) {
1691 my $difffile = "$dir.new/$name.txt";
1693 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1694 die $error if $error;
1695 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1696 my $olddir = $update ? "$dir.1" : "";
1697 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1699 $difffile =~ s/^$cache_dir//;
1700 push @list, "${name}file:$difffile";
1703 # perform the import
1704 local $keep_cch_files = 1;
1705 $param->{uploaded_files} = join( ',', @list );
1706 $param->{format} .= '-update' if $update;
1708 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1710 rename "$dir.new", "$dir"
1711 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1714 die "Unknown format: $format";
1718 =item browse_queries PARAMS
1720 Returns a list consisting of a hashref suited for use as the argument
1721 to qsearch, and sql query string. Each is based on the PARAMS hashref
1722 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1723 from a form. This conveniently creates the query hashref and count_query
1724 string required by the browse and search elements. As a side effect,
1725 the PARAMS hashref is untainted and keys with unexpected values are removed.
1729 sub browse_queries {
1733 'table' => 'tax_rate',
1735 'order_by' => 'ORDER BY geocode, taxclassnum',
1740 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1741 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1743 delete $params->{data_vendor};
1746 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1747 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1748 'geocode LIKE '. dbh->quote($1.'%');
1750 delete $params->{geocode};
1753 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1754 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1757 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1758 ' taxclassnum = '. dbh->quote($1)
1760 delete $params->{taxclassnun};
1764 if ( $params->{tax_type} =~ /^(\d+)$/ );
1765 delete $params->{tax_type}
1769 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1770 delete $params->{tax_cat}
1773 my @taxclassnum = ();
1774 if ($tax_type || $tax_cat ) {
1775 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1776 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1777 @taxclassnum = map { $_->taxclassnum }
1778 qsearch({ 'table' => 'tax_class',
1780 'extra_sql' => "WHERE taxclass $compare",
1784 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1785 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1786 if ( @taxclassnum );
1788 unless ($params->{'showdisabled'}) {
1789 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1790 "( disabled = '' OR disabled IS NULL )";
1793 $query->{extra_sql} = $extra_sql;
1795 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1798 =item queue_liability_report PARAMS
1800 Launches a tax liability report.
1803 sub queue_liability_report {
1805 my $param = thaw(decode_base64(shift));
1808 $cgi->param('beginning', $param->{beginning});
1809 $cgi->param('ending', $param->{ending});
1810 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1811 my $agentnum = $param->{agentnum};
1812 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1813 generate_liability_report(
1814 'beginning' => $beginning,
1815 'ending' => $ending,
1816 'agentnum' => $agentnum,
1817 'p' => $param->{RootURL},
1822 =item generate_liability_report PARAMS
1824 Generates a tax liability report. Provide a hash including desired
1825 agentnum, beginning, and ending
1829 #shit, all sorts of false laxiness w/report_newtax.cgi
1830 sub generate_liability_report {
1833 my ( $count, $last, $min_sec ) = _progressbar_foo();
1835 #let us open the temp file early
1836 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1837 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1839 UNLINK => 0, # not so temp
1840 ) or die "can't open report file: $!\n";
1842 my $conf = new FS::Conf;
1843 my $money_char = $conf->config('money_char') || '$';
1846 JOIN cust_bill USING ( invnum )
1847 LEFT JOIN cust_main USING ( custnum )
1851 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1852 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1854 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1856 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1859 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1860 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1861 die "agent not found" unless $agent;
1862 $agentname = $agent->agent;
1863 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1866 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1867 my @taxparams = qw( city county state locationtaxid );
1868 my @params = ('itemdesc', @taxparams);
1870 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1872 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1873 #to FS::Report or FS::Record or who the fuck knows where)
1874 my $scalar_sql = sub {
1875 my( $r, $param, $sql ) = @_;
1876 my $sth = dbh->prepare($sql) or die dbh->errstr;
1877 $sth->execute( map $r->$_(), @$param )
1878 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1879 $sth->fetchrow_arrayref->[0] || 0;
1887 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1889 hashref => { pkgpart => 0 },
1890 addl_from => $addl_from,
1891 extra_sql => $where,
1893 $count = scalar(@tax_and_location);
1894 foreach my $t ( @tax_and_location ) {
1897 if ( time - $min_sec > $last ) {
1898 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1905 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1906 my $label = join('~', map { $t->$_ } @params);
1907 $label = 'Tax'. $label if $label =~ /^~/;
1908 unless ( exists( $taxes{$label} ) ) {
1909 my ($baselabel, @trash) = split /~/, $label;
1911 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1912 $taxes{$label}->{'url_param'} =
1913 join(';', map { "$_=". uri_escape($t->$_) } @params);
1915 my $payby_itemdesc_loc =
1916 " payby != 'COMP' ".
1917 "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1918 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1923 "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1925 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1927 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1929 $taxes{$label}->{'tax'} += $x;
1932 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1934 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1936 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1937 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1939 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1941 $taxes{$label}->{'credit'} += $y;
1943 unless ( exists( $taxes{$baselabel} ) ) {
1945 $basetaxes{$baselabel}->{'label'} = $baselabel;
1946 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1947 $basetaxes{$baselabel}->{'base'} = 1;
1951 $basetaxes{$baselabel}->{'tax'} += $x;
1952 $basetaxes{$baselabel}->{'credit'} += $y;
1956 # calculate customer-exemption for this tax
1957 # calculate package-exemption for this tax
1958 # calculate monthly exemption (texas tax) for this tax
1959 # count up all the cust_tax_exempt_pkg records associated with
1960 # the actual line items.
1967 $args{job}->update_statustext( "0,Sorted" );
1973 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1974 my ($base, @trash) = split '~', $tax;
1975 my $basetax = delete( $basetaxes{$base} );
1977 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1978 $taxes{$tax}->{base} = 1;
1980 push @taxes, $basetax;
1983 push @taxes, $taxes{$tax};
1990 'credit' => $credit,
1995 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1996 $dateagentlink .= ';agentnum='. $args{agentnum}
1997 if length($agentname);
1998 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1999 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2001 print $report <<EOF;
2003 <% include("/elements/header.html", "$agentname Tax Report - ".
2005 ? time2str('%h %o %Y ', $args{beginning} )
2009 ( $args{ending} == 4294967295
2011 : time2str('%h %o %Y', $args{ending} )
2016 <% include('/elements/table-grid.html') %>
2019 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2020 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2021 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2022 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2023 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2024 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2028 my $bgcolor1 = '#eeeeee';
2029 my $bgcolor2 = '#ffffff';
2032 $count = scalar(@taxes);
2034 foreach my $tax ( @taxes ) {
2037 if ( time - $min_sec > $last ) {
2038 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2045 if ( $bgcolor eq $bgcolor1 ) {
2046 $bgcolor = $bgcolor2;
2048 $bgcolor = $bgcolor1;
2052 if ( $tax->{'label'} ne 'Total' ) {
2053 $link = ';'. $tax->{'url_param'};
2056 print $report <<EOF;
2058 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2059 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2060 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2061 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2063 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2064 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2065 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2066 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2067 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2069 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2074 print $report <<EOF;
2081 my $reportname = $report->filename;
2084 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2085 $reportname =~ s/^$dropstring//;
2087 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2088 die "<a href=$reporturl>view</a>\n";
2098 Mixing automatic and manual editing works poorly at present.
2100 Tax liability calculations take too long and arguably don't belong here.
2101 Tax liability report generation not entirely safe (escaped).
2105 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base