- my $arrayref_or_error =
- $cust_main->calculate_taxes(
- $cust_bill_pkg{$invnum}, # list of taxable items that we're crediting
- $taxlisthash{$invnum}, # list of tax-item bindings
- $cust_bill_pkg{$invnum}->[0]->cust_bill->_date, # invoice time
- );
-
- unless ( ref( $arrayref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error calculating taxes: $arrayref_or_error";
- }
-
- my %tax_links; # {tax billpkgnum}{nontax billpkgnum}
-
- #taxes
- foreach my $cust_bill_pkg ( @{ $cust_bill_pkg{$invnum} } ) {
- my $billpkgnum = $cust_bill_pkg->billpkgnum;
- my %hash = ( 'taxable_billpkgnum' => $billpkgnum );
- # gather up existing tax links (we need their billpkgtaxlocationnums)
- my @tax_links = qsearch('cust_bill_pkg_tax_location', \%hash),
- qsearch('cust_bill_pkg_tax_rate_location', \%hash);
-
- foreach ( @tax_links ) {
- $tax_links{$_->billpkgnum} ||= {};
- $tax_links{$_->billpkgnum}{$_->taxable_billpkgnum} = $_;
- }
- }
-
- foreach my $taxline ( @$arrayref_or_error ) {
-
- my $amount = $taxline->setup;
-
- # find equivalent tax line item on the existing invoice
- my $tax_item = qsearchs('cust_bill_pkg', {
- 'invnum' => $invnum,
- 'pkgnum' => 0,
- 'itemdesc' => $taxline->desc,
- });
- if (!$tax_item) {
- # or should we just exit if this happens?
- $cust_credit->set('amount',
- sprintf('%.2f', $cust_credit->get('amount') - $amount)
- );
- my $error = $cust_credit->replace;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error correcting credit for missing tax line: $error";
- }
- }
-
- # but in the new era, we no longer have the problem of uniquely
- # identifying the tax_Xlocation record. The billpkgnums of the
- # tax and the taxed item are known.
- foreach my $new_loc
- ( @{ $taxline->get('cust_bill_pkg_tax_location') },
- @{ $taxline->get('cust_bill_pkg_tax_rate_location') } )
- {
- # the existing tax_Xlocation object
- my $old_loc =
- $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_cust_bill_pkg->billpkgnum};
-
- next if !$old_loc; # apply the leftover amount nonspecifically
-
- #support partial credits: use $amount if smaller
- # (so just distribute to the first location? perhaps should
- # do so evenly...)
- my $loc_amount = min( $amount, $new_loc->amount);
-
- $amount -= $loc_amount;
-
- $cust_credit_bill{$invnum} += $loc_amount;
- push @{ $cust_credit_bill_pkg{$invnum} },
- new FS::cust_credit_bill_pkg {
- 'billpkgnum' => $tax_item->billpkgnum,
- 'amount' => $loc_amount,
- 'setuprecur' => 'setup',
- 'billpkgtaxlocationnum' => $old_loc->billpkgtaxlocationnum,
- 'billpkgtaxratelocationnum' => $old_loc->billpkgtaxratelocationnum,
- };
-
- } #foreach my $new_loc
-
- # we still have to deal with the possibility that the tax links don't
- # cover the whole amount of tax because of an incomplete upgrade...
- if ($amount > 0.005) {
- $cust_credit_bill{$invnum} += $amount;
- push @{ $cust_credit_bill_pkg{$invnum} },
- new FS::cust_credit_bill_pkg {
- 'billpkgnum' => $tax_item->billpkgnum,
- 'amount' => sprintf('%.2f', $amount),
- 'setuprecur' => 'setup',
- };
-
- } # if $amount > 0
-
- #unapply any payments applied to the tax
- foreach my $cust_bill_pay_pkg
- ( $tax_item->cust_bill_pay_pkg('setup') )
- {
- $error = $cust_bill_pay_pkg->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error unapplying payment: $error";
- }
- $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
- += $cust_bill_pay_pkg->amount;
- }
- } #foreach $taxline
-