FS/FS/tax_rate.pm

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