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   my @replace = grep { exists($delete{$_}) } keys %insert;
 789   for (@replace) {
 790     if ( $job ) {  # progress bar
 791       if ( time - $min_sec > $last ) {
 792         my $error = $job->update_statustext(
 793           int( 100 * $imported / $count ). ",Importing tax rates"
 794         );
 795         if ($error) {
 796           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 797           die $error;
 798         }
 799         $last = time;
 800       }
 801     }
 802
 803     my $old = qsearchs( 'tax_rate', $delete{$_} );
 804
 805     if ( $old ) {
 806
 807       my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
 808       $new->taxnum($old->taxnum);
 809       my $error = $new->replace($old);
 810
 811       if ( $error ) {
 812         $dbh->rollback if $oldAutoCommit;
 813         my $hashref = $insert{$_};
 814         $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 815         return "can't replace tax_rate for $line: $error";
 816       }
 817
 818       $imported++;
 819
 820     } else {
 821
 822       $old = delete $delete{$_};
 823       warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
 824         #join(" ", map { "$_ => ". $old->{$_} } @fields);
 825         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
 826     }
 827
 828     $imported++;
 829   }
 830
 831   for (grep { !exists($delete{$_}) } keys %insert) {
 832     if ( $job ) {  # progress bar
 833       if ( time - $min_sec > $last ) {
 834         my $error = $job->update_statustext(
 835           int( 100 * $imported / $count ). ",Importing tax rates"
 836         );
 837         if ($error) {
 838           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 839           die $error;
 840         }
 841         $last = time;
 842       }
 843     }
 844
 845     my $tax_rate = new FS::tax_rate( $insert{$_} );
 846     my $error = $tax_rate->insert;
 847
 848     if ( $error ) {
 849       $dbh->rollback if $oldAutoCommit;
 850       my $hashref = $insert{$_};
 851       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 852       return "can't insert tax_rate for $line: $error";
 853     }
 854
 855     $imported++;
 856   }
 857
 858   for (grep { !exists($insert{$_}) } keys %delete) {
 859     if ( $job ) {  # progress bar
 860       if ( time - $min_sec > $last ) {
 861         my $error = $job->update_statustext(
 862           int( 100 * $imported / $count ). ",Importing tax rates"
 863         );
 864         if ($error) {
 865           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 866           die $error;
 867         }
 868         $last = time;
 869       }
 870     }
 871
 872     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
 873     unless ($tax_rate) {
 874       $dbh->rollback if $oldAutoCommit;
 875       $tax_rate = $delete{$_};
 876       return "can't find tax_rate to delete for: ".
 877         #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
 878         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
 879     }
 880     my $error = $tax_rate->delete;
 881
 882     if ( $error ) {
 883       $dbh->rollback if $oldAutoCommit;
 884       my $hashref = $delete{$_};
 885       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 886       return "can't delete tax_rate for $line: $error";
 887     }
 888
 889     $imported++;
 890   }
 891
 892   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 893
 894   return "Empty file!" unless ($imported || $format eq 'cch-update');
 895
 896   ''; #no error
 897
 898 }
 899
 900 =item process_batch_import
 901
 902 Load a batch import as a queued JSRPC job
 903
 904 =cut
 905
 906 sub process_batch_import {
 907   my $job = shift;
 908
 909   my $oldAutoCommit = $FS::UID::AutoCommit;
 910   local $FS::UID::AutoCommit = 0;
 911   my $dbh = dbh;
 912
 913   my $param = thaw(decode_base64(shift));
 914   my $args = '$job, encode_base64( nfreeze( $param ) )';
 915
 916   my $method = '_perform_batch_import';
 917   if ( $param->{reload} ) {
 918     $method = 'process_batch_reload';
 919   }
 920
 921   eval "$method($args);";
 922   if ($@) {
 923     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 924     die $@;
 925   }
 926
 927   #success!
 928   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 929 }
 930
 931 sub _perform_batch_import {
 932   my $job = shift;
 933
 934   my $param = thaw(decode_base64(shift));
 935   my $format = $param->{'format'};        #well... this is all cch specific
 936
 937   my $files = $param->{'uploaded_files'}
 938     or die "No files provided.";
 939
 940   my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
 941                 split /,/, $files;
 942
 943   if ( $format eq 'cch' || $format eq 'cch-fixed'
 944     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
 945   {
 946
 947     my $oldAutoCommit = $FS::UID::AutoCommit;
 948     local $FS::UID::AutoCommit = 0;
 949     my $dbh = dbh;
 950     my $error = '';
 951     my @insert_list = ();
 952     my @delete_list = ();
 953     my @predelete_list = ();
 954     my $insertname = '';
 955     my $deletename = '';
 956     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
 957
 958     my @list = ( 'GEOCODE',  \&FS::tax_rate_location::batch_import,
 959                  'CODE',     \&FS::tax_class::batch_import,
 960                  'PLUS4',    \&FS::cust_tax_location::batch_import,
 961                  'ZIP',      \&FS::cust_tax_location::batch_import,
 962                  'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
 963                  'DETAIL',   \&FS::tax_rate::batch_import,
 964                );
 965     while( scalar(@list) ) {
 966       my ( $name, $import_sub ) = splice( @list, 0, 2 );
 967       my $file = lc($name). 'file';
 968
 969       unless ($files{$file}) {
 970         $error = "No $name supplied";
 971         next;
 972       }
 973       next if $name eq 'DETAIL' && $format =~ /update/;
 974
 975       my $filename = "$dir/".  $files{$file};
 976
 977       if ( $format =~ /update/ ) {
 978
 979         ( $error, $insertname, $deletename ) =
 980           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
 981           unless $error;
 982         last if $error;
 983
 984         unlink $filename or warn "Can't delete $filename: $!"
 985           unless $keep_cch_files;
 986         push @insert_list, $name, $insertname, $import_sub, $format;
 987         if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
 988           unshift @predelete_list, $name, $deletename, $import_sub, $format;
 989         } else {
 990           unshift @delete_list, $name, $deletename, $import_sub, $format;
 991         }
 992
 993       } else {
 994
 995         push @insert_list, $name, $filename, $import_sub, $format;
 996
 997       }
 998
 999     }
1000
1001     push @insert_list,
1002       'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1003       if $format =~ /update/;
1004
1005     $error ||= _perform_cch_tax_import( $job,
1006                                         [ @predelete_list ],
1007                                         [ @insert_list ],
1008                                         [ @delete_list ],
1009     );
1010
1011
1012     @list = ( @predelete_list, @insert_list, @delete_list );
1013     while( !$keep_cch_files && scalar(@list) ) {
1014       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1015       unlink $file or warn "Can't delete $file: $!";
1016     }
1017
1018     if ($error) {
1019       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1020       die $error;
1021     }else{
1022       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1023     }
1024
1025   }else{
1026     die "Unknown format: $format";
1027   }
1028
1029 }
1030
1031
1032 sub _perform_cch_tax_import {
1033   my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1034
1035   my $error = '';
1036   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1037     while( scalar(@$list) ) {
1038       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1039       my $fmt = "$format-update";
1040       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1041       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1042       $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1043       close $fh;
1044     }
1045   }
1046
1047   return $error;
1048 }
1049
1050 sub _perform_cch_insert_delete_split {
1051   my ($name, $filename, $dir, $format) = @_;
1052
1053   my $error = '';
1054
1055   open my $fh, "< $filename"
1056     or $error ||= "Can't open $name file $filename: $!";
1057
1058   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1059                             DIR      => $dir,
1060                             UNLINK   => 0,     #meh
1061                           ) or die "can't open temp file: $!\n";
1062   my $insertname = $ifh->filename;
1063
1064   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1065                             DIR      => $dir,
1066                             UNLINK   => 0,     #meh
1067                           ) or die "can't open temp file: $!\n";
1068   my $deletename = $dfh->filename;
1069
1070   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1071   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1072   while(<$fh>) {
1073     my $handle = '';
1074     $handle = $ifh if $_ =~ /$insert_pattern/;
1075     $handle = $dfh if $_ =~ /$delete_pattern/;
1076     unless ($handle) {
1077       $error = "bad input line: $_" unless $handle;
1078       last;
1079     }
1080     print $handle $_;
1081   }
1082   close $fh;
1083   close $ifh;
1084   close $dfh;
1085
1086   return ($error, $insertname, $deletename);
1087 }
1088
1089 sub _perform_cch_diff {
1090   my ($name, $newdir, $olddir) = @_;
1091
1092   my %oldlines = ();
1093
1094   if ($olddir) {
1095     open my $oldcsvfh, "$olddir/$name.txt"
1096       or die "failed to open $olddir/$name.txt: $!\n";
1097
1098     while(<$oldcsvfh>) {
1099       chomp;
1100       $oldlines{$_} = 1;
1101     }
1102     close $oldcsvfh;
1103   }
1104
1105   open my $newcsvfh, "$newdir/$name.txt"
1106     or die "failed to open $newdir/$name.txt: $!\n";
1107
1108   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1109                             DIR      => "$newdir",
1110                             UNLINK   => 0,     #meh
1111                           ) or die "can't open temp file: $!\n";
1112   my $diffname = $dfh->filename;
1113
1114   while(<$newcsvfh>) {
1115     chomp;
1116     if (exists($oldlines{$_})) {
1117       $oldlines{$_} = 0;
1118     } else {
1119       print $dfh $_, ',"I"', "\n";
1120     }
1121   }
1122   close $newcsvfh;
1123
1124   #false laziness w/above (sub batch_import)
1125   my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1126                    excessrate effective_date taxauth taxtype taxcat taxname
1127                    usetax useexcessrate fee unittype feemax maxtype passflag
1128                    passtype basetype );
1129   my $numfields = scalar(@fields);
1130
1131   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1132
1133   for my $line (grep $oldlines{$_}, keys %oldlines) {
1134
1135     $csv->parse($line) or do {
1136       #$dbh->rollback if $oldAutoCommit;
1137       die "can't parse: ". $csv->error_input();
1138     };
1139     my @columns = $csv->fields();
1140
1141     $csv->combine( splice(@columns, 0, $numfields) );
1142
1143     print $dfh $csv->string, ',"D"', "\n";
1144   }
1145
1146   close $dfh;
1147
1148   return $diffname;
1149 }
1150
1151 sub _cch_fetch_and_unzip {
1152   my ( $job, $urls, $secret, $dir ) = @_;
1153
1154   my $ua = new LWP::UserAgent;
1155   foreach my $url (split ',', $urls) {
1156     my @name = split '/', $url;  #somewhat restrictive
1157     my $name = pop @name;
1158     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1159     $name = $1;
1160
1161     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1162
1163     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1164     my $res = $ua->request(
1165       new HTTP::Request( GET => $url ),
1166       sub {
1167             print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1168             my $content_length = $_[1]->content_length;
1169             $imported += length($_[0]);
1170             if ( time - $min_sec > $last ) {
1171               my $error = $job->update_statustext(
1172                 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1173                 ",Downloading data from CCH"
1174               );
1175               die $error if $error;
1176               $last = time;
1177             }
1178       },
1179     );
1180     die "download of $url failed: ". $res->status_line
1181       unless $res->is_success;
1182
1183     close $taxfh;
1184     my $error = $job->update_statustext( "0,Unpacking data" );
1185     die $error if $error;
1186     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1187     $secret = $1;
1188     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1189       or die "unzip -P $secret -d $dir $dir/$name failed";
1190     #unlink "$dir/$name";
1191   }
1192 }
1193
1194 sub _cch_extract_csv_from_dbf {
1195   my ( $job, $dir, $name ) = @_;
1196
1197   eval "use XBase;";
1198   die $@ if $@;
1199
1200   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1201   my $error = $job->update_statustext( "0,Unpacking $name" );
1202   die $error if $error;
1203   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1204   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1205   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1206     unless defined($table);
1207   my $count = $table->last_record; # approximately;
1208   open my $csvfh, ">$dir.new/$name.txt"
1209     or die "failed to open $dir.new/$name.txt: $!\n";
1210
1211   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1212   my @fields = $table->field_names;
1213   my $cursor = $table->prepare_select;
1214   my $format_date =
1215     sub { my $date = shift;
1216           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1217           $date;
1218         };
1219   while (my $row = $cursor->fetch_hashref) {
1220     $csv->combine( map { my $type = $table->field_type($_);
1221                          if ($type eq 'D') {
1222                            &{$format_date}($row->{$_}) ;
1223                          } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1224                            sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1225                          } else {
1226                            $row->{$_};
1227                          }
1228                        }
1229                    @fields
1230     );
1231     print $csvfh $csv->string, "\n";
1232     $imported++;
1233     if ( time - $min_sec > $last ) {
1234       my $error = $job->update_statustext(
1235         int(100 * $imported/$count).  ",Unpacking $name"
1236       );
1237       die $error if $error;
1238       $last = time;
1239     }
1240   }
1241   $table->close;
1242   close $csvfh;
1243 }
1244
1245 sub _remember_disabled_taxes {
1246   my ( $job, $format, $disabled_tax_rate ) = @_;
1247
1248   # cch specific hash
1249
1250   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1251
1252   my @items = qsearch( { table   => 'tax_rate',
1253                          hashref => { disabled => 'Y',
1254                                       data_vendor => $format,
1255                                     },
1256                          select  => 'geocode, taxclassnum',
1257                        }
1258                      );
1259   my $count = scalar(@items);
1260   foreach my $tax_rate ( @items ) {
1261     if ( time - $min_sec > $last ) {
1262       $job->update_statustext(
1263         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1264       );
1265       $last = time;
1266     }
1267     $imported++;
1268     my $tax_class =
1269       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1270     unless ( $tax_class ) {
1271       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1272       next;
1273     }
1274     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1275   }
1276 }
1277
1278 sub _remember_tax_products {
1279   my ( $job, $format, $taxproduct ) = @_;
1280
1281   # XXX FIXME  this loop only works when cch is the only data provider
1282
1283   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1284
1285   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1286                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1287                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1288                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1289                   "       optionvalue != '' )";
1290   my @items = qsearch( { table => 'part_pkg',
1291                          select  => 'DISTINCT pkgpart,taxproductnum',
1292                          hashref => {},
1293                          extra_sql => $extra_sql,
1294                        }
1295                      );
1296   my $count = scalar(@items);
1297   foreach my $part_pkg ( @items ) {
1298     if ( time - $min_sec > $last ) {
1299       $job->update_statustext(
1300         int( 100 * $imported / $count ). ",Remembering tax products"
1301       );
1302       $last = time;
1303     }
1304     $imported++;
1305     warn "working with package part ". $part_pkg->pkgpart.
1306       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1307     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1308     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1309       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1310
1311     foreach my $option ( $part_pkg->part_pkg_option ) {
1312       next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1313       my $class = $1;
1314
1315       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1316       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1317           $part_pkg_taxproduct->taxproduct
1318         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1319     }
1320   }
1321 }
1322
1323 sub _restore_remembered_tax_products {
1324   my ( $job, $format, $taxproduct ) = @_;
1325
1326   # cch specific
1327
1328   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1329   my $count = scalar(keys %$taxproduct);
1330   foreach my $pkgpart ( keys %$taxproduct ) {
1331     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1332     if ( time - $min_sec > $last ) {
1333       $job->update_statustext(
1334         int( 100 * $imported / $count ). ",Restoring tax products"
1335       );
1336       $last = time;
1337     }
1338     $imported++;
1339
1340     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1341     unless ( $part_pkg ) {
1342       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1343     }
1344
1345     my %options = $part_pkg->options;
1346     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1347     my $primary_svc = $part_pkg->svcpart;
1348     my $new = new FS::part_pkg { $part_pkg->hash };
1349
1350     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1351       warn "working with class '$class'\n" if $DEBUG;
1352       my $part_pkg_taxproduct =
1353         qsearchs( 'part_pkg_taxproduct',
1354                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1355                     data_vendor => $format,
1356                   }
1357                 );
1358
1359       unless ( $part_pkg_taxproduct ) {
1360         return "failed to find part_pkg_taxproduct (".
1361           $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1362       }
1363
1364       if ( $class eq '' ) {
1365         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1366         next;
1367       }
1368
1369       $options{"usage_taxproductnum_$class"} =
1370         $part_pkg_taxproduct->taxproductnum;
1371
1372     }
1373
1374     my $error = $new->replace( $part_pkg,
1375                                'pkg_svc' => \%pkg_svc,
1376                                'primary_svc' => $primary_svc,
1377                                'options' => \%options,
1378     );
1379
1380     return $error if $error;
1381
1382   }
1383
1384   '';
1385 }
1386
1387 sub _restore_remembered_disabled_taxes {
1388   my ( $job, $format, $disabled_tax_rate ) = @_;
1389
1390   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1391   my $count = scalar(keys %$disabled_tax_rate);
1392   foreach my $key (keys %$disabled_tax_rate) {
1393     if ( time - $min_sec > $last ) {
1394       $job->update_statustext(
1395         int( 100 * $imported / $count ). ",Disabling tax rates"
1396       );
1397       $last = time;
1398     }
1399     $imported++;
1400     my ($geocode,$taxclass) = split /:/, $key, 2;
1401     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1402                                             taxclass    => $taxclass,
1403                                           } );
1404     return "found multiple tax_class records for format $format class $taxclass"
1405       if scalar(@tax_class) > 1;
1406
1407     unless (scalar(@tax_class)) {
1408       warn "no tax_class for format $format class $taxclass\n";
1409       next;
1410     }
1411
1412     my @tax_rate =
1413       qsearch('tax_rate', { data_vendor  => $format,
1414                             geocode      => $geocode,
1415                             taxclassnum  => $tax_class[0]->taxclassnum,
1416                           }
1417     );
1418
1419     if (scalar(@tax_rate) > 1) {
1420       return "found multiple tax_rate records for format $format geocode ".
1421              "$geocode and taxclass $taxclass ( taxclassnum ".
1422              $tax_class[0]->taxclassnum.  " )";
1423     }
1424
1425     if (scalar(@tax_rate)) {
1426       $tax_rate[0]->disabled('Y');
1427       my $error = $tax_rate[0]->replace;
1428       return $error if $error;
1429     }
1430   }
1431 }
1432
1433 sub _remove_old_tax_data {
1434   my ( $job, $format ) = @_;
1435
1436   my $dbh = dbh;
1437   my $error = $job->update_statustext( "0,Removing old tax data" );
1438   die $error if $error;
1439
1440   my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1441     "WHERE data_vendor = ".  $dbh->quote($format);
1442   $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1443
1444   my @table = qw(
1445     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1446   );
1447   foreach my $table ( @table ) {
1448     $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1449       $dbh->quote($format);
1450     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1451   }
1452
1453   if ( $format eq 'cch' ) {
1454     $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1455       $dbh->quote("$format-zip");
1456     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1457   }
1458
1459   '';
1460 }
1461
1462 sub _create_temporary_tables {
1463   my ( $job, $format ) = @_;
1464
1465   my $dbh = dbh;
1466   my $error = $job->update_statustext( "0,Creating temporary tables" );
1467   die $error if $error;
1468
1469   my @table = qw( tax_rate
1470                   tax_rate_location
1471                   part_pkg_taxrate
1472                   part_pkg_taxproduct
1473                   tax_class
1474                   cust_tax_location
1475   );
1476   foreach my $table ( @table ) {
1477     my $sql =
1478       "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1479     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1480   }
1481
1482   '';
1483 }
1484
1485 sub _copy_from_temp {
1486   my ( $job, $format ) = @_;
1487
1488   my $dbh = dbh;
1489   my $error = $job->update_statustext( "0,Making permanent" );
1490   die $error if $error;
1491
1492   my @table = qw( tax_rate
1493                   tax_rate_location
1494                   part_pkg_taxrate
1495                   part_pkg_taxproduct
1496                   tax_class
1497                   cust_tax_location
1498   );
1499   foreach my $table ( @table ) {
1500     my $sql =
1501       "INSERT INTO public.$table SELECT * from $table";
1502     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1503   }
1504
1505   '';
1506 }
1507
1508 =item process_download_and_reload
1509
1510 Download and process a tax update as a queued JSRPC job after wiping the
1511 existing wipable tax data.
1512
1513 =cut
1514
1515 sub process_download_and_reload {
1516   _process_reload('process_download_and_update', @_);
1517 }
1518
1519
1520 =item process_batch_reload
1521
1522 Load and process a tax update from the provided files as a queued JSRPC job
1523 after wiping the existing wipable tax data.
1524
1525 =cut
1526
1527 sub process_batch_reload {
1528   _process_reload('_perform_batch_import', @_);
1529 }
1530
1531
1532 sub _process_reload {
1533   my ( $method, $job ) = ( shift, shift );
1534
1535   my $param = thaw(decode_base64($_[0]));
1536   my $format = $param->{'format'};        #well... this is all cch specific
1537
1538   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1539
1540   if ( $job ) {  # progress bar
1541     my $error = $job->update_statustext( 0 );
1542     die $error if $error;
1543   }
1544
1545   my $oldAutoCommit = $FS::UID::AutoCommit;
1546   local $FS::UID::AutoCommit = 0;
1547   my $dbh = dbh;
1548   my $error = '';
1549
1550   my $sql =
1551     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1552     "USING (taxclassnum) WHERE data_vendor = '$format'";
1553   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1554   $sth->execute
1555     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1556   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1557     if $sth->fetchrow_arrayref->[0];
1558
1559   # really should get a table EXCLUSIVE lock here
1560
1561   #remember disabled taxes
1562   my %disabled_tax_rate = ();
1563   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1564
1565   #remember tax products
1566   my %taxproduct = ();
1567   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1568
1569   #create temp tables
1570   $error ||= _create_temporary_tables( $job, $format );
1571
1572   #import new data
1573   unless ($error) {
1574     my $args = '$job, @_';
1575     eval "$method($args);";
1576     $error = $@ if $@;
1577   }
1578
1579   #restore taxproducts
1580   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1581
1582   #disable tax_rates
1583   $error ||=
1584    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1585
1586   #wipe out the old data
1587   $error ||= _remove_old_tax_data( $job, $format );
1588
1589   #untemporize
1590   $error ||= _copy_from_temp( $job, $format );
1591
1592   if ($error) {
1593     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1594     die $error;
1595   }
1596
1597   #success!
1598   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1599 }
1600
1601
1602 =item process_download_and_update
1603
1604 Download and process a tax update as a queued JSRPC job
1605
1606 =cut
1607
1608 sub process_download_and_update {
1609   my $job = shift;
1610
1611   my $param = thaw(decode_base64(shift));
1612   my $format = $param->{'format'};        #well... this is all cch specific
1613
1614   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1615
1616   if ( $job ) {  # progress bar
1617     my $error = $job->update_statustext( 0);
1618     die $error if $error;
1619   }
1620
1621   my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1622   my $dir = $cache_dir. 'taxdata';
1623   unless (-d $dir) {
1624     mkdir $dir or die "can't create $dir: $!\n";
1625   }
1626
1627   if ($format eq 'cch') {
1628
1629     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1630
1631     my $conf = new FS::Conf;
1632     die "direct download of tax data not enabled\n"
1633       unless $conf->exists('taxdatadirectdownload');
1634     my ( $urls, $username, $secret, $states ) =
1635       $conf->config('taxdatadirectdownload');
1636     die "No tax download URL provided.  ".
1637         "Did you set the taxdatadirectdownload configuration value?\n"
1638       unless $urls;
1639
1640     $dir .= '/cch';
1641
1642     my $dbh = dbh;
1643     my $error = '';
1644
1645     # really should get a table EXCLUSIVE lock here
1646     # check if initial import or update
1647     #
1648     # relying on mkdir "$dir.new" as a mutex
1649
1650     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1651     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1652     $sth->execute() or die $sth->errstr;
1653     my $update = $sth->fetchrow_arrayref->[0];
1654
1655     # create cache and/or rotate old tax data
1656
1657     if (-d $dir) {
1658
1659       if (-d "$dir.9") {
1660         opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1661         foreach my $file (readdir($dirh)) {
1662           unlink "$dir.9/$file" if (-f "$dir.9/$file");
1663         }
1664         closedir($dirh);
1665         rmdir "$dir.9";
1666       }
1667
1668       for (8, 7, 6, 5, 4, 3, 2, 1) {
1669         if ( -e "$dir.$_" ) {
1670           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1671         }
1672       }
1673       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1674
1675     } else {
1676
1677       die "can't find previous tax data\n" if $update;
1678
1679     }
1680
1681     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1682
1683     # fetch and unpack the zip files
1684
1685     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1686
1687     # extract csv files from the dbf files
1688
1689     foreach my $name ( @namelist ) {
1690       _cch_extract_csv_from_dbf( $job, $dir, $name );
1691     }
1692
1693     # generate the diff files
1694
1695     my @list = ();
1696     foreach my $name ( @namelist ) {
1697       my $difffile = "$dir.new/$name.txt";
1698       if ($update) {
1699         my $error = $job->update_statustext( "0,Comparing to previous $name" );
1700         die $error if $error;
1701         warn "processing $dir.new/$name.txt\n" if $DEBUG;
1702         my $olddir = $update ? "$dir.1" : "";
1703         $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1704       }
1705       $difffile =~ s/^$cache_dir//;
1706       push @list, "${name}file:$difffile";
1707     }
1708
1709     # perform the import
1710     local $keep_cch_files = 1;
1711     $param->{uploaded_files} = join( ',', @list );
1712     $param->{format} .= '-update' if $update;
1713     $error ||=
1714       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1715
1716     rename "$dir.new", "$dir"
1717       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1718
1719   }else{
1720     die "Unknown format: $format";
1721   }
1722 }
1723
1724 =item browse_queries PARAMS
1725
1726 Returns a list consisting of a hashref suited for use as the argument
1727 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1728 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1729 from a form.  This conveniently creates the query hashref and count_query
1730 string required by the browse and search elements.  As a side effect,
1731 the PARAMS hashref is untainted and keys with unexpected values are removed.
1732
1733 =cut
1734
1735 sub browse_queries {
1736   my $params = shift;
1737
1738   my $query = {
1739                 'table'     => 'tax_rate',
1740                 'hashref'   => {},
1741                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1742               },
1743
1744   my $extra_sql = '';
1745
1746   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1747     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1748   } else {
1749     delete $params->{data_vendor};
1750   }
1751
1752   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1753     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1754                     'geocode LIKE '. dbh->quote($1.'%');
1755   } else {
1756     delete $params->{geocode};
1757   }
1758
1759   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1760        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1761      )
1762   {
1763     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1764                   ' taxclassnum  = '. dbh->quote($1)
1765   } else {
1766     delete $params->{taxclassnun};
1767   }
1768
1769   my $tax_type = $1
1770     if ( $params->{tax_type} =~ /^(\d+)$/ );
1771   delete $params->{tax_type}
1772     unless $tax_type;
1773
1774   my $tax_cat = $1
1775     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1776   delete $params->{tax_cat}
1777     unless $tax_cat;
1778
1779   my @taxclassnum = ();
1780   if ($tax_type || $tax_cat ) {
1781     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1782     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1783     @taxclassnum = map { $_->taxclassnum }
1784                    qsearch({ 'table'     => 'tax_class',
1785                              'hashref'   => {},
1786                              'extra_sql' => "WHERE taxclass $compare",
1787                           });
1788   }
1789
1790   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1791                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1792     if ( @taxclassnum );
1793
1794   unless ($params->{'showdisabled'}) {
1795     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1796                   "( disabled = '' OR disabled IS NULL )";
1797   }
1798
1799   $query->{extra_sql} = $extra_sql;
1800
1801   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1802 }
1803
1804 =item queue_liability_report PARAMS
1805
1806 Launches a tax liability report.
1807 =cut
1808
1809 sub queue_liability_report {
1810   my $job = shift;
1811   my $param = thaw(decode_base64(shift));
1812
1813   my $cgi = new CGI;
1814   $cgi->param('beginning', $param->{beginning});
1815   $cgi->param('ending', $param->{ending});
1816   my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1817   my $agentnum = $param->{agentnum};
1818   if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1819   generate_liability_report(
1820     'beginning' => $beginning,
1821     'ending'    => $ending,
1822     'agentnum'  => $agentnum,
1823     'p'         => $param->{RootURL},
1824     'job'       => $job,
1825   );
1826 }
1827
1828 =item generate_liability_report PARAMS
1829
1830 Generates a tax liability report.  Provide a hash including desired
1831 agentnum, beginning, and ending
1832
1833 =cut
1834
1835 #shit, all sorts of false laxiness w/report_newtax.cgi
1836 sub generate_liability_report {
1837   my %args = @_;
1838
1839   my ( $count, $last, $min_sec ) = _progressbar_foo();
1840
1841   #let us open the temp file early
1842   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1843   my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1844                                DIR      => $dir,
1845                                UNLINK   => 0, # not so temp
1846                              ) or die "can't open report file: $!\n";
1847
1848   my $conf = new FS::Conf;
1849   my $money_char = $conf->config('money_char') || '$';
1850
1851   my $join_cust = "
1852       JOIN cust_bill USING ( invnum )
1853       LEFT JOIN cust_main USING ( custnum )
1854   ";
1855
1856   my $join_loc =
1857     "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1858   my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1859
1860   my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1861
1862   my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1863
1864   my $agentname = '';
1865   if ( $args{agentnum} =~ /^(\d+)$/ ) {
1866     my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1867     die "agent not found" unless $agent;
1868     $agentname = $agent->agent;
1869     $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1870   }
1871
1872   #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1873   my @taxparams = qw( city county state locationtaxid );
1874   my @params = ('itemdesc', @taxparams);
1875
1876   my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1877
1878   #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1879   #to FS::Report or FS::Record or who the fuck knows where)
1880   my $scalar_sql = sub {
1881     my( $r, $param, $sql ) = @_;
1882     my $sth = dbh->prepare($sql) or die dbh->errstr;
1883     $sth->execute( map $r->$_(), @$param )
1884       or die "Unexpected error executing statement $sql: ". $sth->errstr;
1885     $sth->fetchrow_arrayref->[0] || 0;
1886   };
1887
1888   my $tax = 0;
1889   my $credit = 0;
1890   my %taxes = ();
1891   my %basetaxes = ();
1892   my $calculated = 0;
1893   my @tax_and_location = qsearch({ table     => 'cust_bill_pkg',
1894                                    select    => $select,
1895                                    hashref   => { pkgpart => 0 },
1896                                    addl_from => $addl_from,
1897                                    extra_sql => $where,
1898                                 });
1899   $count = scalar(@tax_and_location);
1900   foreach my $t ( @tax_and_location ) {
1901
1902     if ( $args{job} ) {
1903       if ( time - $min_sec > $last ) {
1904         $args{job}->update_statustext( int( 100 * $calculated / $count ).
1905                                        ",Calculating"
1906                                      );
1907         $last = time;
1908       }
1909     }
1910
1911     #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1912     my $label = join('~', map { $t->$_ } @params);
1913     $label = 'Tax'. $label if $label =~ /^~/;
1914     unless ( exists( $taxes{$label} ) ) {
1915       my ($baselabel, @trash) = split /~/, $label;
1916
1917       $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1918       $taxes{$label}->{'url_param'} =
1919         join(';', map { "$_=". uri_escape($t->$_) } @params);
1920
1921       my $payby_itemdesc_loc =
1922         "    payby != 'COMP' ".
1923         "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1924         "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1925                                                          @taxparams
1926                                                    );
1927
1928       my $taxwhere =
1929         "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1930
1931       my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1932
1933       my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1934       $tax += $x;
1935       $taxes{$label}->{'tax'} += $x;
1936
1937       my $creditfrom =
1938        "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1939       my $creditwhere =
1940         "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1941
1942       $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1943              " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1944
1945       my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1946       $credit += $y;
1947       $taxes{$label}->{'credit'} += $y;
1948
1949       unless ( exists( $taxes{$baselabel} ) ) {
1950
1951         $basetaxes{$baselabel}->{'label'} = $baselabel;
1952         $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1953         $basetaxes{$baselabel}->{'base'} = 1;
1954
1955       }
1956
1957       $basetaxes{$baselabel}->{'tax'} += $x;
1958       $basetaxes{$baselabel}->{'credit'} += $y;
1959
1960     }
1961
1962     # calculate customer-exemption for this tax
1963     # calculate package-exemption for this tax
1964     # calculate monthly exemption (texas tax) for this tax
1965     # count up all the cust_tax_exempt_pkg records associated with
1966     # the actual line items.
1967   }
1968
1969
1970   #ordering
1971
1972   if ( $args{job} ) {
1973     $args{job}->update_statustext( "0,Sorted" );
1974     $last = time;
1975   }
1976
1977   my @taxes = ();
1978
1979   foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1980     my ($base, @trash) = split '~', $tax;
1981     my $basetax = delete( $basetaxes{$base} );
1982     if ($basetax) {
1983       if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1984         $taxes{$tax}->{base} = 1;
1985       } else {
1986         push @taxes, $basetax;
1987       }
1988     }
1989     push @taxes, $taxes{$tax};
1990   }
1991
1992   push @taxes, {
1993     'label'          => 'Total',
1994     'url_param'      => '',
1995     'tax'            => $tax,
1996     'credit'         => $credit,
1997     'base'           => 1,
1998   };
1999
2000
2001   my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2002   $dateagentlink .= ';agentnum='. $args{agentnum}
2003     if length($agentname);
2004   my $baselink   = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
2005   my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2006
2007   print $report <<EOF;
2008
2009     <% include("/elements/header.html", "$agentname Tax Report - ".
2010                   ( $args{beginning}
2011                       ? time2str('%h %o %Y ', $args{beginning} )
2012                       : ''
2013                   ).
2014                   'through '.
2015                   ( $args{ending} == 4294967295
2016                       ? 'now'
2017                       : time2str('%h %o %Y', $args{ending} )
2018                   )
2019               )
2020     %>
2021
2022     <% include('/elements/table-grid.html') %>
2023
2024     <TR>
2025       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2026       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2027       <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2028       <TH CLASS="grid" BGCOLOR="#cccccc">&nbsp;&nbsp;&nbsp;&nbsp;</TH>
2029       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2030       <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2031     </TR>
2032 EOF
2033
2034   my $bgcolor1 = '#eeeeee';
2035   my $bgcolor2 = '#ffffff';
2036   my $bgcolor = '';
2037
2038   $count = scalar(@taxes);
2039   $calculated = 0;
2040   foreach my $tax ( @taxes ) {
2041
2042     if ( $args{job} ) {
2043       if ( time - $min_sec > $last ) {
2044         $args{job}->update_statustext( int( 100 * $calculated / $count ).
2045                                        ",Generated"
2046                                      );
2047         $last = time;
2048       }
2049     }
2050
2051     if ( $bgcolor eq $bgcolor1 ) {
2052       $bgcolor = $bgcolor2;
2053     } else {
2054       $bgcolor = $bgcolor1;
2055     }
2056
2057     my $link = '';
2058     if ( $tax->{'label'} ne 'Total' ) {
2059       $link = ';'. $tax->{'url_param'};
2060     }
2061
2062     print $report <<EOF;
2063       <TR>
2064         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2065         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2066         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2067           <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2068         </TD>
2069         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2070         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2071         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2072         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2073           <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2074         </TD>
2075         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2076       </TR>
2077 EOF
2078   }
2079
2080   print $report <<EOF;
2081     </TABLE>
2082
2083     </BODY>
2084     </HTML>
2085 EOF
2086
2087   my $reportname = $report->filename;
2088   close $report;
2089
2090   my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2091   $reportname =~ s/^$dropstring//;
2092
2093   my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2094   die "<a href=$reporturl>view</a>\n";
2095
2096 }
2097
2098
2099
2100 =back
2101
2102 =head1 BUGS
2103
2104   Mixing automatic and manual editing works poorly at present.
2105
2106   Tax liability calculations take too long and arguably don't belong here.
2107   Tax liability report generation not entirely safe (escaped).
2108
2109 =head1 SEE ALSO
2110
2111 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
2112 documentation.
2113
2114 =cut
2115
2116 1;
2117