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