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 );
   7 use Date::Parse;
   8 use Storable qw( thaw );
   9 use MIME::Base64;
  10 use DBIx::DBSchema;
  11 use DBIx::DBSchema::Table;
  12 use DBIx::DBSchema::Column;
  13 use FS::Record qw( qsearch qsearchs dbh dbdef );
  14 use FS::tax_class;
  15 use FS::cust_bill_pkg;
  16 use FS::cust_tax_location;
  17 use FS::part_pkg_taxrate;
  18 use FS::cust_main;
  19 use FS::Misc qw( csv_from_fixed );
  20
  21 @ISA = qw( FS::Record );
  22
  23 $DEBUG = 0;
  24 $me = '[FS::tax_rate]';
  25
  26 =head1 NAME
  27
  28 FS::tax_rate - Object methods for tax_rate objects
  29
  30 =head1 SYNOPSIS
  31
  32   use FS::tax_rate;
  33
  34   $record = new FS::tax_rate \%hash;
  35   $record = new FS::tax_rate { 'column' => 'value' };
  36
  37   $error = $record->insert;
  38
  39   $error = $new_record->replace($old_record);
  40
  41   $error = $record->delete;
  42
  43   $error = $record->check;
  44
  45 =head1 DESCRIPTION
  46
  47 An FS::tax_rate object represents a tax rate, defined by locale.
  48 FS::tax_rate inherits from FS::Record.  The following fields are
  49 currently supported:
  50
  51 =over 4
  52
  53 =item taxnum
  54
  55 primary key (assigned automatically for new tax rates)
  56
  57 =item geocode
  58
  59 a geographic location code provided by a tax data vendor
  60
  61 =item data_vendor
  62
  63 the tax data vendor
  64
  65 =item location
  66
  67 a location code provided by a tax authority
  68
  69 =item taxclassnum
  70
  71 a foreign key into FS::tax_class - the type of tax
  72 referenced but FS::part_pkg_taxrate
  73 eitem effective_date
  74
  75 the time after which the tax applies
  76
  77 =item tax
  78
  79 percentage
  80
  81 =item excessrate
  82
  83 second bracket percentage
  84
  85 =item taxbase
  86
  87 the amount to which the tax applies (first bracket)
  88
  89 =item taxmax
  90
  91 a cap on the amount of tax if a cap exists
  92
  93 =item usetax
  94
  95 percentage on out of jurisdiction purchases
  96
  97 =item useexcessrate
  98
  99 second bracket percentage on out of jurisdiction purchases
 100
 101 =item unittype
 102
 103 one of the values in %tax_unittypes
 104
 105 =item fee
 106
 107 amount of tax per unit
 108
 109 =item excessfee
 110
 111 second bracket amount of tax per unit
 112
 113 =item feebase
 114
 115 the number of units to which the fee applies (first bracket)
 116
 117 =item feemax
 118
 119 the most units to which fees apply (first and second brackets)
 120
 121 =item maxtype
 122
 123 a value from %tax_maxtypes indicating how brackets accumulate (i.e. monthly, per invoice, etc)
 124
 125 =item taxname
 126
 127 if defined, printed on invoices instead of "Tax"
 128
 129 =item taxauth
 130
 131 a value from %tax_authorities
 132
 133 =item basetype
 134
 135 a value from %tax_basetypes indicating the tax basis
 136
 137 =item passtype
 138
 139 a value from %tax_passtypes indicating how the tax should displayed to the customer
 140
 141 =item passflag
 142
 143 'Y', 'N', or blank indicating the tax can be passed to the customer
 144
 145 =item setuptax
 146
 147 if 'Y', this tax does not apply to setup fees
 148
 149 =item recurtax
 150
 151 if 'Y', this tax does not apply to recurring fees
 152
 153 =item manual
 154
 155 if 'Y', has been manually edited
 156
 157 =back
 158
 159 =head1 METHODS
 160
 161 =over 4
 162
 163 =item new HASHREF
 164
 165 Creates a new tax rate.  To add the tax rate to the database, see L<"insert">.
 166
 167 =cut
 168
 169 sub table { 'tax_rate'; }
 170
 171 =item insert
 172
 173 Adds this tax rate to the database.  If there is an error, returns the error,
 174 otherwise returns false.
 175
 176 =item delete
 177
 178 Deletes this tax rate from the database.  If there is an error, returns the
 179 error, otherwise returns false.
 180
 181 =item replace OLD_RECORD
 182
 183 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 184 returns the error, otherwise returns false.
 185
 186 =item check
 187
 188 Checks all fields to make sure this is a valid tax rate.  If there is an error,
 189 returns the error, otherwise returns false.  Called by the insert and replace
 190 methods.
 191
 192 =cut
 193
 194 sub check {
 195   my $self = shift;
 196
 197   foreach (qw( taxbase taxmax )) {
 198     $self->$_(0) unless $self->$_;
 199   }
 200
 201   $self->ut_numbern('taxnum')
 202     || $self->ut_text('geocode')
 203     || $self->ut_textn('data_vendor')
 204     || $self->ut_textn('location')
 205     || $self->ut_foreign_key('taxclassnum', 'tax_class', 'taxclassnum')
 206     || $self->ut_snumbern('effective_date')
 207     || $self->ut_float('tax')
 208     || $self->ut_floatn('excessrate')
 209     || $self->ut_money('taxbase')
 210     || $self->ut_money('taxmax')
 211     || $self->ut_floatn('usetax')
 212     || $self->ut_floatn('useexcessrate')
 213     || $self->ut_numbern('unittype')
 214     || $self->ut_floatn('fee')
 215     || $self->ut_floatn('excessfee')
 216     || $self->ut_floatn('feemax')
 217     || $self->ut_numbern('maxtype')
 218     || $self->ut_textn('taxname')
 219     || $self->ut_numbern('taxauth')
 220     || $self->ut_numbern('basetype')
 221     || $self->ut_numbern('passtype')
 222     || $self->ut_enum('passflag', [ '', 'Y', 'N' ])
 223     || $self->ut_enum('setuptax', [ '', 'Y' ] )
 224     || $self->ut_enum('recurtax', [ '', 'Y' ] )
 225     || $self->ut_enum('manual', [ '', 'Y' ] )
 226     || $self->ut_enum('disabled', [ '', 'Y' ] )
 227     || $self->SUPER::check
 228     ;
 229
 230 }
 231
 232 =item taxclass_description
 233
 234 Returns the human understandable value associated with the related
 235 FS::tax_class.
 236
 237 =cut
 238
 239 sub taxclass_description {
 240   my $self = shift;
 241   my $tax_class = qsearchs('tax_class', {'taxclassnum' => $self->taxclassnum });
 242   $tax_class ? $tax_class->description : '';
 243 }
 244
 245 =item unittype_name
 246
 247 Returns the human understandable value associated with the unittype column
 248
 249 =cut
 250
 251 %tax_unittypes = ( '0' => 'access line',
 252                    '1' => 'minute',
 253                    '2' => 'account',
 254 );
 255
 256 sub unittype_name {
 257   my $self = shift;
 258   $tax_unittypes{$self->unittype};
 259 }
 260
 261 =item maxtype_name
 262
 263 Returns the human understandable value associated with the maxtype column
 264
 265 =cut
 266
 267 %tax_maxtypes = ( '0' => 'receipts per invoice',
 268                   '1' => 'receipts per item',
 269                   '2' => 'total utility charges per utility tax year',
 270                   '3' => 'total charges per utility tax year',
 271                   '4' => 'receipts per access line',
 272                   '9' => 'monthly receipts per location',
 273 );
 274
 275 sub maxtype_name {
 276   my $self = shift;
 277   $tax_maxtypes{$self->maxtype};
 278 }
 279
 280 =item basetype_name
 281
 282 Returns the human understandable value associated with the basetype column
 283
 284 =cut
 285
 286 %tax_basetypes = ( '0'  => 'sale price',
 287                    '1'  => 'gross receipts',
 288                    '2'  => 'sales taxable telecom revenue',
 289                    '3'  => 'minutes carried',
 290                    '4'  => 'minutes billed',
 291                    '5'  => 'gross operating revenue',
 292                    '6'  => 'access line',
 293                    '7'  => 'account',
 294                    '8'  => 'gross revenue',
 295                    '9'  => 'portion gross receipts attributable to interstate service',
 296                    '10' => 'access line',
 297                    '11' => 'gross profits',
 298                    '12' => 'tariff rate',
 299                    '14' => 'account',
 300                    '15' => 'prior year gross receipts',
 301 );
 302
 303 sub basetype_name {
 304   my $self = shift;
 305   $tax_basetypes{$self->basetype};
 306 }
 307
 308 =item taxauth_name
 309
 310 Returns the human understandable value associated with the taxauth column
 311
 312 =cut
 313
 314 %tax_authorities = ( '0' => 'federal',
 315                      '1' => 'state',
 316                      '2' => 'county',
 317                      '3' => 'city',
 318                      '4' => 'local',
 319                      '5' => 'county administered by state',
 320                      '6' => 'city administered by state',
 321                      '7' => 'city administered by county',
 322                      '8' => 'local administered by state',
 323                      '9' => 'local administered by county',
 324 );
 325
 326 sub taxauth_name {
 327   my $self = shift;
 328   $tax_authorities{$self->taxauth};
 329 }
 330
 331 =item passtype_name
 332
 333 Returns the human understandable value associated with the passtype column
 334
 335 =cut
 336
 337 %tax_passtypes = ( '0' => 'separate tax line',
 338                    '1' => 'separate surcharge line',
 339                    '2' => 'surcharge not separated',
 340                    '3' => 'included in base rate',
 341 );
 342
 343 sub passtype_name {
 344   my $self = shift;
 345   $tax_passtypes{$self->passtype};
 346 }
 347
 348 =item taxline TAXABLES, [ OPTIONSHASH ]
 349
 350 Returns a listref of a name and an amount of tax calculated for the list
 351 of packages/amounts referenced by TAXABLES.  If an error occurs, a message
 352 is returned as a scalar.
 353
 354 =cut
 355
 356 sub taxline {
 357   my $self = shift;
 358
 359   my $taxables;
 360   my %opt = ();
 361
 362   if (ref($_[0]) eq 'ARRAY') {
 363     $taxables = shift;
 364     %opt = @_;
 365   }else{
 366     $taxables = [ @_ ];
 367     #exemptions would be broken in this case
 368   }
 369
 370   my $name = $self->taxname;
 371   $name = 'Other surcharges'
 372     if ($self->passtype == 2);
 373   my $amount = 0;
 374
 375   if ( $self->disabled ) { # we always know how to handle disabled taxes
 376     return {
 377       'name'   => $name,
 378       'amount' => $amount,
 379     };
 380   }
 381
 382   my $taxable_charged = 0;
 383   my @cust_bill_pkg = grep { $taxable_charged += $_ unless ref; ref; }
 384                       @$taxables;
 385
 386   warn "calculating taxes for ". $self->taxnum. " on ".
 387     join (",", map { $_->pkgnum } @cust_bill_pkg)
 388     if $DEBUG;
 389
 390   if ($self->passflag eq 'N') {
 391     # return "fatal: can't (yet) handle taxes not passed to the customer";
 392     # until someone needs to track these in freeside
 393     return {
 394       'name'   => $name,
 395       'amount' => 0,
 396     };
 397   }
 398
 399   if ($self->maxtype != 0 && $self->maxtype != 9) {
 400     return $self->_fatal_or_null( 'tax with "'.
 401                                     $self->maxtype_name. '" threshold'
 402                                 );
 403   }
 404
 405   if ($self->maxtype == 9) {
 406     return
 407       $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' );
 408                                                                 # "texas" tax
 409   }
 410
 411   # we treat gross revenue as gross receipts and expect the tax data
 412   # to DTRT (i.e. tax on tax rules)
 413   if ($self->basetype != 0 && $self->basetype != 1 &&
 414       $self->basetype != 5 && $self->basetype != 6 &&
 415       $self->basetype != 7 && $self->basetype != 8 &&
 416       $self->basetype != 14
 417   ) {
 418     return
 419       $self->_fatal_or_null( 'tax with "'. $self->basetype_name. '" basis' );
 420   }
 421
 422   unless ($self->setuptax =~ /^Y$/i) {
 423     $taxable_charged += $_->setup foreach @cust_bill_pkg;
 424   }
 425   unless ($self->recurtax =~ /^Y$/i) {
 426     $taxable_charged += $_->recur foreach @cust_bill_pkg;
 427   }
 428
 429   my $taxable_units = 0;
 430   unless ($self->recurtax =~ /^Y$/i) {
 431     if ($self->unittype == 0) {
 432       my %seen = ();
 433       foreach (@cust_bill_pkg) {
 434         $taxable_units += $_->units
 435           unless $seen{$_->pkgnum};
 436         $seen{$_->pkgnum}++;
 437       }
 438     }elsif ($self->unittype == 1) {
 439       return $self->_fatal_or_null( 'fee with minute unit type' );
 440     }elsif ($self->unittype == 2) {
 441       $taxable_units = 1;
 442     }else {
 443       return $self->_fatal_or_null( 'unknown unit type in tax'. $self->taxnum );
 444     }
 445   }
 446
 447   #
 448   # XXX insert exemption handling here
 449   #
 450   # the tax or fee is applied to taxbase or feebase and then
 451   # the excessrate or excess fee is applied to taxmax or feemax
 452   #
 453
 454   $amount += $taxable_charged * $self->tax;
 455   $amount += $taxable_units * $self->fee;
 456
 457   warn "calculated taxes as [ $name, $amount ]\n"
 458     if $DEBUG;
 459
 460   return {
 461     'name'   => $name,
 462     'amount' => $amount,
 463   };
 464
 465 }
 466
 467 sub _fatal_or_null {
 468   my ($self, $error) = @_;
 469
 470   my $conf = new FS::Conf;
 471
 472   $error = "fatal: can't yet handle ". $error;
 473   my $name = $self->taxname;
 474   $name = 'Other surcharges'
 475     if ($self->passtype == 2);
 476
 477   if ($conf->exists('ignore_incalculable_taxes')) {
 478     warn $error;
 479     return { name => $name, amount => 0 };
 480   } else {
 481     return $error;
 482   }
 483 }
 484
 485 =item tax_on_tax CUST_MAIN
 486
 487 Returns a list of taxes which are candidates for taxing taxes for the
 488 given customer (see L<FS::cust_main>)
 489
 490 =cut
 491
 492 sub tax_on_tax {
 493   my $self = shift;
 494   my $cust_main = shift;
 495
 496   warn "looking up taxes on tax ". $self->taxnum. " for customer ".
 497     $cust_main->custnum
 498     if $DEBUG;
 499
 500   my $geocode = $cust_main->geocode($self->data_vendor);
 501
 502   # CCH oddness in m2m
 503   my $dbh = dbh;
 504   my $extra_sql = ' AND ('.
 505     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
 506                  qw(10 5 2)
 507         ).
 508     ')';
 509
 510   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc';
 511   my $select   = 'DISTINCT ON(taxclassnum) *';
 512
 513   # should qsearch preface columns with the table to facilitate joins?
 514   my @taxclassnums = map { $_->taxclassnum }
 515     qsearch( { 'table'     => 'part_pkg_taxrate',
 516                'select'    => $select,
 517                'hashref'   => { 'data_vendor'      => $self->data_vendor,
 518                                 'taxclassnumtaxed' => $self->taxclassnum,
 519                               },
 520                'extra_sql' => $extra_sql,
 521                'order_by'  => $order_by,
 522            } );
 523
 524   return () unless @taxclassnums;
 525
 526   $extra_sql =
 527     "AND (".  join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
 528
 529   qsearch({ 'table'     => 'tax_rate',
 530             'hashref'   => { 'geocode' => $geocode, },
 531             'extra_sql' => $extra_sql,
 532          })
 533
 534 }
 535
 536 =back
 537
 538 =head1 SUBROUTINES
 539
 540 =over 4
 541
 542 =item batch_import
 543
 544 =cut
 545
 546 sub batch_import {
 547   my ($param, $job) = @_;
 548
 549   my $fh = $param->{filehandle};
 550   my $format = $param->{'format'};
 551
 552   my %insert = ();
 553   my %delete = ();
 554
 555   my @fields;
 556   my $hook;
 557
 558   my @column_lengths = ();
 559   my @column_callbacks = ();
 560   if ( $format eq 'cch-fixed' || $format eq 'cch-fixed-update' ) {
 561     $format =~ s/-fixed//;
 562     my $date_format = sub { my $r='';
 563                             /^(\d{4})(\d{2})(\d{2})$/ && ($r="$1/$2/$3");
 564                             $r;
 565                           };
 566     my $trim = sub { my $r = shift; $r =~ s/^\s*//; $r =~ s/\s*$//; $r };
 567     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 );
 568     push @column_lengths, 1 if $format eq 'cch-update';
 569     push @column_callbacks, $trim foreach (@column_lengths); # 5, 6, 15, 17 esp
 570     $column_callbacks[8] = $date_format;
 571   }
 572
 573   my $line;
 574   my ( $count, $last, $min_sec ) = (0, time, 5); #progressbar
 575   if ( $job || scalar(@column_callbacks) ) {
 576     my $error =
 577       csv_from_fixed(\$fh, \$count, \@column_lengths, \@column_callbacks);
 578     return $error if $error;
 579   }
 580   $count *=2;
 581
 582   if ( $format eq 'cch' || $format eq 'cch-update' ) {
 583     @fields = qw( geocode inoutcity inoutlocal tax location taxbase taxmax
 584                   excessrate effective_date taxauth taxtype taxcat taxname
 585                   usetax useexcessrate fee unittype feemax maxtype passflag
 586                   passtype basetype );
 587     push @fields, 'actionflag' if $format eq 'cch-update';
 588
 589     $hook = sub {
 590       my $hash = shift;
 591
 592       $hash->{'actionflag'} ='I' if ($hash->{'data_vendor'} eq 'cch');
 593       $hash->{'data_vendor'} ='cch';
 594       $hash->{'effective_date'} = str2time($hash->{'effective_date'});
 595
 596       my $taxclassid =
 597         join(':', map{ $hash->{$_} } qw(taxtype taxcat) );
 598
 599       my %tax_class = ( 'data_vendor'  => 'cch',
 600                         'taxclass' => $taxclassid,
 601                       );
 602
 603       my $tax_class = qsearchs( 'tax_class', \%tax_class );
 604       return "Error updating tax rate: no tax class $taxclassid"
 605         unless $tax_class;
 606
 607       $hash->{'taxclassnum'} = $tax_class->taxclassnum;
 608
 609       foreach (qw( inoutcity inoutlocal taxtype taxcat )) {
 610         delete($hash->{$_});
 611       }
 612
 613       my %passflagmap = ( '0' => '',
 614                           '1' => 'Y',
 615                           '2' => 'N',
 616                         );
 617       $hash->{'passflag'} = $passflagmap{$hash->{'passflag'}}
 618         if exists $passflagmap{$hash->{'passflag'}};
 619
 620       foreach (keys %$hash) {
 621         $hash->{$_} = substr($hash->{$_}, 0, 80)
 622           if length($hash->{$_}) > 80;
 623       }
 624
 625       my $actionflag = delete($hash->{'actionflag'});
 626
 627       $hash->{'taxname'} =~ s/`/'/g;
 628       $hash->{'taxname'} =~ s|\\|/|g;
 629
 630       return '' if $format eq 'cch';  # but not cch-update
 631
 632       if ($actionflag eq 'I') {
 633         $insert{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
 634       }elsif ($actionflag eq 'D') {
 635         $delete{ $hash->{'geocode'}. ':'. $hash->{'taxclassnum'} } = { %$hash };
 636       }else{
 637         return "Unexpected action flag: ". $hash->{'actionflag'};
 638       }
 639
 640       delete($hash->{$_}) for keys %$hash;
 641
 642       '';
 643
 644     };
 645
 646   } elsif ( $format eq 'extended' ) {
 647     die "unimplemented\n";
 648     @fields = qw( );
 649     $hook = sub {};
 650   } else {
 651     die "unknown format $format";
 652   }
 653
 654   eval "use Text::CSV_XS;";
 655   die $@ if $@;
 656
 657   my $csv = new Text::CSV_XS;
 658
 659   my $imported = 0;
 660
 661   local $SIG{HUP} = 'IGNORE';
 662   local $SIG{INT} = 'IGNORE';
 663   local $SIG{QUIT} = 'IGNORE';
 664   local $SIG{TERM} = 'IGNORE';
 665   local $SIG{TSTP} = 'IGNORE';
 666   local $SIG{PIPE} = 'IGNORE';
 667
 668   my $oldAutoCommit = $FS::UID::AutoCommit;
 669   local $FS::UID::AutoCommit = 0;
 670   my $dbh = dbh;
 671
 672   while ( defined($line=<$fh>) ) {
 673     $csv->parse($line) or do {
 674       $dbh->rollback if $oldAutoCommit;
 675       return "can't parse: ". $csv->error_input();
 676     };
 677
 678     if ( $job ) {  # progress bar
 679       if ( time - $min_sec > $last ) {
 680         my $error = $job->update_statustext(
 681           int( 100 * $imported / $count )
 682         );
 683         die $error if $error;
 684         $last = time;
 685       }
 686     }
 687
 688     my @columns = $csv->fields();
 689
 690     my %tax_rate = ( 'data_vendor' => $format );
 691     foreach my $field ( @fields ) {
 692       $tax_rate{$field} = shift @columns;
 693     }
 694     if ( scalar( @columns ) ) {
 695       $dbh->rollback if $oldAutoCommit;
 696       return "Unexpected trailing columns in line (wrong format?): $line";
 697     }
 698
 699     my $error = &{$hook}(\%tax_rate);
 700     if ( $error ) {
 701       $dbh->rollback if $oldAutoCommit;
 702       return $error;
 703     }
 704
 705     if (scalar(keys %tax_rate)) { #inserts only, not updates for cch
 706
 707       my $tax_rate = new FS::tax_rate( \%tax_rate );
 708       $error = $tax_rate->insert;
 709
 710       if ( $error ) {
 711         $dbh->rollback if $oldAutoCommit;
 712         return "can't insert tax_rate for $line: $error";
 713       }
 714
 715     }
 716
 717     $imported++;
 718
 719   }
 720
 721   for (grep { !exists($delete{$_}) } keys %insert) {
 722     if ( $job ) {  # progress bar
 723       if ( time - $min_sec > $last ) {
 724         my $error = $job->update_statustext(
 725           int( 100 * $imported / $count )
 726         );
 727         die $error if $error;
 728         $last = time;
 729       }
 730     }
 731
 732     my $tax_rate = new FS::tax_rate( $insert{$_} );
 733     my $error = $tax_rate->insert;
 734
 735     if ( $error ) {
 736       $dbh->rollback if $oldAutoCommit;
 737       my $hashref = $insert{$_};
 738       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 739       return "can't insert tax_rate for $line: $error";
 740     }
 741
 742     $imported++;
 743   }
 744
 745   for (grep { exists($delete{$_}) } keys %insert) {
 746     if ( $job ) {  # progress bar
 747       if ( time - $min_sec > $last ) {
 748         my $error = $job->update_statustext(
 749           int( 100 * $imported / $count )
 750         );
 751         die $error if $error;
 752         $last = time;
 753       }
 754     }
 755
 756     my $old = qsearchs( 'tax_rate', $delete{$_} );
 757     unless ($old) {
 758       $dbh->rollback if $oldAutoCommit;
 759       $old = $delete{$_};
 760       return "can't find tax_rate to replace for: ".
 761         #join(" ", map { "$_ => ". $old->{$_} } @fields);
 762         join(" ", map { "$_ => ". $old->{$_} } keys(%$old) );
 763     }
 764     my $new = new FS::tax_rate({ $old->hash, %{$insert{$_}}, 'manual' => ''  });
 765     $new->taxnum($old->taxnum);
 766     my $error = $new->replace($old);
 767
 768     if ( $error ) {
 769       $dbh->rollback if $oldAutoCommit;
 770       my $hashref = $insert{$_};
 771       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 772       return "can't replace tax_rate for $line: $error";
 773     }
 774
 775     $imported++;
 776     $imported++;
 777   }
 778
 779   for (grep { !exists($insert{$_}) } keys %delete) {
 780     if ( $job ) {  # progress bar
 781       if ( time - $min_sec > $last ) {
 782         my $error = $job->update_statustext(
 783           int( 100 * $imported / $count )
 784         );
 785         die $error if $error;
 786         $last = time;
 787       }
 788     }
 789
 790     my $tax_rate = qsearchs( 'tax_rate', $delete{$_} );
 791     unless ($tax_rate) {
 792       $dbh->rollback if $oldAutoCommit;
 793       $tax_rate = $delete{$_};
 794       return "can't find tax_rate to delete for: ".
 795         #join(" ", map { "$_ => ". $tax_rate->{$_} } @fields);
 796         join(" ", map { "$_ => ". $tax_rate->{$_} } keys(%$tax_rate) );
 797     }
 798     my $error = $tax_rate->delete;
 799
 800     if ( $error ) {
 801       $dbh->rollback if $oldAutoCommit;
 802       my $hashref = $delete{$_};
 803       $line = join(", ", map { "$_ => ". $hashref->{$_} } keys(%$hashref) );
 804       return "can't delete tax_rate for $line: $error";
 805     }
 806
 807     $imported++;
 808   }
 809
 810   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 811
 812   return "Empty file!" unless ($imported || $format eq 'cch-update');
 813
 814   ''; #no error
 815
 816 }
 817
 818 =item process_batch_import
 819
 820 Load a batch import as a queued JSRPC job
 821
 822 =cut
 823
 824 sub process_batch_import {
 825   my $job = shift;
 826
 827   my $param = thaw(decode_base64(shift));
 828   my $format = $param->{'format'};        #well... this is all cch specific
 829
 830   my $files = $param->{'uploaded_files'}
 831     or die "No files provided.";
 832
 833   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
 834
 835   if ($format eq 'cch' || $format eq 'cch-fixed') {
 836
 837     my $oldAutoCommit = $FS::UID::AutoCommit;
 838     local $FS::UID::AutoCommit = 0;
 839     my $dbh = dbh;
 840     my $error = '';
 841     my $have_location = 0;
 842
 843     my @list = ( 'CODE',     'codefile',  \&FS::tax_class::batch_import,
 844                  'PLUS4',    'plus4file', \&FS::cust_tax_location::batch_import,
 845                  'ZIP',      'zipfile',   \&FS::cust_tax_location::batch_import,
 846                  'TXMATRIX', 'txmatrix',  \&FS::part_pkg_taxrate::batch_import,
 847                  'DETAIL',   'detail',    \&FS::tax_rate::batch_import,
 848                );
 849     while( scalar(@list) ) {
 850       my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
 851       unless ($files{$file}) {
 852         next if $name eq 'PLUS4';
 853         $error = "No $name supplied";
 854         $error = "Neither PLUS4 nor ZIP supplied"
 855           if ($name eq 'ZIP' && !$have_location);
 856         next;
 857       }
 858       $have_location = 1 if $name eq 'PLUS4';
 859       my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
 860       my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
 861       my $filename = "$dir/".  $files{$file};
 862       open my $fh, "< $filename" or $error ||= "Can't open $name file: $!";
 863
 864       $error ||= &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
 865       close $fh;
 866       unlink $filename or warn "Can't delete $filename: $!";
 867     }
 868
 869     if ($error) {
 870       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 871       die $error;
 872     }else{
 873       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 874     }
 875
 876   }elsif ($format eq 'cch-update' || $format eq 'cch-fixed-update') {
 877
 878     my $oldAutoCommit = $FS::UID::AutoCommit;
 879     local $FS::UID::AutoCommit = 0;
 880     my $dbh = dbh;
 881     my $error = '';
 882     my @insert_list = ();
 883     my @delete_list = ();
 884
 885     my @list = ( 'CODE',     'codefile',  \&FS::tax_class::batch_import,
 886                  'PLUS4',    'plus4file', \&FS::cust_tax_location::batch_import,
 887                  'ZIP',      'zipfile',   \&FS::cust_tax_location::batch_import,
 888                  'TXMATRIX', 'txmatrix',  \&FS::part_pkg_taxrate::batch_import,
 889                );
 890     my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc;
 891     while( scalar(@list) ) {
 892       my ($name, $file, $import_sub) = (shift @list, shift @list, shift @list);
 893       unless ($files{$file}) {
 894         my $vendor = $name eq 'ZIP' ? 'cch' : 'cch-zip';
 895         next     # update expected only for previously installed location data
 896           if (   ($name eq 'PLUS4' || $name eq 'ZIP')
 897                && !scalar( qsearch( { table => 'cust_tax_location',
 898                                       hashref => { data_vendor => $vendor },
 899                                       select => 'DISTINCT data_vendor',
 900                                   } )
 901                          )
 902              );
 903
 904         $error = "No $name supplied";
 905         next;
 906       }
 907       my $filename = "$dir/".  $files{$file};
 908       open my $fh, "< $filename" or $error ||= "Can't open $name file $filename: $!";
 909       unlink $filename or warn "Can't delete $filename: $!";
 910
 911       my $ifh = new File::Temp( TEMPLATE => "$name.insert.XXXXXXXX",
 912                                 DIR      => $dir,
 913                                 UNLINK   => 0,     #meh
 914                               ) or die "can't open temp file: $!\n";
 915
 916       my $dfh = new File::Temp( TEMPLATE => "$name.delete.XXXXXXXX",
 917                                 DIR      => $dir,
 918                                 UNLINK   => 0,     #meh
 919                               ) or die "can't open temp file: $!\n";
 920
 921       my $insert_pattern = ($format eq 'cch-update') ? qr/"I"\s*$/ : qr/I\s*$/;
 922       my $delete_pattern = ($format eq 'cch-update') ? qr/"D"\s*$/ : qr/D\s*$/;
 923       while(<$fh>) {
 924         my $handle = '';
 925         $handle = $ifh if $_ =~ /$insert_pattern/;
 926         $handle = $dfh if $_ =~ /$delete_pattern/;
 927         unless ($handle) {
 928           $error = "bad input line: $_" unless $handle;
 929           last;
 930         }
 931         print $handle $_;
 932       }
 933       close $fh;
 934       close $ifh;
 935       close $dfh;
 936
 937       push @insert_list, $name, $ifh->filename, $import_sub;
 938       unshift @delete_list, $name, $dfh->filename, $import_sub;
 939
 940     }
 941     while( scalar(@insert_list) ) {
 942       my ($name, $file, $import_sub) =
 943         (shift @insert_list, shift @insert_list, shift @insert_list);
 944
 945       my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
 946       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
 947       $error ||=
 948         &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
 949       close $fh;
 950       unlink $file or warn "Can't delete $file: $!";
 951     }
 952
 953     $error ||= "No DETAIL supplied"
 954       unless ($files{detail});
 955     open my $fh, "< $dir/". $files{detail}
 956       or $error ||= "Can't open DETAIL file: $!";
 957     $error ||=
 958       &FS::tax_rate::batch_import({ 'filehandle' => $fh, 'format' => $format },
 959                                   $job);
 960     close $fh;
 961     unlink "$dir/". $files{detail} or warn "Can't delete $files{detail}: $!"
 962       if $files{detail};
 963
 964     while( scalar(@delete_list) ) {
 965       my ($name, $file, $import_sub) =
 966         (shift @delete_list, shift @delete_list, shift @delete_list);
 967
 968       my $fmt = $format. ( $name eq 'ZIP' ? '-zip' : '' );
 969       open my $fh, "< $file" or $error ||= "Can't open $name file $file: $!";
 970       $error ||=
 971         &{$import_sub}({ 'filehandle' => $fh, 'format' => $fmt }, $job);
 972       close $fh;
 973       unlink $file or warn "Can't delete $file: $!";
 974     }
 975
 976     if ($error) {
 977       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 978       die $error;
 979     }else{
 980       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 981     }
 982
 983   }else{
 984     die "Unknown format: $format";
 985   }
 986
 987 }
 988
 989 =item browse_queries PARAMS
 990
 991 Returns a list consisting of a hashref suited for use as the argument
 992 to qsearch, and sql query string.  Each is based on the PARAMS hashref
 993 of keys and values which frequently would be passed as C<scalar($cgi->Vars)>
 994 from a form.  This conveniently creates the query hashref and count_query
 995 string required by the browse and search elements.  As a side effect,
 996 the PARAMS hashref is untainted and keys with unexpected values are removed.
 997
 998 =cut
 999
1000 sub browse_queries {
1001   my $params = shift;
1002
1003   my $query = {
1004                 'table'     => 'tax_rate',
1005                 'hashref'   => {},
1006                 'order_by'  => 'ORDER BY geocode, taxclassnum',
1007               },
1008
1009   my $extra_sql = '';
1010
1011   if ( $params->{data_vendor} =~ /^(\w+)$/ ) {
1012     $extra_sql .= ' WHERE data_vendor = '. dbh->quote($1);
1013   } else {
1014     delete $params->{data_vendor};
1015   }
1016
1017   if ( $params->{geocode} =~ /^(\w+)$/ ) {
1018     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1019                     'geocode LIKE '. dbh->quote($1.'%');
1020   } else {
1021     delete $params->{geocode};
1022   }
1023
1024   if ( $params->{taxclassnum} =~ /^(\d+)$/ &&
1025        qsearchs( 'tax_class', {'taxclassnum' => $1} )
1026      )
1027   {
1028     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1029                   ' taxclassnum  = '. dbh->quote($1)
1030   } else {
1031     delete $params->{taxclassnun};
1032   }
1033
1034   my $tax_type = $1
1035     if ( $params->{tax_type} =~ /^(\d+)$/ );
1036   delete $params->{tax_type}
1037     unless $tax_type;
1038
1039   my $tax_cat = $1
1040     if ( $params->{tax_cat} =~ /^(\d+)$/ );
1041   delete $params->{tax_cat}
1042     unless $tax_cat;
1043
1044   my @taxclassnum = ();
1045   if ($tax_type || $tax_cat ) {
1046     my $compare = "LIKE '". ( $tax_type || "%" ). ":". ( $tax_cat || "%" ). "'";
1047     $compare = "= '$tax_type:$tax_cat'" if ($tax_type && $tax_cat);
1048     @taxclassnum = map { $_->taxclassnum }
1049                    qsearch({ 'table'     => 'tax_class',
1050                              'hashref'   => {},
1051                              'extra_sql' => "WHERE taxclass $compare",
1052                           });
1053   }
1054
1055   $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ). '( '.
1056                 join(' OR ', map { " taxclassnum  = $_ " } @taxclassnum ). ' )'
1057     if ( @taxclassnum );
1058
1059   unless ($params->{'showdisabled'}) {
1060     $extra_sql .= ( $extra_sql =~ /WHERE/i ? ' AND ' : ' WHERE ' ).
1061                   "( disabled = '' OR disabled IS NULL )";
1062   }
1063
1064   $query->{extra_sql} = $extra_sql;
1065
1066   return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql");
1067 }
1068
1069 # _upgrade_data
1070 #
1071 # Used by FS::Upgrade to migrate to a new database.
1072 #
1073 #
1074
1075 sub _upgrade_data {  # class method
1076   my ($self, %opts) = @_;
1077   my $dbh = dbh;
1078
1079   warn "$me upgrading $self\n" if $DEBUG;
1080
1081   my @column = qw ( tax excessrate usetax useexcessrate fee excessfee
1082                     feebase feemax );
1083
1084   if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
1085
1086     eval "use DBI::Const::GetInfoType;";
1087     die $@ if $@;
1088
1089     my $major_version = 0;
1090     $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
1091       && ( $major_version = sprintf("%d", $1) );
1092
1093     if ( $major_version > 7 ) {
1094
1095       # ideally this would be supported in DBIx-DBSchema and friends
1096
1097       foreach my $column ( @column ) {
1098         my $columndef = dbdef->table($self->table)->column($column);
1099         unless ($columndef->type eq 'numeric') {
1100
1101           warn "updating tax_rate column $column to numeric\n" if $DEBUG;
1102           my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)";
1103           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
1104           $sth->execute or die $sth->errstr;
1105
1106           warn "updating h_tax_rate column $column to numeric\n" if $DEBUG;
1107           $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)";
1108           $sth = $dbh->prepare($sql) or die $dbh->errstr;
1109           $sth->execute or die $sth->errstr;
1110
1111         }
1112       }
1113
1114     } else {
1115
1116       warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n";
1117
1118     }
1119
1120   } else {
1121
1122     warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n";
1123
1124   }
1125
1126   '';
1127
1128 }
1129
1130 =back
1131
1132 =head1 BUGS
1133
1134   Mixing automatic and manual editing works poorly at present.
1135
1136 =head1 SEE ALSO
1137
1138 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
1139 documentation.
1140
1141 =cut
1142
1143 1;
1144