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