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