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