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 && $maxtype != 18 # sigh
441 return $self->_fatal_or_null( 'tax with "'.
442 $self->maxtype_name. '" threshold'
444 } # I don't know why, it's not like there are maxtypes that we DO support
446 # we treat gross revenue as gross receipts and expect the tax data
447 # to DTRT (i.e. tax on tax rules)
448 if ($self->basetype != 0 && $self->basetype != 1 &&
449 $self->basetype != 5 && $self->basetype != 6 &&
450 $self->basetype != 7 && $self->basetype != 8 &&
451 $self->basetype != 14
454 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
457 unless ($self->setuptax =~ /^Y$/i) {
458 $taxable_charged += $_->setup foreach @cust_bill_pkg;
460 unless ($self->recurtax =~ /^Y$/i) {
461 $taxable_charged += $_->recur foreach @cust_bill_pkg;
464 my $taxable_units = 0;
465 unless ($self->recurtax =~ /^Y$/i) {
467 if (( $self->unittype || 0 ) == 0) { #access line
469 foreach (@cust_bill_pkg) {
470 $taxable_units += $_->units
471 unless $seen{$_->pkgnum}++;
474 } elsif ($self->unittype == 1) { #minute
475 return $self->_fatal_or_null( 'fee with minute unit type' );
477 } elsif ($self->unittype == 2) { #account
479 my $conf = new FS::Conf;
480 if ( $conf->exists('tax-pkg_address') ) {
481 #number of distinct locations
483 foreach (@cust_bill_pkg) {
485 unless $seen{$_->cust_pkg->locationnum}++;
492 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
497 # XXX handle excessrate (use_excessrate) / excessfee /
498 # taxbase/feebase / taxmax/feemax
499 # and eventually exemptions
501 # the tax or fee is applied to taxbase or feebase and then
502 # the excessrate or excess fee is applied to taxmax or feemax
504 if ( ($self->taxmax > 0 and $taxable_charged > $self->taxmax) or
505 ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
507 # (why not just cap taxable_charged/units at the taxmax/feemax? because
508 # it's way more complicated than that. this won't even catch every case
509 # where a bracket maximum should apply.)
510 return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
513 $amount += $taxable_charged * $self->tax;
514 $amount += $taxable_units * $self->fee;
516 warn "calculated taxes as [ $name, $amount ]\n"
527 my ($self, $error) = @_;
529 $DB::single = 1; # not a mistake
531 my $conf = new FS::Conf;
533 $error = "can't yet handle ". $error;
534 my $name = $self->taxname;
535 $name = 'Other surcharges'
536 if ($self->passtype == 2);
538 if ($conf->exists('ignore_incalculable_taxes')) {
539 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
540 return { name => $name, amount => 0 };
542 return "fatal: $error";
546 =item tax_on_tax CUST_LOCATION
548 Returns a list of taxes which are candidates for taxing taxes for the
549 given service location (see L<FS::cust_location>)
557 my $cust_location = shift;
559 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
560 $cust_location->custnum
563 my $geocode = $cust_location->geocode($self->data_vendor);
567 my $extra_sql = ' AND ('.
568 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
573 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
574 my $select = 'DISTINCT ON(taxclassnum) *';
576 # should qsearch preface columns with the table to facilitate joins?
577 my @taxclassnums = map { $_->taxclassnum }
578 qsearch( { 'table' => 'part_pkg_taxrate',
580 'hashref' => { 'data_vendor' => $self->data_vendor,
581 'taxclassnumtaxed' => $self->taxclassnum,
583 'extra_sql' => $extra_sql,
584 'order_by' => $order_by,
587 return () unless @taxclassnums;
590 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
592 qsearch({ 'table' => 'tax_rate',
593 'hashref' => { 'geocode' => $geocode, },
594 'extra_sql' => $extra_sql,
599 =item tax_rate_location
601 Returns an object representing the location associated with this tax
602 (see L<FS::tax_rate_location>)
606 sub tax_rate_location {
609 qsearchs({ 'table' => 'tax_rate_location',
610 'hashref' => { 'data_vendor' => $self->data_vendor,
611 'geocode' => $self->geocode,
615 new FS::tax_rate_location;
629 sub _progressbar_foo {
634 my ($param, $job) = @_;
636 my $fh = $param->{filehandle};
637 my $format = $param->{'format'};
645 my @column_lengths = ();
646 my @column_callbacks = ();
647 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
648 $format =~ s/-fixed//;
649 my $date_format = sub { my $r='';
650 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
653 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
654 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 );
655 push @column_lengths, 1 if $format eq 'cch-update';
656 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
657 $column_callbacks[8] = $date_format;
661 my ( $count, $last, $min_sec ) = _progressbar_foo();
662 if ( $job || scalar(@column_callbacks) ) {
664 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
665 return $error if $error;
669 if ( $format eq 'cch' || $format eq 'cch-update' ) {
670 #false laziness w/below (sub _perform_cch_diff)
671 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
672 excessrate effective_date taxauth taxtype taxcat taxname
673 usetax useexcessrate fee unittype feemax maxtype passflag
675 push @fields, 'actionflag' if $format eq 'cch-update';
680 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
681 $hash->{'data_vendor'} ='cch';
682 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
683 time_zone => 'floating',
685 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
686 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
688 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
689 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
692 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
694 my %tax_class = ( 'data_vendor' => 'cch',
695 'taxclass' => $taxclassid,
698 my $tax_class = qsearchs( 'tax_class', \%tax_class );
699 return "Error updating tax rate: no tax class $taxclassid"
702 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
704 foreach (qw( taxtype taxcat )) {
708 my %passflagmap = ( '0' => '',
712 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
713 if exists $passflagmap{$hash->{'passflag'}};
715 foreach (keys %$hash) {
716 $hash->{$_} = substr($hash->{$_}, 0, 80)
717 if length($hash->{$_}) > 80;
720 my $actionflag = delete($hash->{'actionflag'});
722 $hash->{'taxname'} =~ s/`/'/g;
723 $hash->{'taxname'} =~ s|\\|/|g;
725 return '' if $format eq 'cch'; # but not cch-update
727 if ($actionflag eq 'I') {
728 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
729 }elsif ($actionflag eq 'D') {
730 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
732 return "Unexpected action flag: ". $hash->{'actionflag'};
735 delete($hash->{$_}) for keys %$hash;
741 } elsif ( $format eq 'extended' ) {
742 die "unimplemented\n";
746 die "unknown format $format";
749 my $csv = new Text::CSV_XS;
753 local $SIG{HUP} = 'IGNORE';
754 local $SIG{INT} = 'IGNORE';
755 local $SIG{QUIT} = 'IGNORE';
756 local $SIG{TERM} = 'IGNORE';
757 local $SIG{TSTP} = 'IGNORE';
758 local $SIG{PIPE} = 'IGNORE';
760 my $oldAutoCommit = $FS::UID::AutoCommit;
761 local $FS::UID::AutoCommit = 0;
764 while ( defined($line=<$fh>) ) {
765 $csv->parse($line) or do {
766 $dbh->rollback if $oldAutoCommit;
767 return "can't parse: ". $csv->error_input();
770 if ( $job ) { # progress bar
771 if ( time - $min_sec > $last ) {
772 my $error = $job->update_statustext(
773 int( 100 * $imported / $count ). ",Importing tax rates"
776 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
783 my @columns = $csv->fields();
785 my %tax_rate = ( 'data_vendor' => $format );
786 foreach my $field ( @fields ) {
787 $tax_rate{$field} = shift @columns;
790 if ( scalar( @columns ) ) {
791 $dbh->rollback if $oldAutoCommit;
792 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
795 my $error = &{$hook}(\%tax_rate);
797 $dbh->rollback if $oldAutoCommit;
801 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
803 my $tax_rate = new FS::tax_rate( \%tax_rate );
804 $error = $tax_rate->insert;
807 $dbh->rollback if $oldAutoCommit;
808 return "can't insert tax_rate for $line: $error";
817 my @replace = grep { exists($delete{$_}) } keys %insert;
819 if ( $job ) { # progress bar
820 if ( time - $min_sec > $last ) {
821 my $error = $job->update_statustext(
822 int( 100 * $imported / $count ). ",Importing tax rates"
825 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
832 my $old = qsearchs( 'tax_rate', $delete{$_} );
836 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
837 $new->taxnum($old->taxnum);
838 my $error = $new->replace($old);
841 $dbh->rollback if $oldAutoCommit;
842 my $hashref = $insert{$_};
843 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
844 return "can't replace tax_rate for $line: $error";
851 $old = delete $delete{$_};
852 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
853 #join(" ", map { "$_ => ". $old->{$_} } @fields);
854 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
860 for (grep { !exists($delete{$_}) } keys %insert) {
861 if ( $job ) { # progress bar
862 if ( time - $min_sec > $last ) {
863 my $error = $job->update_statustext(
864 int( 100 * $imported / $count ). ",Importing tax rates"
867 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
874 my $tax_rate = new FS::tax_rate( $insert{$_} );
875 my $error = $tax_rate->insert;
878 $dbh->rollback if $oldAutoCommit;
879 my $hashref = $insert{$_};
880 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
881 return "can't insert tax_rate for $line: $error";
887 for (grep { !exists($insert{$_}) } keys %delete) {
888 if ( $job ) { # progress bar
889 if ( time - $min_sec > $last ) {
890 my $error = $job->update_statustext(
891 int( 100 * $imported / $count ). ",Importing tax rates"
894 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
901 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
903 $dbh->rollback if $oldAutoCommit;
904 $tax_rate = $delete{$_};
905 warn "WARNING: can't find tax_rate to delete for: ".
906 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
909 my $error = $tax_rate->delete; # XXX we really should not do this
910 # (it orphans CBPTRL records)
913 $dbh->rollback if $oldAutoCommit;
914 my $hashref = $delete{$_};
915 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
916 return "can't delete tax_rate for $line: $error";
923 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
925 return "Empty file!" unless ($imported || $format eq 'cch-update');
931 =item process_batch_import
933 Load a batch import as a queued JSRPC job
937 sub process_batch_import {
940 my $oldAutoCommit = $FS::UID::AutoCommit;
941 local $FS::UID::AutoCommit = 0;
944 my $param = thaw(decode_base64(shift));
945 my $args = '$job, encode_base64( nfreeze( $param ) )';
947 my $method = '_perform_batch_import';
948 if ( $param->{reload} ) {
949 $method = 'process_batch_reload';
952 eval "$method($args);";
954 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
959 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
962 sub _perform_batch_import {
965 my $param = thaw(decode_base64(shift));
966 my $format = $param->{'format'}; #well... this is all cch specific
968 my $files = $param->{'uploaded_files'}
969 or die "No files provided.";
971 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
974 if ( $format eq 'cch' || $format eq 'cch-fixed'
975 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
978 my $oldAutoCommit = $FS::UID::AutoCommit;
979 local $FS::UID::AutoCommit = 0;
982 my @insert_list = ();
983 my @delete_list = ();
984 my @predelete_list = ();
987 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
989 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
990 'CODE', \&FS::tax_class::batch_import,
991 'PLUS4', \&FS::cust_tax_location::batch_import,
992 'ZIP', \&FS::cust_tax_location::batch_import,
993 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
994 'DETAIL', \&FS::tax_rate::batch_import,
996 while( scalar(@list) ) {
997 my ( $name, $import_sub ) = splice( @list, 0, 2 );
998 my $file = lc($name). 'file';
1000 unless ($files{$file}) {
1001 #$error = "No $name supplied";
1004 next if $name eq 'DETAIL' && $format =~ /update/;
1006 my $filename = "$dir/". $files{$file};
1008 if ( $format =~ /update/ ) {
1010 ( $error, $insertname, $deletename ) =
1011 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1015 unlink $filename or warn "Can't delete $filename: $!"
1016 unless $keep_cch_files;
1017 push @insert_list, $name, $insertname, $import_sub, $format;
1018 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1019 unshift @predelete_list, $name, $deletename, $import_sub, $format;
1021 unshift @delete_list, $name, $deletename, $import_sub, $format;
1026 push @insert_list, $name, $filename, $import_sub, $format;
1033 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1034 if $format =~ /update/;
1036 my %addl_param = ();
1037 if ( $param->{'delete_only'} ) {
1038 $addl_param{'delete_only'} = $param->{'delete_only'};
1042 $error ||= _perform_cch_tax_import( $job,
1043 [ @predelete_list ],
1050 @list = ( @predelete_list, @insert_list, @delete_list );
1051 while( !$keep_cch_files && scalar(@list) ) {
1052 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1053 unlink $file or warn "Can't delete $file: $!";
1057 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1060 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1064 die "Unknown format: $format";
1070 sub _perform_cch_tax_import {
1071 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1075 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1076 while( scalar(@$list) ) {
1077 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1078 my $fmt = "$format-update";
1079 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1080 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1081 my $param = { 'filehandle' => $fh,
1085 $error ||= &{$method}($param, $job);
1093 sub _perform_cch_insert_delete_split {
1094 my ($name, $filename, $dir, $format) = @_;
1098 open my $fh, "< $filename"
1099 or $error ||= "Can't open $name file $filename: $!";
1101 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1104 ) or die "can't open temp file: $!\n";
1105 my $insertname = $ifh->filename;
1107 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1110 ) or die "can't open temp file: $!\n";
1111 my $deletename = $dfh->filename;
1113 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1114 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1117 $handle = $ifh if $_ =~ /$insert_pattern/;
1118 $handle = $dfh if $_ =~ /$delete_pattern/;
1120 $error = "bad input line: $_" unless $handle;
1129 return ($error, $insertname, $deletename);
1132 sub _perform_cch_diff {
1133 my ($name, $newdir, $olddir) = @_;
1138 open my $oldcsvfh, "$olddir/$name.txt"
1139 or die "failed to open $olddir/$name.txt: $!\n";
1141 while(<$oldcsvfh>) {
1148 open my $newcsvfh, "$newdir/$name.txt"
1149 or die "failed to open $newdir/$name.txt: $!\n";
1151 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1154 ) or die "can't open temp file: $!\n";
1155 my $diffname = $dfh->filename;
1157 while(<$newcsvfh>) {
1159 if (exists($oldlines{$_})) {
1162 print $dfh $_, ',"I"', "\n";
1167 #false laziness w/above (sub batch_import)
1168 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1169 excessrate effective_date taxauth taxtype taxcat taxname
1170 usetax useexcessrate fee unittype feemax maxtype passflag
1171 passtype basetype );
1172 my $numfields = scalar(@fields);
1174 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1176 for my $line (grep $oldlines{$_}, keys %oldlines) {
1178 $csv->parse($line) or do {
1179 #$dbh->rollback if $oldAutoCommit;
1180 die "can't parse: ". $csv->error_input();
1182 my @columns = $csv->fields();
1184 $csv->combine( splice(@columns, 0, $numfields) );
1186 print $dfh $csv->string, ',"D"', "\n";
1194 sub _cch_fetch_and_unzip {
1195 my ( $job, $urls, $secret, $dir ) = @_;
1197 my $ua = new LWP::UserAgent;
1198 foreach my $url (split ',', $urls) {
1199 my @name = split '/', $url; #somewhat restrictive
1200 my $name = pop @name;
1201 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1204 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1206 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1207 my $res = $ua->request(
1208 new HTTP::Request( GET => $url ),
1210 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1211 my $content_length = $_[1]->content_length;
1212 $imported += length($_[0]);
1213 if ( time - $min_sec > $last ) {
1214 my $error = $job->update_statustext(
1215 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1216 ",Downloading data from CCH"
1218 die $error if $error;
1223 die "download of $url failed: ". $res->status_line
1224 unless $res->is_success;
1227 my $error = $job->update_statustext( "0,Unpacking data" );
1228 die $error if $error;
1229 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1231 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1232 or die "unzip -P $secret -d $dir $dir/$name failed";
1233 #unlink "$dir/$name";
1237 sub _cch_extract_csv_from_dbf {
1238 my ( $job, $dir, $name ) = @_;
1243 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1244 my $error = $job->update_statustext( "0,Unpacking $name" );
1245 die $error if $error;
1246 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1247 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1248 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1249 unless defined($table);
1250 my $count = $table->last_record; # approximately;
1251 open my $csvfh, ">$dir.new/$name.txt"
1252 or die "failed to open $dir.new/$name.txt: $!\n";
1254 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1255 my @fields = $table->field_names;
1256 my $cursor = $table->prepare_select;
1258 sub { my $date = shift;
1259 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1262 while (my $row = $cursor->fetch_hashref) {
1263 $csv->combine( map { my $type = $table->field_type($_);
1265 &{$format_date}($row->{$_}) ;
1266 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1267 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1274 print $csvfh $csv->string, "\n";
1276 if ( time - $min_sec > $last ) {
1277 my $error = $job->update_statustext(
1278 int(100 * $imported/$count). ",Unpacking $name"
1280 die $error if $error;
1288 sub _remember_disabled_taxes {
1289 my ( $job, $format, $disabled_tax_rate ) = @_;
1293 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1295 my @items = qsearch( { table => 'tax_rate',
1296 hashref => { disabled => 'Y',
1297 data_vendor => $format,
1299 select => 'geocode, taxclassnum',
1302 my $count = scalar(@items);
1303 foreach my $tax_rate ( @items ) {
1304 if ( time - $min_sec > $last ) {
1305 $job->update_statustext(
1306 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1312 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1313 unless ( $tax_class ) {
1314 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1317 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1321 sub _remember_tax_products {
1322 my ( $job, $format, $taxproduct ) = @_;
1324 # XXX FIXME this loop only works when cch is the only data provider
1326 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1328 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1329 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1330 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1331 " optionname LIKE 'usage_taxproductnum_%' AND ".
1332 " optionvalue != '' )";
1333 my @items = qsearch( { table => 'part_pkg',
1334 select => 'DISTINCT pkgpart,taxproductnum',
1336 extra_sql => $extra_sql,
1339 my $count = scalar(@items);
1340 foreach my $part_pkg ( @items ) {
1341 if ( time - $min_sec > $last ) {
1342 $job->update_statustext(
1343 int( 100 * $imported / $count ). ",Remembering tax products"
1348 warn "working with package part ". $part_pkg->pkgpart.
1349 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1350 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1351 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1352 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1354 foreach my $option ( $part_pkg->part_pkg_option ) {
1355 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1358 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1359 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1360 $part_pkg_taxproduct->taxproduct
1361 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1366 sub _restore_remembered_tax_products {
1367 my ( $job, $format, $taxproduct ) = @_;
1371 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1372 my $count = scalar(keys %$taxproduct);
1373 foreach my $pkgpart ( keys %$taxproduct ) {
1374 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1375 if ( time - $min_sec > $last ) {
1376 $job->update_statustext(
1377 int( 100 * $imported / $count ). ",Restoring tax products"
1383 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1384 unless ( $part_pkg ) {
1385 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1388 my %options = $part_pkg->options;
1389 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1390 my $primary_svc = $part_pkg->svcpart;
1391 my $new = new FS::part_pkg { $part_pkg->hash };
1393 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1394 warn "working with class '$class'\n" if $DEBUG;
1395 my $part_pkg_taxproduct =
1396 qsearchs( 'part_pkg_taxproduct',
1397 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1398 data_vendor => $format,
1402 unless ( $part_pkg_taxproduct ) {
1403 return "failed to find part_pkg_taxproduct (".
1404 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1407 if ( $class eq '' ) {
1408 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1412 $options{"usage_taxproductnum_$class"} =
1413 $part_pkg_taxproduct->taxproductnum;
1417 my $error = $new->replace( $part_pkg,
1418 'pkg_svc' => \%pkg_svc,
1419 'primary_svc' => $primary_svc,
1420 'options' => \%options,
1423 return $error if $error;
1430 sub _restore_remembered_disabled_taxes {
1431 my ( $job, $format, $disabled_tax_rate ) = @_;
1433 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1434 my $count = scalar(keys %$disabled_tax_rate);
1435 foreach my $key (keys %$disabled_tax_rate) {
1436 if ( time - $min_sec > $last ) {
1437 $job->update_statustext(
1438 int( 100 * $imported / $count ). ",Disabling tax rates"
1443 my ($geocode,$taxclass) = split /:/, $key, 2;
1444 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1445 taxclass => $taxclass,
1447 return "found multiple tax_class records for format $format class $taxclass"
1448 if scalar(@tax_class) > 1;
1450 unless (scalar(@tax_class)) {
1451 warn "no tax_class for format $format class $taxclass\n";
1456 qsearch('tax_rate', { data_vendor => $format,
1457 geocode => $geocode,
1458 taxclassnum => $tax_class[0]->taxclassnum,
1462 if (scalar(@tax_rate) > 1) {
1463 return "found multiple tax_rate records for format $format geocode ".
1464 "$geocode and taxclass $taxclass ( taxclassnum ".
1465 $tax_class[0]->taxclassnum. " )";
1468 if (scalar(@tax_rate)) {
1469 $tax_rate[0]->disabled('Y');
1470 my $error = $tax_rate[0]->replace;
1471 return $error if $error;
1476 sub _remove_old_tax_data {
1477 my ( $job, $format ) = @_;
1480 my $error = $job->update_statustext( "0,Removing old tax data" );
1481 die $error if $error;
1483 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1484 "WHERE data_vendor = ". $dbh->quote($format);
1485 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1488 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1490 foreach my $table ( @table ) {
1491 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1492 $dbh->quote($format);
1493 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1496 if ( $format eq 'cch' ) {
1497 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1498 $dbh->quote("$format-zip");
1499 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1505 sub _create_temporary_tables {
1506 my ( $job, $format ) = @_;
1509 my $error = $job->update_statustext( "0,Creating temporary tables" );
1510 die $error if $error;
1512 my @table = qw( tax_rate
1519 foreach my $table ( @table ) {
1521 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1522 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1528 sub _copy_from_temp {
1529 my ( $job, $format ) = @_;
1532 my $error = $job->update_statustext( "0,Making permanent" );
1533 die $error if $error;
1535 my @table = qw( tax_rate
1542 foreach my $table ( @table ) {
1544 "INSERT INTO public.$table SELECT * from $table";
1545 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1551 =item process_download_and_reload
1553 Download and process a tax update as a queued JSRPC job after wiping the
1554 existing wipable tax data.
1558 sub process_download_and_reload {
1559 _process_reload('process_download_and_update', @_);
1563 =item process_batch_reload
1565 Load and process a tax update from the provided files as a queued JSRPC job
1566 after wiping the existing wipable tax data.
1570 sub process_batch_reload {
1571 _process_reload('_perform_batch_import', @_);
1575 sub _process_reload {
1576 my ( $method, $job ) = ( shift, shift );
1578 my $param = thaw(decode_base64($_[0]));
1579 my $format = $param->{'format'}; #well... this is all cch specific
1581 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1583 if ( $job ) { # progress bar
1584 my $error = $job->update_statustext( 0 );
1585 die $error if $error;
1588 my $oldAutoCommit = $FS::UID::AutoCommit;
1589 local $FS::UID::AutoCommit = 0;
1594 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1595 "USING (taxclassnum) WHERE data_vendor = '$format'";
1596 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1598 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1599 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1600 if $sth->fetchrow_arrayref->[0];
1602 # really should get a table EXCLUSIVE lock here
1604 #remember disabled taxes
1605 my %disabled_tax_rate = ();
1606 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1608 #remember tax products
1609 my %taxproduct = ();
1610 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1613 $error ||= _create_temporary_tables( $job, $format );
1617 my $args = '$job, @_';
1618 eval "$method($args);";
1622 #restore taxproducts
1623 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1627 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1629 #wipe out the old data
1630 $error ||= _remove_old_tax_data( $job, $format );
1633 $error ||= _copy_from_temp( $job, $format );
1636 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1641 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1645 =item process_download_and_update
1647 Download and process a tax update as a queued JSRPC job
1651 sub process_download_and_update {
1654 my $param = thaw(decode_base64(shift));
1655 my $format = $param->{'format'}; #well... this is all cch specific
1657 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1659 if ( $job ) { # progress bar
1660 my $error = $job->update_statustext( 0);
1661 die $error if $error;
1664 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1665 my $dir = $cache_dir. 'taxdata';
1667 mkdir $dir or die "can't create $dir: $!\n";
1670 if ($format eq 'cch') {
1672 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1674 my $conf = new FS::Conf;
1675 die "direct download of tax data not enabled\n"
1676 unless $conf->exists('taxdatadirectdownload');
1677 my ( $urls, $username, $secret, $states ) =
1678 $conf->config('taxdatadirectdownload');
1679 die "No tax download URL provided. ".
1680 "Did you set the taxdatadirectdownload configuration value?\n"
1688 # really should get a table EXCLUSIVE lock here
1689 # check if initial import or update
1691 # relying on mkdir "$dir.new" as a mutex
1693 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1694 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1695 $sth->execute() or die $sth->errstr;
1696 my $update = $sth->fetchrow_arrayref->[0];
1698 # create cache and/or rotate old tax data
1703 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1704 foreach my $file (readdir($dirh)) {
1705 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1711 for (8, 7, 6, 5, 4, 3, 2, 1) {
1712 if ( -e "$dir.$_" ) {
1713 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1716 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1720 die "can't find previous tax data\n" if $update;
1724 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1726 # fetch and unpack the zip files
1728 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1730 # extract csv files from the dbf files
1732 foreach my $name ( @namelist ) {
1733 _cch_extract_csv_from_dbf( $job, $dir, $name );
1736 # generate the diff files
1739 foreach my $name ( @namelist ) {
1740 my $difffile = "$dir.new/$name.txt";
1742 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1743 die $error if $error;
1744 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1745 my $olddir = $update ? "$dir.1" : "";
1746 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1748 $difffile =~ s/^$cache_dir//;
1749 push @list, "${name}file:$difffile";
1752 # perform the import
1753 local $keep_cch_files = 1;
1754 $param->{uploaded_files} = join( ',', @list );
1755 $param->{format} .= '-update' if $update;
1757 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1759 rename "$dir.new", "$dir"
1760 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1763 die "Unknown format: $format";
1767 =item browse_queries PARAMS
1769 Returns a list consisting of a hashref suited for use as the argument
1770 to qsearch, and sql query string. Each is based on the PARAMS hashref
1771 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1772 from a form. This conveniently creates the query hashref and count_query
1773 string required by the browse and search elements. As a side effect,
1774 the PARAMS hashref is untainted and keys with unexpected values are removed.
1778 sub browse_queries {
1782 'table' => 'tax_rate',
1784 'order_by' => 'ORDER BY geocode, taxclassnum',
1789 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1790 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1792 delete $params->{data_vendor};
1795 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1796 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1797 'geocode LIKE '. dbh->quote($1.'%');
1799 delete $params->{geocode};
1802 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1803 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1806 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1807 ' taxclassnum = '. dbh->quote($1)
1809 delete $params->{taxclassnun};
1813 if ( $params->{tax_type} =~ /^(\d+)$/ );
1814 delete $params->{tax_type}
1818 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1819 delete $params->{tax_cat}
1822 my @taxclassnum = ();
1823 if ($tax_type || $tax_cat ) {
1824 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1825 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1826 @taxclassnum = map { $_->taxclassnum }
1827 qsearch({ 'table' => 'tax_class',
1829 'extra_sql' => "WHERE taxclass $compare",
1833 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1834 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1835 if ( @taxclassnum );
1837 unless ($params->{'showdisabled'}) {
1838 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1839 "( disabled = '' OR disabled IS NULL )";
1842 $query->{extra_sql} = $extra_sql;
1844 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1847 =item queue_liability_report PARAMS
1849 Launches a tax liability report.
1851 PARAMS needs to be a base64-encoded Storable hash containing:
1852 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1853 - end: the end date of the report, likewise.
1854 - agentnum: the agent to limit the report to, if any.
1858 sub queue_liability_report {
1860 my $param = thaw(decode_base64(shift));
1863 $cgi->param('beginning', $param->{beginning});
1864 $cgi->param('ending', $param->{ending});
1865 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1866 my $agentnum = $param->{agentnum};
1867 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1868 generate_liability_report(
1869 'beginning' => $beginning,
1870 'ending' => $ending,
1871 'agentnum' => $agentnum,
1872 'p' => $param->{RootURL},
1877 =item generate_liability_report PARAMS
1879 Generates a tax liability report. PARAMS must include:
1881 - beginning, as a timestamp
1882 - ending, as a timestamp
1883 - p: the Freeside root URL, for generating links
1884 - agentnum (optional)
1888 #shit, all sorts of false laxiness w/report_newtax.cgi
1889 sub generate_liability_report {
1892 my ( $count, $last, $min_sec ) = _progressbar_foo();
1894 #let us open the temp file early
1895 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1896 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1898 UNLINK => 0, # not so temp
1899 ) or die "can't open report file: $!\n";
1901 my $conf = new FS::Conf;
1902 my $money_char = $conf->config('money_char') || '$';
1905 JOIN cust_bill USING ( invnum )
1906 LEFT JOIN cust_main USING ( custnum )
1910 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1911 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1913 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1915 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1918 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1919 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1920 die "agent not found" unless $agent;
1921 $agentname = $agent->agent;
1922 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1925 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1926 my @taxparams = qw( city county state locationtaxid );
1927 my @params = ('itemdesc', @taxparams);
1929 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1931 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1932 #to FS::Report or FS::Record or who the fuck knows where)
1933 my $scalar_sql = sub {
1934 my( $r, $param, $sql ) = @_;
1935 my $sth = dbh->prepare($sql) or die dbh->errstr;
1936 $sth->execute( map $r->$_(), @$param )
1937 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1938 $sth->fetchrow_arrayref->[0] || 0;
1947 # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1948 # for taxes that have been charged
1949 # (state, county, city are from tax_rate_location, not from customer data)
1950 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1952 hashref => { pkgpart => 0 },
1953 addl_from => $addl_from,
1954 extra_sql => $where,
1957 $count = scalar(@tax_and_location);
1958 foreach my $t ( @tax_and_location ) {
1961 if ( time - $min_sec > $last ) {
1962 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1969 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1970 my $label = join('~', map { $t->$_ } @params);
1971 $label = 'Tax'. $label if $label =~ /^~/;
1972 unless ( exists( $taxes{$label} ) ) {
1973 my ($baselabel, @trash) = split /~/, $label;
1975 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1976 $taxes{$label}->{'url_param'} =
1977 join(';', map { "$_=". uri_escape($t->$_) } @params);
1980 # " payby != 'COMP' ". # breaks the entire report under 4.x
1981 # # and unnecessary since COMP accounts don't
1982 # # get taxes calculated in the first place
1983 " ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1984 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1989 "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1991 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1993 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1995 $taxes{$label}->{'tax'} += $x;
1998 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2000 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2002 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2003 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2005 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2007 $taxes{$label}->{'credit'} += $y;
2009 unless ( exists( $taxes{$baselabel} ) ) {
2011 $basetaxes{$baselabel}->{'label'} = $baselabel;
2012 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2013 $basetaxes{$baselabel}->{'base'} = 1;
2017 $basetaxes{$baselabel}->{'tax'} += $x;
2018 $basetaxes{$baselabel}->{'credit'} += $y;
2022 # calculate customer-exemption for this tax
2023 # calculate package-exemption for this tax
2024 # calculate monthly exemption (texas tax) for this tax
2025 # count up all the cust_tax_exempt_pkg records associated with
2026 # the actual line items.
2033 $args{job}->update_statustext( "0,Sorted" );
2039 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2040 my ($base, @trash) = split '~', $tax;
2041 my $basetax = delete( $basetaxes{$base} );
2043 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2044 $taxes{$tax}->{base} = 1;
2046 push @taxes, $basetax;
2049 push @taxes, $taxes{$tax};
2056 'credit' => $credit,
2061 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2062 $dateagentlink .= ';agentnum='. $args{agentnum}
2063 if length($agentname);
2064 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2066 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2068 print $report <<EOF;
2070 <% include("/elements/header.html", "$agentname Tax Report - ".
2072 ? time2str('%h %o %Y ', $args{beginning} )
2076 ( $args{ending} == 4294967295
2078 : time2str('%h %o %Y', $args{ending} )
2083 <% include('/elements/table-grid.html') %>
2086 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2087 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2088 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2089 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2090 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2091 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2095 my $bgcolor1 = '#eeeeee';
2096 my $bgcolor2 = '#ffffff';
2099 $count = scalar(@taxes);
2101 foreach my $tax ( @taxes ) {
2104 if ( time - $min_sec > $last ) {
2105 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2112 if ( $bgcolor eq $bgcolor1 ) {
2113 $bgcolor = $bgcolor2;
2115 $bgcolor = $bgcolor1;
2119 if ( $tax->{'label'} ne 'Total' ) {
2120 $link = ';'. $tax->{'url_param'};
2123 print $report <<EOF;
2125 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2126 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2127 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2128 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2130 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2131 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2132 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2133 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2134 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2136 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2141 print $report <<EOF;
2148 my $reportname = $report->filename;
2151 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2152 $reportname =~ s/^$dropstring//;
2154 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2155 die "<a href=$reporturl>view</a>\n";
2165 Mixing automatic and manual editing works poorly at present.
2167 Tax liability calculations take too long and arguably don't belong here.
2168 Tax liability report generation not entirely safe (escaped).
2172 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>