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