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('inoutcity', [ '', 'I', 'O' ] )
235 || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
236 || $self->ut_enum('manual', [ '', 'Y' ] )
237 || $self->ut_enum('disabled', [ '', 'Y' ] )
238 || $self->SUPER::check
243 =item taxclass_description
245 Returns the human understandable value associated with the related
250 sub taxclass_description {
252 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
253 $tax_class ? $tax_class->description : '';
258 Returns the human understandable value associated with the unittype column
262 %tax_unittypes = ( '0' => 'access line',
269 $tax_unittypes{$self->unittype};
274 Returns the human understandable value associated with the maxtype column
278 %tax_maxtypes = ( '0' => 'receipts per invoice',
279 '1' => 'receipts per item',
280 '2' => 'total utility charges per utility tax year',
281 '3' => 'total charges per utility tax year',
282 '4' => 'receipts per access line',
283 '9' => 'monthly receipts per location',
288 $tax_maxtypes{$self->maxtype};
293 Returns the human understandable value associated with the basetype column
297 %tax_basetypes = ( '0' => 'sale price',
298 '1' => 'gross receipts',
299 '2' => 'sales taxable telecom revenue',
300 '3' => 'minutes carried',
301 '4' => 'minutes billed',
302 '5' => 'gross operating revenue',
303 '6' => 'access line',
305 '8' => 'gross revenue',
306 '9' => 'portion gross receipts attributable to interstate service',
307 '10' => 'access line',
308 '11' => 'gross profits',
309 '12' => 'tariff rate',
311 '15' => 'prior year gross receipts',
316 $tax_basetypes{$self->basetype};
321 Returns the human understandable value associated with the taxauth column
325 %tax_authorities = ( '0' => 'federal',
330 '5' => 'county administered by state',
331 '6' => 'city administered by state',
332 '7' => 'city administered by county',
333 '8' => 'local administered by state',
334 '9' => 'local administered by county',
339 $tax_authorities{$self->taxauth};
344 Returns the human understandable value associated with the passtype column
348 %tax_passtypes = ( '0' => 'separate tax line',
349 '1' => 'separate surcharge line',
350 '2' => 'surcharge not separated',
351 '3' => 'included in base rate',
356 $tax_passtypes{$self->passtype};
359 =item taxline TAXABLES, [ OPTIONSHASH ]
361 Returns a listref of a name and an amount of tax calculated for the list
362 of packages/amounts referenced by TAXABLES. If an error occurs, a message
363 is returned as a scalar.
373 if (ref($_[0]) eq 'ARRAY') {
378 #exemptions would be broken in this case
381 my $name = $self->taxname;
382 $name = 'Other surcharges'
383 if ($self->passtype == 2);
386 if ( $self->disabled ) { # we always know how to handle disabled taxes
393 my $taxable_charged = 0;
394 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
397 warn "calculating taxes for ". $self->taxnum. " on ".
398 join (",", map { $_->pkgnum } @cust_bill_pkg)
401 if ($self->passflag eq 'N') {
402 # return "fatal: can't (yet) handle taxes not passed to the customer";
403 # until someone needs to track these in freeside
410 my $maxtype = $self->maxtype || 0;
411 if ($maxtype != 0 && $maxtype != 9) {
412 return $self->_fatal_or_null( 'tax with "'.
413 $self->maxtype_name. '" threshold'
419 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
423 # we treat gross revenue as gross receipts and expect the tax data
424 # to DTRT (i.e. tax on tax rules)
425 if ($self->basetype != 0 && $self->basetype != 1 &&
426 $self->basetype != 5 && $self->basetype != 6 &&
427 $self->basetype != 7 && $self->basetype != 8 &&
428 $self->basetype != 14
431 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
434 unless ($self->setuptax =~ /^Y$/i) {
435 $taxable_charged += $_->setup foreach @cust_bill_pkg;
437 unless ($self->recurtax =~ /^Y$/i) {
438 $taxable_charged += $_->recur foreach @cust_bill_pkg;
441 my $taxable_units = 0;
442 unless ($self->recurtax =~ /^Y$/i) {
443 if (( $self->unittype || 0 ) == 0) {
445 foreach (@cust_bill_pkg) {
446 $taxable_units += $_->units
447 unless $seen{$_->pkgnum};
450 }elsif ($self->unittype == 1) {
451 return $self->_fatal_or_null( 'fee with minute unit type' );
452 }elsif ($self->unittype == 2) {
455 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
460 # XXX insert exemption handling here
462 # the tax or fee is applied to taxbase or feebase and then
463 # the excessrate or excess fee is applied to taxmax or feemax
466 $amount += $taxable_charged * $self->tax;
467 $amount += $taxable_units * $self->fee;
469 warn "calculated taxes as [ $name, $amount ]\n"
480 my ($self, $error) = @_;
482 my $conf = new FS::Conf;
484 $error = "can't yet handle $error";
485 my $name = $self->taxname;
486 $name = 'Other surcharges'
487 if ($self->passtype == 2);
489 if ($conf->exists('ignore_incalculable_taxes')) {
490 warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
491 return { name => $name, amount => 0 };
493 return "fatal: $error";
497 =item tax_on_tax CUST_MAIN
499 Returns a list of taxes which are candidates for taxing taxes for the
500 given customer (see L<FS::cust_main>)
506 my $cust_main = shift;
508 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
512 my $geocode = $cust_main->geocode($self->data_vendor);
516 my $extra_sql = ' AND ('.
517 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
522 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
523 my $select = 'DISTINCT ON(taxclassnum) *';
525 # should qsearch preface columns with the table to facilitate joins?
526 my @taxclassnums = map { $_->taxclassnum }
527 qsearch( { 'table' => 'part_pkg_taxrate',
529 'hashref' => { 'data_vendor' => $self->data_vendor,
530 'taxclassnumtaxed' => $self->taxclassnum,
532 'extra_sql' => $extra_sql,
533 'order_by' => $order_by,
536 return () unless @taxclassnums;
539 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
541 qsearch({ 'table' => 'tax_rate',
542 'hashref' => { 'geocode' => $geocode, },
543 'extra_sql' => $extra_sql,
548 =item tax_rate_location
550 Returns an object representing the location associated with this tax
551 (see L<FS::tax_rate_location>)
555 sub tax_rate_location {
558 qsearchs({ 'table' => 'tax_rate_location',
559 'hashref' => { 'data_vendor' => $self->data_vendor,
560 'geocode' => $self->geocode,
564 new FS::tax_rate_location;
579 my ($param, $job) = @_;
581 my $fh = $param->{filehandle};
582 my $format = $param->{'format'};
590 my @column_lengths = ();
591 my @column_callbacks = ();
592 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
593 $format =~ s/-fixed//;
594 my $date_format = sub { my $r='';
595 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
598 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
599 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 );
600 push @column_lengths, 1 if $format eq 'cch-update';
601 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
602 $column_callbacks[8] = $date_format;
606 my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
607 if ( $job || scalar(@column_callbacks) ) {
609 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
610 return $error if $error;
614 if ( $format eq 'cch' || $format eq 'cch-update' ) {
615 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
616 excessrate effective_date taxauth taxtype taxcat taxname
617 usetax useexcessrate fee unittype feemax maxtype passflag
619 push @fields, 'actionflag' if $format eq 'cch-update';
624 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
625 $hash->{'data_vendor'} ='cch';
626 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
627 time_zone => 'floating',
629 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
630 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
632 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
635 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
637 my %tax_class = ( 'data_vendor' => 'cch',
638 'taxclass' => $taxclassid,
641 my $tax_class = qsearchs( 'tax_class', \%tax_class );
642 return "Error updating tax rate: no tax class $taxclassid"
645 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
647 foreach (qw( taxtype taxcat )) {
651 my %passflagmap = ( '0' => '',
655 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
656 if exists $passflagmap{$hash->{'passflag'}};
658 foreach (keys %$hash) {
659 $hash->{$_} = substr($hash->{$_}, 0, 80)
660 if length($hash->{$_}) > 80;
663 my $actionflag = delete($hash->{'actionflag'});
665 $hash->{'taxname'} =~ s/`/'/g;
666 $hash->{'taxname'} =~ s|\\|/|g;
668 return '' if $format eq 'cch'; # but not cch-update
670 if ($actionflag eq 'I') {
671 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
672 }elsif ($actionflag eq 'D') {
673 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
675 return "Unexpected action flag: ". $hash->{'actionflag'};
678 delete($hash->{$_}) for keys %$hash;
684 } elsif ( $format eq 'extended' ) {
685 die "unimplemented\n";
689 die "unknown format $format";
692 eval "use Text::CSV_XS;";
695 my $csv = new Text::CSV_XS;
699 local $SIG{HUP} = 'IGNORE';
700 local $SIG{INT} = 'IGNORE';
701 local $SIG{QUIT} = 'IGNORE';
702 local $SIG{TERM} = 'IGNORE';
703 local $SIG{TSTP} = 'IGNORE';
704 local $SIG{PIPE} = 'IGNORE';
706 my $oldAutoCommit = $FS::UID::AutoCommit;
707 local $FS::UID::AutoCommit = 0;
710 while ( defined($line=<$fh>) ) {
711 $csv->parse($line) or do {
712 $dbh->rollback if $oldAutoCommit;
713 return "can't parse: ". $csv->error_input();
716 if ( $job ) { # progress bar
717 if ( time - $min_sec > $last ) {
718 my $error = $job->update_statustext(
719 int( 100 * $imported / $count ). ",Importing tax rates"
722 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
729 my @columns = $csv->fields();
731 my %tax_rate = ( 'data_vendor' => $format );
732 foreach my $field ( @fields ) {
733 $tax_rate{$field} = shift @columns;
735 if ( scalar( @columns ) ) {
736 $dbh->rollback if $oldAutoCommit;
737 return "Unexpected trailing columns in line (wrong format?): $line";
740 my $error = &{$hook}(\%tax_rate);
742 $dbh->rollback if $oldAutoCommit;
746 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
748 my $tax_rate = new FS::tax_rate( \%tax_rate );
749 $error = $tax_rate->insert;
752 $dbh->rollback if $oldAutoCommit;
753 return "can't insert tax_rate for $line: $error";
762 for (grep { !exists($delete{$_}) } keys %insert) {
763 if ( $job ) { # progress bar
764 if ( time - $min_sec > $last ) {
765 my $error = $job->update_statustext(
766 int( 100 * $imported / $count ). ",Importing tax rates"
769 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
776 my $tax_rate = new FS::tax_rate( $insert{$_} );
777 my $error = $tax_rate->insert;
780 $dbh->rollback if $oldAutoCommit;
781 my $hashref = $insert{$_};
782 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
783 return "can't insert tax_rate for $line: $error";
789 for (grep { exists($delete{$_}) } keys %insert) {
790 if ( $job ) { # progress bar
791 if ( time - $min_sec > $last ) {
792 my $error = $job->update_statustext(
793 int( 100 * $imported / $count ). ",Importing tax rates"
796 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
803 my $old = qsearchs( 'tax_rate', $delete{$_} );
805 $dbh->rollback if $oldAutoCommit;
807 return "can't find tax_rate to replace for: ".
808 #join(" ", map { "$_ => ". $old->{$_} } @fields);
809 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
811 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
812 $new->taxnum($old->taxnum);
813 my $error = $new->replace($old);
816 $dbh->rollback if $oldAutoCommit;
817 my $hashref = $insert{$_};
818 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
819 return "can't replace tax_rate for $line: $error";
826 for (grep { !exists($insert{$_}) } keys %delete) {
827 if ( $job ) { # progress bar
828 if ( time - $min_sec > $last ) {
829 my $error = $job->update_statustext(
830 int( 100 * $imported / $count ). ",Importing tax rates"
833 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
840 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
842 $dbh->rollback if $oldAutoCommit;
843 $tax_rate = $delete{$_};
844 return "can't find tax_rate to delete for: ".
845 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
846 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
848 my $error = $tax_rate->delete;
851 $dbh->rollback if $oldAutoCommit;
852 my $hashref = $delete{$_};
853 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
854 return "can't delete tax_rate for $line: $error";
860 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
862 return "Empty file!" unless ($imported || $format eq 'cch-update');
868 =item process_batch_import
870 Load a batch import as a queued JSRPC job
874 sub process_batch_import {
877 my $param = thaw(decode_base64(shift));
878 my $format = $param->{'format'}; #well... this is all cch specific
880 my $files = $param->{'uploaded_files'}
881 or die "No files provided.";
883 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
885 if ($format eq 'cch' || $format eq 'cch-fixed') {
887 my $oldAutoCommit = $FS::UID::AutoCommit;
888 local $FS::UID::AutoCommit = 0;
891 my $have_location = 0;
893 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
894 'CODE', 'codefile', \&FS::tax_class::batch_import,
895 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
896 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
897 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
898 'DETAIL', 'detail', \&FS::tax_rate::batch_import,
900 while( scalar(@list) ) {
901 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
902 unless ($files{$file}) {
903 next if $name eq 'PLUS4';
904 $error = "No $name supplied";
905 $error = "Neither PLUS4 nor ZIP supplied"
906 if ($name eq 'ZIP' && !$have_location);
909 $have_location = 1 if $name eq 'PLUS4';
910 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
911 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
912 my $filename = "$dir/". $files{$file};
913 open my $fh, "< $filename" or $error ||= "Can't open $name file: $!";
915 $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
917 unlink $filename or warn "Can't delete $filename: $!";
921 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
924 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
927 }elsif ($format eq 'cch-update' || $format eq 'cch-fixed-update') {
929 my $oldAutoCommit = $FS::UID::AutoCommit;
930 local $FS::UID::AutoCommit = 0;
933 my @insert_list = ();
934 my @delete_list = ();
935 my @predelete_list = ();
937 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
938 'CODE', 'codefile', \&FS::tax_class::batch_import,
939 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
940 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
941 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
943 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
944 while( scalar(@list) ) {
945 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
946 unless ($files{$file}) {
947 my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip';
948 next # update expected only for previously installed location data
949 if ( ($name eq 'PLUS4' || $name eq 'ZIP')
950 && !scalar( qsearch( { table => 'cust_tax_location',
951 hashref => { data_vendor => $vendor },
952 select => 'DISTINCT data_vendor',
957 $error = "No $name supplied";
960 my $filename = "$dir/". $files{$file};
961 open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!";
962 unlink $filename or warn "Can't delete $filename: $!";
964 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
967 ) or die "can't open temp file: $!\n";
969 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
972 ) or die "can't open temp file: $!\n";
974 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
975 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
978 $handle = $ifh if $_ =~ /$insert_pattern/;
979 $handle = $dfh if $_ =~ /$delete_pattern/;
981 $error = "bad input line: $_" unless $handle;
990 push @insert_list, $name, $ifh->filename, $import_sub;
991 if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
992 unshift @predelete_list, $name, $dfh->filename, $import_sub;
994 unshift @delete_list, $name, $dfh->filename, $import_sub;
999 while( scalar(@predelete_list) ) {
1000 my ($name, $file, $import_sub) =
1001 (shift @predelete_list, shift @predelete_list, shift @predelete_list);
1003 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1004 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1006 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1008 unlink $file or warn "Can't delete $file: $!";
1011 while( scalar(@insert_list) ) {
1012 my ($name, $file, $import_sub) =
1013 (shift @insert_list, shift @insert_list, shift @insert_list);
1015 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1016 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1018 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1020 unlink $file or warn "Can't delete $file: $!";
1023 $error ||= "No DETAIL supplied"
1024 unless ($files{detail});
1025 open my $fh, "< $dir/". $files{detail}
1026 or $error ||= "Can't open DETAIL file: $!";
1028 &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format },
1031 unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!"
1034 while( scalar(@delete_list) ) {
1035 my ($name, $file, $import_sub) =
1036 (shift @delete_list, shift @delete_list, shift @delete_list);
1038 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1039 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1041 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1043 unlink $file or warn "Can't delete $file: $!";
1047 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1050 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1054 die "Unknown format: $format";
1059 =item process_download_and_reload
1061 Download and process a tax update as a queued JSRPC job after wiping the
1062 existing wipable tax data.
1066 sub process_download_and_reload {
1069 my $param = thaw(decode_base64($_[0]));
1070 my $format = $param->{'format'}; #well... this is all cch specific
1072 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1075 if ( $job ) { # progress bar
1076 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1077 die $error if $error;
1080 my $oldAutoCommit = $FS::UID::AutoCommit;
1081 local $FS::UID::AutoCommit = 0;
1086 "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1087 "USING (taxclassnum) WHERE data_vendor = '$format'";
1088 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1090 or die "Unexpected error executing statement $sql: ". $sth->errstr;
1091 die "Don't (yet) know how to handle part_pkg_taxoverride records."
1092 if $sth->fetchrow_arrayref->[0];
1094 # really should get a table EXCLUSIVE lock here
1096 #remember disabled taxes
1097 my %disabled_tax_rate = ();
1098 my @items = qsearch( { table => 'tax_rate',
1099 hashref => { disabled => 'Y',
1100 data_vendor => $format,
1102 select => 'geocode, taxclassnum',
1105 $count = scalar(@items);
1106 foreach my $tax_rate ( @items ) {
1107 if ( time - $min_sec > $last ) {
1108 my $error = $job->update_statustext(
1109 int( 100 * $imported / $count ). ",Remembering disabled taxes"
1112 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1119 qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1120 unless ( $tax_class ) {
1121 warn "failed to find tax_class ". $tax_rate->taxclassnum;
1124 $disabled_tax_rate{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1127 #remember tax products
1128 # XXX FIXME this loop only works when cch is the only data provider
1129 my %taxproduct = ();
1130 my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1131 "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1132 " part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1133 " optionname LIKE 'usage_taxproductnum_%' AND ".
1134 " optionvalue != '' )";
1135 @items = qsearch( { table => 'part_pkg',
1136 select => 'DISTINCT pkgpart,taxproductnum',
1138 extra_sql => $extra_sql,
1141 $count = scalar(@items);
1143 foreach my $part_pkg ( @items ) {
1144 if ( time - $min_sec > $last ) {
1145 my $error = $job->update_statustext(
1146 int( 100 * $imported / $count ). ",Remembering tax products"
1149 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1155 warn "working with package part ". $part_pkg->pkgpart.
1156 "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1157 my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1158 $taxproduct{$part_pkg->pkgpart}{''} = $part_pkg_taxproduct->taxproduct
1159 if $part_pkg_taxproduct;
1161 foreach my $option ( $part_pkg->part_pkg_option ) {
1162 next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1165 $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1166 $taxproduct{$part_pkg->pkgpart}{$class} = $part_pkg_taxproduct->taxproduct
1167 if $part_pkg_taxproduct;
1171 #wipe out the old data
1172 $error = $job->update_statustext( "0,Removing old tax data" );
1174 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1177 foreach my $tax_rate_location ( qsearch( 'tax_rate_location',
1178 { data_vendor => $format,
1184 $tax_rate_location->disabled('Y');
1185 my $error = $tax_rate_location->replace;
1187 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1192 local $FS::part_pkg_taxproduct::delete_kludge = 1;
1194 tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1196 foreach my $table ( @table ) {
1198 # my $primary_key = dbdef->table($table)->primary_key;
1199 # my $sql = "SELECT $primary_key FROM $table WHERE data_vendor = ".
1200 my $sql = "DELETE FROM $table WHERE data_vendor = ".
1201 $dbh->quote($format);
1202 my $sth = $dbh->prepare($sql);
1204 $error = $dbh->errstr;
1205 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1208 unless ($sth->execute) {
1209 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1210 die "Failed to execute $sql: ". $sth->errstr;
1212 # foreach my $row ( @{ $sth->fetchall_arrayref } ) {
1213 # my $record = qsearchs( $table, { $primary_key => $row->[0] } )
1214 # or die "Failed to find $table with $primary_key ". $row->[0];
1215 # my $error = $record->delete;
1217 # $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1223 if ( $format eq 'cch' ) {
1224 foreach my $cust_tax_location ( qsearch( 'cust_tax_location',
1225 { data_vendor => "$format-zip" }
1229 my $error = $cust_tax_location->delete;
1231 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1238 my $statement = ' &process_download_and_update($job, @_); ';
1241 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1245 #restore taxproducts
1246 $count = scalar(keys %taxproduct);
1248 foreach my $pkgpart ( keys %taxproduct ) {
1249 warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1250 if ( time - $min_sec > $last ) {
1251 my $error = $job->update_statustext(
1252 int( 100 * $imported / $count ). ",Restoring tax products"
1255 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1262 my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1263 unless ( $part_pkg ) {
1264 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1265 die "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1268 my %options = $part_pkg->options;
1269 my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1270 my $primary_svc = $part_pkg->svcpart;
1271 my $new = new FS::part_pkg { $part_pkg->hash };
1273 foreach my $class ( keys %{ $taxproduct{$pkgpart} } ) {
1274 warn "working with class '$class'\n" if $DEBUG;
1275 my $part_pkg_taxproduct =
1276 qsearchs( 'part_pkg_taxproduct',
1277 { taxproduct => $taxproduct{$pkgpart}{$class},
1278 data_vendor => $format,
1282 unless ( $part_pkg_taxproduct ) {
1283 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1284 die "failed to find part_pkg_taxproduct ($taxproduct{pkgpart}{$class})".
1285 " for pkgpart $pkgpart\n";
1288 if ( $class eq '' ) {
1289 $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1293 $options{"usage_taxproductnum_$class"} =
1294 $part_pkg_taxproduct->taxproductnum;
1298 my $error = $new->replace( $part_pkg,
1299 'pkg_svc' => \%pkg_svc,
1300 'primary_svc' => $primary_svc,
1301 'options' => \%options,
1305 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1311 $count = scalar(keys %disabled_tax_rate);
1313 foreach my $key (keys %disabled_tax_rate) {
1314 if ( time - $min_sec > $last ) {
1315 my $error = $job->update_statustext(
1316 int( 100 * $imported / $count ). ",Disabling tax rates"
1319 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1325 my ($geocode,$taxclass) = split /:/, $key, 2;
1326 my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1327 taxclass => $taxclass,
1329 if (scalar(@tax_class) > 1) {
1330 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1331 die "found multiple tax_class records for format $format class $taxclass";
1334 unless (scalar(@tax_class)) {
1335 warn "no tax_class for format $format class $taxclass\n";
1340 qsearch('tax_rate', { data_vendor => $format,
1341 geocode => $geocode,
1342 taxclassnum => $tax_class[0]->taxclassnum,
1346 if (scalar(@tax_rate) > 1) {
1347 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1348 die "found multiple tax_rate records for format $format geocode $geocode".
1349 " and taxclass $taxclass ( taxclassnum ". $tax_class[0]->taxclassnum.
1353 if (scalar(@tax_rate)) {
1354 $tax_rate[0]->disabled('Y');
1355 my $error = $tax_rate[0]->replace;
1357 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1365 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1369 =item process_download_and_update
1371 Download and process a tax update as a queued JSRPC job
1375 sub process_download_and_update {
1378 my $param = thaw(decode_base64(shift));
1379 my $format = $param->{'format'}; #well... this is all cch specific
1381 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1384 if ( $job ) { # progress bar
1385 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1386 die $error if $error;
1389 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1391 mkdir $dir or die "can't create $dir: $!\n";
1394 if ($format eq 'cch') {
1396 eval "use Text::CSV_XS;";
1402 my $conf = new FS::Conf;
1403 die "direct download of tax data not enabled\n"
1404 unless $conf->exists('taxdatadirectdownload');
1405 my ( $urls, $username, $secret, $states ) =
1406 $conf->config('taxdatadirectdownload');
1407 die "No tax download URL provided. ".
1408 "Did you set the taxdatadirectdownload configuration value?\n"
1413 my $oldAutoCommit = $FS::UID::AutoCommit;
1414 local $FS::UID::AutoCommit = 0;
1418 # really should get a table EXCLUSIVE lock here
1419 # check if initial import or update
1421 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1422 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1423 $sth->execute() or die $sth->errstr;
1424 my $upgrade = $sth->fetchrow_arrayref->[0];
1426 # create cache and/or rotate old tax data
1431 opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1432 foreach my $file (readdir($dirh)) {
1433 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1440 if ( -e "$dir.$_" ) {
1441 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1444 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1448 die "can't find previous tax data\n" if $upgrade;
1452 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1454 # fetch and unpack the zip files
1456 my $ua = new LWP::UserAgent;
1457 foreach my $url (split ',', $urls) {
1458 my @name = split '/', $url; #somewhat restrictive
1459 my $name = pop @name;
1460 $name =~ /(.*)/; # untaint that which we trust;
1463 open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n";
1465 my $res = $ua->request(
1466 new HTTP::Request( GET => $url),
1467 sub { #my ($data, $response_object) = @_;
1468 print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n";
1469 my $content_length = $_[1]->content_length;
1470 $imported += length($_[0]);
1471 if ( time - $min_sec > $last ) {
1472 my $error = $job->update_statustext(
1473 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1474 ",Downloading data from CCH"
1476 die $error if $error;
1481 die "download of $url failed: ". $res->status_line
1482 unless $res->is_success;
1485 my $error = $job->update_statustext( "0,Unpacking data" );
1486 die $error if $error;
1487 $secret =~ /(.*)/; # untaint that which we trust;
1489 system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0
1490 or die "unzip -P $secret -d $dir.new $dir.new/$name failed";
1491 #unlink "$dir.new/$name";
1494 # extract csv files from the dbf files
1496 foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) {
1497 my $error = $job->update_statustext( "0,Unpacking $name" );
1498 die $error if $error;
1499 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1500 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1501 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1502 unless defined($table);
1503 $count = $table->last_record; # approximately;
1505 open my $csvfh, ">$dir.new/$name.txt"
1506 or die "failed to open $dir.new/$name.txt: $!\n";
1508 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1509 my @fields = $table->field_names;
1510 my $cursor = $table->prepare_select;
1512 sub { my $date = shift;
1513 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1516 while (my $row = $cursor->fetch_hashref) {
1517 $csv->combine( map { ($table->field_type($_) eq 'D')
1518 ? &{$format_date}($row->{$_})
1523 print $csvfh $csv->string, "\n";
1525 if ( time - $min_sec > $last ) {
1526 my $error = $job->update_statustext(
1527 int(100 * $imported/$count). ",Unpacking $name"
1529 die $error if $error;
1537 # generate the diff files
1539 my @insert_list = ();
1540 my @delete_list = ();
1541 my @predelete_list = ();
1544 'geocode', \&FS::tax_rate_location::batch_import,
1545 'code', \&FS::tax_class::batch_import,
1546 'plus4', \&FS::cust_tax_location::batch_import,
1547 'zip', \&FS::cust_tax_location::batch_import,
1548 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
1549 'detail', \&FS::tax_rate::batch_import,
1552 while( scalar(@list) ) {
1553 my ( $name, $method ) = ( shift @list, shift @list );
1556 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1557 die $error if $error;
1559 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1562 open my $oldcsvfh, "$dir.1/$name.txt"
1563 or die "failed to open $dir.1/$name.txt: $!\n";
1565 while(<$oldcsvfh>) {
1572 open my $newcsvfh, "$dir.new/$name.txt"
1573 or die "failed to open $dir.new/$name.txt: $!\n";
1575 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1578 ) or die "can't open temp file: $!\n";
1580 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1583 ) or die "can't open temp file: $!\n";
1585 while(<$newcsvfh>) {
1587 if (exists($oldlines{$_})) {
1590 print $ifh $_, ',"I"', "\n";
1595 if ($name eq 'detail') {
1596 for (keys %oldlines) { # one file for rate details
1597 print $ifh $_, ',"D"', "\n" if $oldlines{$_};
1600 for (keys %oldlines) {
1601 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1606 push @insert_list, $name, $ifh->filename, $method;
1607 if ( $name eq 'geocode' ) {
1608 unshift @predelete_list, $name, $dfh->filename, $method
1609 unless $name eq 'detail';
1611 unshift @delete_list, $name, $dfh->filename, $method
1612 unless $name eq 'detail';
1619 while( scalar(@predelete_list) ) {
1620 my ($name, $file, $method) =
1621 (shift @predelete_list, shift @predelete_list, shift @predelete_list);
1623 my $fmt = "$format-update";
1624 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1625 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1627 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1629 #unlink $file or warn "Can't delete $file: $!";
1632 while( scalar(@insert_list) ) {
1633 my ($name, $file, $method) =
1634 (shift @insert_list, shift @insert_list, shift @insert_list);
1636 my $fmt = "$format-update";
1637 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1638 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1640 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1642 #unlink $file or warn "Can't delete $file: $!";
1645 while( scalar(@delete_list) ) {
1646 my ($name, $file, $method) =
1647 (shift @delete_list, shift @delete_list, shift @delete_list);
1649 my $fmt = "$format-update";
1650 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1651 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1653 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1655 #unlink $file or warn "Can't delete $file: $!";
1659 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1662 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1665 rename "$dir.new", "$dir"
1666 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1669 die "Unknown format: $format";
1673 =item browse_queries PARAMS
1675 Returns a list consisting of a hashref suited for use as the argument
1676 to qsearch, and sql query string. Each is based on the PARAMS hashref
1677 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1678 from a form. This conveniently creates the query hashref and count_query
1679 string required by the browse and search elements. As a side effect,
1680 the PARAMS hashref is untainted and keys with unexpected values are removed.
1684 sub browse_queries {
1688 'table' => 'tax_rate',
1690 'order_by' => 'ORDER BY geocode, taxclassnum',
1695 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1696 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1698 delete $params->{data_vendor};
1701 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1702 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1703 'geocode LIKE '. dbh->quote($1.'%');
1705 delete $params->{geocode};
1708 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1709 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1712 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1713 ' taxclassnum = '. dbh->quote($1)
1715 delete $params->{taxclassnun};
1719 if ( $params->{tax_type} =~ /^(\d+)$/ );
1720 delete $params->{tax_type}
1724 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1725 delete $params->{tax_cat}
1728 my @taxclassnum = ();
1729 if ($tax_type || $tax_cat ) {
1730 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1731 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1732 @taxclassnum = map { $_->taxclassnum }
1733 qsearch({ 'table' => 'tax_class',
1735 'extra_sql' => "WHERE taxclass $compare",
1739 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1740 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1741 if ( @taxclassnum );
1743 unless ($params->{'showdisabled'}) {
1744 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1745 "( disabled = '' OR disabled IS NULL )";
1748 $query->{extra_sql} = $extra_sql;
1750 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1755 # Used by FS::Upgrade to migrate to a new database.
1759 sub _upgrade_data { # class method
1760 my ($self, %opts) = @_;
1763 warn "$me upgrading $self\n" if $DEBUG;
1765 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1768 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1770 eval "use DBI::Const::GetInfoType;";
1773 my $major_version = 0;
1774 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1775 && ( $major_version = sprintf("%d", $1) );
1777 if ( $major_version > 7 ) {
1779 # ideally this would be supported in DBIx-DBSchema and friends
1781 foreach my $column ( @column ) {
1782 my $columndef = dbdef->table($self->table)->column($column);
1783 unless ($columndef->type eq 'numeric') {
1785 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1786 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1787 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1788 $sth->execute or die $sth->errstr;
1790 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1791 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1792 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1793 $sth->execute or die $sth->errstr;
1798 } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1800 # ideally this would be supported in DBIx-DBSchema and friends
1802 foreach my $column ( @column ) {
1803 my $columndef = dbdef->table($self->table)->column($column);
1804 unless ($columndef->type eq 'numeric') {
1806 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1808 foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1810 my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1811 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1812 $sth->execute or die $sth->errstr;
1814 my $def = dbdef->table($table)->column($column);
1815 $def->type('numeric');
1816 $def->length('14,8');
1817 my $null = $def->null;
1820 $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1821 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1822 $sth->execute or die $sth->errstr;
1824 $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1825 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1826 $sth->execute or die $sth->errstr;
1828 unless ( $null eq 'NULL' ) {
1829 $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1830 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1831 $sth->execute or die $sth->errstr;
1834 $sql = "ALTER TABLE $table DROP old_$column";
1835 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1836 $sth->execute or die $sth->errstr;
1844 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1850 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1862 Mixing automatic and manual editing works poorly at present.
1866 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base