X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pay.pm;h=eed735a9fcbccf39ffe59537b5bf90d78a6a6f67;hb=e208512d4fef58a7dadf6a46e10bed24f5d777cb;hp=b402ed373830091dacab86f2f31a86d8d32e7705;hpb=b641542f7838a68612cd34b6a32284241f116c2f;p=freeside.git diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index b402ed373..eed735a9f 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -4,7 +4,7 @@ use strict; use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin FS::Record ); use vars qw( $DEBUG $me $conf @encrypted_fields - $unsuspendauto $ignore_noapply + $ignore_noapply ); use Date::Format; use Business::CreditCard; @@ -35,7 +35,6 @@ $ignore_noapply = 0; #ask FS::UID to run this stuff for us later FS::UID->install_callback( sub { $conf = new FS::Conf; - $unsuspendauto = $conf->exists('unsuspendauto'); } ); @encrypted_fields = ('payinfo'); @@ -97,6 +96,10 @@ Payment Type (See L for valid values) Payment Information (See L for data format) +=item paycardtype + +Credit card type, if appropriate; autodetected. + =item paymask Masked payinfo (See L for how this works) @@ -341,16 +344,8 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert - if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { - my @errors = $cust_main->unsuspend; - #return - # side-fx with nested transactions? upstack rolls back? - warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ". - join(' / ', @errors) - if @errors; - } - #eslaf + # possibly trigger package unsuspend, doesn't abort transaction on failure + $self->unsuspend_balance if $old_balance; #bill setup fees for voip_cdr bill_every_call packages #some false laziness w/search in freeside-cdrd @@ -396,6 +391,22 @@ sub insert { warn "can't send payment receipt/statement: $error" if $error; } + #run payment events immediately + my $due_cust_event = $self->cust_main->due_cust_event( + 'eventtable' => 'cust_pay', + 'objects' => [ $self ], + ); + if ( !ref($due_cust_event) ) { + warn "Error searching for cust_pay billing events: $due_cust_event\n"; + } else { + foreach my $cust_event (@$due_cust_event) { + next unless $cust_event->test_conditions; + if ( my $error = $cust_event->do_event() ) { + warn "Error running cust_pay billing event: $error\n"; + } + } + } + ''; } @@ -537,7 +548,8 @@ otherwise returns false. sub replace { my $self = shift; - return "Can't modify closed payment" if $self->closed =~ /^Y/i; + return "Can't modify closed payment" + if $self->closed =~ /^Y/i && !$FS::payinfo_Mixin::allow_closed_replace; $self->SUPER::replace(@_); } @@ -833,6 +845,154 @@ 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 ''; +} + +### refund_to_unapply/unapply_refund false laziness with FS::cust_credit + +=item refund_to_unapply + +Returns L objects that will be deleted by L +(all currently applied refunds that aren't closed.) +Returns empty list if payment itself is closed. + +=cut + +sub refund_to_unapply { + my $self = shift; + return () if $self->closed; + qsearch({ + 'table' => 'cust_pay_refund', + 'hashref' => { 'paynum' => $self->paynum }, + 'addl_from' => 'LEFT JOIN cust_refund USING (refundnum)', + 'extra_sql' => "AND cust_refund.closed IS NULL AND cust_refund.source_paynum IS NULL", + }); +} + +=item unapply_refund + +Deletes all objects returned by L. + +=cut + +sub unapply_refund { + my $self = 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; + + foreach my $cust_pay_refund ($self->refund_to_unapply) { + my $error = $cust_pay_refund->delete; + if ($error) { + dbh->rollback if $oldAutoCommit; + return $error; + } + } + + dbh->commit or die dbh->errstr if $oldAutoCommit; + return ''; +} + =back =head1 CLASS METHODS @@ -901,7 +1061,7 @@ sub batch_insert { } } elsif ( !$error ) { #normal case: apply payments as usual - $cust_pay->cust_main->apply_payments; + $cust_pay->cust_main->apply_payments( 'manual'=>1 ); } } @@ -920,7 +1080,7 @@ sub batch_insert { Returns an SQL fragment to retreive the unapplied amount. -=cut +=cut sub unapplied_sql { my ($class, $start, $end) = @_; @@ -1087,6 +1247,12 @@ sub _upgrade_data { #class method process_upgrade_paybatch(); } } + + ### + # don't set paycardtype until 4.x + ### + #$class->upgrade_set_cardtype; + } sub process_upgrade_paybatch { @@ -1244,12 +1410,12 @@ sub process_batch_import { '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 ) }, + '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; + my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 ); return $error ? "can't apply payments to customer ".$cust_pay->custnum."$error" : '';