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