X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pay.pm;h=424fab01137e702b0d73b1816457c1bf265d9b8e;hb=f3738a9fcd588d32eea9b0af6a3e884293c0c6e5;hp=7952e6418c30e3b477a590a8fcc6a3da30c9e239;hpb=e80770898cc86365b335845dd1a02b4d82bd7e40;p=freeside.git diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 7952e6418..424fab011 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -833,6 +833,102 @@ sub amount { $self->paid(); } +=item delete_cust_bill_pay OPTIONS + +Deletes all associated cust_bill_pay records. + +If option 'unapplied' is a specified, only deletes until +this object's 'unapplied' value is >= the specified amount. +(Deletes in order returned by L.) + +=cut + +sub delete_cust_bill_pay { + my $self = shift; + my %opt = @_; + + 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 $unapplied = $self->unapplied; #only need to look it up once + + my $error = ''; + + # Maybe we should reverse the order these get deleted in? + # ie delete newest first? + # keeping consistent with how bop refunds work, for now... + foreach my $cust_bill_pay ( $self->cust_bill_pay ) { + last if $opt{'unapplied'} && ($unapplied > $opt{'unapplied'}); + $unapplied += $cust_bill_pay->amount; + $error = $cust_bill_pay->delete; + last if $error; + } + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; +} + +=item refund HASHREF + +Accepts input for creating a new FS::cust_refund object. +Unapplies payment from invoices up to the amount of the refund, +creates the refund and applies payment to refund. Allows entire +process to be handled in one transaction. + +Causes a fatal error if called on CARD or CHEK payments. + +=cut + +sub refund { + my $self = shift; + my $hash = shift; + die "Cannot call cust_pay->refund on " . $self->payby + if grep { $_ eq $self->payby } qw(CARD CHEK); + + 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 $error = $self->delete_cust_bill_pay('amount' => $hash->{'amount'}); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $hash->{'paynum'} = $self->paynum; + my $new = new FS::cust_refund ( $hash ); + $error = $new->insert; + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; +} + =back =head1 CLASS METHODS @@ -1235,23 +1331,26 @@ sub process_batch_import { return %hash; }; - my $opt = { 'table' => 'cust_pay', - 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ], - #agent_custid isn't a cust_pay field, see hash callback - 'formats' => { 'simple' => [ qw(custnum agent_custid paid payinfo invnum) ] }, - 'format_types' => { 'simple' => '' }, #force infer from file extension - 'default_csv' => 1, #if it's not .xls, it'll read as csv, regardless of extension - 'format_hash_callbacks' => { 'simple' => $hashcb }, - 'postinsert_callback' => sub { - my $cust_pay = shift; - my $cust_main = $cust_pay->cust_main || - return "can't find customer to which payments apply"; - my $error = $cust_main->apply_payments_and_credits; - return $error - ? "can't apply payments to customer ".$cust_pay->custnum."$error" - : ''; - }, - }; + my $opt = { + 'table' => 'cust_pay', + 'params' => [ '_date', 'agentnum', 'payby', 'paybatch' ], + #agent_custid isn't a cust_pay field, see hash callback + 'formats' => { 'simple' => + [ qw(custnum agent_custid paid payinfo invnum) ] }, + 'format_types' => { 'simple' => '' }, #force infer from file extension + 'default_csv' => 1, #if not .xls, will read as csv, regardless of extension + 'format_hash_callbacks' => { 'simple' => $hashcb }, + 'insert_args_callback' => sub { ( 'manual'=>1 ); }, + 'postinsert_callback' => sub { + my $cust_pay = shift; + my $cust_main = $cust_pay->cust_main + or return "can't find customer to which payments apply"; + my $error = $cust_main->apply_payments_and_credits; + return $error + ? "can't apply payments to customer ".$cust_pay->custnum."$error" + : ''; + }, + }; FS::Record::process_batch_import( $job, $opt, @_ );