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