refactor cch tax import to remove tons of false laziness and improve flexibility...
[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+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
915
916   if ( $format eq 'cch' || $format eq 'cch-fixed'
917     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
918   {
919
920     my $oldAutoCommit = $FS::UID::AutoCommit;
921     local $FS::UID::AutoCommit = 0;
922     my $dbh = dbh;
923     my $error = '';
924     my @insert_list = ();
925     my @delete_list = ();
926     my @predelete_list = ();
927     my $insertname = '';
928     my $deletename = '';
929     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
930
931     my @list = ( 'GEOCODE',  'geofile',   \&FS::tax_rate_location::batch_import,
932                  'CODE',     'codefile',  \&FS::tax_class::batch_import,
933                  'PLUS4',    'plus4file', \&FS::cust_tax_location::batch_import,
934                  'ZIP',      'zipfile',   \&FS::cust_tax_location::batch_import,
935                  'TXMATRIX', 'txmatrix',  \&FS::part_pkg_taxrate::batch_import,
936                  'DETAIL',   'detail',    \&FS::tax_rate::batch_import,
937                );
938     while( scalar(@list) ) {
939       my ( $name, $file, $import_sub ) = splice( @list, 0, 3 );
940
941       unless ($files{$file}) {
942         $error = "No $name supplied";
943         next;
944       }
945       next if $name eq 'DETAIL' && $format =~ /update/;
946
947       my $filename = "$dir/".  $files{$file};
948
949       if ( $format =~ /update/ ) {
950
951         ( $error, $insertname, $deletename ) =
952           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
953           unless $error;
954         last if $error;
955
956         unlink $filename or warn "Can't delete $filename: $!"
957           unless $keep_cch_files;
958         push @insert_list, $name, $insertname, $import_sub, $format;
959         if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
960           unshift @predelete_list, $name, $deletename, $import_sub;
961         } else {
962           unshift @delete_list, $name, $deletename, $import_sub;
963         }
964
965       } else {
966
967         push @insert_list, $name, $filename, $import_sub, $format;
968
969       }
970
971     }
972
973     push @insert_list,
974       'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
975       if $format =~ /update/;
976
977     $error ||= _perform_cch_tax_import( $job,
978                                         [ @predelete_list ],
979                                         [ @insert_list ],
980                                         [ @delete_list ],
981     );
982     
983     
984     @list = ( @predelete_list, @insert_list, @delete_list );
985     while( !$keep_cch_files && scalar(@list) ) {
986       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
987       unlink $file or warn "Can't delete $file: $!";
988     }
989
990     if ($error) {
991       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
992       die $error;
993     }else{
994       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
995     }
996
997   }else{
998     die "Unknown format: $format";
999   }
1000
1001 }
1002
1003
1004 sub _perform_cch_tax_import {
1005   my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1006
1007   my $error = '';
1008   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1009     while( scalar(@$list) ) {
1010       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1011       my $fmt = "$format-update";
1012       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1013       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1014       $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1015       close $fh;
1016     }
1017   }
1018
1019   return $error;
1020 }
1021
1022 sub _perform_cch_insert_delete_split {
1023   my ($name, $filename, $dir, $format) = @_;
1024
1025   my $error = '';
1026
1027   open my $fh, "< $filename"
1028     or $error ||= "Can't open $name file $filename: $!";
1029
1030   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1031                             DIR      => $dir,
1032                             UNLINK   => 0,     #meh
1033                           ) or die "can't open temp file: $!\n";
1034   my $insertname = $ifh->filename;
1035
1036   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1037                             DIR      => $dir,
1038                             UNLINK   => 0,     #meh
1039                           ) or die "can't open temp file: $!\n";
1040   my $deletename = $dfh->filename;
1041
1042   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1043   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1044   while(<$fh>) {
1045     my $handle = '';
1046     $handle = $ifh if $_ =~ /$insert_pattern/;
1047     $handle = $dfh if $_ =~ /$delete_pattern/;
1048     unless ($handle) {
1049       $error = "bad input line: $_" unless $handle;
1050       last;
1051     }
1052     print $handle $_;
1053   }
1054   close $fh;
1055   close $ifh;
1056   close $dfh;
1057
1058   return ($error, $insertname, $deletename);
1059 }
1060
1061 sub _perform_cch_diff {
1062   my ($name, $newdir, $olddir) = @_;
1063
1064   my %oldlines = ();
1065
1066   if ($olddir) {
1067     open my $oldcsvfh, "$olddir/$name.txt"
1068       or die "failed to open $olddir/$name.txt: $!\n";
1069
1070     while(<$oldcsvfh>) {
1071       chomp;
1072       $oldlines{$_} = 1;
1073     }
1074     close $oldcsvfh;
1075   }
1076
1077   open my $newcsvfh, "$newdir/$name.txt"
1078     or die "failed to open $newdir/$name.txt: $!\n";
1079     
1080   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1081                             DIR      => "$newdir",
1082                             UNLINK   => 0,     #meh
1083                           ) or die "can't open temp file: $!\n";
1084   my $diffname = $dfh->filename;
1085
1086   while(<$newcsvfh>) {
1087     chomp;
1088     if (exists($oldlines{$_})) {
1089       $oldlines{$_} = 0;
1090     } else {
1091       print $dfh $_, ',"I"', "\n";
1092     }
1093   }
1094   close $newcsvfh;
1095
1096   for (keys %oldlines) {
1097     print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1098   }
1099
1100   close $dfh;
1101
1102   return $diffname;
1103 }
1104
1105 sub _cch_fetch_and_unzip {
1106   my ( $job, $urls, $secret, $dir ) = @_;
1107
1108   my $ua = new LWP::UserAgent;
1109   foreach my $url (split ',', $urls) {
1110     my @name = split '/', $url;  #somewhat restrictive
1111     my $name = pop @name;
1112     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1113     $name = $1;
1114       
1115     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1116      
1117     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1118     my $res = $ua->request(
1119       new HTTP::Request( GET => $url ),
1120       sub {
1121             print $taxfh $_[0] or die "Can't write to $dir/$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"
1128               );
1129               die $error if $error;
1130               $last = time;
1131             }
1132       },
1133     );
1134     die "download of $url failed: ". $res->status_line
1135       unless $res->is_success;
1136       
1137     close $taxfh;
1138     my $error = $job->update_statustext( "0,Unpacking data" );
1139     die $error if $error;
1140     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1141     $secret = $1;
1142     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1143       or die "unzip -P $secret -d $dir $dir/$name failed";
1144     #unlink "$dir/$name";
1145   }
1146 }
1147  
1148 sub _cch_extract_csv_from_dbf {
1149   my ( $job, $dir, $name ) = @_;
1150
1151   eval "use Text::CSV_XS;";
1152   die $@ if $@;
1153
1154   eval "use XBase;";
1155   die $@ if $@;
1156
1157   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1158   my $error = $job->update_statustext( "0,Unpacking $name" );
1159   die $error if $error;
1160   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1161   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1162   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1163     unless defined($table);
1164   my $count = $table->last_record; # approximately;
1165   open my $csvfh, ">$dir.new/$name.txt"
1166     or die "failed to open $dir.new/$name.txt: $!\n";
1167
1168   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1169   my @fields = $table->field_names;
1170   my $cursor = $table->prepare_select;
1171   my $format_date =
1172     sub { my $date = shift;
1173           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1174           $date;
1175         };
1176   while (my $row = $cursor->fetch_hashref) {
1177     $csv->combine( map { ($table->field_type($_) eq 'D')
1178                          ? &{$format_date}($row->{$_}) 
1179                          : $row->{$_}
1180                        }
1181                    @fields
1182     );
1183     print $csvfh $csv->string, "\n";
1184     $imported++;
1185     if ( time - $min_sec > $last ) {
1186       my $error = $job->update_statustext(
1187         int(100 * $imported/$count).  ",Unpacking $name"
1188       );
1189       die $error if $error;
1190       $last = time;
1191     }
1192   }
1193   $table->close;
1194   close $csvfh;
1195 }
1196
1197 sub _remember_disabled_taxes {
1198   my ( $job, $format, $disabled_tax_rate ) = @_;
1199
1200   # cch specific hash
1201
1202   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1203
1204   my @items = qsearch( { table   => 'tax_rate',
1205                          hashref => { disabled => 'Y',
1206                                       data_vendor => $format,
1207                                     },
1208                          select  => 'geocode, taxclassnum',
1209                        }
1210                      );
1211   my $count = scalar(@items);
1212   foreach my $tax_rate ( @items ) {
1213     if ( time - $min_sec > $last ) {
1214       $job->update_statustext(
1215         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1216       );
1217       $last = time;
1218     }
1219     $imported++;
1220     my $tax_class =
1221       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1222     unless ( $tax_class ) {
1223       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1224       next;
1225     }
1226     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1227   }
1228 }
1229
1230 sub _remember_tax_products {
1231   my ( $job, $format, $taxproduct ) = @_;
1232
1233   # XXX FIXME  this loop only works when cch is the only data provider
1234
1235   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1236
1237   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1238                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1239                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1240                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1241                   "       optionvalue != '' )";
1242   my @items = qsearch( { table => 'part_pkg',
1243                          select  => 'DISTINCT pkgpart,taxproductnum',
1244                          hashref => {},
1245                          extra_sql => $extra_sql,
1246                        }
1247                      );
1248   my $count = scalar(@items);
1249   foreach my $part_pkg ( @items ) {
1250     if ( time - $min_sec > $last ) {
1251       $job->update_statustext(
1252         int( 100 * $imported / $count ). ",Remembering tax products"
1253       );
1254       $last = time;
1255     }
1256     $imported++;
1257     warn "working with package part ". $part_pkg->pkgpart.
1258       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1259     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1260     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1261       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1262
1263     foreach my $option ( $part_pkg->part_pkg_option ) {
1264       next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/;
1265       my $class = $1;
1266
1267       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1268       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1269           $part_pkg_taxproduct->taxproduct
1270         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1271     }
1272   }
1273 }
1274
1275 sub _restore_remembered_tax_products {
1276   my ( $job, $format, $taxproduct ) = @_;
1277
1278   # cch specific
1279
1280   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1281   my $count = scalar(keys %$taxproduct);
1282   foreach my $pkgpart ( keys %$taxproduct ) {
1283     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1284     if ( time - $min_sec > $last ) {
1285       $job->update_statustext(
1286         int( 100 * $imported / $count ). ",Restoring tax products"
1287       );
1288       $last = time;
1289     }
1290     $imported++;
1291
1292     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1293     unless ( $part_pkg ) {
1294       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1295     }
1296
1297     my %options = $part_pkg->options;
1298     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1299     my $primary_svc = $part_pkg->svcpart;
1300     my $new = new FS::part_pkg { $part_pkg->hash };
1301
1302     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1303       warn "working with class '$class'\n" if $DEBUG;
1304       my $part_pkg_taxproduct =
1305         qsearchs( 'part_pkg_taxproduct',
1306                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1307                     data_vendor => $format,
1308                   }
1309                 );
1310
1311       unless ( $part_pkg_taxproduct ) {
1312         return "failed to find part_pkg_taxproduct (".
1313           $taxproduct->{pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1314       }
1315
1316       if ( $class eq '' ) {
1317         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1318         next;
1319       }
1320
1321       $options{"usage_taxproductnum_$class"} =
1322         $part_pkg_taxproduct->taxproductnum;
1323
1324     }
1325
1326     my $error = $new->replace( $part_pkg,
1327                                'pkg_svc' => \%pkg_svc,
1328                                'primary_svc' => $primary_svc,
1329                                'options' => \%options,
1330     );
1331       
1332     return $error if $error;
1333
1334   }
1335
1336   '';
1337 }
1338
1339 sub _restore_remembered_disabled_taxes {
1340   my ( $job, $format, $disabled_tax_rate ) = @_;
1341
1342   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1343   my $count = scalar(keys %$disabled_tax_rate);
1344   foreach my $key (keys %$disabled_tax_rate) {
1345     if ( time - $min_sec > $last ) {
1346       $job->update_statustext(
1347         int( 100 * $imported / $count ). ",Disabling tax rates"
1348       );
1349       $last = time;
1350     }
1351     $imported++;
1352     my ($geocode,$taxclass) = split /:/, $key, 2;
1353     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1354                                             taxclass    => $taxclass,
1355                                           } );
1356     return "found multiple tax_class records for format $format class $taxclass"
1357       if scalar(@tax_class) > 1;
1358       
1359     unless (scalar(@tax_class)) {
1360       warn "no tax_class for format $format class $taxclass\n";
1361       next;
1362     }
1363
1364     my @tax_rate =
1365       qsearch('tax_rate', { data_vendor  => $format,
1366                             geocode      => $geocode,
1367                             taxclassnum  => $tax_class[0]->taxclassnum,
1368                           }
1369     );
1370
1371     if (scalar(@tax_rate) > 1) {
1372       return "found multiple tax_rate records for format $format geocode ".
1373              "$geocode and taxclass $taxclass ( taxclassnum ".
1374              $tax_class[0]->taxclassnum.  " )";
1375     }
1376       
1377     if (scalar(@tax_rate)) {
1378       $tax_rate[0]->disabled('Y');
1379       my $error = $tax_rate[0]->replace;
1380       return $error if $error;
1381     }
1382   }
1383 }
1384
1385 sub _remove_old_tax_data {
1386   my ( $job, $format ) = @_;
1387
1388   my $dbh = dbh;
1389   my $error = $job->update_statustext( "0,Removing old tax data" );
1390   dir $error if $error;
1391   foreach my $tax_rate_location ( qsearch( 'tax_rate_location',
1392                                            { data_vendor => $format,
1393                                              disabled    => '',
1394                                            }
1395                                          )
1396                                 )
1397   {
1398     $tax_rate_location->disabled('Y');
1399     my $error = $tax_rate_location->replace;
1400     return $error if $error;
1401   }
1402
1403   local $FS::part_pkg_taxproduct::delete_kludge = 1;
1404   my @table = qw(
1405     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1406   );
1407   foreach my $table ( @table ) {
1408     my $dbh = dbh;
1409 #    my $primary_key = dbdef->table($table)->primary_key;
1410 #    my $sql = "SELECT $primary_key FROM $table WHERE data_vendor = ".
1411     my $sql = "DELETE FROM $table WHERE data_vendor = ".
1412       $dbh->quote($format);
1413     my $sth = $dbh->prepare($sql);
1414     return $dbh->errstr unless ($sth);
1415     $sth->execute or return "Failed to execute $sql: ". $sth->errstr;
1416 #    foreach my $row ( @{ $sth->fetchall_arrayref } ) {
1417 #      my $record = qsearchs( $table, { $primary_key => $row->[0] } )
1418 #        or return "Failed to find $table with $primary_key ". $row->[0];
1419 #      my $error = $record->delete;
1420 #      return $error if $error;
1421 #    }
1422   }
1423
1424   if ( $format eq 'cch' ) {
1425     foreach my $cust_tax_location ( qsearch( 'cust_tax_location',
1426                                              { data_vendor => "$format-zip" }
1427                                            )
1428                                   )
1429     {
1430       my $error = $cust_tax_location->delete;
1431       return $error if $error;
1432     }
1433   }
1434
1435   '';
1436 }
1437
1438 =item process_download_and_reload
1439
1440 Download and process a tax update as a queued JSRPC job after wiping the
1441 existing wipable tax data.
1442
1443 =cut
1444
1445 sub process_download_and_reload {
1446   _process_reload('process_download_and_update', @_);
1447 }
1448
1449   
1450 =item process_batch_reload
1451
1452 Load and process a tax update from the provided files as a queued JSRPC job
1453 after wiping the existing wipable tax data.
1454
1455 =cut
1456
1457 sub process_batch_reload {
1458   _process_reload('_perform_batch_import', @_);
1459 }
1460
1461   
1462 sub _process_reload {
1463   my ( $method, $job ) = ( shift, shift );
1464
1465   my $param = thaw(decode_base64($_[0]));
1466   my $format = $param->{'format'};        #well... this is all cch specific
1467
1468   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1469
1470   if ( $job ) {  # progress bar
1471     my $error = $job->update_statustext( 0 );
1472     die $error if $error;
1473   }
1474
1475   my $oldAutoCommit = $FS::UID::AutoCommit;
1476   local $FS::UID::AutoCommit = 0;
1477   my $dbh = dbh;
1478   my $error = '';
1479
1480   my $sql =
1481     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1482     "USING (taxclassnum) WHERE data_vendor = '$format'";
1483   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1484   $sth->execute
1485     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1486   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1487     if $sth->fetchrow_arrayref->[0];
1488
1489   # really should get a table EXCLUSIVE lock here
1490
1491   #remember disabled taxes
1492   my %disabled_tax_rate = ();
1493   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1494
1495   #remember tax products
1496   my %taxproduct = ();
1497   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1498
1499   #wipe out the old data
1500   $error ||= _remove_old_tax_data( $job, $format ); 
1501
1502   #import new data
1503   unless ($error) {
1504     my $args = '$job, @_';
1505     eval "$method($args);";
1506     $error = $@ if $@;
1507   }
1508
1509   #restore taxproducts
1510   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1511
1512   #disable tax_rates
1513   $error ||=
1514    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1515
1516   if ($error) {
1517     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1518     die $error;
1519   }
1520
1521   #success!
1522   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1523 }
1524
1525
1526 =item process_download_and_update
1527
1528 Download and process a tax update as a queued JSRPC job
1529
1530 =cut
1531
1532 sub process_download_and_update {
1533   my $job = shift;
1534
1535   my $param = thaw(decode_base64(shift));
1536   my $format = $param->{'format'};        #well... this is all cch specific
1537
1538   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1539
1540   if ( $job ) {  # progress bar
1541     my $error = $job->update_statustext( 0);
1542     die $error if $error;
1543   }
1544
1545   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/taxdata';
1546   unless (-d $dir) {
1547     mkdir $dir or die "can't create $dir: $!\n";
1548   }
1549
1550   if ($format eq 'cch') {
1551
1552     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1553
1554     my $conf = new FS::Conf;
1555     die "direct download of tax data not enabled\n" 
1556       unless $conf->exists('taxdatadirectdownload');
1557     my ( $urls, $username, $secret, $states ) =
1558       $conf->config('taxdatadirectdownload');
1559     die "No tax download URL provided.  ".
1560         "Did you set the taxdatadirectdownload configuration value?\n"
1561       unless $urls;
1562
1563     $dir .= '/cch';
1564
1565     my $dbh = dbh;
1566     my $error = '';
1567
1568     # really should get a table EXCLUSIVE lock here
1569     # check if initial import or update
1570     #
1571     # relying on mkdir "$dir.new" as a mutex
1572     
1573     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1574     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1575     $sth->execute() or die $sth->errstr;
1576     my $update = $sth->fetchrow_arrayref->[0];
1577
1578     # create cache and/or rotate old tax data
1579
1580     if (-d $dir) {
1581
1582       if (-d "$dir.4") {
1583         opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1584         foreach my $file (readdir($dirh)) {
1585           unlink "$dir.4/$file" if (-f "$dir.4/$file");
1586         }
1587         closedir($dirh);
1588         rmdir "$dir.4";
1589       }
1590
1591       for (3, 2, 1) {
1592         if ( -e "$dir.$_" ) {
1593           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1594         }
1595       }
1596       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1597
1598     } else {
1599
1600       die "can't find previous tax data\n" if $update;
1601
1602     }
1603
1604     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1605     
1606     # fetch and unpack the zip files
1607
1608     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1609  
1610     # extract csv files from the dbf files
1611
1612     foreach my $name ( @namelist ) {
1613       cch_extract_csv_from_dbf( $job, $dir, $name ); 
1614     }
1615
1616     # generate the diff files
1617
1618     my @list = ();
1619     foreach my $name ( @namelist ) {
1620       my $error = $job->update_statustext( "0,Comparing to previous $name" );
1621       die $error if $error;
1622       warn "processing $dir.new/$name.txt\n" if $DEBUG;
1623       my $olddir = $update ? "$dir.1" : "";
1624       my $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1625       push @list, "$name:$difffile";
1626     }
1627
1628     # perform the import
1629     local $keep_cch_files = 1;
1630     $param->{uploaded_files} = join( ',', @list );
1631     $param->{format} .= '-update' if $update;
1632     $error ||=
1633       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1634     
1635     rename "$dir.new", "$dir"
1636       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1637
1638   }else{
1639     die "Unknown format: $format";
1640   }
1641 }
1642
1643 =item browse_queries PARAMS
1644
1645 Returns a list consisting of a hashref suited for use as the argument
1646 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1647 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1648 from a form.  This conveniently creates the query hashref and count_query
1649 string required by the browse and search elements.  As a side effect, 
1650 the PARAMS hashref is untainted and keys with unexpected values are removed.
1651
1652 =cut
1653
1654 sub browse_queries {
1655   my $params = shift;
1656
1657   my $query = {
1658                 'table'     => 'tax_rate',
1659                 'hashref'   => {},
1660                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1661               },
1662
1663   my $extra_sql = '';
1664
1665   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1666     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1667   } else {
1668     delete $params->{data_vendor};
1669   }
1670    
1671   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1672     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1673                     'geocode LIKE '. dbh->quote($1.'%');
1674   } else {
1675     delete $params->{geocode};
1676   }
1677
1678   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1679        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1680      )
1681   {
1682     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1683                   ' taxclassnum  = '. dbh->quote($1)
1684   } else {
1685     delete $params->{taxclassnun};
1686   }
1687
1688   my $tax_type = $1
1689     if ( $params->{tax_type} =~ /^(\d+)$/ );
1690   delete $params->{tax_type}
1691     unless $tax_type;
1692
1693   my $tax_cat = $1
1694     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1695   delete $params->{tax_cat}
1696     unless $tax_cat;
1697
1698   my @taxclassnum = ();
1699   if ($tax_type || $tax_cat ) {
1700     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1701     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1702     @taxclassnum = map { $_->taxclassnum } 
1703                    qsearch({ 'table'     => 'tax_class',
1704                              'hashref'   => {},
1705                              'extra_sql' => "WHERE taxclass $compare",
1706                           });
1707   }
1708
1709   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1710                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1711     if ( @taxclassnum );
1712
1713   unless ($params->{'showdisabled'}) {
1714     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1715                   "( disabled = '' OR disabled IS NULL )";
1716   }
1717
1718   $query->{extra_sql} = $extra_sql;
1719
1720   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1721 }
1722
1723 # _upgrade_data
1724 #
1725 # Used by FS::Upgrade to migrate to a new database.
1726 #
1727 #
1728
1729 sub _upgrade_data {  # class method
1730   my ($self, %opts) = @_;
1731   my $dbh = dbh;
1732
1733   warn "$me upgrading $self\n" if $DEBUG;
1734
1735   my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1736                     feebase feemax );
1737
1738   if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1739
1740     eval "use DBI::Const::GetInfoType;";
1741     die $@ if $@;
1742
1743     my $major_version = 0;
1744     $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1745       && ( $major_version = sprintf("%d", $1) );
1746
1747     if ( $major_version > 7 ) {
1748
1749       # ideally this would be supported in DBIx-DBSchema and friends
1750
1751       foreach my $column ( @column ) {
1752         my $columndef = dbdef->table($self->table)->column($column);
1753         unless ($columndef->type eq 'numeric') {
1754
1755           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1756           my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1757           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1758           $sth->execute or die $sth->errstr;
1759
1760           warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1761           $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1762           $sth = $dbh->prepare($sql) or die $dbh->errstr;
1763           $sth->execute or die $sth->errstr;
1764
1765         }
1766       }
1767
1768     } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1769
1770       # ideally this would be supported in DBIx-DBSchema and friends
1771
1772       foreach my $column ( @column ) {
1773         my $columndef = dbdef->table($self->table)->column($column);
1774         unless ($columndef->type eq 'numeric') {
1775
1776           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1777
1778           foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1779
1780             my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1781             my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1782             $sth->execute or die $sth->errstr;
1783
1784             my $def = dbdef->table($table)->column($column);
1785             $def->type('numeric');
1786             $def->length('14,8'); 
1787             my $null = $def->null;
1788             $def->null('NULL');
1789
1790             $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1791             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1792             $sth->execute or die $sth->errstr;
1793
1794             $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1795             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1796             $sth->execute or die $sth->errstr;
1797
1798             unless ( $null eq 'NULL' ) {
1799               $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1800               $sth = $dbh->prepare($sql) or die $dbh->errstr;
1801               $sth->execute or die $sth->errstr;
1802             }
1803
1804             $sql = "ALTER TABLE $table DROP old_$column";
1805             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1806             $sth->execute or die $sth->errstr;
1807
1808           }
1809         }
1810       }
1811
1812     } else {
1813
1814       warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1815
1816     }
1817
1818   } else {
1819
1820     warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1821
1822   }
1823
1824   '';
1825
1826 }
1827
1828 =back
1829
1830 =head1 BUGS
1831
1832   Mixing automatic and manual editing works poorly at present.
1833
1834 =head1 SEE ALSO
1835
1836 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
1837 documentation.
1838
1839 =cut
1840
1841 1;
1842