71513: Card tokenization [v3 backport]
[freeside.git] / FS / FS / cust_pay.pm
index b402ed3..eed735a 100644 (file)
@@ -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<FS::payinfo_Mixin> for valid values)
 
 Payment Information (See L<FS::payinfo_Mixin> for data format)
 
+=item paycardtype
+
+Credit card type, if appropriate; autodetected.
+
 =item paymask
 
 Masked payinfo (See L<FS::payinfo_Mixin> 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</cust_bill_pay>.)
+
+=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<FS::cust_pay_refund> objects that will be deleted by L</unapply_refund>
+(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</refund_to_unapply>.
+
+=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"
                : '';