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