RT# 76093 - Added ability to charge a processing fee when taking a payment on the...
[freeside.git] / FS / FS / cust_main.pm
index 0165bc4..590783b 100644 (file)
@@ -1968,8 +1968,19 @@ sub check {
     validate($payinfo)
       or return gettext('invalid_card'); # . ": ". $self->payinfo;
 
-    my $cardtype = cardtype($payinfo);
-    $cardtype = 'Tokenized' if $self->payinfo =~ /^99\d{14}$/; # token
+    my $cardtype = $self->paycardtype;
+    if ( $payinfo =~ /^99\d{14}$/ ) {
+      $self->set('is_tokenized', 'Y'); #so we don't try to do it again
+      if ( $self->paymask =~ /^\d+x/ ) {
+        $cardtype = cardtype($self->paymask);
+      } else {
+        #return "paycardtype required ".
+        #       "(can't derive from a token and no paymask w/prefix provided)"
+        #  unless $cardtype;
+      }
+    } else {
+      $cardtype = cardtype($self->payinfo);
+    }
 
     return gettext('unknown_card_type') if $cardtype eq 'Unknown';
 
@@ -2134,6 +2145,10 @@ sub check {
       if !$import
       && !$ignore_expired_card 
       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
+
+    if ( my $error = $self->ut_daten('paydate') ) {
+      return $error;
+    }
   }
 
   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
@@ -2186,7 +2201,6 @@ sub check_payinfo_cardtype {
   $payinfo =~ s/\D//g;
 
   if ( $payinfo =~ /^99\d{14}$/ ) {
-    $self->set('paycardtype', 'Tokenized');
     return '';
   }
 
@@ -2289,7 +2303,7 @@ Returns a list: an empty list on success or a list of errors.
 
 sub unsuspend {
   my $self = shift;
-  grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
+  grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
 }
 
 =item release_hold
@@ -2780,7 +2794,7 @@ sub batch_card {
   } );
 
   foreach (qw( address1 address2 city state zip country latitude longitude
-               payby payinfo paydate payname ))
+               payby payinfo paydate payname paycode paytype ))
   {
     $options{$_} = '' unless exists($options{$_});
   }
@@ -2804,9 +2818,15 @@ sub batch_card {
     'country'  => $options{country}  || $loc->country,
     'payby'    => $options{payby}    || $self->payby,
     'payinfo'  => $options{payinfo}  || $self->payinfo,
+    'paymask'  => ( $options{payinfo}
+                      ? FS::payinfo_Mixin->mask_payinfo( $options{payby},
+                                                         $options{payinfo} )
+                      : $self->paymask
+                  ),
     'exp'      => $options{paydate}  || $self->paydate,
     'payname'  => $options{payname}  || $self->payname,
     'amount'   => $amount,                         # consolidating
+    'paycode'  => $options{paycode}  || '',
   } );
   
   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
@@ -2824,6 +2844,41 @@ sub batch_card {
     die $error;
   }
 
+  if ($options{'processing-fee'} > 0) {
+    my $pf_cust_pkg;
+    my $processing_fee_text = 'Payment Processing Fee';
+    my $pf_change_error = $self->charge({
+            'amount'  => $options{'processing-fee'},
+            'pkg'   => $processing_fee_text,
+            'setuptax'  => 'Y',
+            'cust_pkg_ref' => \$pf_cust_pkg,
+    });
+
+    if($pf_change_error) {
+      warn 'Unable to add payment processing fee';
+      return '';
+    }
+
+    $pf_cust_pkg->setup(time);
+    my $pf_error = $pf_cust_pkg->replace;
+    if($pf_error) {
+      warn 'Unable to set setup time on cust_pkg for processing fee';
+      # but keep going...
+    }
+
+    my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum });
+    unless ( $cust_bill ) {
+      warn "race condition + invoice deletion just happened";
+      return '';
+    }
+
+    my $grand_pf_error =
+      $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'});
+
+    warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error"
+      if $grand_pf_error;
+  }
+
   my $unapplied =   $self->total_unapplied_credits
                   + $self->total_unapplied_payments
                   + $self->in_transit_payments;
@@ -5169,121 +5224,6 @@ sub search {
 
 =over 4
 
-=item batch_charge
-
-=cut
-
-sub batch_charge {
-  my $param = shift;
-  #warn join('-',keys %$param);
-  my $fh = $param->{filehandle};
-  my $agentnum = $param->{agentnum};
-  my $format = $param->{format};
-
-  my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
-
-  my @fields;
-  if ( $format eq 'simple' ) {
-    @fields = qw( custnum agent_custid amount pkg );
-  } else {
-    die "unknown format $format";
-  }
-
-  eval "use Text::CSV_XS;";
-  die $@ if $@;
-
-  my $csv = new Text::CSV_XS;
-  #warn $csv;
-  #warn $fh;
-
-  my $imported = 0;
-  #my $columns;
-
-  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;
-  
-  #while ( $columns = $csv->getline($fh) ) {
-  my $line;
-  while ( defined($line=<$fh>) ) {
-
-    $csv->parse($line) or do {
-      $dbh->rollback if $oldAutoCommit;
-      return "can't parse: ". $csv->error_input();
-    };
-
-    my @columns = $csv->fields();
-    #warn join('-',@columns);
-
-    my %row = ();
-    foreach my $field ( @fields ) {
-      $row{$field} = shift @columns;
-    }
-
-    if ( $row{custnum} && $row{agent_custid} ) {
-      dbh->rollback if $oldAutoCommit;
-      return "can't specify custnum with agent_custid $row{agent_custid}";
-    }
-
-    my %hash = ();
-    if ( $row{agent_custid} && $agentnum ) {
-      %hash = ( 'agent_custid' => $row{agent_custid},
-                'agentnum'     => $agentnum,
-              );
-    }
-
-    if ( $row{custnum} ) {
-      %hash = ( 'custnum' => $row{custnum} );
-    }
-
-    unless ( scalar(keys %hash) ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "can't find customer without custnum or agent_custid and agentnum";
-    }
-
-    my $cust_main = qsearchs('cust_main', { %hash } );
-    unless ( $cust_main ) {
-      $dbh->rollback if $oldAutoCommit;
-      my $custnum = $row{custnum} || $row{agent_custid};
-      return "unknown custnum $custnum";
-    }
-
-    if ( $row{'amount'} > 0 ) {
-      my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-      $imported++;
-    } elsif ( $row{'amount'} < 0 ) {
-      my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
-                                      $row{'pkg'}                         );
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-      $imported++;
-    } else {
-      #hmm?
-    }
-
-  }
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  return "Empty file!" unless $imported;
-
-  ''; #no error
-
-}
-
 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
 
 Deprecated.  Use event notification and message templates 
@@ -5734,6 +5674,185 @@ sub _upgrade_data { #class method
 
   $class->_upgrade_otaker(%opts);
 
+  # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
+  # existing records will be encrypted in queueable_upgrade (below)
+  unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
+    eval "use FS::Setup";
+    die $@ if $@;
+    FS::Setup::enable_encryption();
+  }
+
+  $class->_upgrade_data_paydate_edgebug;
+}
+
+=item _upgrade_data_paydate_edgebug
+
+Correct bad data injected into payment expire date column by Edge browser bug
+
+The month and year values may have an extra character injected into form POST
+data by Edge browser.  It was possible for some bad month values to slip
+past data validation.
+
+If the stored value was out of range, it was causing payments screen to crash.
+We can detect and fix this by dropping the second digit.
+
+If the stored value is is 11 or 12, it's possible the user inputted a 1.  In
+this case, the payment method will fail to authorize, but the record will
+not cause crashdumps for being out of range.
+
+In short, check for any expiration month > 12, and drop the extra digit
+
+=cut
+
+sub _upgrade_data_paydate_edgebug {
+  my $journal_label = 'cust_main_paydate_edgebug';
+  return if FS::upgrade_journal->is_done( $journal_label );
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  for my $row (
+    FS::Record::qsearch(
+      cust_main => { paydate => { op => '!=', value => '' }}
+    )
+  ) {
+    next unless $row->ut_daten('paydate');
+
+    # paydate column stored in database has failed date validation
+    my $bad_paydate = $row->paydate;
+
+    my @date = split /[\-\/]/, $bad_paydate;
+    @date = @date[2,0,1] if $date[2] > 1900;
+
+    # Only autocorrecting when month > 12 - notify operator
+    unless ( $date[1] > 12 ) {
+      die sprintf(
+        'Unable to correct bad paydate stored in cust_main row '.
+        'custnum(%s) paydate(%s)',
+        $row->custnum,
+        $bad_paydate,
+      );
+    }
+
+    $date[1] = substr( $date[1], 0, 1 );
+    $row->paydate( join('-', @date ));
+
+    if ( my $error = $row->replace ) {
+      die sprintf(
+        'Failed to autocorrect bad paydate stored in cust_main row '.
+        'custnum(%s) paydate(%s) - error: %s',
+        $row->custnum,
+        $bad_paydate,
+        $error
+      );
+    }
+
+    warn sprintf(
+      'Autocorrected bad paydate stored in cust_main row '.
+      "custnum(%s) old-paydate(%s) new-paydate(%s)\n",
+      $row->custnum,
+      $bad_paydate,
+      $row->paydate,
+    );
+
+  }
+
+  FS::upgrade_journal->set_done( $journal_label );
+  dbh->commit unless $oldAutoCommit;
+}
+
+
+sub queueable_upgrade {
+  my $class = shift;
+
+  ### encryption gets turned on in _upgrade_data, above
+
+  eval "use FS::upgrade_journal";
+  die $@ if $@;
+
+  # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
+  # clear that out before encrypting/tokenizing anything else
+  if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
+    foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
+      my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
+      my $sth = dbh->prepare($sql) or die dbh->errstr;
+      $sth->execute or die $sth->errstr;
+    }
+    FS::upgrade_journal->set_done('clear_payinfo_history');
+  }
+
+  # fix Tokenized paycardtype and encrypt old records
+  if (    ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
+       || ! FS::upgrade_journal->is_done('encryption_check')
+     )
+  {
+
+    # allow replacement of closed cust_pay/cust_refund records
+    local $FS::payinfo_Mixin::allow_closed_replace = 1;
+
+    # because it looks like nothing's changing
+    local $FS::Record::no_update_diff = 1;
+
+    # commit everything immediately
+    local $FS::UID::AutoCommit = 1;
+
+    # encrypt what's there
+    foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
+      my $tclass = 'FS::'.$table;
+      my $lastrecnum = 0;
+      my @recnums = ();
+      while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
+        my $record = $tclass->by_key($recnum);
+        next unless $record; # small chance it's been deleted, that's ok
+        next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
+        # window for possible conflict is practically nonexistant,
+        #   but just in case...
+        $record = $record->select_for_update;
+        if (!$record->custnum && $table eq 'cust_pay_pending') {
+          $record->set('custnum_pending',1);
+        }
+        $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
+
+        local($ignore_expired_card) = 1;
+        local($ignore_banned_card) = 1;
+        local($skip_fuzzyfiles) = 1;
+        local($import) = 1;#prevent automatic geocoding (need its own variable?)
+
+        my $error = $record->replace;
+        die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
+      }
+    }
+
+    FS::upgrade_journal->set_done('paycardtype_Tokenized');
+    FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
+  }
+
+}
+
+# not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
+# cust_payby might get deleted while this runs
+# not a method!
+sub _upgrade_next_recnum {
+  my ($dbh,$table,$lastrecnum,$recnums) = @_;
+  my $recnum = shift @$recnums;
+  return $recnum if $recnum;
+  my $tclass = 'FS::'.$table;
+  my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
+  my $sql = 'SELECT '.$tclass->primary_key.
+            ' FROM '.$table.
+            ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
+            "   AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
+            "   AND ( length(payinfo) < 80$paycardtypecheck ) ".
+            ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
+  my $sth = $dbh->prepare($sql) or die $dbh->errstr;
+  $sth->execute() or die $sth->errstr;
+  my @recnums;
+  while (my $rec = $sth->fetchrow_hashref) {
+    push @$recnums, $rec->{$tclass->primary_key};
+  }
+  $sth->finish();
+  $$lastrecnum = $$recnums[-1];
+  return shift @$recnums;
 }
 
 =back