package FS::cust_credit;
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
use strict;
-use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Record );
use vars qw( $conf $unsuspendauto $me $DEBUG
$otaker_upgrade_kludge $ignore_empty_reasonnum
);
use FS::Misc qw(send_email);
use FS::Record qw( qsearch qsearchs dbdef );
use FS::CurrentUser;
-use FS::cust_main;
use FS::cust_pkg;
use FS::cust_refund;
use FS::cust_credit_bill;
use FS::agent;
use FS::sales;
use FS::cust_credit_void;
+use FS::upgrade_journal;
$me = '[ FS::cust_credit ]';
$DEBUG = 0;
=cut
sub table { 'cust_credit'; }
-sub cust_linked { $_[0]->cust_main_custnum; }
+sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum }
sub cust_unlinked_msg {
my $self = shift;
"WARNING: can't find cust_main.custnum ". $self->custnum.
Returns the customer (see L<FS::cust_main>) for this credit.
-=cut
-
-sub cust_main {
- my $self = shift;
- qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
-}
-
-
=item reason
Returns the text of the associated reason (see L<FS::reason>) for this credit.
local($ignore_empty_reasonnum) = 1;
$class->_upgrade_otaker(%opts);
+ if ( !FS::upgrade_journal->is_done('cust_credit__tax_link')
+ and !$conf->exists('enable_taxproducts') ) {
+ # RT#25458: fix credit line item applications that should refer to a
+ # specific tax allocation
+ my @cust_credit_bill_pkg = qsearch({
+ table => 'cust_credit_bill_pkg',
+ select => 'cust_credit_bill_pkg.*',
+ addl_from => ' LEFT JOIN cust_bill_pkg USING (billpkgnum)',
+ extra_sql =>
+ 'WHERE cust_credit_bill_pkg.billpkgtaxlocationnum IS NULL '.
+ 'AND cust_bill_pkg.pkgnum = 0', # is a tax
+ });
+ my %tax_items;
+ my %credits;
+ foreach (@cust_credit_bill_pkg) {
+ my $billpkgnum = $_->billpkgnum;
+ $tax_items{$billpkgnum} ||= FS::cust_bill_pkg->by_key($billpkgnum);
+ $credits{$billpkgnum} ||= [];
+ push @{ $credits{$billpkgnum} }, $_;
+ }
+ TAX_ITEM: foreach my $tax_item (values %tax_items) {
+ my $billpkgnum = $tax_item->billpkgnum;
+ # get all pkg/location/taxrate allocations of this tax line item
+ my @allocations = sort {$b->amount <=> $a->amount}
+ qsearch('cust_bill_pkg_tax_location', {
+ billpkgnum => $billpkgnum
+ });
+ # and these are all credit applications to it
+ my @credits = sort {$b->amount <=> $a->amount}
+ @{ $credits{$billpkgnum} };
+ my $c = shift @credits;
+ my $a = shift @allocations; # we will NOT modify these
+ while ($c and $a) {
+ if ( abs($c->amount - $a->amount) < 0.005 ) {
+ # by far the most common case: the tax line item is for a single
+ # tax, so we just fill in the billpkgtaxlocationnum
+ $c->set('billpkgtaxlocationnum', $a->billpkgtaxlocationnum);
+ my $error = $c->replace;
+ if ($error) {
+ warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+ next TAX_ITEM;
+ }
+ $c = shift @credits;
+ $a = shift @allocations;
+ } elsif ( $c->amount > $a->amount ) {
+ # fairly common: the tax line contains tax for multiple packages
+ # (or multiple taxes) but the credit isn't divided up
+ my $new_link = FS::cust_credit_bill_pkg->new({
+ creditbillnum => $c->creditbillnum,
+ billpkgnum => $c->billpkgnum,
+ billpkgtaxlocationnum => $a->billpkgtaxlocationnum,
+ amount => $a->amount,
+ setuprecur => 'setup',
+ });
+ my $error = $new_link->insert;
+ if ($error) {
+ warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+ next TAX_ITEM;
+ }
+ $c->set(amount => sprintf('%.2f', $c->amount - $a->amount));
+ $a = shift @allocations;
+ } elsif ( $c->amount < 0.005 ) {
+ # also fairly common; we can delete these with no harm
+ my $error = $c->delete;
+ warn "error removing zero-amount credit application (probably harmless):\n$error\n" if $error;
+ $c = shift @credits;
+ } elsif ( $c->amount < $a->amount ) {
+ # should never happen, but if it does, handle it gracefully
+ $c->set('billpkgtaxlocationnum', $a->billpkgtaxlocationnum);
+ my $error = $c->replace;
+ if ($error) {
+ warn "error fixing credit application to tax item #$billpkgnum:\n$error\n";
+ next TAX_ITEM;
+ }
+ $a->set(amount => $a->amount - $c->amount);
+ $c = shift @credits;
+ }
+ } # while $c and $a
+ if ( $c ) {
+ if ( $c->amount < 0.005 ) {
+ my $error = $c->delete;
+ warn "error removing zero-amount credit application (probably harmless):\n$error\n" if $error;
+ } elsif ( $c->modified ) {
+ # then we've allocated part of it, so reduce the nonspecific
+ # application by that much
+ my $error = $c->replace;
+ warn "error fixing credit application to tax item #$billpkgnum:\n$error\n" if $error;
+ }
+ # else there are probably no allocations, i.e. this is a pre-3.x
+ # record that was never migrated over, so leave it alone
+ } # if $c
+ } # foreach $tax_item
+ FS::upgrade_journal->set_done('cust_credit__tax_link');
+ }
}
=back
{
# the existing tax_Xlocation object
my $old_loc =
- $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_billpkgnum};
+ $tax_links{$tax_item->billpkgnum}{$new_loc->taxable_cust_bill_pkg->billpkgnum};
next if !$old_loc; # apply the leftover amount nonspecifically
=back
+=head1 SUBROUTINES
+
+=over 4
+
+=item process_batch_import
+
+=cut
+
+use List::Util qw( min );
+use FS::cust_bill;
+use FS::cust_credit_bill;
+sub process_batch_import {
+ my $job = shift;
+
+ my $opt = { 'table' => 'cust_credit',
+ 'params' => [ 'credbatch' ],
+ 'formats' => { 'simple' =>
+ [ 'custnum', 'amount', 'reasonnum', 'invnum' ],
+ },
+ 'default_csv' => 1,
+ 'postinsert_callback' => sub {
+ my $cust_credit = shift; #my ($cust_credit, $param ) = @_;
+
+ if ( $cust_credit->invnum ) {
+
+ my $cust_bill = qsearchs('cust_bill', { invnum=>$cust_credit->invnum } );
+ my $amount = min( $cust_credit->credited, $cust_bill->owed );
+
+ my $cust_credit_bill = new FS::cust_credit_bill ( {
+ 'crednum' => $cust_credit->crednum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_credit_bill->insert;
+ return '' unless $error;
+
+ }
+
+ #apply_payments_and_credits ?
+ $cust_credit->cust_main->apply_credits;
+
+ return '';
+
+ },
+ };
+
+ FS::Record::process_batch_import( $job, $opt, @_ );
+
+}
+
+=back
+
=head1 BUGS
The delete method. The replace method.