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