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;
27 use FS::Misc qw( csv_from_fixed );
29 @ISA = qw( FS::Record );
32 $me = '[FS::tax_rate]';
36 FS::tax_rate - Object methods for tax_rate objects
42 $record = new FS::tax_rate \%hash;
43 $record = new FS::tax_rate { 'column' => 'value' };
45 $error = $record->insert;
47 $error = $new_record->replace($old_record);
49 $error = $record->delete;
51 $error = $record->check;
55 An FS::tax_rate object represents a tax rate, defined by locale.
56 FS::tax_rate inherits from FS::Record. The following fields are
63 primary key (assigned automatically for new tax rates)
67 a geographic location code provided by a tax data vendor
75 a location code provided by a tax authority
79 a foreign key into FS::tax_class - the type of tax
80 referenced but FS::part_pkg_taxrate
83 the time after which the tax applies
91 second bracket percentage
95 the amount to which the tax applies (first bracket)
99 a cap on the amount of tax if a cap exists
103 percentage on out of jurisdiction purchases
107 second bracket percentage on out of jurisdiction purchases
111 one of the values in %tax_unittypes
115 amount of tax per unit
119 second bracket amount of tax per unit
123 the number of units to which the fee applies (first bracket)
127 the most units to which fees apply (first and second brackets)
131 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
135 if defined, printed on invoices instead of "Tax"
139 a value from %tax_authorities
143 a value from %tax_basetypes indicating the tax basis
147 a value from %tax_passtypes indicating how the tax should displayed to the customer
151 'Y', 'N', or blank indicating the tax can be passed to the customer
155 if 'Y', this tax does not apply to setup fees
159 if 'Y', this tax does not apply to recurring fees
163 if 'Y', has been manually edited
173 Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
177 sub table { 'tax_rate'; }
181 Adds this tax rate to the database. If there is an error, returns the error,
182 otherwise returns false.
186 Deletes this tax rate from the database. If there is an error, returns the
187 error, otherwise returns false.
189 =item replace OLD_RECORD
191 Replaces the OLD_RECORD with this one in the database. If there is an error,
192 returns the error, otherwise returns false.
196 Checks all fields to make sure this is a valid tax rate. If there is an error,
197 returns the error, otherwise returns false. Called by the insert and replace
205 foreach (qw( taxbase taxmax )) {
206 $self->$_(0) unless $self->$_;
209 $self->ut_numbern('taxnum')
210 || $self->ut_text('geocode')
211 || $self->ut_textn('data_vendor')
212 || $self->ut_textn('location')
213 || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
214 || $self->ut_snumbern('effective_date')
215 || $self->ut_float('tax')
216 || $self->ut_floatn('excessrate')
217 || $self->ut_money('taxbase')
218 || $self->ut_money('taxmax')
219 || $self->ut_floatn('usetax')
220 || $self->ut_floatn('useexcessrate')
221 || $self->ut_numbern('unittype')
222 || $self->ut_floatn('fee')
223 || $self->ut_floatn('excessfee')
224 || $self->ut_floatn('feemax')
225 || $self->ut_numbern('maxtype')
226 || $self->ut_textn('taxname')
227 || $self->ut_numbern('taxauth')
228 || $self->ut_numbern('basetype')
229 || $self->ut_numbern('passtype')
230 || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
231 || $self->ut_enum('setuptax', [ '', 'Y' ] )
232 || $self->ut_enum('recurtax', [ '', 'Y' ] )
233 || $self->ut_enum('manual', [ '', 'Y' ] )
234 || $self->ut_enum('disabled', [ '', 'Y' ] )
235 || $self->SUPER::check
240 =item taxclass_description
242 Returns the human understandable value associated with the related
247 sub taxclass_description {
249 my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
250 $tax_class ? $tax_class->description : '';
255 Returns the human understandable value associated with the unittype column
259 %tax_unittypes = ( '0' => 'access line',
266 $tax_unittypes{$self->unittype};
271 Returns the human understandable value associated with the maxtype column
275 %tax_maxtypes = ( '0' => 'receipts per invoice',
276 '1' => 'receipts per item',
277 '2' => 'total utility charges per utility tax year',
278 '3' => 'total charges per utility tax year',
279 '4' => 'receipts per access line',
280 '9' => 'monthly receipts per location',
285 $tax_maxtypes{$self->maxtype};
290 Returns the human understandable value associated with the basetype column
294 %tax_basetypes = ( '0' => 'sale price',
295 '1' => 'gross receipts',
296 '2' => 'sales taxable telecom revenue',
297 '3' => 'minutes carried',
298 '4' => 'minutes billed',
299 '5' => 'gross operating revenue',
300 '6' => 'access line',
302 '8' => 'gross revenue',
303 '9' => 'portion gross receipts attributable to interstate service',
304 '10' => 'access line',
305 '11' => 'gross profits',
306 '12' => 'tariff rate',
308 '15' => 'prior year gross receipts',
313 $tax_basetypes{$self->basetype};
318 Returns the human understandable value associated with the taxauth column
322 %tax_authorities = ( '0' => 'federal',
327 '5' => 'county administered by state',
328 '6' => 'city administered by state',
329 '7' => 'city administered by county',
330 '8' => 'local administered by state',
331 '9' => 'local administered by county',
336 $tax_authorities{$self->taxauth};
341 Returns the human understandable value associated with the passtype column
345 %tax_passtypes = ( '0' => 'separate tax line',
346 '1' => 'separate surcharge line',
347 '2' => 'surcharge not separated',
348 '3' => 'included in base rate',
353 $tax_passtypes{$self->passtype};
356 =item taxline TAXABLES, [ OPTIONSHASH ]
358 Returns a listref of a name and an amount of tax calculated for the list
359 of packages/amounts referenced by TAXABLES. If an error occurs, a message
360 is returned as a scalar.
370 if (ref($_[0]) eq 'ARRAY') {
375 #exemptions would be broken in this case
378 my $name = $self->taxname;
379 $name = 'Other surcharges'
380 if ($self->passtype == 2);
383 if ( $self->disabled ) { # we always know how to handle disabled taxes
390 my $taxable_charged = 0;
391 my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
394 warn "calculating taxes for ". $self->taxnum. " on ".
395 join (",", map { $_->pkgnum } @cust_bill_pkg)
398 if ($self->passflag eq 'N') {
399 # return "fatal: can't (yet) handle taxes not passed to the customer";
400 # until someone needs to track these in freeside
407 if ($self->maxtype != 0 && $self->maxtype != 9) {
408 return $self->_fatal_or_null( 'tax with "'.
409 $self->maxtype_name. '" threshold'
413 if ($self->maxtype == 9) {
415 $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
419 # we treat gross revenue as gross receipts and expect the tax data
420 # to DTRT (i.e. tax on tax rules)
421 if ($self->basetype != 0 && $self->basetype != 1 &&
422 $self->basetype != 5 && $self->basetype != 6 &&
423 $self->basetype != 7 && $self->basetype != 8 &&
424 $self->basetype != 14
427 $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
430 unless ($self->setuptax =~ /^Y$/i) {
431 $taxable_charged += $_->setup foreach @cust_bill_pkg;
433 unless ($self->recurtax =~ /^Y$/i) {
434 $taxable_charged += $_->recur foreach @cust_bill_pkg;
437 my $taxable_units = 0;
438 unless ($self->recurtax =~ /^Y$/i) {
439 if ($self->unittype == 0) {
441 foreach (@cust_bill_pkg) {
442 $taxable_units += $_->units
443 unless $seen{$_->pkgnum};
446 }elsif ($self->unittype == 1) {
447 return $self->_fatal_or_null( 'fee with minute unit type' );
448 }elsif ($self->unittype == 2) {
451 return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
456 # XXX insert exemption handling here
458 # the tax or fee is applied to taxbase or feebase and then
459 # the excessrate or excess fee is applied to taxmax or feemax
462 $amount += $taxable_charged * $self->tax;
463 $amount += $taxable_units * $self->fee;
465 warn "calculated taxes as [ $name, $amount ]\n"
476 my ($self, $error) = @_;
478 my $conf = new FS::Conf;
480 $error = "fatal: can't yet handle ". $error;
481 my $name = $self->taxname;
482 $name = 'Other surcharges'
483 if ($self->passtype == 2);
485 if ($conf->exists('ignore_incalculable_taxes')) {
487 return { name => $name, amount => 0 };
493 =item tax_on_tax CUST_MAIN
495 Returns a list of taxes which are candidates for taxing taxes for the
496 given customer (see L<FS::cust_main>)
502 my $cust_main = shift;
504 warn "looking up taxes on tax ". $self->taxnum. " for customer ".
508 my $geocode = $cust_main->geocode($self->data_vendor);
512 my $extra_sql = ' AND ('.
513 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
518 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
519 my $select = 'DISTINCT ON(taxclassnum) *';
521 # should qsearch preface columns with the table to facilitate joins?
522 my @taxclassnums = map { $_->taxclassnum }
523 qsearch( { 'table' => 'part_pkg_taxrate',
525 'hashref' => { 'data_vendor' => $self->data_vendor,
526 'taxclassnumtaxed' => $self->taxclassnum,
528 'extra_sql' => $extra_sql,
529 'order_by' => $order_by,
532 return () unless @taxclassnums;
535 "AND (". join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
537 qsearch({ 'table' => 'tax_rate',
538 'hashref' => { 'geocode' => $geocode, },
539 'extra_sql' => $extra_sql,
544 =item tax_rate_location
546 Returns an object representing the location associated with this tax
547 (see L<FS::tax_rate_location>)
551 sub tax_rate_location {
554 qsearchs({ 'table' => 'tax_rate_location',
555 'hashref' => { 'data_vendor' => $self->data_vendor,
556 'geocode' => $self->geocode,
560 new FS::tax_rate_location;
575 my ($param, $job) = @_;
577 my $fh = $param->{filehandle};
578 my $format = $param->{'format'};
586 my @column_lengths = ();
587 my @column_callbacks = ();
588 if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
589 $format =~ s/-fixed//;
590 my $date_format = sub { my $r='';
591 /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
594 my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
595 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 );
596 push @column_lengths, 1 if $format eq 'cch-update';
597 push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
598 $column_callbacks[8] = $date_format;
602 my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
603 if ( $job || scalar(@column_callbacks) ) {
605 csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
606 return $error if $error;
610 if ( $format eq 'cch' || $format eq 'cch-update' ) {
611 @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
612 excessrate effective_date taxauth taxtype taxcat taxname
613 usetax useexcessrate fee unittype feemax maxtype passflag
615 push @fields, 'actionflag' if $format eq 'cch-update';
620 $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
621 $hash->{'data_vendor'} ='cch';
622 my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
623 time_zone => 'floating',
625 my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
626 $hash->{'effective_date'} = $dt ? $dt->epoch : '';
628 $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
631 join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
633 my %tax_class = ( 'data_vendor' => 'cch',
634 'taxclass' => $taxclassid,
637 my $tax_class = qsearchs( 'tax_class', \%tax_class );
638 return "Error updating tax rate: no tax class $taxclassid"
641 $hash->{'taxclassnum'} = $tax_class->taxclassnum;
643 foreach (qw( inoutcity inoutlocal taxtype taxcat )) {
647 my %passflagmap = ( '0' => '',
651 $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
652 if exists $passflagmap{$hash->{'passflag'}};
654 foreach (keys %$hash) {
655 $hash->{$_} = substr($hash->{$_}, 0, 80)
656 if length($hash->{$_}) > 80;
659 my $actionflag = delete($hash->{'actionflag'});
661 $hash->{'taxname'} =~ s/`/'/g;
662 $hash->{'taxname'} =~ s|\\|/|g;
664 return '' if $format eq 'cch'; # but not cch-update
666 if ($actionflag eq 'I') {
667 $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
668 }elsif ($actionflag eq 'D') {
669 $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
671 return "Unexpected action flag: ". $hash->{'actionflag'};
674 delete($hash->{$_}) for keys %$hash;
680 } elsif ( $format eq 'extended' ) {
681 die "unimplemented\n";
685 die "unknown format $format";
688 eval "use Text::CSV_XS;";
691 my $csv = new Text::CSV_XS;
695 local $SIG{HUP} = 'IGNORE';
696 local $SIG{INT} = 'IGNORE';
697 local $SIG{QUIT} = 'IGNORE';
698 local $SIG{TERM} = 'IGNORE';
699 local $SIG{TSTP} = 'IGNORE';
700 local $SIG{PIPE} = 'IGNORE';
702 my $oldAutoCommit = $FS::UID::AutoCommit;
703 local $FS::UID::AutoCommit = 0;
706 while ( defined($line=<$fh>) ) {
707 $csv->parse($line) or do {
708 $dbh->rollback if $oldAutoCommit;
709 return "can't parse: ". $csv->error_input();
712 if ( $job ) { # progress bar
713 if ( time - $min_sec > $last ) {
714 my $error = $job->update_statustext(
715 int( 100 * $imported / $count ). ",Importing tax rates"
717 die $error if $error;
722 my @columns = $csv->fields();
724 my %tax_rate = ( 'data_vendor' => $format );
725 foreach my $field ( @fields ) {
726 $tax_rate{$field} = shift @columns;
728 if ( scalar( @columns ) ) {
729 $dbh->rollback if $oldAutoCommit;
730 return "Unexpected trailing columns in line (wrong format?): $line";
733 my $error = &{$hook}(\%tax_rate);
735 $dbh->rollback if $oldAutoCommit;
739 if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
741 my $tax_rate = new FS::tax_rate( \%tax_rate );
742 $error = $tax_rate->insert;
745 $dbh->rollback if $oldAutoCommit;
746 return "can't insert tax_rate for $line: $error";
755 for (grep { !exists($delete{$_}) } keys %insert) {
756 if ( $job ) { # progress bar
757 if ( time - $min_sec > $last ) {
758 my $error = $job->update_statustext(
759 int( 100 * $imported / $count ). ",Importing tax rates"
761 die $error if $error;
766 my $tax_rate = new FS::tax_rate( $insert{$_} );
767 my $error = $tax_rate->insert;
770 $dbh->rollback if $oldAutoCommit;
771 my $hashref = $insert{$_};
772 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
773 return "can't insert tax_rate for $line: $error";
779 for (grep { exists($delete{$_}) } keys %insert) {
780 if ( $job ) { # progress bar
781 if ( time - $min_sec > $last ) {
782 my $error = $job->update_statustext(
783 int( 100 * $imported / $count ). ",Importing tax rates"
785 die $error if $error;
790 my $old = qsearchs( 'tax_rate', $delete{$_} );
792 $dbh->rollback if $oldAutoCommit;
794 return "can't find tax_rate to replace for: ".
795 #join(" ", map { "$_ => ". $old->{$_} } @fields);
796 join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
798 my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => '' });
799 $new->taxnum($old->taxnum);
800 my $error = $new->replace($old);
803 $dbh->rollback if $oldAutoCommit;
804 my $hashref = $insert{$_};
805 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
806 return "can't replace tax_rate for $line: $error";
813 for (grep { !exists($insert{$_}) } keys %delete) {
814 if ( $job ) { # progress bar
815 if ( time - $min_sec > $last ) {
816 my $error = $job->update_statustext(
817 int( 100 * $imported / $count ). ",Importing tax rates"
819 die $error if $error;
824 my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
826 $dbh->rollback if $oldAutoCommit;
827 $tax_rate = $delete{$_};
828 return "can't find tax_rate to delete for: ".
829 #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
830 join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
832 my $error = $tax_rate->delete;
835 $dbh->rollback if $oldAutoCommit;
836 my $hashref = $delete{$_};
837 $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
838 return "can't delete tax_rate for $line: $error";
844 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
846 return "Empty file!" unless ($imported || $format eq 'cch-update');
852 =item process_batch_import
854 Load a batch import as a queued JSRPC job
858 sub process_batch_import {
861 my $param = thaw(decode_base64(shift));
862 my $format = $param->{'format'}; #well... this is all cch specific
864 my $files = $param->{'uploaded_files'}
865 or die "No files provided.";
867 my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
869 if ($format eq 'cch' || $format eq 'cch-fixed') {
871 my $oldAutoCommit = $FS::UID::AutoCommit;
872 local $FS::UID::AutoCommit = 0;
875 my $have_location = 0;
877 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
878 'CODE', 'codefile', \&FS::tax_class::batch_import,
879 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
880 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
881 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
882 'DETAIL', 'detail', \&FS::tax_rate::batch_import,
884 while( scalar(@list) ) {
885 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
886 unless ($files{$file}) {
887 next if $name eq 'PLUS4';
888 $error = "No $name supplied";
889 $error = "Neither PLUS4 nor ZIP supplied"
890 if ($name eq 'ZIP' && !$have_location);
893 $have_location = 1 if $name eq 'PLUS4';
894 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
895 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
896 my $filename = "$dir/". $files{$file};
897 open my $fh, "< $filename" or $error ||= "Can't open $name file: $!";
899 $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
901 unlink $filename or warn "Can't delete $filename: $!";
905 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
908 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
911 }elsif ($format eq 'cch-update' || $format eq 'cch-fixed-update') {
913 my $oldAutoCommit = $FS::UID::AutoCommit;
914 local $FS::UID::AutoCommit = 0;
917 my @insert_list = ();
918 my @delete_list = ();
920 my @list = ( 'GEOCODE', 'geofile', \&FS::tax_rate_location::batch_import,
921 'CODE', 'codefile', \&FS::tax_class::batch_import,
922 'PLUS4', 'plus4file', \&FS::cust_tax_location::batch_import,
923 'ZIP', 'zipfile', \&FS::cust_tax_location::batch_import,
924 'TXMATRIX', 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
926 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
927 while( scalar(@list) ) {
928 my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
929 unless ($files{$file}) {
930 my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip';
931 next # update expected only for previously installed location data
932 if ( ($name eq 'PLUS4' || $name eq 'ZIP')
933 && !scalar( qsearch( { table => 'cust_tax_location',
934 hashref => { data_vendor => $vendor },
935 select => 'DISTINCT data_vendor',
940 $error = "No $name supplied";
943 my $filename = "$dir/". $files{$file};
944 open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!";
945 unlink $filename or warn "Can't delete $filename: $!";
947 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
950 ) or die "can't open temp file: $!\n";
952 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
955 ) or die "can't open temp file: $!\n";
957 my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
958 my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
961 $handle = $ifh if $_ =~ /$insert_pattern/;
962 $handle = $dfh if $_ =~ /$delete_pattern/;
964 $error = "bad input line: $_" unless $handle;
973 push @insert_list, $name, $ifh->filename, $import_sub;
974 unshift @delete_list, $name, $dfh->filename, $import_sub;
977 while( scalar(@insert_list) ) {
978 my ($name, $file, $import_sub) =
979 (shift @insert_list, shift @insert_list, shift @insert_list);
981 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
982 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
984 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
986 unlink $file or warn "Can't delete $file: $!";
989 $error ||= "No DETAIL supplied"
990 unless ($files{detail});
991 open my $fh, "< $dir/". $files{detail}
992 or $error ||= "Can't open DETAIL file: $!";
994 &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format },
997 unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!"
1000 while( scalar(@delete_list) ) {
1001 my ($name, $file, $import_sub) =
1002 (shift @delete_list, shift @delete_list, shift @delete_list);
1004 my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
1005 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1007 &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1009 unlink $file or warn "Can't delete $file: $!";
1013 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1016 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1020 die "Unknown format: $format";
1025 =item process_download_and_update
1027 Download and process a tax update as a queued JSRPC job
1031 sub process_download_and_update {
1034 my $param = thaw(decode_base64(shift));
1035 my $format = $param->{'format'}; #well... this is all cch specific
1037 my ( $count, $last, $min_sec, $imported ) = (0, time, 5, 0); #progressbar
1040 if ( $job ) { # progress bar
1041 my $error = $job->update_statustext( int( 100 * $imported / $count ) );
1042 die $error if $error;
1045 my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1047 mkdir $dir or die "can't create $dir: $!\n";
1050 if ($format eq 'cch') {
1052 eval "use Text::CSV_XS;";
1058 my $conffile = '%%%FREESIDE_CONF%%%/cchconf';
1059 my $conffh = new IO::File "<$conffile" or die "can't open $conffile: $!\n";
1060 my ( $urls, $secret, $states ) =
1061 map { /^(.*)$/ or die "bad config line in $conffile: $_\n"; $1 }
1066 my $oldAutoCommit = $FS::UID::AutoCommit;
1067 local $FS::UID::AutoCommit = 0;
1071 # really should get a table EXCLUSIVE lock here
1072 # check if initial import or update
1074 my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1075 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1076 $sth->execute() or die $sth->errstr;
1077 my $upgrade = $sth->fetchrow_arrayref->[0];
1079 # create cache and/or rotate old tax data
1084 opendir(my $dirh, $dir) or die "failed to open $dir.4: $!\n";
1085 foreach my $file (readdir($dirh)) {
1086 unlink "$dir.4/$file" if (-f "$dir.4/$file");
1093 if ( -e "$dir.$_" ) {
1094 rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1097 rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1101 die "can't find previous tax data\n" if $upgrade;
1105 mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1107 # fetch and unpack the zip files
1109 my $ua = new LWP::UserAgent;
1110 foreach my $url (split ',', $urls) {
1111 my @name = split '/', $url; #somewhat restrictive
1112 my $name = pop @name;
1113 $name =~ /(.*)/; # untaint that which we trust;
1116 open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n";
1118 my $res = $ua->request(
1119 new HTTP::Request( GET => $url),
1120 sub { #my ($data, $response_object) = @_;
1121 print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n";
1122 my $content_length = $_[1]->content_length;
1123 $imported += length($_[0]);
1124 if ( time - $min_sec > $last ) {
1125 my $error = $job->update_statustext(
1126 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1127 ",Downloading data from CCH"
1129 die $error if $error;
1134 die "download of $url failed: ". $res->status_line
1135 unless $res->is_success;
1138 my $error = $job->update_statustext( "0,Unpacking data" );
1139 die $error if $error;
1140 $secret =~ /(.*)/; # untaint that which we trust;
1142 system('unzip', "-P", $secret, "-d", "$dir.new", "$dir.new/$name") == 0
1143 or die "unzip -P $secret -d $dir.new $dir.new/$name failed";
1144 #unlink "$dir.new/$name";
1147 # extract csv files from the dbf files
1149 foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) {
1150 my $error = $job->update_statustext( "0,Unpacking $name" );
1151 die $error if $error;
1152 warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1153 my $table = new XBase 'name' => "$dir.new/$name.dbf";
1154 die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1155 unless defined($table);
1156 $count = $table->last_record; # approximately;
1158 open my $csvfh, ">$dir.new/$name.txt"
1159 or die "failed to open $dir.new/$name.txt: $!\n";
1161 my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1162 my @fields = $table->field_names;
1163 my $cursor = $table->prepare_select;
1165 sub { my $date = shift;
1166 $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1169 while (my $row = $cursor->fetch_hashref) {
1170 $csv->combine( map { ($table->field_type($_) eq 'D')
1171 ? &{$format_date}($row->{$_})
1176 print $csvfh $csv->string, "\n";
1178 if ( time - $min_sec > $last ) {
1179 my $error = $job->update_statustext(
1180 int(100 * $imported/$count). ",Unpacking $name"
1182 die $error if $error;
1190 # generate the diff files
1192 my @insert_list = ();
1193 my @delete_list = ();
1196 # 'geocode', \&FS::tax_rate_location::batch_import,
1197 'code', \&FS::tax_class::batch_import,
1198 'plus4', \&FS::cust_tax_location::batch_import,
1199 'zip', \&FS::cust_tax_location::batch_import,
1200 'txmatrix', \&FS::part_pkg_taxrate::batch_import,
1201 'detail', \&FS::tax_rate::batch_import,
1204 while( scalar(@list) ) {
1205 my ( $name, $method ) = ( shift @list, shift @list );
1208 my $error = $job->update_statustext( "0,Comparing to previous $name" );
1209 die $error if $error;
1211 warn "processing $dir.new/$name.txt\n" if $DEBUG;
1214 open my $oldcsvfh, "$dir.1/$name.txt"
1215 or die "failed to open $dir.1/$name.txt: $!\n";
1217 while(<$oldcsvfh>) {
1224 open my $newcsvfh, "$dir.new/$name.txt"
1225 or die "failed to open $dir.new/$name.txt: $!\n";
1227 my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1230 ) or die "can't open temp file: $!\n";
1232 my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1235 ) or die "can't open temp file: $!\n";
1237 while(<$newcsvfh>) {
1239 if (exists($oldlines{$_})) {
1242 print $ifh $_, ',"I"', "\n";
1247 if ($name eq 'detail') {
1248 for (keys %oldlines) { # one file for rate details
1249 print $ifh $_, ',"D"', "\n" if $oldlines{$_};
1252 for (keys %oldlines) {
1253 print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1258 push @insert_list, $name, $ifh->filename, $method;
1259 unshift @delete_list, $name, $dfh->filename, $method
1260 unless $name eq 'detail';
1266 while( scalar(@insert_list) ) {
1267 my ($name, $file, $method) =
1268 (shift @insert_list, shift @insert_list, shift @insert_list);
1270 my $fmt = "$format-update";
1271 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1272 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1274 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1276 #unlink $file or warn "Can't delete $file: $!";
1279 while( scalar(@delete_list) ) {
1280 my ($name, $file, $method) =
1281 (shift @delete_list, shift @delete_list, shift @delete_list);
1283 my $fmt = "$format-update";
1284 $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1285 open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1287 &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1289 #unlink $file or warn "Can't delete $file: $!";
1293 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1299 rename "$dir.new", "$dir"
1300 or die "cch tax update processed, but can't rename $dir.new: $!\n";
1303 die "Unknown format: $format";
1307 =item browse_queries PARAMS
1309 Returns a list consisting of a hashref suited for use as the argument
1310 to qsearch, and sql query string. Each is based on the PARAMS hashref
1311 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1312 from a form. This conveniently creates the query hashref and count_query
1313 string required by the browse and search elements. As a side effect,
1314 the PARAMS hashref is untainted and keys with unexpected values are removed.
1318 sub browse_queries {
1322 'table' => 'tax_rate',
1324 'order_by' => 'ORDER BY geocode, taxclassnum',
1329 if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1330 $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1332 delete $params->{data_vendor};
1335 if ( $params->{geocode} =~ /^(\w+)$/ ) {
1336 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1337 'geocode LIKE '. dbh->quote($1.'%');
1339 delete $params->{geocode};
1342 if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1343 qsearchs( 'tax_class', {'taxclassnum' => $1} )
1346 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1347 ' taxclassnum = '. dbh->quote($1)
1349 delete $params->{taxclassnun};
1353 if ( $params->{tax_type} =~ /^(\d+)$/ );
1354 delete $params->{tax_type}
1358 if ( $params->{tax_cat} =~ /^(\d+)$/ );
1359 delete $params->{tax_cat}
1362 my @taxclassnum = ();
1363 if ($tax_type || $tax_cat ) {
1364 my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1365 $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1366 @taxclassnum = map { $_->taxclassnum }
1367 qsearch({ 'table' => 'tax_class',
1369 'extra_sql' => "WHERE taxclass $compare",
1373 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1374 join(' OR ', map { " taxclassnum = $_ " } @taxclassnum ). ' )'
1375 if ( @taxclassnum );
1377 unless ($params->{'showdisabled'}) {
1378 $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1379 "( disabled = '' OR disabled IS NULL )";
1382 $query->{extra_sql} = $extra_sql;
1384 return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1389 # Used by FS::Upgrade to migrate to a new database.
1393 sub _upgrade_data { # class method
1394 my ($self, %opts) = @_;
1397 warn "$me upgrading $self\n" if $DEBUG;
1399 my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1402 if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1404 eval "use DBI::Const::GetInfoType;";
1407 my $major_version = 0;
1408 $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1409 && ( $major_version = sprintf("%d", $1) );
1411 if ( $major_version > 7 ) {
1413 # ideally this would be supported in DBIx-DBSchema and friends
1415 foreach my $column ( @column ) {
1416 my $columndef = dbdef->table($self->table)->column($column);
1417 unless ($columndef->type eq 'numeric') {
1419 warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1420 my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1421 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1422 $sth->execute or die $sth->errstr;
1424 warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1425 $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1426 $sth = $dbh->prepare($sql) or die $dbh->errstr;
1427 $sth->execute or die $sth->errstr;
1434 warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1440 warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1452 Mixing automatic and manual editing works poorly at present.
1456 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base