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