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