FS/FS/cust_bill_pkg_tax_location.pm

   1 package FS::cust_bill_pkg_tax_location;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use FS::Record qw( qsearch qsearchs );
   6 use FS::cust_bill_pkg;
   7 use FS::cust_pkg;
   8 use FS::cust_location;
   9 use FS::cust_bill_pay_pkg;
  10 use FS::cust_credit_bill_pkg;
  11 use FS::cust_main_county;
  12 use FS::Log;
  13
  14 use List::Util qw(sum min);
  15
  16 =head1 NAME
  17
  18 FS::cust_bill_pkg_tax_location - Object methods for cust_bill_pkg_tax_location records
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::cust_bill_pkg_tax_location;
  23
  24   $record = new FS::cust_bill_pkg_tax_location \%hash;
  25   $record = new FS::cust_bill_pkg_tax_location { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35 =head1 DESCRIPTION
  36
  37 An FS::cust_bill_pkg_tax_location object represents an record of taxation
  38 based on package location.  FS::cust_bill_pkg_tax_location inherits from
  39 FS::Record.  The following fields are currently supported:
  40
  41 =over 4
  42
  43 =item billpkgtaxlocationnum
  44
  45 billpkgtaxlocationnum
  46
  47 =item billpkgnum
  48
  49 billpkgnum
  50
  51 =item taxnum
  52
  53 taxnum
  54
  55 =item taxtype
  56
  57 taxtype
  58
  59 =item pkgnum
  60
  61 pkgnum
  62
  63 =item locationnum
  64
  65 locationnum
  66
  67 =item amount
  68
  69 amount
  70
  71 =item taxable_billpkgnum
  72
  73 The billpkgnum of the L<FS::cust_bill_pkg> that this tax was charged on.
  74 It may specifically be on any portion of that line item (setup, recurring,
  75 or a usage class).
  76
  77 =back
  78
  79 =head1 METHODS
  80
  81 =over 4
  82
  83 =item new HASHREF
  84
  85 Creates a new record.  To add the record to the database, see L<"insert">.
  86
  87 Note that this stores the hash reference, not a distinct copy of the hash it
  88 points to.  You can ask the object for a copy with the I<hash> method.
  89
  90 =cut
  91
  92 sub table { 'cust_bill_pkg_tax_location'; }
  93
  94 =item insert
  95
  96 Adds this record to the database.  If there is an error, returns the error,
  97 otherwise returns false.
  98
  99 =item delete
 100
 101 Delete this record from the database.
 102
 103 =item replace OLD_RECORD
 104
 105 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 106 returns the error, otherwise returns false.
 107
 108 =item check
 109
 110 Checks all fields to make sure this is a valid record.  If there is
 111 an error, returns the error, otherwise returns false.  Called by the insert
 112 and replace methods.
 113
 114 =cut
 115
 116 # the check method should currently be supplied - FS::Record contains some
 117 # data checking routines
 118
 119 sub check {
 120   my $self = shift;
 121
 122   my $error =
 123     $self->ut_numbern('billpkgtaxlocationnum')
 124     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum' )
 125     || $self->ut_number('taxnum') #cust_bill_pkg/tax_rate key, based on taxtype
 126     || $self->ut_enum('taxtype', [ qw( FS::cust_main_county FS::tax_rate ) ] )
 127     || $self->ut_number('pkgnum', 'cust_pkg', 'pkgnum' )
 128     || $self->ut_foreign_key('locationnum', 'cust_location', 'locationnum' )
 129     || $self->ut_money('amount')
 130     || $self->ut_foreign_key('taxable_billpkgnum', 'cust_bill_pkg', 'billpkgnum')
 131   ;
 132   return $error if $error;
 133
 134   $self->SUPER::check;
 135 }
 136
 137 =item cust_bill_pkg
 138
 139 Returns the associated cust_bill_pkg object (i.e. the tax charge).
 140
 141 =cut
 142
 143 sub cust_bill_pkg {
 144   my $self = shift;
 145   qsearchs( 'cust_bill_pkg', { 'billpkgnum' => $self->billpkgnum }  );
 146 }
 147
 148 =item taxable_cust_bill_pkg
 149
 150 Returns the cust_bill_pkg object for the I<taxable> charge.
 151
 152 =item cust_location
 153
 154 Returns the associated cust_location object
 155
 156 =cut
 157
 158 sub cust_location {
 159   my $self = shift;
 160   qsearchs( 'cust_location', { 'locationnum' => $self->locationnum }  );
 161 }
 162
 163 =item desc
 164
 165 Returns a description for this tax line item constituent.  Currently this
 166 is the desc of the associated line item followed by the state/county/city
 167 for the location in parentheses.
 168
 169 =cut
 170
 171 sub desc {
 172   my $self = shift;
 173   my $cust_location = $self->cust_location;
 174   my $location = join('/', grep { $_ }                 # leave in?
 175                            map { $cust_location->$_ }
 176                            qw( state county city )     # country?
 177   );
 178   my $cust_bill_pkg_desc = $self->billpkgnum
 179                          ? $self->cust_bill_pkg->desc
 180                          : $self->cust_bill_pkg_desc;
 181   "$cust_bill_pkg_desc ($location)";
 182 }
 183
 184 =item owed
 185
 186 Returns the amount owed (still outstanding) on this tax line item which is
 187 the amount of this record minus all payment applications and credit
 188 applications.
 189
 190 =cut
 191
 192 sub owed {
 193   my $self = shift;
 194   my $balance = $self->amount;
 195   $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg('setup') );
 196   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg('setup') );
 197   $balance = sprintf( '%.2f', $balance );
 198   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
 199   $balance;
 200 }
 201
 202 sub cust_bill_pay_pkg {
 203   my $self = shift;
 204   qsearch( 'cust_bill_pay_pkg',
 205            { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) }
 206          );
 207 }
 208
 209 sub cust_credit_bill_pkg {
 210   my $self = shift;
 211   qsearch( 'cust_credit_bill_pkg',
 212            { map { $_ => $self->$_ } qw( billpkgtaxlocationnum billpkgnum ) }
 213          );
 214 }
 215
 216 sub cust_main_county {
 217   my $self = shift;
 218   return '' unless $self->taxtype eq 'FS::cust_main_county';
 219   qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } );
 220 }
 221
 222 sub _upgrade_data {
 223   eval {
 224     use FS::queue;
 225     use Date::Parse 'str2time';
 226   };
 227   my $class = shift;
 228   my $upgrade = 'tax_location_taxable_billpkgnum';
 229   return if FS::upgrade_journal->is_done($upgrade);
 230   my $job = FS::queue->new({ job =>
 231       'FS::cust_bill_pkg_tax_location::upgrade_taxable_billpkgnum'
 232   });
 233   $job->insert($class, 's' => str2time('2012-01-01'));
 234   FS::upgrade_journal->set_done($upgrade);
 235 }
 236
 237 sub upgrade_taxable_billpkgnum {
 238   # Associate these records to the correct taxable line items.
 239   # The cust_bill_pkg upgrade now does this also for pre-3.0 records that
 240   # aren't broken out by pkgnum, so we only need to deal with the case of
 241   # multiple line items for the same pkgnum.
 242   # Despite appearances, this has almost no relation to the upgrade in
 243   # FS::cust_bill_pkg.
 244
 245   my ($class, %opt) = @_;
 246   my $dbh = FS::UID::dbh();
 247   my $oldAutoCommit = $FS::UID::AutoCommit;
 248   local $FS::UID::AutoCommit = 0;
 249   my $log = FS::Log->new('upgrade_taxable_billpkgnum');
 250
 251   my $date_where = '';
 252   if ( $opt{s} ) {
 253     $date_where .= " AND cust_bill._date >= $opt{s}";
 254   }
 255   if ( $opt{e} ) {
 256     $date_where .= " AND cust_bill._date < $opt{e}";
 257   }
 258
 259   my @need_to_upgrade = qsearch({
 260       select => 'cust_bill_pkg_tax_location.*',
 261       table => 'cust_bill_pkg_tax_location',
 262       hashref => { taxable_billpkgnum => '' },
 263       addl_from => 'JOIN cust_bill_pkg USING (billpkgnum)'.
 264                    'JOIN cust_bill     USING (invnum)',
 265       extra_sql => $date_where,
 266   });
 267   $log->info('Starting upgrade of '.scalar(@need_to_upgrade).
 268       ' cust_bill_pkg_tax_location records.');
 269
 270   # keys are billpkgnums
 271   my %cust_bill_pkg;
 272   my %tax_location;
 273   foreach (@need_to_upgrade) {
 274     my $tax_billpkgnum = $_->billpkgnum;
 275     $cust_bill_pkg{ $tax_billpkgnum } ||= FS::cust_bill_pkg->by_key($tax_billpkgnum);
 276     $tax_location{ $tax_billpkgnum } ||= [];
 277     push @{ $tax_location{ $tax_billpkgnum } }, $_;
 278   }
 279
 280   TAX_ITEM: foreach my $tax_item (values %cust_bill_pkg) {
 281     my $tax_locations = $tax_location{ $tax_item->billpkgnum };
 282     my $invnum = $tax_item->invnum;
 283     my $cust_bill = FS::cust_bill->by_key($tax_item->invnum);
 284     my %tax_on_pkg; # keys are tax identifiers
 285     TAX_LOCATION: foreach my $tax_location (@$tax_locations) {
 286     # recapitulate the "cust_main_county $taxnum $pkgnum" tax identifier,
 287     # in a way
 288       my $taxid = join(' ',
 289         $tax_location->taxtype,
 290         $tax_location->taxnum,
 291         $tax_location->pkgnum,
 292         $tax_location->locationnum
 293       );
 294       $tax_on_pkg{$taxid} ||= [];
 295       push @{ $tax_on_pkg{$taxid} }, $tax_location;
 296     }
 297     PKGNUM: foreach my $taxid (keys %tax_on_pkg) {
 298       my ($taxtype, $taxnum, $pkgnum, $locationnum) = split(' ', $taxid);
 299       $log->info("tax#$taxnum, pkg#$pkgnum", object => $cust_bill);
 300       my @pkg_items = $cust_bill->cust_bill_pkg_pkgnum($pkgnum);
 301       if (!@pkg_items) {
 302         # then how is there tax on it? should never happen
 303         $log->error("no line items with pkg#$pkgnum", object => $cust_bill);
 304         next PKGNUM;
 305       }
 306       my $pkg_amount = 0;
 307       foreach my $pkg_item (@pkg_items) {
 308         # find the taxable amount of each one
 309         my $amount = $pkg_item->setup + $pkg_item->recur;
 310         # subtract any exemptions that apply to this taxdef
 311         foreach (qsearch('cust_tax_exempt_pkg', {
 312                   taxnum      => $taxnum,
 313                   billpkgnum  => $pkg_item->billpkgnum
 314                  }) )
 315         {
 316           $amount -= $_->amount;
 317         }
 318         $pkg_item->set('amount' => $pkg_item->setup + $pkg_item->recur);
 319         $pkg_amount += $amount;
 320       } #$pkg_item
 321       next PKGNUM if $pkg_amount == 0; # probably because it's fully exempted
 322       # now sort them descending by taxable amount
 323       @pkg_items = sort { $b->amount <=> $a->amount }
 324                    @pkg_items;
 325       # and do the same with the tax links
 326       # (there should be one per taxed item)
 327       my @tax_links = sort { $b->amount <=> $a->amount }
 328                       @{ $tax_on_pkg{$taxid} };
 329
 330       if (scalar(@tax_links) == scalar(@pkg_items)) {
 331         # the relatively simple case: they match 1:1
 332         for my $i (0 .. scalar(@tax_links) - 1) {
 333           $tax_links[$i]->set('taxable_billpkgnum',
 334                               $pkg_items[$i]->billpkgnum);
 335           my $error = $tax_links[$i]->replace;
 336           if ( $error ) {
 337             $log->error("failed to set taxable_billpkgnum in tax on pkg#$pkgnum",
 338               object => $cust_bill);
 339             next PKGNUM;
 340           }
 341         } #for $i
 342       } else {
 343         # the more complicated case
 344         $log->warning("mismatched charges and tax links in pkg#$pkgnum",
 345           object => $cust_bill);
 346         my $tax_amount = sum(map {$_->amount} @tax_links);
 347         # remove all tax link records and recreate them to be 1:1 with
 348         # taxable items
 349         my (%billpaynum, %creditbillnum);
 350         my $link_type;
 351         foreach my $tax_link (@tax_links) {
 352           $link_type ||= ref($tax_link);
 353           my $error = $tax_link->delete;
 354           if ( $error ) {
 355             $log->error("error unlinking tax#$taxnum pkg#$pkgnum",
 356               object => $cust_bill);
 357             next PKGNUM;
 358           }
 359           my $pkey = $tax_link->primary_key;
 360           # also remove all applications that reference this tax link
 361           # (they will be applications to the tax item)
 362           my %hash = ($pkey => $tax_link->get($pkey));
 363           foreach (qsearch('cust_bill_pay_pkg', \%hash)) {
 364             $billpaynum{$_->billpaynum} += $_->amount;
 365             my $error = $_->delete;
 366             die "error unapplying payment: $error" if ( $error );
 367           }
 368           foreach (qsearch('cust_credit_bill_pkg', \%hash)) {
 369             $creditbillnum{$_->creditbillnum} += $_->amount;
 370             my $error = $_->delete;
 371             die "error unapplying credit: $error" if ( $error );
 372           }
 373         }
 374         @tax_links = ();
 375         my $cents_remaining = int(100 * $tax_amount);
 376         foreach my $pkg_item (@pkg_items) {
 377           my $cents = int(100 * $pkg_item->amount * $tax_amount / $pkg_amount);
 378           my $tax_link = $link_type->new({
 379               taxable_billpkgnum => $pkg_item->billpkgnum,
 380               billpkgnum  => $tax_item->billpkgnum,
 381               taxnum      => $taxnum,
 382               taxtype     => $taxtype,
 383               pkgnum      => $pkgnum,
 384               locationnum => $locationnum,
 385               cents       => $cents,
 386           });
 387           push @tax_links, $tax_link;
 388           $cents_remaining -= $cents;
 389         }
 390         my $nlinks = scalar @tax_links;
 391         my $i = 0;
 392         while ($cents_remaining) {
 393           $tax_links[$i % $nlinks]->set('cents' =>
 394             $tax_links[$i % $nlinks]->cents + 1
 395           );
 396           $cents_remaining--;
 397           $i++;
 398         }
 399         foreach my $tax_link (@tax_links) {
 400           $tax_link->set('amount' => sprintf('%.2f', $tax_link->cents / 100));
 401           my $error = $tax_link->insert;
 402           if ( $error ) {
 403             $log->error("error relinking tax#$taxnum pkg#$pkgnum",
 404               object => $cust_bill);
 405             next PKGNUM;
 406           }
 407         }
 408
 409         $i = 0;
 410         my $error;
 411         my $left = 0; # the amount "left" on the last tax link after
 412                       # applying payments, but before credits, so that
 413                       # it can receive both a payment and a credit if
 414                       # necessary
 415         # reapply payments/credits...this sucks
 416         foreach my $billpaynum (keys %billpaynum) {
 417           my $pay_amount = $billpaynum{$billpaynum};
 418           while ($i < $nlinks and $pay_amount > 0) {
 419             my $this_amount = min($pay_amount, $tax_links[$i]->amount);
 420             $left = $tax_links[$i]->amount - $this_amount;
 421             my $app = FS::cust_bill_pay_pkg->new({
 422                 billpaynum            => $billpaynum,
 423                 billpkgnum            => $tax_links[$i]->billpkgnum,
 424                 billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum,
 425                 amount                => $this_amount,
 426                 setuprecur            => 'setup',
 427                 # sdate/edate are null
 428             });
 429             my $error ||= $app->insert;
 430             $pay_amount -= $this_amount;
 431             $i++ if $left == 0;
 432           }
 433         }
 434         foreach my $creditbillnum (keys %creditbillnum) {
 435           my $credit_amount = $creditbillnum{$creditbillnum};
 436           while ($i < $nlinks and $credit_amount > 0) {
 437             my $this_amount = min($left, $credit_amount, $tax_links[$i]->amount);
 438             $left = $credit_amount * 2; # just so it can't be selected twice
 439             $i++ if    $this_amount == $left
 440                     or $this_amount == $tax_links[$i]->amount;
 441             my $app = FS::cust_credit_bill_pkg->new({
 442                 creditbillnum         => $creditbillnum,
 443                 billpkgnum            => $tax_links[$i]->billpkgnum,
 444                 billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum,
 445                 amount                => $this_amount,
 446                 setuprecur            => 'setup',
 447                 # sdate/edate are null
 448             });
 449             my $error ||= $app->insert;
 450             $credit_amount -= $this_amount;
 451           }
 452         }
 453         if ( $error ) {
 454           # we've just unapplied a bunch of stuff, so if it won't reapply
 455           # we really need to revert the whole transaction
 456           die "error reapplying payments/credits: $error; upgrade halted";
 457         }
 458       } # scalar(@tax_links) ?= scalar(@pkg_items)
 459     } #taxnum/pkgnum
 460   } #TAX_ITEM
 461
 462   $log->info('finish');
 463
 464   $dbh->commit if $oldAutoCommit;
 465   return;
 466 }
 467
 468 =cut
 469
 470 =back
 471
 472 =head1 BUGS
 473
 474 The presence of FS::cust_main_county::delete makes the cust_main_county method
 475 unreliable.
 476
 477 Pre-3.0 versions of Freeside would only create one cust_bill_pkg_tax_location
 478 per tax definition (taxtype/taxnum) per invoice.  The pkgnum and locationnum
 479 fields were arbitrarily set to those of the first line item subject to the
 480 tax.  This created problems if the tax contribution of each line item ever
 481 needed to be determined (for example, when applying credits).  For several
 482 months in 2012, this was changed to create one record per tax definition
 483 per I<package> per invoice, which was still not specific enough to identify
 484 a line item.
 485
 486 The current behavior is to create one record per tax definition per taxable
 487 line item, and to store the billpkgnum of the taxed line item in the record.
 488 The upgrade will try to convert existing records to the new format, but this
 489 is not perfectly reliable.
 490
 491 =head1 SEE ALSO
 492
 493 L<FS::Record>, schema.html from the base documentation.
 494
 495 =cut
 496
 497 1;
 498