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