9b79b61bbd2d13feb774a5919e26e12a2e2c3116
[freeside.git] / FS / FS / tax_rate.pm
1 package FS::tax_rate;
2
3 use strict;
4 use vars qw( @ISA $DEBUG $me
5              %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
6              %tax_passtypes %GetInfoType $keep_cch_files );
7 use Date::Parse;
8 use DateTime;
9 use DateTime::Format::Strptime;
10 use Storable qw( thaw nfreeze );
11 use IO::File;
12 use File::Temp;
13 use LWP::UserAgent;
14 use HTTP::Request;
15 use HTTP::Response;
16 use MIME::Base64;
17 use DBIx::DBSchema;
18 use DBIx::DBSchema::Table;
19 use DBIx::DBSchema::Column;
20 use FS::Record qw( qsearch qsearchs dbh dbdef );
21 use FS::tax_class;
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;
27 use FS::cust_main;
28 use FS::Misc qw( csv_from_fixed );
29
30 @ISA = qw( FS::Record );
31
32 $DEBUG = 0;
33 $me = '[FS::tax_rate]';
34 $keep_cch_files = 0;
35
36 =head1 NAME
37
38 FS::tax_rate - Object methods for tax_rate objects
39
40 =head1 SYNOPSIS
41
42   use FS::tax_rate;
43
44   $record = new FS::tax_rate \%hash;
45   $record = new FS::tax_rate { 'column' => 'value' };
46
47   $error = $record->insert;
48
49   $error = $new_record->replace($old_record);
50
51   $error = $record->delete;
52
53   $error = $record->check;
54
55 =head1 DESCRIPTION
56
57 An FS::tax_rate object represents a tax rate, defined by locale.
58 FS::tax_rate inherits from FS::Record.  The following fields are
59 currently supported:
60
61 =over 4
62
63 =item taxnum
64
65 primary key (assigned automatically for new tax rates)
66
67 =item geocode
68
69 a geographic location code provided by a tax data vendor
70
71 =item data_vendor
72
73 the tax data vendor
74
75 =item location
76
77 a location code provided by a tax authority
78
79 =item taxclassnum
80
81 a foreign key into FS::tax_class - the type of tax
82 referenced but FS::part_pkg_taxrate
83 eitem effective_date
84
85 the time after which the tax applies
86
87 =item tax
88
89 percentage
90
91 =item excessrate
92
93 second bracket percentage 
94
95 =item taxbase
96
97 the amount to which the tax applies (first bracket)
98
99 =item taxmax
100
101 a cap on the amount of tax if a cap exists
102
103 =item usetax
104
105 percentage on out of jurisdiction purchases
106
107 =item useexcessrate
108
109 second bracket percentage on out of jurisdiction purchases
110
111 =item unittype
112
113 one of the values in %tax_unittypes
114
115 =item fee
116
117 amount of tax per unit
118
119 =item excessfee
120
121 second bracket amount of tax per unit
122
123 =item feebase
124
125 the number of units to which the fee applies (first bracket)
126
127 =item feemax
128
129 the most units to which fees apply (first and second brackets)
130
131 =item maxtype
132
133 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
134
135 =item taxname
136
137 if defined, printed on invoices instead of "Tax"
138
139 =item taxauth
140
141 a value from %tax_authorities
142
143 =item basetype
144
145 a value from %tax_basetypes indicating the tax basis
146
147 =item passtype
148
149 a value from %tax_passtypes indicating how the tax should displayed to the customer
150
151 =item passflag
152
153 'Y', 'N', or blank indicating the tax can be passed to the customer
154
155 =item setuptax
156
157 if 'Y', this tax does not apply to setup fees
158
159 =item recurtax
160
161 if 'Y', this tax does not apply to recurring fees
162
163 =item manual
164
165 if 'Y', has been manually edited
166
167 =back
168
169 =head1 METHODS
170
171 =over 4
172
173 =item new HASHREF
174
175 Creates a new tax rate.  To add the tax rate to the database, see L<"insert">.
176
177 =cut
178
179 sub table { 'tax_rate'; }
180
181 =item insert
182
183 Adds this tax rate to the database.  If there is an error, returns the error,
184 otherwise returns false.
185
186 =item delete
187
188 Deletes this tax rate from the database.  If there is an error, returns the
189 error, otherwise returns false.
190
191 =item replace OLD_RECORD
192
193 Replaces the OLD_RECORD with this one in the database.  If there is an error,
194 returns the error, otherwise returns false.
195
196 =item check
197
198 Checks all fields to make sure this is a valid tax rate.  If there is an error,
199 returns the error, otherwise returns false.  Called by the insert and replace
200 methods.
201
202 =cut
203
204 sub check {
205   my $self = shift;
206
207   foreach (qw( taxbase taxmax )) {
208     $self->$_(0) unless $self->$_;
209   }
210
211   $self->ut_numbern('taxnum')
212     || $self->ut_text('geocode')
213     || $self->ut_textn('data_vendor')
214     || $self->ut_textn('location')
215     || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
216     || $self->ut_snumbern('effective_date')
217     || $self->ut_float('tax')
218     || $self->ut_floatn('excessrate')
219     || $self->ut_money('taxbase')
220     || $self->ut_money('taxmax')
221     || $self->ut_floatn('usetax')
222     || $self->ut_floatn('useexcessrate')
223     || $self->ut_numbern('unittype')
224     || $self->ut_floatn('fee')
225     || $self->ut_floatn('excessfee')
226     || $self->ut_floatn('feemax')
227     || $self->ut_numbern('maxtype')
228     || $self->ut_textn('taxname')
229     || $self->ut_numbern('taxauth')
230     || $self->ut_numbern('basetype')
231     || $self->ut_numbern('passtype')
232     || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
233     || $self->ut_enum('setuptax', [ '', 'Y' ] )
234     || $self->ut_enum('recurtax', [ '', 'Y' ] )
235     || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
236     || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
237     || $self->ut_enum('manual', [ '', 'Y' ] )
238     || $self->ut_enum('disabled', [ '', 'Y' ] )
239     || $self->SUPER::check
240     ;
241
242 }
243
244 =item taxclass_description
245
246 Returns the human understandable value associated with the related
247 FS::tax_class.
248
249 =cut
250
251 sub taxclass_description {
252   my $self = shift;
253   my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
254   $tax_class ? $tax_class->description : '';
255 }
256
257 =item unittype_name
258
259 Returns the human understandable value associated with the unittype column
260
261 =cut
262
263 %tax_unittypes = ( '0' => 'access line',
264                    '1' => 'minute',
265                    '2' => 'account',
266 );
267
268 sub unittype_name {
269   my $self = shift;
270   $tax_unittypes{$self->unittype};
271 }
272
273 =item maxtype_name
274
275 Returns the human understandable value associated with the maxtype column
276
277 =cut
278
279 %tax_maxtypes = ( '0' => 'receipts per invoice',
280                   '1' => 'receipts per item',
281                   '2' => 'total utility charges per utility tax year',
282                   '3' => 'total charges per utility tax year',
283                   '4' => 'receipts per access line',
284                   '9' => 'monthly receipts per location',
285 );
286
287 sub maxtype_name {
288   my $self = shift;
289   $tax_maxtypes{$self->maxtype};
290 }
291
292 =item basetype_name
293
294 Returns the human understandable value associated with the basetype column
295
296 =cut
297
298 %tax_basetypes = ( '0'  => 'sale price',
299                    '1'  => 'gross receipts',
300                    '2'  => 'sales taxable telecom revenue',
301                    '3'  => 'minutes carried',
302                    '4'  => 'minutes billed',
303                    '5'  => 'gross operating revenue',
304                    '6'  => 'access line',
305                    '7'  => 'account',
306                    '8'  => 'gross revenue',
307                    '9'  => 'portion gross receipts attributable to interstate service',
308                    '10' => 'access line',
309                    '11' => 'gross profits',
310                    '12' => 'tariff rate',
311                    '14' => 'account',
312                    '15' => 'prior year gross receipts',
313 );
314
315 sub basetype_name {
316   my $self = shift;
317   $tax_basetypes{$self->basetype};
318 }
319
320 =item taxauth_name
321
322 Returns the human understandable value associated with the taxauth column
323
324 =cut
325
326 %tax_authorities = ( '0' => 'federal',
327                      '1' => 'state',
328                      '2' => 'county',
329                      '3' => 'city',
330                      '4' => 'local',
331                      '5' => 'county administered by state',
332                      '6' => 'city administered by state',
333                      '7' => 'city administered by county',
334                      '8' => 'local administered by state',
335                      '9' => 'local administered by county',
336 );
337
338 sub taxauth_name {
339   my $self = shift;
340   $tax_authorities{$self->taxauth};
341 }
342
343 =item passtype_name
344
345 Returns the human understandable value associated with the passtype column
346
347 =cut
348
349 %tax_passtypes = ( '0' => 'separate tax line',
350                    '1' => 'separate surcharge line',
351                    '2' => 'surcharge not separated',
352                    '3' => 'included in base rate',
353 );
354
355 sub passtype_name {
356   my $self = shift;
357   $tax_passtypes{$self->passtype};
358 }
359
360 =item taxline TAXABLES, [ OPTIONSHASH ]
361
362 Returns a listref of a name and an amount of tax calculated for the list
363 of packages/amounts referenced by TAXABLES.  If an error occurs, a message
364 is returned as a scalar.
365
366 =cut
367
368 sub taxline {
369   my $self = shift;
370
371   my $taxables;
372   my %opt = ();
373
374   if (ref($_[0]) eq 'ARRAY') {
375     $taxables = shift;
376     %opt = @_;
377   }else{
378     $taxables = [ @_ ];
379     #exemptions would be broken in this case
380   }
381
382   my $name = $self->taxname;
383   $name = 'Other surcharges'
384     if ($self->passtype == 2);
385   my $amount = 0;
386   
387   if ( $self->disabled ) { # we always know how to handle disabled taxes
388     return {
389       'name'   => $name,
390       'amount' => $amount,
391     };
392   }
393
394   my $taxable_charged = 0;
395   my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
396                       @$taxables;
397
398   warn "calculating taxes for ". $self->taxnum. " on ".
399     join (",", map { $_->pkgnum } @cust_bill_pkg)
400     if $DEBUG;
401
402   if ($self->passflag eq 'N') {
403     # return "fatal: can't (yet) handle taxes not passed to the customer";
404     # until someone needs to track these in freeside
405     return {
406       'name'   => $name,
407       'amount' => 0,
408     };
409   }
410
411   my $maxtype = $self->maxtype || 0;
412   if ($maxtype != 0 && $maxtype != 9) {
413     return $self->_fatal_or_null( 'tax with "'.
414                                     $self->maxtype_name. '" threshold'
415                                 );
416   }
417
418   if ($maxtype == 9) {
419     return
420       $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
421                                                                 # "texas" tax
422   }
423
424   # we treat gross revenue as gross receipts and expect the tax data
425   # to DTRT (i.e. tax on tax rules)
426   if ($self->basetype != 0 && $self->basetype != 1 &&
427       $self->basetype != 5 && $self->basetype != 6 &&
428       $self->basetype != 7 && $self->basetype != 8 &&
429       $self->basetype != 14
430   ) {
431     return
432       $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
433   }
434
435   unless ($self->setuptax =~ /^Y$/i) {
436     $taxable_charged += $_->setup foreach @cust_bill_pkg;
437   }
438   unless ($self->recurtax =~ /^Y$/i) {
439     $taxable_charged += $_->recur foreach @cust_bill_pkg;
440   }
441
442   my $taxable_units = 0;
443   unless ($self->recurtax =~ /^Y$/i) {
444     if (( $self->unittype || 0 ) == 0) {
445       my %seen = ();
446       foreach (@cust_bill_pkg) {
447         $taxable_units += $_->units
448           unless $seen{$_->pkgnum};
449         $seen{$_->pkgnum}++;
450       }
451     }elsif ($self->unittype == 1) {
452       return $self->_fatal_or_null( 'fee with minute unit type' );
453     }elsif ($self->unittype == 2) {
454       $taxable_units = 1;
455     }else {
456       return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
457     }
458   }
459
460   #
461   # XXX insert exemption handling here
462   #
463   # the tax or fee is applied to taxbase or feebase and then
464   # the excessrate or excess fee is applied to taxmax or feemax
465   #
466
467   $amount += $taxable_charged * $self->tax;
468   $amount += $taxable_units * $self->fee;
469   
470   warn "calculated taxes as [ $name, $amount ]\n"
471     if $DEBUG;
472
473   return {
474     'name'   => $name,
475     'amount' => $amount,
476   };
477
478 }
479
480 sub _fatal_or_null {
481   my ($self, $error) = @_;
482
483   my $conf = new FS::Conf;
484
485   $error = "can't yet handle $error";
486   my $name = $self->taxname;
487   $name = 'Other surcharges'
488     if ($self->passtype == 2);
489
490   if ($conf->exists('ignore_incalculable_taxes')) {
491     warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
492     return { name => $name, amount => 0 };
493   } else {
494     return "fatal: $error";
495   }
496 }
497
498 =item tax_on_tax CUST_MAIN
499
500 Returns a list of taxes which are candidates for taxing taxes for the
501 given customer (see L<FS::cust_main>)
502
503 =cut
504
505 sub tax_on_tax {
506   my $self = shift;
507   my $cust_main = shift;
508
509   warn "looking up taxes on tax ". $self->taxnum. " for customer ".
510     $cust_main->custnum
511     if $DEBUG;
512
513   my $geocode = $cust_main->geocode($self->data_vendor);
514
515   # CCH oddness in m2m
516   my $dbh = dbh;
517   my $extra_sql = ' AND ('.
518     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
519                  qw(10 5 2)
520         ).
521     ')';
522
523   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
524   my $select   = 'DISTINCT ON(taxclassnum) *';
525
526   # should qsearch preface columns with the table to facilitate joins?
527   my @taxclassnums = map { $_->taxclassnum }
528     qsearch( { 'table'     => 'part_pkg_taxrate',
529                'select'    => $select,
530                'hashref'   => { 'data_vendor'      => $self->data_vendor,
531                                 'taxclassnumtaxed' => $self->taxclassnum,
532                               },
533                'extra_sql' => $extra_sql,
534                'order_by'  => $order_by,
535            } );
536
537   return () unless @taxclassnums;
538
539   $extra_sql =
540     "AND (".  join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
541
542   qsearch({ 'table'     => 'tax_rate',
543             'hashref'   => { 'geocode' => $geocode, },
544             'extra_sql' => $extra_sql,
545          })
546
547 }
548
549 =item tax_rate_location
550
551 Returns an object representing the location associated with this tax
552 (see L<FS::tax_rate_location>)
553
554 =cut
555
556 sub tax_rate_location {
557   my $self = shift;
558
559   qsearchs({ 'table'     => 'tax_rate_location',
560              'hashref'   => { 'data_vendor' => $self->data_vendor, 
561                               'geocode'     => $self->geocode,
562                               'disabled'    => '',
563                             },
564           }) ||
565   new FS::tax_rate_location;
566
567 }
568
569 =back
570
571 =head1 SUBROUTINES
572
573 =over 4
574
575 =item batch_import
576
577 =cut
578
579 sub _progressbar_foo {
580   return (0, time, 5);
581 }
582
583 sub batch_import {
584   my ($param, $job) = @_;
585
586   my $fh = $param->{filehandle};
587   my $format = $param->{'format'};
588
589   my %insert = ();
590   my %delete = ();
591
592   my @fields;
593   my $hook;
594
595   my @column_lengths = ();
596   my @column_callbacks = ();
597   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
598     $format =~ s/-fixed//;
599     my $date_format = sub { my $r='';
600                             /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
601                             $r;
602                           };
603     my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
604     push @column_lengths, qw( 10 1 1 8 8 5 8 8 8 1 2 2 30 8 8 10 2 8 2 1 2 2 );
605     push @column_lengths, 1 if $format eq 'cch-update';
606     push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
607     $column_callbacks[8] = $date_format;
608   }
609   
610   my $line;
611   my ( $count, $last, $min_sec ) = _progressbar_foo();
612   if ( $job || scalar(@column_callbacks) ) {
613     my $error =
614       csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
615     return $error if $error;
616   }
617   $count *=2;
618
619   if ( $format eq 'cch' || $format eq 'cch-update' ) {
620     @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
621                   excessrate effective_date taxauth taxtype taxcat taxname
622                   usetax useexcessrate fee unittype feemax maxtype passflag
623                   passtype basetype );
624     push @fields, 'actionflag' if $format eq 'cch-update';
625
626     $hook = sub {
627       my $hash = shift;
628
629       $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
630       $hash->{'data_vendor'} ='cch';
631       my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
632                                                    time_zone => 'floating',
633                                                  );
634       my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
635       $hash->{'effective_date'} = $dt ? $dt->epoch : '';
636
637       $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ; 
638       $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
639
640       my $taxclassid =
641         join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
642
643       my %tax_class = ( 'data_vendor'  => 'cch', 
644                         'taxclass' => $taxclassid,
645                       );
646
647       my $tax_class = qsearchs( 'tax_class', \%tax_class );
648       return "Error updating tax rate: no tax class $taxclassid"
649         unless $tax_class;
650
651       $hash->{'taxclassnum'} = $tax_class->taxclassnum;
652
653       foreach (qw( taxtype taxcat )) {
654         delete($hash->{$_});
655       }
656
657       my %passflagmap = ( '0' => '',
658                           '1' => 'Y',
659                           '2' => 'N',
660                         );
661       $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
662         if exists $passflagmap{$hash->{'passflag'}};
663
664       foreach (keys %$hash) {
665         $hash->{$_} = substr($hash->{$_}, 0, 80)
666           if length($hash->{$_}) > 80;
667       }
668
669       my $actionflag = delete($hash->{'actionflag'});
670
671       $hash->{'taxname'} =~ s/`/'/g; 
672       $hash->{'taxname'} =~ s|\\|/|g;
673
674       return '' if $format eq 'cch';  # but not cch-update
675
676       if ($actionflag eq 'I') {
677         $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
678       }elsif ($actionflag eq 'D') {
679         $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
680       }else{
681         return "Unexpected action flag: ". $hash->{'actionflag'};
682       }
683
684       delete($hash->{$_}) for keys %$hash;
685
686       '';
687
688     };
689
690   } elsif ( $format eq 'extended' ) {
691     die "unimplemented\n";
692     @fields = qw( );
693     $hook = sub {};
694   } else {
695     die "unknown format $format";
696   }
697
698   eval "use Text::CSV_XS;";
699   die $@ if $@;
700
701   my $csv = new Text::CSV_XS;
702
703   my $imported = 0;
704
705   local $SIG{HUP} = 'IGNORE';
706   local $SIG{INT} = 'IGNORE';
707   local $SIG{QUIT} = 'IGNORE';
708   local $SIG{TERM} = 'IGNORE';
709   local $SIG{TSTP} = 'IGNORE';
710   local $SIG{PIPE} = 'IGNORE';
711
712   my $oldAutoCommit = $FS::UID::AutoCommit;
713   local $FS::UID::AutoCommit = 0;
714   my $dbh = dbh;
715   
716   while ( defined($line=<$fh>) ) {
717     $csv->parse($line) or do {
718       $dbh->rollback if $oldAutoCommit;
719       return "can't parse: ". $csv->error_input();
720     };
721
722     if ( $job ) {  # progress bar
723       if ( time - $min_sec > $last ) {
724         my $error = $job->update_statustext(
725           int( 100 * $imported / $count ). ",Importing tax rates"
726         );
727         if ($error) {
728           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
729           die $error;
730         }
731         $last = time;
732       }
733     }
734
735     my @columns = $csv->fields();
736
737     my %tax_rate = ( 'data_vendor' => $format );
738     foreach my $field ( @fields ) {
739       $tax_rate{$field} = shift @columns; 
740     }
741     if ( scalar( @columns ) ) {
742       $dbh->rollback if $oldAutoCommit;
743       return "Unexpected trailing columns in line (wrong format?): $line";
744     }
745
746     my $error = &{$hook}(\%tax_rate);
747     if ( $error ) {
748       $dbh->rollback if $oldAutoCommit;
749       return $error;
750     }
751
752     if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
753
754       my $tax_rate = new FS::tax_rate( \%tax_rate );
755       $error = $tax_rate->insert;
756
757       if ( $error ) {
758         $dbh->rollback if $oldAutoCommit;
759         return "can't insert tax_rate for $line: $error";
760       }
761
762     }
763
764     $imported++;
765
766   }
767
768   for (grep { !exists($delete{$_}) } keys %insert) {
769     if ( $job ) {  # progress bar
770       if ( time - $min_sec > $last ) {
771         my $error = $job->update_statustext(
772           int( 100 * $imported / $count ). ",Importing tax rates"
773         );
774         if ($error) {
775           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
776           die $error;
777         }
778         $last = time;
779       }
780     }
781
782     my $tax_rate = new FS::tax_rate( $insert{$_} );
783     my $error = $tax_rate->insert;
784
785     if ( $error ) {
786       $dbh->rollback if $oldAutoCommit;
787       my $hashref = $insert{$_};
788       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
789       return "can't insert tax_rate for $line: $error";
790     }
791
792     $imported++;
793   }
794
795   for (grep { exists($delete{$_}) } keys %insert) {
796     if ( $job ) {  # progress bar
797       if ( time - $min_sec > $last ) {
798         my $error = $job->update_statustext(
799           int( 100 * $imported / $count ). ",Importing tax rates"
800         );
801         if ($error) {
802           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
803           die $error;
804         }
805         $last = time;
806       }
807     }
808
809     my $old = qsearchs( 'tax_rate', $delete{$_} );
810     unless ($old) {
811       $dbh->rollback if $oldAutoCommit;
812       $old = $delete{$_};
813       return "can't find tax_rate to replace for: ".
814         #join(" ", map { "$_ => ". $old->{$_} } @fields);
815         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
816     }
817     my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
818     $new->taxnum($old->taxnum);
819     my $error = $new->replace($old);
820
821     if ( $error ) {
822       $dbh->rollback if $oldAutoCommit;
823       my $hashref = $insert{$_};
824       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
825       return "can't replace tax_rate for $line: $error";
826     }
827
828     $imported++;
829     $imported++;
830   }
831
832   for (grep { !exists($insert{$_}) } keys %delete) {
833     if ( $job ) {  # progress bar
834       if ( time - $min_sec > $last ) {
835         my $error = $job->update_statustext(
836           int( 100 * $imported / $count ). ",Importing tax rates"
837         );
838         if ($error) {
839           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
840           die $error;
841         }
842         $last = time;
843       }
844     }
845
846     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
847     unless ($tax_rate) {
848       $dbh->rollback if $oldAutoCommit;
849       $tax_rate = $delete{$_};
850       return "can't find tax_rate to delete for: ".
851         #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
852         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
853     }
854     my $error = $tax_rate->delete;
855
856     if ( $error ) {
857       $dbh->rollback if $oldAutoCommit;
858       my $hashref = $delete{$_};
859       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
860       return "can't delete tax_rate for $line: $error";
861     }
862
863     $imported++;
864   }
865
866   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
867
868   return "Empty file!" unless ($imported || $format eq 'cch-update');
869
870   ''; #no error
871
872 }
873
874 =item process_batch_import
875
876 Load a batch import as a queued JSRPC job
877
878 =cut
879
880 sub process_batch_import {
881   my $job = shift;
882
883   my $oldAutoCommit = $FS::UID::AutoCommit;
884   local $FS::UID::AutoCommit = 0;
885   my $dbh = dbh;
886
887   my $param = thaw(decode_base64(shift));
888   my $args = '$job, encode_base64( nfreeze( $param ) )';
889
890   my $method = '_perform_batch_import';
891   if ( $param->{reload} ) {
892     $method = 'process_batch_reload';
893   }
894
895   eval "$method($args);";
896   if ($@) {
897     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
898     die $@;
899   }
900
901   #success!
902   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
903 }
904
905 sub _perform_batch_import {
906   my $job = shift;
907
908   my $param = thaw(decode_base64(shift));
909   my $format = $param->{'format'};        #well... this is all cch specific
910
911   my $files = $param->{'uploaded_files'}
912     or die "No files provided.";
913
914   my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
915                 split /,/, $files;
916
917   if ( $format eq 'cch' || $format eq 'cch-fixed'
918     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
919   {
920
921     my $oldAutoCommit = $FS::UID::AutoCommit;
922     local $FS::UID::AutoCommit = 0;
923     my $dbh = dbh;
924     my $error = '';
925     my @insert_list = ();
926     my @delete_list = ();
927     my @predelete_list = ();
928     my $insertname = '';
929     my $deletename = '';
930     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
931
932     my @list = ( 'GEOCODE',  \&FS::tax_rate_location::batch_import,
933                  'CODE',     \&FS::tax_class::batch_import,
934                  'PLUS4',    \&FS::cust_tax_location::batch_import,
935                  'ZIP',      \&FS::cust_tax_location::batch_import,
936                  'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
937                  'DETAIL',   \&FS::tax_rate::batch_import,
938                );
939     while( scalar(@list) ) {
940       my ( $name, $import_sub ) = splice( @list, 0, 2 );
941       my $file = lc($name). 'file';
942
943       unless ($files{$file}) {
944         $error = "No $name supplied";
945         next;
946       }
947       next if $name eq 'DETAIL' && $format =~ /update/;
948
949       my $filename = "$dir/".  $files{$file};
950
951       if ( $format =~ /update/ ) {
952
953         ( $error, $insertname, $deletename ) =
954           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
955           unless $error;
956         last if $error;
957
958         unlink $filename or warn "Can't delete $filename: $!"
959           unless $keep_cch_files;
960         push @insert_list, $name, $insertname, $import_sub, $format;
961         if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
962           unshift @predelete_list, $name, $deletename, $import_sub;
963         } else {
964           unshift @delete_list, $name, $deletename, $import_sub;
965         }
966
967       } else {
968
969         push @insert_list, $name, $filename, $import_sub, $format;
970
971       }
972
973     }
974
975     push @insert_list,
976       'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
977       if $format =~ /update/;
978
979     $error ||= _perform_cch_tax_import( $job,
980                                         [ @predelete_list ],
981                                         [ @insert_list ],
982                                         [ @delete_list ],
983     );
984     
985     
986     @list = ( @predelete_list, @insert_list, @delete_list );
987     while( !$keep_cch_files && scalar(@list) ) {
988       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
989       unlink $file or warn "Can't delete $file: $!";
990     }
991
992     if ($error) {
993       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
994       die $error;
995     }else{
996       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
997     }
998
999   }else{
1000     die "Unknown format: $format";
1001   }
1002
1003 }
1004
1005
1006 sub _perform_cch_tax_import {
1007   my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1008
1009   my $error = '';
1010   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1011     while( scalar(@$list) ) {
1012       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1013       my $fmt = "$format-update";
1014       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1015       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1016       $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1017       close $fh;
1018     }
1019   }
1020
1021   return $error;
1022 }
1023
1024 sub _perform_cch_insert_delete_split {
1025   my ($name, $filename, $dir, $format) = @_;
1026
1027   my $error = '';
1028
1029   open my $fh, "< $filename"
1030     or $error ||= "Can't open $name file $filename: $!";
1031
1032   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1033                             DIR      => $dir,
1034                             UNLINK   => 0,     #meh
1035                           ) or die "can't open temp file: $!\n";
1036   my $insertname = $ifh->filename;
1037
1038   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1039                             DIR      => $dir,
1040                             UNLINK   => 0,     #meh
1041                           ) or die "can't open temp file: $!\n";
1042   my $deletename = $dfh->filename;
1043
1044   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1045   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1046   while(<$fh>) {
1047     my $handle = '';
1048     $handle = $ifh if $_ =~ /$insert_pattern/;
1049     $handle = $dfh if $_ =~ /$delete_pattern/;
1050     unless ($handle) {
1051       $error = "bad input line: $_" unless $handle;
1052       last;
1053     }
1054     print $handle $_;
1055   }
1056   close $fh;
1057   close $ifh;
1058   close $dfh;
1059
1060   return ($error, $insertname, $deletename);
1061 }
1062
1063 sub _perform_cch_diff {
1064   my ($name, $newdir, $olddir) = @_;
1065
1066   my %oldlines = ();
1067
1068   if ($olddir) {
1069     open my $oldcsvfh, "$olddir/$name.txt"
1070       or die "failed to open $olddir/$name.txt: $!\n";
1071
1072     while(<$oldcsvfh>) {
1073       chomp;
1074       $oldlines{$_} = 1;
1075     }
1076     close $oldcsvfh;
1077   }
1078
1079   open my $newcsvfh, "$newdir/$name.txt"
1080     or die "failed to open $newdir/$name.txt: $!\n";
1081     
1082   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1083                             DIR      => "$newdir",
1084                             UNLINK   => 0,     #meh
1085                           ) or die "can't open temp file: $!\n";
1086   my $diffname = $dfh->filename;
1087
1088   while(<$newcsvfh>) {
1089     chomp;
1090     if (exists($oldlines{$_})) {
1091       $oldlines{$_} = 0;
1092     } else {
1093       print $dfh $_, ',"I"', "\n";
1094     }
1095   }
1096   close $newcsvfh;
1097
1098   for (keys %oldlines) {
1099     print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1100   }
1101
1102   close $dfh;
1103
1104   return $diffname;
1105 }
1106
1107 sub _cch_fetch_and_unzip {
1108   my ( $job, $urls, $secret, $dir ) = @_;
1109
1110   my $ua = new LWP::UserAgent;
1111   foreach my $url (split ',', $urls) {
1112     my @name = split '/', $url;  #somewhat restrictive
1113     my $name = pop @name;
1114     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1115     $name = $1;
1116       
1117     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1118      
1119     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1120     my $res = $ua->request(
1121       new HTTP::Request( GET => $url ),
1122       sub {
1123             print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1124             my $content_length = $_[1]->content_length;
1125             $imported += length($_[0]);
1126             if ( time - $min_sec > $last ) {
1127               my $error = $job->update_statustext(
1128                 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1129                 ",Downloading data from CCH"
1130               );
1131               die $error if $error;
1132               $last = time;
1133             }
1134       },
1135     );
1136     die "download of $url failed: ". $res->status_line
1137       unless $res->is_success;
1138       
1139     close $taxfh;
1140     my $error = $job->update_statustext( "0,Unpacking data" );
1141     die $error if $error;
1142     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1143     $secret = $1;
1144     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1145       or die "unzip -P $secret -d $dir $dir/$name failed";
1146     #unlink "$dir/$name";
1147   }
1148 }
1149  
1150 sub _cch_extract_csv_from_dbf {
1151   my ( $job, $dir, $name ) = @_;
1152
1153   eval "use Text::CSV_XS;";
1154   die $@ if $@;
1155
1156   eval "use XBase;";
1157   die $@ if $@;
1158
1159   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1160   my $error = $job->update_statustext( "0,Unpacking $name" );
1161   die $error if $error;
1162   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1163   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1164   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1165     unless defined($table);
1166   my $count = $table->last_record; # approximately;
1167   open my $csvfh, ">$dir.new/$name.txt"
1168     or die "failed to open $dir.new/$name.txt: $!\n";
1169
1170   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1171   my @fields = $table->field_names;
1172   my $cursor = $table->prepare_select;
1173   my $format_date =
1174     sub { my $date = shift;
1175           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1176           $date;
1177         };
1178   while (my $row = $cursor->fetch_hashref) {
1179     $csv->combine( map { ($table->field_type($_) eq 'D')
1180                          ? &{$format_date}($row->{$_}) 
1181                          : $row->{$_}
1182                        }
1183                    @fields
1184     );
1185     print $csvfh $csv->string, "\n";
1186     $imported++;
1187     if ( time - $min_sec > $last ) {
1188       my $error = $job->update_statustext(
1189         int(100 * $imported/$count).  ",Unpacking $name"
1190       );
1191       die $error if $error;
1192       $last = time;
1193     }
1194   }
1195   $table->close;
1196   close $csvfh;
1197 }
1198
1199 sub _remember_disabled_taxes {
1200   my ( $job, $format, $disabled_tax_rate ) = @_;
1201
1202   # cch specific hash
1203
1204   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1205
1206   my @items = qsearch( { table   => 'tax_rate',
1207                          hashref => { disabled => 'Y',
1208                                       data_vendor => $format,
1209                                     },
1210                          select  => 'geocode, taxclassnum',
1211                        }
1212                      );
1213   my $count = scalar(@items);
1214   foreach my $tax_rate ( @items ) {
1215     if ( time - $min_sec > $last ) {
1216       $job->update_statustext(
1217         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1218       );
1219       $last = time;
1220     }
1221     $imported++;
1222     my $tax_class =
1223       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1224     unless ( $tax_class ) {
1225       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1226       next;
1227     }
1228     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1229   }
1230 }
1231
1232 sub _remember_tax_products {
1233   my ( $job, $format, $taxproduct ) = @_;
1234
1235   # XXX FIXME  this loop only works when cch is the only data provider
1236
1237   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1238
1239   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1240                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1241                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1242                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1243                   "       optionvalue != '' )";
1244   my @items = qsearch( { table => 'part_pkg',
1245                          select  => 'DISTINCT pkgpart,taxproductnum',
1246                          hashref => {},
1247                          extra_sql => $extra_sql,
1248                        }
1249                      );
1250   my $count = scalar(@items);
1251   foreach my $part_pkg ( @items ) {
1252     if ( time - $min_sec > $last ) {
1253       $job->update_statustext(
1254         int( 100 * $imported / $count ). ",Remembering tax products"
1255       );
1256       $last = time;
1257     }
1258     $imported++;
1259     warn "working with package part ". $part_pkg->pkgpart.
1260       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1261     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1262     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1263       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1264
1265     foreach my $option ( $part_pkg->part_pkg_option ) {
1266       next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1267       my $class = $1;
1268
1269       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1270       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1271           $part_pkg_taxproduct->taxproduct
1272         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1273     }
1274   }
1275 }
1276
1277 sub _restore_remembered_tax_products {
1278   my ( $job, $format, $taxproduct ) = @_;
1279
1280   # cch specific
1281
1282   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1283   my $count = scalar(keys %$taxproduct);
1284   foreach my $pkgpart ( keys %$taxproduct ) {
1285     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1286     if ( time - $min_sec > $last ) {
1287       $job->update_statustext(
1288         int( 100 * $imported / $count ). ",Restoring tax products"
1289       );
1290       $last = time;
1291     }
1292     $imported++;
1293
1294     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1295     unless ( $part_pkg ) {
1296       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1297     }
1298
1299     my %options = $part_pkg->options;
1300     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1301     my $primary_svc = $part_pkg->svcpart;
1302     my $new = new FS::part_pkg { $part_pkg->hash };
1303
1304     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1305       warn "working with class '$class'\n" if $DEBUG;
1306       my $part_pkg_taxproduct =
1307         qsearchs( 'part_pkg_taxproduct',
1308                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1309                     data_vendor => $format,
1310                   }
1311                 );
1312
1313       unless ( $part_pkg_taxproduct ) {
1314         return "failed to find part_pkg_taxproduct (".
1315           $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1316       }
1317
1318       if ( $class eq '' ) {
1319         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1320         next;
1321       }
1322
1323       $options{"usage_taxproductnum_$class"} =
1324         $part_pkg_taxproduct->taxproductnum;
1325
1326     }
1327
1328     my $error = $new->replace( $part_pkg,
1329                                'pkg_svc' => \%pkg_svc,
1330                                'primary_svc' => $primary_svc,
1331                                'options' => \%options,
1332     );
1333       
1334     return $error if $error;
1335
1336   }
1337
1338   '';
1339 }
1340
1341 sub _restore_remembered_disabled_taxes {
1342   my ( $job, $format, $disabled_tax_rate ) = @_;
1343
1344   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1345   my $count = scalar(keys %$disabled_tax_rate);
1346   foreach my $key (keys %$disabled_tax_rate) {
1347     if ( time - $min_sec > $last ) {
1348       $job->update_statustext(
1349         int( 100 * $imported / $count ). ",Disabling tax rates"
1350       );
1351       $last = time;
1352     }
1353     $imported++;
1354     my ($geocode,$taxclass) = split /:/, $key, 2;
1355     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1356                                             taxclass    => $taxclass,
1357                                           } );
1358     return "found multiple tax_class records for format $format class $taxclass"
1359       if scalar(@tax_class) > 1;
1360       
1361     unless (scalar(@tax_class)) {
1362       warn "no tax_class for format $format class $taxclass\n";
1363       next;
1364     }
1365
1366     my @tax_rate =
1367       qsearch('tax_rate', { data_vendor  => $format,
1368                             geocode      => $geocode,
1369                             taxclassnum  => $tax_class[0]->taxclassnum,
1370                           }
1371     );
1372
1373     if (scalar(@tax_rate) > 1) {
1374       return "found multiple tax_rate records for format $format geocode ".
1375              "$geocode and taxclass $taxclass ( taxclassnum ".
1376              $tax_class[0]->taxclassnum.  " )";
1377     }
1378       
1379     if (scalar(@tax_rate)) {
1380       $tax_rate[0]->disabled('Y');
1381       my $error = $tax_rate[0]->replace;
1382       return $error if $error;
1383     }
1384   }
1385 }
1386
1387 sub _remove_old_tax_data {
1388   my ( $job, $format ) = @_;
1389
1390   my $dbh = dbh;
1391   my $error = $job->update_statustext( "0,Removing old tax data" );
1392   die $error if $error;
1393
1394   my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1395     "WHERE data_vendor = ".  $dbh->quote($format);
1396   $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1397
1398   my @table = qw(
1399     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1400   );
1401   foreach my $table ( @table ) {
1402     $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1403       $dbh->quote($format);
1404     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1405   }
1406
1407   if ( $format eq 'cch' ) {
1408     $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1409       $dbh->quote("$format-zip");
1410     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1411   }
1412
1413   '';
1414 }
1415
1416 sub _create_temporary_tables {
1417   my ( $job, $format ) = @_;
1418
1419   my $dbh = dbh;
1420   my $error = $job->update_statustext( "0,Creating temporary tables" );
1421   die $error if $error;
1422
1423   my @table = qw( tax_rate
1424                   tax_rate_location
1425                   part_pkg_taxrate
1426                   part_pkg_taxproduct
1427                   tax_class
1428                   cust_tax_location
1429   );
1430   foreach my $table ( @table ) {
1431     my $sql =
1432       "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1433     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1434   }
1435
1436   '';
1437 }
1438
1439 sub _copy_from_temp {
1440   my ( $job, $format ) = @_;
1441
1442   my $dbh = dbh;
1443   my $error = $job->update_statustext( "0,Making permanent" );
1444   die $error if $error;
1445
1446   my @table = qw( tax_rate
1447                   tax_rate_location
1448                   part_pkg_taxrate
1449                   part_pkg_taxproduct
1450                   tax_class
1451                   cust_tax_location
1452   );
1453   foreach my $table ( @table ) {
1454     my $sql =
1455       "INSERT INTO public.$table SELECT * from $table";
1456     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1457   }
1458
1459   '';
1460 }
1461
1462 =item process_download_and_reload
1463
1464 Download and process a tax update as a queued JSRPC job after wiping the
1465 existing wipable tax data.
1466
1467 =cut
1468
1469 sub process_download_and_reload {
1470   _process_reload('process_download_and_update', @_);
1471 }
1472
1473   
1474 =item process_batch_reload
1475
1476 Load and process a tax update from the provided files as a queued JSRPC job
1477 after wiping the existing wipable tax data.
1478
1479 =cut
1480
1481 sub process_batch_reload {
1482   _process_reload('_perform_batch_import', @_);
1483 }
1484
1485   
1486 sub _process_reload {
1487   my ( $method, $job ) = ( shift, shift );
1488
1489   my $param = thaw(decode_base64($_[0]));
1490   my $format = $param->{'format'};        #well... this is all cch specific
1491
1492   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1493
1494   if ( $job ) {  # progress bar
1495     my $error = $job->update_statustext( 0 );
1496     die $error if $error;
1497   }
1498
1499   my $oldAutoCommit = $FS::UID::AutoCommit;
1500   local $FS::UID::AutoCommit = 0;
1501   my $dbh = dbh;
1502   my $error = '';
1503
1504   my $sql =
1505     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1506     "USING (taxclassnum) WHERE data_vendor = '$format'";
1507   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1508   $sth->execute
1509     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1510   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1511     if $sth->fetchrow_arrayref->[0];
1512
1513   # really should get a table EXCLUSIVE lock here
1514
1515   #remember disabled taxes
1516   my %disabled_tax_rate = ();
1517   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1518
1519   #remember tax products
1520   my %taxproduct = ();
1521   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1522
1523   #create temp tables
1524   $error ||= _create_temporary_tables( $job, $format );
1525
1526   #import new data
1527   unless ($error) {
1528     my $args = '$job, @_';
1529     eval "$method($args);";
1530     $error = $@ if $@;
1531   }
1532
1533   #restore taxproducts
1534   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1535
1536   #disable tax_rates
1537   $error ||=
1538    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1539
1540   #wipe out the old data
1541   $error ||= _remove_old_tax_data( $job, $format ); 
1542
1543   #untemporize
1544   $error ||= _copy_from_temp( $job, $format );
1545
1546   if ($error) {
1547     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1548     die $error;
1549   }
1550
1551   #success!
1552   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1553 }
1554
1555
1556 =item process_download_and_update
1557
1558 Download and process a tax update as a queued JSRPC job
1559
1560 =cut
1561
1562 sub process_download_and_update {
1563   my $job = shift;
1564
1565   my $param = thaw(decode_base64(shift));
1566   my $format = $param->{'format'};        #well... this is all cch specific
1567
1568   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1569
1570   if ( $job ) {  # progress bar
1571     my $error = $job->update_statustext( 0);
1572     die $error if $error;
1573   }
1574
1575   my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1576   my $dir = $cache_dir. 'taxdata';
1577   unless (-d $dir) {
1578     mkdir $dir or die "can't create $dir: $!\n";
1579   }
1580
1581   if ($format eq 'cch') {
1582
1583     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1584
1585     my $conf = new FS::Conf;
1586     die "direct download of tax data not enabled\n" 
1587       unless $conf->exists('taxdatadirectdownload');
1588     my ( $urls, $username, $secret, $states ) =
1589       $conf->config('taxdatadirectdownload');
1590     die "No tax download URL provided.  ".
1591         "Did you set the taxdatadirectdownload configuration value?\n"
1592       unless $urls;
1593
1594     $dir .= '/cch';
1595
1596     my $dbh = dbh;
1597     my $error = '';
1598
1599     # really should get a table EXCLUSIVE lock here
1600     # check if initial import or update
1601     #
1602     # relying on mkdir "$dir.new" as a mutex
1603     
1604     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1605     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1606     $sth->execute() or die $sth->errstr;
1607     my $update = $sth->fetchrow_arrayref->[0];
1608
1609     # create cache and/or rotate old tax data
1610
1611     if (-d $dir) {
1612
1613       if (-d "$dir.4") {
1614         opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1615         foreach my $file (readdir($dirh)) {
1616           unlink "$dir.4/$file" if (-f "$dir.4/$file");
1617         }
1618         closedir($dirh);
1619         rmdir "$dir.4";
1620       }
1621
1622       for (3, 2, 1) {
1623         if ( -e "$dir.$_" ) {
1624           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1625         }
1626       }
1627       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1628
1629     } else {
1630
1631       die "can't find previous tax data\n" if $update;
1632
1633     }
1634
1635     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1636     
1637     # fetch and unpack the zip files
1638
1639     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1640  
1641     # extract csv files from the dbf files
1642
1643     foreach my $name ( @namelist ) {
1644       _cch_extract_csv_from_dbf( $job, $dir, $name ); 
1645     }
1646
1647     # generate the diff files
1648
1649     my @list = ();
1650     foreach my $name ( @namelist ) {
1651       my $difffile = "$dir.new/$name.txt";
1652       if ($update) {
1653         my $error = $job->update_statustext( "0,Comparing to previous $name" );
1654         die $error if $error;
1655         warn "processing $dir.new/$name.txt\n" if $DEBUG;
1656         my $olddir = $update ? "$dir.1" : "";
1657         $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1658       } else {
1659         $difffile =~ s/^$cache_dir//;
1660         push @list, "${name}file:$difffile";
1661       }
1662     }
1663
1664     # perform the import
1665     local $keep_cch_files = 1;
1666     $param->{uploaded_files} = join( ',', @list );
1667     $param->{format} .= '-update' if $update;
1668     $error ||=
1669       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1670     
1671     rename "$dir.new", "$dir"
1672       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1673
1674   }else{
1675     die "Unknown format: $format";
1676   }
1677 }
1678
1679 =item browse_queries PARAMS
1680
1681 Returns a list consisting of a hashref suited for use as the argument
1682 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1683 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1684 from a form.  This conveniently creates the query hashref and count_query
1685 string required by the browse and search elements.  As a side effect, 
1686 the PARAMS hashref is untainted and keys with unexpected values are removed.
1687
1688 =cut
1689
1690 sub browse_queries {
1691   my $params = shift;
1692
1693   my $query = {
1694                 'table'     => 'tax_rate',
1695                 'hashref'   => {},
1696                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1697               },
1698
1699   my $extra_sql = '';
1700
1701   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1702     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1703   } else {
1704     delete $params->{data_vendor};
1705   }
1706    
1707   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1708     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1709                     'geocode LIKE '. dbh->quote($1.'%');
1710   } else {
1711     delete $params->{geocode};
1712   }
1713
1714   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1715        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1716      )
1717   {
1718     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1719                   ' taxclassnum  = '. dbh->quote($1)
1720   } else {
1721     delete $params->{taxclassnun};
1722   }
1723
1724   my $tax_type = $1
1725     if ( $params->{tax_type} =~ /^(\d+)$/ );
1726   delete $params->{tax_type}
1727     unless $tax_type;
1728
1729   my $tax_cat = $1
1730     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1731   delete $params->{tax_cat}
1732     unless $tax_cat;
1733
1734   my @taxclassnum = ();
1735   if ($tax_type || $tax_cat ) {
1736     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1737     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1738     @taxclassnum = map { $_->taxclassnum } 
1739                    qsearch({ 'table'     => 'tax_class',
1740                              'hashref'   => {},
1741                              'extra_sql' => "WHERE taxclass $compare",
1742                           });
1743   }
1744
1745   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1746                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1747     if ( @taxclassnum );
1748
1749   unless ($params->{'showdisabled'}) {
1750     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1751                   "( disabled = '' OR disabled IS NULL )";
1752   }
1753
1754   $query->{extra_sql} = $extra_sql;
1755
1756   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1757 }
1758
1759 # _upgrade_data
1760 #
1761 # Used by FS::Upgrade to migrate to a new database.
1762 #
1763 #
1764
1765 sub _upgrade_data {  # class method
1766   my ($self, %opts) = @_;
1767   my $dbh = dbh;
1768
1769   warn "$me upgrading $self\n" if $DEBUG;
1770
1771   my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1772                     feebase feemax );
1773
1774   if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1775
1776     eval "use DBI::Const::GetInfoType;";
1777     die $@ if $@;
1778
1779     my $major_version = 0;
1780     $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1781       && ( $major_version = sprintf("%d", $1) );
1782
1783     if ( $major_version > 7 ) {
1784
1785       # ideally this would be supported in DBIx-DBSchema and friends
1786
1787       foreach my $column ( @column ) {
1788         my $columndef = dbdef->table($self->table)->column($column);
1789         unless ($columndef->type eq 'numeric') {
1790
1791           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1792           my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1793           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1794           $sth->execute or die $sth->errstr;
1795
1796           warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1797           $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1798           $sth = $dbh->prepare($sql) or die $dbh->errstr;
1799           $sth->execute or die $sth->errstr;
1800
1801         }
1802       }
1803
1804     } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1805
1806       # ideally this would be supported in DBIx-DBSchema and friends
1807
1808       foreach my $column ( @column ) {
1809         my $columndef = dbdef->table($self->table)->column($column);
1810         unless ($columndef->type eq 'numeric') {
1811
1812           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1813
1814           foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1815
1816             my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1817             my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1818             $sth->execute or die $sth->errstr;
1819
1820             my $def = dbdef->table($table)->column($column);
1821             $def->type('numeric');
1822             $def->length('14,8'); 
1823             my $null = $def->null;
1824             $def->null('NULL');
1825
1826             $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1827             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1828             $sth->execute or die $sth->errstr;
1829
1830             $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1831             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1832             $sth->execute or die $sth->errstr;
1833
1834             unless ( $null eq 'NULL' ) {
1835               $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1836               $sth = $dbh->prepare($sql) or die $dbh->errstr;
1837               $sth->execute or die $sth->errstr;
1838             }
1839
1840             $sql = "ALTER TABLE $table DROP old_$column";
1841             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1842             $sth->execute or die $sth->errstr;
1843
1844           }
1845         }
1846       }
1847
1848     } else {
1849
1850       warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1851
1852     }
1853
1854   } else {
1855
1856     warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1857
1858   }
1859
1860   '';
1861
1862 }
1863
1864 =back
1865
1866 =head1 BUGS
1867
1868   Mixing automatic and manual editing works poorly at present.
1869
1870 =head1 SEE ALSO
1871
1872 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
1873 documentation.
1874
1875 =cut
1876
1877 1;
1878