50279172df02e2aedd9c9093852dd735659ceb3a
[freeside.git] / FS / FS / tax_rate.pm
1 package FS::tax_rate;
2 use base qw( FS::Record );
3
4 use strict;
5 use vars qw( $DEBUG $me
6              %tax_unittypes %tax_maxtypes %tax_basetypes %tax_authorities
7              %tax_passtypes %GetInfoType $keep_cch_files );
8 use Date::Parse;
9 use DateTime;
10 use DateTime::Format::Strptime;
11 use Storable qw( thaw nfreeze );
12 use IO::File;
13 use File::Temp;
14 use Text::CSV_XS;
15 use URI::Escape;
16 use LWP::UserAgent;
17 use HTTP::Request;
18 use HTTP::Response;
19 use MIME::Base64;
20 use DBIx::DBSchema;
21 use DBIx::DBSchema::Table;
22 use DBIx::DBSchema::Column;
23 use FS::Record qw( qsearch qsearchs dbh dbdef );
24 use FS::Conf;
25 use FS::tax_class;
26 use FS::cust_bill_pkg;
27 use FS::cust_tax_location;
28 use FS::tax_rate_location;
29 use FS::part_pkg_taxrate;
30 use FS::part_pkg_taxproduct;
31 use FS::cust_main;
32 use FS::Misc qw( csv_from_fixed );
33
34 $DEBUG = 0;
35 $me = '[FS::tax_rate]';
36 $keep_cch_files = 0;
37
38 =head1 NAME
39
40 FS::tax_rate - Object methods for tax_rate objects
41
42 =head1 SYNOPSIS
43
44   use FS::tax_rate;
45
46   $record = new FS::tax_rate \%hash;
47   $record = new FS::tax_rate { 'column' => 'value' };
48
49   $error = $record->insert;
50
51   $error = $new_record->replace($old_record);
52
53   $error = $record->delete;
54
55   $error = $record->check;
56
57 =head1 DESCRIPTION
58
59 An FS::tax_rate object represents a tax rate, defined by locale.
60 FS::tax_rate inherits from FS::Record.  The following fields are
61 currently supported:
62
63 =over 4
64
65 =item taxnum
66
67 primary key (assigned automatically for new tax rates)
68
69 =item geocode
70
71 a geographic location code provided by a tax data vendor
72
73 =item data_vendor
74
75 the tax data vendor
76
77 =item location
78
79 a location code provided by a tax authority
80
81 =item taxclassnum
82
83 a foreign key into FS::tax_class - the type of tax
84 referenced but FS::part_pkg_taxrate
85 eitem effective_date
86
87 the time after which the tax applies
88
89 =item tax
90
91 percentage
92
93 =item excessrate
94
95 second bracket percentage 
96
97 =item taxbase
98
99 the amount to which the tax applies (first bracket)
100
101 =item taxmax
102
103 a cap on the amount of tax if a cap exists
104
105 =item usetax
106
107 percentage on out of jurisdiction purchases
108
109 =item useexcessrate
110
111 second bracket percentage on out of jurisdiction purchases
112
113 =item unittype
114
115 one of the values in %tax_unittypes
116
117 =item fee
118
119 amount of tax per unit
120
121 =item excessfee
122
123 second bracket amount of tax per unit
124
125 =item feebase
126
127 the number of units to which the fee applies (first bracket)
128
129 =item feemax
130
131 the most units to which fees apply (first and second brackets)
132
133 =item maxtype
134
135 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
136
137 =item taxname
138
139 if defined, printed on invoices instead of "Tax"
140
141 =item taxauth
142
143 a value from %tax_authorities
144
145 =item basetype
146
147 a value from %tax_basetypes indicating the tax basis
148
149 =item passtype
150
151 a value from %tax_passtypes indicating how the tax should displayed to the customer
152
153 =item passflag
154
155 'Y', 'N', or blank indicating the tax can be passed to the customer
156
157 =item setuptax
158
159 if 'Y', this tax does not apply to setup fees
160
161 =item recurtax
162
163 if 'Y', this tax does not apply to recurring fees
164
165 =item manual
166
167 if 'Y', has been manually edited
168
169 =back
170
171 =head1 METHODS
172
173 =over 4
174
175 =item new HASHREF
176
177 Creates a new tax rate.  To add the tax rate to the database, see L<"insert">.
178
179 =cut
180
181 sub table { 'tax_rate'; }
182
183 =item insert
184
185 Adds this tax rate to the database.  If there is an error, returns the error,
186 otherwise returns false.
187
188 =item delete
189
190 Deletes this tax rate from the database.  If there is an error, returns the
191 error, otherwise returns false.
192
193 =item replace OLD_RECORD
194
195 Replaces the OLD_RECORD with this one in the database.  If there is an error,
196 returns the error, otherwise returns false.
197
198 =item check
199
200 Checks all fields to make sure this is a valid tax rate.  If there is an error,
201 returns the error, otherwise returns false.  Called by the insert and replace
202 methods.
203
204 =cut
205
206 sub check {
207   my $self = shift;
208
209   foreach (qw( taxbase taxmax )) {
210     $self->$_(0) unless $self->$_;
211   }
212
213   $self->ut_numbern('taxnum')
214     || $self->ut_text('geocode')
215     || $self->ut_textn('data_vendor')
216     || $self->ut_cch_textn('location')
217     || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
218     || $self->ut_snumbern('effective_date')
219     || $self->ut_float('tax')
220     || $self->ut_floatn('excessrate')
221     || $self->ut_money('taxbase')
222     || $self->ut_money('taxmax')
223     || $self->ut_floatn('usetax')
224     || $self->ut_floatn('useexcessrate')
225     || $self->ut_numbern('unittype')
226     || $self->ut_floatn('fee')
227     || $self->ut_floatn('excessfee')
228     || $self->ut_floatn('feemax')
229     || $self->ut_numbern('maxtype')
230     || $self->ut_textn('taxname')
231     || $self->ut_numbern('taxauth')
232     || $self->ut_numbern('basetype')
233     || $self->ut_numbern('passtype')
234     || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
235     || $self->ut_enum('setuptax', [ '', 'Y' ] )
236     || $self->ut_enum('recurtax', [ '', 'Y' ] )
237     || $self->ut_enum('inoutcity', [ '', 'I', 'O' ] )
238     || $self->ut_enum('inoutlocal', [ '', 'I', 'O' ] )
239     || $self->ut_enum('manual', [ '', 'Y' ] )
240     || $self->ut_enum('disabled', [ '', 'Y' ] )
241     || $self->SUPER::check
242     ;
243
244 }
245
246 #ut_text / ut_textn w/ ` added cause now that's in the data
247 sub ut_cch_textn {
248   my($self,$field)=@_;
249   $self->getfield($field)
250     =~ /^([\wô \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\`]*)$/
251       or return gettext('illegal_or_empty_text'). " $field: ".
252                  $self->getfield($field);
253   $self->setfield($field,$1);
254   '';
255
256 }
257
258 =item taxclass_description
259
260 Returns the human understandable value associated with the related
261 FS::tax_class.
262
263 =cut
264
265 sub taxclass_description {
266   my $self = shift;
267   my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
268   $tax_class ? $tax_class->description : '';
269 }
270
271 =item unittype_name
272
273 Returns the human understandable value associated with the unittype column
274
275 =cut
276
277 %tax_unittypes = ( '0' => 'access line',
278                    '1' => 'minute',
279                    '2' => 'account',
280 );
281
282 sub unittype_name {
283   my $self = shift;
284   $tax_unittypes{$self->unittype};
285 }
286
287 =item maxtype_name
288
289 Returns the human understandable value associated with the maxtype column.
290
291 =cut
292
293 # XXX these are non-functional, and most of them are horrible to implement
294 # in our current model
295
296 %tax_maxtypes = ( '0' => 'receipts per invoice',
297                   '1' => 'receipts per item',
298                   '2' => 'total utility charges per utility tax year',
299                   '3' => 'total charges per utility tax year',
300                   '4' => 'receipts per access line',
301                   '7' => 'total utility charges per calendar year',
302                   '9' => 'monthly receipts per location',
303                   '10' => 'monthly receipts exceeds taxbase and total tax per month does not exceed maxtax', # wtf?
304                   '11' => 'receipts/units per access line',
305                   '14' => 'units per invoice',
306                   '15' => 'units per month',
307                   '18' => 'units per account',
308 );
309
310 sub maxtype_name {
311   my $self = shift;
312   $tax_maxtypes{$self->maxtype};
313 }
314
315 =item basetype_name
316
317 Returns the human understandable value associated with the basetype column
318
319 =cut
320
321 %tax_basetypes = ( '0'  => 'sale price',
322                    '1'  => 'gross receipts',
323                    '2'  => 'sales taxable telecom revenue',
324                    '3'  => 'minutes carried',
325                    '4'  => 'minutes billed',
326                    '5'  => 'gross operating revenue',
327                    '6'  => 'access line',
328                    '7'  => 'account',
329                    '8'  => 'gross revenue',
330                    '9'  => 'portion gross receipts attributable to interstate service',
331                    '10' => 'access line',
332                    '11' => 'gross profits',
333                    '12' => 'tariff rate',
334                    '14' => 'account',
335                    '15' => 'prior year gross receipts',
336 );
337
338 sub basetype_name {
339   my $self = shift;
340   $tax_basetypes{$self->basetype};
341 }
342
343 =item taxauth_name
344
345 Returns the human understandable value associated with the taxauth column
346
347 =cut
348
349 %tax_authorities = ( '0' => 'federal',
350                      '1' => 'state',
351                      '2' => 'county',
352                      '3' => 'city',
353                      '4' => 'local',
354                      '5' => 'county administered by state',
355                      '6' => 'city administered by state',
356                      '7' => 'city administered by county',
357                      '8' => 'local administered by state',
358                      '9' => 'local administered by county',
359 );
360
361 sub taxauth_name {
362   my $self = shift;
363   $tax_authorities{$self->taxauth};
364 }
365
366 =item passtype_name
367
368 Returns the human understandable value associated with the passtype column
369
370 =cut
371
372 %tax_passtypes = ( '0' => 'separate tax line',
373                    '1' => 'separate surcharge line',
374                    '2' => 'surcharge not separated',
375                    '3' => 'included in base rate',
376 );
377
378 sub passtype_name {
379   my $self = shift;
380   $tax_passtypes{$self->passtype};
381 }
382
383 =item taxline TAXABLES
384
385 Returns a listref of a name and an amount of tax calculated for the list
386 of packages/amounts referenced by TAXABLES.  If an error occurs, a message
387 is returned as a scalar.
388
389 =cut
390
391 sub taxline {
392   my $self = shift;
393   # this used to accept a hash of options but none of them did anything
394   # so it's been removed.
395
396   my $taxables;
397
398   if (ref($_[0]) eq 'ARRAY') {
399     $taxables = shift;
400   }else{
401     $taxables = [ @_ ];
402     #exemptions would be broken in this case
403   }
404
405   my $name = $self->taxname;
406   $name = 'Other surcharges'
407     if ($self->passtype == 2);
408   my $amount = 0;
409   
410   if ( $self->disabled ) { # we always know how to handle disabled taxes
411     return {
412       'name'   => $name,
413       'amount' => $amount,
414     };
415   }
416
417   my $taxable_charged = 0;
418   my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
419                       @$taxables;
420
421   warn "calculating taxes for ". $self->taxnum. " on ".
422     join (",", map { $_->pkgnum } @cust_bill_pkg)
423     if $DEBUG;
424
425   if ($self->passflag eq 'N') {
426     # return "fatal: can't (yet) handle taxes not passed to the customer";
427     # until someone needs to track these in freeside
428     return {
429       'name'   => $name,
430       'amount' => 0,
431     };
432   }
433
434   my $maxtype = $self->maxtype || 0;
435   if ($maxtype != 0 && $maxtype != 1 
436       && $maxtype != 14 && $maxtype != 15) {
437     return $self->_fatal_or_null( 'tax with "'.
438                                     $self->maxtype_name. '" threshold'
439                                 );
440   } # I don't know why, it's not like there are maxtypes that we DO support
441
442   # we treat gross revenue as gross receipts and expect the tax data
443   # to DTRT (i.e. tax on tax rules)
444   if ($self->basetype != 0 && $self->basetype != 1 &&
445       $self->basetype != 5 && $self->basetype != 6 &&
446       $self->basetype != 7 && $self->basetype != 8 &&
447       $self->basetype != 14
448   ) {
449     return
450       $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
451   }
452
453   unless ($self->setuptax =~ /^Y$/i) {
454     $taxable_charged += $_->setup foreach @cust_bill_pkg;
455   }
456   unless ($self->recurtax =~ /^Y$/i) {
457     $taxable_charged += $_->recur foreach @cust_bill_pkg;
458   }
459
460   my $taxable_units = 0;
461   unless ($self->recurtax =~ /^Y$/i) {
462
463     if (( $self->unittype || 0 ) == 0) { #access line
464       my %seen = ();
465       foreach (@cust_bill_pkg) {
466         $taxable_units += $_->units
467           unless $seen{$_->pkgnum}++;
468       }
469
470     } elsif ($self->unittype == 1) { #minute
471       return $self->_fatal_or_null( 'fee with minute unit type' );
472
473     } elsif ($self->unittype == 2) { #account
474
475       my $conf = new FS::Conf;
476       if ( $conf->exists('tax-pkg_address') ) {
477         #number of distinct locations
478         my %seen = ();
479         foreach (@cust_bill_pkg) {
480           $taxable_units++
481             unless $seen{$_->cust_pkg->locationnum}++;
482         }
483       } else {
484         $taxable_units = 1;
485       }
486
487     } else {
488       return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
489     }
490
491   }
492
493   # XXX handle excessrate (use_excessrate) / excessfee /
494   #            taxbase/feebase / taxmax/feemax
495   #            and eventually exemptions
496   #
497   # the tax or fee is applied to taxbase or feebase and then
498   # the excessrate or excess fee is applied to taxmax or feemax
499
500   if ( ($self->taxmax > 0 and $taxable_charged > $self->taxmax) or
501        ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
502     # throw an error
503     # (why not just cap taxable_charged/units at the taxmax/feemax? because
504     # it's way more complicated than that. this won't even catch every case
505     # where a bracket maximum should apply.)
506     return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
507   }
508
509   $amount += $taxable_charged * $self->tax;
510   $amount += $taxable_units * $self->fee;
511   
512   warn "calculated taxes as [ $name, $amount ]\n"
513     if $DEBUG;
514
515   return {
516     'name'   => $name,
517     'amount' => $amount,
518   };
519
520 }
521
522 sub _fatal_or_null {
523   my ($self, $error) = @_;
524
525   $DB::single = 1; # not a mistake
526
527   my $conf = new FS::Conf;
528
529   $error = "can't yet handle ". $error;
530   my $name = $self->taxname;
531   $name = 'Other surcharges'
532     if ($self->passtype == 2);
533
534   if ($conf->exists('ignore_incalculable_taxes')) {
535     warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
536     return { name => $name, amount => 0 };
537   } else {
538     return "fatal: $error";
539   }
540 }
541
542 =item tax_on_tax CUST_LOCATION
543
544 Returns a list of taxes which are candidates for taxing taxes for the
545 given service location (see L<FS::cust_location>)
546
547 =cut
548
549     #hot
550 sub tax_on_tax {
551        #akshun
552   my $self = shift;
553   my $cust_location = shift;
554
555   warn "looking up taxes on tax ". $self->taxnum. " for customer ".
556     $cust_location->custnum
557     if $DEBUG;
558
559   my $geocode = $cust_location->geocode($self->data_vendor);
560
561   # CCH oddness in m2m
562   my $dbh = dbh;
563   my $extra_sql = ' AND ('.
564     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
565                  qw(10 5 2)
566         ).
567     ')';
568
569   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
570   my $select   = 'DISTINCT ON(taxclassnum) *';
571
572   # should qsearch preface columns with the table to facilitate joins?
573   my @taxclassnums = map { $_->taxclassnum }
574     qsearch( { 'table'     => 'part_pkg_taxrate',
575                'select'    => $select,
576                'hashref'   => { 'data_vendor'      => $self->data_vendor,
577                                 'taxclassnumtaxed' => $self->taxclassnum,
578                               },
579                'extra_sql' => $extra_sql,
580                'order_by'  => $order_by,
581            } );
582
583   return () unless @taxclassnums;
584
585   $extra_sql =
586     "AND (".  join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
587
588   qsearch({ 'table'     => 'tax_rate',
589             'hashref'   => { 'geocode' => $geocode, },
590             'extra_sql' => $extra_sql,
591          })
592
593 }
594
595 =item tax_rate_location
596
597 Returns an object representing the location associated with this tax
598 (see L<FS::tax_rate_location>)
599
600 =cut
601
602 sub tax_rate_location {
603   my $self = shift;
604
605   qsearchs({ 'table'     => 'tax_rate_location',
606              'hashref'   => { 'data_vendor' => $self->data_vendor, 
607                               'geocode'     => $self->geocode,
608                               'disabled'    => '',
609                             },
610           }) ||
611   new FS::tax_rate_location;
612
613 }
614
615 =back
616
617 =head1 SUBROUTINES
618
619 =over 4
620
621 =item batch_import
622
623 =cut
624
625 sub _progressbar_foo {
626   return (0, time, 5);
627 }
628
629 sub batch_import {
630   my ($param, $job) = @_;
631
632   my $fh = $param->{filehandle};
633   my $format = $param->{'format'};
634
635   my %insert = ();
636   my %delete = ();
637
638   my @fields;
639   my $hook;
640
641   my @column_lengths = ();
642   my @column_callbacks = ();
643   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
644     $format =~ s/-fixed//;
645     my $date_format = sub { my $r='';
646                             /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
647                             $r;
648                           };
649     my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
650     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 );
651     push @column_lengths, 1 if $format eq 'cch-update';
652     push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
653     $column_callbacks[8] = $date_format;
654   }
655   
656   my $line;
657   my ( $count, $last, $min_sec ) = _progressbar_foo();
658   if ( $job || scalar(@column_callbacks) ) {
659     my $error =
660       csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
661     return $error if $error;
662   }
663   $count *=2;
664
665   if ( $format eq 'cch' || $format eq 'cch-update' ) {
666     #false laziness w/below (sub _perform_cch_diff)
667     @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
668                   excessrate effective_date taxauth taxtype taxcat taxname
669                   usetax useexcessrate fee unittype feemax maxtype passflag
670                   passtype basetype );
671     push @fields, 'actionflag' if $format eq 'cch-update';
672
673     $hook = sub {
674       my $hash = shift;
675
676       $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
677       $hash->{'data_vendor'} ='cch';
678       my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
679                                                    time_zone => 'floating',
680                                                  );
681       my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
682       $hash->{'effective_date'} = $dt ? $dt->epoch : '';
683
684       $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ; 
685       $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
686
687       my $taxclassid =
688         join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
689
690       my %tax_class = ( 'data_vendor'  => 'cch', 
691                         'taxclass' => $taxclassid,
692                       );
693
694       my $tax_class = qsearchs( 'tax_class', \%tax_class );
695       return "Error updating tax rate: no tax class $taxclassid"
696         unless $tax_class;
697
698       $hash->{'taxclassnum'} = $tax_class->taxclassnum;
699
700       foreach (qw( taxtype taxcat )) {
701         delete($hash->{$_});
702       }
703
704       my %passflagmap = ( '0' => '',
705                           '1' => 'Y',
706                           '2' => 'N',
707                         );
708       $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
709         if exists $passflagmap{$hash->{'passflag'}};
710
711       foreach (keys %$hash) {
712         $hash->{$_} = substr($hash->{$_}, 0, 80)
713           if length($hash->{$_}) > 80;
714       }
715
716       my $actionflag = delete($hash->{'actionflag'});
717
718       $hash->{'taxname'} =~ s/`/'/g; 
719       $hash->{'taxname'} =~ s|\\|/|g;
720
721       return '' if $format eq 'cch';  # but not cch-update
722
723       if ($actionflag eq 'I') {
724         $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
725       }elsif ($actionflag eq 'D') {
726         $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
727       }else{
728         return "Unexpected action flag: ". $hash->{'actionflag'};
729       }
730
731       delete($hash->{$_}) for keys %$hash;
732
733       '';
734
735     };
736
737   } elsif ( $format eq 'extended' ) {
738     die "unimplemented\n";
739     @fields = qw( );
740     $hook = sub {};
741   } else {
742     die "unknown format $format";
743   }
744
745   my $csv = new Text::CSV_XS;
746
747   my $imported = 0;
748
749   local $SIG{HUP} = 'IGNORE';
750   local $SIG{INT} = 'IGNORE';
751   local $SIG{QUIT} = 'IGNORE';
752   local $SIG{TERM} = 'IGNORE';
753   local $SIG{TSTP} = 'IGNORE';
754   local $SIG{PIPE} = 'IGNORE';
755
756   my $oldAutoCommit = $FS::UID::AutoCommit;
757   local $FS::UID::AutoCommit = 0;
758   my $dbh = dbh;
759   
760   while ( defined($line=<$fh>) ) {
761     $csv->parse($line) or do {
762       $dbh->rollback if $oldAutoCommit;
763       return "can't parse: ". $csv->error_input();
764     };
765
766     if ( $job ) {  # progress bar
767       if ( time - $min_sec > $last ) {
768         my $error = $job->update_statustext(
769           int( 100 * $imported / $count ). ",Importing tax rates"
770         );
771         if ($error) {
772           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
773           die $error;
774         }
775         $last = time;
776       }
777     }
778
779     my @columns = $csv->fields();
780
781     my %tax_rate = ( 'data_vendor' => $format );
782     foreach my $field ( @fields ) {
783       $tax_rate{$field} = shift @columns; 
784     }
785
786     if ( scalar( @columns ) ) {
787       $dbh->rollback if $oldAutoCommit;
788       return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
789     }
790
791     my $error = &{$hook}(\%tax_rate);
792     if ( $error ) {
793       $dbh->rollback if $oldAutoCommit;
794       return $error;
795     }
796
797     if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
798
799       my $tax_rate = new FS::tax_rate( \%tax_rate );
800       $error = $tax_rate->insert;
801
802       if ( $error ) {
803         $dbh->rollback if $oldAutoCommit;
804         return "can't insert tax_rate for $line: $error";
805       }
806
807     }
808
809     $imported++;
810
811   }
812
813   my @replace = grep { exists($delete{$_}) } keys %insert;
814   for (@replace) {
815     if ( $job ) {  # progress bar
816       if ( time - $min_sec > $last ) {
817         my $error = $job->update_statustext(
818           int( 100 * $imported / $count ). ",Importing tax rates"
819         );
820         if ($error) {
821           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
822           die $error;
823         }
824         $last = time;
825       }
826     }
827
828     my $old = qsearchs( 'tax_rate', $delete{$_} );
829
830     if ( $old ) {
831
832       my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
833       $new->taxnum($old->taxnum);
834       my $error = $new->replace($old);
835
836       if ( $error ) {
837         $dbh->rollback if $oldAutoCommit;
838         my $hashref = $insert{$_};
839         $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
840         return "can't replace tax_rate for $line: $error";
841       }
842
843       $imported++;
844
845     } else {
846
847       $old = delete $delete{$_};
848       warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
849         #join(" ", map { "$_ => ". $old->{$_} } @fields);
850         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
851     }
852
853     $imported++;
854   }
855
856   for (grep { !exists($delete{$_}) } keys %insert) {
857     if ( $job ) {  # progress bar
858       if ( time - $min_sec > $last ) {
859         my $error = $job->update_statustext(
860           int( 100 * $imported / $count ). ",Importing tax rates"
861         );
862         if ($error) {
863           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
864           die $error;
865         }
866         $last = time;
867       }
868     }
869
870     my $tax_rate = new FS::tax_rate( $insert{$_} );
871     my $error = $tax_rate->insert;
872
873     if ( $error ) {
874       $dbh->rollback if $oldAutoCommit;
875       my $hashref = $insert{$_};
876       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
877       return "can't insert tax_rate for $line: $error";
878     }
879
880     $imported++;
881   }
882
883   for (grep { !exists($insert{$_}) } keys %delete) {
884     if ( $job ) {  # progress bar
885       if ( time - $min_sec > $last ) {
886         my $error = $job->update_statustext(
887           int( 100 * $imported / $count ). ",Importing tax rates"
888         );
889         if ($error) {
890           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
891           die $error;
892         }
893         $last = time;
894       }
895     }
896
897     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
898     if (!$tax_rate) {
899       $dbh->rollback if $oldAutoCommit;
900       $tax_rate = $delete{$_};
901       warn "WARNING: can't find tax_rate to delete for: ".
902         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
903         " (ignoring)\n";
904     } else {
905       my $error = $tax_rate->delete; #  XXX we really should not do this
906                                      # (it orphans CBPTRL records)
907
908       if ( $error ) {
909         $dbh->rollback if $oldAutoCommit;
910         my $hashref = $delete{$_};
911         $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
912         return "can't delete tax_rate for $line: $error";
913       }
914     }
915
916     $imported++;
917   }
918
919   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
920
921   return "Empty file!" unless ($imported || $format eq 'cch-update');
922
923   ''; #no error
924
925 }
926
927 =item process_batch_import
928
929 Load a batch import as a queued JSRPC job
930
931 =cut
932
933 sub process_batch_import {
934   my $job = shift;
935
936   my $oldAutoCommit = $FS::UID::AutoCommit;
937   local $FS::UID::AutoCommit = 0;
938   my $dbh = dbh;
939
940   my $param = thaw(decode_base64(shift));
941   my $args = '$job, encode_base64( nfreeze( $param ) )';
942
943   my $method = '_perform_batch_import';
944   if ( $param->{reload} ) {
945     $method = 'process_batch_reload';
946   }
947
948   eval "$method($args);";
949   if ($@) {
950     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
951     die $@;
952   }
953
954   #success!
955   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
956 }
957
958 sub _perform_batch_import {
959   my $job = shift;
960
961   my $param = thaw(decode_base64(shift));
962   my $format = $param->{'format'};        #well... this is all cch specific
963
964   my $files = $param->{'uploaded_files'}
965     or die "No files provided.";
966
967   my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
968                 split /,/, $files;
969
970   if ( $format eq 'cch' || $format eq 'cch-fixed'
971     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
972   {
973
974     my $oldAutoCommit = $FS::UID::AutoCommit;
975     local $FS::UID::AutoCommit = 0;
976     my $dbh = dbh;
977     my $error = '';
978     my @insert_list = ();
979     my @delete_list = ();
980     my @predelete_list = ();
981     my $insertname = '';
982     my $deletename = '';
983     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
984
985     my @list = ( 'GEOCODE',  \&FS::tax_rate_location::batch_import,
986                  'CODE',     \&FS::tax_class::batch_import,
987                  'PLUS4',    \&FS::cust_tax_location::batch_import,
988                  'ZIP',      \&FS::cust_tax_location::batch_import,
989                  'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
990                  'DETAIL',   \&FS::tax_rate::batch_import,
991                );
992     while( scalar(@list) ) {
993       my ( $name, $import_sub ) = splice( @list, 0, 2 );
994       my $file = lc($name). 'file';
995
996       unless ($files{$file}) {
997         #$error = "No $name supplied";
998         next;
999       }
1000       next if $name eq 'DETAIL' && $format =~ /update/;
1001
1002       my $filename = "$dir/".  $files{$file};
1003
1004       if ( $format =~ /update/ ) {
1005
1006         ( $error, $insertname, $deletename ) =
1007           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1008           unless $error;
1009         last if $error;
1010
1011         unlink $filename or warn "Can't delete $filename: $!"
1012           unless $keep_cch_files;
1013         push @insert_list, $name, $insertname, $import_sub, $format;
1014         if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1015           unshift @predelete_list, $name, $deletename, $import_sub, $format;
1016         } else {
1017           unshift @delete_list, $name, $deletename, $import_sub, $format;
1018         }
1019
1020       } else {
1021
1022         push @insert_list, $name, $filename, $import_sub, $format;
1023
1024       }
1025
1026     }
1027
1028     push @insert_list,
1029       'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1030       if $format =~ /update/;
1031
1032     my %addl_param = ();
1033     if ( $param->{'delete_only'} ) {
1034       $addl_param{'delete_only'} = $param->{'delete_only'};
1035       @insert_list = () 
1036     }
1037
1038     $error ||= _perform_cch_tax_import( $job,
1039                                         [ @predelete_list ],
1040                                         [ @insert_list ],
1041                                         [ @delete_list ],
1042                                         \%addl_param,
1043     );
1044     
1045     
1046     @list = ( @predelete_list, @insert_list, @delete_list );
1047     while( !$keep_cch_files && scalar(@list) ) {
1048       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1049       unlink $file or warn "Can't delete $file: $!";
1050     }
1051
1052     if ($error) {
1053       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1054       die $error;
1055     }else{
1056       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1057     }
1058
1059   }else{
1060     die "Unknown format: $format";
1061   }
1062
1063 }
1064
1065
1066 sub _perform_cch_tax_import {
1067   my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1068   $addl_param ||= {};
1069
1070   my $error = '';
1071   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1072     while( scalar(@$list) ) {
1073       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1074       my $fmt = "$format-update";
1075       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1076       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1077       my $param = { 'filehandle' => $fh,
1078                     'format'     => $fmt,
1079                     %$addl_param,
1080                   };
1081       $error ||= &{$method}($param, $job);
1082       close $fh;
1083     }
1084   }
1085
1086   return $error;
1087 }
1088
1089 sub _perform_cch_insert_delete_split {
1090   my ($name, $filename, $dir, $format) = @_;
1091
1092   my $error = '';
1093
1094   open my $fh, "< $filename"
1095     or $error ||= "Can't open $name file $filename: $!";
1096
1097   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1098                             DIR      => $dir,
1099                             UNLINK   => 0,     #meh
1100                           ) or die "can't open temp file: $!\n";
1101   my $insertname = $ifh->filename;
1102
1103   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1104                             DIR      => $dir,
1105                             UNLINK   => 0,     #meh
1106                           ) or die "can't open temp file: $!\n";
1107   my $deletename = $dfh->filename;
1108
1109   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1110   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1111   while(<$fh>) {
1112     my $handle = '';
1113     $handle = $ifh if $_ =~ /$insert_pattern/;
1114     $handle = $dfh if $_ =~ /$delete_pattern/;
1115     unless ($handle) {
1116       $error = "bad input line: $_" unless $handle;
1117       last;
1118     }
1119     print $handle $_;
1120   }
1121   close $fh;
1122   close $ifh;
1123   close $dfh;
1124
1125   return ($error, $insertname, $deletename);
1126 }
1127
1128 sub _perform_cch_diff {
1129   my ($name, $newdir, $olddir) = @_;
1130
1131   my %oldlines = ();
1132
1133   if ($olddir) {
1134     open my $oldcsvfh, "$olddir/$name.txt"
1135       or die "failed to open $olddir/$name.txt: $!\n";
1136
1137     while(<$oldcsvfh>) {
1138       chomp;
1139       $oldlines{$_} = 1;
1140     }
1141     close $oldcsvfh;
1142   }
1143
1144   open my $newcsvfh, "$newdir/$name.txt"
1145     or die "failed to open $newdir/$name.txt: $!\n";
1146     
1147   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1148                             DIR      => "$newdir",
1149                             UNLINK   => 0,     #meh
1150                           ) or die "can't open temp file: $!\n";
1151   my $diffname = $dfh->filename;
1152
1153   while(<$newcsvfh>) {
1154     chomp;
1155     if (exists($oldlines{$_})) {
1156       $oldlines{$_} = 0;
1157     } else {
1158       print $dfh $_, ',"I"', "\n";
1159     }
1160   }
1161   close $newcsvfh;
1162
1163   #false laziness w/above (sub batch_import)
1164   my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1165                    excessrate effective_date taxauth taxtype taxcat taxname
1166                    usetax useexcessrate fee unittype feemax maxtype passflag
1167                    passtype basetype );
1168   my $numfields = scalar(@fields);
1169
1170   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1171
1172   for my $line (grep $oldlines{$_}, keys %oldlines) {
1173
1174     $csv->parse($line) or do {
1175       #$dbh->rollback if $oldAutoCommit;
1176       die "can't parse: ". $csv->error_input();
1177     };
1178     my @columns = $csv->fields();
1179     
1180     $csv->combine( splice(@columns, 0, $numfields) );
1181
1182     print $dfh $csv->string, ',"D"', "\n";
1183   }
1184
1185   close $dfh;
1186
1187   return $diffname;
1188 }
1189
1190 sub _cch_fetch_and_unzip {
1191   my ( $job, $urls, $secret, $dir ) = @_;
1192
1193   my $ua = new LWP::UserAgent;
1194   foreach my $url (split ',', $urls) {
1195     my @name = split '/', $url;  #somewhat restrictive
1196     my $name = pop @name;
1197     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1198     $name = $1;
1199       
1200     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1201      
1202     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1203     my $res = $ua->request(
1204       new HTTP::Request( GET => $url ),
1205       sub {
1206             print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1207             my $content_length = $_[1]->content_length;
1208             $imported += length($_[0]);
1209             if ( time - $min_sec > $last ) {
1210               my $error = $job->update_statustext(
1211                 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1212                 ",Downloading data from CCH"
1213               );
1214               die $error if $error;
1215               $last = time;
1216             }
1217       },
1218     );
1219     die "download of $url failed: ". $res->status_line
1220       unless $res->is_success;
1221       
1222     close $taxfh;
1223     my $error = $job->update_statustext( "0,Unpacking data" );
1224     die $error if $error;
1225     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1226     $secret = $1;
1227     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1228       or die "unzip -P $secret -d $dir $dir/$name failed";
1229     #unlink "$dir/$name";
1230   }
1231 }
1232  
1233 sub _cch_extract_csv_from_dbf {
1234   my ( $job, $dir, $name ) = @_;
1235
1236   eval "use XBase;";
1237   die $@ if $@;
1238
1239   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1240   my $error = $job->update_statustext( "0,Unpacking $name" );
1241   die $error if $error;
1242   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1243   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1244   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1245     unless defined($table);
1246   my $count = $table->last_record; # approximately;
1247   open my $csvfh, ">$dir.new/$name.txt"
1248     or die "failed to open $dir.new/$name.txt: $!\n";
1249
1250   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1251   my @fields = $table->field_names;
1252   my $cursor = $table->prepare_select;
1253   my $format_date =
1254     sub { my $date = shift;
1255           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1256           $date;
1257         };
1258   while (my $row = $cursor->fetch_hashref) {
1259     $csv->combine( map { my $type = $table->field_type($_);
1260                          if ($type eq 'D') {
1261                            &{$format_date}($row->{$_}) ;
1262                          } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1263                            sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1264                          } else {
1265                            $row->{$_};
1266                          }
1267                        }
1268                    @fields
1269     );
1270     print $csvfh $csv->string, "\n";
1271     $imported++;
1272     if ( time - $min_sec > $last ) {
1273       my $error = $job->update_statustext(
1274         int(100 * $imported/$count).  ",Unpacking $name"
1275       );
1276       die $error if $error;
1277       $last = time;
1278     }
1279   }
1280   $table->close;
1281   close $csvfh;
1282 }
1283
1284 sub _remember_disabled_taxes {
1285   my ( $job, $format, $disabled_tax_rate ) = @_;
1286
1287   # cch specific hash
1288
1289   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1290
1291   my @items = qsearch( { table   => 'tax_rate',
1292                          hashref => { disabled => 'Y',
1293                                       data_vendor => $format,
1294                                     },
1295                          select  => 'geocode, taxclassnum',
1296                        }
1297                      );
1298   my $count = scalar(@items);
1299   foreach my $tax_rate ( @items ) {
1300     if ( time - $min_sec > $last ) {
1301       $job->update_statustext(
1302         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1303       );
1304       $last = time;
1305     }
1306     $imported++;
1307     my $tax_class =
1308       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1309     unless ( $tax_class ) {
1310       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1311       next;
1312     }
1313     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1314   }
1315 }
1316
1317 sub _remember_tax_products {
1318   my ( $job, $format, $taxproduct ) = @_;
1319
1320   # XXX FIXME  this loop only works when cch is the only data provider
1321
1322   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1323
1324   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1325                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1326                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1327                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1328                   "       optionvalue != '' )";
1329   my @items = qsearch( { table => 'part_pkg',
1330                          select  => 'DISTINCT pkgpart,taxproductnum',
1331                          hashref => {},
1332                          extra_sql => $extra_sql,
1333                        }
1334                      );
1335   my $count = scalar(@items);
1336   foreach my $part_pkg ( @items ) {
1337     if ( time - $min_sec > $last ) {
1338       $job->update_statustext(
1339         int( 100 * $imported / $count ). ",Remembering tax products"
1340       );
1341       $last = time;
1342     }
1343     $imported++;
1344     warn "working with package part ". $part_pkg->pkgpart.
1345       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1346     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1347     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1348       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1349
1350     foreach my $option ( $part_pkg->part_pkg_option ) {
1351       next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1352       my $class = $1;
1353
1354       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1355       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1356           $part_pkg_taxproduct->taxproduct
1357         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1358     }
1359   }
1360 }
1361
1362 sub _restore_remembered_tax_products {
1363   my ( $job, $format, $taxproduct ) = @_;
1364
1365   # cch specific
1366
1367   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1368   my $count = scalar(keys %$taxproduct);
1369   foreach my $pkgpart ( keys %$taxproduct ) {
1370     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1371     if ( time - $min_sec > $last ) {
1372       $job->update_statustext(
1373         int( 100 * $imported / $count ). ",Restoring tax products"
1374       );
1375       $last = time;
1376     }
1377     $imported++;
1378
1379     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1380     unless ( $part_pkg ) {
1381       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1382     }
1383
1384     my %options = $part_pkg->options;
1385     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1386     my $primary_svc = $part_pkg->svcpart;
1387     my $new = new FS::part_pkg { $part_pkg->hash };
1388
1389     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1390       warn "working with class '$class'\n" if $DEBUG;
1391       my $part_pkg_taxproduct =
1392         qsearchs( 'part_pkg_taxproduct',
1393                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1394                     data_vendor => $format,
1395                   }
1396                 );
1397
1398       unless ( $part_pkg_taxproduct ) {
1399         return "failed to find part_pkg_taxproduct (".
1400           $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1401       }
1402
1403       if ( $class eq '' ) {
1404         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1405         next;
1406       }
1407
1408       $options{"usage_taxproductnum_$class"} =
1409         $part_pkg_taxproduct->taxproductnum;
1410
1411     }
1412
1413     my $error = $new->replace( $part_pkg,
1414                                'pkg_svc' => \%pkg_svc,
1415                                'primary_svc' => $primary_svc,
1416                                'options' => \%options,
1417     );
1418       
1419     return $error if $error;
1420
1421   }
1422
1423   '';
1424 }
1425
1426 sub _restore_remembered_disabled_taxes {
1427   my ( $job, $format, $disabled_tax_rate ) = @_;
1428
1429   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1430   my $count = scalar(keys %$disabled_tax_rate);
1431   foreach my $key (keys %$disabled_tax_rate) {
1432     if ( time - $min_sec > $last ) {
1433       $job->update_statustext(
1434         int( 100 * $imported / $count ). ",Disabling tax rates"
1435       );
1436       $last = time;
1437     }
1438     $imported++;
1439     my ($geocode,$taxclass) = split /:/, $key, 2;
1440     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1441                                             taxclass    => $taxclass,
1442                                           } );
1443     return "found multiple tax_class records for format $format class $taxclass"
1444       if scalar(@tax_class) > 1;
1445       
1446     unless (scalar(@tax_class)) {
1447       warn "no tax_class for format $format class $taxclass\n";
1448       next;
1449     }
1450
1451     my @tax_rate =
1452       qsearch('tax_rate', { data_vendor  => $format,
1453                             geocode      => $geocode,
1454                             taxclassnum  => $tax_class[0]->taxclassnum,
1455                           }
1456     );
1457
1458     if (scalar(@tax_rate) > 1) {
1459       return "found multiple tax_rate records for format $format geocode ".
1460              "$geocode and taxclass $taxclass ( taxclassnum ".
1461              $tax_class[0]->taxclassnum.  " )";
1462     }
1463       
1464     if (scalar(@tax_rate)) {
1465       $tax_rate[0]->disabled('Y');
1466       my $error = $tax_rate[0]->replace;
1467       return $error if $error;
1468     }
1469   }
1470 }
1471
1472 sub _remove_old_tax_data {
1473   my ( $job, $format ) = @_;
1474
1475   my $dbh = dbh;
1476   my $error = $job->update_statustext( "0,Removing old tax data" );
1477   die $error if $error;
1478
1479   my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1480     "WHERE data_vendor = ".  $dbh->quote($format);
1481   $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1482
1483   my @table = qw(
1484     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1485   );
1486   foreach my $table ( @table ) {
1487     $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1488       $dbh->quote($format);
1489     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1490   }
1491
1492   if ( $format eq 'cch' ) {
1493     $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1494       $dbh->quote("$format-zip");
1495     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1496   }
1497
1498   '';
1499 }
1500
1501 sub _create_temporary_tables {
1502   my ( $job, $format ) = @_;
1503
1504   my $dbh = dbh;
1505   my $error = $job->update_statustext( "0,Creating temporary tables" );
1506   die $error if $error;
1507
1508   my @table = qw( tax_rate
1509                   tax_rate_location
1510                   part_pkg_taxrate
1511                   part_pkg_taxproduct
1512                   tax_class
1513                   cust_tax_location
1514   );
1515   foreach my $table ( @table ) {
1516     my $sql =
1517       "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1518     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1519   }
1520
1521   '';
1522 }
1523
1524 sub _copy_from_temp {
1525   my ( $job, $format ) = @_;
1526
1527   my $dbh = dbh;
1528   my $error = $job->update_statustext( "0,Making permanent" );
1529   die $error if $error;
1530
1531   my @table = qw( tax_rate
1532                   tax_rate_location
1533                   part_pkg_taxrate
1534                   part_pkg_taxproduct
1535                   tax_class
1536                   cust_tax_location
1537   );
1538   foreach my $table ( @table ) {
1539     my $sql =
1540       "INSERT INTO public.$table SELECT * from $table";
1541     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1542   }
1543
1544   '';
1545 }
1546
1547 =item process_download_and_reload
1548
1549 Download and process a tax update as a queued JSRPC job after wiping the
1550 existing wipable tax data.
1551
1552 =cut
1553
1554 sub process_download_and_reload {
1555   _process_reload('process_download_and_update', @_);
1556 }
1557
1558   
1559 =item process_batch_reload
1560
1561 Load and process a tax update from the provided files as a queued JSRPC job
1562 after wiping the existing wipable tax data.
1563
1564 =cut
1565
1566 sub process_batch_reload {
1567   _process_reload('_perform_batch_import', @_);
1568 }
1569
1570   
1571 sub _process_reload {
1572   my ( $method, $job ) = ( shift, shift );
1573
1574   my $param = thaw(decode_base64($_[0]));
1575   my $format = $param->{'format'};        #well... this is all cch specific
1576
1577   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1578
1579   if ( $job ) {  # progress bar
1580     my $error = $job->update_statustext( 0 );
1581     die $error if $error;
1582   }
1583
1584   my $oldAutoCommit = $FS::UID::AutoCommit;
1585   local $FS::UID::AutoCommit = 0;
1586   my $dbh = dbh;
1587   my $error = '';
1588
1589   my $sql =
1590     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1591     "USING (taxclassnum) WHERE data_vendor = '$format'";
1592   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1593   $sth->execute
1594     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1595   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1596     if $sth->fetchrow_arrayref->[0];
1597
1598   # really should get a table EXCLUSIVE lock here
1599
1600   #remember disabled taxes
1601   my %disabled_tax_rate = ();
1602   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1603
1604   #remember tax products
1605   my %taxproduct = ();
1606   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1607
1608   #create temp tables
1609   $error ||= _create_temporary_tables( $job, $format );
1610
1611   #import new data
1612   unless ($error) {
1613     my $args = '$job, @_';
1614     eval "$method($args);";
1615     $error = $@ if $@;
1616   }
1617
1618   #restore taxproducts
1619   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1620
1621   #disable tax_rates
1622   $error ||=
1623    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1624
1625   #wipe out the old data
1626   $error ||= _remove_old_tax_data( $job, $format ); 
1627
1628   #untemporize
1629   $error ||= _copy_from_temp( $job, $format );
1630
1631   if ($error) {
1632     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1633     die $error;
1634   }
1635
1636   #success!
1637   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1638 }
1639
1640
1641 =item process_download_and_update
1642
1643 Download and process a tax update as a queued JSRPC job
1644
1645 =cut
1646
1647 sub process_download_and_update {
1648   my $job = shift;
1649
1650   my $param = thaw(decode_base64(shift));
1651   my $format = $param->{'format'};        #well... this is all cch specific
1652
1653   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1654
1655   if ( $job ) {  # progress bar
1656     my $error = $job->update_statustext( 0);
1657     die $error if $error;
1658   }
1659
1660   my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1661   my $dir = $cache_dir. 'taxdata';
1662   unless (-d $dir) {
1663     mkdir $dir or die "can't create $dir: $!\n";
1664   }
1665
1666   if ($format eq 'cch') {
1667
1668     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1669
1670     my $conf = new FS::Conf;
1671     die "direct download of tax data not enabled\n" 
1672       unless $conf->exists('taxdatadirectdownload');
1673     my ( $urls, $username, $secret, $states ) =
1674       $conf->config('taxdatadirectdownload');
1675     die "No tax download URL provided.  ".
1676         "Did you set the taxdatadirectdownload configuration value?\n"
1677       unless $urls;
1678
1679     $dir .= '/cch';
1680
1681     my $dbh = dbh;
1682     my $error = '';
1683
1684     # really should get a table EXCLUSIVE lock here
1685     # check if initial import or update
1686     #
1687     # relying on mkdir "$dir.new" as a mutex
1688     
1689     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1690     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1691     $sth->execute() or die $sth->errstr;
1692     my $update = $sth->fetchrow_arrayref->[0];
1693
1694     # create cache and/or rotate old tax data
1695
1696     if (-d $dir) {
1697
1698       if (-d "$dir.9") {
1699         opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1700         foreach my $file (readdir($dirh)) {
1701           unlink "$dir.9/$file" if (-f "$dir.9/$file");
1702         }
1703         closedir($dirh);
1704         rmdir "$dir.9";
1705       }
1706
1707       for (8, 7, 6, 5, 4, 3, 2, 1) {
1708         if ( -e "$dir.$_" ) {
1709           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1710         }
1711       }
1712       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1713
1714     } else {
1715
1716       die "can't find previous tax data\n" if $update;
1717
1718     }
1719
1720     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1721     
1722     # fetch and unpack the zip files
1723
1724     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1725  
1726     # extract csv files from the dbf files
1727
1728     foreach my $name ( @namelist ) {
1729       _cch_extract_csv_from_dbf( $job, $dir, $name ); 
1730     }
1731
1732     # generate the diff files
1733
1734     my @list = ();
1735     foreach my $name ( @namelist ) {
1736       my $difffile = "$dir.new/$name.txt";
1737       if ($update) {
1738         my $error = $job->update_statustext( "0,Comparing to previous $name" );
1739         die $error if $error;
1740         warn "processing $dir.new/$name.txt\n" if $DEBUG;
1741         my $olddir = $update ? "$dir.1" : "";
1742         $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1743       }
1744       $difffile =~ s/^$cache_dir//;
1745       push @list, "${name}file:$difffile";
1746     }
1747
1748     # perform the import
1749     local $keep_cch_files = 1;
1750     $param->{uploaded_files} = join( ',', @list );
1751     $param->{format} .= '-update' if $update;
1752     $error ||=
1753       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1754     
1755     rename "$dir.new", "$dir"
1756       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1757
1758   }else{
1759     die "Unknown format: $format";
1760   }
1761 }
1762
1763 =item browse_queries PARAMS
1764
1765 Returns a list consisting of a hashref suited for use as the argument
1766 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1767 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1768 from a form.  This conveniently creates the query hashref and count_query
1769 string required by the browse and search elements.  As a side effect, 
1770 the PARAMS hashref is untainted and keys with unexpected values are removed.
1771
1772 =cut
1773
1774 sub browse_queries {
1775   my $params = shift;
1776
1777   my $query = {
1778                 'table'     => 'tax_rate',
1779                 'hashref'   => {},
1780                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1781               },
1782
1783   my $extra_sql = '';
1784
1785   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1786     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1787   } else {
1788     delete $params->{data_vendor};
1789   }
1790    
1791   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1792     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1793                     'geocode LIKE '. dbh->quote($1.'%');
1794   } else {
1795     delete $params->{geocode};
1796   }
1797
1798   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1799        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1800      )
1801   {
1802     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1803                   ' taxclassnum  = '. dbh->quote($1)
1804   } else {
1805     delete $params->{taxclassnun};
1806   }
1807
1808   my $tax_type = $1
1809     if ( $params->{tax_type} =~ /^(\d+)$/ );
1810   delete $params->{tax_type}
1811     unless $tax_type;
1812
1813   my $tax_cat = $1
1814     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1815   delete $params->{tax_cat}
1816     unless $tax_cat;
1817
1818   my @taxclassnum = ();
1819   if ($tax_type || $tax_cat ) {
1820     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1821     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1822     @taxclassnum = map { $_->taxclassnum } 
1823                    qsearch({ 'table'     => 'tax_class',
1824                              'hashref'   => {},
1825                              'extra_sql' => "WHERE taxclass $compare",
1826                           });
1827   }
1828
1829   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1830                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1831     if ( @taxclassnum );
1832
1833   unless ($params->{'showdisabled'}) {
1834     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1835                   "( disabled = '' OR disabled IS NULL )";
1836   }
1837
1838   $query->{extra_sql} = $extra_sql;
1839
1840   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1841 }
1842
1843 =item queue_liability_report PARAMS
1844
1845 Launches a tax liability report.
1846
1847 PARAMS needs to be a base64-encoded Storable hash containing:
1848 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1849 - end: the end date of the report, likewise.
1850 - agentnum: the agent to limit the report to, if any.
1851
1852 =cut
1853
1854 sub queue_liability_report {
1855   my $job = shift;
1856   my $param = thaw(decode_base64(shift));
1857
1858   my $cgi = new CGI;
1859   $cgi->param('beginning', $param->{beginning});
1860   $cgi->param('ending', $param->{ending});
1861   my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1862   my $agentnum = $param->{agentnum};
1863   if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1864   generate_liability_report(
1865     'beginning' => $beginning,
1866     'ending'    => $ending,
1867     'agentnum'  => $agentnum,
1868     'p'         => $param->{RootURL},
1869     'job'       => $job,
1870   );
1871 }
1872
1873 =item generate_liability_report PARAMS
1874
1875 Generates a tax liability report.  PARAMS must include:
1876
1877 - beginning, as a timestamp
1878 - ending, as a timestamp
1879 - p: the Freeside root URL, for generating links
1880 - agentnum (optional)
1881
1882 =cut
1883
1884 #shit, all sorts of false laxiness w/report_newtax.cgi
1885 sub generate_liability_report {
1886   my %args = @_;
1887
1888   my ( $count, $last, $min_sec ) = _progressbar_foo();
1889
1890   #let us open the temp file early
1891   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1892   my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1893                                DIR      => $dir,
1894                                UNLINK   => 0, # not so temp
1895                              ) or die "can't open report file: $!\n";
1896
1897   my $conf = new FS::Conf;
1898   my $money_char = $conf->config('money_char') || '$';
1899
1900   my $join_cust = "
1901       JOIN cust_bill USING ( invnum ) 
1902       LEFT JOIN cust_main USING ( custnum )
1903   ";
1904
1905   my $join_loc =
1906     "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1907   my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1908
1909   my $addl_from = " $join_cust $join_loc $join_tax_loc "; 
1910
1911   my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1912
1913   my $agentname = '';
1914   if ( $args{agentnum} =~ /^(\d+)$/ ) {
1915     my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1916     die "agent not found" unless $agent;
1917     $agentname = $agent->agent;
1918     $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1919   }
1920
1921   #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1922   my @taxparams = qw( city county state locationtaxid );
1923   my @params = ('itemdesc', @taxparams);
1924
1925   my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1926
1927   #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1928   #to FS::Report or FS::Record or who the fuck knows where)
1929   my $scalar_sql = sub {
1930     my( $r, $param, $sql ) = @_;
1931     my $sth = dbh->prepare($sql) or die dbh->errstr;
1932     $sth->execute( map $r->$_(), @$param )
1933       or die "Unexpected error executing statement $sql: ". $sth->errstr;
1934     $sth->fetchrow_arrayref->[0] || 0;
1935   };
1936
1937   my $tax = 0;
1938   my $credit = 0;
1939   my %taxes = ();
1940   my %basetaxes = ();
1941   my $calculated = 0;
1942
1943   # get all distinct tuples of (tax name, state, county, city, locationtaxid)
1944   # for taxes that have been charged
1945   # (state, county, city are from tax_rate_location, not from customer data)
1946   my @tax_and_location = qsearch({ table     => 'cust_bill_pkg',
1947                                    select    => $select,
1948                                    hashref   => { pkgpart => 0 },
1949                                    addl_from => $addl_from,
1950                                    extra_sql => $where,
1951                                    debug     => 1,
1952                                 });
1953   $count = scalar(@tax_and_location);
1954   foreach my $t ( @tax_and_location ) {
1955
1956     if ( $args{job} ) {
1957       if ( time - $min_sec > $last ) {
1958         $args{job}->update_statustext( int( 100 * $calculated / $count ).
1959                                        ",Calculating"
1960                                      );
1961         $last = time;
1962       }
1963     }
1964
1965     #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1966     my $label = join('~', map { $t->$_ } @params);
1967     $label = 'Tax'. $label if $label =~ /^~/;
1968     unless ( exists( $taxes{$label} ) ) {
1969       my ($baselabel, @trash) = split /~/, $label;
1970
1971       $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1972       $taxes{$label}->{'url_param'} =
1973         join(';', map { "$_=". uri_escape($t->$_) } @params);
1974
1975       my $itemdesc_loc = 
1976       # "    payby != 'COMP' ". # breaks the entire report under 4.x
1977       #                         # and unnecessary since COMP accounts don't
1978       #                         # get taxes calculated in the first place
1979         "    ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1980         "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1981                                                          @taxparams
1982                                                    );
1983
1984       my $taxwhere =
1985         "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
1986
1987       my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1988
1989       my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1990       $tax += $x;
1991       $taxes{$label}->{'tax'} += $x;
1992
1993       my $creditfrom =
1994        "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1995       my $creditwhere =
1996         "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
1997
1998       $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1999              " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2000
2001       my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2002       $credit += $y;
2003       $taxes{$label}->{'credit'} += $y;
2004
2005       unless ( exists( $taxes{$baselabel} ) ) {
2006
2007         $basetaxes{$baselabel}->{'label'} = $baselabel;
2008         $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2009         $basetaxes{$baselabel}->{'base'} = 1;
2010
2011       }
2012
2013       $basetaxes{$baselabel}->{'tax'} += $x;
2014       $basetaxes{$baselabel}->{'credit'} += $y;
2015       
2016     }
2017
2018     # calculate customer-exemption for this tax
2019     # calculate package-exemption for this tax
2020     # calculate monthly exemption (texas tax) for this tax
2021     # count up all the cust_tax_exempt_pkg records associated with
2022     # the actual line items.
2023   }
2024
2025
2026   #ordering
2027
2028   if ( $args{job} ) {
2029     $args{job}->update_statustext( "0,Sorted" );
2030     $last = time;
2031   }
2032
2033   my @taxes = ();
2034
2035   foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2036     my ($base, @trash) = split '~', $tax;
2037     my $basetax = delete( $basetaxes{$base} );
2038     if ($basetax) {
2039       if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2040         $taxes{$tax}->{base} = 1;
2041       } else {
2042         push @taxes, $basetax;
2043       }
2044     }
2045     push @taxes, $taxes{$tax};
2046   }
2047
2048   push @taxes, {
2049     'label'          => 'Total',
2050     'url_param'      => '',
2051     'tax'            => $tax,
2052     'credit'         => $credit,
2053     'base'           => 1,
2054   };
2055
2056
2057   my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2058   $dateagentlink .= ';agentnum='. $args{agentnum}
2059     if length($agentname);
2060   my $baselink   = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2061                              $dateagentlink;
2062   my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2063
2064   print $report <<EOF;
2065   
2066     <% include("/elements/header.html", "$agentname Tax Report - ".
2067                   ( $args{beginning}
2068                       ? time2str('%h %o %Y ', $args{beginning} )
2069                       : ''
2070                   ).
2071                   'through '.
2072                   ( $args{ending} == 4294967295
2073                       ? 'now'
2074                       : time2str('%h %o %Y', $args{ending} )
2075                   )
2076               )
2077     %>
2078
2079     <% include('/elements/table-grid.html') %>
2080
2081     <TR>
2082       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2083       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2084       <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2085       <TH CLASS="grid" BGCOLOR="#cccccc">&nbsp;&nbsp;&nbsp;&nbsp;</TH>
2086       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2087       <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2088     </TR>
2089 EOF
2090
2091   my $bgcolor1 = '#eeeeee';
2092   my $bgcolor2 = '#ffffff';
2093   my $bgcolor = '';
2094  
2095   $count = scalar(@taxes);
2096   $calculated = 0;
2097   foreach my $tax ( @taxes ) {
2098  
2099     if ( $args{job} ) {
2100       if ( time - $min_sec > $last ) {
2101         $args{job}->update_statustext( int( 100 * $calculated / $count ).
2102                                        ",Generated"
2103                                      );
2104         $last = time;
2105       }
2106     }
2107
2108     if ( $bgcolor eq $bgcolor1 ) {
2109       $bgcolor = $bgcolor2;
2110     } else {
2111       $bgcolor = $bgcolor1;
2112     }
2113  
2114     my $link = '';
2115     if ( $tax->{'label'} ne 'Total' ) {
2116       $link = ';'. $tax->{'url_param'};
2117     }
2118  
2119     print $report <<EOF;
2120       <TR>
2121         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2122         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2123         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2124           <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2125         </TD>
2126         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2127         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2128         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2129         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2130           <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2131         </TD>
2132         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2133       </TR>
2134 EOF
2135   } 
2136
2137   print $report <<EOF;
2138     </TABLE>
2139
2140     </BODY>
2141     </HTML>
2142 EOF
2143
2144   my $reportname = $report->filename;
2145   close $report;
2146
2147   my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2148   $reportname =~ s/^$dropstring//;
2149
2150   my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2151   die "<a href=$reporturl>view</a>\n";
2152
2153 }
2154
2155
2156
2157 =back
2158
2159 =head1 BUGS
2160
2161   Mixing automatic and manual editing works poorly at present.
2162
2163   Tax liability calculations take too long and arguably don't belong here.
2164   Tax liability report generation not entirely safe (escaped).
2165
2166 =head1 SEE ALSO
2167
2168 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>
2169
2170 =cut
2171
2172 1;
2173