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