X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=fbd461841192e4d1b189555458da4cdf0da3be77;hp=a9fcb2b6610f43867393ab32cf9e671b778657e7;hb=e975ed0585280f4cbb90b02f57114dedc43f58be;hpb=c65b166b6e2ebdac5c2eb2e8336ebd1a4087f77c

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index a9fcb2b66..fbd461841 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -895,7 +895,7 @@ sub check {
     my( $m, $y );
     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
-    } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{2})[\/\-]\d+$/ ) {
+    } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
       ( $m, $y ) = ( $3, "20$2" );
     } else {
       return "Illegal expiration date: ". $self->paydate;
@@ -1028,6 +1028,38 @@ sub suspend {
   grep { $_->suspend } $self->unsuspended_pkgs;
 }
 
+=item suspend_if_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list on
+success or a list of errors.
+
+=cut
+
+sub suspend_if_pkgpart {
+  my $self = shift;
+  my @pkgparts = @_;
+  grep { $_->suspend }
+    grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
+      $self->unsuspended_pkgs;
+}
+
+=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ]
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
+listed PKGPARTs (see L<FS::part_pkg>).  Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub suspend_unless_pkgpart {
+  my $self = shift;
+  my @pkgparts = @_;
+  grep { $_->suspend }
+    grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
+      $self->unsuspended_pkgs;
+}
+
 =item cancel [ OPTION => VALUE ... ]
 
 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
@@ -1098,6 +1130,8 @@ sub bill {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  $self->select_for_update; #mutex
+
   # find the packages which are due for billing, find out how much they are
   # & generate invoice database.
  
@@ -1499,6 +1533,8 @@ sub collect {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
+  $self->select_for_update; #mutex
+
   my $balance = $self->balance;
   warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG;
   unless ( $balance > 0 ) { #redundant?????
@@ -1533,7 +1569,7 @@ sub collect {
              || $a->weight    <=> $b->weight
              || $a->eventpart <=> $b->eventpart }
         grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
-               && ! qsearchs( 'cust_bill_event', {
+               && ! qsearch( 'cust_bill_event', {
                                 'invnum'    => $cust_bill->invnum,
                                 'eventpart' => $_->eventpart,
                                 'status'    => 'done',
@@ -1701,7 +1737,7 @@ sub realtime_bop {
   #overrides
   $self->set( $_ => $options{$_} )
     foreach grep { exists($options{$_}) }
-            qw( payname address1 address2 city state zip payinfo paydate );
+            qw( payname address1 address2 city state zip payinfo paydate paycvv);
 
   #load up config
   my $bop_config = 'business-onlinepayment';
@@ -1711,6 +1747,9 @@ sub realtime_bop {
     $conf->config($bop_config);
   $action ||= 'normal authorization';
   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
+  die "No real-time processor is enabled - ".
+      "did you set the business-onlinepayment configuration value?\n"
+    unless $processor;
 
   #massage data
 
@@ -1837,11 +1876,12 @@ sub realtime_bop {
   }
 
   #remove paycvv after initial transaction
-  #make this disable-able via a config option if anyone insists?  
-  # (though that probably violates cardholder agreements)
+  #false laziness w/misc/process/payment.cgi - check both to make sure working
+  # correctly
   if ( defined $self->dbdef_table->column('paycvv')
        && length($self->paycvv)
        && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
+       && ! length($options{'paycvv'})
   ) {
     my $new = new FS::cust_main { $self->hash };
     $new->paycvv('');
@@ -1871,15 +1911,19 @@ sub realtime_bop {
     } );
     my $error = $cust_pay->insert;
     if ( $error ) {
-      # gah, even with transactions.
-      my $e = 'WARNING: Card/ACH debited but database not updated - '.
-              'error applying payment, invnum #' . $self->invnum.
-              " ($processor): $error";
-      warn $e;
-      return $e;
-    } else {
-      return '';
+      $cust_pay->invnum(''); #try again with no specific invnum
+      my $error2 = $cust_pay->insert;
+      if ( $error2 ) {
+        # gah, even with transactions.
+        my $e = 'WARNING: Card/ACH debited but database not updated - '.
+                "error inserting payment ($processor): $error2".
+                " (previously tried insert with invnum #$options{'invnum'}" .
+                ": $error )";
+        warn $e;
+        return $e;
+      }
     }
+    return ''; #no error
 
   } else {
 
@@ -1888,7 +1932,7 @@ sub realtime_bop {
     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
          && $conf->exists('emaildecline')
          && grep { $_ ne 'POST' } $self->invoicing_list
-         && ! grep { $_ eq $transaction->error_message }
+         && ! grep { $transaction->error_message =~ /$_/ }
                    $conf->config('emaildecline-exclude')
     ) {
       my @templ = $conf->config('declinetemplate');
@@ -2121,6 +2165,37 @@ sub balance_date {
   );
 }
 
+=item paydate_monthyear
+
+Returns a two-element list consisting of the month and year of this customer's
+paydate (credit card expiration date for CARD customers)
+
+=cut
+
+sub paydate_monthyear {
+  my $self = shift;
+  if ( $self->paydate  =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format
+    ( $2, $1 );
+  } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
+    ( $1, $3 );
+  } else {
+    ('', '');
+  }
+}
+
+=item payinfo_masked
+
+Returns a "masked" payinfo field with all but the last four characters replaced
+by 'x'es.  Useful for displaying credit cards.
+
+=cut
+
+sub payinfo_masked {
+  my $self = shift;
+  my $payinfo = $self->payinfo;
+  'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
+}
+
 =item invoicing_list [ ARRAYREF ]
 
 If an arguement is given, sets these email addresses as invoice recipients
@@ -2451,6 +2526,18 @@ sub cust_refund {
     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
 }
 
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command.  This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+  my $self = shift;
+  qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' );
+}
+
 =back
 
 =head1 SUBROUTINES
@@ -2641,7 +2728,7 @@ sub batch_import {
     my %cust_main = (
       agentnum => $agentnum,
       refnum   => $refnum,
-      country  => 'US', #default
+      country  => $conf->config('countrydefault') || 'US',
       payby    => 'BILL', #default
       paydate  => '12/2037', #default
     );
@@ -2802,6 +2889,8 @@ card types.
 
 No multiple currency support (probably a larger project than just this module).
 
+payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
+
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>