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 # XXX these are non-functional, and most of them are horrible to implement
296 # in our current model
298 %tax_maxtypes = ( '0' => 'receipts per invoice',
299 '1' => 'receipts per item',
300 '2' => 'total utility charges per utility tax year',
301 '3' => 'total charges per utility tax year',
302 '4' => 'receipts per access line',
303 '7' => 'total utility charges per calendar year',
304 '9' => 'monthly receipts per location',
305 '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
306 '11' => 'receipts/units per access line',
307 '14' => 'units per invoice',
308 '15' => 'units per month',
309 '18' => 'units per account',
314 $tax_maxtypes{$self->maxtype};
319 Returns the human understandable value associated with the basetype column
323 %tax_basetypes = ( '0' => 'sale price',
324 '1' => 'gross receipts',
325 '2' => 'sales taxable telecom revenue',
326 '3' => 'minutes carried',
327 '4' => 'minutes billed',
328 '5' => 'gross operating revenue',
329 '6' => 'access line',
331 '8' => 'gross revenue',
332 '9' => 'portion gross receipts attributable to interstate service',
333 '10' => 'access line',
334 '11' => 'gross profits',
335 '12' => 'tariff rate',
337 '15' => 'prior year gross receipts',
342 $tax_basetypes{$self->basetype};
347 Returns the human understandable value associated with the taxauth column
351 %tax_authorities = ( '0' => 'federal',
356 '5' => 'county administered by state',
357 '6' => 'city administered by state',
358 '7' => 'city administered by county',
359 '8' => 'local administered by state',
360 '9' => 'local administered by county',
365 $tax_authorities{$self->taxauth};
370 Returns the human understandable value associated with the passtype column
374 %tax_passtypes = ( '0' => 'separate tax line',
375 '1' => 'separate surcharge line',
376 '2' => 'surcharge not separated',
377 '3' => 'included in base rate',
382 $tax_passtypes{$self->passtype};
385 =item taxline TAXABLES
387 Returns a listref of a name and an amount of tax calculated for the list
388 of packages/amounts referenced by TAXABLES. If an error occurs, a message
389 is returned as a scalar.
395 # this used to accept a hash of options but none of them did anything
396 # so it's been removed.
400 if (ref($_[0]) eq 'ARRAY') {
404 #exemptions would be broken in this case
407 my $name = $self->taxname;
408 $name = 'Other surcharges'
409 if ($self->passtype == 2);
412 if ( $self->disabled ) { # we always know how to handle disabled taxes
419 my $taxable_charged = 0;
420 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
423 warn "calculating taxes for ". $self->taxnum. " on ".
424 join (",", map { $_->pkgnum } @cust_bill_pkg)
427 if ($self->passflag eq 'N') {
428 # return "fatal: can't (yet) handle taxes not passed to the customer";
429 # until someone needs to track these in freeside
436 my $maxtype = $self->maxtype || 0;
437 if ($maxtype != 0 && $maxtype != 1
438 && $maxtype != 14 && $maxtype != 15) {
439 return $self->_fatal_or_null( 'tax with "'.
440 $self->maxtype_name. '" threshold'
442 } # I don't know why, it's not like there are maxtypes that we DO support
444 # we treat gross revenue as gross receipts and expect the tax data
445 # to DTRT (i.e. tax on tax rules)
446 if ($self->basetype != 0 && $self->basetype != 1 &&
447 $self->basetype != 5 && $self->basetype != 6 &&
448 $self->basetype != 7 && $self->basetype != 8 &&
449 $self->basetype != 14
452 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
455 unless ($self->setuptax =~ /^Y$/i) {
456 $taxable_charged += $_->setup foreach @cust_bill_pkg;
458 unless ($self->recurtax =~ /^Y$/i) {
459 $taxable_charged += $_->recur foreach @cust_bill_pkg;
462 my $taxable_units = 0;
463 unless ($self->recurtax =~ /^Y$/i) {
465 if (( $self->unittype || 0 ) == 0) { #access line
467 foreach (@cust_bill_pkg) {
468 $taxable_units += $_->units
469 unless $seen{$_->pkgnum}++;
472 } elsif ($self->unittype == 1) { #minute
473 return $self->_fatal_or_null( 'fee with minute unit type' );
475 } elsif ($self->unittype == 2) { #account
477 my $conf = new FS::Conf;
478 if ( $conf->exists('tax-pkg_address') ) {
479 #number of distinct locations
481 foreach (@cust_bill_pkg) {
483 unless $seen{$_->cust_pkg->locationnum}++;
490 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
495 # XXX handle excessrate (use_excessrate) / excessfee /
496 # taxbase/feebase / taxmax/feemax
497 # and eventually exemptions
499 # the tax or fee is applied to taxbase or feebase and then
500 # the excessrate or excess fee is applied to taxmax or feemax
502 if ( ($self->taxmax > 0 and $taxable_charged > $self->taxmax) or
503 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
505 # (why not just cap taxable_charged/units at the taxmax/feemax? because
506 # it's way more complicated than that. this won't even catch every case
507 # where a bracket maximum should apply.)
508 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
511 $amount += $taxable_charged * $self->tax;
512 $amount += $taxable_units * $self->fee;
514 warn "calculated taxes as [ $name, $amount ]\n"
525 my ($self, $error) = @_;
527 $DB::single = 1; # not a mistake
529 my $conf = new FS::Conf;
531 $error = "can't yet handle ". $error;
532 my $name = $self->taxname;
533 $name = 'Other surcharges'
534 if ($self->passtype == 2);
536 if ($conf->exists('ignore_incalculable_taxes')) {
537 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
538 return { name => $name, amount => 0 };
540 return "fatal: $error";
544 =item tax_on_tax CUST_LOCATION
546 Returns a list of taxes which are candidates for taxing taxes for the
547 given service location (see L<FS::cust_location>)
555 my $cust_location = shift;
557 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
558 $cust_location->custnum
561 my $geocode = $cust_location->geocode($self->data_vendor);
565 my $extra_sql = ' AND ('.
566 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
571 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
572 my $select = 'DISTINCT ON(taxclassnum) *';
574 # should qsearch preface columns with the table to facilitate joins?
575 my @taxclassnums = map { $_->taxclassnum }
576 qsearch( { 'table' => 'part_pkg_taxrate',
578 'hashref' => { 'data_vendor' => $self->data_vendor,
579 'taxclassnumtaxed' => $self->taxclassnum,
581 'extra_sql' => $extra_sql,
582 'order_by' => $order_by,
585 return () unless @taxclassnums;
588 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
590 qsearch({ 'table' => 'tax_rate',
591 'hashref' => { 'geocode' => $geocode, },
592 'extra_sql' => $extra_sql,
597 =item tax_rate_location
599 Returns an object representing the location associated with this tax
600 (see L<FS::tax_rate_location>)
604 sub tax_rate_location {
607 qsearchs({ 'table' => 'tax_rate_location',
608 'hashref' => { 'data_vendor' => $self->data_vendor,
609 'geocode' => $self->geocode,
613 new FS::tax_rate_location;
627 sub _progressbar_foo {
632 my ($param, $job) = @_;
634 my $fh = $param->{filehandle};
635 my $format = $param->{'format'};
643 my @column_lengths = ();
644 my @column_callbacks = ();
645 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
646 $format =~ s/-fixed//;
647 my $date_format = sub { my $r='';
648 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
651 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
652 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 );
653 push @column_lengths, 1 if $format eq 'cch-update';
654 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
655 $column_callbacks[8] = $date_format;
659 my ( $count, $last, $min_sec ) = _progressbar_foo();
660 if ( $job || scalar(@column_callbacks) ) {
662 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
663 return $error if $error;
667 if ( $format eq 'cch' || $format eq 'cch-update' ) {
668 #false laziness w/below (sub _perform_cch_diff)
669 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
670 excessrate effective_date taxauth taxtype taxcat taxname
671 usetax useexcessrate fee unittype feemax maxtype passflag
673 push @fields, 'actionflag' if $format eq 'cch-update';
678 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
679 $hash->{'data_vendor'} ='cch';
680 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
681 time_zone => 'floating',
683 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
684 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
686 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
687 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
690 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
692 my %tax_class = ( 'data_vendor' => 'cch',
693 'taxclass' => $taxclassid,
696 my $tax_class = qsearchs( 'tax_class', \%tax_class );
697 return "Error updating tax rate: no tax class $taxclassid"
700 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
702 foreach (qw( taxtype taxcat )) {
706 my %passflagmap = ( '0' => '',
710 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
711 if exists $passflagmap{$hash->{'passflag'}};
713 foreach (keys %$hash) {
714 $hash->{$_} = substr($hash->{$_}, 0, 80)
715 if length($hash->{$_}) > 80;
718 my $actionflag = delete($hash->{'actionflag'});
720 $hash->{'taxname'} =~ s/`/'/g;
721 $hash->{'taxname'} =~ s|\\|/|g;
723 return '' if $format eq 'cch'; # but not cch-update
725 if ($actionflag eq 'I') {
726 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
727 }elsif ($actionflag eq 'D') {
728 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
730 return "Unexpected action flag: ". $hash->{'actionflag'};
733 delete($hash->{$_}) for keys %$hash;
739 } elsif ( $format eq 'extended' ) {
740 die "unimplemented\n";
744 die "unknown format $format";
747 my $csv = new Text::CSV_XS;
751 local $SIG{HUP} = 'IGNORE';
752 local $SIG{INT} = 'IGNORE';
753 local $SIG{QUIT} = 'IGNORE';
754 local $SIG{TERM} = 'IGNORE';
755 local $SIG{TSTP} = 'IGNORE';
756 local $SIG{PIPE} = 'IGNORE';
758 my $oldAutoCommit = $FS::UID::AutoCommit;
759 local $FS::UID::AutoCommit = 0;
762 while ( defined($line=<$fh>) ) {
763 $csv->parse($line) or do {
764 $dbh->rollback if $oldAutoCommit;
765 return "can't parse: ". $csv->error_input();
768 if ( $job ) { # progress bar
769 if ( time - $min_sec > $last ) {
770 my $error = $job->update_statustext(
771 int( 100 * $imported / $count ). ",Importing tax rates"
774 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
781 my @columns = $csv->fields();
783 my %tax_rate = ( 'data_vendor' => $format );
784 foreach my $field ( @fields ) {
785 $tax_rate{$field} = shift @columns;
788 if ( scalar( @columns ) ) {
789 $dbh->rollback if $oldAutoCommit;
790 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
793 my $error = &{$hook}(\%tax_rate);
795 $dbh->rollback if $oldAutoCommit;
799 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
801 my $tax_rate = new FS::tax_rate( \%tax_rate );
802 $error = $tax_rate->insert;
805 $dbh->rollback if $oldAutoCommit;
806 return "can't insert tax_rate for $line: $error";
815 my @replace = grep { exists($delete{$_}) } keys %insert;
817 if ( $job ) { # progress bar
818 if ( time - $min_sec > $last ) {
819 my $error = $job->update_statustext(
820 int( 100 * $imported / $count ). ",Importing tax rates"
823 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
830 my $old = qsearchs( 'tax_rate', $delete{$_} );
834 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
835 $new->taxnum($old->taxnum);
836 my $error = $new->replace($old);
839 $dbh->rollback if $oldAutoCommit;
840 my $hashref = $insert{$_};
841 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
842 return "can't replace tax_rate for $line: $error";
849 $old = delete $delete{$_};
850 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
851 #join(" ", map { "$_ => ". $old->{$_} } @fields);
852 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
858 for (grep { !exists($delete{$_}) } keys %insert) {
859 if ( $job ) { # progress bar
860 if ( time - $min_sec > $last ) {
861 my $error = $job->update_statustext(
862 int( 100 * $imported / $count ). ",Importing tax rates"
865 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
872 my $tax_rate = new FS::tax_rate( $insert{$_} );
873 my $error = $tax_rate->insert;
876 $dbh->rollback if $oldAutoCommit;
877 my $hashref = $insert{$_};
878 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
879 return "can't insert tax_rate for $line: $error";
885 for (grep { !exists($insert{$_}) } keys %delete) {
886 if ( $job ) { # progress bar
887 if ( time - $min_sec > $last ) {
888 my $error = $job->update_statustext(
889 int( 100 * $imported / $count ). ",Importing tax rates"
892 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
899 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
901 $dbh->rollback if $oldAutoCommit;
902 $tax_rate = $delete{$_};
903 warn "WARNING: can't find tax_rate to delete for: ".
904 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
907 my $error = $tax_rate->delete; # XXX we really should not do this
908 # (it orphans CBPTRL records)
911 $dbh->rollback if $oldAutoCommit;
912 my $hashref = $delete{$_};
913 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
914 return "can't delete tax_rate for $line: $error";
921 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
923 return "Empty file!" unless ($imported || $format eq 'cch-update');
929 =item process_batch_import
931 Load a batch import as a queued JSRPC job
935 sub process_batch_import {
938 my $oldAutoCommit = $FS::UID::AutoCommit;
939 local $FS::UID::AutoCommit = 0;
942 my $param = thaw(decode_base64(shift));
943 my $args = '$job, encode_base64( nfreeze( $param ) )';
945 my $method = '_perform_batch_import';
946 if ( $param->{reload} ) {
947 $method = 'process_batch_reload';
950 eval "$method($args);";
952 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
957 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
960 sub _perform_batch_import {
963 my $param = thaw(decode_base64(shift));
964 my $format = $param->{'format'}; #well... this is all cch specific
966 my $files = $param->{'uploaded_files'}
967 or die "No files provided.";
969 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
972 if ( $format eq 'cch' || $format eq 'cch-fixed'
973 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
976 my $oldAutoCommit = $FS::UID::AutoCommit;
977 local $FS::UID::AutoCommit = 0;
980 my @insert_list = ();
981 my @delete_list = ();
982 my @predelete_list = ();
985 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
987 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
988 'CODE', \&FS::tax_class::batch_import,
989 'PLUS4', \&FS::cust_tax_location::batch_import,
990 'ZIP', \&FS::cust_tax_location::batch_import,
991 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
992 'DETAIL', \&FS::tax_rate::batch_import,
994 while( scalar(@list) ) {
995 my ( $name, $import_sub ) = splice( @list, 0, 2 );
996 my $file = lc($name). 'file';
998 unless ($files{$file}) {
999 #$error = "No $name supplied";
1002 next if $name eq 'DETAIL' && $format =~ /update/;
1004 my $filename = "$dir/". $files{$file};
1006 if ( $format =~ /update/ ) {
1008 ( $error, $insertname, $deletename ) =
1009 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1013 unlink $filename or warn "Can't delete $filename: $!"
1014 unless $keep_cch_files;
1015 push @insert_list, $name, $insertname, $import_sub, $format;
1016 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1017 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1019 unshift @delete_list, $name, $deletename, $import_sub, $format;
1024 push @insert_list, $name, $filename, $import_sub, $format;
1031 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1032 if $format =~ /update/;
1034 my %addl_param = ();
1035 if ( $param->{'delete_only'} ) {
1036 $addl_param{'delete_only'} = $param->{'delete_only'};
1040 $error ||= _perform_cch_tax_import( $job,
1041 [ @predelete_list ],
1048 @list = ( @predelete_list, @insert_list, @delete_list );
1049 while( !$keep_cch_files && scalar(@list) ) {
1050 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1051 unlink $file or warn "Can't delete $file: $!";
1055 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1058 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1062 die "Unknown format: $format";
1068 sub _perform_cch_tax_import {
1069 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1073 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1074 while( scalar(@$list) ) {
1075 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1076 my $fmt = "$format-update";
1077 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1078 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1079 my $param = { 'filehandle' => $fh,
1083 $error ||= &{$method}($param, $job);
1091 sub _perform_cch_insert_delete_split {
1092 my ($name, $filename, $dir, $format) = @_;
1096 open my $fh, "< $filename"
1097 or $error ||= "Can't open $name file $filename: $!";
1099 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1102 ) or die "can't open temp file: $!\n";
1103 my $insertname = $ifh->filename;
1105 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1108 ) or die "can't open temp file: $!\n";
1109 my $deletename = $dfh->filename;
1111 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1112 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1115 $handle = $ifh if $_ =~ /$insert_pattern/;
1116 $handle = $dfh if $_ =~ /$delete_pattern/;
1118 $error = "bad input line: $_" unless $handle;
1127 return ($error, $insertname, $deletename);
1130 sub _perform_cch_diff {
1131 my ($name, $newdir, $olddir) = @_;
1136 open my $oldcsvfh, "$olddir/$name.txt"
1137 or die "failed to open $olddir/$name.txt: $!\n";
1139 while(<$oldcsvfh>) {
1146 open my $newcsvfh, "$newdir/$name.txt"
1147 or die "failed to open $newdir/$name.txt: $!\n";
1149 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1152 ) or die "can't open temp file: $!\n";
1153 my $diffname = $dfh->filename;
1155 while(<$newcsvfh>) {
1157 if (exists($oldlines{$_})) {
1160 print $dfh $_, ',"I"', "\n";
1165 #false laziness w/above (sub batch_import)
1166 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1167 excessrate effective_date taxauth taxtype taxcat taxname
1168 usetax useexcessrate fee unittype feemax maxtype passflag
1169 passtype basetype );
1170 my $numfields = scalar(@fields);
1172 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1174 for my $line (grep $oldlines{$_}, keys %oldlines) {
1176 $csv->parse($line) or do {
1177 #$dbh->rollback if $oldAutoCommit;
1178 die "can't parse: ". $csv->error_input();
1180 my @columns = $csv->fields();
1182 $csv->combine( splice(@columns, 0, $numfields) );
1184 print $dfh $csv->string, ',"D"', "\n";
1192 sub _cch_fetch_and_unzip {
1193 my ( $job, $urls, $secret, $dir ) = @_;
1195 my $ua = new LWP::UserAgent;
1196 foreach my $url (split ',', $urls) {
1197 my @name = split '/', $url; #somewhat restrictive
1198 my $name = pop @name;
1199 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1202 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1204 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1205 my $res = $ua->request(
1206 new HTTP::Request( GET => $url ),
1208 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1209 my $content_length = $_[1]->content_length;
1210 $imported += length($_[0]);
1211 if ( time - $min_sec > $last ) {
1212 my $error = $job->update_statustext(
1213 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1214 ",Downloading data from CCH"
1216 die $error if $error;
1221 die "download of $url failed: ". $res->status_line
1222 unless $res->is_success;
1225 my $error = $job->update_statustext( "0,Unpacking data" );
1226 die $error if $error;
1227 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1229 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1230 or die "unzip -P $secret -d $dir $dir/$name failed";
1231 #unlink "$dir/$name";
1235 sub _cch_extract_csv_from_dbf {
1236 my ( $job, $dir, $name ) = @_;
1241 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1242 my $error = $job->update_statustext( "0,Unpacking $name" );
1243 die $error if $error;
1244 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1245 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1246 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1247 unless defined($table);
1248 my $count = $table->last_record; # approximately;
1249 open my $csvfh, ">$dir.new/$name.txt"
1250 or die "failed to open $dir.new/$name.txt: $!\n";
1252 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1253 my @fields = $table->field_names;
1254 my $cursor = $table->prepare_select;
1256 sub { my $date = shift;
1257 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1260 while (my $row = $cursor->fetch_hashref) {
1261 $csv->combine( map { my $type = $table->field_type($_);
1263 &{$format_date}($row->{$_}) ;
1264 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1265 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1272 print $csvfh $csv->string, "\n";
1274 if ( time - $min_sec > $last ) {
1275 my $error = $job->update_statustext(
1276 int(100 * $imported/$count). ",Unpacking $name"
1278 die $error if $error;
1286 sub _remember_disabled_taxes {
1287 my ( $job, $format, $disabled_tax_rate ) = @_;
1291 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1293 my @items = qsearch( { table => 'tax_rate',
1294 hashref => { disabled => 'Y',
1295 data_vendor => $format,
1297 select => 'geocode, taxclassnum',
1300 my $count = scalar(@items);
1301 foreach my $tax_rate ( @items ) {
1302 if ( time - $min_sec > $last ) {
1303 $job->update_statustext(
1304 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1310 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1311 unless ( $tax_class ) {
1312 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1315 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1319 sub _remember_tax_products {
1320 my ( $job, $format, $taxproduct ) = @_;
1322 # XXX FIXME this loop only works when cch is the only data provider
1324 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1326 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1327 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1328 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1329 " optionname LIKE 'usage_taxproductnum_%' AND ".
1330 " optionvalue != '' )";
1331 my @items = qsearch( { table => 'part_pkg',
1332 select => 'DISTINCT pkgpart,taxproductnum',
1334 extra_sql => $extra_sql,
1337 my $count = scalar(@items);
1338 foreach my $part_pkg ( @items ) {
1339 if ( time - $min_sec > $last ) {
1340 $job->update_statustext(
1341 int( 100 * $imported / $count ). ",Remembering tax products"
1346 warn "working with package part ". $part_pkg->pkgpart.
1347 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1348 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1349 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1350 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1352 foreach my $option ( $part_pkg->part_pkg_option ) {
1353 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1356 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1357 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1358 $part_pkg_taxproduct->taxproduct
1359 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1364 sub _restore_remembered_tax_products {
1365 my ( $job, $format, $taxproduct ) = @_;
1369 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1370 my $count = scalar(keys %$taxproduct);
1371 foreach my $pkgpart ( keys %$taxproduct ) {
1372 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1373 if ( time - $min_sec > $last ) {
1374 $job->update_statustext(
1375 int( 100 * $imported / $count ). ",Restoring tax products"
1381 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1382 unless ( $part_pkg ) {
1383 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1386 my %options = $part_pkg->options;
1387 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1388 my $primary_svc = $part_pkg->svcpart;
1389 my $new = new FS::part_pkg { $part_pkg->hash };
1391 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1392 warn "working with class '$class'\n" if $DEBUG;
1393 my $part_pkg_taxproduct =
1394 qsearchs( 'part_pkg_taxproduct',
1395 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1396 data_vendor => $format,
1400 unless ( $part_pkg_taxproduct ) {
1401 return "failed to find part_pkg_taxproduct (".
1402 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1405 if ( $class eq '' ) {
1406 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1410 $options{"usage_taxproductnum_$class"} =
1411 $part_pkg_taxproduct->taxproductnum;
1415 my $error = $new->replace( $part_pkg,
1416 'pkg_svc' => \%pkg_svc,
1417 'primary_svc' => $primary_svc,
1418 'options' => \%options,
1421 return $error if $error;
1428 sub _restore_remembered_disabled_taxes {
1429 my ( $job, $format, $disabled_tax_rate ) = @_;
1431 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1432 my $count = scalar(keys %$disabled_tax_rate);
1433 foreach my $key (keys %$disabled_tax_rate) {
1434 if ( time - $min_sec > $last ) {
1435 $job->update_statustext(
1436 int( 100 * $imported / $count ). ",Disabling tax rates"
1441 my ($geocode,$taxclass) = split /:/, $key, 2;
1442 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1443 taxclass => $taxclass,
1445 return "found multiple tax_class records for format $format class $taxclass"
1446 if scalar(@tax_class) > 1;
1448 unless (scalar(@tax_class)) {
1449 warn "no tax_class for format $format class $taxclass\n";
1454 qsearch('tax_rate', { data_vendor => $format,
1455 geocode => $geocode,
1456 taxclassnum => $tax_class[0]->taxclassnum,
1460 if (scalar(@tax_rate) > 1) {
1461 return "found multiple tax_rate records for format $format geocode ".
1462 "$geocode and taxclass $taxclass ( taxclassnum ".
1463 $tax_class[0]->taxclassnum. " )";
1466 if (scalar(@tax_rate)) {
1467 $tax_rate[0]->disabled('Y');
1468 my $error = $tax_rate[0]->replace;
1469 return $error if $error;
1474 sub _remove_old_tax_data {
1475 my ( $job, $format ) = @_;
1478 my $error = $job->update_statustext( "0,Removing old tax data" );
1479 die $error if $error;
1481 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1482 "WHERE data_vendor = ". $dbh->quote($format);
1483 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1486 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1488 foreach my $table ( @table ) {
1489 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1490 $dbh->quote($format);
1491 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1494 if ( $format eq 'cch' ) {
1495 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1496 $dbh->quote("$format-zip");
1497 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1503 sub _create_temporary_tables {
1504 my ( $job, $format ) = @_;
1507 my $error = $job->update_statustext( "0,Creating temporary tables" );
1508 die $error if $error;
1510 my @table = qw( tax_rate
1517 foreach my $table ( @table ) {
1519 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1520 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1526 sub _copy_from_temp {
1527 my ( $job, $format ) = @_;
1530 my $error = $job->update_statustext( "0,Making permanent" );
1531 die $error if $error;
1533 my @table = qw( tax_rate
1540 foreach my $table ( @table ) {
1542 "INSERT INTO public.$table SELECT * from $table";
1543 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1549 =item process_download_and_reload
1551 Download and process a tax update as a queued JSRPC job after wiping the
1552 existing wipable tax data.
1556 sub process_download_and_reload {
1557 _process_reload('process_download_and_update', @_);
1561 =item process_batch_reload
1563 Load and process a tax update from the provided files as a queued JSRPC job
1564 after wiping the existing wipable tax data.
1568 sub process_batch_reload {
1569 _process_reload('_perform_batch_import', @_);
1573 sub _process_reload {
1574 my ( $method, $job ) = ( shift, shift );
1576 my $param = thaw(decode_base64($_[0]));
1577 my $format = $param->{'format'}; #well... this is all cch specific
1579 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1581 if ( $job ) { # progress bar
1582 my $error = $job->update_statustext( 0 );
1583 die $error if $error;
1586 my $oldAutoCommit = $FS::UID::AutoCommit;
1587 local $FS::UID::AutoCommit = 0;
1592 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1593 "USING (taxclassnum) WHERE data_vendor = '$format'";
1594 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1596 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1597 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1598 if $sth->fetchrow_arrayref->[0];
1600 # really should get a table EXCLUSIVE lock here
1602 #remember disabled taxes
1603 my %disabled_tax_rate = ();
1604 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1606 #remember tax products
1607 my %taxproduct = ();
1608 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1611 $error ||= _create_temporary_tables( $job, $format );
1615 my $args = '$job, @_';
1616 eval "$method($args);";
1620 #restore taxproducts
1621 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1625 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1627 #wipe out the old data
1628 $error ||= _remove_old_tax_data( $job, $format );
1631 $error ||= _copy_from_temp( $job, $format );
1634 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1639 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1643 =item process_download_and_update
1645 Download and process a tax update as a queued JSRPC job
1649 sub process_download_and_update {
1652 my $param = thaw(decode_base64(shift));
1653 my $format = $param->{'format'}; #well... this is all cch specific
1655 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1657 if ( $job ) { # progress bar
1658 my $error = $job->update_statustext( 0);
1659 die $error if $error;
1662 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1663 my $dir = $cache_dir. 'taxdata';
1665 mkdir $dir or die "can't create $dir: $!\n";
1668 if ($format eq 'cch') {
1670 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1672 my $conf = new FS::Conf;
1673 die "direct download of tax data not enabled\n"
1674 unless $conf->exists('taxdatadirectdownload');
1675 my ( $urls, $username, $secret, $states ) =
1676 $conf->config('taxdatadirectdownload');
1677 die "No tax download URL provided. ".
1678 "Did you set the taxdatadirectdownload configuration value?\n"
1686 # really should get a table EXCLUSIVE lock here
1687 # check if initial import or update
1689 # relying on mkdir "$dir.new" as a mutex
1691 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1692 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1693 $sth->execute() or die $sth->errstr;
1694 my $update = $sth->fetchrow_arrayref->[0];
1696 # create cache and/or rotate old tax data
1701 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1702 foreach my $file (readdir($dirh)) {
1703 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1709 for (8, 7, 6, 5, 4, 3, 2, 1) {
1710 if ( -e "$dir.$_" ) {
1711 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1714 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1718 die "can't find previous tax data\n" if $update;
1722 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1724 # fetch and unpack the zip files
1726 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1728 # extract csv files from the dbf files
1730 foreach my $name ( @namelist ) {
1731 _cch_extract_csv_from_dbf( $job, $dir, $name );
1734 # generate the diff files
1737 foreach my $name ( @namelist ) {
1738 my $difffile = "$dir.new/$name.txt";
1740 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1741 die $error if $error;
1742 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1743 my $olddir = $update ? "$dir.1" : "";
1744 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1746 $difffile =~ s/^$cache_dir//;
1747 push @list, "${name}file:$difffile";
1750 # perform the import
1751 local $keep_cch_files = 1;
1752 $param->{uploaded_files} = join( ',', @list );
1753 $param->{format} .= '-update' if $update;
1755 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1757 rename "$dir.new", "$dir"
1758 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1761 die "Unknown format: $format";
1765 =item browse_queries PARAMS
1767 Returns a list consisting of a hashref suited for use as the argument
1768 to qsearch, and sql query string. Each is based on the PARAMS hashref
1769 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1770 from a form. This conveniently creates the query hashref and count_query
1771 string required by the browse and search elements. As a side effect,
1772 the PARAMS hashref is untainted and keys with unexpected values are removed.
1776 sub browse_queries {
1780 'table' => 'tax_rate',
1782 'order_by' => 'ORDER BY geocode, taxclassnum',
1787 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1788 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1790 delete $params->{data_vendor};
1793 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1794 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1795 'geocode LIKE '. dbh->quote($1.'%');
1797 delete $params->{geocode};
1800 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1801 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1804 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1805 ' taxclassnum = '. dbh->quote($1)
1807 delete $params->{taxclassnun};
1811 if ( $params->{tax_type} =~ /^(\d+)$/ );
1812 delete $params->{tax_type}
1816 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1817 delete $params->{tax_cat}
1820 my @taxclassnum = ();
1821 if ($tax_type || $tax_cat ) {
1822 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1823 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1824 @taxclassnum = map { $_->taxclassnum }
1825 qsearch({ 'table' => 'tax_class',
1827 'extra_sql' => "WHERE taxclass $compare",
1831 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1832 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1833 if ( @taxclassnum );
1835 unless ($params->{'showdisabled'}) {
1836 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1837 "( disabled = '' OR disabled IS NULL )";
1840 $query->{extra_sql} = $extra_sql;
1842 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1845 =item queue_liability_report PARAMS
1847 Launches a tax liability report.
1849 PARAMS needs to be a base64-encoded Storable hash containing:
1850 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1851 - end: the end date of the report, likewise.
1852 - agentnum: the agent to limit the report to, if any.
1856 sub queue_liability_report {
1858 my $param = thaw(decode_base64(shift));
1861 $cgi->param('beginning', $param->{beginning});
1862 $cgi->param('ending', $param->{ending});
1863 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1864 my $agentnum = $param->{agentnum};
1865 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1866 generate_liability_report(
1867 'beginning' => $beginning,
1868 'ending' => $ending,
1869 'agentnum' => $agentnum,
1870 'p' => $param->{RootURL},
1875 =item generate_liability_report PARAMS
1877 Generates a tax liability report. PARAMS must include:
1879 - beginning, as a timestamp
1880 - ending, as a timestamp
1881 - p: the Freeside root URL, for generating links
1882 - agentnum (optional)
1886 #shit, all sorts of false laxiness w/report_newtax.cgi
1887 sub generate_liability_report {
1890 my ( $count, $last, $min_sec ) = _progressbar_foo();
1892 #let us open the temp file early
1893 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1894 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1896 UNLINK => 0, # not so temp
1897 ) or die "can't open report file: $!\n";
1899 my $conf = new FS::Conf;
1900 my $money_char = $conf->config('money_char') || '$';
1903 JOIN cust_bill USING ( invnum )
1904 LEFT JOIN cust_main USING ( custnum )
1908 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1909 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1911 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1913 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1916 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1917 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1918 die "agent not found" unless $agent;
1919 $agentname = $agent->agent;
1920 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1923 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1924 my @taxparams = qw( city county state locationtaxid );
1925 my @params = ('itemdesc', @taxparams);
1927 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1929 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1930 #to FS::Report or FS::Record or who the fuck knows where)
1931 my $scalar_sql = sub {
1932 my( $r, $param, $sql ) = @_;
1933 my $sth = dbh->prepare($sql) or die dbh->errstr;
1934 $sth->execute( map $r->$_(), @$param )
1935 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1936 $sth->fetchrow_arrayref->[0] || 0;
1945 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1946 # for taxes that have been charged
1947 # (state, county, city are from tax_rate_location, not from customer data)
1948 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1950 hashref => { pkgpart => 0 },
1951 addl_from => $addl_from,
1952 extra_sql => $where,
1955 $count = scalar(@tax_and_location);
1956 foreach my $t ( @tax_and_location ) {
1959 if ( time - $min_sec > $last ) {
1960 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1967 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1968 my $label = join('~', map { $t->$_ } @params);
1969 $label = 'Tax'. $label if $label =~ /^~/;
1970 unless ( exists( $taxes{$label} ) ) {
1971 my ($baselabel, @trash) = split /~/, $label;
1973 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1974 $taxes{$label}->{'url_param'} =
1975 join(';', map { "$_=". uri_escape($t->$_) } @params);
1978 # " payby != 'COMP' ". # breaks the entire report under 4.x
1979 # # and unnecessary since COMP accounts don't
1980 # # get taxes calculated in the first place
1981 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1982 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1987 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1989 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1991 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1993 $taxes{$label}->{'tax'} += $x;
1996 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1998 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2000 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2001 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2003 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2005 $taxes{$label}->{'credit'} += $y;
2007 unless ( exists( $taxes{$baselabel} ) ) {
2009 $basetaxes{$baselabel}->{'label'} = $baselabel;
2010 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2011 $basetaxes{$baselabel}->{'base'} = 1;
2015 $basetaxes{$baselabel}->{'tax'} += $x;
2016 $basetaxes{$baselabel}->{'credit'} += $y;
2020 # calculate customer-exemption for this tax
2021 # calculate package-exemption for this tax
2022 # calculate monthly exemption (texas tax) for this tax
2023 # count up all the cust_tax_exempt_pkg records associated with
2024 # the actual line items.
2031 $args{job}->update_statustext( "0,Sorted" );
2037 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2038 my ($base, @trash) = split '~', $tax;
2039 my $basetax = delete( $basetaxes{$base} );
2041 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2042 $taxes{$tax}->{base} = 1;
2044 push @taxes, $basetax;
2047 push @taxes, $taxes{$tax};
2054 'credit' => $credit,
2059 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2060 $dateagentlink .= ';agentnum='. $args{agentnum}
2061 if length($agentname);
2062 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2064 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2066 print $report <<EOF;
2068 <% include("/elements/header.html", "$agentname Tax Report - ".
2070 ? time2str('%h %o %Y ', $args{beginning} )
2074 ( $args{ending} == 4294967295
2076 : time2str('%h %o %Y', $args{ending} )
2081 <% include('/elements/table-grid.html') %>
2084 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2085 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2086 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2087 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2088 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2089 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2093 my $bgcolor1 = '#eeeeee';
2094 my $bgcolor2 = '#ffffff';
2097 $count = scalar(@taxes);
2099 foreach my $tax ( @taxes ) {
2102 if ( time - $min_sec > $last ) {
2103 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2110 if ( $bgcolor eq $bgcolor1 ) {
2111 $bgcolor = $bgcolor2;
2113 $bgcolor = $bgcolor1;
2117 if ( $tax->{'label'} ne 'Total' ) {
2118 $link = ';'. $tax->{'url_param'};
2121 print $report <<EOF;
2123 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2124 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2125 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2126 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2128 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2129 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2130 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2131 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2132 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2134 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2139 print $report <<EOF;
2146 my $reportname = $report->filename;
2149 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2150 $reportname =~ s/^$dropstring//;
2152 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2153 die "<a href=$reporturl>view</a>\n";
2163 Mixing automatic and manual editing works poorly at present.
2165 Tax liability calculations take too long and arguably don't belong here.
2166 Tax liability report generation not entirely safe (escaped).
2170 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>