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