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 );
18 use DBIx::DBSchema::Table;
19 use DBIx::DBSchema::Column;
20 use FS::Record qw( qsearch qsearchs dbh dbdef );
22 use FS::cust_bill_pkg;
23 use FS::cust_tax_location;
24 use FS::tax_rate_location;
25 use FS::part_pkg_taxrate;
26 use FS::part_pkg_taxproduct;
28 use FS::Misc qw( csv_from_fixed );
30 #i'd like to dump these
31 use FS::CGI qw(rooturl popurl);
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_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 =item taxclass_description
250 Returns the human understandable value associated with the related
255 sub taxclass_description {
257 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
258 $tax_class ? $tax_class->description : '';
263 Returns the human understandable value associated with the unittype column
267 %tax_unittypes = ( '0' => 'access line',
274 $tax_unittypes{$self->unittype};
279 Returns the human understandable value associated with the maxtype column
283 %tax_maxtypes = ( '0' => 'receipts per invoice',
284 '1' => 'receipts per item',
285 '2' => 'total utility charges per utility tax year',
286 '3' => 'total charges per utility tax year',
287 '4' => 'receipts per access line',
288 '9' => 'monthly receipts per location',
293 $tax_maxtypes{$self->maxtype};
298 Returns the human understandable value associated with the basetype column
302 %tax_basetypes = ( '0' => 'sale price',
303 '1' => 'gross receipts',
304 '2' => 'sales taxable telecom revenue',
305 '3' => 'minutes carried',
306 '4' => 'minutes billed',
307 '5' => 'gross operating revenue',
308 '6' => 'access line',
310 '8' => 'gross revenue',
311 '9' => 'portion gross receipts attributable to interstate service',
312 '10' => 'access line',
313 '11' => 'gross profits',
314 '12' => 'tariff rate',
316 '15' => 'prior year gross receipts',
321 $tax_basetypes{$self->basetype};
326 Returns the human understandable value associated with the taxauth column
330 %tax_authorities = ( '0' => 'federal',
335 '5' => 'county administered by state',
336 '6' => 'city administered by state',
337 '7' => 'city administered by county',
338 '8' => 'local administered by state',
339 '9' => 'local administered by county',
344 $tax_authorities{$self->taxauth};
349 Returns the human understandable value associated with the passtype column
353 %tax_passtypes = ( '0' => 'separate tax line',
354 '1' => 'separate surcharge line',
355 '2' => 'surcharge not separated',
356 '3' => 'included in base rate',
361 $tax_passtypes{$self->passtype};
364 =item taxline TAXABLES, [ OPTIONSHASH ]
366 Returns a listref of a name and an amount of tax calculated for the list
367 of packages/amounts referenced by TAXABLES. If an error occurs, a message
368 is returned as a scalar.
378 if (ref($_[0]) eq 'ARRAY') {
383 #exemptions would be broken in this case
386 my $name = $self->taxname;
387 $name = 'Other surcharges'
388 if ($self->passtype == 2);
391 if ( $self->disabled ) { # we always know how to handle disabled taxes
398 my $taxable_charged = 0;
399 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
402 warn "calculating taxes for ". $self->taxnum. " on ".
403 join (",", map { $_->pkgnum } @cust_bill_pkg)
406 if ($self->passflag eq 'N') {
407 # return "fatal: can't (yet) handle taxes not passed to the customer";
408 # until someone needs to track these in freeside
415 my $maxtype = $self->maxtype || 0;
416 if ($maxtype != 0 && $maxtype != 9) {
417 return $self->_fatal_or_null( 'tax with "'.
418 $self->maxtype_name. '" threshold'
424 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
428 # we treat gross revenue as gross receipts and expect the tax data
429 # to DTRT (i.e. tax on tax rules)
430 if ($self->basetype != 0 && $self->basetype != 1 &&
431 $self->basetype != 5 && $self->basetype != 6 &&
432 $self->basetype != 7 && $self->basetype != 8 &&
433 $self->basetype != 14
436 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
439 unless ($self->setuptax =~ /^Y$/i) {
440 $taxable_charged += $_->setup foreach @cust_bill_pkg;
442 unless ($self->recurtax =~ /^Y$/i) {
443 $taxable_charged += $_->recur foreach @cust_bill_pkg;
446 my $taxable_units = 0;
447 unless ($self->recurtax =~ /^Y$/i) {
448 if (( $self->unittype || 0 ) == 0) {
450 foreach (@cust_bill_pkg) {
451 $taxable_units += $_->units
452 unless $seen{$_->pkgnum};
455 }elsif ($self->unittype == 1) {
456 return $self->_fatal_or_null( 'fee with minute unit type' );
457 }elsif ($self->unittype == 2) {
460 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
465 # XXX insert exemption handling here
467 # the tax or fee is applied to taxbase or feebase and then
468 # the excessrate or excess fee is applied to taxmax or feemax
471 $amount += $taxable_charged * $self->tax;
472 $amount += $taxable_units * $self->fee;
474 warn "calculated taxes as [ $name, $amount ]\n"
485 my ($self, $error) = @_;
487 my $conf = new FS::Conf;
489 $error = "can't yet handle $error";
490 my $name = $self->taxname;
491 $name = 'Other surcharges'
492 if ($self->passtype == 2);
494 if ($conf->exists('ignore_incalculable_taxes')) {
495 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
496 return { name => $name, amount => 0 };
498 return "fatal: $error";
502 =item tax_on_tax CUST_MAIN
504 Returns a list of taxes which are candidates for taxing taxes for the
505 given customer (see L<FS::cust_main>)
513 my $cust_main = shift;
515 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
519 my $geocode = $cust_main->geocode($self->data_vendor);
523 my $extra_sql = ' AND ('.
524 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
529 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
530 my $select = 'DISTINCT ON(taxclassnum) *';
532 # should qsearch preface columns with the table to facilitate joins?
533 my @taxclassnums = map { $_->taxclassnum }
534 qsearch( { 'table' => 'part_pkg_taxrate',
536 'hashref' => { 'data_vendor' => $self->data_vendor,
537 'taxclassnumtaxed' => $self->taxclassnum,
539 'extra_sql' => $extra_sql,
540 'order_by' => $order_by,
543 return () unless @taxclassnums;
546 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
548 qsearch({ 'table' => 'tax_rate',
549 'hashref' => { 'geocode' => $geocode, },
550 'extra_sql' => $extra_sql,
555 =item tax_rate_location
557 Returns an object representing the location associated with this tax
558 (see L<FS::tax_rate_location>)
562 sub tax_rate_location {
565 qsearchs({ 'table' => 'tax_rate_location',
566 'hashref' => { 'data_vendor' => $self->data_vendor,
567 'geocode' => $self->geocode,
571 new FS::tax_rate_location;
585 sub _progressbar_foo {
590 my ($param, $job) = @_;
592 my $fh = $param->{filehandle};
593 my $format = $param->{'format'};
601 my @column_lengths = ();
602 my @column_callbacks = ();
603 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
604 $format =~ s/-fixed//;
605 my $date_format = sub { my $r='';
606 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
609 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
610 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 );
611 push @column_lengths, 1 if $format eq 'cch-update';
612 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
613 $column_callbacks[8] = $date_format;
617 my ( $count, $last, $min_sec ) = _progressbar_foo();
618 if ( $job || scalar(@column_callbacks) ) {
620 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
621 return $error if $error;
625 if ( $format eq 'cch' || $format eq 'cch-update' ) {
626 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
627 excessrate effective_date taxauth taxtype taxcat taxname
628 usetax useexcessrate fee unittype feemax maxtype passflag
630 push @fields, 'actionflag' if $format eq 'cch-update';
635 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
636 $hash->{'data_vendor'} ='cch';
637 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
638 time_zone => 'floating',
640 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
641 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
643 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
644 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
647 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
649 my %tax_class = ( 'data_vendor' => 'cch',
650 'taxclass' => $taxclassid,
653 my $tax_class = qsearchs( 'tax_class', \%tax_class );
654 return "Error updating tax rate: no tax class $taxclassid"
657 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
659 foreach (qw( taxtype taxcat )) {
663 my %passflagmap = ( '0' => '',
667 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
668 if exists $passflagmap{$hash->{'passflag'}};
670 foreach (keys %$hash) {
671 $hash->{$_} = substr($hash->{$_}, 0, 80)
672 if length($hash->{$_}) > 80;
675 my $actionflag = delete($hash->{'actionflag'});
677 $hash->{'taxname'} =~ s/`/'/g;
678 $hash->{'taxname'} =~ s|\\|/|g;
680 return '' if $format eq 'cch'; # but not cch-update
682 if ($actionflag eq 'I') {
683 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
684 }elsif ($actionflag eq 'D') {
685 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
687 return "Unexpected action flag: ". $hash->{'actionflag'};
690 delete($hash->{$_}) for keys %$hash;
696 } elsif ( $format eq 'extended' ) {
697 die "unimplemented\n";
701 die "unknown format $format";
704 eval "use Text::CSV_XS;";
707 my $csv = new Text::CSV_XS;
711 local $SIG{HUP} = 'IGNORE';
712 local $SIG{INT} = 'IGNORE';
713 local $SIG{QUIT} = 'IGNORE';
714 local $SIG{TERM} = 'IGNORE';
715 local $SIG{TSTP} = 'IGNORE';
716 local $SIG{PIPE} = 'IGNORE';
718 my $oldAutoCommit = $FS::UID::AutoCommit;
719 local $FS::UID::AutoCommit = 0;
722 while ( defined($line=<$fh>) ) {
723 $csv->parse($line) or do {
724 $dbh->rollback if $oldAutoCommit;
725 return "can't parse: ". $csv->error_input();
728 if ( $job ) { # progress bar
729 if ( time - $min_sec > $last ) {
730 my $error = $job->update_statustext(
731 int( 100 * $imported / $count ). ",Importing tax rates"
734 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
741 my @columns = $csv->fields();
743 my %tax_rate = ( 'data_vendor' => $format );
744 foreach my $field ( @fields ) {
745 $tax_rate{$field} = shift @columns;
747 if ( scalar( @columns ) ) {
748 $dbh->rollback if $oldAutoCommit;
749 return "Unexpected trailing columns in line (wrong format?): $line";
752 my $error = &{$hook}(\%tax_rate);
754 $dbh->rollback if $oldAutoCommit;
758 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
760 my $tax_rate = new FS::tax_rate( \%tax_rate );
761 $error = $tax_rate->insert;
764 $dbh->rollback if $oldAutoCommit;
765 return "can't insert tax_rate for $line: $error";
774 for (grep { !exists($delete{$_}) } keys %insert) {
775 if ( $job ) { # progress bar
776 if ( time - $min_sec > $last ) {
777 my $error = $job->update_statustext(
778 int( 100 * $imported / $count ). ",Importing tax rates"
781 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
788 my $tax_rate = new FS::tax_rate( $insert{$_} );
789 my $error = $tax_rate->insert;
792 $dbh->rollback if $oldAutoCommit;
793 my $hashref = $insert{$_};
794 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
795 return "can't insert tax_rate for $line: $error";
801 for (grep { exists($delete{$_}) } keys %insert) {
802 if ( $job ) { # progress bar
803 if ( time - $min_sec > $last ) {
804 my $error = $job->update_statustext(
805 int( 100 * $imported / $count ). ",Importing tax rates"
808 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
815 my $old = qsearchs( 'tax_rate', $delete{$_} );
817 $dbh->rollback if $oldAutoCommit;
819 return "can't find tax_rate to replace for: ".
820 #join(" ", map { "$_ => ". $old->{$_} } @fields);
821 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
823 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
824 $new->taxnum($old->taxnum);
825 my $error = $new->replace($old);
828 $dbh->rollback if $oldAutoCommit;
829 my $hashref = $insert{$_};
830 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
831 return "can't replace tax_rate for $line: $error";
838 for (grep { !exists($insert{$_}) } keys %delete) {
839 if ( $job ) { # progress bar
840 if ( time - $min_sec > $last ) {
841 my $error = $job->update_statustext(
842 int( 100 * $imported / $count ). ",Importing tax rates"
845 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
852 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
854 $dbh->rollback if $oldAutoCommit;
855 $tax_rate = $delete{$_};
856 return "can't find tax_rate to delete for: ".
857 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
858 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
860 my $error = $tax_rate->delete;
863 $dbh->rollback if $oldAutoCommit;
864 my $hashref = $delete{$_};
865 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
866 return "can't delete tax_rate for $line: $error";
872 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
874 return "Empty file!" unless ($imported || $format eq 'cch-update');
880 =item process_batch_import
882 Load a batch import as a queued JSRPC job
886 sub process_batch_import {
889 my $oldAutoCommit = $FS::UID::AutoCommit;
890 local $FS::UID::AutoCommit = 0;
893 my $param = thaw(decode_base64(shift));
894 my $args = '$job, encode_base64( nfreeze( $param ) )';
896 my $method = '_perform_batch_import';
897 if ( $param->{reload} ) {
898 $method = 'process_batch_reload';
901 eval "$method($args);";
903 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
908 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
911 sub _perform_batch_import {
914 my $param = thaw(decode_base64(shift));
915 my $format = $param->{'format'}; #well... this is all cch specific
917 my $files = $param->{'uploaded_files'}
918 or die "No files provided.";
920 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
923 if ( $format eq 'cch' || $format eq 'cch-fixed'
924 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
927 my $oldAutoCommit = $FS::UID::AutoCommit;
928 local $FS::UID::AutoCommit = 0;
931 my @insert_list = ();
932 my @delete_list = ();
933 my @predelete_list = ();
936 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
938 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
939 'CODE', \&FS::tax_class::batch_import,
940 'PLUS4', \&FS::cust_tax_location::batch_import,
941 'ZIP', \&FS::cust_tax_location::batch_import,
942 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
943 'DETAIL', \&FS::tax_rate::batch_import,
945 while( scalar(@list) ) {
946 my ( $name, $import_sub ) = splice( @list, 0, 2 );
947 my $file = lc($name). 'file';
949 unless ($files{$file}) {
950 $error = "No $name supplied";
953 next if $name eq 'DETAIL' && $format =~ /update/;
955 my $filename = "$dir/". $files{$file};
957 if ( $format =~ /update/ ) {
959 ( $error, $insertname, $deletename ) =
960 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
964 unlink $filename or warn "Can't delete $filename: $!"
965 unless $keep_cch_files;
966 push @insert_list, $name, $insertname, $import_sub, $format;
967 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
968 unshift @predelete_list, $name, $deletename, $import_sub, $format;
970 unshift @delete_list, $name, $deletename, $import_sub, $format;
975 push @insert_list, $name, $filename, $import_sub, $format;
982 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
983 if $format =~ /update/;
985 $error ||= _perform_cch_tax_import( $job,
992 @list = ( @predelete_list, @insert_list, @delete_list );
993 while( !$keep_cch_files && scalar(@list) ) {
994 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
995 unlink $file or warn "Can't delete $file: $!";
999 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1002 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1006 die "Unknown format: $format";
1012 sub _perform_cch_tax_import {
1013 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1016 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1017 while( scalar(@$list) ) {
1018 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1019 my $fmt = "$format-update";
1020 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1021 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1022 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1030 sub _perform_cch_insert_delete_split {
1031 my ($name, $filename, $dir, $format) = @_;
1035 open my $fh, "< $filename"
1036 or $error ||= "Can't open $name file $filename: $!";
1038 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1041 ) or die "can't open temp file: $!\n";
1042 my $insertname = $ifh->filename;
1044 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1047 ) or die "can't open temp file: $!\n";
1048 my $deletename = $dfh->filename;
1050 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1051 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1054 $handle = $ifh if $_ =~ /$insert_pattern/;
1055 $handle = $dfh if $_ =~ /$delete_pattern/;
1057 $error = "bad input line: $_" unless $handle;
1066 return ($error, $insertname, $deletename);
1069 sub _perform_cch_diff {
1070 my ($name, $newdir, $olddir) = @_;
1075 open my $oldcsvfh, "$olddir/$name.txt"
1076 or die "failed to open $olddir/$name.txt: $!\n";
1078 while(<$oldcsvfh>) {
1085 open my $newcsvfh, "$newdir/$name.txt"
1086 or die "failed to open $newdir/$name.txt: $!\n";
1088 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1091 ) or die "can't open temp file: $!\n";
1092 my $diffname = $dfh->filename;
1094 while(<$newcsvfh>) {
1096 if (exists($oldlines{$_})) {
1099 print $dfh $_, ',"I"', "\n";
1104 for (keys %oldlines) {
1105 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1113 sub _cch_fetch_and_unzip {
1114 my ( $job, $urls, $secret, $dir ) = @_;
1116 my $ua = new LWP::UserAgent;
1117 foreach my $url (split ',', $urls) {
1118 my @name = split '/', $url; #somewhat restrictive
1119 my $name = pop @name;
1120 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1123 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1125 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1126 my $res = $ua->request(
1127 new HTTP::Request( GET => $url ),
1129 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1130 my $content_length = $_[1]->content_length;
1131 $imported += length($_[0]);
1132 if ( time - $min_sec > $last ) {
1133 my $error = $job->update_statustext(
1134 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1135 ",Downloading data from CCH"
1137 die $error if $error;
1142 die "download of $url failed: ". $res->status_line
1143 unless $res->is_success;
1146 my $error = $job->update_statustext( "0,Unpacking data" );
1147 die $error if $error;
1148 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1150 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1151 or die "unzip -P $secret -d $dir $dir/$name failed";
1152 #unlink "$dir/$name";
1156 sub _cch_extract_csv_from_dbf {
1157 my ( $job, $dir, $name ) = @_;
1159 eval "use Text::CSV_XS;";
1165 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1166 my $error = $job->update_statustext( "0,Unpacking $name" );
1167 die $error if $error;
1168 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1169 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1170 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1171 unless defined($table);
1172 my $count = $table->last_record; # approximately;
1173 open my $csvfh, ">$dir.new/$name.txt"
1174 or die "failed to open $dir.new/$name.txt: $!\n";
1176 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1177 my @fields = $table->field_names;
1178 my $cursor = $table->prepare_select;
1180 sub { my $date = shift;
1181 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1184 while (my $row = $cursor->fetch_hashref) {
1185 $csv->combine( map { ($table->field_type($_) eq 'D')
1186 ? &{$format_date}($row->{$_})
1191 print $csvfh $csv->string, "\n";
1193 if ( time - $min_sec > $last ) {
1194 my $error = $job->update_statustext(
1195 int(100 * $imported/$count). ",Unpacking $name"
1197 die $error if $error;
1205 sub _remember_disabled_taxes {
1206 my ( $job, $format, $disabled_tax_rate ) = @_;
1210 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1212 my @items = qsearch( { table => 'tax_rate',
1213 hashref => { disabled => 'Y',
1214 data_vendor => $format,
1216 select => 'geocode, taxclassnum',
1219 my $count = scalar(@items);
1220 foreach my $tax_rate ( @items ) {
1221 if ( time - $min_sec > $last ) {
1222 $job->update_statustext(
1223 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1229 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1230 unless ( $tax_class ) {
1231 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1234 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1238 sub _remember_tax_products {
1239 my ( $job, $format, $taxproduct ) = @_;
1241 # XXX FIXME this loop only works when cch is the only data provider
1243 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1245 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1246 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1247 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1248 " optionname LIKE 'usage_taxproductnum_%' AND ".
1249 " optionvalue != '' )";
1250 my @items = qsearch( { table => 'part_pkg',
1251 select => 'DISTINCT pkgpart,taxproductnum',
1253 extra_sql => $extra_sql,
1256 my $count = scalar(@items);
1257 foreach my $part_pkg ( @items ) {
1258 if ( time - $min_sec > $last ) {
1259 $job->update_statustext(
1260 int( 100 * $imported / $count ). ",Remembering tax products"
1265 warn "working with package part ". $part_pkg->pkgpart.
1266 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1267 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1268 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1269 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1271 foreach my $option ( $part_pkg->part_pkg_option ) {
1272 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1275 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1276 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1277 $part_pkg_taxproduct->taxproduct
1278 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1283 sub _restore_remembered_tax_products {
1284 my ( $job, $format, $taxproduct ) = @_;
1288 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1289 my $count = scalar(keys %$taxproduct);
1290 foreach my $pkgpart ( keys %$taxproduct ) {
1291 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1292 if ( time - $min_sec > $last ) {
1293 $job->update_statustext(
1294 int( 100 * $imported / $count ). ",Restoring tax products"
1300 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1301 unless ( $part_pkg ) {
1302 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1305 my %options = $part_pkg->options;
1306 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1307 my $primary_svc = $part_pkg->svcpart;
1308 my $new = new FS::part_pkg { $part_pkg->hash };
1310 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1311 warn "working with class '$class'\n" if $DEBUG;
1312 my $part_pkg_taxproduct =
1313 qsearchs( 'part_pkg_taxproduct',
1314 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1315 data_vendor => $format,
1319 unless ( $part_pkg_taxproduct ) {
1320 return "failed to find part_pkg_taxproduct (".
1321 $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1324 if ( $class eq '' ) {
1325 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1329 $options{"usage_taxproductnum_$class"} =
1330 $part_pkg_taxproduct->taxproductnum;
1334 my $error = $new->replace( $part_pkg,
1335 'pkg_svc' => \%pkg_svc,
1336 'primary_svc' => $primary_svc,
1337 'options' => \%options,
1340 return $error if $error;
1347 sub _restore_remembered_disabled_taxes {
1348 my ( $job, $format, $disabled_tax_rate ) = @_;
1350 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1351 my $count = scalar(keys %$disabled_tax_rate);
1352 foreach my $key (keys %$disabled_tax_rate) {
1353 if ( time - $min_sec > $last ) {
1354 $job->update_statustext(
1355 int( 100 * $imported / $count ). ",Disabling tax rates"
1360 my ($geocode,$taxclass) = split /:/, $key, 2;
1361 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1362 taxclass => $taxclass,
1364 return "found multiple tax_class records for format $format class $taxclass"
1365 if scalar(@tax_class) > 1;
1367 unless (scalar(@tax_class)) {
1368 warn "no tax_class for format $format class $taxclass\n";
1373 qsearch('tax_rate', { data_vendor => $format,
1374 geocode => $geocode,
1375 taxclassnum => $tax_class[0]->taxclassnum,
1379 if (scalar(@tax_rate) > 1) {
1380 return "found multiple tax_rate records for format $format geocode ".
1381 "$geocode and taxclass $taxclass ( taxclassnum ".
1382 $tax_class[0]->taxclassnum. " )";
1385 if (scalar(@tax_rate)) {
1386 $tax_rate[0]->disabled('Y');
1387 my $error = $tax_rate[0]->replace;
1388 return $error if $error;
1393 sub _remove_old_tax_data {
1394 my ( $job, $format ) = @_;
1397 my $error = $job->update_statustext( "0,Removing old tax data" );
1398 die $error if $error;
1400 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1401 "WHERE data_vendor = ". $dbh->quote($format);
1402 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1405 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1407 foreach my $table ( @table ) {
1408 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1409 $dbh->quote($format);
1410 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1413 if ( $format eq 'cch' ) {
1414 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1415 $dbh->quote("$format-zip");
1416 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1422 sub _create_temporary_tables {
1423 my ( $job, $format ) = @_;
1426 my $error = $job->update_statustext( "0,Creating temporary tables" );
1427 die $error if $error;
1429 my @table = qw( tax_rate
1436 foreach my $table ( @table ) {
1438 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1439 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1445 sub _copy_from_temp {
1446 my ( $job, $format ) = @_;
1449 my $error = $job->update_statustext( "0,Making permanent" );
1450 die $error if $error;
1452 my @table = qw( tax_rate
1459 foreach my $table ( @table ) {
1461 "INSERT INTO public.$table SELECT * from $table";
1462 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1468 =item process_download_and_reload
1470 Download and process a tax update as a queued JSRPC job after wiping the
1471 existing wipable tax data.
1475 sub process_download_and_reload {
1476 _process_reload('process_download_and_update', @_);
1480 =item process_batch_reload
1482 Load and process a tax update from the provided files as a queued JSRPC job
1483 after wiping the existing wipable tax data.
1487 sub process_batch_reload {
1488 _process_reload('_perform_batch_import', @_);
1492 sub _process_reload {
1493 my ( $method, $job ) = ( shift, shift );
1495 my $param = thaw(decode_base64($_[0]));
1496 my $format = $param->{'format'}; #well... this is all cch specific
1498 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1500 if ( $job ) { # progress bar
1501 my $error = $job->update_statustext( 0 );
1502 die $error if $error;
1505 my $oldAutoCommit = $FS::UID::AutoCommit;
1506 local $FS::UID::AutoCommit = 0;
1511 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1512 "USING (taxclassnum) WHERE data_vendor = '$format'";
1513 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1515 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1516 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1517 if $sth->fetchrow_arrayref->[0];
1519 # really should get a table EXCLUSIVE lock here
1521 #remember disabled taxes
1522 my %disabled_tax_rate = ();
1523 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1525 #remember tax products
1526 my %taxproduct = ();
1527 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1530 $error ||= _create_temporary_tables( $job, $format );
1534 my $args = '$job, @_';
1535 eval "$method($args);";
1539 #restore taxproducts
1540 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1544 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1546 #wipe out the old data
1547 $error ||= _remove_old_tax_data( $job, $format );
1550 $error ||= _copy_from_temp( $job, $format );
1553 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1558 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1562 =item process_download_and_update
1564 Download and process a tax update as a queued JSRPC job
1568 sub process_download_and_update {
1571 my $param = thaw(decode_base64(shift));
1572 my $format = $param->{'format'}; #well... this is all cch specific
1574 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1576 if ( $job ) { # progress bar
1577 my $error = $job->update_statustext( 0);
1578 die $error if $error;
1581 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1582 my $dir = $cache_dir. 'taxdata';
1584 mkdir $dir or die "can't create $dir: $!\n";
1587 if ($format eq 'cch') {
1589 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1591 my $conf = new FS::Conf;
1592 die "direct download of tax data not enabled\n"
1593 unless $conf->exists('taxdatadirectdownload');
1594 my ( $urls, $username, $secret, $states ) =
1595 $conf->config('taxdatadirectdownload');
1596 die "No tax download URL provided. ".
1597 "Did you set the taxdatadirectdownload configuration value?\n"
1605 # really should get a table EXCLUSIVE lock here
1606 # check if initial import or update
1608 # relying on mkdir "$dir.new" as a mutex
1610 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1611 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1612 $sth->execute() or die $sth->errstr;
1613 my $update = $sth->fetchrow_arrayref->[0];
1615 # create cache and/or rotate old tax data
1620 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1621 foreach my $file (readdir($dirh)) {
1622 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1629 if ( -e "$dir.$_" ) {
1630 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1633 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1637 die "can't find previous tax data\n" if $update;
1641 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1643 # fetch and unpack the zip files
1645 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1647 # extract csv files from the dbf files
1649 foreach my $name ( @namelist ) {
1650 _cch_extract_csv_from_dbf( $job, $dir, $name );
1653 # generate the diff files
1656 foreach my $name ( @namelist ) {
1657 my $difffile = "$dir.new/$name.txt";
1659 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1660 die $error if $error;
1661 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1662 my $olddir = $update ? "$dir.1" : "";
1663 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1665 $difffile =~ s/^$cache_dir//;
1666 push @list, "${name}file:$difffile";
1669 # perform the import
1670 local $keep_cch_files = 1;
1671 $param->{uploaded_files} = join( ',', @list );
1672 $param->{format} .= '-update' if $update;
1674 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1676 rename "$dir.new", "$dir"
1677 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1680 die "Unknown format: $format";
1684 =item browse_queries PARAMS
1686 Returns a list consisting of a hashref suited for use as the argument
1687 to qsearch, and sql query string. Each is based on the PARAMS hashref
1688 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1689 from a form. This conveniently creates the query hashref and count_query
1690 string required by the browse and search elements. As a side effect,
1691 the PARAMS hashref is untainted and keys with unexpected values are removed.
1695 sub browse_queries {
1699 'table' => 'tax_rate',
1701 'order_by' => 'ORDER BY geocode, taxclassnum',
1706 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1707 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1709 delete $params->{data_vendor};
1712 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1713 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1714 'geocode LIKE '. dbh->quote($1.'%');
1716 delete $params->{geocode};
1719 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1720 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1723 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1724 ' taxclassnum = '. dbh->quote($1)
1726 delete $params->{taxclassnun};
1730 if ( $params->{tax_type} =~ /^(\d+)$/ );
1731 delete $params->{tax_type}
1735 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1736 delete $params->{tax_cat}
1739 my @taxclassnum = ();
1740 if ($tax_type || $tax_cat ) {
1741 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1742 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1743 @taxclassnum = map { $_->taxclassnum }
1744 qsearch({ 'table' => 'tax_class',
1746 'extra_sql' => "WHERE taxclass $compare",
1750 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1751 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1752 if ( @taxclassnum );
1754 unless ($params->{'showdisabled'}) {
1755 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1756 "( disabled = '' OR disabled IS NULL )";
1759 $query->{extra_sql} = $extra_sql;
1761 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1764 =item queue_liability_report PARAMS
1766 Launches a tax liability report.
1769 sub queue_liability_report {
1771 my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1772 my $agentnum = $cgi->param('agentnum');
1773 $agentnum =~ /^(\d+)$/ ? $agentnum = $1 : $agentnum = '';
1774 my $job = new FS::queue { job => 'FS::tax_rate::generate_liability_report' };
1776 'beginning' => $beginning,
1777 'ending' => $ending,
1778 'agentnum' => $agentnum,
1780 'rooturl' => rooturl,
1784 =item generate_liability_report PARAMS
1786 Generates a tax liability report. Provide a hash including desired
1787 agentnum, beginning, and ending
1791 sub generate_liability_report {
1794 #let us open the temp file early
1795 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1796 my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1798 UNLINK => 0, # not so temp
1799 ) or die "can't open report file: $!\n";
1801 my $conf = new FS::Conf;
1802 my $money_char = $conf->config('money_char') || '$';
1805 JOIN cust_bill USING ( invnum )
1806 LEFT JOIN cust_main USING ( custnum )
1810 "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1811 my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1813 my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1815 my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1818 if ( $args{agentnum} =~ /^(\d+)$/ ) {
1819 my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1820 die "agent not found" unless $agent;
1821 $agentname = $agent->agent;
1822 $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1825 # my ( $location_sql, @location_param ) = FS::cust_pkg->location_sql;
1826 # $where .= " AND $location_sql";
1827 #my @taxparam = ( 'itemdesc', @location_param );
1828 # now something along the lines of geocode matching ?
1829 #$where .= FS::cust_pkg->_location_sql_where('cust_tax_location');;
1830 my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1832 my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1834 #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1835 #to FS::Report or FS::Record or who the fuck knows where)
1836 my $scalar_sql = sub {
1837 my( $r, $param, $sql ) = @_;
1838 my $sth = dbh->prepare($sql) or die dbh->errstr;
1839 $sth->execute( map $r->$_(), @$param )
1840 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1841 $sth->fetchrow_arrayref->[0] || 0;
1848 foreach my $t (qsearch({ table => 'cust_bill_pkg',
1850 hashref => { pkgpart => 0 },
1851 addl_from => $addl_from,
1852 extra_sql => $where,
1856 my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1857 my $label = join('~', map { $t->$_ } @params);
1858 $label = 'Tax'. $label if $label =~ /^~/;
1859 unless ( exists( $taxes{$label} ) ) {
1860 my ($baselabel, @trash) = split /~/, $label;
1862 $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1863 $taxes{$label}->{'url_param'} =
1864 join(';', map { "$_=". uri_escape($t->$_) } @params);
1866 my $taxwhere = "FROM cust_bill_pkg $addl_from $where AND payby != 'COMP' ".
1867 "AND ". join( ' AND ', map { "( $_ = ? OR ? = '' AND $_ IS NULL)" } @taxparam );
1869 my $sql = "SELECT SUM(cust_bill_pkg.setup+cust_bill_pkg.recur) ".
1870 " $taxwhere AND cust_bill_pkg.pkgnum = 0";
1872 my $x = &{$scalar_sql}($t, [ map { $_, $_ } @params ], $sql );
1874 $taxes{$label}->{'tax'} += $x;
1876 unless ( exists( $taxes{$baselabel} ) ) {
1878 $basetaxes{$baselabel}->{'label'} = $baselabel;
1879 $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1880 $basetaxes{$baselabel}->{'base'} = 1;
1884 $basetaxes{$baselabel}->{'tax'} += $x;
1888 # calculate customer-exemption for this tax
1889 # calculate package-exemption for this tax
1890 # calculate monthly exemption (texas tax) for this tax
1891 # count up all the cust_tax_exempt_pkg records associated with
1892 # the actual line items.
1899 foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1900 my ($base, @trash) = split '~', $tax;
1901 my $basetax = delete( $basetaxes{$base} );
1903 if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1904 $taxes{$tax}->{base} = 1;
1906 push @taxes, $basetax;
1909 push @taxes, $taxes{$tax};
1920 my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1921 $dateagentlink .= ';agentnum='. $args{agentnum}
1922 if length($agentname);
1923 my $baselink = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1926 print $report <<EOF;
1928 <% include("/elements/header.html", "$agentname Tax Report - ".
1930 ? time2str('%h %o %Y ', $args{beginning} )
1934 ( $args{ending} == 4294967295
1936 : time2str('%h %o %Y', $args{ending} )
1941 <% include('/elements/table-grid.html') %>
1944 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1945 <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
1946 <TH CLASS="grid" BGCOLOR="#cccccc">Tax collected</TH>
1950 my $bgcolor1 = '#eeeeee';
1951 my $bgcolor2 = '#ffffff';
1954 foreach my $tax ( @taxes ) {
1956 if ( $bgcolor eq $bgcolor1 ) {
1957 $bgcolor = $bgcolor2;
1959 $bgcolor = $bgcolor1;
1963 if ( $tax->{'label'} ne 'Total' ) {
1964 $link = ';'. $tax->{'url_param'};
1967 print $report <<EOF;
1969 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
1970 <% $tax->{base} ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
1971 <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
1972 <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
1974 <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
1979 print $report <<EOF;
1986 my $reportname = $report->filename;
1989 my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
1990 $reportname =~ s/^$dropstring//;
1992 my $reporturl = $args{rooturl}. "/misc/queued_report?report=$reportname";
1993 die "<a href=$reporturl>view</a>\n";
2003 Mixing automatic and manual editing works poorly at present.
2005 Tax liability calculations take too long and arguably don't belong here.
2006 Tax liability report generation not entirely safe (escaped).
2010 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base