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 = ();
921 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
922 'CODE', 'codefile', \&FS::tax_class::batch_import,
923 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
924 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
925 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
927 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
928 while( scalar(@list) ) {
929 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
930 unless ($files{$file}) {
931 my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip';
932 next # update expected only for previously installed location data
933 if ( ($name eq 'PLUS4' || $name eq 'ZIP')
934 && !scalar( qsearch( { table => 'cust_tax_location',
935 hashref => { data_vendor => $vendor },
936 select => 'DISTINCT data_vendor',
941 $error = "No $name supplied";
944 my $filename = "$dir/". $files{$file};
945 open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!";
946 unlink $filename or warn "Can't delete $filename: $!";
948 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
951 ) or die "can't open temp file: $!\n";
953 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
956 ) or die "can't open temp file: $!\n";
958 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
959 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
962 $handle = $ifh if $_ =~ /$insert_pattern/;
963 $handle = $dfh if $_ =~ /$delete_pattern/;
965 $error = "bad input line: $_" unless $handle;
974 push @insert_list, $name, $ifh->filename, $import_sub;
975 unshift @delete_list, $name, $dfh->filename, $import_sub;
978 while( scalar(@insert_list) ) {
979 my ($name, $file, $import_sub) =
980 (shift @insert_list, shift @insert_list, shift @insert_list);
982 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
983 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
985 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
987 unlink $file or warn "Can't delete $file: $!";
990 $error ||= "No DETAIL supplied"
991 unless ($files{detail});
992 open my $fh, "< $dir/". $files{detail}
993 or $error ||= "Can't open DETAIL file: $!";
995 &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format },
998 unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!"
1001 while( scalar(@delete_list) ) {
1002 my ($name, $file, $import_sub) =
1003 (shift @delete_list, shift @delete_list, shift @delete_list);
1005 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1006 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1008 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1010 unlink $file or warn "Can't delete $file: $!";
1014 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1017 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1021 die "Unknown format: $format";
1026 =item process_download_and_reload
1028 Download and process a tax update as a queued JSRPC job after wiping the
1029 existing wipable tax data.
1033 sub process_download_and_reload {
1036 my $param = thaw(decode_base64($_[0]));
1037 my $format = $param->{'format'}; #well... this is all cch specific
1039 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1042 if ( $job ) { # progress bar
1043 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1044 die $error if $error;
1047 my $oldAutoCommit = $FS::UID::AutoCommit;
1048 local $FS::UID::AutoCommit = 0;
1053 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1054 "USING (taxclassnum) WHERE data_vendor = '$format'";
1055 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1057 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1058 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1059 if $sth->fetchrow_arrayref->[0];
1061 # really should get a table EXCLUSIVE lock here
1063 #remember disabled taxes
1064 my %disabled_tax_rate = ();
1065 foreach my $tax_rate ( qsearch( { table => 'tax_rate',
1066 hashref => { disabled => 'Y',
1067 data_vendor => $format,
1069 select => 'geocode, taxclassnum',
1075 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1076 unless ( $tax_class ) {
1077 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1080 $disabled_tax_rate{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1083 #remember tax products
1084 # XXX FIXME this loop only works when cch is the only data provider
1085 my %taxproduct = ();
1086 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1087 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1088 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1089 " optionname LIKE 'usage_taxproductnum_%' AND ".
1090 " optionvalue != '' )";
1091 foreach my $part_pkg ( qsearch( { table => 'part_pkg',
1092 select => 'DISTINCT pkgpart,taxproductnum',
1094 extra_sql => $extra_sql,
1099 warn "working with package part ". $part_pkg->pkgpart.
1100 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1101 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1102 $taxproduct{$part_pkg->pkgpart}{''} = $part_pkg_taxproduct->taxproduct
1103 if $part_pkg_taxproduct;
1105 foreach my $option ( $part_pkg->part_pkg_option ) {
1106 next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1109 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1110 $taxproduct{$part_pkg->pkgpart}{$class} = $part_pkg_taxproduct->taxproduct
1111 if $part_pkg_taxproduct;
1115 #wipe out the old data
1116 foreach my $tax_rate_location ( qsearch( 'tax_rate_location',
1117 { data_vendor => $format,
1123 $tax_rate_location->disabled('Y');
1124 my $error = $tax_rate_location->replace;
1126 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1131 local $FS::part_pkg_taxproduct::delete_kludge = 1;
1133 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1135 foreach my $table ( @table ) {
1136 foreach my $row ( qsearch( $table, { data_vendor => $format } ) ) {
1137 my $error = $row->delete;
1139 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1145 if ( $format eq 'cch' ) {
1146 foreach my $cust_tax_location ( qsearch( 'cust_tax_location',
1147 { data_vendor => "$format-zip" }
1151 my $error = $cust_tax_location->delete;
1153 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1160 process_download_and_update($job, @_);
1162 #restore taxproducts
1163 foreach my $pkgpart ( keys %taxproduct ) {
1164 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1166 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1167 unless ( $part_pkg ) {
1168 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1169 die "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1172 my %options = $part_pkg->options;
1173 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1174 my $primary_svc = $part_pkg->svcpart;
1175 my $new = new FS::part_pkg { $part_pkg->hash };
1177 foreach my $class ( keys %{ $taxproduct{$pkgpart} } ) {
1178 warn "working with class '$class'\n" if $DEBUG;
1179 my $part_pkg_taxproduct =
1180 qsearchs( 'part_pkg_taxproduct',
1181 { taxproduct => $taxproduct{$pkgpart}{$class},
1182 data_vendor => $format,
1186 unless ( $part_pkg_taxproduct ) {
1187 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1188 die "failed to find part_pkg_taxproduct ($taxproduct{pkgpart}{$class})".
1189 " for pkgpart $pkgpart\n";
1192 if ( $class eq '' ) {
1193 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1197 $options{"usage_taxproductnum_$class"} =
1198 $part_pkg_taxproduct->taxproductnum;
1202 my $error = $new->replace( $part_pkg,
1203 'pkg_svc' => \%pkg_svc,
1204 'primary_svc' => $primary_svc,
1205 'options' => \%options,
1209 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1215 foreach my $key (keys %disabled_tax_rate) {
1216 my ($geocode,$taxclass) = split /:/, $key, 2;
1217 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1218 taxclass => $taxclass,
1220 if (scalar(@tax_class) > 1) {
1221 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1222 die "found multiple tax_class records for format $format class $taxclass";
1225 unless (scalar(@tax_class)) {
1226 warn "no tax_class for format $format class $taxclass\n";
1231 qsearch('tax_rate', { data_vendor => $format,
1232 geocode => $geocode,
1233 taxclassnum => $tax_class[0]->taxclassnum,
1237 if (scalar(@tax_rate) > 1) {
1238 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1239 die "found multiple tax_rate records for format $format geocode $geocode".
1240 " and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum.
1244 if (scalar(@tax_rate)) {
1245 $tax_rate[0]->disabled('Y');
1246 my $error = $tax_rate[0]->replace;
1248 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1260 =item process_download_and_update
1262 Download and process a tax update as a queued JSRPC job
1266 sub process_download_and_update {
1269 my $param = thaw(decode_base64(shift));
1270 my $format = $param->{'format'}; #well... this is all cch specific
1272 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1275 if ( $job ) { # progress bar
1276 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1277 die $error if $error;
1280 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1282 mkdir $dir or die "can't create $dir: $!\n";
1285 if ($format eq 'cch') {
1287 eval "use Text::CSV_XS;";
1293 my $conffile = '%%%FREESIDE_CONF%%%/cchconf';
1294 my $conffh = new IO::File "<$conffile" or die "can't open $conffile: $!\n";
1295 my ( $urls, $secret, $states ) =
1296 map { /^(.*)$/ or die "bad config line in $conffile: $_\n"; $1 }
1301 my $oldAutoCommit = $FS::UID::AutoCommit;
1302 local $FS::UID::AutoCommit = 0;
1306 # really should get a table EXCLUSIVE lock here
1307 # check if initial import or update
1309 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1310 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1311 $sth->execute() or die $sth->errstr;
1312 my $upgrade = $sth->fetchrow_arrayref->[0];
1314 # create cache and/or rotate old tax data
1319 opendir(my $dirh, $dir) or die "failed to open $dir.4: $!\n";
1320 foreach my $file (readdir($dirh)) {
1321 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1328 if ( -e "$dir.$_" ) {
1329 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1332 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1336 die "can't find previous tax data\n" if $upgrade;
1340 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1342 # fetch and unpack the zip files
1344 my $ua = new LWP::UserAgent;
1345 foreach my $url (split ',', $urls) {
1346 my @name = split '/', $url; #somewhat restrictive
1347 my $name = pop @name;
1348 $name =~ /(.*)/; # untaint that which we trust;
1351 open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n";
1353 my $res = $ua->request(
1354 new HTTP::Request( GET => $url),
1355 sub { #my ($data, $response_object) = @_;
1356 print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n";
1357 my $content_length = $_[1]->content_length;
1358 $imported += length($_[0]);
1359 if ( time - $min_sec > $last ) {
1360 my $error = $job->update_statustext(
1361 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1362 ",Downloading data from CCH"
1364 die $error if $error;
1369 die "download of $url failed: ". $res->status_line
1370 unless $res->is_success;
1373 my $error = $job->update_statustext( "0,Unpacking data" );
1374 die $error if $error;
1375 $secret =~ /(.*)/; # untaint that which we trust;
1377 system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0
1378 or die "unzip -P $secret -d $dir.new $dir.new/$name failed";
1379 #unlink "$dir.new/$name";
1382 # extract csv files from the dbf files
1384 foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) {
1385 my $error = $job->update_statustext( "0,Unpacking $name" );
1386 die $error if $error;
1387 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1388 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1389 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1390 unless defined($table);
1391 $count = $table->last_record; # approximately;
1393 open my $csvfh, ">$dir.new/$name.txt"
1394 or die "failed to open $dir.new/$name.txt: $!\n";
1396 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1397 my @fields = $table->field_names;
1398 my $cursor = $table->prepare_select;
1400 sub { my $date = shift;
1401 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1404 while (my $row = $cursor->fetch_hashref) {
1405 $csv->combine( map { ($table->field_type($_) eq 'D')
1406 ? &{$format_date}($row->{$_})
1411 print $csvfh $csv->string, "\n";
1413 if ( time - $min_sec > $last ) {
1414 my $error = $job->update_statustext(
1415 int(100 * $imported/$count). ",Unpacking $name"
1417 die $error if $error;
1425 # generate the diff files
1427 my @insert_list = ();
1428 my @delete_list = ();
1431 'geocode', \&FS::tax_rate_location::batch_import,
1432 'code', \&FS::tax_class::batch_import,
1433 'plus4', \&FS::cust_tax_location::batch_import,
1434 'zip', \&FS::cust_tax_location::batch_import,
1435 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
1436 'detail', \&FS::tax_rate::batch_import,
1439 while( scalar(@list) ) {
1440 my ( $name, $method ) = ( shift @list, shift @list );
1443 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1444 die $error if $error;
1446 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1449 open my $oldcsvfh, "$dir.1/$name.txt"
1450 or die "failed to open $dir.1/$name.txt: $!\n";
1452 while(<$oldcsvfh>) {
1459 open my $newcsvfh, "$dir.new/$name.txt"
1460 or die "failed to open $dir.new/$name.txt: $!\n";
1462 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1465 ) or die "can't open temp file: $!\n";
1467 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1470 ) or die "can't open temp file: $!\n";
1472 while(<$newcsvfh>) {
1474 if (exists($oldlines{$_})) {
1477 print $ifh $_, ',"I"', "\n";
1482 if ($name eq 'detail') {
1483 for (keys %oldlines) { # one file for rate details
1484 print $ifh $_, ',"D"', "\n" if $oldlines{$_};
1487 for (keys %oldlines) {
1488 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1493 push @insert_list, $name, $ifh->filename, $method;
1494 unshift @delete_list, $name, $dfh->filename, $method
1495 unless $name eq 'detail';
1501 while( scalar(@insert_list) ) {
1502 my ($name, $file, $method) =
1503 (shift @insert_list, shift @insert_list, shift @insert_list);
1505 my $fmt = "$format-update";
1506 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1507 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1509 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1511 #unlink $file or warn "Can't delete $file: $!";
1514 while( scalar(@delete_list) ) {
1515 my ($name, $file, $method) =
1516 (shift @delete_list, shift @delete_list, shift @delete_list);
1518 my $fmt = "$format-update";
1519 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1520 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1522 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1524 #unlink $file or warn "Can't delete $file: $!";
1528 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1531 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1534 rename "$dir.new", "$dir"
1535 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1538 die "Unknown format: $format";
1542 =item browse_queries PARAMS
1544 Returns a list consisting of a hashref suited for use as the argument
1545 to qsearch, and sql query string. Each is based on the PARAMS hashref
1546 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1547 from a form. This conveniently creates the query hashref and count_query
1548 string required by the browse and search elements. As a side effect,
1549 the PARAMS hashref is untainted and keys with unexpected values are removed.
1553 sub browse_queries {
1557 'table' => 'tax_rate',
1559 'order_by' => 'ORDER BY geocode, taxclassnum',
1564 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1565 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1567 delete $params->{data_vendor};
1570 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1571 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1572 'geocode LIKE '. dbh->quote($1.'%');
1574 delete $params->{geocode};
1577 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1578 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1581 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1582 ' taxclassnum = '. dbh->quote($1)
1584 delete $params->{taxclassnun};
1588 if ( $params->{tax_type} =~ /^(\d+)$/ );
1589 delete $params->{tax_type}
1593 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1594 delete $params->{tax_cat}
1597 my @taxclassnum = ();
1598 if ($tax_type || $tax_cat ) {
1599 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1600 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1601 @taxclassnum = map { $_->taxclassnum }
1602 qsearch({ 'table' => 'tax_class',
1604 'extra_sql' => "WHERE taxclass $compare",
1608 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1609 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1610 if ( @taxclassnum );
1612 unless ($params->{'showdisabled'}) {
1613 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1614 "( disabled = '' OR disabled IS NULL )";
1617 $query->{extra_sql} = $extra_sql;
1619 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1624 # Used by FS::Upgrade to migrate to a new database.
1628 sub _upgrade_data { # class method
1629 my ($self, %opts) = @_;
1632 warn "$me upgrading $self\n" if $DEBUG;
1634 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1637 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1639 eval "use DBI::Const::GetInfoType;";
1642 my $major_version = 0;
1643 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1644 && ( $major_version = sprintf("%d", $1) );
1646 if ( $major_version > 7 ) {
1648 # ideally this would be supported in DBIx-DBSchema and friends
1650 foreach my $column ( @column ) {
1651 my $columndef = dbdef->table($self->table)->column($column);
1652 unless ($columndef->type eq 'numeric') {
1654 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1655 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1656 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1657 $sth->execute or die $sth->errstr;
1659 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1660 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1661 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1662 $sth->execute or die $sth->errstr;
1667 } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1669 # ideally this would be supported in DBIx-DBSchema and friends
1671 foreach my $column ( @column ) {
1672 my $columndef = dbdef->table($self->table)->column($column);
1673 unless ($columndef->type eq 'numeric') {
1675 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1677 foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1679 my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1680 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1681 $sth->execute or die $sth->errstr;
1683 my $def = dbdef->table($table)->column($column);
1684 $def->type('numeric');
1685 $def->length('14,8');
1686 my $null = $def->null;
1689 $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1690 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1691 $sth->execute or die $sth->errstr;
1693 $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1694 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1695 $sth->execute or die $sth->errstr;
1697 unless ( $null eq 'NULL' ) {
1698 $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1699 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1700 $sth->execute or die $sth->errstr;
1703 $sql = "ALTER TABLE $table DROP old_$column";
1704 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1705 $sth->execute or die $sth->errstr;
1713 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1719 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1731 Mixing automatic and manual editing works poorly at present.
1735 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base