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>)
509 my $cust_main = shift;
511 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
515 my $geocode = $cust_main->geocode($self->data_vendor);
519 my $extra_sql = ' AND ('.
520 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
525 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
526 my $select = 'DISTINCT ON(taxclassnum) *';
528 # should qsearch preface columns with the table to facilitate joins?
529 my @taxclassnums = map { $_->taxclassnum }
530 qsearch( { 'table' => 'part_pkg_taxrate',
532 'hashref' => { 'data_vendor' => $self->data_vendor,
533 'taxclassnumtaxed' => $self->taxclassnum,
535 'extra_sql' => $extra_sql,
536 'order_by' => $order_by,
539 return () unless @taxclassnums;
542 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
544 qsearch({ 'table' => 'tax_rate',
545 'hashref' => { 'geocode' => $geocode, },
546 'extra_sql' => $extra_sql,
551 =item tax_rate_location
553 Returns an object representing the location associated with this tax
554 (see L<FS::tax_rate_location>)
558 sub tax_rate_location {
561 qsearchs({ 'table' => 'tax_rate_location',
562 'hashref' => { 'data_vendor' => $self->data_vendor,
563 'geocode' => $self->geocode,
567 new FS::tax_rate_location;
581 sub _progressbar_foo {
586 my ($param, $job) = @_;
588 my $fh = $param->{filehandle};
589 my $format = $param->{'format'};
597 my @column_lengths = ();
598 my @column_callbacks = ();
599 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
600 $format =~ s/-fixed//;
601 my $date_format = sub { my $r='';
602 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
605 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
606 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 );
607 push @column_lengths, 1 if $format eq 'cch-update';
608 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
609 $column_callbacks[8] = $date_format;
613 my ( $count, $last, $min_sec ) = _progressbar_foo();
614 if ( $job || scalar(@column_callbacks) ) {
616 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
617 return $error if $error;
621 if ( $format eq 'cch' || $format eq 'cch-update' ) {
622 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
623 excessrate effective_date taxauth taxtype taxcat taxname
624 usetax useexcessrate fee unittype feemax maxtype passflag
626 push @fields, 'actionflag' if $format eq 'cch-update';
631 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
632 $hash->{'data_vendor'} ='cch';
633 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
634 time_zone => 'floating',
636 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
637 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
639 $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
640 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
643 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
645 my %tax_class = ( 'data_vendor' => 'cch',
646 'taxclass' => $taxclassid,
649 my $tax_class = qsearchs( 'tax_class', \%tax_class );
650 return "Error updating tax rate: no tax class $taxclassid"
653 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
655 foreach (qw( taxtype taxcat )) {
659 my %passflagmap = ( '0' => '',
663 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
664 if exists $passflagmap{$hash->{'passflag'}};
666 foreach (keys %$hash) {
667 $hash->{$_} = substr($hash->{$_}, 0, 80)
668 if length($hash->{$_}) > 80;
671 my $actionflag = delete($hash->{'actionflag'});
673 $hash->{'taxname'} =~ s/`/'/g;
674 $hash->{'taxname'} =~ s|\\|/|g;
676 return '' if $format eq 'cch'; # but not cch-update
678 if ($actionflag eq 'I') {
679 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
680 }elsif ($actionflag eq 'D') {
681 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
683 return "Unexpected action flag: ". $hash->{'actionflag'};
686 delete($hash->{$_}) for keys %$hash;
692 } elsif ( $format eq 'extended' ) {
693 die "unimplemented\n";
697 die "unknown format $format";
700 eval "use Text::CSV_XS;";
703 my $csv = new Text::CSV_XS;
707 local $SIG{HUP} = 'IGNORE';
708 local $SIG{INT} = 'IGNORE';
709 local $SIG{QUIT} = 'IGNORE';
710 local $SIG{TERM} = 'IGNORE';
711 local $SIG{TSTP} = 'IGNORE';
712 local $SIG{PIPE} = 'IGNORE';
714 my $oldAutoCommit = $FS::UID::AutoCommit;
715 local $FS::UID::AutoCommit = 0;
718 while ( defined($line=<$fh>) ) {
719 $csv->parse($line) or do {
720 $dbh->rollback if $oldAutoCommit;
721 return "can't parse: ". $csv->error_input();
724 if ( $job ) { # progress bar
725 if ( time - $min_sec > $last ) {
726 my $error = $job->update_statustext(
727 int( 100 * $imported / $count ). ",Importing tax rates"
730 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
737 my @columns = $csv->fields();
739 my %tax_rate = ( 'data_vendor' => $format );
740 foreach my $field ( @fields ) {
741 $tax_rate{$field} = shift @columns;
743 if ( scalar( @columns ) ) {
744 $dbh->rollback if $oldAutoCommit;
745 return "Unexpected trailing columns in line (wrong format?): $line";
748 my $error = &{$hook}(\%tax_rate);
750 $dbh->rollback if $oldAutoCommit;
754 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
756 my $tax_rate = new FS::tax_rate( \%tax_rate );
757 $error = $tax_rate->insert;
760 $dbh->rollback if $oldAutoCommit;
761 return "can't insert tax_rate for $line: $error";
770 for (grep { !exists($delete{$_}) } keys %insert) {
771 if ( $job ) { # progress bar
772 if ( time - $min_sec > $last ) {
773 my $error = $job->update_statustext(
774 int( 100 * $imported / $count ). ",Importing tax rates"
777 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
784 my $tax_rate = new FS::tax_rate( $insert{$_} );
785 my $error = $tax_rate->insert;
788 $dbh->rollback if $oldAutoCommit;
789 my $hashref = $insert{$_};
790 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
791 return "can't insert tax_rate for $line: $error";
797 for (grep { exists($delete{$_}) } keys %insert) {
798 if ( $job ) { # progress bar
799 if ( time - $min_sec > $last ) {
800 my $error = $job->update_statustext(
801 int( 100 * $imported / $count ). ",Importing tax rates"
804 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
811 my $old = qsearchs( 'tax_rate', $delete{$_} );
813 $dbh->rollback if $oldAutoCommit;
815 return "can't find tax_rate to replace for: ".
816 #join(" ", map { "$_ => ". $old->{$_} } @fields);
817 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
819 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
820 $new->taxnum($old->taxnum);
821 my $error = $new->replace($old);
824 $dbh->rollback if $oldAutoCommit;
825 my $hashref = $insert{$_};
826 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
827 return "can't replace tax_rate for $line: $error";
834 for (grep { !exists($insert{$_}) } keys %delete) {
835 if ( $job ) { # progress bar
836 if ( time - $min_sec > $last ) {
837 my $error = $job->update_statustext(
838 int( 100 * $imported / $count ). ",Importing tax rates"
841 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
848 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
850 $dbh->rollback if $oldAutoCommit;
851 $tax_rate = $delete{$_};
852 return "can't find tax_rate to delete for: ".
853 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
854 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
856 my $error = $tax_rate->delete;
859 $dbh->rollback if $oldAutoCommit;
860 my $hashref = $delete{$_};
861 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
862 return "can't delete tax_rate for $line: $error";
868 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
870 return "Empty file!" unless ($imported || $format eq 'cch-update');
876 =item process_batch_import
878 Load a batch import as a queued JSRPC job
882 sub process_batch_import {
885 my $oldAutoCommit = $FS::UID::AutoCommit;
886 local $FS::UID::AutoCommit = 0;
889 my $param = thaw(decode_base64(shift));
890 my $args = '$job, encode_base64( nfreeze( $param ) )';
892 my $method = '_perform_batch_import';
893 if ( $param->{reload} ) {
894 $method = 'process_batch_reload';
897 eval "$method($args);";
899 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
907 sub _perform_batch_import {
910 my $param = thaw(decode_base64(shift));
911 my $format = $param->{'format'}; #well... this is all cch specific
913 my $files = $param->{'uploaded_files'}
914 or die "No files provided.";
916 my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
919 if ( $format eq 'cch' || $format eq 'cch-fixed'
920 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
923 my $oldAutoCommit = $FS::UID::AutoCommit;
924 local $FS::UID::AutoCommit = 0;
927 my @insert_list = ();
928 my @delete_list = ();
929 my @predelete_list = ();
932 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
934 my @list = ( 'GEOCODE', \&FS::tax_rate_location::batch_import,
935 'CODE', \&FS::tax_class::batch_import,
936 'PLUS4', \&FS::cust_tax_location::batch_import,
937 'ZIP', \&FS::cust_tax_location::batch_import,
938 'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
939 'DETAIL', \&FS::tax_rate::batch_import,
941 while( scalar(@list) ) {
942 my ( $name, $import_sub ) = splice( @list, 0, 2 );
943 my $file = lc($name). 'file';
945 unless ($files{$file}) {
946 $error = "No $name supplied";
949 next if $name eq 'DETAIL' && $format =~ /update/;
951 my $filename = "$dir/". $files{$file};
953 if ( $format =~ /update/ ) {
955 ( $error, $insertname, $deletename ) =
956 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
960 unlink $filename or warn "Can't delete $filename: $!"
961 unless $keep_cch_files;
962 push @insert_list, $name, $insertname, $import_sub, $format;
963 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
964 unshift @predelete_list, $name, $deletename, $import_sub, $format;
966 unshift @delete_list, $name, $deletename, $import_sub, $format;
971 push @insert_list, $name, $filename, $import_sub, $format;
978 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
979 if $format =~ /update/;
981 $error ||= _perform_cch_tax_import( $job,
988 @list = ( @predelete_list, @insert_list, @delete_list );
989 while( !$keep_cch_files && scalar(@list) ) {
990 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
991 unlink $file or warn "Can't delete $file: $!";
995 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1002 die "Unknown format: $format";
1008 sub _perform_cch_tax_import {
1009 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1012 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1013 while( scalar(@$list) ) {
1014 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1015 my $fmt = "$format-update";
1016 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1017 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1018 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1026 sub _perform_cch_insert_delete_split {
1027 my ($name, $filename, $dir, $format) = @_;
1031 open my $fh, "< $filename"
1032 or $error ||= "Can't open $name file $filename: $!";
1034 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1037 ) or die "can't open temp file: $!\n";
1038 my $insertname = $ifh->filename;
1040 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1043 ) or die "can't open temp file: $!\n";
1044 my $deletename = $dfh->filename;
1046 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1047 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1050 $handle = $ifh if $_ =~ /$insert_pattern/;
1051 $handle = $dfh if $_ =~ /$delete_pattern/;
1053 $error = "bad input line: $_" unless $handle;
1062 return ($error, $insertname, $deletename);
1065 sub _perform_cch_diff {
1066 my ($name, $newdir, $olddir) = @_;
1071 open my $oldcsvfh, "$olddir/$name.txt"
1072 or die "failed to open $olddir/$name.txt: $!\n";
1074 while(<$oldcsvfh>) {
1081 open my $newcsvfh, "$newdir/$name.txt"
1082 or die "failed to open $newdir/$name.txt: $!\n";
1084 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1087 ) or die "can't open temp file: $!\n";
1088 my $diffname = $dfh->filename;
1090 while(<$newcsvfh>) {
1092 if (exists($oldlines{$_})) {
1095 print $dfh $_, ',"I"', "\n";
1100 for (keys %oldlines) {
1101 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1109 sub _cch_fetch_and_unzip {
1110 my ( $job, $urls, $secret, $dir ) = @_;
1112 my $ua = new LWP::UserAgent;
1113 foreach my $url (split ',', $urls) {
1114 my @name = split '/', $url; #somewhat restrictive
1115 my $name = pop @name;
1116 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1119 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1121 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1122 my $res = $ua->request(
1123 new HTTP::Request( GET => $url ),
1125 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1126 my $content_length = $_[1]->content_length;
1127 $imported += length($_[0]);
1128 if ( time - $min_sec > $last ) {
1129 my $error = $job->update_statustext(
1130 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1131 ",Downloading data from CCH"
1133 die $error if $error;
1138 die "download of $url failed: ". $res->status_line
1139 unless $res->is_success;
1142 my $error = $job->update_statustext( "0,Unpacking data" );
1143 die $error if $error;
1144 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1146 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1147 or die "unzip -P $secret -d $dir $dir/$name failed";
1148 #unlink "$dir/$name";
1152 sub _cch_extract_csv_from_dbf {
1153 my ( $job, $dir, $name ) = @_;
1155 eval "use Text::CSV_XS;";
1161 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1162 my $error = $job->update_statustext( "0,Unpacking $name" );
1163 die $error if $error;
1164 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1165 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1166 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1167 unless defined($table);
1168 my $count = $table->last_record; # approximately;
1169 open my $csvfh, ">$dir.new/$name.txt"
1170 or die "failed to open $dir.new/$name.txt: $!\n";
1172 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1173 my @fields = $table->field_names;
1174 my $cursor = $table->prepare_select;
1176 sub { my $date = shift;
1177 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1180 while (my $row = $cursor->fetch_hashref) {
1181 $csv->combine( map { ($table->field_type($_) eq 'D')
1182 ? &{$format_date}($row->{$_})
1187 print $csvfh $csv->string, "\n";
1189 if ( time - $min_sec > $last ) {
1190 my $error = $job->update_statustext(
1191 int(100 * $imported/$count). ",Unpacking $name"
1193 die $error if $error;
1201 sub _remember_disabled_taxes {
1202 my ( $job, $format, $disabled_tax_rate ) = @_;
1206 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1208 my @items = qsearch( { table => 'tax_rate',
1209 hashref => { disabled => 'Y',
1210 data_vendor => $format,
1212 select => 'geocode, taxclassnum',
1215 my $count = scalar(@items);
1216 foreach my $tax_rate ( @items ) {
1217 if ( time - $min_sec > $last ) {
1218 $job->update_statustext(
1219 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1225 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1226 unless ( $tax_class ) {
1227 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1230 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1234 sub _remember_tax_products {
1235 my ( $job, $format, $taxproduct ) = @_;
1237 # XXX FIXME this loop only works when cch is the only data provider
1239 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1241 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1242 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1243 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1244 " optionname LIKE 'usage_taxproductnum_%' AND ".
1245 " optionvalue != '' )";
1246 my @items = qsearch( { table => 'part_pkg',
1247 select => 'DISTINCT pkgpart,taxproductnum',
1249 extra_sql => $extra_sql,
1252 my $count = scalar(@items);
1253 foreach my $part_pkg ( @items ) {
1254 if ( time - $min_sec > $last ) {
1255 $job->update_statustext(
1256 int( 100 * $imported / $count ). ",Remembering tax products"
1261 warn "working with package part ". $part_pkg->pkgpart.
1262 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1263 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1264 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1265 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1267 foreach my $option ( $part_pkg->part_pkg_option ) {
1268 next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1271 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1272 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1273 $part_pkg_taxproduct->taxproduct
1274 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1279 sub _restore_remembered_tax_products {
1280 my ( $job, $format, $taxproduct ) = @_;
1284 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1285 my $count = scalar(keys %$taxproduct);
1286 foreach my $pkgpart ( keys %$taxproduct ) {
1287 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1288 if ( time - $min_sec > $last ) {
1289 $job->update_statustext(
1290 int( 100 * $imported / $count ). ",Restoring tax products"
1296 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1297 unless ( $part_pkg ) {
1298 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1301 my %options = $part_pkg->options;
1302 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1303 my $primary_svc = $part_pkg->svcpart;
1304 my $new = new FS::part_pkg { $part_pkg->hash };
1306 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1307 warn "working with class '$class'\n" if $DEBUG;
1308 my $part_pkg_taxproduct =
1309 qsearchs( 'part_pkg_taxproduct',
1310 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1311 data_vendor => $format,
1315 unless ( $part_pkg_taxproduct ) {
1316 return "failed to find part_pkg_taxproduct (".
1317 $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1320 if ( $class eq '' ) {
1321 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1325 $options{"usage_taxproductnum_$class"} =
1326 $part_pkg_taxproduct->taxproductnum;
1330 my $error = $new->replace( $part_pkg,
1331 'pkg_svc' => \%pkg_svc,
1332 'primary_svc' => $primary_svc,
1333 'options' => \%options,
1336 return $error if $error;
1343 sub _restore_remembered_disabled_taxes {
1344 my ( $job, $format, $disabled_tax_rate ) = @_;
1346 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1347 my $count = scalar(keys %$disabled_tax_rate);
1348 foreach my $key (keys %$disabled_tax_rate) {
1349 if ( time - $min_sec > $last ) {
1350 $job->update_statustext(
1351 int( 100 * $imported / $count ). ",Disabling tax rates"
1356 my ($geocode,$taxclass) = split /:/, $key, 2;
1357 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1358 taxclass => $taxclass,
1360 return "found multiple tax_class records for format $format class $taxclass"
1361 if scalar(@tax_class) > 1;
1363 unless (scalar(@tax_class)) {
1364 warn "no tax_class for format $format class $taxclass\n";
1369 qsearch('tax_rate', { data_vendor => $format,
1370 geocode => $geocode,
1371 taxclassnum => $tax_class[0]->taxclassnum,
1375 if (scalar(@tax_rate) > 1) {
1376 return "found multiple tax_rate records for format $format geocode ".
1377 "$geocode and taxclass $taxclass ( taxclassnum ".
1378 $tax_class[0]->taxclassnum. " )";
1381 if (scalar(@tax_rate)) {
1382 $tax_rate[0]->disabled('Y');
1383 my $error = $tax_rate[0]->replace;
1384 return $error if $error;
1389 sub _remove_old_tax_data {
1390 my ( $job, $format ) = @_;
1393 my $error = $job->update_statustext( "0,Removing old tax data" );
1394 die $error if $error;
1396 my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1397 "WHERE data_vendor = ". $dbh->quote($format);
1398 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1401 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1403 foreach my $table ( @table ) {
1404 $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1405 $dbh->quote($format);
1406 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1409 if ( $format eq 'cch' ) {
1410 $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1411 $dbh->quote("$format-zip");
1412 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1418 sub _create_temporary_tables {
1419 my ( $job, $format ) = @_;
1422 my $error = $job->update_statustext( "0,Creating temporary tables" );
1423 die $error if $error;
1425 my @table = qw( tax_rate
1432 foreach my $table ( @table ) {
1434 "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1435 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1441 sub _copy_from_temp {
1442 my ( $job, $format ) = @_;
1445 my $error = $job->update_statustext( "0,Making permanent" );
1446 die $error if $error;
1448 my @table = qw( tax_rate
1455 foreach my $table ( @table ) {
1457 "INSERT INTO public.$table SELECT * from $table";
1458 $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1464 =item process_download_and_reload
1466 Download and process a tax update as a queued JSRPC job after wiping the
1467 existing wipable tax data.
1471 sub process_download_and_reload {
1472 _process_reload('process_download_and_update', @_);
1476 =item process_batch_reload
1478 Load and process a tax update from the provided files as a queued JSRPC job
1479 after wiping the existing wipable tax data.
1483 sub process_batch_reload {
1484 _process_reload('_perform_batch_import', @_);
1488 sub _process_reload {
1489 my ( $method, $job ) = ( shift, shift );
1491 my $param = thaw(decode_base64($_[0]));
1492 my $format = $param->{'format'}; #well... this is all cch specific
1494 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1496 if ( $job ) { # progress bar
1497 my $error = $job->update_statustext( 0 );
1498 die $error if $error;
1501 my $oldAutoCommit = $FS::UID::AutoCommit;
1502 local $FS::UID::AutoCommit = 0;
1507 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1508 "USING (taxclassnum) WHERE data_vendor = '$format'";
1509 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1511 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1512 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1513 if $sth->fetchrow_arrayref->[0];
1515 # really should get a table EXCLUSIVE lock here
1517 #remember disabled taxes
1518 my %disabled_tax_rate = ();
1519 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1521 #remember tax products
1522 my %taxproduct = ();
1523 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1526 $error ||= _create_temporary_tables( $job, $format );
1530 my $args = '$job, @_';
1531 eval "$method($args);";
1535 #restore taxproducts
1536 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1540 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1542 #wipe out the old data
1543 $error ||= _remove_old_tax_data( $job, $format );
1546 $error ||= _copy_from_temp( $job, $format );
1549 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1554 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1558 =item process_download_and_update
1560 Download and process a tax update as a queued JSRPC job
1564 sub process_download_and_update {
1567 my $param = thaw(decode_base64(shift));
1568 my $format = $param->{'format'}; #well... this is all cch specific
1570 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1572 if ( $job ) { # progress bar
1573 my $error = $job->update_statustext( 0);
1574 die $error if $error;
1577 my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1578 my $dir = $cache_dir. 'taxdata';
1580 mkdir $dir or die "can't create $dir: $!\n";
1583 if ($format eq 'cch') {
1585 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1587 my $conf = new FS::Conf;
1588 die "direct download of tax data not enabled\n"
1589 unless $conf->exists('taxdatadirectdownload');
1590 my ( $urls, $username, $secret, $states ) =
1591 $conf->config('taxdatadirectdownload');
1592 die "No tax download URL provided. ".
1593 "Did you set the taxdatadirectdownload configuration value?\n"
1601 # really should get a table EXCLUSIVE lock here
1602 # check if initial import or update
1604 # relying on mkdir "$dir.new" as a mutex
1606 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1607 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1608 $sth->execute() or die $sth->errstr;
1609 my $update = $sth->fetchrow_arrayref->[0];
1611 # create cache and/or rotate old tax data
1616 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1617 foreach my $file (readdir($dirh)) {
1618 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1625 if ( -e "$dir.$_" ) {
1626 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1629 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1633 die "can't find previous tax data\n" if $update;
1637 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1639 # fetch and unpack the zip files
1641 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1643 # extract csv files from the dbf files
1645 foreach my $name ( @namelist ) {
1646 _cch_extract_csv_from_dbf( $job, $dir, $name );
1649 # generate the diff files
1652 foreach my $name ( @namelist ) {
1653 my $difffile = "$dir.new/$name.txt";
1655 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1656 die $error if $error;
1657 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1658 my $olddir = $update ? "$dir.1" : "";
1659 $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1661 $difffile =~ s/^$cache_dir//;
1662 push @list, "${name}file:$difffile";
1665 # perform the import
1666 local $keep_cch_files = 1;
1667 $param->{uploaded_files} = join( ',', @list );
1668 $param->{format} .= '-update' if $update;
1670 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1672 rename "$dir.new", "$dir"
1673 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1676 die "Unknown format: $format";
1680 =item browse_queries PARAMS
1682 Returns a list consisting of a hashref suited for use as the argument
1683 to qsearch, and sql query string. Each is based on the PARAMS hashref
1684 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1685 from a form. This conveniently creates the query hashref and count_query
1686 string required by the browse and search elements. As a side effect,
1687 the PARAMS hashref is untainted and keys with unexpected values are removed.
1691 sub browse_queries {
1695 'table' => 'tax_rate',
1697 'order_by' => 'ORDER BY geocode, taxclassnum',
1702 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1703 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1705 delete $params->{data_vendor};
1708 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1709 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1710 'geocode LIKE '. dbh->quote($1.'%');
1712 delete $params->{geocode};
1715 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1716 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1719 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1720 ' taxclassnum = '. dbh->quote($1)
1722 delete $params->{taxclassnun};
1726 if ( $params->{tax_type} =~ /^(\d+)$/ );
1727 delete $params->{tax_type}
1731 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1732 delete $params->{tax_cat}
1735 my @taxclassnum = ();
1736 if ($tax_type || $tax_cat ) {
1737 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1738 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1739 @taxclassnum = map { $_->taxclassnum }
1740 qsearch({ 'table' => 'tax_class',
1742 'extra_sql' => "WHERE taxclass $compare",
1746 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1747 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1748 if ( @taxclassnum );
1750 unless ($params->{'showdisabled'}) {
1751 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1752 "( disabled = '' OR disabled IS NULL )";
1755 $query->{extra_sql} = $extra_sql;
1757 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1764 Mixing automatic and manual editing works poorly at present.
1768 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base