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