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_foreign_key('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   my $result;
 219   if ( $self->taxtype eq 'FS::cust_main_county' ) {
 220     $result = qsearchs( 'cust_main_county', { 'taxnum' => $self->taxnum } );
 221   }
 222 }
 223
 224 sub _upgrade_data {
 225   eval {
 226     use FS::queue;
 227     use Date::Parse 'str2time';
 228   };
 229   my $class = shift;
 230   my $upgrade = 'tax_location_taxable_billpkgnum';
 231   return if FS::upgrade_journal->is_done($upgrade);
 232   my $job = FS::queue->new({ job =>
 233       'FS::cust_bill_pkg_tax_location::upgrade_taxable_billpkgnum'
 234   });
 235   $job->insert($class, 's' => str2time('2012-01-01'));
 236   FS::upgrade_journal->set_done($upgrade);
 237 }
 238
 239 sub upgrade_taxable_billpkgnum {
 240   # Associate these records to the correct taxable line items.
 241   # The cust_bill_pkg upgrade now does this also for pre-3.0 records that
 242   # aren't broken out by pkgnum, so we only need to deal with the case of
 243   # multiple line items for the same pkgnum.
 244   # Despite appearances, this has almost no relation to the upgrade in
 245   # FS::cust_bill_pkg.
 246
 247   my ($class, %opt) = @_;
 248   my $dbh = FS::UID::dbh();
 249   my $oldAutoCommit = $FS::UID::AutoCommit;
 250   local $FS::UID::AutoCommit = 0;
 251   my $log = FS::Log->new('upgrade_taxable_billpkgnum');
 252
 253   my $date_where = '';
 254   if ( $opt{s} ) {
 255     $date_where .= " AND cust_bill._date >= $opt{s}";
 256   }
 257   if ( $opt{e} ) {
 258     $date_where .= " AND cust_bill._date < $opt{e}";
 259   }
 260
 261   my @need_to_upgrade = qsearch({
 262       select => 'cust_bill_pkg_tax_location.*',
 263       table => 'cust_bill_pkg_tax_location',
 264       hashref => { taxable_billpkgnum => '' },
 265       addl_from => 'JOIN cust_bill_pkg USING (billpkgnum)'.
 266                    'JOIN cust_bill     USING (invnum)',
 267       extra_sql => $date_where,
 268   });
 269   $log->info('Starting upgrade of '.scalar(@need_to_upgrade).
 270       ' cust_bill_pkg_tax_location records.');
 271
 272   # keys are billpkgnums
 273   my %cust_bill_pkg;
 274   my %tax_location;
 275   foreach (@need_to_upgrade) {
 276     my $tax_billpkgnum = $_->billpkgnum;
 277     $cust_bill_pkg{ $tax_billpkgnum } ||= FS::cust_bill_pkg->by_key($tax_billpkgnum);
 278     $tax_location{ $tax_billpkgnum } ||= [];
 279     push @{ $tax_location{ $tax_billpkgnum } }, $_;
 280   }
 281
 282   TAX_ITEM: foreach my $tax_item (values %cust_bill_pkg) {
 283     my $tax_locations = $tax_location{ $tax_item->billpkgnum };
 284     my $invnum = $tax_item->invnum;
 285     my $cust_bill = FS::cust_bill->by_key($tax_item->invnum);
 286     my %tax_on_pkg; # keys are tax identifiers
 287     TAX_LOCATION: foreach my $tax_location (@$tax_locations) {
 288     # recapitulate the "cust_main_county $taxnum $pkgnum" tax identifier,
 289     # in a way
 290       my $taxid = join(' ',
 291         $tax_location->taxtype,
 292         $tax_location->taxnum,
 293         $tax_location->pkgnum,
 294         $tax_location->locationnum
 295       );
 296       $tax_on_pkg{$taxid} ||= [];
 297       push @{ $tax_on_pkg{$taxid} }, $tax_location;
 298     }
 299     PKGNUM: foreach my $taxid (keys %tax_on_pkg) {
 300       my ($taxtype, $taxnum, $pkgnum, $locationnum) = split(' ', $taxid);
 301       $log->info("tax#$taxnum, pkg#$pkgnum", object => $cust_bill);
 302       my @pkg_items = $cust_bill->cust_bill_pkg_pkgnum($pkgnum);
 303       if (!@pkg_items) {
 304         # then how is there tax on it? should never happen
 305         $log->error("no line items with pkg#$pkgnum", object => $cust_bill);
 306         next PKGNUM;
 307       }
 308       my $pkg_amount = 0;
 309       foreach my $pkg_item (@pkg_items) {
 310         # find the taxable amount of each one
 311         my $amount = $pkg_item->setup + $pkg_item->recur;
 312         # subtract any exemptions that apply to this taxdef
 313         foreach (qsearch('cust_tax_exempt_pkg', {
 314                   taxnum      => $taxnum,
 315                   billpkgnum  => $pkg_item->billpkgnum
 316                  }) )
 317         {
 318           $amount -= $_->amount;
 319         }
 320         $pkg_item->set('amount' => $pkg_item->setup + $pkg_item->recur);
 321         $pkg_amount += $amount;
 322       } #$pkg_item
 323       next PKGNUM if $pkg_amount == 0; # probably because it's fully exempted
 324       # now sort them descending by taxable amount
 325       @pkg_items = sort { $b->amount <=> $a->amount }
 326                    @pkg_items;
 327       # and do the same with the tax links
 328       # (there should be one per taxed item)
 329       my @tax_links = sort { $b->amount <=> $a->amount }
 330                       @{ $tax_on_pkg{$taxid} };
 331
 332       if (scalar(@tax_links) == scalar(@pkg_items)) {
 333         # the relatively simple case: they match 1:1
 334         for my $i (0 .. scalar(@tax_links) - 1) {
 335           $tax_links[$i]->set('taxable_billpkgnum',
 336                               $pkg_items[$i]->billpkgnum);
 337           my $error = $tax_links[$i]->replace;
 338           if ( $error ) {
 339             $log->error("failed to set taxable_billpkgnum in tax on pkg#$pkgnum",
 340               object => $cust_bill);
 341             next PKGNUM;
 342           }
 343         } #for $i
 344       } else {
 345         # the more complicated case
 346         $log->warn("mismatched charges and tax links in pkg#$pkgnum",
 347           object => $cust_bill);
 348         my $tax_amount = sum(map {$_->amount} @tax_links);
 349         # remove all tax link records and recreate them to be 1:1 with
 350         # taxable items
 351         my (%billpaynum, %creditbillnum);
 352         my $link_type;
 353         foreach my $tax_link (@tax_links) {
 354           $link_type ||= ref($tax_link);
 355           my $error = $tax_link->delete;
 356           if ( $error ) {
 357             $log->error("error unlinking tax#$taxnum pkg#$pkgnum",
 358               object => $cust_bill);
 359             next PKGNUM;
 360           }
 361           my $pkey = $tax_link->primary_key;
 362           # also remove all applications that reference this tax link
 363           # (they will be applications to the tax item)
 364           my %hash = ($pkey => $tax_link->get($pkey));
 365           foreach (qsearch('cust_bill_pay_pkg', \%hash)) {
 366             $billpaynum{$_->billpaynum} += $_->amount;
 367             my $error = $_->delete;
 368             die "error unapplying payment: $error" if ( $error );
 369           }
 370           foreach (qsearch('cust_credit_bill_pkg', \%hash)) {
 371             $creditbillnum{$_->creditbillnum} += $_->amount;
 372             my $error = $_->delete;
 373             die "error unapplying credit: $error" if ( $error );
 374           }
 375         }
 376         @tax_links = ();
 377         my $cents_remaining = int(100 * $tax_amount);
 378         foreach my $pkg_item (@pkg_items) {
 379           my $cents = int(100 * $pkg_item->amount * $tax_amount / $pkg_amount);
 380           my $tax_link = $link_type->new({
 381               taxable_billpkgnum => $pkg_item->billpkgnum,
 382               billpkgnum  => $tax_item->billpkgnum,
 383               taxnum      => $taxnum,
 384               taxtype     => $taxtype,
 385               pkgnum      => $pkgnum,
 386               locationnum => $locationnum,
 387               cents       => $cents,
 388           });
 389           push @tax_links, $tax_link;
 390           $cents_remaining -= $cents;
 391         }
 392         my $nlinks = scalar @tax_links;
 393         my $i = 0;
 394         while ($cents_remaining) {
 395           $tax_links[$i % $nlinks]->set('cents' =>
 396             $tax_links[$i % $nlinks]->cents + 1
 397           );
 398           $cents_remaining--;
 399           $i++;
 400         }
 401         foreach my $tax_link (@tax_links) {
 402           $tax_link->set('amount' => sprintf('%.2f', $tax_link->cents / 100));
 403           my $error = $tax_link->insert;
 404           if ( $error ) {
 405             $log->error("error relinking tax#$taxnum pkg#$pkgnum",
 406               object => $cust_bill);
 407             next PKGNUM;
 408           }
 409         }
 410
 411         $i = 0;
 412         my $error;
 413         my $left = 0; # the amount "left" on the last tax link after
 414                       # applying payments, but before credits, so that
 415                       # it can receive both a payment and a credit if
 416                       # necessary
 417         # reapply payments/credits...this sucks
 418         foreach my $billpaynum (keys %billpaynum) {
 419           my $pay_amount = $billpaynum{$billpaynum};
 420           while ($i < $nlinks and $pay_amount > 0) {
 421             my $this_amount = min($pay_amount, $tax_links[$i]->amount);
 422             $left = $tax_links[$i]->amount - $this_amount;
 423             my $app = FS::cust_bill_pay_pkg->new({
 424                 billpaynum            => $billpaynum,
 425                 billpkgnum            => $tax_links[$i]->billpkgnum,
 426                 billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum,
 427                 amount                => $this_amount,
 428                 setuprecur            => 'setup',
 429                 # sdate/edate are null
 430             });
 431             my $error ||= $app->insert;
 432             $pay_amount -= $this_amount;
 433             $i++ if $left == 0;
 434           }
 435         }
 436         foreach my $creditbillnum (keys %creditbillnum) {
 437           my $credit_amount = $creditbillnum{$creditbillnum};
 438           while ($i < $nlinks and $credit_amount > 0) {
 439             my $this_amount = min($left, $credit_amount, $tax_links[$i]->amount);
 440             $left = $credit_amount * 2; # just so it can't be selected twice
 441             $i++ if    $this_amount == $left
 442                     or $this_amount == $tax_links[$i]->amount;
 443             my $app = FS::cust_credit_bill_pkg->new({
 444                 creditbillnum         => $creditbillnum,
 445                 billpkgnum            => $tax_links[$i]->billpkgnum,
 446                 billpkgtaxlocationnum => $tax_links[$i]->billpkgtaxlocationnum,
 447                 amount                => $this_amount,
 448                 setuprecur            => 'setup',
 449                 # sdate/edate are null
 450             });
 451             my $error ||= $app->insert;
 452             $credit_amount -= $this_amount;
 453           }
 454         }
 455         if ( $error ) {
 456           # we've just unapplied a bunch of stuff, so if it won't reapply
 457           # we really need to revert the whole transaction
 458           die "error reapplying payments/credits: $error; upgrade halted";
 459         }
 460       } # scalar(@tax_links) ?= scalar(@pkg_items)
 461     } #taxnum/pkgnum
 462   } #TAX_ITEM
 463
 464   $log->info('finish');
 465
 466   $dbh->commit if $oldAutoCommit;
 467   return;
 468 }
 469
 470 =cut
 471
 472 =back
 473
 474 =head1 BUGS
 475
 476 The presence of FS::cust_main_county::delete makes the cust_main_county method
 477 unreliable.
 478
 479 Pre-3.0 versions of Freeside would only create one cust_bill_pkg_tax_location
 480 per tax definition (taxtype/taxnum) per invoice.  The pkgnum and locationnum
 481 fields were arbitrarily set to those of the first line item subject to the
 482 tax.  This created problems if the tax contribution of each line item ever
 483 needed to be determined (for example, when applying credits).  For several
 484 months in 2012, this was changed to create one record per tax definition
 485 per I<package> per invoice, which was still not specific enough to identify
 486 a line item.
 487
 488 The current behavior is to create one record per tax definition per taxable
 489 line item, and to store the billpkgnum of the taxed line item in the record.
 490 The upgrade will try to convert existing records to the new format, but this
 491 is not perfectly reliable.
 492
 493 =head1 SEE ALSO
 494
 495 L<FS::Record>, schema.html from the base documentation.
 496
 497 =cut
 498
 499 1;
 500