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 return "can't find tax_rate to delete for: ".
889 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
890 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
892 my $error = $tax_rate->delete;
895 $dbh->rollback if $oldAutoCommit;
896 my $hashref = $delete{$_};
897 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
898 return "can't delete tax_rate for $line: $error";
904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 return "Empty file!" unless ($imported || $format eq 'cch-update');
912 =item process_batch_import
914 Load a batch import as a queued JSRPC job
918 sub process_batch_import {
921 my $oldAutoCommit = $FS::UID::AutoCommit;
922 local $FS::UID::AutoCommit = 0;
925 my $param = thaw(decode_base64(shift));
926 my $args = '$job, encode_base64( nfreeze( $param ) )';
928 my $method = '_perform_batch_import';
929 if ( $param->{reload} ) {
930 $method = 'process_batch_reload';
933 eval "$method($args);";
935 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
940 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
943 sub _perform_batch_import {
946 my $param = thaw(decode_base64(shift));
947 my $format = $param->{'format'}; #well... this is all cch specific
949 my $files = $param->{'uploaded_files'}
950 or die "No files provided.";
952 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
955 if ( $format eq 'cch' || $format eq 'cch-fixed'
956 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
959 my $oldAutoCommit = $FS::UID::AutoCommit;
960 local $FS::UID::AutoCommit = 0;
963 my @insert_list = ();
964 my @delete_list = ();
965 my @predelete_list = ();
968 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
970 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
971 'CODE', \&FS::tax_class::batch_import,
972 'PLUS4', \&FS::cust_tax_location::batch_import,
973 'ZIP', \&FS::cust_tax_location::batch_import,
974 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
975 'DETAIL', \&FS::tax_rate::batch_import,
977 while( scalar(@list) ) {
978 my ( $name, $import_sub ) = splice( @list, 0, 2 );
979 my $file = lc($name). 'file';
981 unless ($files{$file}) {
982 #$error = "No $name supplied";
985 next if $name eq 'DETAIL' && $format =~ /update/;
987 my $filename = "$dir/". $files{$file};
989 if ( $format =~ /update/ ) {
991 ( $error, $insertname, $deletename ) =
992 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
996 unlink $filename or warn "Can't delete $filename: $!"
997 unless $keep_cch_files;
998 push @insert_list, $name, $insertname, $import_sub, $format;
999 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1000 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1002 unshift @delete_list, $name, $deletename, $import_sub, $format;
1007 push @insert_list, $name, $filename, $import_sub, $format;
1014 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1015 if $format =~ /update/;
1017 my %addl_param = ();
1018 if ( $param->{'delete_only'} ) {
1019 $addl_param{'delete_only'} = $param->{'delete_only'};
1023 $error ||= _perform_cch_tax_import( $job,
1024 [ @predelete_list ],
1031 @list = ( @predelete_list, @insert_list, @delete_list );
1032 while( !$keep_cch_files && scalar(@list) ) {
1033 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1034 unlink $file or warn "Can't delete $file: $!";
1038 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1041 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1045 die "Unknown format: $format";
1051 sub _perform_cch_tax_import {
1052 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1056 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1057 while( scalar(@$list) ) {
1058 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1059 my $fmt = "$format-update";
1060 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1061 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1062 my $param = { 'filehandle' => $fh,
1066 $error ||= &{$method}($param, $job);
1074 sub _perform_cch_insert_delete_split {
1075 my ($name, $filename, $dir, $format) = @_;
1079 open my $fh, "< $filename"
1080 or $error ||= "Can't open $name file $filename: $!";
1082 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1085 ) or die "can't open temp file: $!\n";
1086 my $insertname = $ifh->filename;
1088 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1091 ) or die "can't open temp file: $!\n";
1092 my $deletename = $dfh->filename;
1094 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1095 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1098 $handle = $ifh if $_ =~ /$insert_pattern/;
1099 $handle = $dfh if $_ =~ /$delete_pattern/;
1101 $error = "bad input line: $_" unless $handle;
1110 return ($error, $insertname, $deletename);
1113 sub _perform_cch_diff {
1114 my ($name, $newdir, $olddir) = @_;
1119 open my $oldcsvfh, "$olddir/$name.txt"
1120 or die "failed to open $olddir/$name.txt: $!\n";
1122 while(<$oldcsvfh>) {
1129 open my $newcsvfh, "$newdir/$name.txt"
1130 or die "failed to open $newdir/$name.txt: $!\n";
1132 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1135 ) or die "can't open temp file: $!\n";
1136 my $diffname = $dfh->filename;
1138 while(<$newcsvfh>) {
1140 if (exists($oldlines{$_})) {
1143 print $dfh $_, ',"I"', "\n";
1148 #false laziness w/above (sub batch_import)
1149 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1150 excessrate effective_date taxauth taxtype taxcat taxname
1151 usetax useexcessrate fee unittype feemax maxtype passflag
1152 passtype basetype );
1153 my $numfields = scalar(@fields);
1155 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1157 for my $line (grep $oldlines{$_}, keys %oldlines) {
1159 $csv->parse($line) or do {
1160 #$dbh->rollback if $oldAutoCommit;
1161 die "can't parse: ". $csv->error_input();
1163 my @columns = $csv->fields();
1165 $csv->combine( splice(@columns, 0, $numfields) );
1167 print $dfh $csv->string, ',"D"', "\n";
1175 sub _cch_fetch_and_unzip {
1176 my ( $job, $urls, $secret, $dir ) = @_;
1178 my $ua = new LWP::UserAgent;
1179 foreach my $url (split ',', $urls) {
1180 my @name = split '/', $url; #somewhat restrictive
1181 my $name = pop @name;
1182 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1185 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1187 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1188 my $res = $ua->request(
1189 new HTTP::Request( GET => $url ),
1191 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1192 my $content_length = $_[1]->content_length;
1193 $imported += length($_[0]);
1194 if ( time - $min_sec > $last ) {
1195 my $error = $job->update_statustext(
1196 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1197 ",Downloading data from CCH"
1199 die $error if $error;
1204 die "download of $url failed: ". $res->status_line
1205 unless $res->is_success;
1208 my $error = $job->update_statustext( "0,Unpacking data" );
1209 die $error if $error;
1210 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1212 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1213 or die "unzip -P $secret -d $dir $dir/$name failed";
1214 #unlink "$dir/$name";
1218 sub _cch_extract_csv_from_dbf {
1219 my ( $job, $dir, $name ) = @_;
1224 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1225 my $error = $job->update_statustext( "0,Unpacking $name" );
1226 die $error if $error;
1227 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1228 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1229 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1230 unless defined($table);
1231 my $count = $table->last_record; # approximately;
1232 open my $csvfh, ">$dir.new/$name.txt"
1233 or die "failed to open $dir.new/$name.txt: $!\n";
1235 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1236 my @fields = $table->field_names;
1237 my $cursor = $table->prepare_select;
1239 sub { my $date = shift;
1240 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1243 while (my $row = $cursor->fetch_hashref) {
1244 $csv->combine( map { my $type = $table->field_type($_);
1246 &{$format_date}($row->{$_}) ;
1247 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1248 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1255 print $csvfh $csv->string, "\n";
1257 if ( time - $min_sec > $last ) {
1258 my $error = $job->update_statustext(
1259 int(100 * $imported/$count). ",Unpacking $name"
1261 die $error if $error;
1269 sub _remember_disabled_taxes {
1270 my ( $job, $format, $disabled_tax_rate ) = @_;
1274 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1276 my @items = qsearch( { table => 'tax_rate',
1277 hashref => { disabled => 'Y',
1278 data_vendor => $format,
1280 select => 'geocode, taxclassnum',
1283 my $count = scalar(@items);
1284 foreach my $tax_rate ( @items ) {
1285 if ( time - $min_sec > $last ) {
1286 $job->update_statustext(
1287 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1293 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1294 unless ( $tax_class ) {
1295 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1298 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1302 sub _remember_tax_products {
1303 my ( $job, $format, $taxproduct ) = @_;
1305 # XXX FIXME this loop only works when cch is the only data provider
1307 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1309 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1310 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1311 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1312 " optionname LIKE 'usage_taxproductnum_%' AND ".
1313 " optionvalue != '' )";
1314 my @items = qsearch( { table => 'part_pkg',
1315 select => 'DISTINCT pkgpart,taxproductnum',
1317 extra_sql => $extra_sql,
1320 my $count = scalar(@items);
1321 foreach my $part_pkg ( @items ) {
1322 if ( time - $min_sec > $last ) {
1323 $job->update_statustext(
1324 int( 100 * $imported / $count ). ",Remembering tax products"
1329 warn "working with package part ". $part_pkg->pkgpart.
1330 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1331 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1332 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1333 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1335 foreach my $option ( $part_pkg->part_pkg_option ) {
1336 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1339 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1340 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1341 $part_pkg_taxproduct->taxproduct
1342 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1347 sub _restore_remembered_tax_products {
1348 my ( $job, $format, $taxproduct ) = @_;
1352 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1353 my $count = scalar(keys %$taxproduct);
1354 foreach my $pkgpart ( keys %$taxproduct ) {
1355 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1356 if ( time - $min_sec > $last ) {
1357 $job->update_statustext(
1358 int( 100 * $imported / $count ). ",Restoring tax products"
1364 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1365 unless ( $part_pkg ) {
1366 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1369 my %options = $part_pkg->options;
1370 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1371 my $primary_svc = $part_pkg->svcpart;
1372 my $new = new FS::part_pkg { $part_pkg->hash };
1374 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1375 warn "working with class '$class'\n" if $DEBUG;
1376 my $part_pkg_taxproduct =
1377 qsearchs( 'part_pkg_taxproduct',
1378 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1379 data_vendor => $format,
1383 unless ( $part_pkg_taxproduct ) {
1384 return "failed to find part_pkg_taxproduct (".
1385 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1388 if ( $class eq '' ) {
1389 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1393 $options{"usage_taxproductnum_$class"} =
1394 $part_pkg_taxproduct->taxproductnum;
1398 my $error = $new->replace( $part_pkg,
1399 'pkg_svc' => \%pkg_svc,
1400 'primary_svc' => $primary_svc,
1401 'options' => \%options,
1404 return $error if $error;
1411 sub _restore_remembered_disabled_taxes {
1412 my ( $job, $format, $disabled_tax_rate ) = @_;
1414 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1415 my $count = scalar(keys %$disabled_tax_rate);
1416 foreach my $key (keys %$disabled_tax_rate) {
1417 if ( time - $min_sec > $last ) {
1418 $job->update_statustext(
1419 int( 100 * $imported / $count ). ",Disabling tax rates"
1424 my ($geocode,$taxclass) = split /:/, $key, 2;
1425 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1426 taxclass => $taxclass,
1428 return "found multiple tax_class records for format $format class $taxclass"
1429 if scalar(@tax_class) > 1;
1431 unless (scalar(@tax_class)) {
1432 warn "no tax_class for format $format class $taxclass\n";
1437 qsearch('tax_rate', { data_vendor => $format,
1438 geocode => $geocode,
1439 taxclassnum => $tax_class[0]->taxclassnum,
1443 if (scalar(@tax_rate) > 1) {
1444 return "found multiple tax_rate records for format $format geocode ".
1445 "$geocode and taxclass $taxclass ( taxclassnum ".
1446 $tax_class[0]->taxclassnum. " )";
1449 if (scalar(@tax_rate)) {
1450 $tax_rate[0]->disabled('Y');
1451 my $error = $tax_rate[0]->replace;
1452 return $error if $error;
1457 sub _remove_old_tax_data {
1458 my ( $job, $format ) = @_;
1461 my $error = $job->update_statustext( "0,Removing old tax data" );
1462 die $error if $error;
1464 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1465 "WHERE data_vendor = ". $dbh->quote($format);
1466 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1469 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1471 foreach my $table ( @table ) {
1472 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1473 $dbh->quote($format);
1474 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1477 if ( $format eq 'cch' ) {
1478 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1479 $dbh->quote("$format-zip");
1480 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1486 sub _create_temporary_tables {
1487 my ( $job, $format ) = @_;
1490 my $error = $job->update_statustext( "0,Creating temporary tables" );
1491 die $error if $error;
1493 my @table = qw( tax_rate
1500 foreach my $table ( @table ) {
1502 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1503 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1509 sub _copy_from_temp {
1510 my ( $job, $format ) = @_;
1513 my $error = $job->update_statustext( "0,Making permanent" );
1514 die $error if $error;
1516 my @table = qw( tax_rate
1523 foreach my $table ( @table ) {
1525 "INSERT INTO public.$table SELECT * from $table";
1526 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1532 =item process_download_and_reload
1534 Download and process a tax update as a queued JSRPC job after wiping the
1535 existing wipable tax data.
1539 sub process_download_and_reload {
1540 _process_reload('process_download_and_update', @_);
1544 =item process_batch_reload
1546 Load and process a tax update from the provided files as a queued JSRPC job
1547 after wiping the existing wipable tax data.
1551 sub process_batch_reload {
1552 _process_reload('_perform_batch_import', @_);
1556 sub _process_reload {
1557 my ( $method, $job ) = ( shift, shift );
1559 my $param = thaw(decode_base64($_[0]));
1560 my $format = $param->{'format'}; #well... this is all cch specific
1562 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1564 if ( $job ) { # progress bar
1565 my $error = $job->update_statustext( 0 );
1566 die $error if $error;
1569 my $oldAutoCommit = $FS::UID::AutoCommit;
1570 local $FS::UID::AutoCommit = 0;
1575 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1576 "USING (taxclassnum) WHERE data_vendor = '$format'";
1577 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1579 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1580 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1581 if $sth->fetchrow_arrayref->[0];
1583 # really should get a table EXCLUSIVE lock here
1585 #remember disabled taxes
1586 my %disabled_tax_rate = ();
1587 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1589 #remember tax products
1590 my %taxproduct = ();
1591 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1594 $error ||= _create_temporary_tables( $job, $format );
1598 my $args = '$job, @_';
1599 eval "$method($args);";
1603 #restore taxproducts
1604 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1608 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1610 #wipe out the old data
1611 $error ||= _remove_old_tax_data( $job, $format );
1614 $error ||= _copy_from_temp( $job, $format );
1617 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1622 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1626 =item process_download_and_update
1628 Download and process a tax update as a queued JSRPC job
1632 sub process_download_and_update {
1635 my $param = thaw(decode_base64(shift));
1636 my $format = $param->{'format'}; #well... this is all cch specific
1638 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1640 if ( $job ) { # progress bar
1641 my $error = $job->update_statustext( 0);
1642 die $error if $error;
1645 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1646 my $dir = $cache_dir. 'taxdata';
1648 mkdir $dir or die "can't create $dir: $!\n";
1651 if ($format eq 'cch') {
1653 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1655 my $conf = new FS::Conf;
1656 die "direct download of tax data not enabled\n"
1657 unless $conf->exists('taxdatadirectdownload');
1658 my ( $urls, $username, $secret, $states ) =
1659 $conf->config('taxdatadirectdownload');
1660 die "No tax download URL provided. ".
1661 "Did you set the taxdatadirectdownload configuration value?\n"
1669 # really should get a table EXCLUSIVE lock here
1670 # check if initial import or update
1672 # relying on mkdir "$dir.new" as a mutex
1674 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1675 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1676 $sth->execute() or die $sth->errstr;
1677 my $update = $sth->fetchrow_arrayref->[0];
1679 # create cache and/or rotate old tax data
1684 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1685 foreach my $file (readdir($dirh)) {
1686 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1692 for (8, 7, 6, 5, 4, 3, 2, 1) {
1693 if ( -e "$dir.$_" ) {
1694 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1697 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1701 die "can't find previous tax data\n" if $update;
1705 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1707 # fetch and unpack the zip files
1709 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1711 # extract csv files from the dbf files
1713 foreach my $name ( @namelist ) {
1714 _cch_extract_csv_from_dbf( $job, $dir, $name );
1717 # generate the diff files
1720 foreach my $name ( @namelist ) {
1721 my $difffile = "$dir.new/$name.txt";
1723 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1724 die $error if $error;
1725 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1726 my $olddir = $update ? "$dir.1" : "";
1727 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1729 $difffile =~ s/^$cache_dir//;
1730 push @list, "${name}file:$difffile";
1733 # perform the import
1734 local $keep_cch_files = 1;
1735 $param->{uploaded_files} = join( ',', @list );
1736 $param->{format} .= '-update' if $update;
1738 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1740 rename "$dir.new", "$dir"
1741 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1744 die "Unknown format: $format";
1748 =item browse_queries PARAMS
1750 Returns a list consisting of a hashref suited for use as the argument
1751 to qsearch, and sql query string. Each is based on the PARAMS hashref
1752 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1753 from a form. This conveniently creates the query hashref and count_query
1754 string required by the browse and search elements. As a side effect,
1755 the PARAMS hashref is untainted and keys with unexpected values are removed.
1759 sub browse_queries {
1763 'table' => 'tax_rate',
1765 'order_by' => 'ORDER BY geocode, taxclassnum',
1770 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1771 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1773 delete $params->{data_vendor};
1776 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1777 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1778 'geocode LIKE '. dbh->quote($1.'%');
1780 delete $params->{geocode};
1783 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1784 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1787 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1788 ' taxclassnum = '. dbh->quote($1)
1790 delete $params->{taxclassnun};
1794 if ( $params->{tax_type} =~ /^(\d+)$/ );
1795 delete $params->{tax_type}
1799 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1800 delete $params->{tax_cat}
1803 my @taxclassnum = ();
1804 if ($tax_type || $tax_cat ) {
1805 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1806 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1807 @taxclassnum = map { $_->taxclassnum }
1808 qsearch({ 'table' => 'tax_class',
1810 'extra_sql' => "WHERE taxclass $compare",
1814 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1815 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1816 if ( @taxclassnum );
1818 unless ($params->{'showdisabled'}) {
1819 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1820 "( disabled = '' OR disabled IS NULL )";
1823 $query->{extra_sql} = $extra_sql;
1825 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1828 =item queue_liability_report PARAMS
1830 Launches a tax liability report.
1832 PARAMS needs to be a base64-encoded Storable hash containing:
1833 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1834 - end: the end date of the report, likewise.
1835 - agentnum: the agent to limit the report to, if any.
1839 sub queue_liability_report {
1841 my $param = thaw(decode_base64(shift));
1844 $cgi->param('beginning', $param->{beginning});
1845 $cgi->param('ending', $param->{ending});
1846 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1847 my $agentnum = $param->{agentnum};
1848 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1849 generate_liability_report(
1850 'beginning' => $beginning,
1851 'ending' => $ending,
1852 'agentnum' => $agentnum,
1853 'p' => $param->{RootURL},
1858 =item generate_liability_report PARAMS
1860 Generates a tax liability report. PARAMS must include:
1862 - beginning, as a timestamp
1863 - ending, as a timestamp
1864 - p: the Freeside root URL, for generating links
1865 - agentnum (optional)
1869 #shit, all sorts of false laxiness w/report_newtax.cgi
1870 sub generate_liability_report {
1873 my ( $count, $last, $min_sec ) = _progressbar_foo();
1875 #let us open the temp file early
1876 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1877 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1879 UNLINK => 0, # not so temp
1880 ) or die "can't open report file: $!\n";
1882 my $conf = new FS::Conf;
1883 my $money_char = $conf->config('money_char') || '$';
1886 JOIN cust_bill USING ( invnum )
1887 LEFT JOIN cust_main USING ( custnum )
1891 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1892 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1894 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1896 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1899 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1900 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1901 die "agent not found" unless $agent;
1902 $agentname = $agent->agent;
1903 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1906 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1907 my @taxparams = qw( city county state locationtaxid );
1908 my @params = ('itemdesc', @taxparams);
1910 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1912 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1913 #to FS::Report or FS::Record or who the fuck knows where)
1914 my $scalar_sql = sub {
1915 my( $r, $param, $sql ) = @_;
1916 my $sth = dbh->prepare($sql) or die dbh->errstr;
1917 $sth->execute( map $r->$_(), @$param )
1918 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1919 $sth->fetchrow_arrayref->[0] || 0;
1928 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1929 # for taxes that have been charged
1930 # (state, county, city are from tax_rate_location, not from customer data)
1931 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1933 hashref => { pkgpart => 0 },
1934 addl_from => $addl_from,
1935 extra_sql => $where,
1938 $count = scalar(@tax_and_location);
1939 foreach my $t ( @tax_and_location ) {
1942 if ( time - $min_sec > $last ) {
1943 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1950 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1951 my $label = join('~', map { $t->$_ } @params);
1952 $label = 'Tax'. $label if $label =~ /^~/;
1953 unless ( exists( $taxes{$label} ) ) {
1954 my ($baselabel, @trash) = split /~/, $label;
1956 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1957 $taxes{$label}->{'url_param'} =
1958 join(';', map { "$_=". uri_escape($t->$_) } @params);
1961 # " payby != 'COMP' ". # breaks the entire report under 4.x
1962 # # and unnecessary since COMP accounts don't
1963 # # get taxes calculated in the first place
1964 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1965 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1970 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1972 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1974 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1976 $taxes{$label}->{'tax'} += $x;
1979 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1981 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
1983 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1984 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1986 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1988 $taxes{$label}->{'credit'} += $y;
1990 unless ( exists( $taxes{$baselabel} ) ) {
1992 $basetaxes{$baselabel}->{'label'} = $baselabel;
1993 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1994 $basetaxes{$baselabel}->{'base'} = 1;
1998 $basetaxes{$baselabel}->{'tax'} += $x;
1999 $basetaxes{$baselabel}->{'credit'} += $y;
2003 # calculate customer-exemption for this tax
2004 # calculate package-exemption for this tax
2005 # calculate monthly exemption (texas tax) for this tax
2006 # count up all the cust_tax_exempt_pkg records associated with
2007 # the actual line items.
2014 $args{job}->update_statustext( "0,Sorted" );
2020 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2021 my ($base, @trash) = split '~', $tax;
2022 my $basetax = delete( $basetaxes{$base} );
2024 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2025 $taxes{$tax}->{base} = 1;
2027 push @taxes, $basetax;
2030 push @taxes, $taxes{$tax};
2037 'credit' => $credit,
2042 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2043 $dateagentlink .= ';agentnum='. $args{agentnum}
2044 if length($agentname);
2045 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2047 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2049 print $report <<EOF;
2051 <% include("/elements/header.html", "$agentname Tax Report - ".
2053 ? time2str('%h %o %Y ', $args{beginning} )
2057 ( $args{ending} == 4294967295
2059 : time2str('%h %o %Y', $args{ending} )
2064 <% include('/elements/table-grid.html') %>
2067 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2068 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2069 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2070 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2071 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2072 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2076 my $bgcolor1 = '#eeeeee';
2077 my $bgcolor2 = '#ffffff';
2080 $count = scalar(@taxes);
2082 foreach my $tax ( @taxes ) {
2085 if ( time - $min_sec > $last ) {
2086 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2093 if ( $bgcolor eq $bgcolor1 ) {
2094 $bgcolor = $bgcolor2;
2096 $bgcolor = $bgcolor1;
2100 if ( $tax->{'label'} ne 'Total' ) {
2101 $link = ';'. $tax->{'url_param'};
2104 print $report <<EOF;
2106 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2107 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2108 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2109 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2111 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2112 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2113 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2114 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2115 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2117 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2122 print $report <<EOF;
2129 my $reportname = $report->filename;
2132 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2133 $reportname =~ s/^$dropstring//;
2135 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2136 die "<a href=$reporturl>view</a>\n";
2146 Mixing automatic and manual editing works poorly at present.
2148 Tax liability calculations take too long and arguably don't belong here.
2149 Tax liability report generation not entirely safe (escaped).
2153 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>