X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_credit.pm;h=7ae6c97a55b1bbd8f37a5a78a660693ece7624a7;hb=761449917d3d1d7b3a2206785e702246b8b5625e;hp=ba279a26c2d74be3828b2e8d9edec8ea2ec95b75;hpb=c6782ab85ea83e0c78d85b8975985aac9d467f9d;p=freeside.git diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index ba279a26c..7ae6c97a5 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -1,17 +1,16 @@ 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 List::Util qw( min ); use Date::Format; -use FS::UID qw( dbh getotaker ); +use FS::UID qw( dbh ); 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; @@ -19,6 +18,10 @@ use FS::part_pkg; use FS::reason_type; use FS::reason; use FS::cust_event; +use FS::agent; +use FS::sales; +use FS::cust_credit_void; +use FS::upgrade_journal; $me = '[ FS::cust_credit ]'; $DEBUG = 0; @@ -120,7 +123,7 @@ Creates a new credit. To add the credit to the database, see L<"insert">. =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. @@ -201,6 +204,8 @@ the void method instead to leave a record of the deleted credit. # very similar to FS::cust_pay::delete sub delete { my $self = shift; + my %opt = @_; + return "Can't delete closed credit" if $self->closed =~ /^Y/i; local $SIG{HUP} = 'IGNORE'; @@ -236,7 +241,7 @@ sub delete { return $error; } - if ( $conf->config('deletecredits') ne '' ) { + if ( !$opt{void} and $conf->config('deletecredits') ne '' ) { my $cust_main = $self->cust_main; @@ -311,6 +316,9 @@ sub check { || $self->ut_enum('closed', [ '', 'Y' ]) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum') + || $self->ut_foreign_keyn('commission_agentnum', 'agent', 'agentnum') + || $self->ut_foreign_keyn('commission_salesnum', 'sales', 'salesnum') + || $self->ut_foreign_keyn('commission_pkgnum', 'cust_pkg', 'pkgnum') ; return $error if $error; @@ -331,6 +339,53 @@ sub check { $self->SUPER::check; } +=item void [ REASON ] + +Voids this credit: deletes the credit and all associated applications and +adds a record of the voided credit to the cust_credit_void table. + +=cut + +# yes, false laziness with cust_pay and cust_bill +# but frankly I don't have time to fix it now + +sub void { + my $self = shift; + my $reason = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $cust_credit_void = new FS::cust_credit_void ( { + map { $_ => $self->get($_) } $self->fields + } ); + $cust_credit_void->set('void_reason', $reason); + my $error = $cust_credit_void->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $error = $self->delete(void => 1); # suppress deletecredits warning + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item cust_credit_refund Returns all refund applications (see L) for this credit. @@ -392,14 +447,6 @@ sub credited { Returns the customer (see L) 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) for this credit. @@ -565,6 +612,100 @@ sub _upgrade_data { # class method 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 @@ -847,7 +988,7 @@ sub credit_lineitems { { # 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 @@ -962,6 +1103,58 @@ sub credit_lineitems { =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' => [ '_date', '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.