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