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