store credit card type in cust_payby and transaction records, #71291, schema support

7 files changed, 99 insertions, 9 deletions

diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 748df8b1b..60593ad96 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2459,6 +2459,7 @@ sub tables_hashref {
         'usernum',         'int', 'NULL',      '', '', '',
         'payby',          'char',     '',       4, '', '',
         'payinfo',     'varchar', 'NULL',     512, '', '',
+        'cardtype',    'varchar', 'NULL',   $char_d, '', '',
         'paymask',     'varchar', 'NULL', $char_d, '', '', 
         'paydate',     'varchar', 'NULL',      10, '', '', 
         'paybatch',    'varchar', 'NULL', $char_d, '', '',#for auditing purposes
@@ -2516,7 +2517,8 @@ sub tables_hashref {
         'usernum',         'int', 'NULL',      '', '', '',
         'payby',          'char',     '',       4, '', '',
         'payinfo',     'varchar', 'NULL',     512, '', '',
-	'paymask',     'varchar', 'NULL', $char_d, '', '', 
+        'cardtype',    'varchar', 'NULL',   $char_d, '', '',
+        'paymask',     'varchar', 'NULL', $char_d, '', '', 
         #'paydate' ?
         'paybatch',    'varchar', 'NULL', $char_d, '', '', #for auditing purposes.
         'closed',        'char',  'NULL',       1, '', '', 
@@ -3076,7 +3078,8 @@ sub tables_hashref {
                                                      # be index into payby
                                                      # table eventually
         'payinfo',      'varchar',   'NULL', 512, '', '', #see cust_main above
-	'paymask', 'varchar', 'NULL', $char_d, '', '', 
+        'cardtype',    'varchar', 'NULL',   $char_d, '', '',
+        'paymask', 'varchar', 'NULL', $char_d, '', '', 
         'paybatch',     'varchar',   'NULL', $char_d, '', '', 
         'closed',    'char', 'NULL', 1, '', '', 
         'source_paynum', 'int', 'NULL', '', '', '', # link to cust_payby, to prevent unapply of gateway-generated refunds
diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm
index 3ff943fcf..f93c545fe 100644
--- a/FS/FS/Upgrade.pm
+++ b/FS/FS/Upgrade.pm
@@ -428,6 +428,9 @@ sub upgrade_data {
     'cust_refund' => [],
     'banned_pay' => [],
 
+    #cardtype
+    'cust_payby' => [],
+
     #default namespace
     'payment_gateway' => [],
 
diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
index 331a15623..8e87745ea 100644
--- a/FS/FS/cust_pay.pm
+++ b/FS/FS/cust_pay.pm
@@ -97,6 +97,10 @@ Payment Type (See L<FS::payinfo_Mixin> for valid values)
 
 Payment Information (See L<FS::payinfo_Mixin> for data format)
 
+=item cardtype
+
+Credit card type, if appropriate; autodetected.
+
 =item paymask
 
 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
@@ -1205,6 +1209,12 @@ sub _upgrade_data {  #class method
       process_upgrade_paybatch();
     }
   }
+
+  ###
+  # set cardtype
+  ###
+  $class->upgrade_set_cardtype;
+
 }
 
 sub process_upgrade_paybatch {
diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm
index 8d37a58b5..29540d1c6 100644
--- a/FS/FS/cust_pay_void.pm
+++ b/FS/FS/cust_pay_void.pm
@@ -74,6 +74,10 @@ Payment Type (See L<FS::payinfo_Mixin> for valid values)
 
 card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
 
+=item cardtype
+
+Credit card type, if appropriate.
+
 =item paybatch
 
 text field for tracking card processing
diff --git a/FS/FS/cust_payby.pm b/FS/FS/cust_payby.pm
index 62fa9be5f..993bab55d 100644
--- a/FS/FS/cust_payby.pm
+++ b/FS/FS/cust_payby.pm
@@ -115,6 +115,9 @@ paytype
 
 payip
 
+=item cardtype
+
+The credit card type (deduced from the card number).
 
 =back
 
@@ -331,6 +334,13 @@ sub check {
   # Need some kind of global flag to accept invalid cards, for testing
   # on scrubbed data.
   #XXX if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
+
+  # In this block: detect card type; reject credit card / account numbers that
+  # are impossible or banned; reject other payment features (date, CVV length)
+  # that are inappropriate for the card type.
+  # However, if the payinfo is encrypted then just detect card type and assume
+  # the other checks were already done.
+
   if ( !$ignore_invalid_card && 
     $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
 
@@ -343,9 +353,11 @@ sub check {
     validate($payinfo)
       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 
+    my $cardtype = cardtype($payinfo);
+    $self->set('cardtype', $cardtype);
     return gettext('unknown_card_type')
       if $self->payinfo !~ /^99\d{14}$/ #token
-      && cardtype($self->payinfo) eq "Unknown";
+      && $cardtype eq "Unknown";
 
     unless ( $ignore_banned_card ) {
       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
@@ -367,7 +379,7 @@ sub check {
     }
 
     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
-      if ( cardtype($self->payinfo) eq 'American Express card' ) {
+      if ( $cardtype eq 'American Express card' ) {
         $self->paycvv =~ /^(\d{4})$/
           or return "CVV2 (CID) for American Express cards is four digits.";
         $self->paycvv($1);
@@ -380,7 +392,6 @@ sub check {
       $self->paycvv('');
     }
 
-    my $cardtype = cardtype($payinfo);
     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
 
       return "Start date or issue number is required for $cardtype cards"
@@ -438,6 +449,15 @@ sub check {
       }
     }
 
+  } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) {
+    # either ignoring invalid cards, or we can't decrypt the payinfo, but
+    # try to detect the card type anyway. this never returns failure, so
+    # the contract of $ignore_invalid_cards is maintained.
+    $self->set('cardtype', cardtype($self->paymask));
+  } else {
+    $self->set('cardtype', '');
+  }
+
 #  } elsif ( $self->payby eq 'PREPAY' ) {
 #
 #    my $payinfo = $self->payinfo;
@@ -449,8 +469,6 @@ sub check {
 #      unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 #    $self->paycvv('');
 
-  }
-
   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
 
     $self->paydate('');
@@ -458,6 +476,7 @@ sub check {
   } elsif ( $self->payby =~ /^(CARD|DCRD)$/ ) {
 
     # shouldn't payinfo_check do this?
+    # (except we don't ever call payinfo_check from here)
     return "Expiration date required"
       if $self->paydate eq '' || $self->paydate eq '-';
 
@@ -524,6 +543,7 @@ sub check_payinfo_cardtype {
 
   my %bop_card_types = map { $_=>1 } values %{ card_types() };
   my $cardtype = cardtype($payinfo);
+  $self->set('cardtype', $cardtype);
 
   return "$cardtype not accepted" unless $bop_card_types{$cardtype};
 
@@ -599,7 +619,7 @@ sub label {
   my $self = shift;
 
   my $name = $self->payby =~ /^(CARD|DCRD)$/
-              && cardtype($self->paymask) || FS::payby->shortname($self->payby);
+              && $self->cardtype || FS::payby->shortname($self->payby);
 
   ( $self->payby =~ /^(CARD|CHEK)$/  ? $weight{$self->weight}. ' automatic '
                                      : 'Manual '
@@ -872,6 +892,18 @@ sub search_sql {
 
 =back
 
+=cut
+
+sub _upgrade_data {
+
+  my $class = shift;
+  local $ignore_banned_card = 1;
+  local $ignore_expired_card = 1;
+  local $ignore_invalid_card = 1;
+  $class->upgrade_set_cardtype;
+
+}
+
 =head1 BUGS
 
 =head1 SEE ALSO
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index ced954036..ee144c11f 100644
--- a/FS/FS/cust_refund.pm
+++ b/FS/FS/cust_refund.pm
@@ -82,6 +82,10 @@ Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 
 Payment Information (See L<FS::payinfo_Mixin> for data format)
 
+=item cardtype
+
+Detected credit card type, if appropriate; autodetected.
+
 =item paymask
 
 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
@@ -472,6 +476,9 @@ sub _upgrade_data {  # class method
   my ($class, %opts) = @_;
   $class->_upgrade_reasonnum(%opts);
   $class->_upgrade_otaker(%opts);
+
+  local $ignore_empty_reasonnum = 1;
+  $class->upgrade_set_cardtype;
 }
 
 =back
diff --git a/FS/FS/payinfo_Mixin.pm b/FS/FS/payinfo_Mixin.pm
index 41768189e..b32f13b8d 100644
--- a/FS/FS/payinfo_Mixin.pm
+++ b/FS/FS/payinfo_Mixin.pm
@@ -5,6 +5,7 @@ use Business::CreditCard;
 use FS::payby;
 use FS::Record qw(qsearch);
 use FS::UID qw(driver_name);
+use FS::Cursor;
 use Time::Local qw(timelocal);
 
 use vars qw($ignore_masked_payinfo);
@@ -194,6 +195,8 @@ sub payinfo_check {
 
   if ( $self->payby eq 'CARD' && ! $self->is_encrypted($self->payinfo) ) {
     my $payinfo = $self->payinfo;
+    my $cardtype = cardtype($payinfo);
+    $self->set('cardtype', $cardtype);
     if ( $ignore_masked_payinfo and $self->mask_payinfo eq $self->payinfo ) {
       # allow it
     } else {
@@ -205,12 +208,18 @@ sub payinfo_check {
         $self->payinfo($1);
         validate($self->payinfo) or return "Illegal credit card number";
         return "Unknown card type" if $self->payinfo !~ /^99\d{14}$/ #token
-                                   && cardtype($self->payinfo) eq "Unknown";
+                                   && $cardtype eq "Unknown";
       } else {
         $self->payinfo('N/A'); #???
       }
     }
   } else {
+    if ( $self->payby eq 'CARD' and $self->paymask ) {
+      # if we can't decrypt the card, at least detect the cardtype
+      $self->set('cardtype', cardtype($self->paymask));
+    } else {
+      $self->set('cardtype', '');
+    }
     if ( $self->is_encrypted($self->payinfo) ) {
       #something better?  all it would cause is a decryption error anyway?
       my $error = $self->ut_anything('payinfo');
@@ -404,6 +413,28 @@ sub paydate_epoch_sql {
   END"
 }
 
+=item upgrade_set_cardtype
+
+Find all records with a credit card payment type and no cardtype, and
+replace them in order to set their cardtype.
+
+=cut
+
+sub upgrade_set_cardtype {
+  my $class = shift;
+  # assign cardtypes to CARD/DCRDs that need them; check_payinfo_cardtype
+  # will do this. ignore any problems with the cards.
+  local $ignore_masked_payinfo = 1;
+  my $search = FS::Cursor->new({
+    table     => $class->table,
+    extra_sql => q[ WHERE payby IN('CARD','DCRD') AND cardtype IS NULL ],
+  });
+  while (my $record = $search->fetch) {
+    my $error = $record->replace;
+    die $error if $error;
+  }
+}
+
 =back
 
 =head1 BUGS