4 use vars qw( @ISA $DEBUG $me
5 %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
6 %tax_passtypes %GetInfoType );
9 use DateTime::Format::Strptime;
10 use Storable qw( thaw );
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]';
37 FS::tax_rate - Object methods for tax_rate objects
43 $record = new FS::tax_rate \%hash;
44 $record = new FS::tax_rate { 'column' => 'value' };
46 $error = $record->insert;
48 $error = $new_record->replace($old_record);
50 $error = $record->delete;
52 $error = $record->check;
56 An FS::tax_rate object represents a tax rate, defined by locale.
57 FS::tax_rate inherits from FS::Record. The following fields are
64 primary key (assigned automatically for new tax rates)
68 a geographic location code provided by a tax data vendor
76 a location code provided by a tax authority
80 a foreign key into FS::tax_class - the type of tax
81 referenced but FS::part_pkg_taxrate
84 the time after which the tax applies
92 second bracket percentage
96 the amount to which the tax applies (first bracket)
100 a cap on the amount of tax if a cap exists
104 percentage on out of jurisdiction purchases
108 second bracket percentage on out of jurisdiction purchases
112 one of the values in %tax_unittypes
116 amount of tax per unit
120 second bracket amount of tax per unit
124 the number of units to which the fee applies (first bracket)
128 the most units to which fees apply (first and second brackets)
132 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
136 if defined, printed on invoices instead of "Tax"
140 a value from %tax_authorities
144 a value from %tax_basetypes indicating the tax basis
148 a value from %tax_passtypes indicating how the tax should displayed to the customer
152 'Y', 'N', or blank indicating the tax can be passed to the customer
156 if 'Y', this tax does not apply to setup fees
160 if 'Y', this tax does not apply to recurring fees
164 if 'Y', has been manually edited
174 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
178 sub table { 'tax_rate'; }
182 Adds this tax rate to the database. If there is an error, returns the error,
183 otherwise returns false.
187 Deletes this tax rate from the database. If there is an error, returns the
188 error, otherwise returns false.
190 =item replace OLD_RECORD
192 Replaces the OLD_RECORD with this one in the database. If there is an error,
193 returns the error, otherwise returns false.
197 Checks all fields to make sure this is a valid tax rate. If there is an error,
198 returns the error, otherwise returns false. Called by the insert and replace
206 foreach (qw( taxbase taxmax )) {
207 $self->$_(0) unless $self->$_;
210 $self->ut_numbern('taxnum')
211 || $self->ut_text('geocode')
212 || $self->ut_textn('data_vendor')
213 || $self->ut_textn('location')
214 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
215 || $self->ut_snumbern('effective_date')
216 || $self->ut_float('tax')
217 || $self->ut_floatn('excessrate')
218 || $self->ut_money('taxbase')
219 || $self->ut_money('taxmax')
220 || $self->ut_floatn('usetax')
221 || $self->ut_floatn('useexcessrate')
222 || $self->ut_numbern('unittype')
223 || $self->ut_floatn('fee')
224 || $self->ut_floatn('excessfee')
225 || $self->ut_floatn('feemax')
226 || $self->ut_numbern('maxtype')
227 || $self->ut_textn('taxname')
228 || $self->ut_numbern('taxauth')
229 || $self->ut_numbern('basetype')
230 || $self->ut_numbern('passtype')
231 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
232 || $self->ut_enum('setuptax', [ '', 'Y' ] )
233 || $self->ut_enum('recurtax', [ '', 'Y' ] )
234 || $self->ut_enum('manual', [ '', 'Y' ] )
235 || $self->ut_enum('disabled', [ '', 'Y' ] )
236 || $self->SUPER::check
241 =item taxclass_description
243 Returns the human understandable value associated with the related
248 sub taxclass_description {
250 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
251 $tax_class ? $tax_class->description : '';
256 Returns the human understandable value associated with the unittype column
260 %tax_unittypes = ( '0' => 'access line',
267 $tax_unittypes{$self->unittype};
272 Returns the human understandable value associated with the maxtype column
276 %tax_maxtypes = ( '0' => 'receipts per invoice',
277 '1' => 'receipts per item',
278 '2' => 'total utility charges per utility tax year',
279 '3' => 'total charges per utility tax year',
280 '4' => 'receipts per access line',
281 '9' => 'monthly receipts per location',
286 $tax_maxtypes{$self->maxtype};
291 Returns the human understandable value associated with the basetype column
295 %tax_basetypes = ( '0' => 'sale price',
296 '1' => 'gross receipts',
297 '2' => 'sales taxable telecom revenue',
298 '3' => 'minutes carried',
299 '4' => 'minutes billed',
300 '5' => 'gross operating revenue',
301 '6' => 'access line',
303 '8' => 'gross revenue',
304 '9' => 'portion gross receipts attributable to interstate service',
305 '10' => 'access line',
306 '11' => 'gross profits',
307 '12' => 'tariff rate',
309 '15' => 'prior year gross receipts',
314 $tax_basetypes{$self->basetype};
319 Returns the human understandable value associated with the taxauth column
323 %tax_authorities = ( '0' => 'federal',
328 '5' => 'county administered by state',
329 '6' => 'city administered by state',
330 '7' => 'city administered by county',
331 '8' => 'local administered by state',
332 '9' => 'local administered by county',
337 $tax_authorities{$self->taxauth};
342 Returns the human understandable value associated with the passtype column
346 %tax_passtypes = ( '0' => 'separate tax line',
347 '1' => 'separate surcharge line',
348 '2' => 'surcharge not separated',
349 '3' => 'included in base rate',
354 $tax_passtypes{$self->passtype};
357 =item taxline TAXABLES, [ OPTIONSHASH ]
359 Returns a listref of a name and an amount of tax calculated for the list
360 of packages/amounts referenced by TAXABLES. If an error occurs, a message
361 is returned as a scalar.
371 if (ref($_[0]) eq 'ARRAY') {
376 #exemptions would be broken in this case
379 my $name = $self->taxname;
380 $name = 'Other surcharges'
381 if ($self->passtype == 2);
384 if ( $self->disabled ) { # we always know how to handle disabled taxes
391 my $taxable_charged = 0;
392 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
395 warn "calculating taxes for ". $self->taxnum. " on ".
396 join (",", map { $_->pkgnum } @cust_bill_pkg)
399 if ($self->passflag eq 'N') {
400 # return "fatal: can't (yet) handle taxes not passed to the customer";
401 # until someone needs to track these in freeside
408 if ($self->maxtype != 0 && $self->maxtype != 9) {
409 return $self->_fatal_or_null( 'tax with "'.
410 $self->maxtype_name. '" threshold'
414 if ($self->maxtype == 9) {
416 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
420 # we treat gross revenue as gross receipts and expect the tax data
421 # to DTRT (i.e. tax on tax rules)
422 if ($self->basetype != 0 && $self->basetype != 1 &&
423 $self->basetype != 5 && $self->basetype != 6 &&
424 $self->basetype != 7 && $self->basetype != 8 &&
425 $self->basetype != 14
428 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
431 unless ($self->setuptax =~ /^Y$/i) {
432 $taxable_charged += $_->setup foreach @cust_bill_pkg;
434 unless ($self->recurtax =~ /^Y$/i) {
435 $taxable_charged += $_->recur foreach @cust_bill_pkg;
438 my $taxable_units = 0;
439 unless ($self->recurtax =~ /^Y$/i) {
440 if ($self->unittype == 0) {
442 foreach (@cust_bill_pkg) {
443 $taxable_units += $_->units
444 unless $seen{$_->pkgnum};
447 }elsif ($self->unittype == 1) {
448 return $self->_fatal_or_null( 'fee with minute unit type' );
449 }elsif ($self->unittype == 2) {
452 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
457 # XXX insert exemption handling here
459 # the tax or fee is applied to taxbase or feebase and then
460 # the excessrate or excess fee is applied to taxmax or feemax
463 $amount += $taxable_charged * $self->tax;
464 $amount += $taxable_units * $self->fee;
466 warn "calculated taxes as [ $name, $amount ]\n"
477 my ($self, $error) = @_;
479 my $conf = new FS::Conf;
481 $error = "fatal: can't yet handle ". $error;
482 my $name = $self->taxname;
483 $name = 'Other surcharges'
484 if ($self->passtype == 2);
486 if ($conf->exists('ignore_incalculable_taxes')) {
488 return { name => $name, amount => 0 };
494 =item tax_on_tax CUST_MAIN
496 Returns a list of taxes which are candidates for taxing taxes for the
497 given customer (see L<FS::cust_main>)
503 my $cust_main = shift;
505 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
509 my $geocode = $cust_main->geocode($self->data_vendor);
513 my $extra_sql = ' AND ('.
514 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
519 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
520 my $select = 'DISTINCT ON(taxclassnum) *';
522 # should qsearch preface columns with the table to facilitate joins?
523 my @taxclassnums = map { $_->taxclassnum }
524 qsearch( { 'table' => 'part_pkg_taxrate',
526 'hashref' => { 'data_vendor' => $self->data_vendor,
527 'taxclassnumtaxed' => $self->taxclassnum,
529 'extra_sql' => $extra_sql,
530 'order_by' => $order_by,
533 return () unless @taxclassnums;
536 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
538 qsearch({ 'table' => 'tax_rate',
539 'hashref' => { 'geocode' => $geocode, },
540 'extra_sql' => $extra_sql,
545 =item tax_rate_location
547 Returns an object representing the location associated with this tax
548 (see L<FS::tax_rate_location>)
552 sub tax_rate_location {
555 qsearchs({ 'table' => 'tax_rate_location',
556 'hashref' => { 'data_vendor' => $self->data_vendor,
557 'geocode' => $self->geocode,
561 new FS::tax_rate_location;
576 my ($param, $job) = @_;
578 my $fh = $param->{filehandle};
579 my $format = $param->{'format'};
587 my @column_lengths = ();
588 my @column_callbacks = ();
589 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
590 $format =~ s/-fixed//;
591 my $date_format = sub { my $r='';
592 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
595 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
596 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 );
597 push @column_lengths, 1 if $format eq 'cch-update';
598 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
599 $column_callbacks[8] = $date_format;
603 my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
604 if ( $job || scalar(@column_callbacks) ) {
606 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
607 return $error if $error;
611 if ( $format eq 'cch' || $format eq 'cch-update' ) {
612 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
613 excessrate effective_date taxauth taxtype taxcat taxname
614 usetax useexcessrate fee unittype feemax maxtype passflag
616 push @fields, 'actionflag' if $format eq 'cch-update';
621 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
622 $hash->{'data_vendor'} ='cch';
623 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
624 time_zone => 'floating',
626 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
627 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
629 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
632 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
634 my %tax_class = ( 'data_vendor' => 'cch',
635 'taxclass' => $taxclassid,
638 my $tax_class = qsearchs( 'tax_class', \%tax_class );
639 return "Error updating tax rate: no tax class $taxclassid"
642 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
644 foreach (qw( inoutcity inoutlocal taxtype taxcat )) {
648 my %passflagmap = ( '0' => '',
652 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
653 if exists $passflagmap{$hash->{'passflag'}};
655 foreach (keys %$hash) {
656 $hash->{$_} = substr($hash->{$_}, 0, 80)
657 if length($hash->{$_}) > 80;
660 my $actionflag = delete($hash->{'actionflag'});
662 $hash->{'taxname'} =~ s/`/'/g;
663 $hash->{'taxname'} =~ s|\\|/|g;
665 return '' if $format eq 'cch'; # but not cch-update
667 if ($actionflag eq 'I') {
668 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
669 }elsif ($actionflag eq 'D') {
670 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
672 return "Unexpected action flag: ". $hash->{'actionflag'};
675 delete($hash->{$_}) for keys %$hash;
681 } elsif ( $format eq 'extended' ) {
682 die "unimplemented\n";
686 die "unknown format $format";
689 eval "use Text::CSV_XS;";
692 my $csv = new Text::CSV_XS;
696 local $SIG{HUP} = 'IGNORE';
697 local $SIG{INT} = 'IGNORE';
698 local $SIG{QUIT} = 'IGNORE';
699 local $SIG{TERM} = 'IGNORE';
700 local $SIG{TSTP} = 'IGNORE';
701 local $SIG{PIPE} = 'IGNORE';
703 my $oldAutoCommit = $FS::UID::AutoCommit;
704 local $FS::UID::AutoCommit = 0;
707 while ( defined($line=<$fh>) ) {
708 $csv->parse($line) or do {
709 $dbh->rollback if $oldAutoCommit;
710 return "can't parse: ". $csv->error_input();
713 if ( $job ) { # progress bar
714 if ( time - $min_sec > $last ) {
715 my $error = $job->update_statustext(
716 int( 100 * $imported / $count ). ",Importing tax rates"
718 die $error if $error;
723 my @columns = $csv->fields();
725 my %tax_rate = ( 'data_vendor' => $format );
726 foreach my $field ( @fields ) {
727 $tax_rate{$field} = shift @columns;
729 if ( scalar( @columns ) ) {
730 $dbh->rollback if $oldAutoCommit;
731 return "Unexpected trailing columns in line (wrong format?): $line";
734 my $error = &{$hook}(\%tax_rate);
736 $dbh->rollback if $oldAutoCommit;
740 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
742 my $tax_rate = new FS::tax_rate( \%tax_rate );
743 $error = $tax_rate->insert;
746 $dbh->rollback if $oldAutoCommit;
747 return "can't insert tax_rate for $line: $error";
756 for (grep { !exists($delete{$_}) } keys %insert) {
757 if ( $job ) { # progress bar
758 if ( time - $min_sec > $last ) {
759 my $error = $job->update_statustext(
760 int( 100 * $imported / $count ). ",Importing tax rates"
762 die $error if $error;
767 my $tax_rate = new FS::tax_rate( $insert{$_} );
768 my $error = $tax_rate->insert;
771 $dbh->rollback if $oldAutoCommit;
772 my $hashref = $insert{$_};
773 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
774 return "can't insert tax_rate for $line: $error";
780 for (grep { exists($delete{$_}) } keys %insert) {
781 if ( $job ) { # progress bar
782 if ( time - $min_sec > $last ) {
783 my $error = $job->update_statustext(
784 int( 100 * $imported / $count ). ",Importing tax rates"
786 die $error if $error;
791 my $old = qsearchs( 'tax_rate', $delete{$_} );
793 $dbh->rollback if $oldAutoCommit;
795 return "can't find tax_rate to replace for: ".
796 #join(" ", map { "$_ => ". $old->{$_} } @fields);
797 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
799 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
800 $new->taxnum($old->taxnum);
801 my $error = $new->replace($old);
804 $dbh->rollback if $oldAutoCommit;
805 my $hashref = $insert{$_};
806 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
807 return "can't replace tax_rate for $line: $error";
814 for (grep { !exists($insert{$_}) } keys %delete) {
815 if ( $job ) { # progress bar
816 if ( time - $min_sec > $last ) {
817 my $error = $job->update_statustext(
818 int( 100 * $imported / $count ). ",Importing tax rates"
820 die $error if $error;
825 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
827 $dbh->rollback if $oldAutoCommit;
828 $tax_rate = $delete{$_};
829 return "can't find tax_rate to delete for: ".
830 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
831 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
833 my $error = $tax_rate->delete;
836 $dbh->rollback if $oldAutoCommit;
837 my $hashref = $delete{$_};
838 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
839 return "can't delete tax_rate for $line: $error";
845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
847 return "Empty file!" unless ($imported || $format eq 'cch-update');
853 =item process_batch_import
855 Load a batch import as a queued JSRPC job
859 sub process_batch_import {
862 my $param = thaw(decode_base64(shift));
863 my $format = $param->{'format'}; #well... this is all cch specific
865 my $files = $param->{'uploaded_files'}
866 or die "No files provided.";
868 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
870 if ($format eq 'cch' || $format eq 'cch-fixed') {
872 my $oldAutoCommit = $FS::UID::AutoCommit;
873 local $FS::UID::AutoCommit = 0;
876 my $have_location = 0;
878 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
879 'CODE', 'codefile', \&FS::tax_class::batch_import,
880 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
881 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
882 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
883 'DETAIL', 'detail', \&FS::tax_rate::batch_import,
885 while( scalar(@list) ) {
886 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
887 unless ($files{$file}) {
888 next if $name eq 'PLUS4';
889 $error = "No $name supplied";
890 $error = "Neither PLUS4 nor ZIP supplied"
891 if ($name eq 'ZIP' && !$have_location);
894 $have_location = 1 if $name eq 'PLUS4';
895 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
896 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
897 my $filename = "$dir/". $files{$file};
898 open my $fh, "< $filename" or $error ||= "Can't open $name file: $!";
900 $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
902 unlink $filename or warn "Can't delete $filename: $!";
906 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
909 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
912 }elsif ($format eq 'cch-update' || $format eq 'cch-fixed-update') {
914 my $oldAutoCommit = $FS::UID::AutoCommit;
915 local $FS::UID::AutoCommit = 0;
918 my @insert_list = ();
919 my @delete_list = ();
920 my @predelete_list = ();
922 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
923 'CODE', 'codefile', \&FS::tax_class::batch_import,
924 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
925 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
926 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
928 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
929 while( scalar(@list) ) {
930 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
931 unless ($files{$file}) {
932 my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip';
933 next # update expected only for previously installed location data
934 if ( ($name eq 'PLUS4' || $name eq 'ZIP')
935 && !scalar( qsearch( { table => 'cust_tax_location',
936 hashref => { data_vendor => $vendor },
937 select => 'DISTINCT data_vendor',
942 $error = "No $name supplied";
945 my $filename = "$dir/". $files{$file};
946 open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!";
947 unlink $filename or warn "Can't delete $filename: $!";
949 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
952 ) or die "can't open temp file: $!\n";
954 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
957 ) or die "can't open temp file: $!\n";
959 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
960 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
963 $handle = $ifh if $_ =~ /$insert_pattern/;
964 $handle = $dfh if $_ =~ /$delete_pattern/;
966 $error = "bad input line: $_" unless $handle;
975 push @insert_list, $name, $ifh->filename, $import_sub;
976 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
977 unshift @predelete_list, $name, $dfh->filename, $import_sub;
979 unshift @delete_list, $name, $dfh->filename, $import_sub;
984 while( scalar(@predelete_list) ) {
985 my ($name, $file, $import_sub) =
986 (shift @predelete_list, shift @predelete_list, shift @predelete_list);
988 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
989 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
991 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
993 unlink $file or warn "Can't delete $file: $!";
996 while( scalar(@insert_list) ) {
997 my ($name, $file, $import_sub) =
998 (shift @insert_list, shift @insert_list, shift @insert_list);
1000 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1001 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1003 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1005 unlink $file or warn "Can't delete $file: $!";
1008 $error ||= "No DETAIL supplied"
1009 unless ($files{detail});
1010 open my $fh, "< $dir/". $files{detail}
1011 or $error ||= "Can't open DETAIL file: $!";
1013 &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format },
1016 unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!"
1019 while( scalar(@delete_list) ) {
1020 my ($name, $file, $import_sub) =
1021 (shift @delete_list, shift @delete_list, shift @delete_list);
1023 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1024 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1026 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1028 unlink $file or warn "Can't delete $file: $!";
1032 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1035 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1039 die "Unknown format: $format";
1044 =item process_download_and_reload
1046 Download and process a tax update as a queued JSRPC job after wiping the
1047 existing wipable tax data.
1051 sub process_download_and_reload {
1054 my $param = thaw(decode_base64($_[0]));
1055 my $format = $param->{'format'}; #well... this is all cch specific
1057 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1060 if ( $job ) { # progress bar
1061 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1062 die $error if $error;
1065 my $oldAutoCommit = $FS::UID::AutoCommit;
1066 local $FS::UID::AutoCommit = 0;
1071 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1072 "USING (taxclassnum) WHERE data_vendor = '$format'";
1073 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1075 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1076 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1077 if $sth->fetchrow_arrayref->[0];
1079 # really should get a table EXCLUSIVE lock here
1081 #remember disabled taxes
1082 my %disabled_tax_rate = ();
1083 foreach my $tax_rate ( qsearch( { table => 'tax_rate',
1084 hashref => { disabled => 'Y',
1085 data_vendor => $format,
1087 select => 'geocode, taxclassnum',
1093 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1094 unless ( $tax_class ) {
1095 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1098 $disabled_tax_rate{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1101 #remember tax products
1102 # XXX FIXME this loop only works when cch is the only data provider
1103 my %taxproduct = ();
1104 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1105 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1106 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1107 " optionname LIKE 'usage_taxproductnum_%' AND ".
1108 " optionvalue != '' )";
1109 foreach my $part_pkg ( qsearch( { table => 'part_pkg',
1110 select => 'DISTINCT pkgpart,taxproductnum',
1112 extra_sql => $extra_sql,
1117 warn "working with package part ". $part_pkg->pkgpart.
1118 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1119 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1120 $taxproduct{$part_pkg->pkgpart}{''} = $part_pkg_taxproduct->taxproduct
1121 if $part_pkg_taxproduct;
1123 foreach my $option ( $part_pkg->part_pkg_option ) {
1124 next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1127 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1128 $taxproduct{$part_pkg->pkgpart}{$class} = $part_pkg_taxproduct->taxproduct
1129 if $part_pkg_taxproduct;
1133 #wipe out the old data
1134 foreach my $tax_rate_location ( qsearch( 'tax_rate_location',
1135 { data_vendor => $format,
1141 $tax_rate_location->disabled('Y');
1142 my $error = $tax_rate_location->replace;
1144 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1149 local $FS::part_pkg_taxproduct::delete_kludge = 1;
1151 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1153 foreach my $table ( @table ) {
1154 foreach my $row ( qsearch( $table, { data_vendor => $format } ) ) {
1155 my $error = $row->delete;
1157 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1163 if ( $format eq 'cch' ) {
1164 foreach my $cust_tax_location ( qsearch( 'cust_tax_location',
1165 { data_vendor => "$format-zip" }
1169 my $error = $cust_tax_location->delete;
1171 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1178 process_download_and_update($job, @_);
1180 #restore taxproducts
1181 foreach my $pkgpart ( keys %taxproduct ) {
1182 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1184 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1185 unless ( $part_pkg ) {
1186 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1187 die "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1190 my %options = $part_pkg->options;
1191 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1192 my $primary_svc = $part_pkg->svcpart;
1193 my $new = new FS::part_pkg { $part_pkg->hash };
1195 foreach my $class ( keys %{ $taxproduct{$pkgpart} } ) {
1196 warn "working with class '$class'\n" if $DEBUG;
1197 my $part_pkg_taxproduct =
1198 qsearchs( 'part_pkg_taxproduct',
1199 { taxproduct => $taxproduct{$pkgpart}{$class},
1200 data_vendor => $format,
1204 unless ( $part_pkg_taxproduct ) {
1205 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1206 die "failed to find part_pkg_taxproduct ($taxproduct{pkgpart}{$class})".
1207 " for pkgpart $pkgpart\n";
1210 if ( $class eq '' ) {
1211 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1215 $options{"usage_taxproductnum_$class"} =
1216 $part_pkg_taxproduct->taxproductnum;
1220 my $error = $new->replace( $part_pkg,
1221 'pkg_svc' => \%pkg_svc,
1222 'primary_svc' => $primary_svc,
1223 'options' => \%options,
1227 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1233 foreach my $key (keys %disabled_tax_rate) {
1234 my ($geocode,$taxclass) = split /:/, $key, 2;
1235 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1236 taxclass => $taxclass,
1238 if (scalar(@tax_class) > 1) {
1239 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1240 die "found multiple tax_class records for format $format class $taxclass";
1243 unless (scalar(@tax_class)) {
1244 warn "no tax_class for format $format class $taxclass\n";
1249 qsearch('tax_rate', { data_vendor => $format,
1250 geocode => $geocode,
1251 taxclassnum => $tax_class[0]->taxclassnum,
1255 if (scalar(@tax_rate) > 1) {
1256 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1257 die "found multiple tax_rate records for format $format geocode $geocode".
1258 " and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum.
1262 if (scalar(@tax_rate)) {
1263 $tax_rate[0]->disabled('Y');
1264 my $error = $tax_rate[0]->replace;
1266 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1274 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1278 =item process_download_and_update
1280 Download and process a tax update as a queued JSRPC job
1284 sub process_download_and_update {
1287 my $param = thaw(decode_base64(shift));
1288 my $format = $param->{'format'}; #well... this is all cch specific
1290 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1293 if ( $job ) { # progress bar
1294 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1295 die $error if $error;
1298 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1300 mkdir $dir or die "can't create $dir: $!\n";
1303 if ($format eq 'cch') {
1305 eval "use Text::CSV_XS;";
1311 my $conffile = '%%%FREESIDE_CONF%%%/cchconf';
1312 my $conffh = new IO::File "<$conffile" or die "can't open $conffile: $!\n";
1313 my ( $urls, $secret, $states ) =
1314 map { /^(.*)$/ or die "bad config line in $conffile: $_\n"; $1 }
1319 my $oldAutoCommit = $FS::UID::AutoCommit;
1320 local $FS::UID::AutoCommit = 0;
1324 # really should get a table EXCLUSIVE lock here
1325 # check if initial import or update
1327 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1328 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1329 $sth->execute() or die $sth->errstr;
1330 my $upgrade = $sth->fetchrow_arrayref->[0];
1332 # create cache and/or rotate old tax data
1337 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1338 foreach my $file (readdir($dirh)) {
1339 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1346 if ( -e "$dir.$_" ) {
1347 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1350 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1354 die "can't find previous tax data\n" if $upgrade;
1358 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1360 # fetch and unpack the zip files
1362 my $ua = new LWP::UserAgent;
1363 foreach my $url (split ',', $urls) {
1364 my @name = split '/', $url; #somewhat restrictive
1365 my $name = pop @name;
1366 $name =~ /(.*)/; # untaint that which we trust;
1369 open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n";
1371 my $res = $ua->request(
1372 new HTTP::Request( GET => $url),
1373 sub { #my ($data, $response_object) = @_;
1374 print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n";
1375 my $content_length = $_[1]->content_length;
1376 $imported += length($_[0]);
1377 if ( time - $min_sec > $last ) {
1378 my $error = $job->update_statustext(
1379 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1380 ",Downloading data from CCH"
1382 die $error if $error;
1387 die "download of $url failed: ". $res->status_line
1388 unless $res->is_success;
1391 my $error = $job->update_statustext( "0,Unpacking data" );
1392 die $error if $error;
1393 $secret =~ /(.*)/; # untaint that which we trust;
1395 system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0
1396 or die "unzip -P $secret -d $dir.new $dir.new/$name failed";
1397 #unlink "$dir.new/$name";
1400 # extract csv files from the dbf files
1402 foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) {
1403 my $error = $job->update_statustext( "0,Unpacking $name" );
1404 die $error if $error;
1405 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1406 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1407 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1408 unless defined($table);
1409 $count = $table->last_record; # approximately;
1411 open my $csvfh, ">$dir.new/$name.txt"
1412 or die "failed to open $dir.new/$name.txt: $!\n";
1414 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1415 my @fields = $table->field_names;
1416 my $cursor = $table->prepare_select;
1418 sub { my $date = shift;
1419 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1422 while (my $row = $cursor->fetch_hashref) {
1423 $csv->combine( map { ($table->field_type($_) eq 'D')
1424 ? &{$format_date}($row->{$_})
1429 print $csvfh $csv->string, "\n";
1431 if ( time - $min_sec > $last ) {
1432 my $error = $job->update_statustext(
1433 int(100 * $imported/$count). ",Unpacking $name"
1435 die $error if $error;
1443 # generate the diff files
1445 my @insert_list = ();
1446 my @delete_list = ();
1447 my @predelete_list = ();
1450 'geocode', \&FS::tax_rate_location::batch_import,
1451 'code', \&FS::tax_class::batch_import,
1452 'plus4', \&FS::cust_tax_location::batch_import,
1453 'zip', \&FS::cust_tax_location::batch_import,
1454 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
1455 'detail', \&FS::tax_rate::batch_import,
1458 while( scalar(@list) ) {
1459 my ( $name, $method ) = ( shift @list, shift @list );
1462 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1463 die $error if $error;
1465 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1468 open my $oldcsvfh, "$dir.1/$name.txt"
1469 or die "failed to open $dir.1/$name.txt: $!\n";
1471 while(<$oldcsvfh>) {
1478 open my $newcsvfh, "$dir.new/$name.txt"
1479 or die "failed to open $dir.new/$name.txt: $!\n";
1481 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1484 ) or die "can't open temp file: $!\n";
1486 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1489 ) or die "can't open temp file: $!\n";
1491 while(<$newcsvfh>) {
1493 if (exists($oldlines{$_})) {
1496 print $ifh $_, ',"I"', "\n";
1501 if ($name eq 'detail') {
1502 for (keys %oldlines) { # one file for rate details
1503 print $ifh $_, ',"D"', "\n" if $oldlines{$_};
1506 for (keys %oldlines) {
1507 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1512 push @insert_list, $name, $ifh->filename, $method;
1513 if ( $name eq 'geocode' ) {
1514 unshift @predelete_list, $name, $dfh->filename, $method
1515 unless $name eq 'detail';
1517 unshift @delete_list, $name, $dfh->filename, $method
1518 unless $name eq 'detail';
1525 while( scalar(@predelete_list) ) {
1526 my ($name, $file, $method) =
1527 (shift @predelete_list, shift @predelete_list, shift @predelete_list);
1529 my $fmt = "$format-update";
1530 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1531 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1533 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1535 #unlink $file or warn "Can't delete $file: $!";
1538 while( scalar(@insert_list) ) {
1539 my ($name, $file, $method) =
1540 (shift @insert_list, shift @insert_list, shift @insert_list);
1542 my $fmt = "$format-update";
1543 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1544 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1546 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1548 #unlink $file or warn "Can't delete $file: $!";
1551 while( scalar(@delete_list) ) {
1552 my ($name, $file, $method) =
1553 (shift @delete_list, shift @delete_list, shift @delete_list);
1555 my $fmt = "$format-update";
1556 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1557 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1559 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1561 #unlink $file or warn "Can't delete $file: $!";
1565 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1568 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1571 rename "$dir.new", "$dir"
1572 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1575 die "Unknown format: $format";
1579 =item browse_queries PARAMS
1581 Returns a list consisting of a hashref suited for use as the argument
1582 to qsearch, and sql query string. Each is based on the PARAMS hashref
1583 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1584 from a form. This conveniently creates the query hashref and count_query
1585 string required by the browse and search elements. As a side effect,
1586 the PARAMS hashref is untainted and keys with unexpected values are removed.
1590 sub browse_queries {
1594 'table' => 'tax_rate',
1596 'order_by' => 'ORDER BY geocode, taxclassnum',
1601 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1602 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1604 delete $params->{data_vendor};
1607 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1608 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1609 'geocode LIKE '. dbh->quote($1.'%');
1611 delete $params->{geocode};
1614 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1615 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1618 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1619 ' taxclassnum = '. dbh->quote($1)
1621 delete $params->{taxclassnun};
1625 if ( $params->{tax_type} =~ /^(\d+)$/ );
1626 delete $params->{tax_type}
1630 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1631 delete $params->{tax_cat}
1634 my @taxclassnum = ();
1635 if ($tax_type || $tax_cat ) {
1636 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1637 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1638 @taxclassnum = map { $_->taxclassnum }
1639 qsearch({ 'table' => 'tax_class',
1641 'extra_sql' => "WHERE taxclass $compare",
1645 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1646 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1647 if ( @taxclassnum );
1649 unless ($params->{'showdisabled'}) {
1650 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1651 "( disabled = '' OR disabled IS NULL )";
1654 $query->{extra_sql} = $extra_sql;
1656 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1661 # Used by FS::Upgrade to migrate to a new database.
1665 sub _upgrade_data { # class method
1666 my ($self, %opts) = @_;
1669 warn "$me upgrading $self\n" if $DEBUG;
1671 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1674 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1676 eval "use DBI::Const::GetInfoType;";
1679 my $major_version = 0;
1680 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1681 && ( $major_version = sprintf("%d", $1) );
1683 if ( $major_version > 7 ) {
1685 # ideally this would be supported in DBIx-DBSchema and friends
1687 foreach my $column ( @column ) {
1688 my $columndef = dbdef->table($self->table)->column($column);
1689 unless ($columndef->type eq 'numeric') {
1691 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1692 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1693 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1694 $sth->execute or die $sth->errstr;
1696 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1697 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1698 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1699 $sth->execute or die $sth->errstr;
1704 } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1706 # ideally this would be supported in DBIx-DBSchema and friends
1708 foreach my $column ( @column ) {
1709 my $columndef = dbdef->table($self->table)->column($column);
1710 unless ($columndef->type eq 'numeric') {
1712 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1714 foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1716 my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1717 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1718 $sth->execute or die $sth->errstr;
1720 my $def = dbdef->table($table)->column($column);
1721 $def->type('numeric');
1722 $def->length('14,8');
1723 my $null = $def->null;
1726 $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1727 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1728 $sth->execute or die $sth->errstr;
1730 $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1731 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1732 $sth->execute or die $sth->errstr;
1734 unless ( $null eq 'NULL' ) {
1735 $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1736 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1737 $sth->execute or die $sth->errstr;
1740 $sql = "ALTER TABLE $table DROP old_$column";
1741 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1742 $sth->execute or die $sth->errstr;
1750 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1756 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1768 Mixing automatic and manual editing works poorly at present.
1772 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base