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     if ( scalar( @columns ) ) {
 762       $dbh->rollback if $oldAutoCommit;
 763       return "Unexpected trailing columns in line (wrong format?): $line";
 764     }
 765
 766     my $error = &{$hook}(\%tax_rate);
 767     if ( $error ) {
 768       $dbh->rollback if $oldAutoCommit;
 769       return $error;
 770     }
 771
 772     if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
 773
 774       my $tax_rate = new FS::tax_rate( \%tax_rate );
 775       $error = $tax_rate->insert;
 776
 777       if ( $error ) {
 778         $dbh->rollback if $oldAutoCommit;
 779         return "can't insert tax_rate for $line: $error";
 780       }
 781
 782     }
 783
 784     $imported++;
 785
 786   }
 787
 788   for (grep { !exists($delete{$_}) } keys %insert) {
 789     if ( $job ) {  # progress bar
 790       if ( time - $min_sec > $last ) {
 791         my $error = $job->update_statustext(
 792           int( 100 * $imported / $count ). ",Importing tax rates"
 793         );
 794         if ($error) {
 795           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 796           die $error;
 797         }
 798         $last = time;
 799       }
 800     }
 801
 802     my $tax_rate = new FS::tax_rate( $insert{$_} );
 803     my $error = $tax_rate->insert;
 804
 805     if ( $error ) {
 806       $dbh->rollback if $oldAutoCommit;
 807       my $hashref = $insert{$_};
 808       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 809       return "can't insert tax_rate for $line: $error";
 810     }
 811
 812     $imported++;
 813   }
 814
 815   for (grep { exists($delete{$_}) } keys %insert) {
 816     if ( $job ) {  # progress bar
 817       if ( time - $min_sec > $last ) {
 818         my $error = $job->update_statustext(
 819           int( 100 * $imported / $count ). ",Importing tax rates"
 820         );
 821         if ($error) {
 822           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 823           die $error;
 824         }
 825         $last = time;
 826       }
 827     }
 828
 829     my $old = qsearchs( 'tax_rate', $delete{$_} );
 830     unless ($old) {
 831       $dbh->rollback if $oldAutoCommit;
 832       $old = $delete{$_};
 833       return "can't find tax_rate to replace for: ".
 834         #join(" ", map { "$_ => ". $old->{$_} } @fields);
 835         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
 836     }
 837     my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
 838     $new->taxnum($old->taxnum);
 839     my $error = $new->replace($old);
 840
 841     if ( $error ) {
 842       $dbh->rollback if $oldAutoCommit;
 843       my $hashref = $insert{$_};
 844       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 845       return "can't replace tax_rate for $line: $error";
 846     }
 847
 848     $imported++;
 849     $imported++;
 850   }
 851
 852   for (grep { !exists($insert{$_}) } keys %delete) {
 853     if ( $job ) {  # progress bar
 854       if ( time - $min_sec > $last ) {
 855         my $error = $job->update_statustext(
 856           int( 100 * $imported / $count ). ",Importing tax rates"
 857         );
 858         if ($error) {
 859           $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 860           die $error;
 861         }
 862         $last = time;
 863       }
 864     }
 865
 866     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
 867     unless ($tax_rate) {
 868       $dbh->rollback if $oldAutoCommit;
 869       $tax_rate = $delete{$_};
 870       return "can't find tax_rate to delete for: ".
 871         #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
 872         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
 873     }
 874     my $error = $tax_rate->delete;
 875
 876     if ( $error ) {
 877       $dbh->rollback if $oldAutoCommit;
 878       my $hashref = $delete{$_};
 879       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 880       return "can't delete tax_rate for $line: $error";
 881     }
 882
 883     $imported++;
 884   }
 885
 886   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 887
 888   return "Empty file!" unless ($imported || $format eq 'cch-update');
 889
 890   ''; #no error
 891
 892 }
 893
 894 =item process_batch_import
 895
 896 Load a batch import as a queued JSRPC job
 897
 898 =cut
 899
 900 sub process_batch_import {
 901   my $job = shift;
 902
 903   my $oldAutoCommit = $FS::UID::AutoCommit;
 904   local $FS::UID::AutoCommit = 0;
 905   my $dbh = dbh;
 906
 907   my $param = thaw(decode_base64(shift));
 908   my $args = '$job, encode_base64( nfreeze( $param ) )';
 909
 910   my $method = '_perform_batch_import';
 911   if ( $param->{reload} ) {
 912     $method = 'process_batch_reload';
 913   }
 914
 915   eval "$method($args);";
 916   if ($@) {
 917     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 918     die $@;
 919   }
 920
 921   #success!
 922   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 923 }
 924
 925 sub _perform_batch_import {
 926   my $job = shift;
 927
 928   my $param = thaw(decode_base64(shift));
 929   my $format = $param->{'format'};        #well... this is all cch specific
 930
 931   my $files = $param->{'uploaded_files'}
 932     or die "No files provided.";
 933
 934   my (%files) = map { /^(\w+):((taxdata\/\w+\.\w+\/)?[\.\w]+)$/ ? ($1,$2):() }
 935                 split /,/, $files;
 936
 937   if ( $format eq 'cch' || $format eq 'cch-fixed'
 938     || $format eq 'cch-update' || $format eq 'cch-fixed-update' )
 939   {
 940
 941     my $oldAutoCommit = $FS::UID::AutoCommit;
 942     local $FS::UID::AutoCommit = 0;
 943     my $dbh = dbh;
 944     my $error = '';
 945     my @insert_list = ();
 946     my @delete_list = ();
 947     my @predelete_list = ();
 948     my $insertname = '';
 949     my $deletename = '';
 950     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
 951
 952     my @list = ( 'GEOCODE',  \&FS::tax_rate_location::batch_import,
 953                  'CODE',     \&FS::tax_class::batch_import,
 954                  'PLUS4',    \&FS::cust_tax_location::batch_import,
 955                  'ZIP',      \&FS::cust_tax_location::batch_import,
 956                  'TXMATRIX', \&FS::part_pkg_taxrate::batch_import,
 957                  'DETAIL',   \&FS::tax_rate::batch_import,
 958                );
 959     while( scalar(@list) ) {
 960       my ( $name, $import_sub ) = splice( @list, 0, 2 );
 961       my $file = lc($name). 'file';
 962
 963       unless ($files{$file}) {
 964         $error = "No $name supplied";
 965         next;
 966       }
 967       next if $name eq 'DETAIL' && $format =~ /update/;
 968
 969       my $filename = "$dir/".  $files{$file};
 970
 971       if ( $format =~ /update/ ) {
 972
 973         ( $error, $insertname, $deletename ) =
 974           _perform_cch_insert_delete_split( $name, $filename, $dir, $format )
 975           unless $error;
 976         last if $error;
 977
 978         unlink $filename or warn "Can't delete $filename: $!"
 979           unless $keep_cch_files;
 980         push @insert_list, $name, $insertname, $import_sub, $format;
 981         if ( $name eq 'GEOCODE' ) { #handle this whole ordering issue better
 982           unshift @predelete_list, $name, $deletename, $import_sub, $format;
 983         } else {
 984           unshift @delete_list, $name, $deletename, $import_sub, $format;
 985         }
 986
 987       } else {
 988
 989         push @insert_list, $name, $filename, $import_sub, $format;
 990
 991       }
 992
 993     }
 994
 995     push @insert_list,
 996       'DETAIL', "$dir/".$files{detail}, \&FS::tax_rate::batch_import, $format
 997       if $format =~ /update/;
 998
 999     $error ||= _perform_cch_tax_import( $job,
1000                                         [ @predelete_list ],
1001                                         [ @insert_list ],
1002                                         [ @delete_list ],
1003     );
1004
1005
1006     @list = ( @predelete_list, @insert_list, @delete_list );
1007     while( !$keep_cch_files && scalar(@list) ) {
1008       my ( undef, $file, undef, undef ) = splice( @list, 0, 4 );
1009       unlink $file or warn "Can't delete $file: $!";
1010     }
1011
1012     if ($error) {
1013       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1014       die $error;
1015     }else{
1016       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1017     }
1018
1019   }else{
1020     die "Unknown format: $format";
1021   }
1022
1023 }
1024
1025
1026 sub _perform_cch_tax_import {
1027   my ( $job, $predelete_list, $insert_list, $delete_list ) = @_;
1028
1029   my $error = '';
1030   foreach my $list ($predelete_list, $insert_list, $delete_list) {
1031     while( scalar(@$list) ) {
1032       my ( $name, $file, $method, $format ) = splice( @$list, 0, 4 );
1033       my $fmt = "$format-update";
1034       $fmt = $format. ( lc($name) eq 'zip' ? '-zip' : '' );
1035       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
1036       $error ||= &{$method}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
1037       close $fh;
1038     }
1039   }
1040
1041   return $error;
1042 }
1043
1044 sub _perform_cch_insert_delete_split {
1045   my ($name, $filename, $dir, $format) = @_;
1046
1047   my $error = '';
1048
1049   open my $fh, "< $filename"
1050     or $error ||= "Can't open $name file $filename: $!";
1051
1052   my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
1053                             DIR      => $dir,
1054                             UNLINK   => 0,     #meh
1055                           ) or die "can't open temp file: $!\n";
1056   my $insertname = $ifh->filename;
1057
1058   my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
1059                             DIR      => $dir,
1060                             UNLINK   => 0,     #meh
1061                           ) or die "can't open temp file: $!\n";
1062   my $deletename = $dfh->filename;
1063
1064   my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
1065   my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
1066   while(<$fh>) {
1067     my $handle = '';
1068     $handle = $ifh if $_ =~ /$insert_pattern/;
1069     $handle = $dfh if $_ =~ /$delete_pattern/;
1070     unless ($handle) {
1071       $error = "bad input line: $_" unless $handle;
1072       last;
1073     }
1074     print $handle $_;
1075   }
1076   close $fh;
1077   close $ifh;
1078   close $dfh;
1079
1080   return ($error, $insertname, $deletename);
1081 }
1082
1083 sub _perform_cch_diff {
1084   my ($name, $newdir, $olddir) = @_;
1085
1086   my %oldlines = ();
1087
1088   if ($olddir) {
1089     open my $oldcsvfh, "$olddir/$name.txt"
1090       or die "failed to open $olddir/$name.txt: $!\n";
1091
1092     while(<$oldcsvfh>) {
1093       chomp;
1094       $oldlines{$_} = 1;
1095     }
1096     close $oldcsvfh;
1097   }
1098
1099   open my $newcsvfh, "$newdir/$name.txt"
1100     or die "failed to open $newdir/$name.txt: $!\n";
1101
1102   my $dfh = new File::Temp( TEMPLATE => "$name.diff.XXXXXXXX",
1103                             DIR      => "$newdir",
1104                             UNLINK   => 0,     #meh
1105                           ) or die "can't open temp file: $!\n";
1106   my $diffname = $dfh->filename;
1107
1108   while(<$newcsvfh>) {
1109     chomp;
1110     if (exists($oldlines{$_})) {
1111       $oldlines{$_} = 0;
1112     } else {
1113       print $dfh $_, ',"I"', "\n";
1114     }
1115   }
1116   close $newcsvfh;
1117
1118   for (keys %oldlines) {
1119     print $dfh $_, ',"D"', "\n" if $oldlines{$_};
1120   }
1121
1122   close $dfh;
1123
1124   return $diffname;
1125 }
1126
1127 sub _cch_fetch_and_unzip {
1128   my ( $job, $urls, $secret, $dir ) = @_;
1129
1130   my $ua = new LWP::UserAgent;
1131   foreach my $url (split ',', $urls) {
1132     my @name = split '/', $url;  #somewhat restrictive
1133     my $name = pop @name;
1134     $name =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1135     $name = $1;
1136
1137     open my $taxfh, ">$dir/$name" or die "Can't open $dir/$name: $!\n";
1138
1139     my ( $imported, $last, $min_sec ) = _progressbar_foo();
1140     my $res = $ua->request(
1141       new HTTP::Request( GET => $url ),
1142       sub {
1143             print $taxfh $_[0] or die "Can't write to $dir/$name: $!\n";
1144             my $content_length = $_[1]->content_length;
1145             $imported += length($_[0]);
1146             if ( time - $min_sec > $last ) {
1147               my $error = $job->update_statustext(
1148                 ($content_length ? int(100 * $imported/$content_length) : 0 ).
1149                 ",Downloading data from CCH"
1150               );
1151               die $error if $error;
1152               $last = time;
1153             }
1154       },
1155     );
1156     die "download of $url failed: ". $res->status_line
1157       unless $res->is_success;
1158
1159     close $taxfh;
1160     my $error = $job->update_statustext( "0,Unpacking data" );
1161     die $error if $error;
1162     $secret =~ /([\w.]+)/; # untaint that which we don't trust so much any more
1163     $secret = $1;
1164     system('unzip', "-P", $secret, "-d", "$dir",  "$dir/$name") == 0
1165       or die "unzip -P $secret -d $dir $dir/$name failed";
1166     #unlink "$dir/$name";
1167   }
1168 }
1169
1170 sub _cch_extract_csv_from_dbf {
1171   my ( $job, $dir, $name ) = @_;
1172
1173   eval "use Text::CSV_XS;";
1174   die $@ if $@;
1175
1176   eval "use XBase;";
1177   die $@ if $@;
1178
1179   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1180   my $error = $job->update_statustext( "0,Unpacking $name" );
1181   die $error if $error;
1182   warn "opening $dir.new/$name.dbf\n" if $DEBUG;
1183   my $table = new XBase 'name' => "$dir.new/$name.dbf";
1184   die "failed to access $dir.new/$name.dbf: ". XBase->errstr
1185     unless defined($table);
1186   my $count = $table->last_record; # approximately;
1187   open my $csvfh, ">$dir.new/$name.txt"
1188     or die "failed to open $dir.new/$name.txt: $!\n";
1189
1190   my $csv = new Text::CSV_XS { 'always_quote' => 1 };
1191   my @fields = $table->field_names;
1192   my $cursor = $table->prepare_select;
1193   my $format_date =
1194     sub { my $date = shift;
1195           $date =~ /^(\d{4})(\d{2})(\d{2})$/ && ($date = "$2/$3/$1");
1196           $date;
1197         };
1198   while (my $row = $cursor->fetch_hashref) {
1199     $csv->combine( map { my $type = $table->field_type($_);
1200                          if ($type eq 'D') {
1201                            &{$format_date}($row->{$_}) ;
1202                          } elsif ($type eq 'N' && $row->{$_} =~ /e-/i ) {
1203                            sprintf('%.8f', $row->{$_}); #db row is numeric(14,8)
1204                          } else {
1205                            $row->{$_};
1206                          }
1207                        }
1208                    @fields
1209     );
1210     print $csvfh $csv->string, "\n";
1211     $imported++;
1212     if ( time - $min_sec > $last ) {
1213       my $error = $job->update_statustext(
1214         int(100 * $imported/$count).  ",Unpacking $name"
1215       );
1216       die $error if $error;
1217       $last = time;
1218     }
1219   }
1220   $table->close;
1221   close $csvfh;
1222 }
1223
1224 sub _remember_disabled_taxes {
1225   my ( $job, $format, $disabled_tax_rate ) = @_;
1226
1227   # cch specific hash
1228
1229   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1230
1231   my @items = qsearch( { table   => 'tax_rate',
1232                          hashref => { disabled => 'Y',
1233                                       data_vendor => $format,
1234                                     },
1235                          select  => 'geocode, taxclassnum',
1236                        }
1237                      );
1238   my $count = scalar(@items);
1239   foreach my $tax_rate ( @items ) {
1240     if ( time - $min_sec > $last ) {
1241       $job->update_statustext(
1242         int( 100 * $imported / $count ). ",Remembering disabled taxes"
1243       );
1244       $last = time;
1245     }
1246     $imported++;
1247     my $tax_class =
1248       qsearchs( 'tax_class', { taxclassnum => $tax_rate->taxclassnum } );
1249     unless ( $tax_class ) {
1250       warn "failed to find tax_class ". $tax_rate->taxclassnum;
1251       next;
1252     }
1253     $disabled_tax_rate->{$tax_rate->geocode. ':'. $tax_class->taxclass} = 1;
1254   }
1255 }
1256
1257 sub _remember_tax_products {
1258   my ( $job, $format, $taxproduct ) = @_;
1259
1260   # XXX FIXME  this loop only works when cch is the only data provider
1261
1262   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1263
1264   my $extra_sql = "WHERE taxproductnum IS NOT NULL OR ".
1265                   "0 < ( SELECT count(*) from part_pkg_option WHERE ".
1266                   "       part_pkg_option.pkgpart = part_pkg.pkgpart AND ".
1267                   "       optionname LIKE 'usage_taxproductnum_%' AND ".
1268                   "       optionvalue != '' )";
1269   my @items = qsearch( { table => 'part_pkg',
1270                          select  => 'DISTINCT pkgpart,taxproductnum',
1271                          hashref => {},
1272                          extra_sql => $extra_sql,
1273                        }
1274                      );
1275   my $count = scalar(@items);
1276   foreach my $part_pkg ( @items ) {
1277     if ( time - $min_sec > $last ) {
1278       $job->update_statustext(
1279         int( 100 * $imported / $count ). ",Remembering tax products"
1280       );
1281       $last = time;
1282     }
1283     $imported++;
1284     warn "working with package part ". $part_pkg->pkgpart.
1285       "which has a taxproductnum of ". $part_pkg->taxproductnum. "\n" if $DEBUG;
1286     my $part_pkg_taxproduct = $part_pkg->taxproduct('');
1287     $taxproduct->{$part_pkg->pkgpart}->{''} = $part_pkg_taxproduct->taxproduct
1288       if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1289
1290     foreach my $option ( $part_pkg->part_pkg_option ) {
1291       next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/;
1292       my $class = $1;
1293
1294       $part_pkg_taxproduct = $part_pkg->taxproduct($class);
1295       $taxproduct->{$part_pkg->pkgpart}->{$class} =
1296           $part_pkg_taxproduct->taxproduct
1297         if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format;
1298     }
1299   }
1300 }
1301
1302 sub _restore_remembered_tax_products {
1303   my ( $job, $format, $taxproduct ) = @_;
1304
1305   # cch specific
1306
1307   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1308   my $count = scalar(keys %$taxproduct);
1309   foreach my $pkgpart ( keys %$taxproduct ) {
1310     warn "restoring taxproductnums on pkgpart $pkgpart\n" if $DEBUG;
1311     if ( time - $min_sec > $last ) {
1312       $job->update_statustext(
1313         int( 100 * $imported / $count ). ",Restoring tax products"
1314       );
1315       $last = time;
1316     }
1317     $imported++;
1318
1319     my $part_pkg = qsearchs('part_pkg', { pkgpart => $pkgpart } );
1320     unless ( $part_pkg ) {
1321       return "somehow failed to find part_pkg with pkgpart $pkgpart!\n";
1322     }
1323
1324     my %options = $part_pkg->options;
1325     my %pkg_svc = map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc;
1326     my $primary_svc = $part_pkg->svcpart;
1327     my $new = new FS::part_pkg { $part_pkg->hash };
1328
1329     foreach my $class ( keys %{ $taxproduct->{$pkgpart} } ) {
1330       warn "working with class '$class'\n" if $DEBUG;
1331       my $part_pkg_taxproduct =
1332         qsearchs( 'part_pkg_taxproduct',
1333                   { taxproduct  => $taxproduct->{$pkgpart}->{$class},
1334                     data_vendor => $format,
1335                   }
1336                 );
1337
1338       unless ( $part_pkg_taxproduct ) {
1339         return "failed to find part_pkg_taxproduct (".
1340           $taxproduct->{$pkgpart}->{$class}. ") for pkgpart $pkgpart\n";
1341       }
1342
1343       if ( $class eq '' ) {
1344         $new->taxproductnum($part_pkg_taxproduct->taxproductnum);
1345         next;
1346       }
1347
1348       $options{"usage_taxproductnum_$class"} =
1349         $part_pkg_taxproduct->taxproductnum;
1350
1351     }
1352
1353     my $error = $new->replace( $part_pkg,
1354                                'pkg_svc' => \%pkg_svc,
1355                                'primary_svc' => $primary_svc,
1356                                'options' => \%options,
1357     );
1358
1359     return $error if $error;
1360
1361   }
1362
1363   '';
1364 }
1365
1366 sub _restore_remembered_disabled_taxes {
1367   my ( $job, $format, $disabled_tax_rate ) = @_;
1368
1369   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1370   my $count = scalar(keys %$disabled_tax_rate);
1371   foreach my $key (keys %$disabled_tax_rate) {
1372     if ( time - $min_sec > $last ) {
1373       $job->update_statustext(
1374         int( 100 * $imported / $count ). ",Disabling tax rates"
1375       );
1376       $last = time;
1377     }
1378     $imported++;
1379     my ($geocode,$taxclass) = split /:/, $key, 2;
1380     my @tax_class = qsearch( 'tax_class', { data_vendor => $format,
1381                                             taxclass    => $taxclass,
1382                                           } );
1383     return "found multiple tax_class records for format $format class $taxclass"
1384       if scalar(@tax_class) > 1;
1385
1386     unless (scalar(@tax_class)) {
1387       warn "no tax_class for format $format class $taxclass\n";
1388       next;
1389     }
1390
1391     my @tax_rate =
1392       qsearch('tax_rate', { data_vendor  => $format,
1393                             geocode      => $geocode,
1394                             taxclassnum  => $tax_class[0]->taxclassnum,
1395                           }
1396     );
1397
1398     if (scalar(@tax_rate) > 1) {
1399       return "found multiple tax_rate records for format $format geocode ".
1400              "$geocode and taxclass $taxclass ( taxclassnum ".
1401              $tax_class[0]->taxclassnum.  " )";
1402     }
1403
1404     if (scalar(@tax_rate)) {
1405       $tax_rate[0]->disabled('Y');
1406       my $error = $tax_rate[0]->replace;
1407       return $error if $error;
1408     }
1409   }
1410 }
1411
1412 sub _remove_old_tax_data {
1413   my ( $job, $format ) = @_;
1414
1415   my $dbh = dbh;
1416   my $error = $job->update_statustext( "0,Removing old tax data" );
1417   die $error if $error;
1418
1419   my $sql = "UPDATE public.tax_rate_location SET disabled='Y' ".
1420     "WHERE data_vendor = ".  $dbh->quote($format);
1421   $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1422
1423   my @table = qw(
1424     tax_rate part_pkg_taxrate part_pkg_taxproduct tax_class cust_tax_location
1425   );
1426   foreach my $table ( @table ) {
1427     $sql = "DELETE FROM public.$table WHERE data_vendor = ".
1428       $dbh->quote($format);
1429     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1430   }
1431
1432   if ( $format eq 'cch' ) {
1433     $sql = "DELETE FROM public.cust_tax_location WHERE data_vendor = ".
1434       $dbh->quote("$format-zip");
1435     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1436   }
1437
1438   '';
1439 }
1440
1441 sub _create_temporary_tables {
1442   my ( $job, $format ) = @_;
1443
1444   my $dbh = dbh;
1445   my $error = $job->update_statustext( "0,Creating temporary tables" );
1446   die $error if $error;
1447
1448   my @table = qw( tax_rate
1449                   tax_rate_location
1450                   part_pkg_taxrate
1451                   part_pkg_taxproduct
1452                   tax_class
1453                   cust_tax_location
1454   );
1455   foreach my $table ( @table ) {
1456     my $sql =
1457       "CREATE TEMPORARY TABLE $table ( LIKE $table INCLUDING DEFAULTS )";
1458     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1459   }
1460
1461   '';
1462 }
1463
1464 sub _copy_from_temp {
1465   my ( $job, $format ) = @_;
1466
1467   my $dbh = dbh;
1468   my $error = $job->update_statustext( "0,Making permanent" );
1469   die $error if $error;
1470
1471   my @table = qw( tax_rate
1472                   tax_rate_location
1473                   part_pkg_taxrate
1474                   part_pkg_taxproduct
1475                   tax_class
1476                   cust_tax_location
1477   );
1478   foreach my $table ( @table ) {
1479     my $sql =
1480       "INSERT INTO public.$table SELECT * from $table";
1481     $dbh->do($sql) or return "Failed to execute $sql: ". $dbh->errstr;
1482   }
1483
1484   '';
1485 }
1486
1487 =item process_download_and_reload
1488
1489 Download and process a tax update as a queued JSRPC job after wiping the
1490 existing wipable tax data.
1491
1492 =cut
1493
1494 sub process_download_and_reload {
1495   _process_reload('process_download_and_update', @_);
1496 }
1497
1498
1499 =item process_batch_reload
1500
1501 Load and process a tax update from the provided files as a queued JSRPC job
1502 after wiping the existing wipable tax data.
1503
1504 =cut
1505
1506 sub process_batch_reload {
1507   _process_reload('_perform_batch_import', @_);
1508 }
1509
1510
1511 sub _process_reload {
1512   my ( $method, $job ) = ( shift, shift );
1513
1514   my $param = thaw(decode_base64($_[0]));
1515   my $format = $param->{'format'};        #well... this is all cch specific
1516
1517   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1518
1519   if ( $job ) {  # progress bar
1520     my $error = $job->update_statustext( 0 );
1521     die $error if $error;
1522   }
1523
1524   my $oldAutoCommit = $FS::UID::AutoCommit;
1525   local $FS::UID::AutoCommit = 0;
1526   my $dbh = dbh;
1527   my $error = '';
1528
1529   my $sql =
1530     "SELECT count(*) FROM part_pkg_taxoverride JOIN tax_class ".
1531     "USING (taxclassnum) WHERE data_vendor = '$format'";
1532   my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1533   $sth->execute
1534     or die "Unexpected error executing statement $sql: ". $sth->errstr;
1535   die "Don't (yet) know how to handle part_pkg_taxoverride records."
1536     if $sth->fetchrow_arrayref->[0];
1537
1538   # really should get a table EXCLUSIVE lock here
1539
1540   #remember disabled taxes
1541   my %disabled_tax_rate = ();
1542   $error ||= _remember_disabled_taxes( $job, $format, \%disabled_tax_rate );
1543
1544   #remember tax products
1545   my %taxproduct = ();
1546   $error ||= _remember_tax_products( $job, $format, \%taxproduct );
1547
1548   #create temp tables
1549   $error ||= _create_temporary_tables( $job, $format );
1550
1551   #import new data
1552   unless ($error) {
1553     my $args = '$job, @_';
1554     eval "$method($args);";
1555     $error = $@ if $@;
1556   }
1557
1558   #restore taxproducts
1559   $error ||= _restore_remembered_tax_products( $job, $format, \%taxproduct );
1560
1561   #disable tax_rates
1562   $error ||=
1563    _restore_remembered_disabled_taxes( $job, $format, \%disabled_tax_rate );
1564
1565   #wipe out the old data
1566   $error ||= _remove_old_tax_data( $job, $format );
1567
1568   #untemporize
1569   $error ||= _copy_from_temp( $job, $format );
1570
1571   if ($error) {
1572     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1573     die $error;
1574   }
1575
1576   #success!
1577   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1578 }
1579
1580
1581 =item process_download_and_update
1582
1583 Download and process a tax update as a queued JSRPC job
1584
1585 =cut
1586
1587 sub process_download_and_update {
1588   my $job = shift;
1589
1590   my $param = thaw(decode_base64(shift));
1591   my $format = $param->{'format'};        #well... this is all cch specific
1592
1593   my ( $imported, $last, $min_sec ) = _progressbar_foo();
1594
1595   if ( $job ) {  # progress bar
1596     my $error = $job->update_statustext( 0);
1597     die $error if $error;
1598   }
1599
1600   my $cache_dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
1601   my $dir = $cache_dir. 'taxdata';
1602   unless (-d $dir) {
1603     mkdir $dir or die "can't create $dir: $!\n";
1604   }
1605
1606   if ($format eq 'cch') {
1607
1608     my @namelist = qw( code detail geocode plus4 txmatrix zip );
1609
1610     my $conf = new FS::Conf;
1611     die "direct download of tax data not enabled\n"
1612       unless $conf->exists('taxdatadirectdownload');
1613     my ( $urls, $username, $secret, $states ) =
1614       $conf->config('taxdatadirectdownload');
1615     die "No tax download URL provided.  ".
1616         "Did you set the taxdatadirectdownload configuration value?\n"
1617       unless $urls;
1618
1619     $dir .= '/cch';
1620
1621     my $dbh = dbh;
1622     my $error = '';
1623
1624     # really should get a table EXCLUSIVE lock here
1625     # check if initial import or update
1626     #
1627     # relying on mkdir "$dir.new" as a mutex
1628
1629     my $sql = "SELECT count(*) from tax_rate WHERE data_vendor='$format'";
1630     my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1631     $sth->execute() or die $sth->errstr;
1632     my $update = $sth->fetchrow_arrayref->[0];
1633
1634     # create cache and/or rotate old tax data
1635
1636     if (-d $dir) {
1637
1638       if (-d "$dir.4") {
1639         opendir(my $dirh, "$dir.4") or die "failed to open $dir.4: $!\n";
1640         foreach my $file (readdir($dirh)) {
1641           unlink "$dir.4/$file" if (-f "$dir.4/$file");
1642         }
1643         closedir($dirh);
1644         rmdir "$dir.4";
1645       }
1646
1647       for (3, 2, 1) {
1648         if ( -e "$dir.$_" ) {
1649           rename "$dir.$_", "$dir.". ($_+1) or die "can't rename $dir.$_: $!\n";
1650         }
1651       }
1652       rename "$dir", "$dir.1" or die "can't rename $dir: $!\n";
1653
1654     } else {
1655
1656       die "can't find previous tax data\n" if $update;
1657
1658     }
1659
1660     mkdir "$dir.new" or die "can't create $dir.new: $!\n";
1661
1662     # fetch and unpack the zip files
1663
1664     _cch_fetch_and_unzip( $job, $urls, $secret, "$dir.new" );
1665
1666     # extract csv files from the dbf files
1667
1668     foreach my $name ( @namelist ) {
1669       _cch_extract_csv_from_dbf( $job, $dir, $name );
1670     }
1671
1672     # generate the diff files
1673
1674     my @list = ();
1675     foreach my $name ( @namelist ) {
1676       my $difffile = "$dir.new/$name.txt";
1677       if ($update) {
1678         my $error = $job->update_statustext( "0,Comparing to previous $name" );
1679         die $error if $error;
1680         warn "processing $dir.new/$name.txt\n" if $DEBUG;
1681         my $olddir = $update ? "$dir.1" : "";
1682         $difffile = _perform_cch_diff( $name, "$dir.new", $olddir );
1683       }
1684       $difffile =~ s/^$cache_dir//;
1685       push @list, "${name}file:$difffile";
1686     }
1687
1688     # perform the import
1689     local $keep_cch_files = 1;
1690     $param->{uploaded_files} = join( ',', @list );
1691     $param->{format} .= '-update' if $update;
1692     $error ||=
1693       _perform_batch_import( $job, encode_base64( nfreeze( $param ) ) );
1694
1695     rename "$dir.new", "$dir"
1696       or die "cch tax update processed, but can't rename $dir.new: $!\n";
1697
1698   }else{
1699     die "Unknown format: $format";
1700   }
1701 }
1702
1703 =item browse_queries PARAMS
1704
1705 Returns a list consisting of a hashref suited for use as the argument
1706 to qsearch, and sql query string.  Each is based on the PARAMS hashref
1707 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
1708 from a form.  This conveniently creates the query hashref and count_query
1709 string required by the browse and search elements.  As a side effect,
1710 the PARAMS hashref is untainted and keys with unexpected values are removed.
1711
1712 =cut
1713
1714 sub browse_queries {
1715   my $params = shift;
1716
1717   my $query = {
1718                 'table'     => 'tax_rate',
1719                 'hashref'   => {},
1720                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1721               },
1722
1723   my $extra_sql = '';
1724
1725   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1726     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1727   } else {
1728     delete $params->{data_vendor};
1729   }
1730
1731   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1732     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1733                     'geocode LIKE '. dbh->quote($1.'%');
1734   } else {
1735     delete $params->{geocode};
1736   }
1737
1738   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1739        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1740      )
1741   {
1742     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1743                   ' taxclassnum  = '. dbh->quote($1)
1744   } else {
1745     delete $params->{taxclassnun};
1746   }
1747
1748   my $tax_type = $1
1749     if ( $params->{tax_type} =~ /^(\d+)$/ );
1750   delete $params->{tax_type}
1751     unless $tax_type;
1752
1753   my $tax_cat = $1
1754     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1755   delete $params->{tax_cat}
1756     unless $tax_cat;
1757
1758   my @taxclassnum = ();
1759   if ($tax_type || $tax_cat ) {
1760     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1761     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1762     @taxclassnum = map { $_->taxclassnum }
1763                    qsearch({ 'table'     => 'tax_class',
1764                              'hashref'   => {},
1765                              'extra_sql' => "WHERE taxclass $compare",
1766                           });
1767   }
1768
1769   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1770                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1771     if ( @taxclassnum );
1772
1773   unless ($params->{'showdisabled'}) {
1774     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1775                   "( disabled = '' OR disabled IS NULL )";
1776   }
1777
1778   $query->{extra_sql} = $extra_sql;
1779
1780   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1781 }
1782
1783 =item queue_liability_report PARAMS
1784
1785 Launches a tax liability report.
1786 =cut
1787
1788 sub queue_liability_report {
1789   my $job = shift;
1790   my $param = thaw(decode_base64(shift));
1791
1792   my $cgi = new CGI;
1793   $cgi->param('beginning', $param->{beginning});
1794   $cgi->param('ending', $param->{ending});
1795   my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
1796   my $agentnum = $param->{agentnum};
1797   if ($agentnum =~ /^(\d+)$/) { $agentnum = $1; } else { $agentnum = ''; };
1798   generate_liability_report(
1799     'beginning' => $beginning,
1800     'ending'    => $ending,
1801     'agentnum'  => $agentnum,
1802     'p'         => $param->{RootURL},
1803     'job'       => $job,
1804   );
1805 }
1806
1807 =item generate_liability_report PARAMS
1808
1809 Generates a tax liability report.  Provide a hash including desired
1810 agentnum, beginning, and ending
1811
1812 =cut
1813
1814 #shit, all sorts of false laxiness w/report_newtax.cgi
1815 sub generate_liability_report {
1816   my %args = @_;
1817
1818   my ( $count, $last, $min_sec ) = _progressbar_foo();
1819
1820   #let us open the temp file early
1821   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
1822   my $report = new File::Temp( TEMPLATE => 'report.tax.liability.XXXXXXXX',
1823                                DIR      => $dir,
1824                                UNLINK   => 0, # not so temp
1825                              ) or die "can't open report file: $!\n";
1826
1827   my $conf = new FS::Conf;
1828   my $money_char = $conf->config('money_char') || '$';
1829
1830   my $join_cust = "
1831       JOIN cust_bill USING ( invnum )
1832       LEFT JOIN cust_main USING ( custnum )
1833   ";
1834
1835   my $join_loc =
1836     "LEFT JOIN cust_bill_pkg_tax_rate_location USING ( billpkgnum )";
1837   my $join_tax_loc = "LEFT JOIN tax_rate_location USING ( taxratelocationnum )";
1838
1839   my $addl_from = " $join_cust $join_loc $join_tax_loc ";
1840
1841   my $where = "WHERE _date >= $args{beginning} AND _date <= $args{ending} ";
1842
1843   my $agentname = '';
1844   if ( $args{agentnum} =~ /^(\d+)$/ ) {
1845     my $agent = qsearchs('agent', { 'agentnum' => $1 } );
1846     die "agent not found" unless $agent;
1847     $agentname = $agent->agent;
1848     $where .= ' AND cust_main.agentnum = '. $agent->agentnum;
1849   }
1850
1851   #my @taxparam = ( 'itemdesc', 'tax_rate_location.state', 'tax_rate_location.county', 'tax_rate_location.city', 'cust_bill_pkg_tax_rate_location.locationtaxid' );
1852   my @taxparams = qw( city county state locationtaxid );
1853   my @params = ('itemdesc', @taxparams);
1854
1855   my $select = 'DISTINCT itemdesc,locationtaxid,tax_rate_location.state,tax_rate_location.county,tax_rate_location.city';
1856
1857   #false laziness w/FS::Report::Table::Monthly (sub should probably be moved up
1858   #to FS::Report or FS::Record or who the fuck knows where)
1859   my $scalar_sql = sub {
1860     my( $r, $param, $sql ) = @_;
1861     my $sth = dbh->prepare($sql) or die dbh->errstr;
1862     $sth->execute( map $r->$_(), @$param )
1863       or die "Unexpected error executing statement $sql: ". $sth->errstr;
1864     $sth->fetchrow_arrayref->[0] || 0;
1865   };
1866
1867   my $tax = 0;
1868   my $credit = 0;
1869   my %taxes = ();
1870   my %basetaxes = ();
1871   my $calculated = 0;
1872   my @tax_and_location = qsearch({ table     => 'cust_bill_pkg',
1873                                    select    => $select,
1874                                    hashref   => { pkgpart => 0 },
1875                                    addl_from => $addl_from,
1876                                    extra_sql => $where,
1877                                 });
1878   $count = scalar(@tax_and_location);
1879   foreach my $t ( @tax_and_location ) {
1880
1881     if ( $args{job} ) {
1882       if ( time - $min_sec > $last ) {
1883         $args{job}->update_statustext( int( 100 * $calculated / $count ).
1884                                        ",Calculating"
1885                                      );
1886         $last = time;
1887       }
1888     }
1889
1890     #my @params = map { my $f = $_; $f =~ s/.*\.//; $f } @taxparam;
1891     my $label = join('~', map { $t->$_ } @params);
1892     $label = 'Tax'. $label if $label =~ /^~/;
1893     unless ( exists( $taxes{$label} ) ) {
1894       my ($baselabel, @trash) = split /~/, $label;
1895
1896       $taxes{$label}->{'label'} = join(', ', split(/~/, $label) );
1897       $taxes{$label}->{'url_param'} =
1898         join(';', map { "$_=". uri_escape($t->$_) } @params);
1899
1900       my $payby_itemdesc_loc =
1901         "    payby != 'COMP' ".
1902         "AND ( itemdesc = ? OR ? = '' AND itemdesc IS NULL ) ".
1903         "AND ". FS::tax_rate_location->location_sql( map { $_ => $t->$_ }
1904                                                          @taxparams
1905                                                    );
1906
1907       my $taxwhere =
1908         "FROM cust_bill_pkg $addl_from $where AND $payby_itemdesc_loc";
1909
1910       my $sql = "SELECT SUM(amount) $taxwhere AND cust_bill_pkg.pkgnum = 0";
1911
1912       my $x = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1913       $tax += $x;
1914       $taxes{$label}->{'tax'} += $x;
1915
1916       my $creditfrom =
1917        "JOIN cust_credit_bill_pkg USING (billpkgnum,billpkgtaxratelocationnum)";
1918       my $creditwhere =
1919         "FROM cust_bill_pkg $addl_from $creditfrom $where AND $payby_itemdesc_loc";
1920
1921       $sql = "SELECT SUM(cust_credit_bill_pkg.amount) ".
1922              " $creditwhere AND cust_bill_pkg.pkgnum = 0";
1923
1924       my $y = &{$scalar_sql}($t, [ 'itemdesc', 'itemdesc' ], $sql );
1925       $credit += $y;
1926       $taxes{$label}->{'credit'} += $y;
1927
1928       unless ( exists( $taxes{$baselabel} ) ) {
1929
1930         $basetaxes{$baselabel}->{'label'} = $baselabel;
1931         $basetaxes{$baselabel}->{'url_param'} = "itemdesc=$baselabel";
1932         $basetaxes{$baselabel}->{'base'} = 1;
1933
1934       }
1935
1936       $basetaxes{$baselabel}->{'tax'} += $x;
1937       $basetaxes{$baselabel}->{'credit'} += $y;
1938
1939     }
1940
1941     # calculate customer-exemption for this tax
1942     # calculate package-exemption for this tax
1943     # calculate monthly exemption (texas tax) for this tax
1944     # count up all the cust_tax_exempt_pkg records associated with
1945     # the actual line items.
1946   }
1947
1948
1949   #ordering
1950
1951   if ( $args{job} ) {
1952     $args{job}->update_statustext( "0,Sorted" );
1953     $last = time;
1954   }
1955
1956   my @taxes = ();
1957
1958   foreach my $tax ( sort { $a cmp $b } keys %taxes ) {
1959     my ($base, @trash) = split '~', $tax;
1960     my $basetax = delete( $basetaxes{$base} );
1961     if ($basetax) {
1962       if ( $basetax->{tax} == $taxes{$tax}->{tax} ) {
1963         $taxes{$tax}->{base} = 1;
1964       } else {
1965         push @taxes, $basetax;
1966       }
1967     }
1968     push @taxes, $taxes{$tax};
1969   }
1970
1971   push @taxes, {
1972     'label'          => 'Total',
1973     'url_param'      => '',
1974     'tax'            => $tax,
1975     'credit'         => $credit,
1976     'base'           => 1,
1977   };
1978
1979
1980   my $dateagentlink = "begin=$args{beginning};end=$args{ending}";
1981   $dateagentlink .= ';agentnum='. $args{agentnum}
1982     if length($agentname);
1983   my $baselink   = $args{p}. "search/cust_bill_pkg.cgi?$dateagentlink";
1984   my $creditlink = $args{p}. "search/cust_credit_bill_pkg.html?$dateagentlink";
1985
1986   print $report <<EOF;
1987
1988     <% include("/elements/header.html", "$agentname Tax Report - ".
1989                   ( $args{beginning}
1990                       ? time2str('%h %o %Y ', $args{beginning} )
1991                       : ''
1992                   ).
1993                   'through '.
1994                   ( $args{ending} == 4294967295
1995                       ? 'now'
1996                       : time2str('%h %o %Y', $args{ending} )
1997                   )
1998               )
1999     %>
2000
2001     <% include('/elements/table-grid.html') %>
2002
2003     <TR>
2004       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2005       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2006       <TH CLASS="grid" BGCOLOR="#cccccc">Tax invoiced</TH>
2007       <TH CLASS="grid" BGCOLOR="#cccccc">&nbsp;&nbsp;&nbsp;&nbsp;</TH>
2008       <TH CLASS="grid" BGCOLOR="#cccccc"></TH>
2009       <TH CLASS="grid" BGCOLOR="#cccccc">Tax credited</TH>
2010     </TR>
2011 EOF
2012
2013   my $bgcolor1 = '#eeeeee';
2014   my $bgcolor2 = '#ffffff';
2015   my $bgcolor = '';
2016
2017   $count = scalar(@taxes);
2018   $calculated = 0;
2019   foreach my $tax ( @taxes ) {
2020
2021     if ( $args{job} ) {
2022       if ( time - $min_sec > $last ) {
2023         $args{job}->update_statustext( int( 100 * $calculated / $count ).
2024                                        ",Generated"
2025                                      );
2026         $last = time;
2027       }
2028     }
2029
2030     if ( $bgcolor eq $bgcolor1 ) {
2031       $bgcolor = $bgcolor2;
2032     } else {
2033       $bgcolor = $bgcolor1;
2034     }
2035
2036     my $link = '';
2037     if ( $tax->{'label'} ne 'Total' ) {
2038       $link = ';'. $tax->{'url_param'};
2039     }
2040
2041     print $report <<EOF;
2042       <TR>
2043         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"><% '$tax->{label}' %></TD>
2044         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2045         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2046           <A HREF="<% '$baselink$link' %>;istax=1"><% '$money_char' %><% sprintf('%.2f', $tax->{'tax'} ) %></A>
2047         </TD>
2048         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2049         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>"></TD>
2050         <% ($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2051         <TD CLASS="grid" BGCOLOR="<% '$bgcolor' %>" ALIGN="right">
2052           <A HREF="<% '$creditlink$link' %>;istax=1;iscredit=rate"><% '$money_char' %><% sprintf('%.2f', $tax->{'credit'} ) %></A>
2053         </TD>
2054         <% !($tax->{base}) ? qq!<TD CLASS="grid" BGCOLOR="$bgcolor"></TD>! : '' %>
2055       </TR>
2056 EOF
2057   }
2058
2059   print $report <<EOF;
2060     </TABLE>
2061
2062     </BODY>
2063     </HTML>
2064 EOF
2065
2066   my $reportname = $report->filename;
2067   close $report;
2068
2069   my $dropstring = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/report.';
2070   $reportname =~ s/^$dropstring//;
2071
2072   my $reporturl = "%%%ROOTURL%%%/misc/queued_report?report=$reportname";
2073   die "<a href=$reporturl>view</a>\n";
2074
2075 }
2076
2077
2078
2079 =back
2080
2081 =head1 BUGS
2082
2083   Mixing automatic and manual editing works poorly at present.
2084
2085   Tax liability calculations take too long and arguably don't belong here.
2086   Tax liability report generation not entirely safe (escaped).
2087
2088 =head1 SEE ALSO
2089
2090 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
2091 documentation.
2092
2093 =cut
2094
2095 1;
2096