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