FS/FS/tax_rate.pm

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