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+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
916 if ( $format eq 'cch' || $format eq 'cch-fixed'
917 || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
920 my $oldAutoCommit = $FS::UID::AutoCommit;
921 local $FS::UID::AutoCommit = 0;
924 my @insert_list = ();
925 my @delete_list = ();
926 my @predelete_list = ();
929 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
931 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
932 'CODE', 'codefile', \&FS::tax_class::batch_import,
933 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
934 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
935 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
936 'DETAIL', 'detail', \&FS::tax_rate::batch_import,
938 while( scalar(@list) ) {
939 my ( $name, $file, $import_sub ) = splice( @list, 0, 3 );
941 unless ($files{$file}) {
942 $error = "No $name supplied";
945 next if $name eq 'DETAIL' && $format =~ /update/;
947 my $filename = "$dir/". $files{$file};
949 if ( $format =~ /update/ ) {
951 ( $error, $insertname, $deletename ) =
952 _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
956 unlink $filename or warn "Can't delete $filename: $!"
957 unless $keep_cch_files;
958 push @insert_list, $name, $insertname, $import_sub, $format;
959 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
960 unshift @predelete_list, $name, $deletename, $import_sub;
962 unshift @delete_list, $name, $deletename, $import_sub;
967 push @insert_list, $name, $filename, $import_sub, $format;
974 'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
975 if $format =~ /update/;
977 $error ||= _perform_cch_tax_import( $job,
984 @list = ( @predelete_list, @insert_list, @delete_list );
985 while( !$keep_cch_files && scalar(@list) ) {
986 my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
987 unlink $file or warn "Can't delete $file: $!";
991 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
994 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
998 die "Unknown format: $format";
1004 sub _perform_cch_tax_import {
1005 my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1008 foreach my $list ($predelete_list, $insert_list, $delete_list) {
1009 while( scalar(@$list) ) {
1010 my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1011 my $fmt = "$format-update";
1012 $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1013 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1014 $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1022 sub _perform_cch_insert_delete_split {
1023 my ($name, $filename, $dir, $format) = @_;
1027 open my $fh, "< $filename"
1028 or $error ||= "Can't open $name file $filename: $!";
1030 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1033 ) or die "can't open temp file: $!\n";
1034 my $insertname = $ifh->filename;
1036 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1039 ) or die "can't open temp file: $!\n";
1040 my $deletename = $dfh->filename;
1042 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1043 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1046 $handle = $ifh if $_ =~ /$insert_pattern/;
1047 $handle = $dfh if $_ =~ /$delete_pattern/;
1049 $error = "bad input line: $_" unless $handle;
1058 return ($error, $insertname, $deletename);
1061 sub _perform_cch_diff {
1062 my ($name, $newdir, $olddir) = @_;
1067 open my $oldcsvfh, "$olddir/$name.txt"
1068 or die "failed to open $olddir/$name.txt: $!\n";
1070 while(<$oldcsvfh>) {
1077 open my $newcsvfh, "$newdir/$name.txt"
1078 or die "failed to open $newdir/$name.txt: $!\n";
1080 my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1083 ) or die "can't open temp file: $!\n";
1084 my $diffname = $dfh->filename;
1086 while(<$newcsvfh>) {
1088 if (exists($oldlines{$_})) {
1091 print $dfh $_, ',"I"', "\n";
1096 for (keys %oldlines) {
1097 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1105 sub _cch_fetch_and_unzip {
1106 my ( $job, $urls, $secret, $dir ) = @_;
1108 my $ua = new LWP::UserAgent;
1109 foreach my $url (split ',', $urls) {
1110 my @name = split '/', $url; #somewhat restrictive
1111 my $name = pop @name;
1112 $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1115 open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1117 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1118 my $res = $ua->request(
1119 new HTTP::Request( GET => $url ),
1121 print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1122 my $content_length = $_[1]->content_length;
1123 $imported += length($_[0]);
1124 if ( time - $min_sec > $last ) {
1125 my $error = $job->update_statustext(
1126 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1127 ",Downloading data from CCH"
1129 die $error if $error;
1134 die "download of $url failed: ". $res->status_line
1135 unless $res->is_success;
1138 my $error = $job->update_statustext( "0,Unpacking data" );
1139 die $error if $error;
1140 $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1142 system('unzip', "-P", $secret, "-d", "$dir", "$dir/$name") == 0
1143 or die "unzip -P $secret -d $dir $dir/$name failed";
1144 #unlink "$dir/$name";
1148 sub _cch_extract_csv_from_dbf {
1149 my ( $job, $dir, $name ) = @_;
1151 eval "use Text::CSV_XS;";
1157 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1158 my $error = $job->update_statustext( "0,Unpacking $name" );
1159 die $error if $error;
1160 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1161 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1162 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1163 unless defined($table);
1164 my $count = $table->last_record; # approximately;
1165 open my $csvfh, ">$dir.new/$name.txt"
1166 or die "failed to open $dir.new/$name.txt: $!\n";
1168 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1169 my @fields = $table->field_names;
1170 my $cursor = $table->prepare_select;
1172 sub { my $date = shift;
1173 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1176 while (my $row = $cursor->fetch_hashref) {
1177 $csv->combine( map { ($table->field_type($_) eq 'D')
1178 ? &{$format_date}($row->{$_})
1183 print $csvfh $csv->string, "\n";
1185 if ( time - $min_sec > $last ) {
1186 my $error = $job->update_statustext(
1187 int(100 * $imported/$count). ",Unpacking $name"
1189 die $error if $error;
1197 sub _remember_disabled_taxes {
1198 my ( $job, $format, $disabled_tax_rate ) = @_;
1202 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1204 my @items = qsearch( { table => 'tax_rate',
1205 hashref => { disabled => 'Y',
1206 data_vendor => $format,
1208 select => 'geocode, taxclassnum',
1211 my $count = scalar(@items);
1212 foreach my $tax_rate ( @items ) {
1213 if ( time - $min_sec > $last ) {
1214 $job->update_statustext(
1215 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1221 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1222 unless ( $tax_class ) {
1223 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1226 $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1230 sub _remember_tax_products {
1231 my ( $job, $format, $taxproduct ) = @_;
1233 # XXX FIXME this loop only works when cch is the only data provider
1235 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1237 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1238 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1239 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1240 " optionname LIKE 'usage_taxproductnum_%' AND ".
1241 " optionvalue != '' )";
1242 my @items = qsearch( { table => 'part_pkg',
1243 select => 'DISTINCT pkgpart,taxproductnum',
1245 extra_sql => $extra_sql,
1248 my $count = scalar(@items);
1249 foreach my $part_pkg ( @items ) {
1250 if ( time - $min_sec > $last ) {
1251 $job->update_statustext(
1252 int( 100 * $imported / $count ). ",Remembering tax products"
1257 warn "working with package part ". $part_pkg->pkgpart.
1258 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1259 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1260 $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1261 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1263 foreach my $option ( $part_pkg->part_pkg_option ) {
1264 next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1267 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1268 $taxproduct->{$part_pkg->pkgpart}->{$class} =
1269 $part_pkg_taxproduct->taxproduct
1270 if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1275 sub _restore_remembered_tax_products {
1276 my ( $job, $format, $taxproduct ) = @_;
1280 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1281 my $count = scalar(keys %$taxproduct);
1282 foreach my $pkgpart ( keys %$taxproduct ) {
1283 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1284 if ( time - $min_sec > $last ) {
1285 $job->update_statustext(
1286 int( 100 * $imported / $count ). ",Restoring tax products"
1292 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1293 unless ( $part_pkg ) {
1294 return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1297 my %options = $part_pkg->options;
1298 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1299 my $primary_svc = $part_pkg->svcpart;
1300 my $new = new FS::part_pkg { $part_pkg->hash };
1302 foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1303 warn "working with class '$class'\n" if $DEBUG;
1304 my $part_pkg_taxproduct =
1305 qsearchs( 'part_pkg_taxproduct',
1306 { taxproduct => $taxproduct->{$pkgpart}->{$class},
1307 data_vendor => $format,
1311 unless ( $part_pkg_taxproduct ) {
1312 return "failed to find part_pkg_taxproduct (".
1313 $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1316 if ( $class eq '' ) {
1317 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1321 $options{"usage_taxproductnum_$class"} =
1322 $part_pkg_taxproduct->taxproductnum;
1326 my $error = $new->replace( $part_pkg,
1327 'pkg_svc' => \%pkg_svc,
1328 'primary_svc' => $primary_svc,
1329 'options' => \%options,
1332 return $error if $error;
1339 sub _restore_remembered_disabled_taxes {
1340 my ( $job, $format, $disabled_tax_rate ) = @_;
1342 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1343 my $count = scalar(keys %$disabled_tax_rate);
1344 foreach my $key (keys %$disabled_tax_rate) {
1345 if ( time - $min_sec > $last ) {
1346 $job->update_statustext(
1347 int( 100 * $imported / $count ). ",Disabling tax rates"
1352 my ($geocode,$taxclass) = split /:/, $key, 2;
1353 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1354 taxclass => $taxclass,
1356 return "found multiple tax_class records for format $format class $taxclass"
1357 if scalar(@tax_class) > 1;
1359 unless (scalar(@tax_class)) {
1360 warn "no tax_class for format $format class $taxclass\n";
1365 qsearch('tax_rate', { data_vendor => $format,
1366 geocode => $geocode,
1367 taxclassnum => $tax_class[0]->taxclassnum,
1371 if (scalar(@tax_rate) > 1) {
1372 return "found multiple tax_rate records for format $format geocode ".
1373 "$geocode and taxclass $taxclass ( taxclassnum ".
1374 $tax_class[0]->taxclassnum. " )";
1377 if (scalar(@tax_rate)) {
1378 $tax_rate[0]->disabled('Y');
1379 my $error = $tax_rate[0]->replace;
1380 return $error if $error;
1385 sub _remove_old_tax_data {
1386 my ( $job, $format ) = @_;
1389 my $error = $job->update_statustext( "0,Removing old tax data" );
1390 dir $error if $error;
1391 foreach my $tax_rate_location ( qsearch( 'tax_rate_location',
1392 { data_vendor => $format,
1398 $tax_rate_location->disabled('Y');
1399 my $error = $tax_rate_location->replace;
1400 return $error if $error;
1403 local $FS::part_pkg_taxproduct::delete_kludge = 1;
1405 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1407 foreach my $table ( @table ) {
1409 # my $primary_key = dbdef->table($table)->primary_key;
1410 # my $sql = "SELECT $primary_key FROM $table WHERE data_vendor = ".
1411 my $sql = "DELETE FROM $table WHERE data_vendor = ".
1412 $dbh->quote($format);
1413 my $sth = $dbh->prepare($sql);
1414 return $dbh->errstr unless ($sth);
1415 $sth->execute or return "Failed to execute $sql: ". $sth->errstr;
1416 # foreach my $row ( @{ $sth->fetchall_arrayref } ) {
1417 # my $record = qsearchs( $table, { $primary_key => $row->[0] } )
1418 # or return "Failed to find $table with $primary_key ". $row->[0];
1419 # my $error = $record->delete;
1420 # return $error if $error;
1424 if ( $format eq 'cch' ) {
1425 foreach my $cust_tax_location ( qsearch( 'cust_tax_location',
1426 { data_vendor => "$format-zip" }
1430 my $error = $cust_tax_location->delete;
1431 return $error if $error;
1438 =item process_download_and_reload
1440 Download and process a tax update as a queued JSRPC job after wiping the
1441 existing wipable tax data.
1445 sub process_download_and_reload {
1446 _process_reload('process_download_and_update', @_);
1450 =item process_batch_reload
1452 Load and process a tax update from the provided files as a queued JSRPC job
1453 after wiping the existing wipable tax data.
1457 sub process_batch_reload {
1458 _process_reload('_perform_batch_import', @_);
1462 sub _process_reload {
1463 my ( $method, $job ) = ( shift, shift );
1465 my $param = thaw(decode_base64($_[0]));
1466 my $format = $param->{'format'}; #well... this is all cch specific
1468 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1470 if ( $job ) { # progress bar
1471 my $error = $job->update_statustext( 0 );
1472 die $error if $error;
1475 my $oldAutoCommit = $FS::UID::AutoCommit;
1476 local $FS::UID::AutoCommit = 0;
1481 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1482 "USING (taxclassnum) WHERE data_vendor = '$format'";
1483 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1485 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1486 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1487 if $sth->fetchrow_arrayref->[0];
1489 # really should get a table EXCLUSIVE lock here
1491 #remember disabled taxes
1492 my %disabled_tax_rate = ();
1493 $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1495 #remember tax products
1496 my %taxproduct = ();
1497 $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1499 #wipe out the old data
1500 $error ||= _remove_old_tax_data( $job, $format );
1504 my $args = '$job, @_';
1505 eval "$method($args);";
1509 #restore taxproducts
1510 $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1514 _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1517 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1522 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1526 =item process_download_and_update
1528 Download and process a tax update as a queued JSRPC job
1532 sub process_download_and_update {
1535 my $param = thaw(decode_base64(shift));
1536 my $format = $param->{'format'}; #well... this is all cch specific
1538 my ( $imported, $last, $min_sec ) = _progressbar_foo();
1540 if ( $job ) { # progress bar
1541 my $error = $job->update_statustext( 0);
1542 die $error if $error;
1545 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1547 mkdir $dir or die "can't create $dir: $!\n";
1550 if ($format eq 'cch') {
1552 my @namelist = qw( code detail geocode plus4 txmatrix zip );
1554 my $conf = new FS::Conf;
1555 die "direct download of tax data not enabled\n"
1556 unless $conf->exists('taxdatadirectdownload');
1557 my ( $urls, $username, $secret, $states ) =
1558 $conf->config('taxdatadirectdownload');
1559 die "No tax download URL provided. ".
1560 "Did you set the taxdatadirectdownload configuration value?\n"
1568 # really should get a table EXCLUSIVE lock here
1569 # check if initial import or update
1571 # relying on mkdir "$dir.new" as a mutex
1573 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1574 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1575 $sth->execute() or die $sth->errstr;
1576 my $update = $sth->fetchrow_arrayref->[0];
1578 # create cache and/or rotate old tax data
1583 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1584 foreach my $file (readdir($dirh)) {
1585 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1592 if ( -e "$dir.$_" ) {
1593 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1596 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1600 die "can't find previous tax data\n" if $update;
1604 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1606 # fetch and unpack the zip files
1608 _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1610 # extract csv files from the dbf files
1612 foreach my $name ( @namelist ) {
1613 cch_extract_csv_from_dbf( $job, $dir, $name );
1616 # generate the diff files
1619 foreach my $name ( @namelist ) {
1620 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1621 die $error if $error;
1622 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1623 my $olddir = $update ? "$dir.1" : "";
1624 my $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1625 push @list, "$name:$difffile";
1628 # perform the import
1629 local $keep_cch_files = 1;
1630 $param->{uploaded_files} = join( ',', @list );
1631 $param->{format} .= '-update' if $update;
1633 _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1635 rename "$dir.new", "$dir"
1636 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1639 die "Unknown format: $format";
1643 =item browse_queries PARAMS
1645 Returns a list consisting of a hashref suited for use as the argument
1646 to qsearch, and sql query string. Each is based on the PARAMS hashref
1647 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1648 from a form. This conveniently creates the query hashref and count_query
1649 string required by the browse and search elements. As a side effect,
1650 the PARAMS hashref is untainted and keys with unexpected values are removed.
1654 sub browse_queries {
1658 'table' => 'tax_rate',
1660 'order_by' => 'ORDER BY geocode, taxclassnum',
1665 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1666 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1668 delete $params->{data_vendor};
1671 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1672 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1673 'geocode LIKE '. dbh->quote($1.'%');
1675 delete $params->{geocode};
1678 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1679 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1682 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1683 ' taxclassnum = '. dbh->quote($1)
1685 delete $params->{taxclassnun};
1689 if ( $params->{tax_type} =~ /^(\d+)$/ );
1690 delete $params->{tax_type}
1694 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1695 delete $params->{tax_cat}
1698 my @taxclassnum = ();
1699 if ($tax_type || $tax_cat ) {
1700 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1701 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1702 @taxclassnum = map { $_->taxclassnum }
1703 qsearch({ 'table' => 'tax_class',
1705 'extra_sql' => "WHERE taxclass $compare",
1709 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1710 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1711 if ( @taxclassnum );
1713 unless ($params->{'showdisabled'}) {
1714 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1715 "( disabled = '' OR disabled IS NULL )";
1718 $query->{extra_sql} = $extra_sql;
1720 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1725 # Used by FS::Upgrade to migrate to a new database.
1729 sub _upgrade_data { # class method
1730 my ($self, %opts) = @_;
1733 warn "$me upgrading $self\n" if $DEBUG;
1735 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1738 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1740 eval "use DBI::Const::GetInfoType;";
1743 my $major_version = 0;
1744 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1745 && ( $major_version = sprintf("%d", $1) );
1747 if ( $major_version > 7 ) {
1749 # ideally this would be supported in DBIx-DBSchema and friends
1751 foreach my $column ( @column ) {
1752 my $columndef = dbdef->table($self->table)->column($column);
1753 unless ($columndef->type eq 'numeric') {
1755 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1756 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1757 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1758 $sth->execute or die $sth->errstr;
1760 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1761 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1762 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1763 $sth->execute or die $sth->errstr;
1768 } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1770 # ideally this would be supported in DBIx-DBSchema and friends
1772 foreach my $column ( @column ) {
1773 my $columndef = dbdef->table($self->table)->column($column);
1774 unless ($columndef->type eq 'numeric') {
1776 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1778 foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1780 my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1781 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1782 $sth->execute or die $sth->errstr;
1784 my $def = dbdef->table($table)->column($column);
1785 $def->type('numeric');
1786 $def->length('14,8');
1787 my $null = $def->null;
1790 $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1791 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1792 $sth->execute or die $sth->errstr;
1794 $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1795 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1796 $sth->execute or die $sth->errstr;
1798 unless ( $null eq 'NULL' ) {
1799 $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1800 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1801 $sth->execute or die $sth->errstr;
1804 $sql = "ALTER TABLE $table DROP old_$column";
1805 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1806 $sth->execute or die $sth->errstr;
1814 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1820 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1832 Mixing automatic and manual editing works poorly at present.
1836 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base