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