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         # per account
 579         $units = 1 unless $seen{$cust_bill_pkg->tax_locationnum};
 580         $seen{$cust_bill_pkg->tax_locationnum} = 1;
 581
 582       } else {
 583         # Unittype 19 is used for prepaid wireless E911 charges in many states.
 584         # Apparently "per retail purchase", which for us would mean per invoice.
 585         # Unittype 20 is used for some 911 surcharges and I have no idea what
 586         # it means.
 587         return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
 588       }
 589       my $this_tax_cents = int($units * $self->fee * 100);
 590       my $tax_location = FS::cust_bill_pkg_tax_rate_location->new({
 591           'taxnum'                => $self->taxnum,
 592           'taxtype'               => ref($self),
 593           'cents'                 => $this_tax_cents,
 594           'locationtaxid'         => $self->location,
 595           'taxable_cust_bill_pkg' => $cust_bill_pkg,
 596           'taxratelocationnum'    => $taxratelocationnum,
 597       });
 598       push @tax_locations, $tax_location;
 599
 600       $taxable_units += $units;
 601       $tax_cents += $this_tax_cents;
 602
 603     }
 604   } # foreach $cust_bill_pkg
 605
 606   # check bracket maxima; throw an error if we've gone over, because
 607   # we don't really implement them
 608
 609   if ( ($self->taxmax > 0 and $taxable_cents > $self->taxmax*100 ) or
 610        ($self->feemax > 0 and $taxable_units > $self->feemax) ) {
 611     # throw an error
 612     # (why not just cap taxable_charged/units at the taxmax/feemax? because
 613     # it's way more complicated than that. this won't even catch every case
 614     # where a bracket maximum should apply.)
 615     return $self->_fatal_or_null( 'tax base > taxmax/feemax for tax'.$self->taxnum );
 616   }
 617
 618   # round and distribute
 619   my $total_tax_cents = sprintf('%.0f',
 620     ($taxable_cents * $self->tax) + ($taxable_units * $self->fee * 100)
 621   );
 622   my $extra_cents = sprintf('%.0f', $total_tax_cents - $tax_cents);
 623   $tax_cents += $extra_cents;
 624   my $i = 0;
 625   foreach (@tax_locations) { # can never require more than a single pass, yes?
 626     my $cents = $_->get('cents');
 627     if ( $extra_cents > 0 ) {
 628       $cents++;
 629       $extra_cents--;
 630     }
 631     $_->set('amount', sprintf('%.2f', $cents/100));
 632   }
 633
 634   # just transform each CBPTRL record into a tax line item.
 635   # calculate_taxes will consolidate them, but before that happens we have
 636   # to do tax on tax calculation.
 637   my @tax_items;
 638   foreach (@tax_locations) {
 639     next if $_->amount == 0;
 640     my $tax_item = FS::cust_bill_pkg->new({
 641         'pkgnum'        => 0,
 642         'recur'         => 0,
 643         'setup'         => $_->amount,
 644         'sdate'         => '', # $_->sdate?
 645         'edate'         => '',
 646         'itemdesc'      => $name,
 647         'cust_bill_pkg_tax_rate_location' => [ $_ ],
 648     });
 649     $_->set('tax_cust_bill_pkg' => $tax_item);
 650     push @tax_items, $tax_item;
 651   }
 652
 653   return @tax_items;
 654 }
 655
 656 sub _fatal_or_null {
 657   my ($self, $error) = @_;
 658
 659   $DB::single = 1; # not a mistake
 660
 661   my $conf = new FS::Conf;
 662
 663   $error = "can't yet handle ". $error;
 664   my $name = $self->taxname;
 665   $name = 'Other surcharges'
 666     if ($self->passtype == 2);
 667
 668   if ($conf->exists('ignore_incalculable_taxes')) {
 669     warn "WARNING: $error; billing anyway per ignore_incalculable_taxes conf\n";
 670     return { name => $name, amount => 0 };
 671   } else {
 672     return "fatal: $error";
 673   }
 674 }
 675
 676 =item tax_on_tax CUST_LOCATION
 677
 678 Returns a list of taxes which are candidates for taxing taxes for the
 679 given service location (see L<FS::cust_location>)
 680
 681 =cut
 682
 683     #hot
 684 sub tax_on_tax {
 685        #akshun
 686   my $self = shift;
 687   my $cust_location = shift;
 688
 689   warn "looking up taxes on tax ". $self->taxnum. " for customer ".
 690     $cust_location->custnum
 691     if $DEBUG;
 692
 693   my $geocode = $cust_location->geocode($self->data_vendor);
 694
 695   # CCH oddness in m2m
 696   my $dbh = dbh;
 697   my $extra_sql = ' AND ('.
 698     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
 699                  qw(10 5 2)
 700         ).
 701     ')';
 702
 703   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
 704   my $select   = 'DISTINCT ON(taxclassnum) *';
 705
 706   # should qsearch preface columns with the table to facilitate joins?
 707   my @taxclassnums = map { $_->taxclassnum }
 708     qsearch( { 'table'     => 'part_pkg_taxrate',
 709                'select'    => $select,
 710                'hashref'   => { 'data_vendor'      => $self->data_vendor,
 711                                 'taxclassnumtaxed' => $self->taxclassnum,
 712                               },
 713                'extra_sql' => $extra_sql,
 714                'order_by'  => $order_by,
 715            } );
 716
 717   return () unless @taxclassnums;
 718
 719   $extra_sql =
 720     "AND (".  join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
 721
 722   qsearch({ 'table'     => 'tax_rate',
 723             'hashref'   => { 'geocode' => $geocode, },
 724             'extra_sql' => $extra_sql,
 725          })
 726
 727 }
 728
 729 =item tax_rate_location
 730
 731 Returns an object representing the location associated with this tax
 732 (see L<FS::tax_rate_location>)
 733
 734 =cut
 735
 736 sub tax_rate_location {
 737   my $self = shift;
 738
 739   qsearchs({ 'table'     => 'tax_rate_location',
 740              'hashref'   => { 'data_vendor' => $self->data_vendor,
 741                               'geocode'     => $self->geocode,
 742                               'disabled'    => '',
 743                             },
 744           }) ||
 745   new FS::tax_rate_location;
 746
 747 }
 748
 749 =back
 750
 751 =head1 SUBROUTINES
 752
 753 =over 4
 754
 755 =item batch_import
 756
 757 =cut
 758
 759 sub _progressbar_foo {
 760   return (0, time, 5);
 761 }
 762
 763 sub batch_import {
 764   my ($param, $job) = @_;
 765
 766   my $fh = $param->{filehandle};
 767   my $format = $param->{'format'};
 768
 769   my %insert = ();
 770   my %delete = ();
 771
 772   my @fields;
 773   my $hook;
 774
 775   my @column_lengths = ();
 776   my @column_callbacks = ();
 777   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
 778     $format =~ s/-fixed//;
 779     my $date_format = sub { my $r='';
 780                             /^(\d{4})(\d{2})(\d{2})$/ && ($r="$3/$2/$1");
 781                             $r;
 782                           };
 783     my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
 784     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 );
 785     push @column_lengths, 1 if $format eq 'cch-update';
 786     push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
 787     $column_callbacks[8] = $date_format;
 788   }
 789
 790   my $line;
 791   my ( $count, $last, $min_sec ) = _progressbar_foo();
 792   if ( $job || scalar(@column_callbacks) ) {
 793     my $error =
 794       csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
 795     return $error if $error;
 796   }
 797   $count *=2;
 798
 799   if ( $format eq 'cch' || $format eq 'cch-update' ) {
 800     #false laziness w/below (sub _perform_cch_diff)
 801     @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
 802                   excessrate effective_date taxauth taxtype taxcat taxname
 803                   usetax useexcessrate fee unittype feemax maxtype passflag
 804                   passtype basetype );
 805     push @fields, 'actionflag' if $format eq 'cch-update';
 806
 807     $hook = sub {
 808       my $hash = shift;
 809
 810       $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
 811       $hash->{'data_vendor'} ='cch';
 812       my $parser = new DateTime::Format::Strptime( pattern => "%m/%d/%Y",
 813                                                    time_zone => 'floating',
 814                                                  );
 815       my $dt = $parser->parse_datetime( $hash->{'effective_date'} );
 816       $hash->{'effective_date'} = $dt ? $dt->epoch : '';
 817
 818       $hash->{$_} =~ s/\s//g foreach qw( inoutcity inoutlocal ) ;
 819       $hash->{$_} = sprintf("%.2f", $hash->{$_}) foreach qw( taxbase taxmax );
 820
 821       my $taxclassid =
 822         join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
 823
 824       my %tax_class = ( 'data_vendor'  => 'cch',
 825                         'taxclass' => $taxclassid,
 826                       );
 827
 828       my $tax_class = qsearchs( 'tax_class', \%tax_class );
 829       return "Error updating tax rate: no tax class $taxclassid"
 830         unless $tax_class;
 831
 832       $hash->{'taxclassnum'} = $tax_class->taxclassnum;
 833
 834       foreach (qw( taxtype taxcat )) {
 835         delete($hash->{$_});
 836       }
 837
 838       my %passflagmap = ( '0' => '',
 839                           '1' => 'Y',
 840                           '2' => 'N',
 841                         );
 842       $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
 843         if exists $passflagmap{$hash->{'passflag'}};
 844
 845       foreach (keys %$hash) {
 846         $hash->{$_} = substr($hash->{$_}, 0, 80)
 847           if length($hash->{$_}) > 80;
 848       }
 849
 850       my $actionflag = delete($hash->{'actionflag'});
 851
 852       $hash->{'taxname'} =~ s/`/'/g;
 853       $hash->{'taxname'} =~ s|\\|/|g;
 854
 855       return '' if $format eq 'cch';  # but not cch-update
 856
 857       if ($actionflag eq 'I') {
 858         $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
 859       }elsif ($actionflag eq 'D') {
 860         $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
 861       }else{
 862         return "Unexpected action flag: ". $hash->{'actionflag'};
 863       }
 864
 865       delete($hash->{$_}) for keys %$hash;
 866
 867       '';
 868
 869     };
 870
 871   } elsif ( $format eq 'extended' ) {
 872     die "unimplemented\n";
 873     @fields = qw( );
 874     $hook = sub {};
 875   } else {
 876     die "unknown format $format";
 877   }
 878
 879   my $csv = new Text::CSV_XS;
 880
 881   my $imported = 0;
 882
 883   local $SIG{HUP} = 'IGNORE';
 884   local $SIG{INT} = 'IGNORE';
 885   local $SIG{QUIT} = 'IGNORE';
 886   local $SIG{TERM} = 'IGNORE';
 887   local $SIG{TSTP} = 'IGNORE';
 888   local $SIG{PIPE} = 'IGNORE';
 889
 890   my $oldAutoCommit = $FS::UID::AutoCommit;
 891   local $FS::UID::AutoCommit = 0;
 892   my $dbh = dbh;
 893
 894   while ( defined($line=<$fh>) ) {
 895     $csv->parse($line) or do {
 896       $dbh->rollback if $oldAutoCommit;
 897       return "can't parse: ". $csv->error_input();
 898     };
 899
 900     if ( $job ) {  # progress bar
 901       if ( time - $min_sec > $last ) {
 902         my $error = $job->update_statustext(
 903           int( 100 * $imported / $count ). ",Importing tax rates"
 904         );
 905         if ($error) {
 906           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 907           die $error;
 908         }
 909         $last = time;
 910       }
 911     }
 912
 913     my @columns = $csv->fields();
 914
 915     my %tax_rate = ( 'data_vendor' => $format );
 916     foreach my $field ( @fields ) {
 917       $tax_rate{$field} = shift @columns;
 918     }
 919
 920     if ( scalar( @columns ) ) {
 921       $dbh->rollback if $oldAutoCommit;
 922       return "Unexpected trailing columns in line (wrong format?) importing tax_rate: $line";
 923     }
 924
 925     my $error = &{$hook}(\%tax_rate);
 926     if ( $error ) {
 927       $dbh->rollback if $oldAutoCommit;
 928       return $error;
 929     }
 930
 931     if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
 932
 933       my $tax_rate = new FS::tax_rate( \%tax_rate );
 934       $error = $tax_rate->insert;
 935
 936       if ( $error ) {
 937         $dbh->rollback if $oldAutoCommit;
 938         return "can't insert tax_rate for $line: $error";
 939       }
 940
 941     }
 942
 943     $imported++;
 944
 945   }
 946
 947   my @replace = grep { exists($delete{$_}) } keys %insert;
 948   for (@replace) {
 949     if ( $job ) {  # progress bar
 950       if ( time - $min_sec > $last ) {
 951         my $error = $job->update_statustext(
 952           int( 100 * $imported / $count ). ",Importing tax rates"
 953         );
 954         if ($error) {
 955           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 956           die $error;
 957         }
 958         $last = time;
 959       }
 960     }
 961
 962     my $old = qsearchs( 'tax_rate', $delete{$_} );
 963
 964     if ( $old ) {
 965
 966       my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
 967       $new->taxnum($old->taxnum);
 968       my $error = $new->replace($old);
 969
 970       if ( $error ) {
 971         $dbh->rollback if $oldAutoCommit;
 972         my $hashref = $insert{$_};
 973         $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 974         return "can't replace tax_rate for $line: $error";
 975       }
 976
 977       $imported++;
 978
 979     } else {
 980
 981       $old = delete $delete{$_};
 982       warn "WARNING: can't find tax_rate to replace (inserting instead and continuing) for: ".
 983         #join(" ", map { "$_ => ". $old->{$_} } @fields);
 984         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
 985     }
 986
 987     $imported++;
 988   }
 989
 990   for (grep { !exists($delete{$_}) } keys %insert) {
 991     if ( $job ) {  # progress bar
 992       if ( time - $min_sec > $last ) {
 993         my $error = $job->update_statustext(
 994           int( 100 * $imported / $count ). ",Importing tax rates"
 995         );
 996         if ($error) {
 997           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 998           die $error;
 999         }
1000         $last = time;
1001       }
1002     }
1003
1004     my $tax_rate = new FS::tax_rate( $insert{$_} );
1005     my $error = $tax_rate->insert;
1006
1007     if ( $error ) {
1008       $dbh->rollback if $oldAutoCommit;
1009       my $hashref = $insert{$_};
1010       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1011       return "can't insert tax_rate for $line: $error";
1012     }
1013
1014     $imported++;
1015   }
1016
1017   for (grep { !exists($insert{$_}) } keys %delete) {
1018     if ( $job ) {  # progress bar
1019       if ( time - $min_sec > $last ) {
1020         my $error = $job->update_statustext(
1021           int( 100 * $imported / $count ). ",Importing tax rates"
1022         );
1023         if ($error) {
1024           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1025           die $error;
1026         }
1027         $last = time;
1028       }
1029     }
1030
1031     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
1032     if (!$tax_rate) {
1033       $dbh->rollback if $oldAutoCommit;
1034       $tax_rate = $delete{$_};
1035       warn "WARNING: can't find tax_rate to delete for: ".
1036         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) ).
1037         " (ignoring)\n";
1038     } else {
1039       my $error = $tax_rate->delete; #  XXX we really should not do this
1040                                      # (it orphans CBPTRL records)
1041
1042       if ( $error ) {
1043         $dbh->rollback if $oldAutoCommit;
1044         my $hashref = $delete{$_};
1045         $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
1046         return "can't delete tax_rate for $line: $error";
1047       }
1048     }
1049
1050     $imported++;
1051   }
1052
1053   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1054
1055   return "Empty file!" unless ($imported || $format eq 'cch-update');
1056
1057   ''; #no error
1058
1059 }
1060
1061 =item process_batch_import
1062
1063 Load a batch import as a queued JSRPC job
1064
1065 =cut
1066
1067 sub process_batch_import {
1068   my $job = shift;
1069
1070   my $oldAutoCommit = $FS::UID::AutoCommit;
1071   local $FS::UID::AutoCommit = 0;
1072   my $dbh = dbh;
1073
1074   my $param = thaw(decode_base64(shift));
1075   my $args = '$job, encode_base64( nfreeze( $param ) )';
1076
1077   my $method = '_perform_batch_import';
1078   if ( $param->{reload} ) {
1079     $method = 'process_batch_reload';
1080   }
1081
1082   eval "$method($args);";
1083   if ($@) {
1084     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1085     die $@;
1086   }
1087
1088   #success!
1089   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1090 }
1091
1092 sub _perform_batch_import {
1093   my $job = shift;
1094
1095   my $param = thaw(decode_base64(shift));
1096   my $format = $param->{'format'};        #well... this is all cch specific
1097
1098   my $files = $param->{'uploaded_files'}
1099     or die "No files provided.";
1100
1101   my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
1102                 split /,/, $files;
1103
1104   if ( $format eq 'cch' || $format eq 'cch-fixed'
1105     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
1106   {
1107
1108     my $oldAutoCommit = $FS::UID::AutoCommit;
1109     local $FS::UID::AutoCommit = 0;
1110     my $dbh = dbh;
1111     my $error = '';
1112     my @insert_list = ();
1113     my @delete_list = ();
1114     my @predelete_list = ();
1115     my $insertname = '';
1116     my $deletename = '';
1117     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1118
1119     my @list = ( 'GEOCODE',  \&FS::tax_rate_location::batch_import,
1120                  'CODE',     \&FS::tax_class::batch_import,
1121                  'PLUS4',    \&FS::cust_tax_location::batch_import,
1122                  'ZIP',      \&FS::cust_tax_location::batch_import,
1123                  'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
1124                  'DETAIL',   \&FS::tax_rate::batch_import,
1125                );
1126     while( scalar(@list) ) {
1127       my ( $name, $import_sub ) = splice( @list, 0, 2 );
1128       my $file = lc($name). 'file';
1129
1130       unless ($files{$file}) {
1131         #$error = "No $name supplied";
1132         next;
1133       }
1134       next if $name eq 'DETAIL' && $format =~ /update/;
1135
1136       my $filename = "$dir/".  $files{$file};
1137
1138       if ( $format =~ /update/ ) {
1139
1140         ( $error, $insertname, $deletename ) =
1141           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
1142           unless $error;
1143         last if $error;
1144
1145         unlink $filename or warn "Can't delete $filename: $!"
1146           unless $keep_cch_files;
1147         push @insert_list, $name, $insertname, $import_sub, $format;
1148         if ( $name eq 'GEOCODE' || $name eq 'CODE' ) { #handle this whole ordering issue better
1149           unshift @predelete_list, $name, $deletename, $import_sub, $format;
1150         } else {
1151           unshift @delete_list, $name, $deletename, $import_sub, $format;
1152         }
1153
1154       } else {
1155
1156         push @insert_list, $name, $filename, $import_sub, $format;
1157
1158       }
1159
1160     }
1161
1162     push @insert_list,
1163       'DETAIL', "$dir/".$files{detailfile}, \&FS::tax_rate::batch_import, $format
1164       if $format =~ /update/;
1165
1166     my %addl_param = ();
1167     if ( $param->{'delete_only'} ) {
1168       $addl_param{'delete_only'} = $param->{'delete_only'};
1169       @insert_list = ()
1170     }
1171
1172     $error ||= _perform_cch_tax_import( $job,
1173                                         [ @predelete_list ],
1174                                         [ @insert_list ],
1175                                         [ @delete_list ],
1176                                         \%addl_param,
1177     );
1178
1179
1180     @list = ( @predelete_list, @insert_list, @delete_list );
1181     while( !$keep_cch_files && scalar(@list) ) {
1182       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1183       unlink $file or warn "Can't delete $file: $!";
1184     }
1185
1186     if ($error) {
1187       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1188       die $error;
1189     }else{
1190       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1191     }
1192
1193   }else{
1194     die "Unknown format: $format";
1195   }
1196
1197 }
1198
1199
1200 sub _perform_cch_tax_import {
1201   my ( $job, $predelete_list, $insert_list, $delete_list, $addl_param ) = @_;
1202   $addl_param ||= {};
1203
1204   my $error = '';
1205   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1206     while( scalar(@$list) ) {
1207       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1208       my $fmt = "$format-update";
1209       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1210       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1211       my $param = { 'filehandle' => $fh,
1212                     'format'     => $fmt,
1213                     %$addl_param,
1214                   };
1215       $error ||= &{$method}($param, $job);
1216       close $fh;
1217     }
1218   }
1219
1220   return $error;
1221 }
1222
1223 sub _perform_cch_insert_delete_split {
1224   my ($name, $filename, $dir, $format) = @_;
1225
1226   my $error = '';
1227
1228   open my $fh, "< $filename"
1229     or $error ||= "Can't open $name file $filename: $!";
1230
1231   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1232                             DIR      => $dir,
1233                             UNLINK   => 0,     #meh
1234                           ) or die "can't open temp file: $!\n";
1235   my $insertname = $ifh->filename;
1236
1237   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1238                             DIR      => $dir,
1239                             UNLINK   => 0,     #meh
1240                           ) or die "can't open temp file: $!\n";
1241   my $deletename = $dfh->filename;
1242
1243   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1244   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1245   while(<$fh>) {
1246     my $handle = '';
1247     $handle = $ifh if $_ =~ /$insert_pattern/;
1248     $handle = $dfh if $_ =~ /$delete_pattern/;
1249     unless ($handle) {
1250       $error = "bad input line: $_" unless $handle;
1251       last;
1252     }
1253     print $handle $_;
1254   }
1255   close $fh;
1256   close $ifh;
1257   close $dfh;
1258
1259   return ($error, $insertname, $deletename);
1260 }
1261
1262 sub _perform_cch_diff {
1263   my ($name, $newdir, $olddir) = @_;
1264
1265   my %oldlines = ();
1266
1267   if ($olddir) {
1268     open my $oldcsvfh, "$olddir/$name.txt"
1269       or die "failed to open $olddir/$name.txt: $!\n";
1270
1271     while(<$oldcsvfh>) {
1272       chomp;
1273       $oldlines{$_} = 1;
1274     }
1275     close $oldcsvfh;
1276   }
1277
1278   open my $newcsvfh, "$newdir/$name.txt"
1279     or die "failed to open $newdir/$name.txt: $!\n";
1280
1281   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1282                             DIR      => "$newdir",
1283                             UNLINK   => 0,     #meh
1284                           ) or die "can't open temp file: $!\n";
1285   my $diffname = $dfh->filename;
1286
1287   while(<$newcsvfh>) {
1288     chomp;
1289     if (exists($oldlines{$_})) {
1290       $oldlines{$_} = 0;
1291     } else {
1292       print $dfh $_, ',"I"', "\n";
1293     }
1294   }
1295   close $newcsvfh;
1296
1297   #false laziness w/above (sub batch_import)
1298   my @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
1299                    excessrate effective_date taxauth taxtype taxcat taxname
1300                    usetax useexcessrate fee unittype feemax maxtype passflag
1301                    passtype basetype );
1302   my $numfields = scalar(@fields);
1303
1304   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1305
1306   for my $line (grep $oldlines{$_}, keys %oldlines) {
1307
1308     $csv->parse($line) or do {
1309       #$dbh->rollback if $oldAutoCommit;
1310       die "can't parse: ". $csv->error_input();
1311     };
1312     my @columns = $csv->fields();
1313
1314     $csv->combine( splice(@columns, 0, $numfields) );
1315
1316     print $dfh $csv->string, ',"D"', "\n";
1317   }
1318
1319   close $dfh;
1320
1321   return $diffname;
1322 }
1323
1324 sub _cch_fetch_and_unzip {
1325   my ( $job, $urls, $secret, $dir ) = @_;
1326
1327   my $ua = new LWP::UserAgent;
1328   foreach my $url (split ',', $urls) {
1329     my @name = split '/', $url;  #somewhat restrictive
1330     my $name = pop @name;
1331     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1332     $name = $1;
1333
1334     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1335
1336     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1337     my $res = $ua->request(
1338       new HTTP::Request( GET => $url ),
1339       sub {
1340             print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1341             my $content_length = $_[1]->content_length;
1342             $imported += length($_[0]);
1343             if ( time - $min_sec > $last ) {
1344               my $error = $job->update_statustext(
1345                 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1346                 ",Downloading data from CCH"
1347               );
1348               die $error if $error;
1349               $last = time;
1350             }
1351       },
1352     );
1353     die "download of $url failed: ". $res->status_line
1354       unless $res->is_success;
1355
1356     close $taxfh;
1357     my $error = $job->update_statustext( "0,Unpacking data" );
1358     die $error if $error;
1359     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1360     $secret = $1;
1361     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1362       or die "unzip -P $secret -d $dir $dir/$name failed";
1363     #unlink "$dir/$name";
1364   }
1365 }
1366
1367 sub _cch_extract_csv_from_dbf {
1368   my ( $job, $dir, $name ) = @_;
1369
1370   eval "use XBase;";
1371   die $@ if $@;
1372
1373   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1374   my $error = $job->update_statustext( "0,Unpacking $name" );
1375   die $error if $error;
1376   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1377   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1378   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1379     unless defined($table);
1380   my $count = $table->last_record; # approximately;
1381   open my $csvfh, ">$dir.new/$name.txt"
1382     or die "failed to open $dir.new/$name.txt: $!\n";
1383
1384   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1385   my @fields = $table->field_names;
1386   my $cursor = $table->prepare_select;
1387   my $format_date =
1388     sub { my $date = shift;
1389           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1390           $date;
1391         };
1392   while (my $row = $cursor->fetch_hashref) {
1393     $csv->combine( map { my $type = $table->field_type($_);
1394                          if ($type eq 'D') {
1395                            &{$format_date}($row->{$_}) ;
1396                          } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1397                            sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1398                          } else {
1399                            $row->{$_};
1400                          }
1401                        }
1402                    @fields
1403     );
1404     print $csvfh $csv->string, "\n";
1405     $imported++;
1406     if ( time - $min_sec > $last ) {
1407       my $error = $job->update_statustext(
1408         int(100 * $imported/$count).  ",Unpacking $name"
1409       );
1410       die $error if $error;
1411       $last = time;
1412     }
1413   }
1414   $table->close;
1415   close $csvfh;
1416 }
1417
1418 sub _remember_disabled_taxes {
1419   my ( $job, $format, $disabled_tax_rate ) = @_;
1420
1421   # cch specific hash
1422
1423   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1424
1425   my @items = qsearch( { table   => 'tax_rate',
1426                          hashref => { disabled => 'Y',
1427                                       data_vendor => $format,
1428                                     },
1429                          select  => 'geocode, taxclassnum',
1430                        }
1431                      );
1432   my $count = scalar(@items);
1433   foreach my $tax_rate ( @items ) {
1434     if ( time - $min_sec > $last ) {
1435       $job->update_statustext(
1436         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1437       );
1438       $last = time;
1439     }
1440     $imported++;
1441     my $tax_class =
1442       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1443     unless ( $tax_class ) {
1444       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1445       next;
1446     }
1447     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1448   }
1449 }
1450
1451 sub _remember_tax_products {
1452   my ( $job, $format, $taxproduct ) = @_;
1453
1454   # XXX FIXME  this loop only works when cch is the only data provider
1455
1456   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1457
1458   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1459                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1460                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1461                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1462                   "       optionvalue != '' )";
1463   my @items = qsearch( { table => 'part_pkg',
1464                          select  => 'DISTINCT pkgpart,taxproductnum',
1465                          hashref => {},
1466                          extra_sql => $extra_sql,
1467                        }
1468                      );
1469   my $count = scalar(@items);
1470   foreach my $part_pkg ( @items ) {
1471     if ( time - $min_sec > $last ) {
1472       $job->update_statustext(
1473         int( 100 * $imported / $count ). ",Remembering tax products"
1474       );
1475       $last = time;
1476     }
1477     $imported++;
1478     warn "working with package part ". $part_pkg->pkgpart.
1479       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1480     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1481     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1482       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1483
1484     foreach my $option ( $part_pkg->part_pkg_option ) {
1485       next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1486       my $class = $1;
1487
1488       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1489       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1490           $part_pkg_taxproduct->taxproduct
1491         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1492     }
1493   }
1494 }
1495
1496 sub _restore_remembered_tax_products {
1497   my ( $job, $format, $taxproduct ) = @_;
1498
1499   # cch specific
1500
1501   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1502   my $count = scalar(keys %$taxproduct);
1503   foreach my $pkgpart ( keys %$taxproduct ) {
1504     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1505     if ( time - $min_sec > $last ) {
1506       $job->update_statustext(
1507         int( 100 * $imported / $count ). ",Restoring tax products"
1508       );
1509       $last = time;
1510     }
1511     $imported++;
1512
1513     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1514     unless ( $part_pkg ) {
1515       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1516     }
1517
1518     my %options = $part_pkg->options;
1519     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1520     my $primary_svc = $part_pkg->svcpart;
1521     my $new = new FS::part_pkg { $part_pkg->hash };
1522
1523     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1524       warn "working with class '$class'\n" if $DEBUG;
1525       my $part_pkg_taxproduct =
1526         qsearchs( 'part_pkg_taxproduct',
1527                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1528                     data_vendor => $format,
1529                   }
1530                 );
1531
1532       unless ( $part_pkg_taxproduct ) {
1533         return "failed to find part_pkg_taxproduct (".
1534           $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1535       }
1536
1537       if ( $class eq '' ) {
1538         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1539         next;
1540       }
1541
1542       $options{"usage_taxproductnum_$class"} =
1543         $part_pkg_taxproduct->taxproductnum;
1544
1545     }
1546
1547     my $error = $new->replace( $part_pkg,
1548                                'pkg_svc' => \%pkg_svc,
1549                                'primary_svc' => $primary_svc,
1550                                'options' => \%options,
1551     );
1552
1553     return $error if $error;
1554
1555   }
1556
1557   '';
1558 }
1559
1560 sub _restore_remembered_disabled_taxes {
1561   my ( $job, $format, $disabled_tax_rate ) = @_;
1562
1563   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1564   my $count = scalar(keys %$disabled_tax_rate);
1565   foreach my $key (keys %$disabled_tax_rate) {
1566     if ( time - $min_sec > $last ) {
1567       $job->update_statustext(
1568         int( 100 * $imported / $count ). ",Disabling tax rates"
1569       );
1570       $last = time;
1571     }
1572     $imported++;
1573     my ($geocode,$taxclass) = split /:/, $key, 2;
1574     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1575                                             taxclass    => $taxclass,
1576                                           } );
1577     return "found multiple tax_class records for format $format class $taxclass"
1578       if scalar(@tax_class) > 1;
1579
1580     unless (scalar(@tax_class)) {
1581       warn "no tax_class for format $format class $taxclass\n";
1582       next;
1583     }
1584
1585     my @tax_rate =
1586       qsearch('tax_rate', { data_vendor  => $format,
1587                             geocode      => $geocode,
1588                             taxclassnum  => $tax_class[0]->taxclassnum,
1589                           }
1590     );
1591
1592     if (scalar(@tax_rate) > 1) {
1593       return "found multiple tax_rate records for format $format geocode ".
1594              "$geocode and taxclass $taxclass ( taxclassnum ".
1595              $tax_class[0]->taxclassnum.  " )";
1596     }
1597
1598     if (scalar(@tax_rate)) {
1599       $tax_rate[0]->disabled('Y');
1600       my $error = $tax_rate[0]->replace;
1601       return $error if $error;
1602     }
1603   }
1604 }
1605
1606 sub _remove_old_tax_data {
1607   my ( $job, $format ) = @_;
1608
1609   my $dbh = dbh;
1610   my $error = $job->update_statustext( "0,Removing old tax data" );
1611   die $error if $error;
1612
1613   my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1614     "WHERE data_vendor = ".  $dbh->quote($format);
1615   $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1616
1617   my @table = qw(
1618     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1619   );
1620   foreach my $table ( @table ) {
1621     $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1622       $dbh->quote($format);
1623     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1624   }
1625
1626   if ( $format eq 'cch' ) {
1627     $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1628       $dbh->quote("$format-zip");
1629     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1630   }
1631
1632   '';
1633 }
1634
1635 sub _create_temporary_tables {
1636   my ( $job, $format ) = @_;
1637
1638   my $dbh = dbh;
1639   my $error = $job->update_statustext( "0,Creating temporary tables" );
1640   die $error if $error;
1641
1642   my @table = qw( tax_rate
1643                   tax_rate_location
1644                   part_pkg_taxrate
1645                   part_pkg_taxproduct
1646                   tax_class
1647                   cust_tax_location
1648   );
1649   foreach my $table ( @table ) {
1650     my $sql =
1651       "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1652     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1653   }
1654
1655   '';
1656 }
1657
1658 sub _copy_from_temp {
1659   my ( $job, $format ) = @_;
1660
1661   my $dbh = dbh;
1662   my $error = $job->update_statustext( "0,Making permanent" );
1663   die $error if $error;
1664
1665   my @table = qw( tax_rate
1666                   tax_rate_location
1667                   part_pkg_taxrate
1668                   part_pkg_taxproduct
1669                   tax_class
1670                   cust_tax_location
1671   );
1672   foreach my $table ( @table ) {
1673     my $sql =
1674       "INSERT INTO public.$table SELECT * from $table";
1675     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1676   }
1677
1678   '';
1679 }
1680
1681 =item process_download_and_reload
1682
1683 Download and process a tax update as a queued JSRPC job after wiping the
1684 existing wipable tax data.
1685
1686 =cut
1687
1688 sub process_download_and_reload {
1689   _process_reload('process_download_and_update', @_);
1690 }
1691
1692
1693 =item process_batch_reload
1694
1695 Load and process a tax update from the provided files as a queued JSRPC job
1696 after wiping the existing wipable tax data.
1697
1698 =cut
1699
1700 sub process_batch_reload {
1701   _process_reload('_perform_batch_import', @_);
1702 }
1703
1704
1705 sub _process_reload {
1706   my ( $method, $job ) = ( shift, shift );
1707
1708   my $param = thaw(decode_base64($_[0]));
1709   my $format = $param->{'format'};        #well... this is all cch specific
1710
1711   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1712
1713   if ( $job ) {  # progress bar
1714     my $error = $job->update_statustext( 0 );
1715     die $error if $error;
1716   }
1717
1718   my $oldAutoCommit = $FS::UID::AutoCommit;
1719   local $FS::UID::AutoCommit = 0;
1720   my $dbh = dbh;
1721   my $error = '';
1722
1723   my $sql =
1724     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1725     "USING (taxclassnum) WHERE data_vendor = '$format'";
1726   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1727   $sth->execute
1728     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1729   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1730     if $sth->fetchrow_arrayref->[0];
1731
1732   # really should get a table EXCLUSIVE lock here
1733
1734   #remember disabled taxes
1735   my %disabled_tax_rate = ();
1736   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1737
1738   #remember tax products
1739   my %taxproduct = ();
1740   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1741
1742   #create temp tables
1743   $error ||= _create_temporary_tables( $job, $format );
1744
1745   #import new data
1746   unless ($error) {
1747     my $args = '$job, @_';
1748     eval "$method($args);";
1749     $error = $@ if $@;
1750   }
1751
1752   #restore taxproducts
1753   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1754
1755   #disable tax_rates
1756   $error ||=
1757    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1758
1759   #wipe out the old data
1760   $error ||= _remove_old_tax_data( $job, $format );
1761
1762   #untemporize
1763   $error ||= _copy_from_temp( $job, $format );
1764
1765   if ($error) {
1766     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1767     die $error;
1768   }
1769
1770   #success!
1771   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1772 }
1773
1774
1775 =item process_download_and_update
1776
1777 Download and process a tax update as a queued JSRPC job
1778
1779 =cut
1780
1781 sub process_download_and_update {
1782   my $job = shift;
1783
1784   my $param = thaw(decode_base64(shift));
1785   my $format = $param->{'format'};        #well... this is all cch specific
1786
1787   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1788
1789   if ( $job ) {  # progress bar
1790     my $error = $job->update_statustext( 0);
1791     die $error if $error;
1792   }
1793
1794   my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1795   my $dir = $cache_dir. 'taxdata';
1796   unless (-d $dir) {
1797     mkdir $dir or die "can't create $dir: $!\n";
1798   }
1799
1800   if ($format eq 'cch') {
1801
1802     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1803
1804     my $conf = new FS::Conf;
1805     die "direct download of tax data not enabled\n"
1806       unless $conf->exists('taxdatadirectdownload');
1807     my ( $urls, $username, $secret, $states ) =
1808       $conf->config('taxdatadirectdownload');
1809     die "No tax download URL provided.  ".
1810         "Did you set the taxdatadirectdownload configuration value?\n"
1811       unless $urls;
1812
1813     $dir .= '/cch';
1814
1815     my $dbh = dbh;
1816     my $error = '';
1817
1818     # really should get a table EXCLUSIVE lock here
1819     # check if initial import or update
1820     #
1821     # relying on mkdir "$dir.new" as a mutex
1822
1823     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1824     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1825     $sth->execute() or die $sth->errstr;
1826     my $update = $sth->fetchrow_arrayref->[0];
1827
1828     # create cache and/or rotate old tax data
1829
1830     if (-d $dir) {
1831
1832       if (-d "$dir.9") {
1833         opendir(my $dirh, "$dir.9") or die "failed to open $dir.9: $!\n";
1834         foreach my $file (readdir($dirh)) {
1835           unlink "$dir.9/$file" if (-f "$dir.9/$file");
1836         }
1837         closedir($dirh);
1838         rmdir "$dir.9";
1839       }
1840
1841       for (8, 7, 6, 5, 4, 3, 2, 1) {
1842         if ( -e "$dir.$_" ) {
1843           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1844         }
1845       }
1846       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1847
1848     } else {
1849
1850       die "can't find previous tax data\n" if $update;
1851
1852     }
1853
1854     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1855
1856     # fetch and unpack the zip files
1857
1858     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1859
1860     # extract csv files from the dbf files
1861
1862     foreach my $name ( @namelist ) {
1863       _cch_extract_csv_from_dbf( $job, $dir, $name );
1864     }
1865
1866     # generate the diff files
1867
1868     my @list = ();
1869     foreach my $name ( @namelist ) {
1870       my $difffile = "$dir.new/$name.txt";
1871       if ($update) {
1872         my $error = $job->update_statustext( "0,Comparing to previous $name" );
1873         die $error if $error;
1874         warn "processing $dir.new/$name.txt\n" if $DEBUG;
1875         my $olddir = $update ? "$dir.1" : "";
1876         $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1877       }
1878       $difffile =~ s/^$cache_dir//;
1879       push @list, "${name}file:$difffile";
1880     }
1881
1882     # perform the import
1883     local $keep_cch_files = 1;
1884     $param->{uploaded_files} = join( ',', @list );
1885     $param->{format} .= '-update' if $update;
1886     $error ||=
1887       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1888
1889     rename "$dir.new", "$dir"
1890       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1891
1892   }else{
1893     die "Unknown format: $format";
1894   }
1895 }
1896
1897 =item browse_queries PARAMS
1898
1899 Returns a list consisting of a hashref suited for use as the argument
1900 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1901 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1902 from a form.  This conveniently creates the query hashref and count_query
1903 string required by the browse and search elements.  As a side effect,
1904 the PARAMS hashref is untainted and keys with unexpected values are removed.
1905
1906 =cut
1907
1908 sub browse_queries {
1909   my $params = shift;
1910
1911   my $query = {
1912                 'table'     => 'tax_rate',
1913                 'hashref'   => {},
1914                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1915               },
1916
1917   my $extra_sql = '';
1918
1919   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1920     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1921   } else {
1922     delete $params->{data_vendor};
1923   }
1924
1925   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1926     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1927                     'geocode LIKE '. dbh->quote($1.'%');
1928   } else {
1929     delete $params->{geocode};
1930   }
1931
1932   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1933        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1934      )
1935   {
1936     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1937                   ' taxclassnum  = '. dbh->quote($1)
1938   } else {
1939     delete $params->{taxclassnun};
1940   }
1941
1942   my $tax_type = $1
1943     if ( $params->{tax_type} =~ /^(\d+)$/ );
1944   delete $params->{tax_type}
1945     unless $tax_type;
1946
1947   my $tax_cat = $1
1948     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1949   delete $params->{tax_cat}
1950     unless $tax_cat;
1951
1952   my @taxclassnum = ();
1953   if ($tax_type || $tax_cat ) {
1954     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1955     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1956     @taxclassnum = map { $_->taxclassnum }
1957                    qsearch({ 'table'     => 'tax_class',
1958                              'hashref'   => {},
1959                              'extra_sql' => "WHERE taxclass $compare",
1960                           });
1961   }
1962
1963   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1964                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1965     if ( @taxclassnum );
1966
1967   unless ($params->{'showdisabled'}) {
1968     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1969                   "( disabled = '' OR disabled IS NULL )";
1970   }
1971
1972   $query->{extra_sql} = $extra_sql;
1973
1974   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1975 }
1976
1977 =item queue_liability_report PARAMS
1978
1979 Launches a tax liability report.
1980
1981 PARAMS needs to be a base64-encoded Storable hash containing:
1982 - beginning: the start date, as a I<user-readable string> (not a timestamp).
1983 - end: the end date of the report, likewise.
1984 - agentnum: the agent to limit the report to, if any.
1985
1986 =cut
1987
1988 sub queue_liability_report {
1989   my $job = shift;
1990   my $param = thaw(decode_base64(shift));
1991
1992   my $cgi = new CGI;
1993   $cgi->param('beginning', $param->{beginning});
1994   $cgi->param('ending', $param->{ending});
1995   my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1996   my $agentnum = $param->{agentnum};
1997   if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1998   generate_liability_report(
1999     'beginning' => $beginning,
2000     'ending'    => $ending,
2001     'agentnum'  => $agentnum,
2002     'p'         => $param->{RootURL},
2003     'job'       => $job,
2004   );
2005 }
2006
2007 =item generate_liability_report PARAMS
2008
2009 Generates a tax liability report.  PARAMS must include:
2010
2011 - beginning, as a timestamp
2012 - ending, as a timestamp
2013 - p: the Freeside root URL, for generating links
2014 - agentnum (optional)
2015
2016 =cut
2017
2018 #shit, all sorts of false laxiness w/report_newtax.cgi
2019 sub generate_liability_report {
2020   my %args = @_;
2021
2022   my ( $count, $last, $min_sec ) = _progressbar_foo();
2023
2024   #let us open the temp file early
2025   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
2026   my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
2027                                DIR      => $dir,
2028                                UNLINK   => 0, # not so temp
2029                              ) or die "can't open report file: $!\n";
2030
2031   my $conf = new FS::Conf;
2032   my $money_char = $conf->config('money_char') || '$';
2033
2034   my $join_cust = "
2035       JOIN cust_bill USING ( invnum )
2036       LEFT JOIN cust_main USING ( custnum )
2037   ";
2038
2039   my $join_loc =
2040     "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
2041   my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
2042
2043   my $addl_from = " $join_cust $join_loc $join_tax_loc ";
2044
2045   my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
2046
2047   my $agentname = '';
2048   if ( $args{agentnum} =~ /^(\d+)$/ ) {
2049     my $agent = qsearchs('agent', { 'agentnum' => $1 } );
2050     die "agent not found" unless $agent;
2051     $agentname = $agent->agent;
2052     $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
2053   }
2054
2055   #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
2056   my @taxparams = qw( city county state locationtaxid );
2057   my @params = ('itemdesc', @taxparams);
2058
2059   my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
2060
2061   #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
2062   #to FS::Report or FS::Record or who the fuck knows where)
2063   my $scalar_sql = sub {
2064     my( $r, $param, $sql ) = @_;
2065     my $sth = dbh->prepare($sql) or die dbh->errstr;
2066     $sth->execute( map $r->$_(), @$param )
2067       or die "Unexpected error executing statement $sql: ". $sth->errstr;
2068     $sth->fetchrow_arrayref->[0] || 0;
2069   };
2070
2071   my $tax = 0;
2072   my $credit = 0;
2073   my %taxes = ();
2074   my %basetaxes = ();
2075   my $calculated = 0;
2076
2077   # get all distinct tuples of (tax name, state, county, city, locationtaxid)
2078   # for taxes that have been charged
2079   # (state, county, city are from tax_rate_location, not from customer data)
2080   my @tax_and_location = qsearch({ table     => 'cust_bill_pkg',
2081                                    select    => $select,
2082                                    hashref   => { pkgpart => 0 },
2083                                    addl_from => $addl_from,
2084                                    extra_sql => $where,
2085                                    debug     => 1,
2086                                 });
2087   $count = scalar(@tax_and_location);
2088   foreach my $t ( @tax_and_location ) {
2089
2090     if ( $args{job} ) {
2091       if ( time - $min_sec > $last ) {
2092         $args{job}->update_statustext( int( 100 * $calculated / $count ).
2093                                        ",Calculating"
2094                                      );
2095         $last = time;
2096       }
2097     }
2098
2099     #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
2100     my $label = join('~', map { $t->$_ } @params);
2101     $label = 'Tax'. $label if $label =~ /^~/;
2102     unless ( exists( $taxes{$label} ) ) {
2103       my ($baselabel, @trash) = split /~/, $label;
2104
2105       $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
2106       $taxes{$label}->{'url_param'} =
2107         join(';', map { "$_=". uri_escape($t->$_) } @params);
2108
2109       my $itemdesc_loc =
2110       # "    payby != 'COMP' ". # breaks the entire report under 4.x
2111       #                         # and unnecessary since COMP accounts don't
2112       #                         # get taxes calculated in the first place
2113         "    ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
2114         "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
2115                                                          @taxparams
2116                                                    );
2117
2118       my $taxwhere =
2119         "FROM cust_bill_pkg $addl_from $where AND $itemdesc_loc";
2120
2121       my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
2122
2123       my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2124       $tax += $x;
2125       $taxes{$label}->{'tax'} += $x;
2126
2127       my $creditfrom =
2128        "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
2129       my $creditwhere =
2130         "FROM cust_bill_pkg $addl_from $creditfrom $where AND $itemdesc_loc";
2131
2132       $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
2133              " $creditwhere AND cust_bill_pkg.pkgnum = 0";
2134
2135       my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
2136       $credit += $y;
2137       $taxes{$label}->{'credit'} += $y;
2138
2139       unless ( exists( $taxes{$baselabel} ) ) {
2140
2141         $basetaxes{$baselabel}->{'label'} = $baselabel;
2142         $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
2143         $basetaxes{$baselabel}->{'base'} = 1;
2144
2145       }
2146
2147       $basetaxes{$baselabel}->{'tax'} += $x;
2148       $basetaxes{$baselabel}->{'credit'} += $y;
2149
2150     }
2151
2152     # calculate customer-exemption for this tax
2153     # calculate package-exemption for this tax
2154     # calculate monthly exemption (texas tax) for this tax
2155     # count up all the cust_tax_exempt_pkg records associated with
2156     # the actual line items.
2157   }
2158
2159
2160   #ordering
2161
2162   if ( $args{job} ) {
2163     $args{job}->update_statustext( "0,Sorted" );
2164     $last = time;
2165   }
2166
2167   my @taxes = ();
2168
2169   foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
2170     my ($base, @trash) = split '~', $tax;
2171     my $basetax = delete( $basetaxes{$base} );
2172     if ($basetax) {
2173       if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
2174         $taxes{$tax}->{base} = 1;
2175       } else {
2176         push @taxes, $basetax;
2177       }
2178     }
2179     push @taxes, $taxes{$tax};
2180   }
2181
2182   push @taxes, {
2183     'label'          => 'Total',
2184     'url_param'      => '',
2185     'tax'            => $tax,
2186     'credit'         => $credit,
2187     'base'           => 1,
2188   };
2189
2190
2191   my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
2192   $dateagentlink .= ';agentnum='. $args{agentnum}
2193     if length($agentname);
2194   my $baselink   = $args{p}. "search/cust_bill_pkg.cgi?vendortax=1;" .
2195                              $dateagentlink;
2196   my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
2197
2198   print $report <<EOF;
2199
2200     <% include("/elements/header.html", "$agentname Tax Report - ".
2201                   ( $args{beginning}
2202                       ? time2str('%h %o %Y ', $args{beginning} )
2203                       : ''
2204                   ).
2205                   'through '.
2206                   ( $args{ending} == 4294967295
2207                       ? 'now'
2208                       : time2str('%h %o %Y', $args{ending} )
2209                   )
2210               )
2211     %>
2212
2213     <% include('/elements/table-grid.html') %>
2214
2215     <TR>
2216       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2217       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2218       <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2219       <TH CLASS="grid" BGCOLOR="#cccccc">&nbsp;&nbsp;&nbsp;&nbsp;</TH>
2220       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2221       <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2222     </TR>
2223 EOF
2224
2225   my $bgcolor1 = '#eeeeee';
2226   my $bgcolor2 = '#ffffff';
2227   my $bgcolor = '';
2228
2229   $count = scalar(@taxes);
2230   $calculated = 0;
2231   foreach my $tax ( @taxes ) {
2232
2233     if ( $args{job} ) {
2234       if ( time - $min_sec > $last ) {
2235         $args{job}->update_statustext( int( 100 * $calculated / $count ).
2236                                        ",Generated"
2237                                      );
2238         $last = time;
2239       }
2240     }
2241
2242     if ( $bgcolor eq $bgcolor1 ) {
2243       $bgcolor = $bgcolor2;
2244     } else {
2245       $bgcolor = $bgcolor1;
2246     }
2247
2248     my $link = '';
2249     if ( $tax->{'label'} ne 'Total' ) {
2250       $link = ';'. $tax->{'url_param'};
2251     }
2252
2253     print $report <<EOF;
2254       <TR>
2255         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2256         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2257         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2258           <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2259         </TD>
2260         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2261         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2262         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2263         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2264           <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2265         </TD>
2266         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2267       </TR>
2268 EOF
2269   }
2270
2271   print $report <<EOF;
2272     </TABLE>
2273
2274     </BODY>
2275     </HTML>
2276 EOF
2277
2278   my $reportname = $report->filename;
2279   close $report;
2280
2281   my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2282   $reportname =~ s/^$dropstring//;
2283
2284   my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2285   die "<a href=$reporturl>view</a>\n";
2286
2287 }
2288
2289
2290
2291 =back
2292
2293 =head1 BUGS
2294
2295   Mixing automatic and manual editing works poorly at present.
2296
2297   Tax liability calculations take too long and arguably don't belong here.
2298   Tax liability report generation not entirely safe (escaped).
2299
2300 =head1 SEE ALSO
2301
2302 L<FS::Record>, L<FS::cust_location>, L<FS::cust_bill>
2303
2304 =cut
2305
2306 1;
2307