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