FS/FS/cust_main_county.pm

   1 package FS::cust_main_county;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $conf
   5              @cust_main_county %cust_main_county $countyflag ); # $cityflag );
   6 use Exporter;
   7 use FS::Record qw( qsearch dbh );
   8 use FS::cust_bill_pkg;
   9 use FS::cust_bill;
  10 use FS::cust_pkg;
  11 use FS::part_pkg;
  12 use FS::cust_tax_exempt;
  13 use FS::cust_tax_exempt_pkg;
  14
  15 @ISA = qw( FS::Record );
  16 @EXPORT_OK = qw( regionselector );
  17
  18 @cust_main_county = ();
  19 $countyflag = '';
  20 #$cityflag = '';
  21
  22 #ask FS::UID to run this stuff for us later
  23 $FS::UID::callback{'FS::cust_main_county'} = sub {
  24   $conf = new FS::Conf;
  25 };
  26
  27 =head1 NAME
  28
  29 FS::cust_main_county - Object methods for cust_main_county objects
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::cust_main_county;
  34
  35   $record = new FS::cust_main_county \%hash;
  36   $record = new FS::cust_main_county { 'column' => 'value' };
  37
  38   $error = $record->insert;
  39
  40   $error = $new_record->replace($old_record);
  41
  42   $error = $record->delete;
  43
  44   $error = $record->check;
  45
  46   ($county_html, $state_html, $country_html) =
  47     FS::cust_main_county::regionselector( $county, $state, $country );
  48
  49 =head1 DESCRIPTION
  50
  51 An FS::cust_main_county object represents a tax rate, defined by locale.
  52 FS::cust_main_county inherits from FS::Record.  The following fields are
  53 currently supported:
  54
  55 =over 4
  56
  57 =item taxnum - primary key (assigned automatically for new tax rates)
  58
  59 =item district - tax district (optional)
  60
  61 =item city
  62
  63 =item county
  64
  65 =item state
  66
  67 =item country
  68
  69 =item tax - percentage
  70
  71 =item taxclass
  72
  73 =item exempt_amount
  74
  75 =item taxname - if defined, printed on invoices instead of "Tax"
  76
  77 =item setuptax - if 'Y', this tax does not apply to setup fees
  78
  79 =item recurtax - if 'Y', this tax does not apply to recurring fees
  80
  81 =back
  82
  83 =head1 METHODS
  84
  85 =over 4
  86
  87 =item new HASHREF
  88
  89 Creates a new tax rate.  To add the tax rate to the database, see L<"insert">.
  90
  91 =cut
  92
  93 sub table { 'cust_main_county'; }
  94
  95 =item insert
  96
  97 Adds this tax rate to the database.  If there is an error, returns the error,
  98 otherwise returns false.
  99
 100 =item delete
 101
 102 Deletes this tax rate from the database.  If there is an error, returns the
 103 error, otherwise returns false.
 104
 105 =item replace OLD_RECORD
 106
 107 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 108 returns the error, otherwise returns false.
 109
 110 =item check
 111
 112 Checks all fields to make sure this is a valid tax rate.  If there is an error,
 113 returns the error, otherwise returns false.  Called by the insert and replace
 114 methods.
 115
 116 =cut
 117
 118 sub check {
 119   my $self = shift;
 120
 121   $self->exempt_amount(0) unless $self->exempt_amount;
 122
 123   $self->ut_numbern('taxnum')
 124     || $self->ut_alphan('district')
 125     || $self->ut_textn('city')
 126     || $self->ut_textn('county')
 127     || $self->ut_anything('state')
 128     || $self->ut_text('country')
 129     || $self->ut_float('tax')
 130     || $self->ut_textn('taxclass') # ...
 131     || $self->ut_money('exempt_amount')
 132     || $self->ut_textn('taxname')
 133     || $self->ut_enum('setuptax', [ '', 'Y' ] )
 134     || $self->ut_enum('recurtax', [ '', 'Y' ] )
 135     || $self->SUPER::check
 136     ;
 137
 138 }
 139
 140 sub taxname {
 141   my $self = shift;
 142   if ( $self->dbdef_table->column('taxname') ) {
 143     return $self->setfield('taxname', $_[0]) if @_;
 144     return $self->getfield('taxname');
 145   }
 146   return '';
 147 }
 148
 149 sub setuptax {
 150   my $self = shift;
 151   if ( $self->dbdef_table->column('setuptax') ) {
 152     return $self->setfield('setuptax', $_[0]) if @_;
 153     return $self->getfield('setuptax');
 154   }
 155   return '';
 156 }
 157
 158 sub recurtax {
 159   my $self = shift;
 160   if ( $self->dbdef_table->column('recurtax') ) {
 161     return $self->setfield('recurtax', $_[0]) if @_;
 162     return $self->getfield('recurtax');
 163   }
 164   return '';
 165 }
 166
 167 =item sql_taxclass_sameregion
 168
 169 Returns an SQL WHERE fragment or the empty string to search for entries
 170 with different tax classes.
 171
 172 =cut
 173
 174 #hmm, description above could be better...
 175
 176 sub sql_taxclass_sameregion {
 177   my $self = shift;
 178
 179   my $same_query = 'SELECT taxclass FROM cust_main_county '.
 180                    ' WHERE taxnum != ? AND country = ?';
 181   my @same_param = ( 'taxnum', 'country' );
 182   foreach my $opt_field (qw( state county )) {
 183     if ( $self->$opt_field() ) {
 184       $same_query .= " AND $opt_field = ?";
 185       push @same_param, $opt_field;
 186     } else {
 187       $same_query .= " AND $opt_field IS NULL";
 188     }
 189   }
 190
 191   my @taxclasses = $self->_list_sql( \@same_param, $same_query );
 192
 193   return '' unless scalar(@taxclasses);
 194
 195   '( taxclass IS NULL OR ( '.  #only if !$self->taxclass ??
 196      join(' AND ', map { 'taxclass != '.dbh->quote($_) } @taxclasses ).
 197   ' ) ) ';
 198 }
 199
 200 sub _list_sql {
 201   my( $self, $param, $sql ) = @_;
 202   my $sth = dbh->prepare($sql) or die dbh->errstr;
 203   $sth->execute( map $self->$_(), @$param )
 204     or die "Unexpected error executing statement $sql: ". $sth->errstr;
 205   map $_->[0], @{ $sth->fetchall_arrayref };
 206 }
 207
 208 =item taxline TAXABLES_ARRAYREF, [ OPTION => VALUE ... ]
 209
 210 Returns a listref of a name and an amount of tax calculated for the list of
 211 packages or amounts referenced by TAXABLES_ARRAYREF.  Returns a scalar error
 212 message on error.
 213
 214 Options include custnum and invoice_date and are hints to this method
 215
 216 =cut
 217
 218 sub taxline {
 219   my( $self, $taxables, %opt ) = @_;
 220
 221   my @exemptions = ();
 222   push @exemptions, @{ $_->_cust_tax_exempt_pkg }
 223     for grep { ref($_) } @$taxables;
 224
 225   local $SIG{HUP} = 'IGNORE';
 226   local $SIG{INT} = 'IGNORE';
 227   local $SIG{QUIT} = 'IGNORE';
 228   local $SIG{TERM} = 'IGNORE';
 229   local $SIG{TSTP} = 'IGNORE';
 230   local $SIG{PIPE} = 'IGNORE';
 231
 232   my $oldAutoCommit = $FS::UID::AutoCommit;
 233   local $FS::UID::AutoCommit = 0;
 234   my $dbh = dbh;
 235
 236   my $name = $self->taxname || 'Tax';
 237   my $amount = 0;
 238
 239   foreach my $cust_bill_pkg (@$taxables) {
 240
 241     my $cust_pkg  = $cust_bill_pkg->cust_pkg;
 242     my $cust_bill = $cust_pkg->cust_bill if $cust_pkg;
 243     my $custnum   = $cust_pkg ? $cust_pkg->custnum : $opt{custnum};
 244     my $part_pkg  = $cust_bill_pkg->part_pkg;
 245     my $invoice_date = $cust_bill ? $cust_bill->_date : $opt{invoice_date};
 246
 247     my $taxable_charged = 0;
 248     $taxable_charged += $cust_bill_pkg->setup
 249       unless $part_pkg->setuptax =~ /^Y$/i
 250           || $self->setuptax =~ /^Y$/i;
 251     $taxable_charged += $cust_bill_pkg->recur
 252       unless $part_pkg->recurtax =~ /^Y$/i
 253           || $self->recurtax =~ /^Y$/i;
 254
 255     next unless $taxable_charged;
 256
 257     if ( $self->exempt_amount && $self->exempt_amount > 0 ) {
 258       #my ($mon,$year) = (localtime($cust_bill_pkg->sdate) )[4,5];
 259       my ($mon,$year) =
 260         (localtime( $cust_bill_pkg->sdate || $invoice_date ) )[4,5];
 261       $mon++;
 262       my $freq = $cust_bill_pkg->freq;
 263       unless ($freq) {
 264         $freq = $part_pkg->freq || 1;  # less trustworthy fallback
 265       }
 266       if ( $freq !~ /(\d+)$/ ) {
 267         $dbh->rollback if $oldAutoCommit;
 268         return "daily/weekly package definitions not (yet?)".
 269                " compatible with monthly tax exemptions";
 270       }
 271       my $taxable_per_month =
 272         sprintf("%.2f", $taxable_charged / $freq );
 273
 274       #call the whole thing off if this customer has any old
 275       #exemption records...
 276       my @cust_tax_exempt =
 277         qsearch( 'cust_tax_exempt' => { custnum=> $custnum } );
 278       if ( @cust_tax_exempt ) {
 279         $dbh->rollback if $oldAutoCommit;
 280         return
 281           'this customer still has old-style tax exemption records; '.
 282           'run bin/fs-migrate-cust_tax_exempt?';
 283       }
 284
 285       foreach my $which_month ( 1 .. $freq ) {
 286
 287         #maintain the new exemption table now
 288         my $sql = "
 289           SELECT SUM(amount)
 290             FROM cust_tax_exempt_pkg
 291               LEFT JOIN cust_bill_pkg USING ( billpkgnum )
 292               LEFT JOIN cust_bill     USING ( invnum     )
 293             WHERE custnum = ?
 294               AND taxnum  = ?
 295               AND year    = ?
 296               AND month   = ?
 297         ";
 298         my $sth = dbh->prepare($sql) or do {
 299           $dbh->rollback if $oldAutoCommit;
 300           return "fatal: can't lookup exising exemption: ". dbh->errstr;
 301         };
 302         $sth->execute(
 303           $custnum,
 304           $self->taxnum,
 305           1900+$year,
 306           $mon,
 307         ) or do {
 308           $dbh->rollback if $oldAutoCommit;
 309           return "fatal: can't lookup exising exemption: ". dbh->errstr;
 310         };
 311         my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0;
 312
 313         foreach ( grep { $_->taxnum == $self->taxnum &&
 314                          $_->month  == $mon          &&
 315                          $_->year   == 1900+$year
 316                        } @exemptions
 317                 )
 318         {
 319           $existing_exemption += $_->amount;
 320         }
 321
 322         my $remaining_exemption =
 323           $self->exempt_amount - $existing_exemption;
 324         if ( $remaining_exemption > 0 ) {
 325           my $addl = $remaining_exemption > $taxable_per_month
 326             ? $taxable_per_month
 327             : $remaining_exemption;
 328           $taxable_charged -= $addl;
 329
 330           my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( {
 331             'taxnum'     => $self->taxnum,
 332             'year'       => 1900+$year,
 333             'month'      => $mon,
 334             'amount'     => sprintf("%.2f", $addl ),
 335           } );
 336           if ($cust_bill_pkg->billpkgnum) {
 337             $cust_tax_exempt_pkg->billpkgnum($cust_bill_pkg->billpkgnum);
 338             my $error = $cust_tax_exempt_pkg->insert;
 339             if ( $error ) {
 340               $dbh->rollback if $oldAutoCommit;
 341               return "fatal: can't insert cust_tax_exempt_pkg: $error";
 342             }
 343           }else{
 344             push @exemptions, $cust_tax_exempt_pkg;
 345             push @{ $cust_bill_pkg->_cust_tax_exempt_pkg }, $cust_tax_exempt_pkg;
 346           } # if $cust_bill_pkg->billpkgnum
 347         } # if $remaining_exemption > 0
 348
 349         #++
 350         $mon++;
 351         #until ( $mon < 12 ) { $mon -= 12; $year++; }
 352         until ( $mon < 13 ) { $mon -= 12; $year++; }
 353
 354       } #foreach $which_month
 355
 356     } #if $tax->exempt_amount
 357
 358     $taxable_charged = sprintf( "%.2f", $taxable_charged);
 359
 360     $amount += $taxable_charged * $self->tax / 100
 361   }
 362
 363   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 364
 365   return {
 366     'name'   => $name,
 367     'amount' => $amount,
 368   };
 369
 370 }
 371
 372 =back
 373
 374 =head1 SUBROUTINES
 375
 376 =over 4
 377
 378 =item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE [ DISABLED ] ] ] ]
 379
 380 =cut
 381
 382 sub regionselector {
 383   my ( $selected_county, $selected_state, $selected_country,
 384        $prefix, $onchange, $disabled ) = @_;
 385
 386   $prefix = '' unless defined $prefix;
 387
 388   $countyflag = 0;
 389
 390 #  unless ( @cust_main_county ) { #cache
 391     @cust_main_county = qsearch('cust_main_county', {} );
 392     foreach my $c ( @cust_main_county ) {
 393       $countyflag=1 if $c->county;
 394       #push @{$cust_main_county{$c->country}{$c->state}}, $c->county;
 395       $cust_main_county{$c->country}{$c->state}{$c->county} = 1;
 396     }
 397 #  }
 398   $countyflag=1 if $selected_county;
 399
 400   my $script_html = <<END;
 401     <SCRIPT>
 402     function opt(what,value,text) {
 403       var optionName = new Option(text, value, false, false);
 404       var length = what.length;
 405       what.options[length] = optionName;
 406     }
 407     function ${prefix}country_changed(what) {
 408       country = what.options[what.selectedIndex].text;
 409       for ( var i = what.form.${prefix}state.length; i >= 0; i-- )
 410           what.form.${prefix}state.options[i] = null;
 411 END
 412       #what.form.${prefix}state.options[0] = new Option('', '', false, true);
 413
 414   foreach my $country ( sort keys %cust_main_county ) {
 415     $script_html .= "\nif ( country == \"$country\" ) {\n";
 416     foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
 417       ( my $dstate = $state ) =~ s/[\n\r]//g;
 418       my $text = $dstate || '(n/a)';
 419       $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!;
 420     }
 421     $script_html .= "}\n";
 422   }
 423
 424   $script_html .= <<END;
 425     }
 426     function ${prefix}state_changed(what) {
 427 END
 428
 429   if ( $countyflag ) {
 430     $script_html .= <<END;
 431       state = what.options[what.selectedIndex].text;
 432       country = what.form.${prefix}country.options[what.form.${prefix}country.selectedIndex].text;
 433       for ( var i = what.form.${prefix}county.length; i >= 0; i-- )
 434           what.form.${prefix}county.options[i] = null;
 435 END
 436
 437     foreach my $country ( sort keys %cust_main_county ) {
 438       $script_html .= "\nif ( country == \"$country\" ) {\n";
 439       foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
 440         $script_html .= "\nif ( state == \"$state\" ) {\n";
 441           #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) {
 442           foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) {
 443             my $text = $county || '(n/a)';
 444             $script_html .=
 445               qq!opt(what.form.${prefix}county, "$county", "$text");\n!;
 446           }
 447         $script_html .= "}\n";
 448       }
 449       $script_html .= "}\n";
 450     }
 451   }
 452
 453   $script_html .= <<END;
 454     }
 455     </SCRIPT>
 456 END
 457
 458   my $county_html = $script_html;
 459   if ( $countyflag ) {
 460     $county_html .= qq!<SELECT NAME="${prefix}county" onChange="$onchange" $disabled>!;
 461     $county_html .= '</SELECT>';
 462   } else {
 463     $county_html .=
 464       qq!<INPUT TYPE="hidden" NAME="${prefix}county" VALUE="$selected_county">!;
 465   }
 466
 467   my $state_html = qq!<SELECT NAME="${prefix}state" !.
 468                    qq!onChange="${prefix}state_changed(this); $onchange" $disabled>!;
 469   foreach my $state ( sort keys %{ $cust_main_county{$selected_country} } ) {
 470     my $text = $state || '(n/a)';
 471     my $selected = $state eq $selected_state ? 'SELECTED' : '';
 472     $state_html .= qq(\n<OPTION $selected VALUE="$state">$text</OPTION>);
 473   }
 474   $state_html .= '</SELECT>';
 475
 476   $state_html .= '</SELECT>';
 477
 478   my $country_html = qq!<SELECT NAME="${prefix}country" !.
 479                      qq!onChange="${prefix}country_changed(this); $onchange" $disabled>!;
 480   my $countrydefault = $conf->config('countrydefault') || 'US';
 481   foreach my $country (
 482     sort { ($b eq $countrydefault) <=> ($a eq $countrydefault) or $a cmp $b }
 483       keys %cust_main_county
 484   ) {
 485     my $selected = $country eq $selected_country ? ' SELECTED' : '';
 486     $country_html .= qq(\n<OPTION$selected VALUE="$country">$country</OPTION>");
 487   }
 488   $country_html .= '</SELECT>';
 489
 490   ($county_html, $state_html, $country_html);
 491
 492 }
 493
 494 =back
 495
 496 =head1 BUGS
 497
 498 regionselector?  putting web ui components in here?  they should probably live
 499 somewhere else...
 500
 501 =head1 SEE ALSO
 502
 503 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
 504 documentation.
 505
 506 =cut
 507
 508 1;
 509