FS/FS/tax_rate.pm

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