FS/FS/cust_main_county.pm

   1 package FS::cust_main_county;
   2 use base qw( FS::Record );
   3
   4 use strict;
   5 use vars qw( @EXPORT_OK $conf
   6              @cust_main_county %cust_main_county $countyflag $DEBUG $me); # $cityflag );
   7 use Exporter;
   8 use FS::Record qw( qsearch qsearchs dbh );
   9 use FS::cust_bill_pkg;
  10 use FS::cust_bill;
  11 use FS::cust_pkg;
  12 use FS::part_pkg;
  13 use FS::cust_tax_exempt;
  14 use FS::cust_tax_exempt_pkg;
  15 use FS::upgrade_journal;
  16
  17 $DEBUG = 0;
  18 $me = '[FS::cust_main_county]';
  19
  20 @EXPORT_OK = qw( regionselector );
  21
  22 @cust_main_county = ();
  23 $countyflag = '';
  24 #$cityflag = '';
  25
  26 #ask FS::UID to run this stuff for us later
  27 $FS::UID::callback{'FS::cust_main_county'} = sub {
  28   $conf = new FS::Conf;
  29 };
  30
  31 =head1 NAME
  32
  33 FS::cust_main_county - Object methods for cust_main_county objects
  34
  35 =head1 SYNOPSIS
  36
  37   use FS::cust_main_county;
  38
  39   $record = new FS::cust_main_county \%hash;
  40   $record = new FS::cust_main_county { '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   ($county_html, $state_html, $country_html) =
  51     FS::cust_main_county::regionselector( $county, $state, $country );
  52
  53 =head1 DESCRIPTION
  54
  55 An FS::cust_main_county object represents a tax rate, defined by locale.
  56 FS::cust_main_county inherits from FS::Record.  The following fields are
  57 currently supported:
  58
  59 =over 4
  60
  61 =item taxnum - primary key (assigned automatically for new tax rates)
  62
  63 =item district - tax district (optional)
  64
  65 =item city
  66
  67 =item county
  68
  69 =item state
  70
  71 =item country
  72
  73 =item tax - percentage
  74
  75 =item taxclass
  76
  77 =item exempt_amount
  78
  79 =item taxname - if defined, printed on invoices instead of "Tax"
  80
  81 =item setuptax - if 'Y', this tax does not apply to setup fees
  82
  83 =item recurtax - if 'Y', this tax does not apply to recurring fees
  84
  85 =item source - the tax lookup method that created this tax record. For records
  86 created manually, this will be null.
  87
  88 =back
  89
  90 =head1 METHODS
  91
  92 =over 4
  93
  94 =item new HASHREF
  95
  96 Creates a new tax rate.  To add the tax rate to the database, see L<"insert">.
  97
  98 =cut
  99
 100 sub table { 'cust_main_county'; }
 101
 102 =item insert
 103
 104 Adds this tax rate to the database.  If there is an error, returns the error,
 105 otherwise returns false.
 106
 107 =item delete
 108
 109 Deletes this tax rate from the database.  If there is an error, returns the
 110 error, otherwise returns false.
 111
 112 =item replace OLD_RECORD
 113
 114 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 115 returns the error, otherwise returns false.
 116
 117 =item check
 118
 119 Checks all fields to make sure this is a valid tax rate.  If there is an error,
 120 returns the error, otherwise returns false.  Called by the insert and replace
 121 methods.
 122
 123 =cut
 124
 125 sub check {
 126   my $self = shift;
 127
 128   $self->trim_whitespace(qw(district city county state country));
 129   $self->set('city', uc($self->get('city'))); # also county?
 130
 131   $self->exempt_amount(0) unless $self->exempt_amount;
 132
 133   $self->ut_numbern('taxnum')
 134     || $self->ut_alphan('district')
 135     || $self->ut_textn('city')
 136     || $self->ut_textn('county')
 137     || $self->ut_anything('state')
 138     || $self->ut_text('country')
 139     || $self->ut_float('tax')
 140     || $self->ut_textn('taxclass') # ...
 141     || $self->ut_money('exempt_amount')
 142     || $self->ut_textn('taxname')
 143     || $self->ut_enum('setuptax', [ '', 'Y' ] )
 144     || $self->ut_enum('recurtax', [ '', 'Y' ] )
 145     || $self->ut_textn('source')
 146     || $self->SUPER::check
 147     ;
 148
 149 }
 150
 151 =item label OPTIONS
 152
 153 Returns a label looking like "Anytown, Alameda County, CA, US".
 154
 155 If the taxname field is set, it will look like
 156 "CA Sales Tax (Anytown, Alameda County, CA, US)".
 157
 158 If the taxclass is set, then it will be
 159 "Anytown, Alameda County, CA, US (International)".
 160
 161 OPTIONS may contain "with_taxclass", "with_city", and "with_district" to show
 162 those fields.  It may also contain "out", in which case, if this region
 163 (district+city+county+state+country) contains no non-zero taxes, the label
 164 will read "Out of taxable region(s)".
 165
 166 =cut
 167
 168 sub label {
 169   my ($self, %opt) = @_;
 170   if ( $opt{'out'}
 171        and $self->tax == 0
 172        and !defined(qsearchs('cust_main_county', {
 173            'district' => $self->district,
 174            'city'     => $self->city,
 175            'county'   => $self->county,
 176            'state'    => $self->state,
 177            'country'  => $self->country,
 178            'tax'  => { op => '>', value => 0 },
 179         })) )
 180   {
 181     return 'Out of taxable region(s)';
 182   }
 183   my $label = $self->country;
 184   $label = $self->state.", $label" if $self->state;
 185   $label = $self->county." County, $label" if $self->county;
 186   if ($opt{with_city}) {
 187     $label = $self->city.", $label" if $self->city;
 188     if ($opt{with_district} and $self->district) {
 189       $label = $self->district . ", $label";
 190     }
 191   }
 192   # ugly labels when taxclass and taxname are both non-null...
 193   # but this is how the tax report does it
 194   if ($opt{with_taxclass}) {
 195     $label = "$label (".$self->taxclass.')' if $self->taxclass;
 196   }
 197   $label = $self->taxname." ($label)" if $self->taxname;
 198
 199   $label;
 200 }
 201
 202 =item sql_taxclass_sameregion
 203
 204 Returns an SQL WHERE fragment or the empty string to search for entries
 205 with different tax classes.
 206
 207 =cut
 208
 209 #hmm, description above could be better...
 210
 211 sub sql_taxclass_sameregion {
 212   my $self = shift;
 213
 214   my $same_query = 'SELECT DISTINCT taxclass FROM cust_main_county '.
 215                    ' WHERE taxnum != ? AND country = ?';
 216   my @same_param = ( 'taxnum', 'country' );
 217   foreach my $opt_field (qw( state county )) {
 218     if ( $self->$opt_field() ) {
 219       $same_query .= " AND $opt_field = ?";
 220       push @same_param, $opt_field;
 221     } else {
 222       $same_query .= " AND $opt_field IS NULL";
 223     }
 224   }
 225
 226   my @taxclasses = $self->_list_sql( \@same_param, $same_query );
 227
 228   return '' unless scalar(@taxclasses);
 229
 230   '( taxclass IS NULL OR ( '.  #only if !$self->taxclass ??
 231      join(' AND ', map { 'taxclass != '.dbh->quote($_) } @taxclasses ).
 232   ' ) ) ';
 233 }
 234
 235 sub _list_sql {
 236   my( $self, $param, $sql ) = @_;
 237   my $sth = dbh->prepare($sql) or die dbh->errstr;
 238   $sth->execute( map $self->$_(), @$param )
 239     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 240   map $_->[0], @{ $sth->fetchall_arrayref };
 241 }
 242
 243 =item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ]
 244
 245 Takes an arrayref of L<FS::cust_bill_pkg> objects representing taxable
 246 line items, and returns a new L<FS::cust_bill_pkg> object representing
 247 the tax on them under this tax rate.
 248
 249 This will have a pseudo-field, "cust_bill_pkg_tax_location", containing
 250 an arrayref of L<FS::cust_bill_pkg_tax_location> objects.  Each of these
 251 will in turn have a "taxable_cust_bill_pkg" pseudo-field linking it to one
 252 of the taxable items.  All of these links must be resolved as the objects
 253 are inserted.
 254
 255 In addition to calculating the tax for the line items, this will calculate
 256 any appropriate tax exemptions and attach them to the line items.
 257
 258 Options may include 'custnum' and 'invoice_time' in case the cust_bill_pkg
 259 objects belong to an invoice that hasn't been inserted yet.
 260
 261 Options may include 'exemptions', an arrayref of L<FS::cust_tax_exempt_pkg>
 262 objects belonging to the same customer, to be counted against the monthly
 263 tax exemption limit if there is one.
 264
 265 =cut
 266
 267 # XXX change tax_rate.pm to work like this
 268
 269 sub taxline {
 270   my( $self, $taxables, %opt ) = @_;
 271   return 'taxline called with no line items' unless @$taxables;
 272
 273   local $SIG{HUP} = 'IGNORE';
 274   local $SIG{INT} = 'IGNORE';
 275   local $SIG{QUIT} = 'IGNORE';
 276   local $SIG{TERM} = 'IGNORE';
 277   local $SIG{TSTP} = 'IGNORE';
 278   local $SIG{PIPE} = 'IGNORE';
 279
 280   my $oldAutoCommit = $FS::UID::AutoCommit;
 281   local $FS::UID::AutoCommit = 0;
 282   my $dbh = dbh;
 283
 284   my $name = $self->taxname || 'Tax';
 285   my $taxable_cents = 0;
 286   my $tax_cents = 0;
 287
 288   my $cust_bill = $taxables->[0]->cust_bill;
 289   my $custnum   = $cust_bill ? $cust_bill->custnum : $opt{'custnum'};
 290   my $invoice_time = $cust_bill ? $cust_bill->_date : $opt{'invoice_time'};
 291   my $cust_main = FS::cust_main->by_key($custnum) if $custnum;
 292   # (to avoid complications with estimated tax on quotations, assume it's
 293   # taxable if there is no customer)
 294   #if (!$cust_main) {
 295     #die "unable to calculate taxes for an unknown customer\n";
 296   #}
 297
 298   # set a flag if the customer is tax-exempt
 299   my ($exempt_cust, $exempt_cust_taxname);
 300   my $conf = FS::Conf->new;
 301   if ( $cust_main ) {
 302     if ( $conf->exists('cust_class-tax_exempt') ) {
 303       my $cust_class = $cust_main->cust_class;
 304       $exempt_cust = $cust_class->tax if $cust_class;
 305     } else {
 306       $exempt_cust = $cust_main->tax;
 307     }
 308
 309     # set a flag if the customer is exempt from this tax here
 310     if ( $self->taxname ) {
 311       $exempt_cust_taxname = $cust_main->tax_exemption($self->taxname);
 312     }
 313   }
 314
 315   # Gather any exemptions that are already attached to these cust_bill_pkgs
 316   # so that we can deduct them from the customer's monthly limit.
 317   my @existing_exemptions = @{ $opt{'exemptions'} };
 318   push @existing_exemptions, @{ $_->cust_tax_exempt_pkg }
 319     for @$taxables;
 320
 321   my $tax_item = FS::cust_bill_pkg->new({
 322       'pkgnum'    => 0,
 323       'recur'     => 0,
 324       'sdate'     => '',
 325       'edate'     => '',
 326       'itemdesc'  => $name,
 327   });
 328   my @tax_location;
 329
 330   foreach my $cust_bill_pkg (@$taxables) {
 331     # careful... may be a cust_bill_pkg or a quotation_pkg
 332
 333     my $cust_pkg  = $cust_bill_pkg->cust_pkg;
 334     my $part_pkg  = $cust_bill_pkg->part_pkg;
 335     my $part_fee  = $cust_bill_pkg->part_fee;
 336
 337     my $locationnum = $cust_bill_pkg->tax_locationnum
 338                       || $cust_main->ship_locationnum;
 339
 340     my @new_exemptions;
 341     my $taxable_charged = $cust_bill_pkg->setup + $cust_bill_pkg->recur
 342       or next; # don't create zero-amount exemptions
 343
 344     # XXX the following procedure should probably be in cust_bill_pkg
 345
 346     if ( $exempt_cust ) {
 347
 348       push @new_exemptions, FS::cust_tax_exempt_pkg->new({
 349           amount => $taxable_charged,
 350           exempt_cust => 'Y',
 351         });
 352       $taxable_charged = 0;
 353
 354     } elsif ( $exempt_cust_taxname ) {
 355
 356       push @new_exemptions, FS::cust_tax_exempt_pkg->new({
 357           amount => $taxable_charged,
 358           exempt_cust_taxname => 'Y',
 359         });
 360       $taxable_charged = 0;
 361
 362     }
 363
 364     my $setup_exempt = ( ($part_fee and not $part_fee->taxable)
 365                       or ($part_pkg and $part_pkg->setuptax)
 366                       or $self->setuptax );
 367
 368     if ( $setup_exempt
 369         and $cust_bill_pkg->setup > 0
 370         and $taxable_charged > 0 ) {
 371
 372       push @new_exemptions, FS::cust_tax_exempt_pkg->new({
 373           amount => $cust_bill_pkg->setup,
 374           exempt_setup => 'Y'
 375       });
 376       $taxable_charged -= $cust_bill_pkg->setup;
 377
 378     }
 379
 380     my $recur_exempt = ( ($part_fee and not $part_fee->taxable)
 381                       or ($part_pkg and $part_pkg->recurtax)
 382                       or $self->recurtax );
 383
 384     if ( $recur_exempt
 385         and $cust_bill_pkg->recur > 0
 386         and $taxable_charged > 0 ) {
 387
 388       push @new_exemptions, FS::cust_tax_exempt_pkg->new({
 389           amount => $cust_bill_pkg->recur,
 390           exempt_recur => 'Y'
 391       });
 392       $taxable_charged -= $cust_bill_pkg->recur;
 393
 394     }
 395
 396     if ( $self->exempt_amount && $self->exempt_amount > 0
 397       and $taxable_charged > 0
 398       and $cust_main ) {
 399
 400       # XXX monthly exemptions currently don't work on quotations
 401
 402       # If the billing period extends across multiple calendar months,
 403       # there may be several months of exemption available.
 404       my $sdate = $cust_bill_pkg->sdate || $invoice_time;
 405       my $start_month = (localtime($sdate))[4] + 1;
 406       my $start_year  = (localtime($sdate))[5] + 1900;
 407       my $edate = $cust_bill_pkg->edate || $invoice_time;
 408       my $end_month   = (localtime($edate))[4] + 1;
 409       my $end_year    = (localtime($edate))[5] + 1900;
 410
 411       # If the partial last month + partial first month <= one month,
 412       # don't use the exemption in the last month
 413       # (unless the last month is also the first month, e.g. one-time
 414       # charges)
 415       if ( (localtime($sdate))[3] >= (localtime($edate))[3]
 416            and ($start_month != $end_month or $start_year != $end_year)
 417       ) {
 418         $end_month--;
 419         if ( $end_month == 0 ) {
 420           $end_year--;
 421           $end_month = 12;
 422         }
 423       }
 424
 425       # number of months of exemption available
 426       my $freq = ($end_month - $start_month) +
 427                  ($end_year  - $start_year) * 12 +
 428                  1;
 429
 430       # divide equally among all of them
 431       my $permonth = sprintf('%.2f', $taxable_charged / $freq);
 432
 433       #call the whole thing off if this customer has any old
 434       #exemption records...
 435       my @cust_tax_exempt =
 436         qsearch( 'cust_tax_exempt' => { custnum=> $custnum } );
 437       if ( @cust_tax_exempt ) {
 438         $dbh->rollback if $oldAutoCommit;
 439         return
 440           'this customer still has old-style tax exemption records; '.
 441           'run bin/fs-migrate-cust_tax_exempt?';
 442       }
 443
 444       my ($mon, $year) = ($start_month, $start_year);
 445       while ($taxable_charged > 0.005 and
 446              ($year < $end_year or
 447                ($year == $end_year and $mon <= $end_month)
 448              )
 449       ) {
 450
 451         # find the sum of the exemption used by this customer, for this tax,
 452         # in this month
 453         my $sql = "
 454           SELECT SUM(amount)
 455             FROM cust_tax_exempt_pkg
 456               LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 457               LEFT JOIN cust_bill     USING ( invnum     )
 458             WHERE custnum = ?
 459               AND taxnum  = ?
 460               AND year    = ?
 461               AND month   = ?
 462               AND exempt_monthly = 'Y'
 463         ";
 464         my $sth = dbh->prepare($sql) or do {
 465           $dbh->rollback if $oldAutoCommit;
 466           return "fatal: can't lookup existing exemption: ". dbh->errstr;
 467         };
 468         $sth->execute(
 469           $custnum,
 470           $self->taxnum,
 471           $year,
 472           $mon,
 473         ) or do {
 474           $dbh->rollback if $oldAutoCommit;
 475           return "fatal: can't lookup existing exemption: ". dbh->errstr;
 476         };
 477         my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
 478
 479         # add any exemption we're already using for another line item
 480         foreach ( grep { $_->taxnum == $self->taxnum &&
 481                          $_->exempt_monthly eq 'Y'   &&
 482                          $_->month  == $mon          &&
 483                          $_->year   == $year
 484                        } @existing_exemptions
 485                 )
 486         {
 487           $existing_exemption += $_->amount;
 488         }
 489
 490         my $remaining_exemption =
 491           $self->exempt_amount - $existing_exemption;
 492         if ( $remaining_exemption > 0 ) {
 493           my $addl = $remaining_exemption > $permonth
 494             ? $permonth
 495             : $remaining_exemption;
 496           $addl = $taxable_charged if $addl > $taxable_charged;
 497
 498           push @new_exemptions, FS::cust_tax_exempt_pkg->new({
 499               amount          => sprintf('%.2f', $addl),
 500               exempt_monthly  => 'Y',
 501               year            => $year,
 502               month           => $mon,
 503             });
 504           $taxable_charged -= $addl;
 505         }
 506         # if they're using multiple months of exemption for a multi-month
 507         # package, then record the exemptions in separate months
 508         $mon++;
 509         if ( $mon > 12 ) {
 510           $mon -= 12;
 511           $year++;
 512         }
 513
 514       }
 515     } # if exempt_amount and $cust_main
 516
 517     $_->taxnum($self->taxnum) foreach @new_exemptions;
 518
 519     # attach them to the line item
 520     push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions;
 521     push @existing_exemptions, @new_exemptions;
 522
 523     $taxable_charged = sprintf( "%.2f", $taxable_charged);
 524     next if $taxable_charged == 0;
 525
 526     my $this_tax_cents = int($taxable_charged * $self->tax);
 527     my $location = FS::cust_bill_pkg_tax_location->new({
 528         'taxnum'      => $self->taxnum,
 529         'taxtype'     => ref($self),
 530         'cents'       => $this_tax_cents,
 531         'pkgnum'      => $cust_bill_pkg->pkgnum,
 532         'locationnum' => $locationnum,
 533         'taxable_cust_bill_pkg' => $cust_bill_pkg,
 534         'tax_cust_bill_pkg'     => $tax_item,
 535     });
 536     push @tax_location, $location;
 537
 538     $taxable_cents += $taxable_charged;
 539     $tax_cents += $this_tax_cents;
 540   } #foreach $cust_bill_pkg
 541
 542   # now round and distribute
 543   my $extra_cents = sprintf('%.2f', $taxable_cents * $self->tax / 100) * 100
 544                     - $tax_cents;
 545   # make sure we have an integer
 546   $extra_cents = sprintf('%.0f', $extra_cents);
 547   if ( $extra_cents < 0 ) {
 548     die "nonsense extra_cents value $extra_cents";
 549   }
 550   $tax_cents += $extra_cents;
 551   my $i = 0;
 552   foreach (@tax_location) { # can never require more than a single pass, yes?
 553     my $cents = $_->get('cents');
 554     if ( $extra_cents > 0 ) {
 555       $cents++;
 556       $extra_cents--;
 557     }
 558     $_->set('amount', sprintf('%.2f', $cents/100));
 559   }
 560   $tax_item->set('setup' => sprintf('%.2f', $tax_cents / 100));
 561   $tax_item->set('cust_bill_pkg_tax_location', \@tax_location);
 562
 563   return $tax_item;
 564 }
 565
 566 =back
 567
 568 =head1 SUBROUTINES
 569
 570 =over 4
 571
 572 =item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE [ DISABLED ] ] ] ]
 573
 574 =cut
 575
 576 sub regionselector {
 577   my ( $selected_county, $selected_state, $selected_country,
 578        $prefix, $onchange, $disabled ) = @_;
 579
 580   $prefix = '' unless defined $prefix;
 581
 582   $countyflag = 0;
 583
 584 #  unless ( @cust_main_county ) { #cache
 585     @cust_main_county = qsearch('cust_main_county', {} );
 586     foreach my $c ( @cust_main_county ) {
 587       $countyflag=1 if $c->county;
 588       #push @{$cust_main_county{$c->country}{$c->state}}, $c->county;
 589       $cust_main_county{$c->country}{$c->state}{$c->county} = 1;
 590     }
 591 #  }
 592   $countyflag=1 if $selected_county;
 593
 594   my $script_html = <<END;
 595     <SCRIPT>
 596     function opt(what,value,text) {
 597       var optionName = new Option(text, value, false, false);
 598       var length = what.length;
 599       what.options[length] = optionName;
 600     }
 601     function ${prefix}country_changed(what) {
 602       country = what.options[what.selectedIndex].text;
 603       for ( var i = what.form.${prefix}state.length; i >= 0; i-- )
 604           what.form.${prefix}state.options[i] = null;
 605 END
 606       #what.form.${prefix}state.options[0] = new Option('', '', false, true);
 607
 608   foreach my $country ( sort keys %cust_main_county ) {
 609     $script_html .= "\nif ( country == \"$country\" ) {\n";
 610     foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
 611       ( my $dstate = $state ) =~ s/[\n\r]//g;
 612       my $text = $dstate || '(n/a)';
 613       $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!;
 614     }
 615     $script_html .= "}\n";
 616   }
 617
 618   $script_html .= <<END;
 619     }
 620     function ${prefix}state_changed(what) {
 621 END
 622
 623   if ( $countyflag ) {
 624     $script_html .= <<END;
 625       state = what.options[what.selectedIndex].text;
 626       country = what.form.${prefix}country.options[what.form.${prefix}country.selectedIndex].text;
 627       for ( var i = what.form.${prefix}county.length; i >= 0; i-- )
 628           what.form.${prefix}county.options[i] = null;
 629 END
 630
 631     foreach my $country ( sort keys %cust_main_county ) {
 632       $script_html .= "\nif ( country == \"$country\" ) {\n";
 633       foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
 634         $script_html .= "\nif ( state == \"$state\" ) {\n";
 635           #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) {
 636           foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) {
 637             my $text = $county || '(n/a)';
 638             $script_html .=
 639               qq!opt(what.form.${prefix}county, "$county", "$text");\n!;
 640           }
 641         $script_html .= "}\n";
 642       }
 643       $script_html .= "}\n";
 644     }
 645   }
 646
 647   $script_html .= <<END;
 648     }
 649     </SCRIPT>
 650 END
 651
 652   my $county_html = $script_html;
 653   if ( $countyflag ) {
 654     $county_html .= qq!<SELECT NAME="${prefix}county" onChange="$onchange" $disabled>!;
 655     $county_html .= '</SELECT>';
 656   } else {
 657     $county_html .=
 658       qq!<INPUT TYPE="hidden" NAME="${prefix}county" VALUE="$selected_county">!;
 659   }
 660
 661   my $state_html = qq!<SELECT NAME="${prefix}state" !.
 662                    qq!onChange="${prefix}state_changed(this); $onchange" $disabled>!;
 663   foreach my $state ( sort keys %{ $cust_main_county{$selected_country} } ) {
 664     my $text = $state || '(n/a)';
 665     my $selected = $state eq $selected_state ? 'SELECTED' : '';
 666     $state_html .= qq(\n<OPTION $selected VALUE="$state">$text</OPTION>);
 667   }
 668   $state_html .= '</SELECT>';
 669
 670   $state_html .= '</SELECT>';
 671
 672   my $country_html = qq!<SELECT NAME="${prefix}country" !.
 673                      qq!onChange="${prefix}country_changed(this); $onchange" $disabled>!;
 674   my $countrydefault = $conf->config('countrydefault') || 'US';
 675   foreach my $country (
 676     sort { ($b eq $countrydefault) <=> ($a eq $countrydefault) or $a cmp $b }
 677       keys %cust_main_county
 678   ) {
 679     my $selected = $country eq $selected_country ? ' SELECTED' : '';
 680     $country_html .= qq(\n<OPTION$selected VALUE="$country">$country</OPTION>");
 681   }
 682   $country_html .= '</SELECT>';
 683
 684   ($county_html, $state_html, $country_html);
 685
 686 }
 687
 688 sub _merge_into {
 689   # for internal use: takes another cust_main_county object, transfers
 690   # all existing references to this record to that one, and deletes this
 691   # one.
 692   my $record = shift;
 693   my $other = shift or die "record to merge into must be provided";
 694   my $new_taxnum = $other->taxnum;
 695   my $old_taxnum = $record->taxnum;
 696   if ($other->tax != $record->tax or
 697       $other->exempt_amount != $record->exempt_amount) {
 698     # don't assume these are the same.
 699     warn "Found duplicate taxes (#$new_taxnum and #$old_taxnum) but they have different rates and can't be merged.\n";
 700   } else {
 701     warn "Merging tax #$old_taxnum into #$new_taxnum\n";
 702     foreach my $table (qw(
 703       cust_bill_pkg_tax_location
 704       cust_bill_pkg_tax_location_void
 705       cust_tax_exempt_pkg
 706       cust_tax_exempt_pkg_void
 707     )) {
 708       foreach my $row (qsearch($table, { 'taxnum' => $old_taxnum })) {
 709         $row->set('taxnum' => $new_taxnum);
 710         my $error = $row->replace;
 711         die $error if $error;
 712       }
 713     }
 714     my $error = $record->delete;
 715     die $error if $error;
 716   }
 717 }
 718
 719 =item process_edit_import
 720
 721 =cut
 722
 723 use Data::Dumper;
 724 sub process_edit_import {
 725   my $job = shift;
 726
 727   my $opt = { 'table'          => 'cust_main_county',
 728               'params'         => [], #required, apparantly
 729               'formats'        => { 'default' => [
 730                 'country',
 731                 'state',
 732                 'county',
 733                 'city',
 734                 '', #tax class
 735                 'taxname',
 736                 'tax',
 737                 'old_tax', #old tax
 738               ] },
 739               'format_headers' => { 'default' => 1, },
 740               'format_types'   => { 'default' => 'xls' },
 741             };
 742
 743   #false laziness w/
 744   #FS::Record::process_batch_import( $job, $opt, @_ );
 745
 746   my $table = $opt->{table};
 747   my @pass_params = @{ $opt->{params} };
 748   my %formats = %{ $opt->{formats} };
 749
 750   my $param = shift;
 751   warn Dumper($param) if $DEBUG;
 752
 753   my $files = $param->{'uploaded_files'}
 754     or die "No files provided.\n";
 755
 756   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
 757
 758   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
 759   my $file = $dir. $files{'file'};
 760
 761   my $error =
 762     #false laziness w/
 763     #FS::Record::batch_import( {
 764     FS::cust_main_county::edit_import( {
 765       #class-static
 766       table                      => $table,
 767       formats                    => \%formats,
 768       format_types               => $opt->{format_types},
 769       format_headers             => $opt->{format_headers},
 770       format_sep_chars           => $opt->{format_sep_chars},
 771       format_fixedlength_formats => $opt->{format_fixedlength_formats},
 772       #per-import
 773       job                        => $job,
 774       file                       => $file,
 775       #type                       => $type,
 776       format                     => $param->{format},
 777       params                     => { map { $_ => $param->{$_} } @pass_params },
 778       #?
 779       default_csv                => $opt->{default_csv},
 780     } );
 781
 782   unlink $file;
 783
 784   die "$error\n" if $error;
 785
 786 }
 787
 788 =item edit_import
 789
 790 =cut
 791
 792 #false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences
 793 #could be turned into callbacks or something
 794 use Text::CSV_XS;
 795 sub edit_import {
 796   my $param = shift;
 797
 798   warn "$me edit_import call with params: \n". Dumper($param)
 799     if $DEBUG;
 800
 801   my $table   = $param->{table};
 802   my $formats = $param->{formats};
 803
 804   my $job     = $param->{job};
 805   my $file    = $param->{file};
 806   my $format  = $param->{'format'};
 807   my $params  = $param->{params} || {};
 808
 809   die "unknown format $format" unless exists $formats->{ $format };
 810
 811   my $type = $param->{'format_types'}
 812              ? $param->{'format_types'}{ $format }
 813              : $param->{type} || 'csv';
 814
 815   unless ( $type ) {
 816     if ( $file =~ /\.(\w+)$/i ) {
 817       $type = lc($1);
 818     } else {
 819       #or error out???
 820       warn "can't parse file type from filename $file; defaulting to CSV";
 821       $type = 'csv';
 822     }
 823     $type = 'csv'
 824       if $param->{'default_csv'} && $type ne 'xls';
 825   }
 826
 827   my $header = $param->{'format_headers'}
 828                  ? $param->{'format_headers'}{ $param->{'format'} }
 829                  : 0;
 830
 831   my $sep_char = $param->{'format_sep_chars'}
 832                    ? $param->{'format_sep_chars'}{ $param->{'format'} }
 833                    : ',';
 834
 835   my $fixedlength_format =
 836     $param->{'format_fixedlength_formats'}
 837       ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
 838       : '';
 839
 840   my @fields = @{ $formats->{ $format } };
 841
 842   my $row = 0;
 843   my $count;
 844   my $parser;
 845   my @buffer = ();
 846   my @header = (); #edit_import
 847   if ( $type eq 'csv' || $type eq 'fixedlength' ) {
 848
 849     if ( $type eq 'csv' ) {
 850
 851       my %attr = ();
 852       $attr{sep_char} = $sep_char if $sep_char;
 853       $parser = new Text::CSV_XS \%attr;
 854
 855     } elsif ( $type eq 'fixedlength' ) {
 856
 857       eval "use Parse::FixedLength;";
 858       die $@ if $@;
 859       $parser = new Parse::FixedLength $fixedlength_format;
 860
 861     } else {
 862       die "Unknown file type $type\n";
 863     }
 864
 865     @buffer = split(/\r?\n/, slurp($file) );
 866     splice(@buffer, 0, ($header || 0) );
 867     $count = scalar(@buffer);
 868
 869   } elsif ( $type eq 'xls' ) {
 870
 871     eval "use Spreadsheet::ParseExcel;";
 872     die $@ if $@;
 873
 874     eval "use DateTime::Format::Excel;";
 875     #for now, just let the error be thrown if it is used, since only CDR
 876     # formats bill_west and troop use it, not other excel-parsing things
 877     #die $@ if $@;
 878
 879     my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file);
 880
 881     $parser = $excel->{Worksheet}[0]; #first sheet
 882
 883     $count = $parser->{MaxRow} || $parser->{MinRow};
 884     $count++;
 885
 886     $row = $header || 0;
 887
 888     #edit_import - need some magic to parse the header
 889     if ( $header ) {
 890       my @header_row = @{ $parser->{Cells}[$0] };
 891       @header = map $_->{Val}, @header_row;
 892     }
 893
 894   } else {
 895     die "Unknown file type $type\n";
 896   }
 897
 898   #my $columns;
 899
 900   local $SIG{HUP} = 'IGNORE';
 901   local $SIG{INT} = 'IGNORE';
 902   local $SIG{QUIT} = 'IGNORE';
 903   local $SIG{TERM} = 'IGNORE';
 904   local $SIG{TSTP} = 'IGNORE';
 905   local $SIG{PIPE} = 'IGNORE';
 906
 907   my $oldAutoCommit = $FS::UID::AutoCommit;
 908   local $FS::UID::AutoCommit = 0;
 909   my $dbh = dbh;
 910
 911   my $line;
 912   my $imported = 0;
 913   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
 914   while (1) {
 915
 916     my @columns = ();
 917     if ( $type eq 'csv' ) {
 918
 919       last unless scalar(@buffer);
 920       $line = shift(@buffer);
 921
 922       $parser->parse($line) or do {
 923         $dbh->rollback if $oldAutoCommit;
 924         return "can't parse: ". $parser->error_input();
 925       };
 926       @columns = $parser->fields();
 927
 928     } elsif ( $type eq 'fixedlength' ) {
 929
 930       @columns = $parser->parse($line);
 931
 932     } elsif ( $type eq 'xls' ) {
 933
 934       last if $row > ($parser->{MaxRow} || $parser->{MinRow})
 935            || ! $parser->{Cells}[$row];
 936
 937       my @row = @{ $parser->{Cells}[$row] };
 938       @columns = map $_->{Val}, @row;
 939
 940       #my $z = 'A';
 941       #warn $z++. ": $_\n" for @columns;
 942
 943     } else {
 944       die "Unknown file type $type\n";
 945     }
 946
 947     #edit_import loop
 948
 949     my %hash = %$params;
 950     my @later;
 951
 952     foreach my $field ( @fields ) {
 953
 954       my $value = shift @columns;
 955
 956       if ( ref($field) eq 'CODE' ) {
 957         #&{$field}(\%hash, $value);
 958         push @later, $field, $value;
 959       } elsif ($field) { #edit_import
 960         $hash{$field} = $value if defined($value) && length($value);
 961       }
 962
 963     }
 964
 965     my $class = "FS::$table";
 966
 967     my $record = $class->new( \%hash );
 968
 969     while ( scalar(@later) ) {
 970       my $sub = shift @later;
 971       my $data = shift @later;
 972       &{$sub}($record, $data); #edit_import - don't have $conf
 973     }
 974
 975     #edit_import update or insert, not just insert
 976     my $old = qsearchs({
 977       'table'   => $table,
 978       'hashref' => { map { $_ => $record->$_() } qw(country state county city taxname) },
 979     });
 980
 981     my $error;
 982     if ( $old ) {
 983       $record->taxnum($old->taxnum);
 984       $error = $record->replace($old)
 985     } else {
 986       $record->insert;
 987     }
 988
 989     if ( $error ) {
 990       $dbh->rollback if $oldAutoCommit;
 991       return "can't insert record". ( $line ? " for $line" : '' ). ": $error";
 992     }
 993
 994     $row++;
 995     $imported++;
 996
 997     if ( $job && time - $min_sec > $last ) { #progress bar
 998       $job->update_statustext( int(100 * $imported / $count) );
 999       $last = time;
1000     }
1001
1002   }
1003
1004   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
1005
1006   return "Empty file!" unless $imported || $param->{empty_ok};
1007
1008   ''; #no error
1009
1010 }
1011
1012 sub _upgrade_data {
1013   my $class = shift;
1014   # assume taxes in Washington with district numbers, and null name, or
1015   # named 'sales tax', are looked up via the wa_sales method. mark them.
1016   my $journal = 'cust_main_county__source_wa_sales_201611';
1017   if (!FS::upgrade_journal->is_done($journal)) {
1018     my @taxes = qsearch({
1019         'table'     => 'cust_main_county',
1020         'extra_sql' => " WHERE tax > 0 AND country = 'US' AND state = 'WA'".
1021                        " AND district IS NOT NULL AND ( taxname IS NULL OR ".
1022                        " taxname ~* 'sales tax' )",
1023     });
1024     if ( @taxes ) {
1025       warn "Flagging Washington state sales taxes: ".scalar(@taxes)." records.\n";
1026       foreach (@taxes) {
1027         $_->set('source', 'wa_sales');
1028         my $error = $_->replace;
1029         die $error if $error;
1030       }
1031     }
1032     FS::upgrade_journal->set_done($journal);
1033   }
1034   my @key_fields = (qw(city county state country district taxname taxclass));
1035
1036   # trim whitespace and convert to uppercase in the 'city' field.
1037   foreach my $record (qsearch({
1038     table => 'cust_main_county',
1039     extra_sql => " WHERE city LIKE ' %' OR city LIKE '% ' OR city != UPPER(city)",
1040   })) {
1041     # any with-trailing-space records probably duplicate other records
1042     # from the same city, and if we just fix the record in place, we'll
1043     # create an exact duplicate.
1044     # so find the record this one would duplicate, and merge them.
1045     $record->check; # trims whitespace
1046     my %match = map { $_ => $record->get($_) } @key_fields;
1047     my $other = qsearchs('cust_main_county', \%match);
1048     if ($other) {
1049       $record->_merge_into($other);
1050     } else {
1051       # else there is no record this one duplicates, so just fix it
1052       my $error = $record->replace;
1053       die $error if $error;
1054     }
1055   } # foreach $record
1056
1057   # separate wa_sales taxes by tax class as needed
1058   my $district_taxname = $conf->config('tax_district_taxname');
1059   $journal = 'cust_main_county__district_taxclass';
1060   if (!FS::upgrade_journal->is_done($journal)
1061       and $conf->exists('enable_taxclasses')) {
1062     eval "use FS::part_pkg_taxclass";
1063     my @taxes = qsearch({
1064         'table'     => 'cust_main_county',
1065         'extra_sql' => " WHERE tax > 0 AND country = 'US' AND state = 'WA'".
1066                        " AND district IS NOT NULL AND  source = 'wa_sales'".
1067                        " AND taxclass IS NULL"
1068     });
1069     my @classes = FS::part_pkg_taxclass->taxclass_names;
1070     if ( @taxes ) {
1071       warn "Separating WA sales taxes: ".scalar(@taxes)." records.\n";
1072       foreach my $oldtax (@taxes) {
1073         my $error;
1074         my $taxnum = $oldtax->taxnum;
1075         warn "Separating tax #$taxnum into classes\n";
1076         foreach my $taxclass (@classes) {
1077           # ensure that we end up with a single copy of the tax in this
1078           # jurisdiction+class. there may already be one (or more) there.
1079           # if so, they all represent the same tax; merge them together.
1080           my %newtax_hash = (
1081             'country'   => 'US',
1082             'state'     => 'WA',
1083             'city'      => $oldtax->city,
1084             'district'  => $oldtax->district,
1085             'taxclass'  => $taxclass,
1086             'source'    => 'wa_sales',
1087           );
1088           my @taxes_in_class = qsearch('cust_main_county', {
1089             %newtax_hash,
1090             'tax'       => { op => '>', value => 0 },
1091             'setuptax'  => '',
1092             'recurtax'  => '',
1093           });
1094           my $newtax = shift @taxes_in_class;
1095           if ($newtax) {
1096             foreach (@taxes_in_class) {
1097               # allow the merge, even if this somehow differs.
1098               $_->set('tax', $newtax->tax);
1099               $_->_merge_into($newtax);
1100             }
1101           }
1102           $newtax ||= FS::cust_main_county->new(\%newtax_hash);
1103           # copy properties from the pre-split tax
1104           $newtax->set('tax', $oldtax->tax);
1105           $newtax->set('setuptax', $oldtax->setuptax);
1106           $newtax->set('recurtax', $oldtax->recurtax);
1107           # and assign the defined tax name
1108           $newtax->set('taxname', $district_taxname);
1109           $error = ($newtax->taxnum ? $newtax->replace : $newtax->insert);
1110           die "splitting taxnum ".$oldtax->taxnum.": $error\n" if $error;
1111         } # foreach $taxclass
1112         $oldtax->set('tax', 0);
1113         $error = $oldtax->replace;
1114         die "splitting taxnum ".$oldtax->taxnum.": $error\n" if $error;
1115       }
1116     }
1117     FS::upgrade_journal->set_done($journal);
1118   }
1119
1120   # also ensure they all have the chosen taxname now
1121   if ($district_taxname) {
1122     my @taxes = qsearch('cust_main_county', {
1123       'source'  => 'wa_sales',
1124       'taxname' => { op => '!=', value => $district_taxname }
1125     });
1126     if (@taxes) {
1127       warn "Renaming WA sales taxes: ".scalar(@taxes)." records.\n";
1128       foreach my $tax (@taxes) {
1129         $tax->set('taxname', $district_taxname);
1130         my $error = $tax->replace;
1131         die "renaming taxnum ".$tax->taxnum.": $error\n" if $error;
1132       }
1133     }
1134   }
1135
1136   # remove duplicates (except disabled records)
1137   my @duplicate_sets = qsearch({
1138     table => 'cust_main_county',
1139     select => FS::Record::group_concat_sql('taxnum', ',') . ' AS taxnums, ' .
1140               join(',', @key_fields),
1141     extra_sql => ' WHERE tax > 0
1142       GROUP BY city, county, state, country, district, taxname, taxclass
1143       HAVING COUNT(*) > 1'
1144   });
1145   warn "Found ".scalar(@duplicate_sets)." set(s) of duplicate tax definitions\n"
1146     if @duplicate_sets;
1147   foreach my $set (@duplicate_sets) {
1148     my @taxnums = split(',', $set->get('taxnums'));
1149     my $first = FS::cust_main_county->by_key(shift @taxnums);
1150     foreach my $taxnum (@taxnums) {
1151       my $record = FS::cust_main_county->by_key($taxnum);
1152       $record->_merge_into($first);
1153     }
1154   }
1155
1156
1157   '';
1158 }
1159
1160 =back
1161
1162 =head1 BUGS
1163
1164 regionselector?  putting web ui components in here?  they should probably live
1165 somewhere else...
1166
1167 =head1 SEE ALSO
1168
1169 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
1170 documentation.
1171
1172 =cut
1173
1174 1;
1175