correct bugs in tax replacement routine and allow updates to function
[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 $conffile = '%%%FREESIDE_CONF%%%/cchconf';
1402     my $conffh = new IO::File "<$conffile" or die "can't open $conffile: $!\n";
1403     my ( $urls, $secret, $states ) =
1404       map { /^(.*)$/ or die "bad config line in $conffile: $_\n"; $1 }
1405           <$conffh>;
1406
1407     $dir .= '/cch';
1408
1409     my $oldAutoCommit = $FS::UID::AutoCommit;
1410     local $FS::UID::AutoCommit = 0;
1411     my $dbh = dbh;
1412     my $error = '';
1413
1414     # really should get a table EXCLUSIVE lock here
1415     # check if initial import or update
1416     
1417     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1418     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1419     $sth->execute() or die $sth->errstr;
1420     my $upgrade = $sth->fetchrow_arrayref->[0];
1421
1422     # create cache and/or rotate old tax data
1423
1424     if (-d $dir) {
1425
1426       if (-d "$dir.4") {
1427         opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1428         foreach my $file (readdir($dirh)) {
1429           unlink "$dir.4/$file" if (-f "$dir.4/$file");
1430         }
1431         closedir($dirh);
1432         rmdir "$dir.4";
1433       }
1434
1435       for (3, 2, 1) {
1436         if ( -e "$dir.$_" ) {
1437           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1438         }
1439       }
1440       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1441
1442     } else {
1443
1444       die "can't find previous tax data\n" if $upgrade;
1445
1446     }
1447
1448     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1449     
1450     # fetch and unpack the zip files
1451
1452     my $ua = new LWP::UserAgent;
1453     foreach my $url (split ',', $urls) {
1454       my @name = split '/', $url;  #somewhat restrictive
1455       my $name = pop @name;
1456       $name =~ /(.*)/; # untaint that which we trust;
1457       $name = $1;
1458       
1459       open my $taxfh, ">$dir.new/$name" or die "Can't open $dir.new/$name: $!\n";
1460      
1461       my $res = $ua->request(
1462         new HTTP::Request( GET => $url),
1463         sub { #my ($data, $response_object) = @_;
1464               print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n";
1465               my $content_length = $_[1]->content_length;
1466               $imported += length($_[0]);
1467               if ( time - $min_sec > $last ) {
1468                 my $error = $job->update_statustext(
1469                   ($content_length ? int(100 * $imported/$content_length) : 0 ).
1470                   ",Downloading data from CCH"
1471                 );
1472                 die $error if $error;
1473                 $last = time;
1474               }
1475         },
1476       );
1477       die "download of $url failed: ". $res->status_line
1478         unless $res->is_success;
1479       
1480       close $taxfh;
1481       my $error = $job->update_statustext( "0,Unpacking data" );
1482       die $error if $error;
1483       $secret =~ /(.*)/; # untaint that which we trust;
1484       $secret = $1;
1485       system('unzip', "-P", $secret, "-d", "$dir.new",  "$dir.new/$name") == 0
1486         or die "unzip -P $secret -d $dir.new $dir.new/$name failed";
1487       #unlink "$dir.new/$name";
1488     }
1489  
1490     # extract csv files from the dbf files
1491
1492     foreach my $name ( qw( code detail geocode plus4 txmatrix zip ) ) {
1493       my $error = $job->update_statustext( "0,Unpacking $name" );
1494       die $error if $error;
1495       warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1496       my $table = new XBase 'name' => "$dir.new/$name.dbf";
1497       die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1498         unless defined($table);
1499       $count = $table->last_record; # approximately;
1500       $imported = 0;
1501       open my $csvfh, ">$dir.new/$name.txt"
1502         or die "failed to open $dir.new/$name.txt: $!\n";
1503
1504       my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1505       my @fields = $table->field_names;
1506       my $cursor = $table->prepare_select;
1507       my $format_date =
1508         sub { my $date = shift;
1509               $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1510               $date;
1511             };
1512       while (my $row = $cursor->fetch_hashref) {
1513         $csv->combine( map { ($table->field_type($_) eq 'D')
1514                              ? &{$format_date}($row->{$_}) 
1515                              : $row->{$_}
1516                            }
1517                        @fields
1518         );
1519         print $csvfh $csv->string, "\n";
1520         $imported++;
1521         if ( time - $min_sec > $last ) {
1522           my $error = $job->update_statustext(
1523             int(100 * $imported/$count).  ",Unpacking $name"
1524           );
1525           die $error if $error;
1526           $last = time;
1527         }
1528       }
1529       $table->close;
1530       close $csvfh;
1531     }
1532
1533     # generate the diff files
1534
1535     my @insert_list = ();
1536     my @delete_list = ();
1537     my @predelete_list = ();
1538
1539     my @list = (
1540                  'geocode',  \&FS::tax_rate_location::batch_import, 
1541                  'code',     \&FS::tax_class::batch_import,
1542                  'plus4',    \&FS::cust_tax_location::batch_import,
1543                  'zip',      \&FS::cust_tax_location::batch_import,
1544                  'txmatrix', \&FS::part_pkg_taxrate::batch_import,
1545                  'detail',   \&FS::tax_rate::batch_import,
1546                );
1547
1548     while( scalar(@list) ) {
1549       my ( $name, $method ) = ( shift @list, shift @list );
1550       my %oldlines = ();
1551
1552       my $error = $job->update_statustext( "0,Comparing to previous $name" );
1553       die $error if $error;
1554
1555       warn "processing $dir.new/$name.txt\n" if $DEBUG;
1556
1557       if ($upgrade) {
1558         open my $oldcsvfh, "$dir.1/$name.txt"
1559           or die "failed to open $dir.1/$name.txt: $!\n";
1560
1561         while(<$oldcsvfh>) {
1562           chomp;
1563           $oldlines{$_} = 1;
1564         }
1565         close $oldcsvfh;
1566       }
1567
1568       open my $newcsvfh, "$dir.new/$name.txt"
1569         or die "failed to open $dir.new/$name.txt: $!\n";
1570     
1571       my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1572                                 DIR      => "$dir.new",
1573                                 UNLINK   => 0,     #meh
1574                               ) or die "can't open temp file: $!\n";
1575
1576       my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1577                                 DIR      => "$dir.new",
1578                                 UNLINK   => 0,     #meh
1579                               ) or die "can't open temp file: $!\n";
1580
1581       while(<$newcsvfh>) {
1582         chomp;
1583         if (exists($oldlines{$_})) {
1584           $oldlines{$_} = 0;
1585         } else {
1586           print $ifh $_, ',"I"', "\n";
1587         }
1588       }
1589       close $newcsvfh;
1590
1591       if ($name eq 'detail') {
1592         for (keys %oldlines) {  # one file for rate details
1593           print $ifh $_, ',"D"', "\n" if $oldlines{$_};
1594         }
1595       } else {
1596         for (keys %oldlines) {
1597           print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1598         }
1599       }
1600       %oldlines = ();
1601
1602       push @insert_list, $name, $ifh->filename, $method;
1603       if ( $name eq 'geocode' ) {
1604         unshift @predelete_list, $name, $dfh->filename, $method
1605           unless $name eq 'detail';
1606       } else {
1607         unshift @delete_list, $name, $dfh->filename, $method
1608           unless $name eq 'detail';
1609       }
1610
1611       close $dfh;
1612       close $ifh;
1613     }
1614
1615     while( scalar(@predelete_list) ) {
1616       my ($name, $file, $method) =
1617         (shift @predelete_list, shift @predelete_list, shift @predelete_list);
1618
1619       my $fmt = "$format-update";
1620       $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1621       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1622       $error ||=
1623         &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1624       close $fh;
1625       #unlink $file or warn "Can't delete $file: $!";
1626     }
1627
1628     while( scalar(@insert_list) ) {
1629       my ($name, $file, $method) =
1630         (shift @insert_list, shift @insert_list, shift @insert_list);
1631
1632       my $fmt = "$format-update";
1633       $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1634       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1635       $error ||=
1636         &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1637       close $fh;
1638       #unlink $file or warn "Can't delete $file: $!";
1639     }
1640     
1641     while( scalar(@delete_list) ) {
1642       my ($name, $file, $method) =
1643         (shift @delete_list, shift @delete_list, shift @delete_list);
1644
1645       my $fmt = "$format-update";
1646       $fmt = $fmt. ( $name eq 'zip' ? '-zip' : '' );
1647       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1648       $error ||=
1649         &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1650       close $fh;
1651       #unlink $file or warn "Can't delete $file: $!";
1652     }
1653     
1654     if ($error) {
1655       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1656       die $error;
1657     }else{
1658       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1659     }
1660
1661     rename "$dir.new", "$dir"
1662       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1663
1664   }else{
1665     die "Unknown format: $format";
1666   }
1667 }
1668
1669 =item browse_queries PARAMS
1670
1671 Returns a list consisting of a hashref suited for use as the argument
1672 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1673 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1674 from a form.  This conveniently creates the query hashref and count_query
1675 string required by the browse and search elements.  As a side effect, 
1676 the PARAMS hashref is untainted and keys with unexpected values are removed.
1677
1678 =cut
1679
1680 sub browse_queries {
1681   my $params = shift;
1682
1683   my $query = {
1684                 'table'     => 'tax_rate',
1685                 'hashref'   => {},
1686                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1687               },
1688
1689   my $extra_sql = '';
1690
1691   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1692     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1693   } else {
1694     delete $params->{data_vendor};
1695   }
1696    
1697   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1698     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1699                     'geocode LIKE '. dbh->quote($1.'%');
1700   } else {
1701     delete $params->{geocode};
1702   }
1703
1704   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1705        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1706      )
1707   {
1708     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1709                   ' taxclassnum  = '. dbh->quote($1)
1710   } else {
1711     delete $params->{taxclassnun};
1712   }
1713
1714   my $tax_type = $1
1715     if ( $params->{tax_type} =~ /^(\d+)$/ );
1716   delete $params->{tax_type}
1717     unless $tax_type;
1718
1719   my $tax_cat = $1
1720     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1721   delete $params->{tax_cat}
1722     unless $tax_cat;
1723
1724   my @taxclassnum = ();
1725   if ($tax_type || $tax_cat ) {
1726     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1727     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1728     @taxclassnum = map { $_->taxclassnum } 
1729                    qsearch({ 'table'     => 'tax_class',
1730                              'hashref'   => {},
1731                              'extra_sql' => "WHERE taxclass $compare",
1732                           });
1733   }
1734
1735   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1736                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1737     if ( @taxclassnum );
1738
1739   unless ($params->{'showdisabled'}) {
1740     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1741                   "( disabled = '' OR disabled IS NULL )";
1742   }
1743
1744   $query->{extra_sql} = $extra_sql;
1745
1746   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1747 }
1748
1749 # _upgrade_data
1750 #
1751 # Used by FS::Upgrade to migrate to a new database.
1752 #
1753 #
1754
1755 sub _upgrade_data {  # class method
1756   my ($self, %opts) = @_;
1757   my $dbh = dbh;
1758
1759   warn "$me upgrading $self\n" if $DEBUG;
1760
1761   my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1762                     feebase feemax );
1763
1764   if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1765
1766     eval "use DBI::Const::GetInfoType;";
1767     die $@ if $@;
1768
1769     my $major_version = 0;
1770     $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1771       && ( $major_version = sprintf("%d", $1) );
1772
1773     if ( $major_version > 7 ) {
1774
1775       # ideally this would be supported in DBIx-DBSchema and friends
1776
1777       foreach my $column ( @column ) {
1778         my $columndef = dbdef->table($self->table)->column($column);
1779         unless ($columndef->type eq 'numeric') {
1780
1781           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1782           my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1783           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1784           $sth->execute or die $sth->errstr;
1785
1786           warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1787           $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1788           $sth = $dbh->prepare($sql) or die $dbh->errstr;
1789           $sth->execute or die $sth->errstr;
1790
1791         }
1792       }
1793
1794     } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {
1795
1796       # ideally this would be supported in DBIx-DBSchema and friends
1797
1798       foreach my $column ( @column ) {
1799         my $columndef = dbdef->table($self->table)->column($column);
1800         unless ($columndef->type eq 'numeric') {
1801
1802           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1803
1804           foreach my $table ( qw( tax_rate h_tax_rate ) ) {
1805
1806             my $sql = "ALTER TABLE $table RENAME $column TO old_$column";
1807             my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1808             $sth->execute or die $sth->errstr;
1809
1810             my $def = dbdef->table($table)->column($column);
1811             $def->type('numeric');
1812             $def->length('14,8'); 
1813             my $null = $def->null;
1814             $def->null('NULL');
1815
1816             $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
1817             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1818             $sth->execute or die $sth->errstr;
1819
1820             $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )";
1821             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1822             $sth->execute or die $sth->errstr;
1823
1824             unless ( $null eq 'NULL' ) {
1825               $sql = "ALTER TABLE $table ALTER $column SET NOT NULL";
1826               $sth = $dbh->prepare($sql) or die $dbh->errstr;
1827               $sth->execute or die $sth->errstr;
1828             }
1829
1830             $sql = "ALTER TABLE $table DROP old_$column";
1831             $sth = $dbh->prepare($sql) or die $dbh->errstr;
1832             $sth->execute or die $sth->errstr;
1833
1834           }
1835         }
1836       }
1837
1838     } else {
1839
1840       warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1841
1842     }
1843
1844   } else {
1845
1846     warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1847
1848   }
1849
1850   '';
1851
1852 }
1853
1854 =back
1855
1856 =head1 BUGS
1857
1858   Mixing automatic and manual editing works poorly at present.
1859
1860 =head1 SEE ALSO
1861
1862 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
1863 documentation.
1864
1865 =cut
1866
1867 1;
1868