FS/FS/tax_rate.pm

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