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_cch_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 #ut_text / ut_textn w/ ` added cause now that's in the data
251 $self->getfield($field)
252 =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
253 or return gettext('illegal_or_empty_text'). " $field: ".
254 $self->getfield($field);
255 $self->setfield($field,$1);
260 =item taxclass_description
262 Returns the human understandable value associated with the related
267 sub taxclass_description {
269 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
270 $tax_class ? $tax_class->description : '';
275 Returns the human understandable value associated with the unittype column
279 %tax_unittypes = ( '0' => 'access line',
286 $tax_unittypes{$self->unittype};
291 Returns the human understandable value associated with the maxtype column
295 %tax_maxtypes = ( '0' => 'receipts per invoice',
296 '1' => 'receipts per item',
297 '2' => 'total utility charges per utility tax year',
298 '3' => 'total charges per utility tax year',
299 '4' => 'receipts per access line',
300 '9' => 'monthly receipts per location',
305 $tax_maxtypes{$self->maxtype};
310 Returns the human understandable value associated with the basetype column
314 %tax_basetypes = ( '0' => 'sale price',
315 '1' => 'gross receipts',
316 '2' => 'sales taxable telecom revenue',
317 '3' => 'minutes carried',
318 '4' => 'minutes billed',
319 '5' => 'gross operating revenue',
320 '6' => 'access line',
322 '8' => 'gross revenue',
323 '9' => 'portion gross receipts attributable to interstate service',
324 '10' => 'access line',
325 '11' => 'gross profits',
326 '12' => 'tariff rate',
328 '15' => 'prior year gross receipts',
333 $tax_basetypes{$self->basetype};
338 Returns the human understandable value associated with the taxauth column
342 %tax_authorities = ( '0' => 'federal',
347 '5' => 'county administered by state',
348 '6' => 'city administered by state',
349 '7' => 'city administered by county',
350 '8' => 'local administered by state',
351 '9' => 'local administered by county',
356 $tax_authorities{$self->taxauth};
361 Returns the human understandable value associated with the passtype column
365 %tax_passtypes = ( '0' => 'separate tax line',
366 '1' => 'separate surcharge line',
367 '2' => 'surcharge not separated',
368 '3' => 'included in base rate',
373 $tax_passtypes{$self->passtype};
376 =item taxline TAXABLES
378 Returns a listref of a name and an amount of tax calculated for the list
379 of packages/amounts referenced by TAXABLES. If an error occurs, a message
380 is returned as a scalar.
386 # this used to accept a hash of options but none of them did anything
387 # so it's been removed.
391 if (ref($_[0]) eq 'ARRAY') {
395 #exemptions would be broken in this case
398 my $name = $self->taxname;
399 $name = 'Other surcharges'
400 if ($self->passtype == 2);
403 if ( $self->disabled ) { # we always know how to handle disabled taxes
410 my $taxable_charged = 0;
411 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
414 warn "calculating taxes for ". $self->taxnum. " on ".
415 join (",", map { $_->pkgnum } @cust_bill_pkg)
418 if ($self->passflag eq 'N') {
419 # return "fatal: can't (yet) handle taxes not passed to the customer";
420 # until someone needs to track these in freeside
427 my $maxtype = $self->maxtype || 0;
428 if ($maxtype != 0 && $maxtype != 1 && $maxtype != 9) {
429 return $self->_fatal_or_null( 'tax with "'.
430 $self->maxtype_name. '" threshold'
436 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
440 # we treat gross revenue as gross receipts and expect the tax data
441 # to DTRT (i.e. tax on tax rules)
442 if ($self->basetype != 0 && $self->basetype != 1 &&
443 $self->basetype != 5 && $self->basetype != 6 &&
444 $self->basetype != 7 && $self->basetype != 8 &&
445 $self->basetype != 14
448 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
451 unless ($self->setuptax =~ /^Y$/i) {
452 $taxable_charged += $_->setup foreach @cust_bill_pkg;
454 unless ($self->recurtax =~ /^Y$/i) {
455 $taxable_charged += $_->recur foreach @cust_bill_pkg;
458 my $taxable_units = 0;
459 unless ($self->recurtax =~ /^Y$/i) {
461 if (( $self->unittype || 0 ) == 0) { #access line
463 foreach (@cust_bill_pkg) {
464 $taxable_units += $_->units
465 unless $seen{$_->pkgnum}++;
468 } elsif ($self->unittype == 1) { #minute
469 return $self->_fatal_or_null( 'fee with minute unit type' );
471 } elsif ($self->unittype == 2) { #account
473 my $conf = new FS::Conf;
474 if ( $conf->exists('tax-pkg_address') ) {
475 #number of distinct locations
477 foreach (@cust_bill_pkg) {
479 unless $seen{$_->cust_pkg->locationnum}++;
486 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
491 # XXX handle excessrate (use_excessrate) / excessfee /
492 # taxbase/feebase / taxmax/feemax
493 # and eventually exemptions
495 # the tax or fee is applied to taxbase or feebase and then
496 # the excessrate or excess fee is applied to taxmax or feemax
498 $amount += $taxable_charged * $self->tax;
499 $amount += $taxable_units * $self->fee;
501 warn "calculated taxes as [ $name, $amount ]\n"
512 my ($self, $error) = @_;
514 my $conf = new FS::Conf;
516 $error = "can't yet handle ". $error;
517 my $name = $self->taxname;
518 $name = 'Other surcharges'
519 if ($self->passtype == 2);
521 if ($conf->exists('ignore_incalculable_taxes')) {
522 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
523 return { name => $name, amount => 0 };
525 return "fatal: $error";
529 =item tax_on_tax CUST_LOCATION
531 Returns a list of taxes which are candidates for taxing taxes for the
532 given service location (see L<FS::cust_location>)
540 my $cust_location = shift;
542 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
543 $cust_location->custnum
546 my $geocode = $cust_location->geocode($self->data_vendor);
550 my $extra_sql = ' AND ('.
551 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
556 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
557 my $select = 'DISTINCT ON(taxclassnum) *';
559 # should qsearch preface columns with the table to facilitate joins?
560 my @taxclassnums = map { $_->taxclassnum }
561 qsearch( { 'table' => 'part_pkg_taxrate',
563 'hashref' => { 'data_vendor' => $self->data_vendor,
564 'taxclassnumtaxed' => $self->taxclassnum,
566 'extra_sql' => $extra_sql,
567 'order_by' => $order_by,
570 return () unless @taxclassnums;
573 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
575 qsearch({ 'table' => 'tax_rate',
576 'hashref' => { 'geocode' => $geocode, },
577 'extra_sql' => $extra_sql,
582 =item tax_rate_location
584 Returns an object representing the location associated with this tax
585 (see L<FS::tax_rate_location>)
589 sub tax_rate_location {
592 qsearchs({ 'table' => 'tax_rate_location',
593 'hashref' => { 'data_vendor' => $self->data_vendor,
594 'geocode' => $self->geocode,
598 new FS::tax_rate_location;
612 sub _progressbar_foo {
617 my ($param, $job) = @_;
619 my $fh = $param->{filehandle};
620 my $format = $param->{'format'};
628 my @column_lengths = ();
629 my @column_callbacks = ();
630 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
631 $format =~ s/-fixed//;
632 my $date_format = sub { my $r='';
633 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
636 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
637 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 );
638 push @column_lengths, 1 if $format eq 'cch-update';
639 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
640 $column_callbacks[8] = $date_format;
644 my ( $count, $last, $min_sec ) = _progressbar_foo();
645 if ( $job || scalar(@column_callbacks) ) {
647 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
648 return $error if $error;
652 if ( $format eq 'cch' || $format eq 'cch-update' ) {
653 #false laziness w/below (sub _perform_cch_diff)
654 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
655 excessrate effective_date taxauth taxtype taxcat taxname
656 usetax useexcessrate fee unittype feemax maxtype passflag
658 push @fields, 'actionflag' if $format eq 'cch-update';
663 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
664 $hash->{'data_vendor'} ='cch';
665 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
666 time_zone => 'floating',
668 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
669 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
671 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
672 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
675 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
677 my %tax_class = ( 'data_vendor' => 'cch',
678 'taxclass' => $taxclassid,
681 my $tax_class = qsearchs( 'tax_class', \%tax_class );
682 return "Error updating tax rate: no tax class $taxclassid"
685 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
687 foreach (qw( taxtype taxcat )) {
691 my %passflagmap = ( '0' => '',
695 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
696 if exists $passflagmap{$hash->{'passflag'}};
698 foreach (keys %$hash) {
699 $hash->{$_} = substr($hash->{$_}, 0, 80)
700 if length($hash->{$_}) > 80;
703 my $actionflag = delete($hash->{'actionflag'});
705 $hash->{'taxname'} =~ s/`/'/g;
706 $hash->{'taxname'} =~ s|\\|/|g;
708 return '' if $format eq 'cch'; # but not cch-update
710 if ($actionflag eq 'I') {
711 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
712 }elsif ($actionflag eq 'D') {
713 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
715 return "Unexpected action flag: ". $hash->{'actionflag'};
718 delete($hash->{$_}) for keys %$hash;
724 } elsif ( $format eq 'extended' ) {
725 die "unimplemented\n";
729 die "unknown format $format";
732 my $csv = new Text::CSV_XS;
736 local $SIG{HUP} = 'IGNORE';
737 local $SIG{INT} = 'IGNORE';
738 local $SIG{QUIT} = 'IGNORE';
739 local $SIG{TERM} = 'IGNORE';
740 local $SIG{TSTP} = 'IGNORE';
741 local $SIG{PIPE} = 'IGNORE';
743 my $oldAutoCommit = $FS::UID::AutoCommit;
744 local $FS::UID::AutoCommit = 0;
747 while ( defined($line=<$fh>) ) {
748 $csv->parse($line) or do {
749 $dbh->rollback if $oldAutoCommit;
750 return "can't parse: ". $csv->error_input();
753 if ( $job ) { # progress bar
754 if ( time - $min_sec > $last ) {
755 my $error = $job->update_statustext(
756 int( 100 * $imported / $count ). ",Importing tax rates"
759 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
766 my @columns = $csv->fields();
768 my %tax_rate = ( 'data_vendor' => $format );
769 foreach my $field ( @fields ) {
770 $tax_rate{$field} = shift @columns;
773 if ( scalar( @columns ) ) {
774 $dbh->rollback if $oldAutoCommit;
775 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
778 my $error = &{$hook}(\%tax_rate);
780 $dbh->rollback if $oldAutoCommit;
784 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
786 my $tax_rate = new FS::tax_rate( \%tax_rate );
787 $error = $tax_rate->insert;
790 $dbh->rollback if $oldAutoCommit;
791 return "can't insert tax_rate for $line: $error";
800 my @replace = grep { exists($delete{$_}) } keys %insert;
802 if ( $job ) { # progress bar
803 if ( time - $min_sec > $last ) {
804 my $error = $job->update_statustext(
805 int( 100 * $imported / $count ). ",Importing tax rates"
808 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
815 my $old = qsearchs( 'tax_rate', $delete{$_} );
819 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
820 $new->taxnum($old->taxnum);
821 my $error = $new->replace($old);
824 $dbh->rollback if $oldAutoCommit;
825 my $hashref = $insert{$_};
826 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
827 return "can't replace tax_rate for $line: $error";
834 $old = delete $delete{$_};
835 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
836 #join(" ", map { "$_ => ". $old->{$_} } @fields);
837 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
843 for (grep { !exists($delete{$_}) } keys %insert) {
844 if ( $job ) { # progress bar
845 if ( time - $min_sec > $last ) {
846 my $error = $job->update_statustext(
847 int( 100 * $imported / $count ). ",Importing tax rates"
850 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
857 my $tax_rate = new FS::tax_rate( $insert{$_} );
858 my $error = $tax_rate->insert;
861 $dbh->rollback if $oldAutoCommit;
862 my $hashref = $insert{$_};
863 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
864 return "can't insert tax_rate for $line: $error";
870 for (grep { !exists($insert{$_}) } keys %delete) {
871 if ( $job ) { # progress bar
872 if ( time - $min_sec > $last ) {
873 my $error = $job->update_statustext(
874 int( 100 * $imported / $count ). ",Importing tax rates"
877 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
884 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
886 $dbh->rollback if $oldAutoCommit;
887 $tax_rate = $delete{$_};
888 warn "WARNING: can't find tax_rate to delete for: ".
889 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
892 my $error = $tax_rate->delete; # XXX we really should not do this
893 # (it orphans CBPTRL records)
896 $dbh->rollback if $oldAutoCommit;
897 my $hashref = $delete{$_};
898 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
899 return "can't delete tax_rate for $line: $error";
906 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
908 return "Empty file!" unless ($imported || $format eq 'cch-update');
914 =item process_batch_import
916 Load a batch import as a queued JSRPC job
920 sub process_batch_import {
923 my $oldAutoCommit = $FS::UID::AutoCommit;
924 local $FS::UID::AutoCommit = 0;
927 my $param = thaw(decode_base64(shift));
928 my $args = '$job, encode_base64( nfreeze( $param ) )';
930 my $method = '_perform_batch_import';
931 if ( $param->{reload} ) {
932 $method = 'process_batch_reload';
935 eval "$method($args);";
937 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
942 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
945 sub _perform_batch_import {
948 my $param = thaw(decode_base64(shift));
949 my $format = $param->{'format'}; #well... this is all cch specific
951 my $files = $param->{'uploaded_files'}
952 or die "No files provided.";
954 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
957 if ( $format eq 'cch' || $format eq 'cch-fixed'
958 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
961 my $oldAutoCommit = $FS::UID::AutoCommit;
962 local $FS::UID::AutoCommit = 0;
965 my @insert_list = ();
966 my @delete_list = ();
967 my @predelete_list = ();
970 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
972 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
973 'CODE', \&FS::tax_class::batch_import,
974 'PLUS4', \&FS::cust_tax_location::batch_import,
975 'ZIP', \&FS::cust_tax_location::batch_import,
976 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
977 'DETAIL', \&FS::tax_rate::batch_import,
979 while( scalar(@list) ) {
980 my ( $name, $import_sub ) = splice( @list, 0, 2 );
981 my $file = lc($name). 'file';
983 unless ($files{$file}) {
984 #$error = "No $name supplied";
987 next if $name eq 'DETAIL' && $format =~ /update/;
989 my $filename = "$dir/". $files{$file};
991 if ( $format =~ /update/ ) {
993 ( $error, $insertname, $deletename ) =
994 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
998 unlink $filename or warn "Can't delete $filename: $!"
999 unless $keep_cch_files;
1000 push @insert_list, $name, $insertname, $import_sub, $format;
1001 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1002 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1004 unshift @delete_list, $name, $deletename, $import_sub, $format;
1009 push @insert_list, $name, $filename, $import_sub, $format;
1016 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1017 if $format =~ /update/;
1019 my %addl_param = ();
1020 if ( $param->{'delete_only'} ) {
1021 $addl_param{'delete_only'} = $param->{'delete_only'};
1025 $error ||= _perform_cch_tax_import( $job,
1026 [ @predelete_list ],
1033 @list = ( @predelete_list, @insert_list, @delete_list );
1034 while( !$keep_cch_files && scalar(@list) ) {
1035 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1036 unlink $file or warn "Can't delete $file: $!";
1040 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1043 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1047 die "Unknown format: $format";
1053 sub _perform_cch_tax_import {
1054 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1058 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1059 while( scalar(@$list) ) {
1060 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1061 my $fmt = "$format-update";
1062 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1063 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1064 my $param = { 'filehandle' => $fh,
1068 $error ||= &{$method}($param, $job);
1076 sub _perform_cch_insert_delete_split {
1077 my ($name, $filename, $dir, $format) = @_;
1081 open my $fh, "< $filename"
1082 or $error ||= "Can't open $name file $filename: $!";
1084 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1087 ) or die "can't open temp file: $!\n";
1088 my $insertname = $ifh->filename;
1090 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1093 ) or die "can't open temp file: $!\n";
1094 my $deletename = $dfh->filename;
1096 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1097 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1100 $handle = $ifh if $_ =~ /$insert_pattern/;
1101 $handle = $dfh if $_ =~ /$delete_pattern/;
1103 $error = "bad input line: $_" unless $handle;
1112 return ($error, $insertname, $deletename);
1115 sub _perform_cch_diff {
1116 my ($name, $newdir, $olddir) = @_;
1121 open my $oldcsvfh, "$olddir/$name.txt"
1122 or die "failed to open $olddir/$name.txt: $!\n";
1124 while(<$oldcsvfh>) {
1131 open my $newcsvfh, "$newdir/$name.txt"
1132 or die "failed to open $newdir/$name.txt: $!\n";
1134 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1137 ) or die "can't open temp file: $!\n";
1138 my $diffname = $dfh->filename;
1140 while(<$newcsvfh>) {
1142 if (exists($oldlines{$_})) {
1145 print $dfh $_, ',"I"', "\n";
1150 #false laziness w/above (sub batch_import)
1151 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1152 excessrate effective_date taxauth taxtype taxcat taxname
1153 usetax useexcessrate fee unittype feemax maxtype passflag
1154 passtype basetype );
1155 my $numfields = scalar(@fields);
1157 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1159 for my $line (grep $oldlines{$_}, keys %oldlines) {
1161 $csv->parse($line) or do {
1162 #$dbh->rollback if $oldAutoCommit;
1163 die "can't parse: ". $csv->error_input();
1165 my @columns = $csv->fields();
1167 $csv->combine( splice(@columns, 0, $numfields) );
1169 print $dfh $csv->string, ',"D"', "\n";
1177 sub _cch_fetch_and_unzip {
1178 my ( $job, $urls, $secret, $dir ) = @_;
1180 my $ua = new LWP::UserAgent;
1181 foreach my $url (split ',', $urls) {
1182 my @name = split '/', $url; #somewhat restrictive
1183 my $name = pop @name;
1184 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1187 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1189 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1190 my $res = $ua->request(
1191 new HTTP::Request( GET => $url ),
1193 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1194 my $content_length = $_[1]->content_length;
1195 $imported += length($_[0]);
1196 if ( time - $min_sec > $last ) {
1197 my $error = $job->update_statustext(
1198 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1199 ",Downloading data from CCH"
1201 die $error if $error;
1206 die "download of $url failed: ". $res->status_line
1207 unless $res->is_success;
1210 my $error = $job->update_statustext( "0,Unpacking data" );
1211 die $error if $error;
1212 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1214 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1215 or die "unzip -P $secret -d $dir $dir/$name failed";
1216 #unlink "$dir/$name";
1220 sub _cch_extract_csv_from_dbf {
1221 my ( $job, $dir, $name ) = @_;
1226 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1227 my $error = $job->update_statustext( "0,Unpacking $name" );
1228 die $error if $error;
1229 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1230 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1231 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1232 unless defined($table);
1233 my $count = $table->last_record; # approximately;
1234 open my $csvfh, ">$dir.new/$name.txt"
1235 or die "failed to open $dir.new/$name.txt: $!\n";
1237 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1238 my @fields = $table->field_names;
1239 my $cursor = $table->prepare_select;
1241 sub { my $date = shift;
1242 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1245 while (my $row = $cursor->fetch_hashref) {
1246 $csv->combine( map { my $type = $table->field_type($_);
1248 &{$format_date}($row->{$_}) ;
1249 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1250 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1257 print $csvfh $csv->string, "\n";
1259 if ( time - $min_sec > $last ) {
1260 my $error = $job->update_statustext(
1261 int(100 * $imported/$count). ",Unpacking $name"
1263 die $error if $error;
1271 sub _remember_disabled_taxes {
1272 my ( $job, $format, $disabled_tax_rate ) = @_;
1276 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1278 my @items = qsearch( { table => 'tax_rate',
1279 hashref => { disabled => 'Y',
1280 data_vendor => $format,
1282 select => 'geocode, taxclassnum',
1285 my $count = scalar(@items);
1286 foreach my $tax_rate ( @items ) {
1287 if ( time - $min_sec > $last ) {
1288 $job->update_statustext(
1289 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1295 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1296 unless ( $tax_class ) {
1297 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1300 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1304 sub _remember_tax_products {
1305 my ( $job, $format, $taxproduct ) = @_;
1307 # XXX FIXME this loop only works when cch is the only data provider
1309 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1311 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1312 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1313 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1314 " optionname LIKE 'usage_taxproductnum_%' AND ".
1315 " optionvalue != '' )";
1316 my @items = qsearch( { table => 'part_pkg',
1317 select => 'DISTINCT pkgpart,taxproductnum',
1319 extra_sql => $extra_sql,
1322 my $count = scalar(@items);
1323 foreach my $part_pkg ( @items ) {
1324 if ( time - $min_sec > $last ) {
1325 $job->update_statustext(
1326 int( 100 * $imported / $count ). ",Remembering tax products"
1331 warn "working with package part ". $part_pkg->pkgpart.
1332 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1333 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1334 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1335 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1337 foreach my $option ( $part_pkg->part_pkg_option ) {
1338 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1341 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1342 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1343 $part_pkg_taxproduct->taxproduct
1344 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1349 sub _restore_remembered_tax_products {
1350 my ( $job, $format, $taxproduct ) = @_;
1354 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1355 my $count = scalar(keys %$taxproduct);
1356 foreach my $pkgpart ( keys %$taxproduct ) {
1357 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1358 if ( time - $min_sec > $last ) {
1359 $job->update_statustext(
1360 int( 100 * $imported / $count ). ",Restoring tax products"
1366 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1367 unless ( $part_pkg ) {
1368 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1371 my %options = $part_pkg->options;
1372 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1373 my $primary_svc = $part_pkg->svcpart;
1374 my $new = new FS::part_pkg { $part_pkg->hash };
1376 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1377 warn "working with class '$class'\n" if $DEBUG;
1378 my $part_pkg_taxproduct =
1379 qsearchs( 'part_pkg_taxproduct',
1380 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1381 data_vendor => $format,
1385 unless ( $part_pkg_taxproduct ) {
1386 return "failed to find part_pkg_taxproduct (".
1387 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1390 if ( $class eq '' ) {
1391 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1395 $options{"usage_taxproductnum_$class"} =
1396 $part_pkg_taxproduct->taxproductnum;
1400 my $error = $new->replace( $part_pkg,
1401 'pkg_svc' => \%pkg_svc,
1402 'primary_svc' => $primary_svc,
1403 'options' => \%options,
1406 return $error if $error;
1413 sub _restore_remembered_disabled_taxes {
1414 my ( $job, $format, $disabled_tax_rate ) = @_;
1416 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1417 my $count = scalar(keys %$disabled_tax_rate);
1418 foreach my $key (keys %$disabled_tax_rate) {
1419 if ( time - $min_sec > $last ) {
1420 $job->update_statustext(
1421 int( 100 * $imported / $count ). ",Disabling tax rates"
1426 my ($geocode,$taxclass) = split /:/, $key, 2;
1427 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1428 taxclass => $taxclass,
1430 return "found multiple tax_class records for format $format class $taxclass"
1431 if scalar(@tax_class) > 1;
1433 unless (scalar(@tax_class)) {
1434 warn "no tax_class for format $format class $taxclass\n";
1439 qsearch('tax_rate', { data_vendor => $format,
1440 geocode => $geocode,
1441 taxclassnum => $tax_class[0]->taxclassnum,
1445 if (scalar(@tax_rate) > 1) {
1446 return "found multiple tax_rate records for format $format geocode ".
1447 "$geocode and taxclass $taxclass ( taxclassnum ".
1448 $tax_class[0]->taxclassnum. " )";
1451 if (scalar(@tax_rate)) {
1452 $tax_rate[0]->disabled('Y');
1453 my $error = $tax_rate[0]->replace;
1454 return $error if $error;
1459 sub _remove_old_tax_data {
1460 my ( $job, $format ) = @_;
1463 my $error = $job->update_statustext( "0,Removing old tax data" );
1464 die $error if $error;
1466 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1467 "WHERE data_vendor = ". $dbh->quote($format);
1468 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1471 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1473 foreach my $table ( @table ) {
1474 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1475 $dbh->quote($format);
1476 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1479 if ( $format eq 'cch' ) {
1480 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1481 $dbh->quote("$format-zip");
1482 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1488 sub _create_temporary_tables {
1489 my ( $job, $format ) = @_;
1492 my $error = $job->update_statustext( "0,Creating temporary tables" );
1493 die $error if $error;
1495 my @table = qw( tax_rate
1502 foreach my $table ( @table ) {
1504 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1505 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1511 sub _copy_from_temp {
1512 my ( $job, $format ) = @_;
1515 my $error = $job->update_statustext( "0,Making permanent" );
1516 die $error if $error;
1518 my @table = qw( tax_rate
1525 foreach my $table ( @table ) {
1527 "INSERT INTO public.$table SELECT * from $table";
1528 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1534 =item process_download_and_reload
1536 Download and process a tax update as a queued JSRPC job after wiping the
1537 existing wipable tax data.
1541 sub process_download_and_reload {
1542 _process_reload('process_download_and_update', @_);
1546 =item process_batch_reload
1548 Load and process a tax update from the provided files as a queued JSRPC job
1549 after wiping the existing wipable tax data.
1553 sub process_batch_reload {
1554 _process_reload('_perform_batch_import', @_);
1558 sub _process_reload {
1559 my ( $method, $job ) = ( shift, shift );
1561 my $param = thaw(decode_base64($_[0]));
1562 my $format = $param->{'format'}; #well... this is all cch specific
1564 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1566 if ( $job ) { # progress bar
1567 my $error = $job->update_statustext( 0 );
1568 die $error if $error;
1571 my $oldAutoCommit = $FS::UID::AutoCommit;
1572 local $FS::UID::AutoCommit = 0;
1577 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1578 "USING (taxclassnum) WHERE data_vendor = '$format'";
1579 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1581 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1582 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1583 if $sth->fetchrow_arrayref->[0];
1585 # really should get a table EXCLUSIVE lock here
1587 #remember disabled taxes
1588 my %disabled_tax_rate = ();
1589 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1591 #remember tax products
1592 my %taxproduct = ();
1593 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1596 $error ||= _create_temporary_tables( $job, $format );
1600 my $args = '$job, @_';
1601 eval "$method($args);";
1605 #restore taxproducts
1606 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1610 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1612 #wipe out the old data
1613 $error ||= _remove_old_tax_data( $job, $format );
1616 $error ||= _copy_from_temp( $job, $format );
1619 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1624 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1628 =item process_download_and_update
1630 Download and process a tax update as a queued JSRPC job
1634 sub process_download_and_update {
1637 my $param = thaw(decode_base64(shift));
1638 my $format = $param->{'format'}; #well... this is all cch specific
1640 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1642 if ( $job ) { # progress bar
1643 my $error = $job->update_statustext( 0);
1644 die $error if $error;
1647 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1648 my $dir = $cache_dir. 'taxdata';
1650 mkdir $dir or die "can't create $dir: $!\n";
1653 if ($format eq 'cch') {
1655 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1657 my $conf = new FS::Conf;
1658 die "direct download of tax data not enabled\n"
1659 unless $conf->exists('taxdatadirectdownload');
1660 my ( $urls, $username, $secret, $states ) =
1661 $conf->config('taxdatadirectdownload');
1662 die "No tax download URL provided. ".
1663 "Did you set the taxdatadirectdownload configuration value?\n"
1671 # really should get a table EXCLUSIVE lock here
1672 # check if initial import or update
1674 # relying on mkdir "$dir.new" as a mutex
1676 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1677 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1678 $sth->execute() or die $sth->errstr;
1679 my $update = $sth->fetchrow_arrayref->[0];
1681 # create cache and/or rotate old tax data
1686 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1687 foreach my $file (readdir($dirh)) {
1688 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1694 for (8, 7, 6, 5, 4, 3, 2, 1) {
1695 if ( -e "$dir.$_" ) {
1696 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1699 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1703 die "can't find previous tax data\n" if $update;
1707 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1709 # fetch and unpack the zip files
1711 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1713 # extract csv files from the dbf files
1715 foreach my $name ( @namelist ) {
1716 _cch_extract_csv_from_dbf( $job, $dir, $name );
1719 # generate the diff files
1722 foreach my $name ( @namelist ) {
1723 my $difffile = "$dir.new/$name.txt";
1725 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1726 die $error if $error;
1727 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1728 my $olddir = $update ? "$dir.1" : "";
1729 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1731 $difffile =~ s/^$cache_dir//;
1732 push @list, "${name}file:$difffile";
1735 # perform the import
1736 local $keep_cch_files = 1;
1737 $param->{uploaded_files} = join( ',', @list );
1738 $param->{format} .= '-update' if $update;
1740 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1742 rename "$dir.new", "$dir"
1743 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1746 die "Unknown format: $format";
1750 =item browse_queries PARAMS
1752 Returns a list consisting of a hashref suited for use as the argument
1753 to qsearch, and sql query string. Each is based on the PARAMS hashref
1754 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1755 from a form. This conveniently creates the query hashref and count_query
1756 string required by the browse and search elements. As a side effect,
1757 the PARAMS hashref is untainted and keys with unexpected values are removed.
1761 sub browse_queries {
1765 'table' => 'tax_rate',
1767 'order_by' => 'ORDER BY geocode, taxclassnum',
1772 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1773 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1775 delete $params->{data_vendor};
1778 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1779 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1780 'geocode LIKE '. dbh->quote($1.'%');
1782 delete $params->{geocode};
1785 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1786 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1789 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1790 ' taxclassnum = '. dbh->quote($1)
1792 delete $params->{taxclassnun};
1796 if ( $params->{tax_type} =~ /^(\d+)$/ );
1797 delete $params->{tax_type}
1801 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1802 delete $params->{tax_cat}
1805 my @taxclassnum = ();
1806 if ($tax_type || $tax_cat ) {
1807 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1808 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1809 @taxclassnum = map { $_->taxclassnum }
1810 qsearch({ 'table' => 'tax_class',
1812 'extra_sql' => "WHERE taxclass $compare",
1816 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1817 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1818 if ( @taxclassnum );
1820 unless ($params->{'showdisabled'}) {
1821 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1822 "( disabled = '' OR disabled IS NULL )";
1825 $query->{extra_sql} = $extra_sql;
1827 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1830 =item queue_liability_report PARAMS
1832 Launches a tax liability report.
1834 PARAMS needs to be a base64-encoded Storable hash containing:
1835 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1836 - end: the end date of the report, likewise.
1837 - agentnum: the agent to limit the report to, if any.
1841 sub queue_liability_report {
1843 my $param = thaw(decode_base64(shift));
1846 $cgi->param('beginning', $param->{beginning});
1847 $cgi->param('ending', $param->{ending});
1848 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1849 my $agentnum = $param->{agentnum};
1850 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1851 generate_liability_report(
1852 'beginning' => $beginning,
1853 'ending' => $ending,
1854 'agentnum' => $agentnum,
1855 'p' => $param->{RootURL},
1860 =item generate_liability_report PARAMS
1862 Generates a tax liability report. PARAMS must include:
1864 - beginning, as a timestamp
1865 - ending, as a timestamp
1866 - p: the Freeside root URL, for generating links
1867 - agentnum (optional)
1871 #shit, all sorts of false laxiness w/report_newtax.cgi
1872 sub generate_liability_report {
1875 my ( $count, $last, $min_sec ) = _progressbar_foo();
1877 #let us open the temp file early
1878 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1879 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1881 UNLINK => 0, # not so temp
1882 ) or die "can't open report file: $!\n";
1884 my $conf = new FS::Conf;
1885 my $money_char = $conf->config('money_char') || '$';
1888 JOIN cust_bill USING ( invnum )
1889 LEFT JOIN cust_main USING ( custnum )
1893 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1894 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1896 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1898 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1901 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1902 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1903 die "agent not found" unless $agent;
1904 $agentname = $agent->agent;
1905 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1908 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1909 my @taxparams = qw( city county state locationtaxid );
1910 my @params = ('itemdesc', @taxparams);
1912 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1914 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1915 #to FS::Report or FS::Record or who the fuck knows where)
1916 my $scalar_sql = sub {
1917 my( $r, $param, $sql ) = @_;
1918 my $sth = dbh->prepare($sql) or die dbh->errstr;
1919 $sth->execute( map $r->$_(), @$param )
1920 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1921 $sth->fetchrow_arrayref->[0] || 0;
1930 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1931 # for taxes that have been charged
1932 # (state, county, city are from tax_rate_location, not from customer data)
1933 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1935 hashref => { pkgpart => 0 },
1936 addl_from => $addl_from,
1937 extra_sql => $where,
1940 $count = scalar(@tax_and_location);
1941 foreach my $t ( @tax_and_location ) {
1944 if ( time - $min_sec > $last ) {
1945 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1952 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1953 my $label = join('~', map { $t->$_ } @params);
1954 $label = 'Tax'. $label if $label =~ /^~/;
1955 unless ( exists( $taxes{$label} ) ) {
1956 my ($baselabel, @trash) = split /~/, $label;
1958 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1959 $taxes{$label}->{'url_param'} =
1960 join(';', map { "$_=". uri_escape($t->$_) } @params);
1963 # " payby != 'COMP' ". # breaks the entire report under 4.x
1964 # # and unnecessary since COMP accounts don't
1965 # # get taxes calculated in the first place
1966 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1967 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1972 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1974 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1976 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1978 $taxes{$label}->{'tax'} += $x;
1981 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1983 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
1985 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1986 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1988 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1990 $taxes{$label}->{'credit'} += $y;
1992 unless ( exists( $taxes{$baselabel} ) ) {
1994 $basetaxes{$baselabel}->{'label'} = $baselabel;
1995 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1996 $basetaxes{$baselabel}->{'base'} = 1;
2000 $basetaxes{$baselabel}->{'tax'} += $x;
2001 $basetaxes{$baselabel}->{'credit'} += $y;
2005 # calculate customer-exemption for this tax
2006 # calculate package-exemption for this tax
2007 # calculate monthly exemption (texas tax) for this tax
2008 # count up all the cust_tax_exempt_pkg records associated with
2009 # the actual line items.
2016 $args{job}->update_statustext( "0,Sorted" );
2022 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2023 my ($base, @trash) = split '~', $tax;
2024 my $basetax = delete( $basetaxes{$base} );
2026 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2027 $taxes{$tax}->{base} = 1;
2029 push @taxes, $basetax;
2032 push @taxes, $taxes{$tax};
2039 'credit' => $credit,
2044 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2045 $dateagentlink .= ';agentnum='. $args{agentnum}
2046 if length($agentname);
2047 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2049 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2051 print $report <<EOF;
2053 <% include("/elements/header.html", "$agentname Tax Report - ".
2055 ? time2str('%h %o %Y ', $args{beginning} )
2059 ( $args{ending} == 4294967295
2061 : time2str('%h %o %Y', $args{ending} )
2066 <% include('/elements/table-grid.html') %>
2069 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2070 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2071 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2072 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2073 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2074 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2078 my $bgcolor1 = '#eeeeee';
2079 my $bgcolor2 = '#ffffff';
2082 $count = scalar(@taxes);
2084 foreach my $tax ( @taxes ) {
2087 if ( time - $min_sec > $last ) {
2088 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2095 if ( $bgcolor eq $bgcolor1 ) {
2096 $bgcolor = $bgcolor2;
2098 $bgcolor = $bgcolor1;
2102 if ( $tax->{'label'} ne 'Total' ) {
2103 $link = ';'. $tax->{'url_param'};
2106 print $report <<EOF;
2108 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2109 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2110 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2111 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2113 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2114 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2115 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2116 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2117 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2119 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2124 print $report <<EOF;
2131 my $reportname = $report->filename;
2134 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2135 $reportname =~ s/^$dropstring//;
2137 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2138 die "<a href=$reporturl>view</a>\n";
2148 Mixing automatic and manual editing works poorly at present.
2150 Tax liability calculations take too long and arguably don't belong here.
2151 Tax liability report generation not entirely safe (escaped).
2155 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>