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