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