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 @ISA = qw( FS::Record );
33 $me = '[FS::tax_rate]';
38 FS::tax_rate - Object methods for tax_rate objects
44 $record = new FS::tax_rate \%hash;
45 $record = new FS::tax_rate { 'column' => 'value' };
47 $error = $record->insert;
49 $error = $new_record->replace($old_record);
51 $error = $record->delete;
53 $error = $record->check;
57 An FS::tax_rate object represents a tax rate, defined by locale.
58 FS::tax_rate inherits from FS::Record. The following fields are
65 primary key (assigned automatically for new tax rates)
69 a geographic location code provided by a tax data vendor
77 a location code provided by a tax authority
81 a foreign key into FS::tax_class - the type of tax
82 referenced but FS::part_pkg_taxrate
85 the time after which the tax applies
93 second bracket percentage
97 the amount to which the tax applies (first bracket)
101 a cap on the amount of tax if a cap exists
105 percentage on out of jurisdiction purchases
109 second bracket percentage on out of jurisdiction purchases
113 one of the values in %tax_unittypes
117 amount of tax per unit
121 second bracket amount of tax per unit
125 the number of units to which the fee applies (first bracket)
129 the most units to which fees apply (first and second brackets)
133 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
137 if defined, printed on invoices instead of "Tax"
141 a value from %tax_authorities
145 a value from %tax_basetypes indicating the tax basis
149 a value from %tax_passtypes indicating how the tax should displayed to the customer
153 'Y', 'N', or blank indicating the tax can be passed to the customer
157 if 'Y', this tax does not apply to setup fees
161 if 'Y', this tax does not apply to recurring fees
165 if 'Y', has been manually edited
175 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
179 sub table { 'tax_rate'; }
183 Adds this tax rate to the database. If there is an error, returns the error,
184 otherwise returns false.
188 Deletes this tax rate from the database. If there is an error, returns the
189 error, otherwise returns false.
191 =item replace OLD_RECORD
193 Replaces the OLD_RECORD with this one in the database. If there is an error,
194 returns the error, otherwise returns false.
198 Checks all fields to make sure this is a valid tax rate. If there is an error,
199 returns the error, otherwise returns false. Called by the insert and replace
207 foreach (qw( taxbase taxmax )) {
208 $self->$_(0) unless $self->$_;
211 $self->ut_numbern('taxnum')
212 || $self->ut_text('geocode')
213 || $self->ut_textn('data_vendor')
214 || $self->ut_textn('location')
215 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
216 || $self->ut_snumbern('effective_date')
217 || $self->ut_float('tax')
218 || $self->ut_floatn('excessrate')
219 || $self->ut_money('taxbase')
220 || $self->ut_money('taxmax')
221 || $self->ut_floatn('usetax')
222 || $self->ut_floatn('useexcessrate')
223 || $self->ut_numbern('unittype')
224 || $self->ut_floatn('fee')
225 || $self->ut_floatn('excessfee')
226 || $self->ut_floatn('feemax')
227 || $self->ut_numbern('maxtype')
228 || $self->ut_textn('taxname')
229 || $self->ut_numbern('taxauth')
230 || $self->ut_numbern('basetype')
231 || $self->ut_numbern('passtype')
232 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
233 || $self->ut_enum('setuptax', [ '', 'Y' ] )
234 || $self->ut_enum('recurtax', [ '', 'Y' ] )
235 || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
236 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
237 || $self->ut_enum('manual', [ '', 'Y' ] )
238 || $self->ut_enum('disabled', [ '', 'Y' ] )
239 || $self->SUPER::check
244 =item taxclass_description
246 Returns the human understandable value associated with the related
251 sub taxclass_description {
253 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
254 $tax_class ? $tax_class->description : '';
259 Returns the human understandable value associated with the unittype column
263 %tax_unittypes = ( '0' => 'access line',
270 $tax_unittypes{$self->unittype};
275 Returns the human understandable value associated with the maxtype column
279 %tax_maxtypes = ( '0' => 'receipts per invoice',
280 '1' => 'receipts per item',
281 '2' => 'total utility charges per utility tax year',
282 '3' => 'total charges per utility tax year',
283 '4' => 'receipts per access line',
284 '9' => 'monthly receipts per location',
289 $tax_maxtypes{$self->maxtype};
294 Returns the human understandable value associated with the basetype column
298 %tax_basetypes = ( '0' => 'sale price',
299 '1' => 'gross receipts',
300 '2' => 'sales taxable telecom revenue',
301 '3' => 'minutes carried',
302 '4' => 'minutes billed',
303 '5' => 'gross operating revenue',
304 '6' => 'access line',
306 '8' => 'gross revenue',
307 '9' => 'portion gross receipts attributable to interstate service',
308 '10' => 'access line',
309 '11' => 'gross profits',
310 '12' => 'tariff rate',
312 '15' => 'prior year gross receipts',
317 $tax_basetypes{$self->basetype};
322 Returns the human understandable value associated with the taxauth column
326 %tax_authorities = ( '0' => 'federal',
331 '5' => 'county administered by state',
332 '6' => 'city administered by state',
333 '7' => 'city administered by county',
334 '8' => 'local administered by state',
335 '9' => 'local administered by county',
340 $tax_authorities{$self->taxauth};
345 Returns the human understandable value associated with the passtype column
349 %tax_passtypes = ( '0' => 'separate tax line',
350 '1' => 'separate surcharge line',
351 '2' => 'surcharge not separated',
352 '3' => 'included in base rate',
357 $tax_passtypes{$self->passtype};
360 =item taxline TAXABLES, [ OPTIONSHASH ]
362 Returns a listref of a name and an amount of tax calculated for the list
363 of packages/amounts referenced by TAXABLES. If an error occurs, a message
364 is returned as a scalar.
374 if (ref($_[0]) eq 'ARRAY') {
379 #exemptions would be broken in this case
382 my $name = $self->taxname;
383 $name = 'Other surcharges'
384 if ($self->passtype == 2);
387 if ( $self->disabled ) { # we always know how to handle disabled taxes
394 my $taxable_charged = 0;
395 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
398 warn "calculating taxes for ". $self->taxnum. " on ".
399 join (",", map { $_->pkgnum } @cust_bill_pkg)
402 if ($self->passflag eq 'N') {
403 # return "fatal: can't (yet) handle taxes not passed to the customer";
404 # until someone needs to track these in freeside
411 my $maxtype = $self->maxtype || 0;
412 if ($maxtype != 0 && $maxtype != 9) {
413 return $self->_fatal_or_null( 'tax with "'.
414 $self->maxtype_name. '" threshold'
420 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
424 # we treat gross revenue as gross receipts and expect the tax data
425 # to DTRT (i.e. tax on tax rules)
426 if ($self->basetype != 0 && $self->basetype != 1 &&
427 $self->basetype != 5 && $self->basetype != 6 &&
428 $self->basetype != 7 && $self->basetype != 8 &&
429 $self->basetype != 14
432 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
435 unless ($self->setuptax =~ /^Y$/i) {
436 $taxable_charged += $_->setup foreach @cust_bill_pkg;
438 unless ($self->recurtax =~ /^Y$/i) {
439 $taxable_charged += $_->recur foreach @cust_bill_pkg;
442 my $taxable_units = 0;
443 unless ($self->recurtax =~ /^Y$/i) {
444 if (( $self->unittype || 0 ) == 0) {
446 foreach (@cust_bill_pkg) {
447 $taxable_units += $_->units
448 unless $seen{$_->pkgnum};
451 }elsif ($self->unittype == 1) {
452 return $self->_fatal_or_null( 'fee with minute unit type' );
453 }elsif ($self->unittype == 2) {
456 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
461 # XXX insert exemption handling here
463 # the tax or fee is applied to taxbase or feebase and then
464 # the excessrate or excess fee is applied to taxmax or feemax
467 $amount += $taxable_charged * $self->tax;
468 $amount += $taxable_units * $self->fee;
470 warn "calculated taxes as [ $name, $amount ]\n"
481 my ($self, $error) = @_;
483 my $conf = new FS::Conf;
485 $error = "can't yet handle $error";
486 my $name = $self->taxname;
487 $name = 'Other surcharges'
488 if ($self->passtype == 2);
490 if ($conf->exists('ignore_incalculable_taxes')) {
491 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
492 return { name => $name, amount => 0 };
494 return "fatal: $error";
498 =item tax_on_tax CUST_MAIN
500 Returns a list of taxes which are candidates for taxing taxes for the
501 given customer (see L<FS::cust_main>)
507 my $cust_main = shift;
509 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
513 my $geocode = $cust_main->geocode($self->data_vendor);
517 my $extra_sql = ' AND ('.
518 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
523 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
524 my $select = 'DISTINCT ON(taxclassnum) *';
526 # should qsearch preface columns with the table to facilitate joins?
527 my @taxclassnums = map { $_->taxclassnum }
528 qsearch( { 'table' => 'part_pkg_taxrate',
530 'hashref' => { 'data_vendor' => $self->data_vendor,
531 'taxclassnumtaxed' => $self->taxclassnum,
533 'extra_sql' => $extra_sql,
534 'order_by' => $order_by,
537 return () unless @taxclassnums;
540 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
542 qsearch({ 'table' => 'tax_rate',
543 'hashref' => { 'geocode' => $geocode, },
544 'extra_sql' => $extra_sql,
549 =item tax_rate_location
551 Returns an object representing the location associated with this tax
552 (see L<FS::tax_rate_location>)
556 sub tax_rate_location {
559 qsearchs({ 'table' => 'tax_rate_location',
560 'hashref' => { 'data_vendor' => $self->data_vendor,
561 'geocode' => $self->geocode,
565 new FS::tax_rate_location;
579 sub _progressbar_foo {
584 my ($param, $job) = @_;
586 my $fh = $param->{filehandle};
587 my $format = $param->{'format'};
595 my @column_lengths = ();
596 my @column_callbacks = ();
597 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
598 $format =~ s/-fixed//;
599 my $date_format = sub { my $r='';
600 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
603 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
604 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 );
605 push @column_lengths, 1 if $format eq 'cch-update';
606 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
607 $column_callbacks[8] = $date_format;
611 my ( $count, $last, $min_sec ) = _progressbar_foo();
612 if ( $job || scalar(@column_callbacks) ) {
614 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
615 return $error if $error;
619 if ( $format eq 'cch' || $format eq 'cch-update' ) {
620 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
621 excessrate effective_date taxauth taxtype taxcat taxname
622 usetax useexcessrate fee unittype feemax maxtype passflag
624 push @fields, 'actionflag' if $format eq 'cch-update';
629 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
630 $hash->{'data_vendor'} ='cch';
631 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
632 time_zone => 'floating',
634 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
635 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
637 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
638 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
641 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
643 my %tax_class = ( 'data_vendor' => 'cch',
644 'taxclass' => $taxclassid,
647 my $tax_class = qsearchs( 'tax_class', \%tax_class );
648 return "Error updating tax rate: no tax class $taxclassid"
651 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
653 foreach (qw( taxtype taxcat )) {
657 my %passflagmap = ( '0' => '',
661 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
662 if exists $passflagmap{$hash->{'passflag'}};
664 foreach (keys %$hash) {
665 $hash->{$_} = substr($hash->{$_}, 0, 80)
666 if length($hash->{$_}) > 80;
669 my $actionflag = delete($hash->{'actionflag'});
671 $hash->{'taxname'} =~ s/`/'/g;
672 $hash->{'taxname'} =~ s|\\|/|g;
674 return '' if $format eq 'cch'; # but not cch-update
676 if ($actionflag eq 'I') {
677 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
678 }elsif ($actionflag eq 'D') {
679 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
681 return "Unexpected action flag: ". $hash->{'actionflag'};
684 delete($hash->{$_}) for keys %$hash;
690 } elsif ( $format eq 'extended' ) {
691 die "unimplemented\n";
695 die "unknown format $format";
698 eval "use Text::CSV_XS;";
701 my $csv = new Text::CSV_XS;
705 local $SIG{HUP} = 'IGNORE';
706 local $SIG{INT} = 'IGNORE';
707 local $SIG{QUIT} = 'IGNORE';
708 local $SIG{TERM} = 'IGNORE';
709 local $SIG{TSTP} = 'IGNORE';
710 local $SIG{PIPE} = 'IGNORE';
712 my $oldAutoCommit = $FS::UID::AutoCommit;
713 local $FS::UID::AutoCommit = 0;
716 while ( defined($line=<$fh>) ) {
717 $csv->parse($line) or do {
718 $dbh->rollback if $oldAutoCommit;
719 return "can't parse: ". $csv->error_input();
722 if ( $job ) { # progress bar
723 if ( time - $min_sec > $last ) {
724 my $error = $job->update_statustext(
725 int( 100 * $imported / $count ). ",Importing tax rates"
728 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
735 my @columns = $csv->fields();
737 my %tax_rate = ( 'data_vendor' => $format );
738 foreach my $field ( @fields ) {
739 $tax_rate{$field} = shift @columns;
741 if ( scalar( @columns ) ) {
742 $dbh->rollback if $oldAutoCommit;
743 return "Unexpected trailing columns in line (wrong format?): $line";
746 my $error = &{$hook}(\%tax_rate);
748 $dbh->rollback if $oldAutoCommit;
752 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
754 my $tax_rate = new FS::tax_rate( \%tax_rate );
755 $error = $tax_rate->insert;
758 $dbh->rollback if $oldAutoCommit;
759 return "can't insert tax_rate for $line: $error";
768 for (grep { !exists($delete{$_}) } keys %insert) {
769 if ( $job ) { # progress bar
770 if ( time - $min_sec > $last ) {
771 my $error = $job->update_statustext(
772 int( 100 * $imported / $count ). ",Importing tax rates"
775 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
782 my $tax_rate = new FS::tax_rate( $insert{$_} );
783 my $error = $tax_rate->insert;
786 $dbh->rollback if $oldAutoCommit;
787 my $hashref = $insert{$_};
788 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
789 return "can't insert tax_rate for $line: $error";
795 for (grep { exists($delete{$_}) } keys %insert) {
796 if ( $job ) { # progress bar
797 if ( time - $min_sec > $last ) {
798 my $error = $job->update_statustext(
799 int( 100 * $imported / $count ). ",Importing tax rates"
802 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
809 my $old = qsearchs( 'tax_rate', $delete{$_} );
811 $dbh->rollback if $oldAutoCommit;
813 return "can't find tax_rate to replace for: ".
814 #join(" ", map { "$_ => ". $old->{$_} } @fields);
815 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
817 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
818 $new->taxnum($old->taxnum);
819 my $error = $new->replace($old);
822 $dbh->rollback if $oldAutoCommit;
823 my $hashref = $insert{$_};
824 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
825 return "can't replace tax_rate for $line: $error";
832 for (grep { !exists($insert{$_}) } keys %delete) {
833 if ( $job ) { # progress bar
834 if ( time - $min_sec > $last ) {
835 my $error = $job->update_statustext(
836 int( 100 * $imported / $count ). ",Importing tax rates"
839 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
846 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
848 $dbh->rollback if $oldAutoCommit;
849 $tax_rate = $delete{$_};
850 return "can't find tax_rate to delete for: ".
851 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
852 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
854 my $error = $tax_rate->delete;
857 $dbh->rollback if $oldAutoCommit;
858 my $hashref = $delete{$_};
859 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
860 return "can't delete tax_rate for $line: $error";
866 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
868 return "Empty file!" unless ($imported || $format eq 'cch-update');
874 =item process_batch_import
876 Load a batch import as a queued JSRPC job
880 sub process_batch_import {
883 my $oldAutoCommit = $FS::UID::AutoCommit;
884 local $FS::UID::AutoCommit = 0;
887 my $param = thaw(decode_base64(shift));
888 my $args = '$job, encode_base64( nfreeze( $param ) )';
890 my $method = '_perform_batch_import';
891 if ( $param->{reload} ) {
892 $method = 'process_batch_reload';
895 eval "$method($args);";
897 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
902 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
905 sub _perform_batch_import {
908 my $param = thaw(decode_base64(shift));
909 my $format = $param->{'format'}; #well... this is all cch specific
911 my $files = $param->{'uploaded_files'}
912 or die "No files provided.";
914 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
917 if ( $format eq 'cch' || $format eq 'cch-fixed'
918 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
921 my $oldAutoCommit = $FS::UID::AutoCommit;
922 local $FS::UID::AutoCommit = 0;
925 my @insert_list = ();
926 my @delete_list = ();
927 my @predelete_list = ();
930 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
932 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
933 'CODE', \&FS::tax_class::batch_import,
934 'PLUS4', \&FS::cust_tax_location::batch_import,
935 'ZIP', \&FS::cust_tax_location::batch_import,
936 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
937 'DETAIL', \&FS::tax_rate::batch_import,
939 while( scalar(@list) ) {
940 my ( $name, $import_sub ) = splice( @list, 0, 2 );
941 my $file = lc($name). 'file';
943 unless ($files{$file}) {
944 $error = "No $name supplied";
947 next if $name eq 'DETAIL' && $format =~ /update/;
949 my $filename = "$dir/". $files{$file};
951 if ( $format =~ /update/ ) {
953 ( $error, $insertname, $deletename ) =
954 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
958 unlink $filename or warn "Can't delete $filename: $!"
959 unless $keep_cch_files;
960 push @insert_list, $name, $insertname, $import_sub, $format;
961 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
962 unshift @predelete_list, $name, $deletename, $import_sub, $format;
964 unshift @delete_list, $name, $deletename, $import_sub, $format;
969 push @insert_list, $name, $filename, $import_sub, $format;
976 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
977 if $format =~ /update/;
979 $error ||= _perform_cch_tax_import( $job,
986 @list = ( @predelete_list, @insert_list, @delete_list );
987 while( !$keep_cch_files && scalar(@list) ) {
988 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
989 unlink $file or warn "Can't delete $file: $!";
993 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
996 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1000 die "Unknown format: $format";
1006 sub _perform_cch_tax_import {
1007 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1010 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1011 while( scalar(@$list) ) {
1012 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1013 my $fmt = "$format-update";
1014 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1015 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1016 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1024 sub _perform_cch_insert_delete_split {
1025 my ($name, $filename, $dir, $format) = @_;
1029 open my $fh, "< $filename"
1030 or $error ||= "Can't open $name file $filename: $!";
1032 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1035 ) or die "can't open temp file: $!\n";
1036 my $insertname = $ifh->filename;
1038 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1041 ) or die "can't open temp file: $!\n";
1042 my $deletename = $dfh->filename;
1044 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1045 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1048 $handle = $ifh if $_ =~ /$insert_pattern/;
1049 $handle = $dfh if $_ =~ /$delete_pattern/;
1051 $error = "bad input line: $_" unless $handle;
1060 return ($error, $insertname, $deletename);
1063 sub _perform_cch_diff {
1064 my ($name, $newdir, $olddir) = @_;
1069 open my $oldcsvfh, "$olddir/$name.txt"
1070 or die "failed to open $olddir/$name.txt: $!\n";
1072 while(<$oldcsvfh>) {
1079 open my $newcsvfh, "$newdir/$name.txt"
1080 or die "failed to open $newdir/$name.txt: $!\n";
1082 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1085 ) or die "can't open temp file: $!\n";
1086 my $diffname = $dfh->filename;
1088 while(<$newcsvfh>) {
1090 if (exists($oldlines{$_})) {
1093 print $dfh $_, ',"I"', "\n";
1098 for (keys %oldlines) {
1099 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1107 sub _cch_fetch_and_unzip {
1108 my ( $job, $urls, $secret, $dir ) = @_;
1110 my $ua = new LWP::UserAgent;
1111 foreach my $url (split ',', $urls) {
1112 my @name = split '/', $url; #somewhat restrictive
1113 my $name = pop @name;
1114 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1117 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1119 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1120 my $res = $ua->request(
1121 new HTTP::Request( GET => $url ),
1123 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1124 my $content_length = $_[1]->content_length;
1125 $imported += length($_[0]);
1126 if ( time - $min_sec > $last ) {
1127 my $error = $job->update_statustext(
1128 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1129 ",Downloading data from CCH"
1131 die $error if $error;
1136 die "download of $url failed: ". $res->status_line
1137 unless $res->is_success;
1140 my $error = $job->update_statustext( "0,Unpacking data" );
1141 die $error if $error;
1142 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1144 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1145 or die "unzip -P $secret -d $dir $dir/$name failed";
1146 #unlink "$dir/$name";
1150 sub _cch_extract_csv_from_dbf {
1151 my ( $job, $dir, $name ) = @_;
1153 eval "use Text::CSV_XS;";
1159 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1160 my $error = $job->update_statustext( "0,Unpacking $name" );
1161 die $error if $error;
1162 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1163 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1164 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1165 unless defined($table);
1166 my $count = $table->last_record; # approximately;
1167 open my $csvfh, ">$dir.new/$name.txt"
1168 or die "failed to open $dir.new/$name.txt: $!\n";
1170 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1171 my @fields = $table->field_names;
1172 my $cursor = $table->prepare_select;
1174 sub { my $date = shift;
1175 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1178 while (my $row = $cursor->fetch_hashref) {
1179 $csv->combine( map { ($table->field_type($_) eq 'D')
1180 ? &{$format_date}($row->{$_})
1185 print $csvfh $csv->string, "\n";
1187 if ( time - $min_sec > $last ) {
1188 my $error = $job->update_statustext(
1189 int(100 * $imported/$count). ",Unpacking $name"
1191 die $error if $error;
1199 sub _remember_disabled_taxes {
1200 my ( $job, $format, $disabled_tax_rate ) = @_;
1204 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1206 my @items = qsearch( { table => 'tax_rate',
1207 hashref => { disabled => 'Y',
1208 data_vendor => $format,
1210 select => 'geocode, taxclassnum',
1213 my $count = scalar(@items);
1214 foreach my $tax_rate ( @items ) {
1215 if ( time - $min_sec > $last ) {
1216 $job->update_statustext(
1217 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1223 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1224 unless ( $tax_class ) {
1225 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1228 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1232 sub _remember_tax_products {
1233 my ( $job, $format, $taxproduct ) = @_;
1235 # XXX FIXME this loop only works when cch is the only data provider
1237 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1239 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1240 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1241 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1242 " optionname LIKE 'usage_taxproductnum_%' AND ".
1243 " optionvalue != '' )";
1244 my @items = qsearch( { table => 'part_pkg',
1245 select => 'DISTINCT pkgpart,taxproductnum',
1247 extra_sql => $extra_sql,
1250 my $count = scalar(@items);
1251 foreach my $part_pkg ( @items ) {
1252 if ( time - $min_sec > $last ) {
1253 $job->update_statustext(
1254 int( 100 * $imported / $count ). ",Remembering tax products"
1259 warn "working with package part ". $part_pkg->pkgpart.
1260 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1261 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1262 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1263 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1265 foreach my $option ( $part_pkg->part_pkg_option ) {
1266 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1269 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1270 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1271 $part_pkg_taxproduct->taxproduct
1272 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1277 sub _restore_remembered_tax_products {
1278 my ( $job, $format, $taxproduct ) = @_;
1282 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1283 my $count = scalar(keys %$taxproduct);
1284 foreach my $pkgpart ( keys %$taxproduct ) {
1285 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1286 if ( time - $min_sec > $last ) {
1287 $job->update_statustext(
1288 int( 100 * $imported / $count ). ",Restoring tax products"
1294 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1295 unless ( $part_pkg ) {
1296 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1299 my %options = $part_pkg->options;
1300 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1301 my $primary_svc = $part_pkg->svcpart;
1302 my $new = new FS::part_pkg { $part_pkg->hash };
1304 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1305 warn "working with class '$class'\n" if $DEBUG;
1306 my $part_pkg_taxproduct =
1307 qsearchs( 'part_pkg_taxproduct',
1308 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1309 data_vendor => $format,
1313 unless ( $part_pkg_taxproduct ) {
1314 return "failed to find part_pkg_taxproduct (".
1315 $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1318 if ( $class eq '' ) {
1319 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1323 $options{"usage_taxproductnum_$class"} =
1324 $part_pkg_taxproduct->taxproductnum;
1328 my $error = $new->replace( $part_pkg,
1329 'pkg_svc' => \%pkg_svc,
1330 'primary_svc' => $primary_svc,
1331 'options' => \%options,
1334 return $error if $error;
1341 sub _restore_remembered_disabled_taxes {
1342 my ( $job, $format, $disabled_tax_rate ) = @_;
1344 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1345 my $count = scalar(keys %$disabled_tax_rate);
1346 foreach my $key (keys %$disabled_tax_rate) {
1347 if ( time - $min_sec > $last ) {
1348 $job->update_statustext(
1349 int( 100 * $imported / $count ). ",Disabling tax rates"
1354 my ($geocode,$taxclass) = split /:/, $key, 2;
1355 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1356 taxclass => $taxclass,
1358 return "found multiple tax_class records for format $format class $taxclass"
1359 if scalar(@tax_class) > 1;
1361 unless (scalar(@tax_class)) {
1362 warn "no tax_class for format $format class $taxclass\n";
1367 qsearch('tax_rate', { data_vendor => $format,
1368 geocode => $geocode,
1369 taxclassnum => $tax_class[0]->taxclassnum,
1373 if (scalar(@tax_rate) > 1) {
1374 return "found multiple tax_rate records for format $format geocode ".
1375 "$geocode and taxclass $taxclass ( taxclassnum ".
1376 $tax_class[0]->taxclassnum. " )";
1379 if (scalar(@tax_rate)) {
1380 $tax_rate[0]->disabled('Y');
1381 my $error = $tax_rate[0]->replace;
1382 return $error if $error;
1387 sub _remove_old_tax_data {
1388 my ( $job, $format ) = @_;
1391 my $error = $job->update_statustext( "0,Removing old tax data" );
1392 die $error if $error;
1394 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1395 "WHERE data_vendor = ". $dbh->quote($format);
1396 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1399 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1401 foreach my $table ( @table ) {
1402 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1403 $dbh->quote($format);
1404 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1407 if ( $format eq 'cch' ) {
1408 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1409 $dbh->quote("$format-zip");
1410 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1416 sub _create_temporary_tables {
1417 my ( $job, $format ) = @_;
1420 my $error = $job->update_statustext( "0,Creating temporary tables" );
1421 die $error if $error;
1423 my @table = qw( tax_rate
1430 foreach my $table ( @table ) {
1432 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1433 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1439 sub _copy_from_temp {
1440 my ( $job, $format ) = @_;
1443 my $error = $job->update_statustext( "0,Making permanent" );
1444 die $error if $error;
1446 my @table = qw( tax_rate
1453 foreach my $table ( @table ) {
1455 "INSERT INTO public.$table SELECT * from $table";
1456 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1462 =item process_download_and_reload
1464 Download and process a tax update as a queued JSRPC job after wiping the
1465 existing wipable tax data.
1469 sub process_download_and_reload {
1470 _process_reload('process_download_and_update', @_);
1474 =item process_batch_reload
1476 Load and process a tax update from the provided files as a queued JSRPC job
1477 after wiping the existing wipable tax data.
1481 sub process_batch_reload {
1482 _process_reload('_perform_batch_import', @_);
1486 sub _process_reload {
1487 my ( $method, $job ) = ( shift, shift );
1489 my $param = thaw(decode_base64($_[0]));
1490 my $format = $param->{'format'}; #well... this is all cch specific
1492 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1494 if ( $job ) { # progress bar
1495 my $error = $job->update_statustext( 0 );
1496 die $error if $error;
1499 my $oldAutoCommit = $FS::UID::AutoCommit;
1500 local $FS::UID::AutoCommit = 0;
1505 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1506 "USING (taxclassnum) WHERE data_vendor = '$format'";
1507 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1509 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1510 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1511 if $sth->fetchrow_arrayref->[0];
1513 # really should get a table EXCLUSIVE lock here
1515 #remember disabled taxes
1516 my %disabled_tax_rate = ();
1517 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1519 #remember tax products
1520 my %taxproduct = ();
1521 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1524 $error ||= _create_temporary_tables( $job, $format );
1528 my $args = '$job, @_';
1529 eval "$method($args);";
1533 #restore taxproducts
1534 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1538 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1540 #wipe out the old data
1541 $error ||= _remove_old_tax_data( $job, $format );
1544 $error ||= _copy_from_temp( $job, $format );
1547 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1552 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1556 =item process_download_and_update
1558 Download and process a tax update as a queued JSRPC job
1562 sub process_download_and_update {
1565 my $param = thaw(decode_base64(shift));
1566 my $format = $param->{'format'}; #well... this is all cch specific
1568 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1570 if ( $job ) { # progress bar
1571 my $error = $job->update_statustext( 0);
1572 die $error if $error;
1575 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1576 my $dir = $cache_dir. 'taxdata';
1578 mkdir $dir or die "can't create $dir: $!\n";
1581 if ($format eq 'cch') {
1583 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1585 my $conf = new FS::Conf;
1586 die "direct download of tax data not enabled\n"
1587 unless $conf->exists('taxdatadirectdownload');
1588 my ( $urls, $username, $secret, $states ) =
1589 $conf->config('taxdatadirectdownload');
1590 die "No tax download URL provided. ".
1591 "Did you set the taxdatadirectdownload configuration value?\n"
1599 # really should get a table EXCLUSIVE lock here
1600 # check if initial import or update
1602 # relying on mkdir "$dir.new" as a mutex
1604 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1605 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1606 $sth->execute() or die $sth->errstr;
1607 my $update = $sth->fetchrow_arrayref->[0];
1609 # create cache and/or rotate old tax data
1614 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1615 foreach my $file (readdir($dirh)) {
1616 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1623 if ( -e "$dir.$_" ) {
1624 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1627 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1631 die "can't find previous tax data\n" if $update;
1635 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1637 # fetch and unpack the zip files
1639 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1641 # extract csv files from the dbf files
1643 foreach my $name ( @namelist ) {
1644 _cch_extract_csv_from_dbf( $job, $dir, $name );
1647 # generate the diff files
1650 foreach my $name ( @namelist ) {
1651 my $difffile = "$dir.new/$name.txt";
1653 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1654 die $error if $error;
1655 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1656 my $olddir = $update ? "$dir.1" : "";
1657 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1659 $difffile =~ s/^$cache_dir//;
1660 push @list, "${name}file:$difffile";
1663 # perform the import
1664 local $keep_cch_files = 1;
1665 $param->{uploaded_files} = join( ',', @list );
1666 $param->{format} .= '-update' if $update;
1668 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1670 rename "$dir.new", "$dir"
1671 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1674 die "Unknown format: $format";
1678 =item browse_queries PARAMS
1680 Returns a list consisting of a hashref suited for use as the argument
1681 to qsearch, and sql query string. Each is based on the PARAMS hashref
1682 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1683 from a form. This conveniently creates the query hashref and count_query
1684 string required by the browse and search elements. As a side effect,
1685 the PARAMS hashref is untainted and keys with unexpected values are removed.
1689 sub browse_queries {
1693 'table' => 'tax_rate',
1695 'order_by' => 'ORDER BY geocode, taxclassnum',
1700 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1701 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1703 delete $params->{data_vendor};
1706 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1707 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1708 'geocode LIKE '. dbh->quote($1.'%');
1710 delete $params->{geocode};
1713 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1714 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1717 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1718 ' taxclassnum = '. dbh->quote($1)
1720 delete $params->{taxclassnun};
1724 if ( $params->{tax_type} =~ /^(\d+)$/ );
1725 delete $params->{tax_type}
1729 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1730 delete $params->{tax_cat}
1733 my @taxclassnum = ();
1734 if ($tax_type || $tax_cat ) {
1735 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1736 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1737 @taxclassnum = map { $_->taxclassnum }
1738 qsearch({ 'table' => 'tax_class',
1740 'extra_sql' => "WHERE taxclass $compare",
1744 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1745 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1746 if ( @taxclassnum );
1748 unless ($params->{'showdisabled'}) {
1749 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1750 "( disabled = '' OR disabled IS NULL )";
1753 $query->{extra_sql} = $extra_sql;
1755 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1760 # Used by FS::Upgrade to migrate to a new database.
1764 sub _upgrade_data { # class method
1765 my ($self, %opts) = @_;
1768 warn "$me upgrading $self\n" if $DEBUG;
1770 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1773 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1775 eval "use DBI::Const::GetInfoType;";
1778 my $major_version = 0;
1779 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1780 && ( $major_version = sprintf("%d", $1) );
1782 if ( $major_version > 7 ) {
1784 # ideally this would be supported in DBIx-DBSchema and friends
1786 foreach my $column ( @column ) {
1787 my $columndef = dbdef->table($self->table)->column($column);
1788 unless ($columndef->type eq 'numeric') {
1790 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1791 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1792 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1793 $sth->execute or die $sth->errstr;
1795 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1796 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1797 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1798 $sth->execute or die $sth->errstr;
1803 } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1805 # ideally this would be supported in DBIx-DBSchema and friends
1807 foreach my $column ( @column ) {
1808 my $columndef = dbdef->table($self->table)->column($column);
1809 unless ($columndef->type eq 'numeric') {
1811 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1813 foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1815 my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1816 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1817 $sth->execute or die $sth->errstr;
1819 my $def = dbdef->table($table)->column($column);
1820 $def->type('numeric');
1821 $def->length('14,8');
1822 my $null = $def->null;
1825 $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1826 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1827 $sth->execute or die $sth->errstr;
1829 $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1830 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1831 $sth->execute or die $sth->errstr;
1833 unless ( $null eq 'NULL' ) {
1834 $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1835 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1836 $sth->execute or die $sth->errstr;
1839 $sql = "ALTER TABLE $table DROP old_$column";
1840 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1841 $sth->execute or die $sth->errstr;
1849 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1855 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1867 Mixing automatic and manual editing works poorly at present.
1871 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base