2 use base qw( FS::Record );
5 use vars qw( $DEBUG $me
6 %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
7 %tax_passtypes %GetInfoType $keep_cch_files );
10 use DateTime::Format::Strptime;
11 use Storable qw( thaw nfreeze );
21 use DBIx::DBSchema::Table;
22 use DBIx::DBSchema::Column;
23 use FS::Record qw( qsearch qsearchs dbh dbdef );
26 use FS::cust_bill_pkg;
27 use FS::cust_tax_location;
28 use FS::tax_rate_location;
29 use FS::part_pkg_taxrate;
30 use FS::part_pkg_taxproduct;
32 use FS::Misc qw( csv_from_fixed );
35 $me = '[FS::tax_rate]';
40 FS::tax_rate - Object methods for tax_rate objects
46 $record = new FS::tax_rate \%hash;
47 $record = new FS::tax_rate { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
59 An FS::tax_rate object represents a tax rate, defined by locale.
60 FS::tax_rate inherits from FS::Record. The following fields are
67 primary key (assigned automatically for new tax rates)
71 a geographic location code provided by a tax data vendor
79 a location code provided by a tax authority
83 a foreign key into FS::tax_class - the type of tax
84 referenced but FS::part_pkg_taxrate
87 the time after which the tax applies
95 second bracket percentage
99 the amount to which the tax applies (first bracket)
103 a cap on the amount of tax if a cap exists
107 percentage on out of jurisdiction purchases
111 second bracket percentage on out of jurisdiction purchases
115 one of the values in %tax_unittypes
119 amount of tax per unit
123 second bracket amount of tax per unit
127 the number of units to which the fee applies (first bracket)
131 the most units to which fees apply (first and second brackets)
135 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
139 if defined, printed on invoices instead of "Tax"
143 a value from %tax_authorities
147 a value from %tax_basetypes indicating the tax basis
151 a value from %tax_passtypes indicating how the tax should displayed to the customer
155 'Y', 'N', or blank indicating the tax can be passed to the customer
159 if 'Y', this tax does not apply to setup fees
163 if 'Y', this tax does not apply to recurring fees
167 if 'Y', has been manually edited
177 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
181 sub table { 'tax_rate'; }
185 Adds this tax rate to the database. If there is an error, returns the error,
186 otherwise returns false.
190 Deletes this tax rate from the database. If there is an error, returns the
191 error, otherwise returns false.
193 =item replace OLD_RECORD
195 Replaces the OLD_RECORD with this one in the database. If there is an error,
196 returns the error, otherwise returns false.
200 Checks all fields to make sure this is a valid tax rate. If there is an error,
201 returns the error, otherwise returns false. Called by the insert and replace
209 foreach (qw( taxbase taxmax )) {
210 $self->$_(0) unless $self->$_;
213 $self->ut_numbern('taxnum')
214 || $self->ut_text('geocode')
215 || $self->ut_textn('data_vendor')
216 || $self->ut_textn('location')
217 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
218 || $self->ut_snumbern('effective_date')
219 || $self->ut_float('tax')
220 || $self->ut_floatn('excessrate')
221 || $self->ut_money('taxbase')
222 || $self->ut_money('taxmax')
223 || $self->ut_floatn('usetax')
224 || $self->ut_floatn('useexcessrate')
225 || $self->ut_numbern('unittype')
226 || $self->ut_floatn('fee')
227 || $self->ut_floatn('excessfee')
228 || $self->ut_floatn('feemax')
229 || $self->ut_numbern('maxtype')
230 || $self->ut_textn('taxname')
231 || $self->ut_numbern('taxauth')
232 || $self->ut_numbern('basetype')
233 || $self->ut_numbern('passtype')
234 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
235 || $self->ut_enum('setuptax', [ '', 'Y' ] )
236 || $self->ut_enum('recurtax', [ '', 'Y' ] )
237 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
238 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
239 || $self->ut_enum('manual', [ '', 'Y' ] )
240 || $self->ut_enum('disabled', [ '', 'Y' ] )
241 || $self->SUPER::check
246 =item taxclass_description
248 Returns the human understandable value associated with the related
253 sub taxclass_description {
255 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
256 $tax_class ? $tax_class->description : '';
261 Returns the human understandable value associated with the unittype column
265 %tax_unittypes = ( '0' => 'access line',
272 $tax_unittypes{$self->unittype};
277 Returns the human understandable value associated with the maxtype column
281 %tax_maxtypes = ( '0' => 'receipts per invoice',
282 '1' => 'receipts per item',
283 '2' => 'total utility charges per utility tax year',
284 '3' => 'total charges per utility tax year',
285 '4' => 'receipts per access line',
286 '9' => 'monthly receipts per location',
291 $tax_maxtypes{$self->maxtype};
296 Returns the human understandable value associated with the basetype column
300 %tax_basetypes = ( '0' => 'sale price',
301 '1' => 'gross receipts',
302 '2' => 'sales taxable telecom revenue',
303 '3' => 'minutes carried',
304 '4' => 'minutes billed',
305 '5' => 'gross operating revenue',
306 '6' => 'access line',
308 '8' => 'gross revenue',
309 '9' => 'portion gross receipts attributable to interstate service',
310 '10' => 'access line',
311 '11' => 'gross profits',
312 '12' => 'tariff rate',
314 '15' => 'prior year gross receipts',
319 $tax_basetypes{$self->basetype};
324 Returns the human understandable value associated with the taxauth column
328 %tax_authorities = ( '0' => 'federal',
333 '5' => 'county administered by state',
334 '6' => 'city administered by state',
335 '7' => 'city administered by county',
336 '8' => 'local administered by state',
337 '9' => 'local administered by county',
342 $tax_authorities{$self->taxauth};
347 Returns the human understandable value associated with the passtype column
351 %tax_passtypes = ( '0' => 'separate tax line',
352 '1' => 'separate surcharge line',
353 '2' => 'surcharge not separated',
354 '3' => 'included in base rate',
359 $tax_passtypes{$self->passtype};
362 =item taxline TAXABLES, [ OPTIONSHASH ]
364 Returns a listref of a name and an amount of tax calculated for the list
365 of packages/amounts referenced by TAXABLES. If an error occurs, a message
366 is returned as a scalar.
376 if (ref($_[0]) eq 'ARRAY') {
381 #exemptions would be broken in this case
384 my $name = $self->taxname;
385 $name = 'Other surcharges'
386 if ($self->passtype == 2);
389 if ( $self->disabled ) { # we always know how to handle disabled taxes
396 my $taxable_charged = 0;
397 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
400 warn "calculating taxes for ". $self->taxnum. " on ".
401 join (",", map { $_->pkgnum } @cust_bill_pkg)
404 if ($self->passflag eq 'N') {
405 # return "fatal: can't (yet) handle taxes not passed to the customer";
406 # until someone needs to track these in freeside
413 my $maxtype = $self->maxtype || 0;
414 if ($maxtype != 0 && $maxtype != 1 && $maxtype != 9) {
415 return $self->_fatal_or_null( 'tax with "'.
416 $self->maxtype_name. '" threshold'
422 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
426 # we treat gross revenue as gross receipts and expect the tax data
427 # to DTRT (i.e. tax on tax rules)
428 if ($self->basetype != 0 && $self->basetype != 1 &&
429 $self->basetype != 5 && $self->basetype != 6 &&
430 $self->basetype != 7 && $self->basetype != 8 &&
431 $self->basetype != 14
434 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
437 unless ($self->setuptax =~ /^Y$/i) {
438 $taxable_charged += $_->setup foreach @cust_bill_pkg;
440 unless ($self->recurtax =~ /^Y$/i) {
441 $taxable_charged += $_->recur foreach @cust_bill_pkg;
444 my $taxable_units = 0;
445 unless ($self->recurtax =~ /^Y$/i) {
447 if (( $self->unittype || 0 ) == 0) { #access line
449 foreach (@cust_bill_pkg) {
450 $taxable_units += $_->units
451 unless $seen{$_->pkgnum}++;
454 } elsif ($self->unittype == 1) { #minute
455 return $self->_fatal_or_null( 'fee with minute unit type' );
457 } elsif ($self->unittype == 2) { #account
459 my $conf = new FS::Conf;
460 if ( $conf->exists('tax-pkg_address') ) {
461 #number of distinct locations
463 foreach (@cust_bill_pkg) {
465 unless $seen{$_->cust_pkg->locationnum}++;
472 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
477 # XXX handle excessrate (use_excessrate) / excessfee /
478 # taxbase/feebase / taxmax/feemax
479 # and eventually exemptions
481 # the tax or fee is applied to taxbase or feebase and then
482 # the excessrate or excess fee is applied to taxmax or feemax
484 $amount += $taxable_charged * $self->tax;
485 $amount += $taxable_units * $self->fee;
487 warn "calculated taxes as [ $name, $amount ]\n"
498 my ($self, $error) = @_;
500 my $conf = new FS::Conf;
502 $error = "can't yet handle ". $error;
503 my $name = $self->taxname;
504 $name = 'Other surcharges'
505 if ($self->passtype == 2);
507 if ($conf->exists('ignore_incalculable_taxes')) {
508 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
509 return { name => $name, amount => 0 };
511 return "fatal: $error";
515 =item tax_on_tax CUST_LOCATION
517 Returns a list of taxes which are candidates for taxing taxes for the
518 given service location (see L<FS::cust_location>)
526 my $cust_location = shift;
528 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
529 $cust_location->custnum
532 my $geocode = $cust_location->geocode($self->data_vendor);
536 my $extra_sql = ' AND ('.
537 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
542 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
543 my $select = 'DISTINCT ON(taxclassnum) *';
545 # should qsearch preface columns with the table to facilitate joins?
546 my @taxclassnums = map { $_->taxclassnum }
547 qsearch( { 'table' => 'part_pkg_taxrate',
549 'hashref' => { 'data_vendor' => $self->data_vendor,
550 'taxclassnumtaxed' => $self->taxclassnum,
552 'extra_sql' => $extra_sql,
553 'order_by' => $order_by,
556 return () unless @taxclassnums;
559 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
561 qsearch({ 'table' => 'tax_rate',
562 'hashref' => { 'geocode' => $geocode, },
563 'extra_sql' => $extra_sql,
568 =item tax_rate_location
570 Returns an object representing the location associated with this tax
571 (see L<FS::tax_rate_location>)
575 sub tax_rate_location {
578 qsearchs({ 'table' => 'tax_rate_location',
579 'hashref' => { 'data_vendor' => $self->data_vendor,
580 'geocode' => $self->geocode,
584 new FS::tax_rate_location;
598 sub _progressbar_foo {
603 my ($param, $job) = @_;
605 my $fh = $param->{filehandle};
606 my $format = $param->{'format'};
614 my @column_lengths = ();
615 my @column_callbacks = ();
616 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
617 $format =~ s/-fixed//;
618 my $date_format = sub { my $r='';
619 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
622 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
623 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 );
624 push @column_lengths, 1 if $format eq 'cch-update';
625 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
626 $column_callbacks[8] = $date_format;
630 my ( $count, $last, $min_sec ) = _progressbar_foo();
631 if ( $job || scalar(@column_callbacks) ) {
633 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
634 return $error if $error;
638 if ( $format eq 'cch' || $format eq 'cch-update' ) {
639 #false laziness w/below (sub _perform_cch_diff)
640 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
641 excessrate effective_date taxauth taxtype taxcat taxname
642 usetax useexcessrate fee unittype feemax maxtype passflag
644 push @fields, 'actionflag' if $format eq 'cch-update';
649 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
650 $hash->{'data_vendor'} ='cch';
651 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
652 time_zone => 'floating',
654 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
655 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
657 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
658 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
661 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
663 my %tax_class = ( 'data_vendor' => 'cch',
664 'taxclass' => $taxclassid,
667 my $tax_class = qsearchs( 'tax_class', \%tax_class );
668 return "Error updating tax rate: no tax class $taxclassid"
671 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
673 foreach (qw( taxtype taxcat )) {
677 my %passflagmap = ( '0' => '',
681 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
682 if exists $passflagmap{$hash->{'passflag'}};
684 foreach (keys %$hash) {
685 $hash->{$_} = substr($hash->{$_}, 0, 80)
686 if length($hash->{$_}) > 80;
689 my $actionflag = delete($hash->{'actionflag'});
691 $hash->{'taxname'} =~ s/`/'/g;
692 $hash->{'taxname'} =~ s|\\|/|g;
694 return '' if $format eq 'cch'; # but not cch-update
696 if ($actionflag eq 'I') {
697 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
698 }elsif ($actionflag eq 'D') {
699 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
701 return "Unexpected action flag: ". $hash->{'actionflag'};
704 delete($hash->{$_}) for keys %$hash;
710 } elsif ( $format eq 'extended' ) {
711 die "unimplemented\n";
715 die "unknown format $format";
718 my $csv = new Text::CSV_XS;
722 local $SIG{HUP} = 'IGNORE';
723 local $SIG{INT} = 'IGNORE';
724 local $SIG{QUIT} = 'IGNORE';
725 local $SIG{TERM} = 'IGNORE';
726 local $SIG{TSTP} = 'IGNORE';
727 local $SIG{PIPE} = 'IGNORE';
729 my $oldAutoCommit = $FS::UID::AutoCommit;
730 local $FS::UID::AutoCommit = 0;
733 while ( defined($line=<$fh>) ) {
734 $csv->parse($line) or do {
735 $dbh->rollback if $oldAutoCommit;
736 return "can't parse: ". $csv->error_input();
739 if ( $job ) { # progress bar
740 if ( time - $min_sec > $last ) {
741 my $error = $job->update_statustext(
742 int( 100 * $imported / $count ). ",Importing tax rates"
745 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
752 my @columns = $csv->fields();
754 my %tax_rate = ( 'data_vendor' => $format );
755 foreach my $field ( @fields ) {
756 $tax_rate{$field} = shift @columns;
759 if ( scalar( @columns ) ) {
760 $dbh->rollback if $oldAutoCommit;
761 return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
764 my $error = &{$hook}(\%tax_rate);
766 $dbh->rollback if $oldAutoCommit;
770 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
772 my $tax_rate = new FS::tax_rate( \%tax_rate );
773 $error = $tax_rate->insert;
776 $dbh->rollback if $oldAutoCommit;
777 return "can't insert tax_rate for $line: $error";
786 my @replace = grep { exists($delete{$_}) } keys %insert;
788 if ( $job ) { # progress bar
789 if ( time - $min_sec > $last ) {
790 my $error = $job->update_statustext(
791 int( 100 * $imported / $count ). ",Importing tax rates"
794 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
801 my $old = qsearchs( 'tax_rate', $delete{$_} );
805 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
806 $new->taxnum($old->taxnum);
807 my $error = $new->replace($old);
810 $dbh->rollback if $oldAutoCommit;
811 my $hashref = $insert{$_};
812 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
813 return "can't replace tax_rate for $line: $error";
820 $old = delete $delete{$_};
821 warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
822 #join(" ", map { "$_ => ". $old->{$_} } @fields);
823 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
829 for (grep { !exists($delete{$_}) } keys %insert) {
830 if ( $job ) { # progress bar
831 if ( time - $min_sec > $last ) {
832 my $error = $job->update_statustext(
833 int( 100 * $imported / $count ). ",Importing tax rates"
836 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
843 my $tax_rate = new FS::tax_rate( $insert{$_} );
844 my $error = $tax_rate->insert;
847 $dbh->rollback if $oldAutoCommit;
848 my $hashref = $insert{$_};
849 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
850 return "can't insert tax_rate for $line: $error";
856 for (grep { !exists($insert{$_}) } keys %delete) {
857 if ( $job ) { # progress bar
858 if ( time - $min_sec > $last ) {
859 my $error = $job->update_statustext(
860 int( 100 * $imported / $count ). ",Importing tax rates"
863 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
870 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
872 $dbh->rollback if $oldAutoCommit;
873 $tax_rate = $delete{$_};
874 return "can't find tax_rate to delete for: ".
875 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
876 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
878 my $error = $tax_rate->delete;
881 $dbh->rollback if $oldAutoCommit;
882 my $hashref = $delete{$_};
883 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
884 return "can't delete tax_rate for $line: $error";
890 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
892 return "Empty file!" unless ($imported || $format eq 'cch-update');
898 =item process_batch_import
900 Load a batch import as a queued JSRPC job
904 sub process_batch_import {
907 my $oldAutoCommit = $FS::UID::AutoCommit;
908 local $FS::UID::AutoCommit = 0;
911 my $param = thaw(decode_base64(shift));
912 my $args = '$job, encode_base64( nfreeze( $param ) )';
914 my $method = '_perform_batch_import';
915 if ( $param->{reload} ) {
916 $method = 'process_batch_reload';
919 eval "$method($args);";
921 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
926 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
929 sub _perform_batch_import {
932 my $param = thaw(decode_base64(shift));
933 my $format = $param->{'format'}; #well... this is all cch specific
935 my $files = $param->{'uploaded_files'}
936 or die "No files provided.";
938 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
941 if ( $format eq 'cch' || $format eq 'cch-fixed'
942 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
945 my $oldAutoCommit = $FS::UID::AutoCommit;
946 local $FS::UID::AutoCommit = 0;
949 my @insert_list = ();
950 my @delete_list = ();
951 my @predelete_list = ();
954 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
956 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
957 'CODE', \&FS::tax_class::batch_import,
958 'PLUS4', \&FS::cust_tax_location::batch_import,
959 'ZIP', \&FS::cust_tax_location::batch_import,
960 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
961 'DETAIL', \&FS::tax_rate::batch_import,
963 while( scalar(@list) ) {
964 my ( $name, $import_sub ) = splice( @list, 0, 2 );
965 my $file = lc($name). 'file';
967 unless ($files{$file}) {
968 #$error = "No $name supplied";
971 next if $name eq 'DETAIL' && $format =~ /update/;
973 my $filename = "$dir/". $files{$file};
975 if ( $format =~ /update/ ) {
977 ( $error, $insertname, $deletename ) =
978 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
982 unlink $filename or warn "Can't delete $filename: $!"
983 unless $keep_cch_files;
984 push @insert_list, $name, $insertname, $import_sub, $format;
985 if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
986 unshift @predelete_list, $name, $deletename, $import_sub, $format;
988 unshift @delete_list, $name, $deletename, $import_sub, $format;
993 push @insert_list, $name, $filename, $import_sub, $format;
1000 'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1001 if $format =~ /update/;
1003 my %addl_param = ();
1004 if ( $param->{'delete_only'} ) {
1005 $addl_param{'delete_only'} = $param->{'delete_only'};
1009 $error ||= _perform_cch_tax_import( $job,
1010 [ @predelete_list ],
1017 @list = ( @predelete_list, @insert_list, @delete_list );
1018 while( !$keep_cch_files && scalar(@list) ) {
1019 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1020 unlink $file or warn "Can't delete $file: $!";
1024 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1027 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1031 die "Unknown format: $format";
1037 sub _perform_cch_tax_import {
1038 my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1042 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1043 while( scalar(@$list) ) {
1044 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1045 my $fmt = "$format-update";
1046 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1047 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1048 my $param = { 'filehandle' => $fh,
1052 $error ||= &{$method}($param, $job);
1060 sub _perform_cch_insert_delete_split {
1061 my ($name, $filename, $dir, $format) = @_;
1065 open my $fh, "< $filename"
1066 or $error ||= "Can't open $name file $filename: $!";
1068 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1071 ) or die "can't open temp file: $!\n";
1072 my $insertname = $ifh->filename;
1074 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1077 ) or die "can't open temp file: $!\n";
1078 my $deletename = $dfh->filename;
1080 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1081 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1084 $handle = $ifh if $_ =~ /$insert_pattern/;
1085 $handle = $dfh if $_ =~ /$delete_pattern/;
1087 $error = "bad input line: $_" unless $handle;
1096 return ($error, $insertname, $deletename);
1099 sub _perform_cch_diff {
1100 my ($name, $newdir, $olddir) = @_;
1105 open my $oldcsvfh, "$olddir/$name.txt"
1106 or die "failed to open $olddir/$name.txt: $!\n";
1108 while(<$oldcsvfh>) {
1115 open my $newcsvfh, "$newdir/$name.txt"
1116 or die "failed to open $newdir/$name.txt: $!\n";
1118 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1121 ) or die "can't open temp file: $!\n";
1122 my $diffname = $dfh->filename;
1124 while(<$newcsvfh>) {
1126 if (exists($oldlines{$_})) {
1129 print $dfh $_, ',"I"', "\n";
1134 #false laziness w/above (sub batch_import)
1135 my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1136 excessrate effective_date taxauth taxtype taxcat taxname
1137 usetax useexcessrate fee unittype feemax maxtype passflag
1138 passtype basetype );
1139 my $numfields = scalar(@fields);
1141 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1143 for my $line (grep $oldlines{$_}, keys %oldlines) {
1145 $csv->parse($line) or do {
1146 #$dbh->rollback if $oldAutoCommit;
1147 die "can't parse: ". $csv->error_input();
1149 my @columns = $csv->fields();
1151 $csv->combine( splice(@columns, 0, $numfields) );
1153 print $dfh $csv->string, ',"D"', "\n";
1161 sub _cch_fetch_and_unzip {
1162 my ( $job, $urls, $secret, $dir ) = @_;
1164 my $ua = new LWP::UserAgent;
1165 foreach my $url (split ',', $urls) {
1166 my @name = split '/', $url; #somewhat restrictive
1167 my $name = pop @name;
1168 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1171 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1173 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1174 my $res = $ua->request(
1175 new HTTP::Request( GET => $url ),
1177 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1178 my $content_length = $_[1]->content_length;
1179 $imported += length($_[0]);
1180 if ( time - $min_sec > $last ) {
1181 my $error = $job->update_statustext(
1182 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1183 ",Downloading data from CCH"
1185 die $error if $error;
1190 die "download of $url failed: ". $res->status_line
1191 unless $res->is_success;
1194 my $error = $job->update_statustext( "0,Unpacking data" );
1195 die $error if $error;
1196 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1198 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1199 or die "unzip -P $secret -d $dir $dir/$name failed";
1200 #unlink "$dir/$name";
1204 sub _cch_extract_csv_from_dbf {
1205 my ( $job, $dir, $name ) = @_;
1210 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1211 my $error = $job->update_statustext( "0,Unpacking $name" );
1212 die $error if $error;
1213 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1214 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1215 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1216 unless defined($table);
1217 my $count = $table->last_record; # approximately;
1218 open my $csvfh, ">$dir.new/$name.txt"
1219 or die "failed to open $dir.new/$name.txt: $!\n";
1221 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1222 my @fields = $table->field_names;
1223 my $cursor = $table->prepare_select;
1225 sub { my $date = shift;
1226 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1229 while (my $row = $cursor->fetch_hashref) {
1230 $csv->combine( map { my $type = $table->field_type($_);
1232 &{$format_date}($row->{$_}) ;
1233 } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1234 sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1241 print $csvfh $csv->string, "\n";
1243 if ( time - $min_sec > $last ) {
1244 my $error = $job->update_statustext(
1245 int(100 * $imported/$count). ",Unpacking $name"
1247 die $error if $error;
1255 sub _remember_disabled_taxes {
1256 my ( $job, $format, $disabled_tax_rate ) = @_;
1260 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1262 my @items = qsearch( { table => 'tax_rate',
1263 hashref => { disabled => 'Y',
1264 data_vendor => $format,
1266 select => 'geocode, taxclassnum',
1269 my $count = scalar(@items);
1270 foreach my $tax_rate ( @items ) {
1271 if ( time - $min_sec > $last ) {
1272 $job->update_statustext(
1273 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1279 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1280 unless ( $tax_class ) {
1281 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1284 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1288 sub _remember_tax_products {
1289 my ( $job, $format, $taxproduct ) = @_;
1291 # XXX FIXME this loop only works when cch is the only data provider
1293 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1295 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1296 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1297 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1298 " optionname LIKE 'usage_taxproductnum_%' AND ".
1299 " optionvalue != '' )";
1300 my @items = qsearch( { table => 'part_pkg',
1301 select => 'DISTINCT pkgpart,taxproductnum',
1303 extra_sql => $extra_sql,
1306 my $count = scalar(@items);
1307 foreach my $part_pkg ( @items ) {
1308 if ( time - $min_sec > $last ) {
1309 $job->update_statustext(
1310 int( 100 * $imported / $count ). ",Remembering tax products"
1315 warn "working with package part ". $part_pkg->pkgpart.
1316 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1317 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1318 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1319 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1321 foreach my $option ( $part_pkg->part_pkg_option ) {
1322 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1325 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1326 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1327 $part_pkg_taxproduct->taxproduct
1328 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1333 sub _restore_remembered_tax_products {
1334 my ( $job, $format, $taxproduct ) = @_;
1338 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1339 my $count = scalar(keys %$taxproduct);
1340 foreach my $pkgpart ( keys %$taxproduct ) {
1341 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1342 if ( time - $min_sec > $last ) {
1343 $job->update_statustext(
1344 int( 100 * $imported / $count ). ",Restoring tax products"
1350 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1351 unless ( $part_pkg ) {
1352 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1355 my %options = $part_pkg->options;
1356 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1357 my $primary_svc = $part_pkg->svcpart;
1358 my $new = new FS::part_pkg { $part_pkg->hash };
1360 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1361 warn "working with class '$class'\n" if $DEBUG;
1362 my $part_pkg_taxproduct =
1363 qsearchs( 'part_pkg_taxproduct',
1364 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1365 data_vendor => $format,
1369 unless ( $part_pkg_taxproduct ) {
1370 return "failed to find part_pkg_taxproduct (".
1371 $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1374 if ( $class eq '' ) {
1375 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1379 $options{"usage_taxproductnum_$class"} =
1380 $part_pkg_taxproduct->taxproductnum;
1384 my $error = $new->replace( $part_pkg,
1385 'pkg_svc' => \%pkg_svc,
1386 'primary_svc' => $primary_svc,
1387 'options' => \%options,
1390 return $error if $error;
1397 sub _restore_remembered_disabled_taxes {
1398 my ( $job, $format, $disabled_tax_rate ) = @_;
1400 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1401 my $count = scalar(keys %$disabled_tax_rate);
1402 foreach my $key (keys %$disabled_tax_rate) {
1403 if ( time - $min_sec > $last ) {
1404 $job->update_statustext(
1405 int( 100 * $imported / $count ). ",Disabling tax rates"
1410 my ($geocode,$taxclass) = split /:/, $key, 2;
1411 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1412 taxclass => $taxclass,
1414 return "found multiple tax_class records for format $format class $taxclass"
1415 if scalar(@tax_class) > 1;
1417 unless (scalar(@tax_class)) {
1418 warn "no tax_class for format $format class $taxclass\n";
1423 qsearch('tax_rate', { data_vendor => $format,
1424 geocode => $geocode,
1425 taxclassnum => $tax_class[0]->taxclassnum,
1429 if (scalar(@tax_rate) > 1) {
1430 return "found multiple tax_rate records for format $format geocode ".
1431 "$geocode and taxclass $taxclass ( taxclassnum ".
1432 $tax_class[0]->taxclassnum. " )";
1435 if (scalar(@tax_rate)) {
1436 $tax_rate[0]->disabled('Y');
1437 my $error = $tax_rate[0]->replace;
1438 return $error if $error;
1443 sub _remove_old_tax_data {
1444 my ( $job, $format ) = @_;
1447 my $error = $job->update_statustext( "0,Removing old tax data" );
1448 die $error if $error;
1450 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1451 "WHERE data_vendor = ". $dbh->quote($format);
1452 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1455 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1457 foreach my $table ( @table ) {
1458 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1459 $dbh->quote($format);
1460 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1463 if ( $format eq 'cch' ) {
1464 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1465 $dbh->quote("$format-zip");
1466 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1472 sub _create_temporary_tables {
1473 my ( $job, $format ) = @_;
1476 my $error = $job->update_statustext( "0,Creating temporary tables" );
1477 die $error if $error;
1479 my @table = qw( tax_rate
1486 foreach my $table ( @table ) {
1488 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1489 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1495 sub _copy_from_temp {
1496 my ( $job, $format ) = @_;
1499 my $error = $job->update_statustext( "0,Making permanent" );
1500 die $error if $error;
1502 my @table = qw( tax_rate
1509 foreach my $table ( @table ) {
1511 "INSERT INTO public.$table SELECT * from $table";
1512 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1518 =item process_download_and_reload
1520 Download and process a tax update as a queued JSRPC job after wiping the
1521 existing wipable tax data.
1525 sub process_download_and_reload {
1526 _process_reload('process_download_and_update', @_);
1530 =item process_batch_reload
1532 Load and process a tax update from the provided files as a queued JSRPC job
1533 after wiping the existing wipable tax data.
1537 sub process_batch_reload {
1538 _process_reload('_perform_batch_import', @_);
1542 sub _process_reload {
1543 my ( $method, $job ) = ( shift, shift );
1545 my $param = thaw(decode_base64($_[0]));
1546 my $format = $param->{'format'}; #well... this is all cch specific
1548 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1550 if ( $job ) { # progress bar
1551 my $error = $job->update_statustext( 0 );
1552 die $error if $error;
1555 my $oldAutoCommit = $FS::UID::AutoCommit;
1556 local $FS::UID::AutoCommit = 0;
1561 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1562 "USING (taxclassnum) WHERE data_vendor = '$format'";
1563 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1565 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1566 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1567 if $sth->fetchrow_arrayref->[0];
1569 # really should get a table EXCLUSIVE lock here
1571 #remember disabled taxes
1572 my %disabled_tax_rate = ();
1573 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1575 #remember tax products
1576 my %taxproduct = ();
1577 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1580 $error ||= _create_temporary_tables( $job, $format );
1584 my $args = '$job, @_';
1585 eval "$method($args);";
1589 #restore taxproducts
1590 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1594 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1596 #wipe out the old data
1597 $error ||= _remove_old_tax_data( $job, $format );
1600 $error ||= _copy_from_temp( $job, $format );
1603 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1608 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1612 =item process_download_and_update
1614 Download and process a tax update as a queued JSRPC job
1618 sub process_download_and_update {
1621 my $param = thaw(decode_base64(shift));
1622 my $format = $param->{'format'}; #well... this is all cch specific
1624 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1626 if ( $job ) { # progress bar
1627 my $error = $job->update_statustext( 0);
1628 die $error if $error;
1631 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1632 my $dir = $cache_dir. 'taxdata';
1634 mkdir $dir or die "can't create $dir: $!\n";
1637 if ($format eq 'cch') {
1639 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1641 my $conf = new FS::Conf;
1642 die "direct download of tax data not enabled\n"
1643 unless $conf->exists('taxdatadirectdownload');
1644 my ( $urls, $username, $secret, $states ) =
1645 $conf->config('taxdatadirectdownload');
1646 die "No tax download URL provided. ".
1647 "Did you set the taxdatadirectdownload configuration value?\n"
1655 # really should get a table EXCLUSIVE lock here
1656 # check if initial import or update
1658 # relying on mkdir "$dir.new" as a mutex
1660 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1661 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1662 $sth->execute() or die $sth->errstr;
1663 my $update = $sth->fetchrow_arrayref->[0];
1665 # create cache and/or rotate old tax data
1670 opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1671 foreach my $file (readdir($dirh)) {
1672 unlink "$dir.9/$file" if (-f "$dir.9/$file");
1678 for (8, 7, 6, 5, 4, 3, 2, 1) {
1679 if ( -e "$dir.$_" ) {
1680 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1683 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1687 die "can't find previous tax data\n" if $update;
1691 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1693 # fetch and unpack the zip files
1695 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1697 # extract csv files from the dbf files
1699 foreach my $name ( @namelist ) {
1700 _cch_extract_csv_from_dbf( $job, $dir, $name );
1703 # generate the diff files
1706 foreach my $name ( @namelist ) {
1707 my $difffile = "$dir.new/$name.txt";
1709 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1710 die $error if $error;
1711 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1712 my $olddir = $update ? "$dir.1" : "";
1713 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1715 $difffile =~ s/^$cache_dir//;
1716 push @list, "${name}file:$difffile";
1719 # perform the import
1720 local $keep_cch_files = 1;
1721 $param->{uploaded_files} = join( ',', @list );
1722 $param->{format} .= '-update' if $update;
1724 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1726 rename "$dir.new", "$dir"
1727 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1730 die "Unknown format: $format";
1734 =item browse_queries PARAMS
1736 Returns a list consisting of a hashref suited for use as the argument
1737 to qsearch, and sql query string. Each is based on the PARAMS hashref
1738 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1739 from a form. This conveniently creates the query hashref and count_query
1740 string required by the browse and search elements. As a side effect,
1741 the PARAMS hashref is untainted and keys with unexpected values are removed.
1745 sub browse_queries {
1749 'table' => 'tax_rate',
1751 'order_by' => 'ORDER BY geocode, taxclassnum',
1756 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1757 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1759 delete $params->{data_vendor};
1762 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1763 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1764 'geocode LIKE '. dbh->quote($1.'%');
1766 delete $params->{geocode};
1769 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1770 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1773 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1774 ' taxclassnum = '. dbh->quote($1)
1776 delete $params->{taxclassnun};
1780 if ( $params->{tax_type} =~ /^(\d+)$/ );
1781 delete $params->{tax_type}
1785 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1786 delete $params->{tax_cat}
1789 my @taxclassnum = ();
1790 if ($tax_type || $tax_cat ) {
1791 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1792 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1793 @taxclassnum = map { $_->taxclassnum }
1794 qsearch({ 'table' => 'tax_class',
1796 'extra_sql' => "WHERE taxclass $compare",
1800 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1801 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1802 if ( @taxclassnum );
1804 unless ($params->{'showdisabled'}) {
1805 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1806 "( disabled = '' OR disabled IS NULL )";
1809 $query->{extra_sql} = $extra_sql;
1811 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1814 =item queue_liability_report PARAMS
1816 Launches a tax liability report.
1819 sub queue_liability_report {
1821 my $param = thaw(decode_base64(shift));
1824 $cgi->param('beginning', $param->{beginning});
1825 $cgi->param('ending', $param->{ending});
1826 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1827 my $agentnum = $param->{agentnum};
1828 if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1829 generate_liability_report(
1830 'beginning' => $beginning,
1831 'ending' => $ending,
1832 'agentnum' => $agentnum,
1833 'p' => $param->{RootURL},
1838 =item generate_liability_report PARAMS
1840 Generates a tax liability report. Provide a hash including desired
1841 agentnum, beginning, and ending
1845 #shit, all sorts of false laxiness w/report_newtax.cgi
1846 sub generate_liability_report {
1849 my ( $count, $last, $min_sec ) = _progressbar_foo();
1851 #let us open the temp file early
1852 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1853 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1855 UNLINK => 0, # not so temp
1856 ) or die "can't open report file: $!\n";
1858 my $conf = new FS::Conf;
1859 my $money_char = $conf->config('money_char') || '$';
1862 JOIN cust_bill USING ( invnum )
1863 LEFT JOIN cust_main USING ( custnum )
1867 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1868 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1870 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1872 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1875 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1876 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1877 die "agent not found" unless $agent;
1878 $agentname = $agent->agent;
1879 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1882 #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1883 my @taxparams = qw( city county state locationtaxid );
1884 my @params = ('itemdesc', @taxparams);
1886 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1888 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1889 #to FS::Report or FS::Record or who the fuck knows where)
1890 my $scalar_sql = sub {
1891 my( $r, $param, $sql ) = @_;
1892 my $sth = dbh->prepare($sql) or die dbh->errstr;
1893 $sth->execute( map $r->$_(), @$param )
1894 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1895 $sth->fetchrow_arrayref->[0] || 0;
1903 my @tax_and_location = qsearch({ table => 'cust_bill_pkg',
1905 hashref => { pkgpart => 0 },
1906 addl_from => $addl_from,
1907 extra_sql => $where,
1909 $count = scalar(@tax_and_location);
1910 foreach my $t ( @tax_and_location ) {
1913 if ( time - $min_sec > $last ) {
1914 $args{job}->update_statustext( int( 100 * $calculated / $count ).
1921 #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1922 my $label = join('~', map { $t->$_ } @params);
1923 $label = 'Tax'. $label if $label =~ /^~/;
1924 unless ( exists( $taxes{$label} ) ) {
1925 my ($baselabel, @trash) = split /~/, $label;
1927 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1928 $taxes{$label}->{'url_param'} =
1929 join(';', map { "$_=". uri_escape($t->$_) } @params);
1931 my $payby_itemdesc_loc =
1932 " payby != 'COMP' ".
1933 "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1934 "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1939 "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1941 my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1943 my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1945 $taxes{$label}->{'tax'} += $x;
1948 "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1950 "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1952 $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1953 " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1955 my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1957 $taxes{$label}->{'credit'} += $y;
1959 unless ( exists( $taxes{$baselabel} ) ) {
1961 $basetaxes{$baselabel}->{'label'} = $baselabel;
1962 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1963 $basetaxes{$baselabel}->{'base'} = 1;
1967 $basetaxes{$baselabel}->{'tax'} += $x;
1968 $basetaxes{$baselabel}->{'credit'} += $y;
1972 # calculate customer-exemption for this tax
1973 # calculate package-exemption for this tax
1974 # calculate monthly exemption (texas tax) for this tax
1975 # count up all the cust_tax_exempt_pkg records associated with
1976 # the actual line items.
1983 $args{job}->update_statustext( "0,Sorted" );
1989 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1990 my ($base, @trash) = split '~', $tax;
1991 my $basetax = delete( $basetaxes{$base} );
1993 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1994 $taxes{$tax}->{base} = 1;
1996 push @taxes, $basetax;
1999 push @taxes, $taxes{$tax};
2006 'credit' => $credit,
2011 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2012 $dateagentlink .= ';agentnum='. $args{agentnum}
2013 if length($agentname);
2014 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
2015 my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2017 print $report <<EOF;
2019 <% include("/elements/header.html", "$agentname Tax Report - ".
2021 ? time2str('%h %o %Y ', $args{beginning} )
2025 ( $args{ending} == 4294967295
2027 : time2str('%h %o %Y', $args{ending} )
2032 <% include('/elements/table-grid.html') %>
2035 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2036 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2037 <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2038 <TH CLASS="grid" BGCOLOR="#cccccc"> </TH>
2039 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2040 <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2044 my $bgcolor1 = '#eeeeee';
2045 my $bgcolor2 = '#ffffff';
2048 $count = scalar(@taxes);
2050 foreach my $tax ( @taxes ) {
2053 if ( time - $min_sec > $last ) {
2054 $args{job}->update_statustext( int( 100 * $calculated / $count ).
2061 if ( $bgcolor eq $bgcolor1 ) {
2062 $bgcolor = $bgcolor2;
2064 $bgcolor = $bgcolor1;
2068 if ( $tax->{'label'} ne 'Total' ) {
2069 $link = ';'. $tax->{'url_param'};
2072 print $report <<EOF;
2074 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2075 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2076 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2077 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2079 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2080 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2081 <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2082 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2083 <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2085 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2090 print $report <<EOF;
2097 my $reportname = $report->filename;
2100 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2101 $reportname =~ s/^$dropstring//;
2103 my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2104 die "<a href=$reporturl>view</a>\n";
2114 Mixing automatic and manual editing works poorly at present.
2116 Tax liability calculations take too long and arguably don't belong here.
2117 Tax liability report generation not entirely safe (escaped).
2121 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>