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