FS/FS/cust_main/Billing_Realtime.pm

   1 package FS::cust_main::Billing_Realtime;
   2
   3 use strict;
   4 use vars qw( $conf $DEBUG $me );
   5 use vars qw( $realtime_bop_decline_quiet ); #ugh
   6 use Carp;
   7 use Data::Dumper;
   8 use Business::CreditCard 0.35;
   9 use Business::OnlinePayment;
  10 use FS::UID qw( dbh myconnect );
  11 use FS::Record qw( qsearch qsearchs );
  12 use FS::payby;
  13 use FS::cust_pay;
  14 use FS::cust_pay_pending;
  15 use FS::cust_bill_pay;
  16 use FS::cust_refund;
  17 use FS::banned_pay;
  18 use FS::payment_gateway;
  19 use FS::Misc::Savepoint;
  20
  21 $realtime_bop_decline_quiet = 0;
  22
  23 # 1 is mostly method/subroutine entry and options
  24 # 2 traces progress of some operations
  25 # 3 is even more information including possibly sensitive data
  26 $DEBUG = 0;
  27 $me = '[FS::cust_main::Billing_Realtime]';
  28
  29 our $BOP_TESTING = 0;
  30 our $BOP_TESTING_SUCCESS = 1;
  31 our $BOP_TESTING_TIMESTAMP = '';
  32
  33 install_callback FS::UID sub {
  34   $conf = new FS::Conf;
  35   #yes, need it for stuff below (prolly should be cached)
  36 };
  37
  38 =head1 NAME
  39
  40 FS::cust_main::Billing_Realtime - Realtime billing mixin for cust_main
  41
  42 =head1 SYNOPSIS
  43
  44 =head1 DESCRIPTION
  45
  46 These methods are available on FS::cust_main objects.
  47
  48 =head1 METHODS
  49
  50 =over 4
  51
  52 =item realtime_cust_payby
  53
  54 =cut
  55
  56 sub realtime_cust_payby {
  57   my( $self, %options ) = @_;
  58
  59   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
  60
  61   $options{amount} = $self->balance unless exists( $options{amount} );
  62
  63   my @cust_payby = $self->cust_payby('CARD','CHEK');
  64
  65   my $error;
  66   foreach my $cust_payby (@cust_payby) {
  67     $error = $cust_payby->realtime_bop( %options, );
  68     last unless $error;
  69   }
  70
  71   #XXX what about the earlier errors?
  72
  73   $error;
  74
  75 }
  76
  77 =item realtime_collect [ OPTION => VALUE ... ]
  78
  79 Attempt to collect the customer's current balance with a realtime credit
  80 card or electronic check transaction (see realtime_bop() below).
  81
  82 Returns the result of realtime_bop(): nothing, an error message, or a
  83 hashref of state information for a third-party transaction.
  84
  85 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
  86
  87 I<method> is one of: I<CC> or I<ECHECK>.  If none is specified
  88 then it is deduced from the customer record.
  89
  90 If no I<amount> is specified, then the customer balance is used.
  91
  92 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
  93 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
  94 if set, will override the value from the customer record.
  95
  96 I<description> is a free-text field passed to the gateway.  It defaults to
  97 the value defined by the business-onlinepayment-description configuration
  98 option, or "Internet services" if that is unset.
  99
 100 If an I<invnum> is specified, this payment (if successful) is applied to the
 101 specified invoice.
 102
 103 I<apply> will automatically apply a resulting payment.
 104
 105 I<quiet> can be set true to suppress email decline notices.
 106
 107 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
 108 resulting paynum, if any.
 109
 110 I<payunique> is a unique identifier for this payment.
 111
 112 I<session_id> is a session identifier associated with this payment.
 113
 114 I<depend_jobnum> allows payment capture to unlock export jobs
 115
 116 =cut
 117
 118 # Currently only used by ClientAPI
 119 sub realtime_collect {
 120   my( $self, %options ) = @_;
 121
 122   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 123
 124   if ( $DEBUG ) {
 125     warn "$me realtime_collect:\n";
 126     warn "  $_ => $options{$_}\n" foreach keys %options;
 127   }
 128
 129   $options{amount} = $self->balance unless exists( $options{amount} );
 130   return '' unless $options{amount} > 0;
 131
 132   #huh, in v4, realtime_bop no longer will just process a card without passing
 133   # payinfo or cust_payby...
 134   if ( ! $options{'payinfo'} && ! $options{'cust_payby'} && $self->has_cust_payby_auto ) {
 135     my @cust_payby = $self->cust_payby;
 136     $options{'cust_payby'} = $cust_payby[0];
 137   }
 138
 139   return $self->realtime_bop({%options});
 140
 141 }
 142
 143 =item realtime_bop { [ ARG => VALUE ... ] }
 144
 145 Runs a realtime credit card or ACH (electronic check) transaction
 146 via a Business::OnlinePayment realtime gateway.  See
 147 L<http://420.am/business-onlinepayment> for supported gateways.
 148
 149 Required arguments in the hashref are I<amount> and either
 150 I<cust_payby> or I<method>, I<payinfo> and (as applicable for method)
 151 I<payname>, I<address1>, I<address2>, I<city>, I<state>, I<zip> and I<paydate>.
 152
 153 Available methods are: I<CC>, I<ECHECK>, or I<PAYPAL>
 154
 155 Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
 156
 157 I<description> is a free-text field passed to the gateway.  It defaults to
 158 the value defined by the business-onlinepayment-description configuration
 159 option, or "Internet services" if that is unset.
 160
 161 If an I<invnum> is specified, this payment (if successful) is applied to the
 162 specified invoice.  If the customer has exactly one open invoice, that
 163 invoice number will be assumed.  If you don't specify an I<invnum> you might
 164 want to call the B<apply_payments> method or set the I<apply> option.
 165
 166 I<no_invnum> can be set to true to prevent that default invnum from being set.
 167
 168 I<apply> can be set to true to run B<apply_payments_and_credits> on success.
 169
 170 I<no_auto_apply> can be set to true to set that flag on the resulting payment
 171 (prevents payment from being applied by B<apply_payments> or B<apply_payments_and_credits>,
 172 but will still be applied if I<invnum> exists...use with I<no_invnum> for intended effect.)
 173
 174 I<quiet> can be set true to surpress email decline notices.
 175
 176 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
 177 resulting paynum, if any.
 178
 179 I<payunique> is a unique identifier for this payment.
 180
 181 I<session_id> is a session identifier associated with this payment.
 182
 183 I<depend_jobnum> allows payment capture to unlock export jobs
 184
 185 I<discount_term> attempts to take a discount by prepaying for discount_term.
 186 The payment will fail if I<amount> is incorrect for this discount term.
 187
 188 A direct (Business::OnlinePayment) transaction will return nothing on success,
 189 or an error message on failure.
 190
 191 A third-party transaction will return a hashref containing:
 192
 193 - popup_url: the URL to which a browser should be redirected to complete
 194   the transaction.
 195 - collectitems: an arrayref of name-value pairs to be posted to popup_url.
 196 - reference: a reference ID for the transaction, to show the customer.
 197
 198 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
 199
 200 =cut
 201
 202 # some helper routines
 203 #
 204 # _bop_recurring_billing: Checks whether this payment should have the
 205 # recurring_billing flag used by some B:OP interfaces (IPPay, PlugnPay,
 206 # vSecure, etc.). This works in two different modes:
 207 # - actual_oncard (default): treat the payment as recurring if the customer
 208 #   has made a payment using this card before.
 209 # - transaction_is_recur: treat the payment as recurring if the invoice
 210 #   being paid has any recurring package charges.
 211
 212 sub _bop_recurring_billing {
 213   my( $self, %opt ) = @_;
 214
 215   my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
 216
 217   if ( defined($method) && $method eq 'transaction_is_recur' ) {
 218
 219     return 1 if $opt{'trans_is_recur'};
 220
 221   } else {
 222
 223     # return 1 if the payinfo has been used for another payment
 224     return $self->payinfo_used($opt{'payinfo'}); # in payinfo_Mixin
 225
 226   }
 227
 228   return 0;
 229
 230 }
 231
 232 #can run safely as class method if opt payment_gateway already exists
 233 sub _payment_gateway {
 234   my ($self, $options) = @_;
 235
 236   if ( $options->{'fake_gatewaynum'} ) {
 237         $options->{payment_gateway} =
 238             qsearchs('payment_gateway',
 239                       { 'gatewaynum' => $options->{'fake_gatewaynum'}, }
 240                     );
 241   }
 242
 243   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
 244     unless exists($options->{payment_gateway});
 245
 246   $options->{payment_gateway};
 247 }
 248
 249 # not a method!!!
 250 sub _bop_auth {
 251   my ($options) = @_;
 252
 253   (
 254     'login'    => $options->{payment_gateway}->gateway_username,
 255     'password' => $options->{payment_gateway}->gateway_password,
 256   );
 257 }
 258
 259 ### not a method!
 260 sub _bop_options {
 261   my ($options) = @_;
 262
 263   $options->{payment_gateway}->gatewaynum
 264     ? $options->{payment_gateway}->options
 265     : @{ $options->{payment_gateway}->get('options') };
 266
 267 }
 268
 269 sub _bop_defaults {
 270   my ($self, $options) = @_;
 271
 272   unless ( $options->{'description'} ) {
 273     if ( $conf->exists('business-onlinepayment-description') ) {
 274       my $dtempl = $conf->config('business-onlinepayment-description');
 275
 276       my $agent = $self->agent->agent;
 277       #$pkgs... not here
 278       $options->{'description'} = eval qq("$dtempl");
 279     } else {
 280       $options->{'description'} = 'Internet services';
 281     }
 282   }
 283
 284   # Default invoice number if the customer has exactly one open invoice.
 285   unless ( $options->{'invnum'} || $options->{'no_invnum'} ) {
 286     $options->{'invnum'} = '';
 287     my @open = $self->open_cust_bill;
 288     $options->{'invnum'} = $open[0]->invnum if scalar(@open) == 1;
 289   }
 290
 291 }
 292
 293 # not a method!
 294 sub _bop_cust_payby_options {
 295   my ($options) = @_;
 296   my $cust_payby = $options->{'cust_payby'};
 297   if ($cust_payby) {
 298
 299     $options->{'method'} = FS::payby->payby2bop( $cust_payby->payby );
 300
 301     if ($cust_payby->payby =~ /^(CARD|DCRD)$/) {
 302       # false laziness with cust_payby->check
 303       #   which might not have been run yet
 304       my( $m, $y );
 305       if ( $cust_payby->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
 306         ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
 307       } elsif ( $cust_payby->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 308         ( $m, $y ) = ( $2, "19$1" );
 309       } elsif ( $cust_payby->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
 310         ( $m, $y ) = ( $3, "20$2" );
 311       } else {
 312         return "Illegal expiration date: ". $cust_payby->paydate;
 313       }
 314       $m = sprintf('%02d',$m);
 315       $options->{paydate} = "$y-$m-01";
 316     } else {
 317       $options->{paydate} = '';
 318     }
 319
 320     $options->{$_} = $cust_payby->$_()
 321       for qw( payinfo paycvv paymask paystart_month paystart_year
 322               payissue payname paystate paytype payip );
 323
 324     if ( $cust_payby->locationnum ) {
 325       my $cust_location = $cust_payby->cust_location;
 326       $options->{$_} = $cust_location->$_() for qw( address1 address2 city state zip );
 327     }
 328   }
 329 }
 330
 331 # can be called as class method,
 332 # but can't load default name/phone fields as class method
 333 sub _bop_content {
 334   my ($self, $options) = @_;
 335   my %content = ();
 336
 337   my $payip = $options->{'payip'};
 338   $content{customer_ip} = $payip if length($payip);
 339
 340   $content{invoice_number} = $options->{'invnum'}
 341     if exists($options->{'invnum'}) && length($options->{'invnum'});
 342
 343   $content{email_customer} =
 344     (    $conf->exists('business-onlinepayment-email_customer')
 345       || $conf->exists('business-onlinepayment-email-override') );
 346
 347   my ($payname, $payfirst, $paylast);
 348   if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
 349     ($payname = $options->{payname}) =~
 350       /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
 351       or return "Illegal payname $payname";
 352     ($payfirst, $paylast) = ($1, $2);
 353   } elsif (ref($self)) { # can't set payname if called as class method
 354     $payfirst = $self->getfield('first');
 355     $paylast = $self->getfield('last');
 356     $payname = "$payfirst $paylast";
 357   }
 358
 359   $content{last_name} = $paylast if $paylast;
 360   $content{first_name} = $payfirst if $payfirst;
 361
 362   $content{name} = $payname if $payname;
 363
 364   $content{address} = $options->{'address1'};
 365   my $address2 = $options->{'address2'};
 366   $content{address} .= ", ". $address2 if length($address2);
 367
 368   $content{city} = $options->{'city'};
 369   $content{state} = $options->{'state'};
 370   $content{zip} = $options->{'zip'};
 371   $content{country} = $options->{'country'};
 372
 373   # can't set phone if called as class method
 374   $content{phone} = $self->daytime || $self->night
 375     if ref($self);
 376
 377   my $currency =    $conf->exists('business-onlinepayment-currency')
 378                  && $conf->config('business-onlinepayment-currency');
 379   $content{currency} = $currency if $currency;
 380
 381   \%content;
 382 }
 383
 384 # updates payinfo and cust_payby options with token from transaction
 385 # can be called as a class method
 386 sub _tokenize_card {
 387   my ($self,$transaction,$options) = @_;
 388   if ( $transaction->can('card_token')
 389        and $transaction->card_token
 390        and !$self->tokenized($options->{'payinfo'})
 391   ) {
 392     $options->{'payinfo'} = $transaction->card_token;
 393     $options->{'cust_payby'}->payinfo($transaction->card_token) if $options->{'cust_payby'};
 394     return $transaction->card_token;
 395   }
 396   return '';
 397 }
 398
 399 my %bop_method2payby = (
 400   'CC'     => 'CARD',
 401   'ECHECK' => 'CHEK',
 402   'PAYPAL' => 'PPAL',
 403 );
 404
 405 sub realtime_bop {
 406   my $self = shift;
 407
 408   confess "Can't call realtime_bop within another transaction ".
 409           '($FS::UID::AutoCommit is false)'
 410     unless $FS::UID::AutoCommit || $BOP_TESTING;
 411
 412   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 413
 414   my $log = FS::Log->new('FS::cust_main::Billing_Realtime::realtime_bop');
 415
 416   my %options = ();
 417   if (ref($_[0]) eq 'HASH') {
 418     %options = %{$_[0]};
 419   } else {
 420     my ( $method, $amount ) = ( shift, shift );
 421     %options = @_;
 422     $options{method} = $method;
 423     $options{amount} = $amount;
 424   }
 425
 426   return '' unless $options{amount} > 0;
 427
 428   # set fields from passed cust_payby
 429   _bop_cust_payby_options(\%options);
 430
 431   # check for banned credit card/ACH
 432   my $ban = FS::banned_pay->ban_search(
 433     'payby'   => $bop_method2payby{$options{method}},
 434     'payinfo' => $options{payinfo},
 435   );
 436   return "Banned credit card" if $ban && $ban->bantype ne 'warn';
 437
 438   # possibly run a separate transaction to tokenize card number,
 439   #   so that we never store tokenized card info in cust_pay_pending
 440   if (($options{method} eq 'CC') && !$self->tokenized($options{'payinfo'})) {
 441     my $token_error = $self->realtime_tokenize(\%options);
 442     return $token_error if $token_error;
 443     # in theory, all cust_payby will be tokenized during original save,
 444     # so we shouldn't get here with opt cust_payby...but just in case...
 445     if ($options{'cust_payby'} && $self->tokenized($options{'payinfo'})) {
 446       $token_error = $options{'cust_payby'}->replace;
 447       return $token_error if $token_error;
 448     }
 449   }
 450
 451   ###
 452   # optional credit card surcharge
 453   ###
 454
 455   my $cc_surcharge = 0;
 456   my $cc_surcharge_pct = 0;
 457   $cc_surcharge_pct = $conf->config('credit-card-surcharge-percentage', $self->agentnum)
 458     if $conf->config('credit-card-surcharge-percentage', $self->agentnum)
 459     && $options{method} eq 'CC';
 460
 461   my $cc_surcharge_flat = 0;
 462   $cc_surcharge_flat = $conf->config('credit-card-surcharge-flatfee', $self->agentnum)
 463     if $conf->config('credit-card-surcharge-flatfee', $self->agentnum)
 464     && $options{method} eq 'CC';
 465
 466   # always add cc surcharge if called from event
 467   if($options{'cc_surcharge_from_event'} && ($cc_surcharge_pct > 0 || $cc_surcharge_flat > 0)) {
 468     if ($options{'amount'} > 0) {
 469       $cc_surcharge = ($options{'amount'} * ($cc_surcharge_pct / 100)) + $cc_surcharge_flat;
 470       $options{'amount'} += $cc_surcharge;
 471       $options{'amount'} = sprintf("%.2f", $options{'amount'}); # round (again)?
 472     }
 473   }
 474   elsif($cc_surcharge_pct > 0 || $cc_surcharge_flat > 0) {
 475     # we're called not from event (i.e. from a
 476     # payment screen), so consider the given
 477                 # amount as post-surcharge-processing_fee
 478     $cc_surcharge = $options{'amount'} - $options{'processing-fee'} - (($options{'amount'} - ($cc_surcharge_flat + $options{'processing-fee'})) / ( 1 + $cc_surcharge_pct/100 )) if $options{'amount'} > 0;
 479   }
 480
 481   $cc_surcharge = sprintf("%.2f",$cc_surcharge) if $cc_surcharge > 0;
 482   $options{'cc_surcharge'} = $cc_surcharge;
 483
 484
 485   if ( $DEBUG ) {
 486     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
 487     warn " cc_surcharge = $cc_surcharge\n";
 488   }
 489   if ( $DEBUG > 2 ) {
 490     warn "  $_ => $options{$_}\n" foreach keys %options;
 491   }
 492
 493   return $self->fake_bop(\%options) if $options{'fake'};
 494
 495   $self->_bop_defaults(\%options);
 496
 497   return "Missing payinfo"
 498     unless $options{'payinfo'};
 499
 500   ###
 501   # set trans_is_recur based on invnum if there is one
 502   ###
 503
 504   my $trans_is_recur = 0;
 505   if ( $options{'invnum'} ) {
 506
 507     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
 508     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
 509
 510     my @part_pkg =
 511       map  { $_->part_pkg }
 512       grep { $_ }
 513       map  { $_->cust_pkg }
 514       $cust_bill->cust_bill_pkg;
 515
 516     $trans_is_recur = 1
 517       if grep { $_->freq ne '0' } @part_pkg;
 518
 519   }
 520
 521   ###
 522   # select a gateway
 523   ###
 524
 525   my $payment_gateway =  $self->_payment_gateway( \%options );
 526   my $namespace = $payment_gateway->gateway_namespace;
 527
 528   eval "use $namespace";
 529   die $@ if $@;
 530
 531   ###
 532   # check for term discount validity
 533   ###
 534
 535   my $discount_term = $options{discount_term};
 536   if ( $discount_term ) {
 537     my $bill = ($self->cust_bill)[-1]
 538       or return "Can't apply a term discount to an unbilled customer";
 539     my $plan = FS::discount_plan->new(
 540       cust_bill => $bill,
 541       months    => $discount_term
 542     ) or return "No discount available for term '$discount_term'";
 543
 544     if ( $plan->discounted_total != $options{amount} ) {
 545       return "Incorrect term prepayment amount (term $discount_term, amount $options{amount}, requires ".$plan->discounted_total.")";
 546     }
 547   }
 548
 549   ###
 550   # massage data
 551   ###
 552
 553   my $bop_content = $self->_bop_content(\%options);
 554   return $bop_content unless ref($bop_content);
 555
 556   my @invoicing_list = $self->invoicing_list_emailonly;
 557   if ( $conf->exists('emailinvoiceautoalways')
 558        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
 559        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
 560     push @invoicing_list, $self->all_emails;
 561   }
 562
 563   my $email = ($conf->exists('business-onlinepayment-email-override'))
 564               ? $conf->config('business-onlinepayment-email-override')
 565               : $invoicing_list[0];
 566
 567   my $paydate = '';
 568   my %content = ();
 569
 570   if ( $namespace eq 'Business::OnlinePayment' ) {
 571
 572     if ( $options{method} eq 'CC' ) {
 573
 574       $content{card_number} = $options{payinfo};
 575       $paydate = $options{'paydate'};
 576       $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
 577       $content{expiration} = "$2/$1";
 578
 579       $content{cvv2} = $options{'paycvv'}
 580         if length($options{'paycvv'});
 581
 582       my $paystart_month = $options{'paystart_month'};
 583       my $paystart_year  = $options{'paystart_year'};
 584       $content{card_start} = "$paystart_month/$paystart_year"
 585         if $paystart_month && $paystart_year;
 586
 587       my $payissue       = $options{'payissue'};
 588       $content{issue_number} = $payissue if $payissue;
 589
 590       if ( $self->_bop_recurring_billing(
 591              'payinfo'        => $options{'payinfo'},
 592              'trans_is_recur' => $trans_is_recur,
 593            )
 594          )
 595       {
 596         $content{recurring_billing} = 'YES';
 597         $content{acct_code} = 'rebill'
 598           if $conf->exists('credit_card-recurring_billing_acct_code');
 599       }
 600
 601     } elsif ( $options{method} eq 'ECHECK' ){
 602
 603       ( $content{account_number}, $content{routing_code} ) =
 604         split('@', $options{payinfo});
 605       $content{bank_name} = $options{payname};
 606       $content{bank_state} = $options{'paystate'};
 607       $content{account_type}= uc($options{'paytype'}) || 'PERSONAL CHECKING';
 608
 609       $content{company} = $self->company if $self->company;
 610
 611       if ( $content{account_type} =~ /BUSINESS/i && $self->company ) {
 612         $content{account_name} = $self->company;
 613       } else {
 614         $content{account_name} = $self->getfield('first'). ' '.
 615                                  $self->getfield('last');
 616       }
 617
 618       $content{customer_org} = $self->company ? 'B' : 'I';
 619       $content{state_id}       = exists($options{'stateid'})
 620                                    ? $options{'stateid'}
 621                                    : $self->getfield('stateid');
 622       $content{state_id_state} = exists($options{'stateid_state'})
 623                                    ? $options{'stateid_state'}
 624                                    : $self->getfield('stateid_state');
 625       $content{customer_ssn} = exists($options{'ss'})
 626                                  ? $options{'ss'}
 627                                  : $self->ss;
 628
 629     } else {
 630       die "unknown method ". $options{method};
 631     }
 632
 633   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
 634     #move along
 635   } else {
 636     die "unknown namespace $namespace";
 637   }
 638
 639   ###
 640   # run transaction(s)
 641   ###
 642
 643   my $balance = exists( $options{'balance'} )
 644                   ? $options{'balance'}
 645                   : $self->balance;
 646
 647   warn "claiming mutex on customer ". $self->custnum. "\n" if $DEBUG > 1;
 648   $self->select_for_update; #mutex ... just until we get our pending record in
 649   warn "obtained mutex on customer ". $self->custnum. "\n" if $DEBUG > 1;
 650
 651   #the checks here are intended to catch concurrent payments
 652   #double-form-submission prevention is taken care of in cust_pay_pending::check
 653
 654   #check the balance
 655   return "The customer's balance has changed; $options{method} transaction aborted."
 656     if $self->balance < $balance;
 657
 658   #also check and make sure there aren't *other* pending payments for this cust
 659
 660   my @pending = qsearch('cust_pay_pending', {
 661     'custnum' => $self->custnum,
 662     'status'  => { op=>'!=', value=>'done' }
 663   });
 664
 665   #for third-party payments only, remove pending payments if they're in the
 666   #'thirdparty' (waiting for customer action) state.
 667   if ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
 668     foreach ( grep { $_->status eq 'thirdparty' } @pending ) {
 669       my $error = $_->delete;
 670       warn "error deleting unfinished third-party payment ".
 671           $_->paypendingnum . ": $error\n"
 672         if $error;
 673     }
 674     @pending = grep { $_->status ne 'thirdparty' } @pending;
 675   }
 676
 677   return "A payment is already being processed for this customer (".
 678          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
 679          "); $options{method} transaction aborted."
 680     if scalar(@pending);
 681
 682   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
 683
 684   my $cust_pay_pending = new FS::cust_pay_pending {
 685     'custnum'           => $self->custnum,
 686     'paid'              => $options{amount},
 687     '_date'             => $BOP_TESTING ? $BOP_TESTING_TIMESTAMP : '',
 688     'payby'             => $bop_method2payby{$options{method}},
 689     'payinfo'           => $options{payinfo},
 690     'paymask'           => $options{paymask},
 691     'paydate'           => $paydate,
 692     'recurring_billing' => $content{recurring_billing},
 693     'pkgnum'            => $options{'pkgnum'},
 694     'status'            => 'new',
 695     'gatewaynum'        => $payment_gateway->gatewaynum || '',
 696     'session_id'        => $options{session_id} || '',
 697     'jobnum'            => $options{depend_jobnum} || '',
 698   };
 699   $cust_pay_pending->payunique( $options{payunique} )
 700     if defined($options{payunique}) && length($options{payunique});
 701
 702   warn "inserting cust_pay_pending record for customer ". $self->custnum. "\n"
 703     if $DEBUG > 1;
 704   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
 705   return $cpp_new_err if $cpp_new_err;
 706
 707   warn "inserted cust_pay_pending record for customer ". $self->custnum. "\n"
 708     if $DEBUG > 1;
 709   warn Dumper($cust_pay_pending) if $DEBUG > 2;
 710
 711   my( $action1, $action2 ) =
 712     split( /\s*\,\s*/, $payment_gateway->gateway_action );
 713
 714   my $transaction = new $namespace( $payment_gateway->gateway_module,
 715                                     _bop_options(\%options),
 716                                   );
 717
 718   $transaction->content(
 719     'type'           => $options{method},
 720     _bop_auth(\%options),
 721     'action'         => $action1,
 722     'description'    => $options{'description'},
 723     'amount'         => $options{amount},
 724     #'invoice_number' => $options{'invnum'},
 725     'customer_id'    => $self->custnum,
 726     %$bop_content,
 727     'reference'      => $cust_pay_pending->paypendingnum, #for now
 728     'callback_url'   => $payment_gateway->gateway_callback_url,
 729     'cancel_url'     => $payment_gateway->gateway_cancel_url,
 730     'email'          => $email,
 731     %content, #after
 732   );
 733
 734   $cust_pay_pending->status('pending');
 735   my $cpp_pending_err = $cust_pay_pending->replace;
 736   return $cpp_pending_err if $cpp_pending_err;
 737
 738   warn Dumper($transaction) if $DEBUG > 2;
 739
 740   unless ( $BOP_TESTING ) {
 741     $transaction->test_transaction(1)
 742       if $conf->exists('business-onlinepayment-test_transaction');
 743     $transaction->submit();
 744   } else {
 745     if ( $BOP_TESTING_SUCCESS ) {
 746       $transaction->is_success(1);
 747       $transaction->authorization('fake auth');
 748     } else {
 749       $transaction->is_success(0);
 750       $transaction->error_message('fake failure');
 751     }
 752   }
 753
 754   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
 755
 756     $cust_pay_pending->status('thirdparty');
 757     my $cpp_err = $cust_pay_pending->replace;
 758     return { error => $cpp_err } if $cpp_err;
 759     return { reference => $cust_pay_pending->paypendingnum,
 760              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
 761
 762   } elsif ( !$BOP_TESTING && $transaction->is_success() && $action2 ) {
 763
 764     $cust_pay_pending->status('authorized');
 765     my $cpp_authorized_err = $cust_pay_pending->replace;
 766     return $cpp_authorized_err if $cpp_authorized_err;
 767
 768     my $auth = $transaction->authorization;
 769     my $ordernum = $transaction->can('order_number')
 770                    ? $transaction->order_number
 771                    : '';
 772
 773     my $capture =
 774       new Business::OnlinePayment( $payment_gateway->gateway_module,
 775                                    _bop_options(\%options),
 776                                  );
 777
 778     my %capture = (
 779       %content,
 780       type           => $options{method},
 781       action         => $action2,
 782       _bop_auth(\%options),
 783       order_number   => $ordernum,
 784       amount         => $options{amount},
 785       authorization  => $auth,
 786       description    => $options{'description'},
 787     );
 788
 789     foreach my $field (qw( authorization_source_code returned_ACI
 790                            transaction_identifier validation_code
 791                            transaction_sequence_num local_transaction_date
 792                            local_transaction_time AVS_result_code          )) {
 793       $capture{$field} = $transaction->$field() if $transaction->can($field);
 794     }
 795
 796     $capture->content( %capture );
 797
 798     $capture->test_transaction(1)
 799       if $conf->exists('business-onlinepayment-test_transaction');
 800     $capture->submit();
 801
 802     unless ( $capture->is_success ) {
 803       my $e = "Authorization successful but capture failed, custnum #".
 804               $self->custnum. ': '.  $capture->result_code.
 805               ": ". $capture->error_message;
 806       warn $e;
 807       return $e;
 808     }
 809
 810   }
 811
 812   ###
 813   # remove paycvv after initial transaction
 814   ###
 815
 816   # compare to FS::cust_main::save_cust_payby - check both to make sure working correctly
 817   if ( length($options{'paycvv'})
 818        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
 819   ) {
 820     my $error = $self->remove_cvv_from_cust_payby($options{payinfo});
 821     if ( $error ) {
 822       $log->critical('Error removing cvv for cust '.$self->custnum.': '.$error);
 823       #not returning error, should at least attempt to handle results of an otherwise valid transaction
 824       warn "WARNING: error removing cvv: $error\n";
 825     }
 826   }
 827
 828   ###
 829   # Tokenize
 830   ###
 831
 832   # This block will only run if the B::OP module supports card_token but not the Tokenize transaction;
 833   #   if that never happens, we should get rid of it (as it has the potential to store real card numbers on error)
 834   if (my $card_token = $self->_tokenize_card($transaction,\%options)) {
 835     # cpp will be replaced in _realtime_bop_result
 836     $cust_pay_pending->payinfo($card_token);
 837     if ($options{'cust_payby'} and my $error = $options{'cust_payby'}->replace) {
 838       $log->critical('Error storing token for cust '.$self->custnum.', cust_payby '.$options{'cust_payby'}->custpaybynum.': '.$error);
 839       #not returning error, should at least attempt to handle results of an otherwise valid transaction
 840       #this leaves real card number in cust_payby, but can't do much else if cust_payby won't replace
 841     }
 842   }
 843
 844   ###
 845   # result handling
 846   ###
 847
 848   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
 849
 850 }
 851
 852 =item fake_bop
 853
 854 =cut
 855
 856 sub fake_bop {
 857   my $self = shift;
 858
 859   my %options = ();
 860   if (ref($_[0]) eq 'HASH') {
 861     %options = %{$_[0]};
 862   } else {
 863     my ( $method, $amount ) = ( shift, shift );
 864     %options = @_;
 865     $options{method} = $method;
 866     $options{amount} = $amount;
 867   }
 868
 869   if ( $options{'fake_failure'} ) {
 870      return "Error: No error; test failure requested with fake_failure";
 871   }
 872
 873   my $cust_pay = new FS::cust_pay ( {
 874      'custnum'  => $self->custnum,
 875      'invnum'   => $options{'invnum'},
 876      'paid'     => $options{amount},
 877      '_date'    => '',
 878      'payby'    => $bop_method2payby{$options{method}},
 879      'payinfo'  => '4111111111111111',
 880      'paydate'  => '2012-05-01',
 881      'processor'      => 'FakeProcessor',
 882      'auth'           => '54',
 883      'order_number'   => '32',
 884   } );
 885   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
 886
 887   if ( $DEBUG ) {
 888       warn "fake_bop\n cust_pay: ". Dumper($cust_pay) . "\n options: ";
 889       warn "  $_ => $options{$_}\n" foreach keys %options;
 890   }
 891
 892   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
 893
 894   if ( $error ) {
 895     $cust_pay->invnum(''); #try again with no specific invnum
 896     my $error2 = $cust_pay->insert( $options{'manual'} ?
 897                                     ( 'manual' => 1 ) : ()
 898                                   );
 899     if ( $error2 ) {
 900       # gah, even with transactions.
 901       my $e = 'WARNING: Card/ACH debited but database not updated - '.
 902               "error inserting (fake!) payment: $error2".
 903               " (previously tried insert with invnum #$options{'invnum'}" .
 904               ": $error )";
 905       warn $e;
 906       return $e;
 907     }
 908   }
 909
 910   if ( $options{'paynum_ref'} ) {
 911     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
 912   }
 913
 914   return ''; #no error
 915
 916 }
 917
 918
 919 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
 920 #
 921 # Wraps up processing of a realtime credit card or ACH (electronic check)
 922 # transaction.
 923
 924 sub _realtime_bop_result {
 925   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
 926
 927   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 928
 929   if ( $DEBUG ) {
 930     warn "$me _realtime_bop_result: pending transaction ".
 931       $cust_pay_pending->paypendingnum. "\n";
 932     warn "  $_ => $options{$_}\n" foreach keys %options;
 933   }
 934
 935   my $payment_gateway = $options{payment_gateway}
 936     or return "no payment gateway in arguments to _realtime_bop_result";
 937
 938   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
 939   my $cpp_captured_err = $cust_pay_pending->replace; #also saves post-transaction tokenization, if that happens
 940   return $cpp_captured_err if $cpp_captured_err;
 941
 942   if ( $transaction->is_success() ) {
 943
 944     my $order_number = $transaction->order_number
 945       if $transaction->can('order_number');
 946
 947     my $cust_pay = new FS::cust_pay ( {
 948        'custnum'  => $self->custnum,
 949        'invnum'   => $options{'invnum'},
 950        'paid'     => $cust_pay_pending->paid,
 951        '_date'    => $BOP_TESTING ? $BOP_TESTING_TIMESTAMP : '',
 952        'payby'    => $cust_pay_pending->payby,
 953        'payinfo'  => $options{'payinfo'},
 954        'paymask'  => $options{'paymask'} || $cust_pay_pending->paymask,
 955        'paydate'  => $cust_pay_pending->paydate,
 956        'pkgnum'   => $cust_pay_pending->pkgnum,
 957        'discount_term'  => $options{'discount_term'},
 958        'gatewaynum'     => ($payment_gateway->gatewaynum || ''),
 959        'processor'      => $payment_gateway->gateway_module,
 960        'auth'           => $transaction->authorization,
 961        'order_number'   => $order_number || '',
 962        'no_auto_apply'  => $options{'no_auto_apply'} ? 'Y' : '',
 963     } );
 964     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
 965     $cust_pay->payunique( $options{payunique} )
 966       if defined($options{payunique}) && length($options{payunique});
 967
 968     my $oldAutoCommit = $FS::UID::AutoCommit;
 969     local $FS::UID::AutoCommit = 0;
 970     my $dbh = dbh;
 971
 972     my $savepoint_label = '_realtime_bop_result';
 973     savepoint_create( $savepoint_label );
 974
 975     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
 976
 977     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
 978
 979     if ( $error ) {
 980       savepoint_rollback( $savepoint_label );
 981
 982       $cust_pay->invnum(''); #try again with no specific invnum
 983       $cust_pay->paynum('');
 984       my $error2 = $cust_pay->insert( $options{'manual'} ?
 985                                       ( 'manual' => 1 ) : ()
 986                                     );
 987       if ( $error2 ) {
 988         # gah.  but at least we have a record of the state we had to abort in
 989         # from cust_pay_pending now.
 990         savepoint_rollback_and_release( $savepoint_label );
 991
 992         my $e = "WARNING: $options{method} captured but payment not recorded -".
 993                 " error inserting payment (". $payment_gateway->gateway_module.
 994                 "): $error2".
 995                 " (previously tried insert with invnum #$options{'invnum'}" .
 996                 ": $error ) - pending payment saved as paypendingnum ".
 997                 $cust_pay_pending->paypendingnum. "\n";
 998         warn $e;
 999         return $e;
1000       }
1001     }
1002
1003     my $jobnum = $cust_pay_pending->jobnum;
1004     if ( $jobnum ) {
1005        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
1006
1007        unless ( $placeholder ) {
1008          savepoint_rollback_and_release( $savepoint_label );
1009
1010          my $e = "WARNING: $options{method} captured but job $jobnum not ".
1011              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
1012          warn $e;
1013          return $e;
1014        }
1015
1016        $error = $placeholder->delete;
1017
1018        if ( $error ) {
1019         savepoint_rollback_and_release( $savepoint_label );
1020
1021          my $e = "WARNING: $options{method} captured but could not delete ".
1022               "job $jobnum for paypendingnum ".
1023               $cust_pay_pending->paypendingnum. ": $error\n";
1024          warn $e;
1025          return $e;
1026        }
1027
1028        $cust_pay_pending->set('jobnum','');
1029
1030     }
1031
1032     if ( $options{'paynum_ref'} ) {
1033       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
1034     }
1035
1036     $cust_pay_pending->status('done');
1037     $cust_pay_pending->statustext('captured');
1038     $cust_pay_pending->paynum($cust_pay->paynum);
1039     my $cpp_done_err = $cust_pay_pending->replace;
1040
1041     if ( $cpp_done_err ) {
1042       savepoint_rollback_and_release( $savepoint_label );
1043
1044       my $e = "WARNING: $options{method} captured but payment not recorded - ".
1045               "error updating status for paypendingnum ".
1046               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
1047       warn $e;
1048       return $e;
1049
1050     } else {
1051       savepoint_release( $savepoint_label );
1052       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1053
1054       if ( $options{'apply'} ) {
1055         my $apply_error = $self->apply_payments_and_credits;
1056         if ( $apply_error ) {
1057           warn "WARNING: error applying payment: $apply_error\n";
1058           #but we still should return no error cause the payment otherwise went
1059           #through...
1060         }
1061       }
1062
1063       # have a CC surcharge portion --> one-time charge
1064       if ( $options{'cc_surcharge'} > 0 || $options{'processing-fee'} > 0) {
1065             # XXX: this whole block needs to be in a transaction?
1066
1067           my $invnum;
1068           $invnum = $options{'invnum'} if $options{'invnum'};
1069           unless ( $invnum ) { # probably from a payment screen
1070              # do we have any open invoices? pick earliest
1071              # uses the fact that cust_main->cust_bill sorts by date ascending
1072              my @open = $self->open_cust_bill;
1073              $invnum = $open[0]->invnum if scalar(@open);
1074           }
1075
1076           unless ( $invnum ) {  # still nothing? pick last closed invoice
1077              # again uses fact that cust_main->cust_bill sorts by date ascending
1078              my @closed = $self->cust_bill;
1079              $invnum = $closed[$#closed]->invnum if scalar(@closed);
1080           }
1081
1082           unless ( $invnum ) {
1083             # XXX: unlikely case - pre-paying before any invoices generated
1084             # what it should do is create a new invoice and pick it
1085                 warn 'CC SURCHARGE OR PROCESS FEE AND NO INVOICES PICKED TO APPLY IT!';
1086                 return '';
1087           }
1088
1089     if ($options{'cc_surcharge'} > 0) {
1090             my $cust_pkg;
1091       my $cc_surcharge_text = 'Credit Card Surcharge';
1092       $cc_surcharge_text = $conf->config('credit-card-surcharge-text', $self->agentnum) if $conf->exists('credit-card-surcharge-text', $self->agentnum);
1093             my $charge_error = $self->charge({
1094                                     'amount'    => $options{'cc_surcharge'},
1095                                     'pkg'       => $cc_surcharge_text,
1096                                     'setuptax'  => 'Y',
1097                                     'cust_pkg_ref' => \$cust_pkg,
1098                         });
1099
1100             if($charge_error) {
1101                     warn 'Unable to add CC surcharge cust_pkg';
1102                     return '';
1103             }
1104
1105       $cust_pkg->setup(time);
1106       my $cp_error = $cust_pkg->replace;
1107       if($cp_error) {
1108         warn 'Unable to set setup time on cust_pkg for cc surcharge';
1109         # but keep going...
1110       }
1111
1112       my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum });
1113       unless ( $cust_bill ) {
1114         warn "race condition + invoice deletion just happened";
1115         return '';
1116       }
1117
1118       my $grand_error =
1119         $cust_bill->add_cc_surcharge($cust_pkg->pkgnum,$options{'cc_surcharge'});
1120
1121       warn "cannot add CC surcharge to invoice #$invnum: $grand_error"
1122         if $grand_error;
1123     } # end if $options{'cc_surcharge'}
1124
1125     if ($options{'processing-fee'} > 0) {
1126       my $pf_cust_pkg;
1127       my $processing_fee_text = 'Payment Processing Fee';
1128       my $pf_change_error = $self->charge({
1129             'amount'  => $options{'processing-fee'},
1130             'pkg'   => $processing_fee_text,
1131             'setuptax'  => 'Y',
1132             'cust_pkg_ref' => \$pf_cust_pkg,
1133       });
1134
1135       if($pf_change_error) {
1136         warn 'Unable to add payment processing fee';
1137         return '';
1138       }
1139
1140       $pf_cust_pkg->setup(time);
1141       my $pf_error = $pf_cust_pkg->replace;
1142       if($pf_error) {
1143         warn 'Unable to set setup time on cust_pkg for processing fee';
1144         # but keep going...
1145       }
1146
1147       my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum });
1148       unless ( $cust_bill ) {
1149         warn "race condition + invoice deletion just happened";
1150         return '';
1151       }
1152
1153       my $grand_pf_error =
1154         $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'});
1155
1156       warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error"
1157         if $grand_pf_error;
1158     } #end if $options{'processing-fee'}
1159
1160       } #end if ( $options{'cc_surcharge'} > 0 || $options{'processing-fee'} > 0)
1161
1162       return ''; #no error
1163
1164     }
1165
1166   } else {
1167
1168     my $perror = $transaction->error_message;
1169     #$payment_gateway->gateway_module. " error: ".
1170     # removed for conciseness
1171
1172     my $jobnum = $cust_pay_pending->jobnum;
1173     if ( $jobnum ) {
1174        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
1175
1176        if ( $placeholder ) {
1177          my $error = $placeholder->depended_delete;
1178          $error ||= $placeholder->delete;
1179          $cust_pay_pending->set('jobnum','');
1180          warn "error removing provisioning jobs after declined paypendingnum ".
1181            $cust_pay_pending->paypendingnum. ": $error\n" if $error;
1182        } else {
1183          my $e = "error finding job $jobnum for declined paypendingnum ".
1184               $cust_pay_pending->paypendingnum. "\n";
1185          warn $e;
1186        }
1187
1188     }
1189
1190     unless ( $transaction->error_message ) {
1191
1192       my $t_response;
1193       if ( $transaction->can('response_page') ) {
1194         $t_response = {
1195                         'page'    => ( $transaction->can('response_page')
1196                                          ? $transaction->response_page
1197                                          : ''
1198                                      ),
1199                         'code'    => ( $transaction->can('response_code')
1200                                          ? $transaction->response_code
1201                                          : ''
1202                                      ),
1203                         'headers' => ( $transaction->can('response_headers')
1204                                          ? $transaction->response_headers
1205                                          : ''
1206                                      ),
1207                       };
1208       } else {
1209         $t_response .=
1210           "No additional debugging information available for ".
1211             $payment_gateway->gateway_module;
1212       }
1213
1214       $perror .= "No error_message returned from ".
1215                    $payment_gateway->gateway_module. " -- ".
1216                  ( ref($t_response) ? Dumper($t_response) : $t_response );
1217
1218     }
1219
1220     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
1221          && $conf->exists('emaildecline', $self->agentnum)
1222          && grep { $_ ne 'POST' } $self->invoicing_list
1223          && ! grep { $transaction->error_message =~ /$_/ }
1224                    $conf->config('emaildecline-exclude', $self->agentnum)
1225     ) {
1226
1227       # Send a decline alert to the customer.
1228       my $msgnum = $conf->config('decline_msgnum', $self->agentnum);
1229       my $error = '';
1230       if ( $msgnum ) {
1231         # include the raw error message in the transaction state
1232         $cust_pay_pending->setfield('error', $transaction->error_message);
1233         my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
1234         $error = $msg_template->send( 'cust_main' => $self,
1235                                       'object'    => $cust_pay_pending );
1236       }
1237
1238
1239       $perror .= " (also received error sending decline notification: $error)"
1240         if $error;
1241
1242     }
1243
1244     $cust_pay_pending->status('done');
1245     $cust_pay_pending->statustext($perror);
1246     #'declined:': no, that's failure_status
1247     if ( $transaction->can('failure_status') ) {
1248       $cust_pay_pending->failure_status( $transaction->failure_status );
1249     }
1250     my $cpp_done_err = $cust_pay_pending->replace;
1251     if ( $cpp_done_err ) {
1252       my $e = "WARNING: $options{method} declined but pending payment not ".
1253               "resolved - error updating status for paypendingnum ".
1254               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
1255       warn $e;
1256       $perror = "$e ($perror)";
1257     }
1258
1259     return $perror;
1260   }
1261
1262 }
1263
1264 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
1265
1266 Verifies successful third party processing of a realtime credit card or
1267 ACH (electronic check) transaction via a
1268 Business::OnlineThirdPartyPayment realtime gateway.  See
1269 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
1270
1271 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
1272
1273 The additional options I<payname>, I<city>, I<state>,
1274 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1275 if set, will override the value from the customer record.
1276
1277 I<description> is a free-text field passed to the gateway.  It defaults to
1278 "Internet services".
1279
1280 If an I<invnum> is specified, this payment (if successful) is applied to the
1281 specified invoice.  If you don't specify an I<invnum> you might want to
1282 call the B<apply_payments> method.
1283
1284 I<quiet> can be set true to surpress email decline notices.
1285
1286 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
1287 resulting paynum, if any.
1288
1289 I<payunique> is a unique identifier for this payment.
1290
1291 Returns a hashref containing elements bill_error (which will be undefined
1292 upon success) and session_id of any associated session.
1293
1294 =cut
1295
1296 sub realtime_botpp_capture {
1297   my( $self, $cust_pay_pending, %options ) = @_;
1298
1299   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1300
1301   if ( $DEBUG ) {
1302     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
1303     warn "  $_ => $options{$_}\n" foreach keys %options;
1304   }
1305
1306   eval "use Business::OnlineThirdPartyPayment";
1307   die $@ if $@;
1308
1309   ###
1310   # select the gateway
1311   ###
1312
1313   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
1314
1315   my $payment_gateway;
1316   my $gatewaynum = $cust_pay_pending->getfield('gatewaynum');
1317   $payment_gateway = $gatewaynum ? qsearchs( 'payment_gateway',
1318                 { gatewaynum => $gatewaynum }
1319               )
1320     : $self->agent->payment_gateway( 'method' => $method,
1321                                      # 'invnum'  => $cust_pay_pending->invnum,
1322                                      # 'payinfo' => $cust_pay_pending->payinfo,
1323                                    );
1324
1325   $options{payment_gateway} = $payment_gateway; # for the helper subs
1326
1327   ###
1328   # massage data
1329   ###
1330
1331   my @invoicing_list = $self->invoicing_list_emailonly;
1332   if ( $conf->exists('emailinvoiceautoalways')
1333        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
1334        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1335     push @invoicing_list, $self->all_emails;
1336   }
1337
1338   my $email = ($conf->exists('business-onlinepayment-email-override'))
1339               ? $conf->config('business-onlinepayment-email-override')
1340               : $invoicing_list[0];
1341
1342   my %content = ();
1343
1344   $content{email_customer} =
1345     (    $conf->exists('business-onlinepayment-email_customer')
1346       || $conf->exists('business-onlinepayment-email-override') );
1347
1348   ###
1349   # run transaction(s)
1350   ###
1351
1352   my $transaction =
1353     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
1354                                            _bop_options(\%options),
1355                                          );
1356
1357   $transaction->reference({ %options });
1358
1359   $transaction->content(
1360     'type'           => $method,
1361     _bop_auth(\%options),
1362     'action'         => 'Post Authorization',
1363     'description'    => $options{'description'},
1364     'amount'         => $cust_pay_pending->paid,
1365     #'invoice_number' => $options{'invnum'},
1366     'customer_id'    => $self->custnum,
1367     'reference'      => $cust_pay_pending->paypendingnum,
1368     'email'          => $email,
1369     'phone'          => $self->daytime || $self->night,
1370     %content, #after
1371     # plus whatever is required for bogus capture avoidance
1372   );
1373
1374   $transaction->submit();
1375
1376   my $error =
1377     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
1378
1379   if ( $options{'apply'} ) {
1380     my $apply_error = $self->apply_payments_and_credits;
1381     if ( $apply_error ) {
1382       warn "WARNING: error applying payment: $apply_error\n";
1383     }
1384   }
1385
1386   return {
1387     bill_error => $error,
1388     session_id => $cust_pay_pending->session_id,
1389   }
1390
1391 }
1392
1393 =item default_payment_gateway
1394
1395 DEPRECATED -- use agent->payment_gateway
1396
1397 =cut
1398
1399 sub default_payment_gateway {
1400   my( $self, $method ) = @_;
1401
1402   die "Real-time processing not enabled\n"
1403     unless $conf->exists('business-onlinepayment');
1404
1405   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
1406
1407   #load up config
1408   my $bop_config = 'business-onlinepayment';
1409   $bop_config .= '-ach'
1410     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
1411   my ( $processor, $login, $password, $action, @bop_options ) =
1412     $conf->config($bop_config);
1413   $action ||= 'normal authorization';
1414   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
1415   die "No real-time processor is enabled - ".
1416       "did you set the business-onlinepayment configuration value?\n"
1417     unless $processor;
1418
1419   ( $processor, $login, $password, $action, @bop_options )
1420 }
1421
1422 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
1423
1424 Refunds a realtime credit card or ACH (electronic check) transaction
1425 via a Business::OnlinePayment realtime gateway.  See
1426 L<http://420.am/business-onlinepayment> for supported gateways.
1427
1428 Available methods are: I<CC> or I<ECHECK>
1429
1430 Available options are: I<amount>, I<reasonnum>, I<paynum>, I<paydate>
1431
1432 Most gateways require a reference to an original payment transaction to refund,
1433 so you probably need to specify a I<paynum>.
1434
1435 I<amount> defaults to the original amount of the payment if not specified.
1436
1437 I<reasonnum> specified an existing refund reason for the refund
1438
1439 I<paydate> specifies the expiration date for a credit card overriding the
1440 value from the customer record or the payment record. Specified as yyyy-mm-dd
1441
1442 Implementation note: If I<amount> is unspecified or equal to the amount of the
1443 orignal payment, first an attempt is made to "void" the transaction via
1444 the gateway (to cancel a not-yet settled transaction) and then if that fails,
1445 the normal attempt is made to "refund" ("credit") the transaction via the
1446 gateway is attempted. No attempt to "void" the transaction is made if the
1447 gateway has introspection data and doesn't support void.
1448
1449 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
1450 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
1451 #if set, will override the value from the customer record.
1452
1453 #If an I<invnum> is specified, this payment (if successful) is applied to the
1454 #specified invoice.  If you don't specify an I<invnum> you might want to
1455 #call the B<apply_payments> method.
1456
1457 =cut
1458
1459 #some false laziness w/realtime_bop, not enough to make it worth merging
1460 #but some useful small subs should be pulled out
1461 sub realtime_refund_bop {
1462   my $self = shift;
1463
1464   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1465
1466   my %options = ();
1467   if (ref($_[0]) eq 'HASH') {
1468     %options = %{$_[0]};
1469   } else {
1470     my $method = shift;
1471     %options = @_;
1472     $options{method} = $method;
1473   }
1474
1475   if ( $DEBUG ) {
1476     warn "$me realtime_refund_bop (new): $options{method} refund\n";
1477     warn "  $_ => $options{$_}\n" foreach keys %options;
1478   }
1479
1480   return "No reason specified" unless $options{'reasonnum'} =~ /^\d+$/;
1481
1482   my %content = ();
1483
1484   ###
1485   # look up the original payment and optionally a gateway for that payment
1486   ###
1487
1488   my $cust_pay = '';
1489   my $amount = $options{'amount'};
1490
1491   my( $processor, $login, $password, @bop_options, $namespace ) ;
1492   my( $auth, $order_number ) = ( '', '', '' );
1493   my $gatewaynum = '';
1494
1495   if ( $options{'paynum'} ) {
1496
1497     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
1498     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
1499       or return "Unknown paynum $options{'paynum'}";
1500     $amount ||= $cust_pay->paid;
1501
1502     my @cust_bill_pay = qsearch('cust_bill_pay', { paynum=>$cust_pay->paynum });
1503     $content{'invoice_number'} = $cust_bill_pay[0]->invnum if @cust_bill_pay;
1504
1505     if ( $cust_pay->get('processor') ) {
1506       ($gatewaynum, $processor, $auth, $order_number) =
1507       (
1508         $cust_pay->gatewaynum,
1509         $cust_pay->processor,
1510         $cust_pay->auth,
1511         $cust_pay->order_number,
1512       );
1513     } else {
1514       # this payment wasn't upgraded, which probably means this won't work,
1515       # but try it anyway
1516       $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
1517         or return "Can't parse paybatch for paynum $options{'paynum'}: ".
1518                   $cust_pay->paybatch;
1519       ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
1520     }
1521
1522     my $payment_gateway;
1523     if ( $gatewaynum ) { #gateway for the payment to be refunded
1524
1525       $payment_gateway =
1526         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
1527       die "payment gateway $gatewaynum not found"
1528         unless $payment_gateway;
1529
1530       $processor   = $payment_gateway->gateway_module;
1531       $login       = $payment_gateway->gateway_username;
1532       $password    = $payment_gateway->gateway_password;
1533       $namespace   = $payment_gateway->gateway_namespace;
1534       @bop_options = $payment_gateway->options;
1535
1536     } else { #try the default gateway
1537
1538       my $conf_processor;
1539       $payment_gateway =
1540         $self->agent->payment_gateway('method' => $options{method});
1541
1542       ( $conf_processor, $login, $password, $namespace ) =
1543         map { my $method = "gateway_$_"; $payment_gateway->$method }
1544           qw( module username password namespace );
1545
1546       @bop_options = $payment_gateway->gatewaynum
1547                        ? $payment_gateway->options
1548                        : @{ $payment_gateway->get('options') };
1549       my %bop_options = @bop_options;
1550
1551       return "processor of payment $options{'paynum'} $processor does not".
1552              " match default processor $conf_processor"
1553         unless ($processor eq $conf_processor)
1554             || (($conf_processor eq 'CardFortress') && ($processor eq $bop_options{'gateway'}));
1555
1556       $processor = $conf_processor;
1557
1558     }
1559
1560     # if gateway has switched to CardFortress but token_check hasn't run yet,
1561     # tokenize just this record now, so that token gets passed/set appropriately
1562     if ($cust_pay->payby eq 'CARD' && !$cust_pay->tokenized) {
1563       my %tokenopts = (
1564         'payment_gateway' => $payment_gateway,
1565         'method'          => 'CC',
1566         'payinfo'         => $cust_pay->payinfo,
1567         'paydate'         => $cust_pay->paydate,
1568       );
1569       my $error = $self->realtime_tokenize(\%tokenopts); # no-op unless gateway can tokenize
1570       if ($self->tokenized($tokenopts{'payinfo'})) { # implies no error
1571         warn "  tokenizing cust_pay\n" if $DEBUG > 1;
1572         $cust_pay->payinfo($tokenopts{'payinfo'});
1573         $error = $cust_pay->replace;
1574       }
1575       return $error if $error;
1576     }
1577
1578   } else { # didn't specify a paynum, so look for agent gateway overrides
1579            # like a normal transaction
1580
1581     my $payment_gateway =
1582       $self->agent->payment_gateway( 'method'  => $options{method} );
1583     ( $processor, $login, $password, $namespace ) =
1584       map { my $method = "gateway_$_"; $payment_gateway->$method }
1585         qw( module username password namespace );
1586
1587     my @bop_options = $payment_gateway->gatewaynum
1588                         ? $payment_gateway->options
1589                         : @{ $payment_gateway->get('options') };
1590
1591   }
1592   return "neither amount nor paynum specified" unless $amount;
1593
1594   eval "use $namespace";
1595   die $@ if $@;
1596
1597   %content = (
1598     %content,
1599     'type'           => $options{method},
1600     'login'          => $login,
1601     'password'       => $password,
1602     'order_number'   => $order_number,
1603     'amount'         => $amount,
1604   );
1605   $content{authorization} = $auth
1606     if length($auth); #echeck/ACH transactions have an order # but no auth
1607                       #(at least with authorize.net)
1608
1609   my $currency =    $conf->exists('business-onlinepayment-currency')
1610                  && $conf->config('business-onlinepayment-currency');
1611   $content{currency} = $currency if $currency;
1612
1613   my $disable_void_after;
1614   if ($conf->exists('disable_void_after')
1615       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
1616     $disable_void_after = $1;
1617   }
1618
1619   #first try void if applicable
1620   my $void = new Business::OnlinePayment( $processor, @bop_options );
1621
1622   my $tryvoid = 1;
1623   if ($void->can('info')) {
1624       my $paytype = '';
1625       $paytype = 'ECHECK' if $cust_pay && $cust_pay->payby eq 'CHEK';
1626       $paytype = 'CC' if $cust_pay && $cust_pay->payby eq 'CARD';
1627       my %supported_actions = $void->info('supported_actions');
1628       $tryvoid = 0
1629         if ( %supported_actions && $paytype
1630                 && defined($supported_actions{$paytype})
1631                 && !grep{ $_ eq 'Void' } @{$supported_actions{$paytype}} );
1632   }
1633
1634   if ( $cust_pay && $cust_pay->paid == $amount
1635     && (
1636       ( not defined($disable_void_after) )
1637       || ( time < ($cust_pay->_date + $disable_void_after ) )
1638     )
1639     && $tryvoid
1640   ) {
1641     warn "  attempting void\n" if $DEBUG > 1;
1642     if ( $void->can('info') ) {
1643       if ( $cust_pay->payby eq 'CARD'
1644            && $void->info('CC_void_requires_card') )
1645       {
1646         $content{'card_number'} = $cust_pay->payinfo;
1647       } elsif ( $cust_pay->payby eq 'CHEK'
1648                 && $void->info('ECHECK_void_requires_account') )
1649       {
1650         ( $content{'account_number'}, $content{'routing_code'} ) =
1651           split('@', $cust_pay->payinfo);
1652         $content{'name'} = $self->get('first'). ' '. $self->get('last');
1653       }
1654     }
1655     $void->content( 'action' => 'void', %content );
1656     $void->test_transaction(1)
1657       if $conf->exists('business-onlinepayment-test_transaction');
1658     $void->submit();
1659     if ( $void->is_success ) {
1660       # specified as a refund reason, but now we want a payment void reason
1661       # extract just the reason text, let cust_pay::void handle new_or_existing
1662       my $reason = qsearchs('reason',{ 'reasonnum' => $options{'reasonnum'} });
1663       my $error;
1664       $error = 'Reason could not be loaded' unless $reason;
1665       $error = $cust_pay->void($reason->reason) unless $error;
1666       if ( $error ) {
1667         # gah, even with transactions.
1668         my $e = 'WARNING: Card/ACH voided but database not updated - '.
1669                 "error voiding payment: $error";
1670         warn $e;
1671         return $e;
1672       }
1673       warn "  void successful\n" if $DEBUG > 1;
1674       return '';
1675     }
1676   }
1677
1678   warn "  void unsuccessful, trying refund\n"
1679     if $DEBUG > 1;
1680
1681   #massage data
1682   my $address = $self->address1;
1683   $address .= ", ". $self->address2 if $self->address2;
1684
1685   my($payname, $payfirst, $paylast);
1686   if ( $self->payname && $options{method} ne 'ECHECK' ) {
1687     $payname = $self->payname;
1688     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
1689       or return "Illegal payname $payname";
1690     ($payfirst, $paylast) = ($1, $2);
1691   } else {
1692     $payfirst = $self->getfield('first');
1693     $paylast = $self->getfield('last');
1694     $payname =  "$payfirst $paylast";
1695   }
1696
1697   my @invoicing_list = $self->invoicing_list_emailonly;
1698   if ( $conf->exists('emailinvoiceautoalways')
1699        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
1700        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1701     push @invoicing_list, $self->all_emails;
1702   }
1703
1704   my $email = ($conf->exists('business-onlinepayment-email-override'))
1705               ? $conf->config('business-onlinepayment-email-override')
1706               : $invoicing_list[0];
1707
1708   my $payip = exists($options{'payip'})
1709                 ? $options{'payip'}
1710                 : $self->payip;
1711   $content{customer_ip} = $payip
1712     if length($payip);
1713
1714   my $payinfo = '';
1715   my $paymask = ''; # for refund record
1716   if ( $options{method} eq 'CC' ) {
1717
1718     if ( $cust_pay ) {
1719       $content{card_number} = $payinfo = $cust_pay->payinfo;
1720       $paymask = $cust_pay->paymask;
1721       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
1722         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
1723         ($content{expiration} = "$2/$1");  # where available
1724     } else {
1725       # this really needs a better cleanup
1726       die "Refund without paynum not supported";
1727 #      $content{card_number} = $payinfo = $self->payinfo;
1728 #      (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
1729 #        =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1730 #      $content{expiration} = "$2/$1";
1731     }
1732
1733   } elsif ( $options{method} eq 'ECHECK' ) {
1734
1735     if ( $cust_pay ) {
1736       $payinfo = $cust_pay->payinfo;
1737     } else {
1738       $payinfo = $self->payinfo;
1739     }
1740     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
1741     $content{bank_name} = $self->payname;
1742     $content{account_type} = 'CHECKING';
1743     $content{account_name} = $payname;
1744     $content{customer_org} = $self->company ? 'B' : 'I';
1745     $content{customer_ssn} = $self->ss;
1746
1747   }
1748
1749   #then try refund
1750   my $refund = new Business::OnlinePayment( $processor, @bop_options );
1751   my %sub_content = $refund->content(
1752     'action'         => 'credit',
1753     'customer_id'    => $self->custnum,
1754     'last_name'      => $paylast,
1755     'first_name'     => $payfirst,
1756     'name'           => $payname,
1757     'address'        => $address,
1758     'city'           => $self->city,
1759     'state'          => $self->state,
1760     'zip'            => $self->zip,
1761     'country'        => $self->country,
1762     'email'          => $email,
1763     'phone'          => $self->daytime || $self->night,
1764     %content, #after
1765   );
1766   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
1767     if $DEBUG > 1;
1768   $refund->test_transaction(1)
1769     if $conf->exists('business-onlinepayment-test_transaction');
1770   $refund->submit();
1771
1772   return "$processor error: ". $refund->error_message
1773     unless $refund->is_success();
1774
1775   $order_number = $refund->order_number if $refund->can('order_number');
1776
1777   # change this to just use $cust_pay->delete_cust_bill_pay?
1778   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
1779     my @cust_bill_pay = $cust_pay->cust_bill_pay;
1780     last unless @cust_bill_pay;
1781     my $cust_bill_pay = pop @cust_bill_pay;
1782     my $error = $cust_bill_pay->delete;
1783     last if $error;
1784   }
1785
1786   my $cust_refund = new FS::cust_refund ( {
1787     'custnum'  => $self->custnum,
1788     'paynum'   => $options{'paynum'},
1789     'source_paynum' => $options{'paynum'},
1790     'refund'   => $amount,
1791     '_date'    => '',
1792     'payby'    => $bop_method2payby{$options{method}},
1793     'payinfo'  => $payinfo,
1794     'paymask'  => $paymask,
1795     'reasonnum'     => $options{'reasonnum'},
1796     'gatewaynum'    => $gatewaynum, # may be null
1797     'processor'     => $processor,
1798     'auth'          => $refund->authorization,
1799     'order_number'  => $order_number,
1800   } );
1801   my $error = $cust_refund->insert;
1802   if ( $error ) {
1803     $cust_refund->paynum(''); #try again with no specific paynum
1804     $cust_refund->source_paynum('');
1805     my $error2 = $cust_refund->insert;
1806     if ( $error2 ) {
1807       # gah, even with transactions.
1808       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
1809               "error inserting refund ($processor): $error2".
1810               " (previously tried insert with paynum #$options{'paynum'}" .
1811               ": $error )";
1812       warn $e;
1813       return $e;
1814     }
1815   }
1816
1817   ''; #no error
1818
1819 }
1820
1821 =item realtime_verify_bop [ OPTION => VALUE ... ]
1822
1823 Runs an authorization-only transaction for $1 against this credit card (if
1824 successful, immediatly reverses the authorization).
1825
1826 Returns the empty string if the authorization was sucessful, or an error
1827 message otherwise.
1828
1829 Option I<cust_payby> should be passed, even if it's not yet been inserted.
1830 Object will be tokenized if possible, but that change will not be
1831 updated in database (must be inserted/replaced afterwards.)
1832
1833 Currently only succeeds for Business::OnlinePayment CC transactions.
1834
1835 =cut
1836
1837 #some false laziness w/realtime_bop and realtime_refund_bop, not enough to make
1838 #it worth merging but some useful small subs should be pulled out
1839 sub realtime_verify_bop {
1840   my $self = shift;
1841
1842   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1843   my $log = FS::Log->new('FS::cust_main::Billing_Realtime::realtime_verify_bop');
1844
1845   my %options = ();
1846   if (ref($_[0]) eq 'HASH') {
1847     %options = %{$_[0]};
1848   } else {
1849     %options = @_;
1850   }
1851
1852   if ( $DEBUG ) {
1853     warn "$me realtime_verify_bop\n";
1854     warn "  $_ => $options{$_}\n" foreach keys %options;
1855   }
1856
1857   # set fields from passed cust_payby
1858   return "No cust_payby" unless $options{'cust_payby'};
1859   _bop_cust_payby_options(\%options);
1860
1861   # check for banned credit card/ACH
1862   my $ban = FS::banned_pay->ban_search(
1863     'payby'   => $bop_method2payby{'CC'},
1864     'payinfo' => $options{payinfo},
1865   );
1866   return "Banned credit card" if $ban && $ban->bantype ne 'warn';
1867
1868   # possibly run a separate transaction to tokenize card number,
1869   #   so that we never store tokenized card info in cust_pay_pending
1870   if (($options{method} eq 'CC') && !$self->tokenized($options{'payinfo'})) {
1871     my $token_error = $self->realtime_tokenize(\%options);
1872     return $token_error if $token_error;
1873     #important that we not replace cust_payby here,
1874     #because cust_payby->replace uses realtime_verify_bop!
1875   }
1876
1877   ###
1878   # select a gateway
1879   ###
1880
1881   my $payment_gateway =  $self->_payment_gateway( \%options );
1882   my $namespace = $payment_gateway->gateway_namespace;
1883
1884   eval "use $namespace";
1885   die $@ if $@;
1886
1887   ###
1888   # massage data
1889   ###
1890
1891   my $bop_content = $self->_bop_content(\%options);
1892   return $bop_content unless ref($bop_content);
1893
1894   my @invoicing_list = $self->invoicing_list_emailonly;
1895   if ( $conf->exists('emailinvoiceautoalways')
1896        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
1897        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
1898     push @invoicing_list, $self->all_emails;
1899   }
1900
1901   my $email = ($conf->exists('business-onlinepayment-email-override'))
1902               ? $conf->config('business-onlinepayment-email-override')
1903               : $invoicing_list[0];
1904
1905   my $paydate = '';
1906   my %content = ();
1907
1908   if ( $namespace eq 'Business::OnlinePayment' ) {
1909
1910     if ( $options{method} eq 'CC' ) {
1911
1912       $content{card_number} = $options{payinfo};
1913       $paydate = $options{'paydate'};
1914       $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
1915       $content{expiration} = "$2/$1";
1916
1917       $content{cvv2} = $options{'paycvv'}
1918         if length($options{'paycvv'});
1919
1920       my $paystart_month = $options{'paystart_month'};
1921       my $paystart_year  = $options{'paystart_year'};
1922
1923       $content{card_start} = "$paystart_month/$paystart_year"
1924         if $paystart_month && $paystart_year;
1925
1926       my $payissue       = $options{'payissue'};
1927       $content{issue_number} = $payissue if $payissue;
1928
1929     } elsif ( $options{method} eq 'ECHECK' ){
1930       #cannot verify, move along (though it shouldn't be called...)
1931       return '';
1932     } else {
1933       return "unknown method ". $options{method};
1934     }
1935   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
1936     #cannot verify, move along
1937     return '';
1938   } else {
1939     return "unknown namespace $namespace";
1940   }
1941
1942   ###
1943   # run transaction(s)
1944   ###
1945
1946   my $error;
1947   my $transaction; #need this back so we can do _tokenize_card
1948
1949   # don't mutex the customer here, because they might be uncommitted. and
1950   # this is only verification. it doesn't matter if they have other
1951   # unfinished verifications.
1952
1953   my $cust_pay_pending = new FS::cust_pay_pending {
1954     'custnum_pending'   => 1,
1955     'paid'              => '1.00',
1956     '_date'             => '',
1957     'payby'             => $bop_method2payby{'CC'},
1958     'payinfo'           => $options{payinfo},
1959     'paymask'           => $options{paymask},
1960     'paydate'           => $paydate,
1961     'pkgnum'            => $options{'pkgnum'},
1962     'status'            => 'new',
1963     'gatewaynum'        => $payment_gateway->gatewaynum || '',
1964     'session_id'        => $options{session_id} || '',
1965   };
1966   $cust_pay_pending->payunique( $options{payunique} )
1967     if defined($options{payunique}) && length($options{payunique});
1968
1969   IMMEDIATE: {
1970     # open a separate handle for creating/updating the cust_pay_pending
1971     # record
1972     local $FS::UID::dbh = myconnect();
1973     local $FS::UID::AutoCommit = 1;
1974
1975     # if this is an existing customer (and we can tell now because
1976     # this is a fresh transaction), it's safe to assign their custnum
1977     # to the cust_pay_pending record, and then the verification attempt
1978     # will remain linked to them even if it fails.
1979     if ( FS::cust_main->by_key($self->custnum) ) {
1980       $cust_pay_pending->set('custnum', $self->custnum);
1981     }
1982
1983     warn "inserting cust_pay_pending record for customer ". $self->custnum. "\n"
1984       if $DEBUG > 1;
1985
1986     # if this fails, just return; everything else will still allow the
1987     # cust_pay_pending to have its custnum set later
1988     my $cpp_new_err = $cust_pay_pending->insert;
1989     return $cpp_new_err if $cpp_new_err;
1990
1991     warn "inserted cust_pay_pending record for customer ". $self->custnum. "\n"
1992       if $DEBUG > 1;
1993     warn Dumper($cust_pay_pending) if $DEBUG > 2;
1994
1995     $transaction = new $namespace( $payment_gateway->gateway_module,
1996                                    _bop_options(\%options),
1997                                     );
1998
1999     $transaction->content(
2000       'type'           => 'CC',
2001       _bop_auth(\%options),
2002       'action'         => 'Authorization Only',
2003       'description'    => $options{'description'},
2004       'amount'         => '1.00',
2005       'customer_id'    => $self->custnum,
2006       %$bop_content,
2007       'reference'      => $cust_pay_pending->paypendingnum, #for now
2008       'email'          => $email,
2009       %content, #after
2010     );
2011
2012     $cust_pay_pending->status('pending');
2013     my $cpp_pending_err = $cust_pay_pending->replace;
2014     return $cpp_pending_err if $cpp_pending_err;
2015
2016     warn Dumper($transaction) if $DEBUG > 2;
2017
2018     unless ( $BOP_TESTING ) {
2019       $transaction->test_transaction(1)
2020         if $conf->exists('business-onlinepayment-test_transaction');
2021       $transaction->submit();
2022     } else {
2023       if ( $BOP_TESTING_SUCCESS ) {
2024         $transaction->is_success(1);
2025         $transaction->authorization('fake auth');
2026       } else {
2027         $transaction->is_success(0);
2028         $transaction->error_message('fake failure');
2029       }
2030     }
2031
2032     if ( $transaction->is_success() ) {
2033
2034       $cust_pay_pending->status('authorized');
2035       my $cpp_authorized_err = $cust_pay_pending->replace;
2036       return $cpp_authorized_err if $cpp_authorized_err;
2037
2038       my $auth = $transaction->authorization;
2039       my $ordernum = $transaction->can('order_number')
2040                      ? $transaction->order_number
2041                      : '';
2042
2043       my $reverse = new $namespace( $payment_gateway->gateway_module,
2044                                     _bop_options(\%options),
2045                                   );
2046
2047       $reverse->content( 'action'        => 'Reverse Authorization',
2048                          _bop_auth(\%options),
2049
2050                          # B:OP
2051                          'amount'        => '1.00',
2052                          'authorization' => $transaction->authorization,
2053                          'order_number'  => $ordernum,
2054
2055                          # vsecure
2056                          'result_code'   => $transaction->result_code,
2057                          'txn_date'      => $transaction->txn_date,
2058
2059                          %content,
2060                        );
2061       $reverse->test_transaction(1)
2062         if $conf->exists('business-onlinepayment-test_transaction');
2063       $reverse->submit();
2064
2065       if ( $reverse->is_success ) {
2066
2067         $cust_pay_pending->status('done');
2068         $cust_pay_pending->statustext('reversed');
2069         my $cpp_reversed_err = $cust_pay_pending->replace;
2070         return $cpp_reversed_err if $cpp_reversed_err;
2071
2072       } else {
2073
2074         my $e = "Authorization successful but reversal failed, custnum #".
2075                 $self->custnum. ': '.  $reverse->result_code.
2076                 ": ". $reverse->error_message;
2077         $log->warning($e);
2078         warn $e;
2079         return $e;
2080
2081       }
2082
2083       ### Address Verification ###
2084       #
2085       # Single-letter codes vary by cardtype.
2086       #
2087       # Erring on the side of accepting cards if avs is not available,
2088       # only rejecting if avs occurred and there's been an explicit mismatch
2089       #
2090       # Charts below taken from vSecure documentation,
2091       #    shows codes for Amex/Dscv/MC/Visa
2092       #
2093       # ACCEPTABLE AVS RESPONSES:
2094       # Both Address and 5-digit postal code match Y A Y Y
2095       # Both address and 9-digit postal code match Y A X Y
2096       # United Kingdom – Address and postal code match _ _ _ F
2097       # International transaction – Address and postal code match _ _ _ D/M
2098       #
2099       # ACCEPTABLE, BUT ISSUE A WARNING:
2100       # Ineligible transaction; or message contains a content error _ _ _ E
2101       # System unavailable; retry R U R R
2102       # Information unavailable U W U U
2103       # Issuer does not support AVS S U S S
2104       # AVS is not applicable _ _ _ S
2105       # Incompatible formats – Not verified _ _ _ C
2106       # Incompatible formats – Address not verified; postal code matches _ _ _ P
2107       # International transaction – address not verified _ G _ G/I
2108       #
2109       # UNACCEPTABLE AVS RESPONSES:
2110       # Only Address matches A Y A A
2111       # Only 5-digit postal code matches Z Z Z Z
2112       # Only 9-digit postal code matches Z Z W W
2113       # Neither address nor postal code matches N N N N
2114
2115       if (my $avscode = uc($transaction->avs_code)) {
2116
2117         # map codes to accept/warn/reject
2118         my $avs = {
2119           'American Express card' => {
2120             'A' => 'r',
2121             'N' => 'r',
2122             'R' => 'w',
2123             'S' => 'w',
2124             'U' => 'w',
2125             'Y' => 'a',
2126             'Z' => 'r',
2127           },
2128           'Discover card' => {
2129             'A' => 'a',
2130             'G' => 'w',
2131             'N' => 'r',
2132             'U' => 'w',
2133             'W' => 'w',
2134             'Y' => 'r',
2135             'Z' => 'r',
2136           },
2137           'MasterCard' => {
2138             'A' => 'r',
2139             'N' => 'r',
2140             'R' => 'w',
2141             'S' => 'w',
2142             'U' => 'w',
2143             'W' => 'r',
2144             'X' => 'a',
2145             'Y' => 'a',
2146             'Z' => 'r',
2147           },
2148           'VISA card' => {
2149             'A' => 'r',
2150             'C' => 'w',
2151             'D' => 'a',
2152             'E' => 'w',
2153             'F' => 'a',
2154             'G' => 'w',
2155             'I' => 'w',
2156             'M' => 'a',
2157             'N' => 'r',
2158             'P' => 'w',
2159             'R' => 'w',
2160             'S' => 'w',
2161             'U' => 'w',
2162             'W' => 'r',
2163             'Y' => 'a',
2164             'Z' => 'r',
2165           },
2166         };
2167         my $cardtype = cardtype($content{card_number});
2168         if ($avs->{$cardtype}) {
2169           my $avsact = $avs->{$cardtype}->{$avscode};
2170           my $warning = '';
2171           if ($avsact eq 'r') {
2172             return "AVS code verification failed, cardtype $cardtype, code $avscode";
2173           } elsif ($avsact eq 'w') {
2174             $warning = "AVS did not occur, cardtype $cardtype, code $avscode";
2175           } elsif (!$avsact) {
2176             $warning = "AVS code unknown, cardtype $cardtype, code $avscode";
2177           } # else $avsact eq 'a'
2178           if ($warning) {
2179             $log->warning($warning);
2180             warn $warning;
2181           }
2182         } # else $cardtype avs handling not implemented
2183       } # else !$transaction->avs_code
2184
2185     } else { # is not success
2186
2187       # status is 'done' not 'declined', as in _realtime_bop_result
2188       $cust_pay_pending->status('done');
2189       $error = $transaction->error_message || 'Unknown error';
2190       $cust_pay_pending->statustext($error);
2191       # could also record failure_status here,
2192       #   but it's not supported by B::OP::vSecureProcessing...
2193       #   need a B::OP module with (reverse) auth only to test it with
2194       my $cpp_declined_err = $cust_pay_pending->replace;
2195       return $cpp_declined_err if $cpp_declined_err;
2196
2197     }
2198
2199   } # end of IMMEDIATE; we now have our $error and $transaction
2200
2201   ###
2202   # Save the custnum (as part of the main transaction, so it can reference
2203   # the cust_main)
2204   ###
2205
2206   if (!$cust_pay_pending->custnum) {
2207     $cust_pay_pending->set('custnum', $self->custnum);
2208     my $set_custnum_err = $cust_pay_pending->replace;
2209     if ($set_custnum_err) {
2210       $log->error($set_custnum_err);
2211       $error ||= $set_custnum_err;
2212       # but if there was a real verification error also, return that one
2213     }
2214   }
2215
2216   ###
2217   # remove paycvv here?  need to find out if a reversed auth
2218   #   counts as an initial transaction for paycvv retention requirements
2219   ###
2220
2221   ###
2222   # Tokenize
2223   ###
2224
2225   # This block will only run if the B::OP module supports card_token but not the Tokenize transaction;
2226   #   if that never happens, we should get rid of it (as it has the potential to store real card numbers on error)
2227   if (my $card_token = $self->_tokenize_card($transaction,\%options)) {
2228     $cust_pay_pending->payinfo($card_token);
2229     my $cpp_token_err = $cust_pay_pending->replace;
2230     #this leaves real card number in cust_pay_pending, but can't do much else if cpp won't replace
2231     return $cpp_token_err if $cpp_token_err;
2232     #important that we not replace cust_payby here,
2233     #because cust_payby->replace uses realtime_verify_bop!
2234   }
2235
2236   ###
2237   # result handling
2238   ###
2239
2240   # $error contains the transaction error_message, if is_success was false.
2241
2242   return $error;
2243
2244 }
2245
2246 =item realtime_tokenize [ OPTION => VALUE ... ]
2247
2248 If possible and necessary, runs a tokenize transaction.
2249 In order to be possible, a credit card cust_payby record
2250 must be passed and a Business::OnlinePayment gateway capable
2251 of Tokenize transactions must be configured for this user.
2252 Is only necessary if payinfo is not yet tokenized.
2253
2254 Returns the empty string if the authorization was sucessful
2255 or was not possible/necessary (thus allowing this to be safely called with
2256 non-tokenizable records/gateways, without having to perform separate tests),
2257 or an error message otherwise.
2258
2259 Option I<cust_payby> may be passed, even if it's not yet been inserted.
2260 Object will be tokenized if possible, but that change will not be
2261 updated in database (must be inserted/replaced afterwards.)
2262
2263 Otherwise, options I<method>, I<payinfo> and other cust_payby fields
2264 may be passed.  If options are passed as a hashref, I<payinfo>
2265 will be updated as appropriate in the passed hashref.
2266
2267 Can be run as a class method if option I<payment_gateway> is passed,
2268 but default customer id/name/phone can't be set in that case.  This
2269 is really only intended for tokenizing old records on upgrade.
2270
2271 =cut
2272
2273 # careful--might be run as a class method
2274 sub realtime_tokenize {
2275   my $self = shift;
2276
2277   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2278   my $log = FS::Log->new('FS::cust_main::Billing_Realtime::realtime_tokenize');
2279
2280   my %options = ();
2281   my $outoptions; #for returning cust_payby/payinfo
2282   if (ref($_[0]) eq 'HASH') {
2283     %options = %{$_[0]};
2284     $outoptions = $_[0];
2285   } else {
2286     %options = @_;
2287     $outoptions = \%options;
2288   }
2289
2290   # set fields from passed cust_payby
2291   _bop_cust_payby_options(\%options);
2292   return '' unless $options{method} eq 'CC';
2293   return '' if $self->tokenized($options{payinfo}); #already tokenized
2294
2295   # check for banned credit card/ACH
2296   my $ban = FS::banned_pay->ban_search(
2297     'payby'   => $bop_method2payby{'CC'},
2298     'payinfo' => $options{payinfo},
2299   );
2300   return "Banned credit card" if $ban && $ban->bantype ne 'warn';
2301
2302   ###
2303   # select a gateway
2304   ###
2305
2306   $options{'nofatal'} = 1;
2307   my $payment_gateway =  $self->_payment_gateway( \%options );
2308   return '' unless $payment_gateway;
2309   my $namespace = $payment_gateway->gateway_namespace;
2310   return '' unless $namespace eq 'Business::OnlinePayment';
2311
2312   eval "use $namespace";
2313   return $@ if $@;
2314
2315   ###
2316   # check for tokenize ability
2317   ###
2318
2319   my $transaction = new $namespace( $payment_gateway->gateway_module,
2320                                     _bop_options(\%options),
2321                                   );
2322
2323   return '' unless $transaction->can('info');
2324
2325   my %supported_actions = $transaction->info('supported_actions');
2326   return '' unless $supported_actions{'CC'} and grep(/^Tokenize$/,@{$supported_actions{'CC'}});
2327
2328   ###
2329   # massage data
2330   ###
2331
2332   ### Currently, cardfortress only keys in on card number and exp date.
2333   ### We pass everything we'd pass to a normal transaction,
2334   ### for ease of current and future development,
2335   ### but note, when tokenizing old records, we may only have access to payinfo/paydate
2336
2337   my $bop_content = $self->_bop_content(\%options);
2338   return $bop_content unless ref($bop_content);
2339
2340   my $paydate = '';
2341   my %content = ();
2342
2343   $content{card_number} = $options{payinfo};
2344   $paydate = $options{'paydate'};
2345   $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
2346   $content{expiration} = "$2/$1";
2347
2348   $content{cvv2} = $options{'paycvv'}
2349     if length($options{'paycvv'});
2350
2351   my $paystart_month = $options{'paystart_month'};
2352   my $paystart_year  = $options{'paystart_year'};
2353
2354   $content{card_start} = "$paystart_month/$paystart_year"
2355     if $paystart_month && $paystart_year;
2356
2357   my $payissue       = $options{'payissue'};
2358   $content{issue_number} = $payissue if $payissue;
2359
2360   $content{customer_id} = $self->custnum
2361     if ref($self);
2362
2363   ###
2364   # run transaction
2365   ###
2366
2367   my $error;
2368
2369   # no cust_pay_pending---this is not a financial transaction
2370
2371   $transaction->content(
2372     'type'           => 'CC',
2373     _bop_auth(\%options),
2374     'action'         => 'Tokenize',
2375     'description'    => $options{'description'},
2376     %$bop_content,
2377     %content, #after
2378   );
2379
2380   # no $BOP_TESTING handling for this
2381   $transaction->test_transaction(1)
2382     if $conf->exists('business-onlinepayment-test_transaction');
2383   $transaction->submit();
2384
2385   if ( $transaction->card_token() ) { # no is_success flag
2386
2387     # realtime_tokenize should not clear paycvv at this time.  it might be
2388     # needed for the first transaction, and a tokenize isn't actually a
2389     # transaction that hits the gateway.  at some point in the future, card
2390     # fortress should take on the "store paycvv until first transaction"
2391     # functionality and we should fix this in freeside, but i that's a bigger
2392     # project for another time.
2393
2394     #important that we not replace cust_payby here,
2395     #because cust_payby->replace uses realtime_tokenize!
2396     $self->_tokenize_card($transaction,$outoptions);
2397
2398   } else {
2399
2400     $error = $transaction->error_message || 'Unknown error when tokenizing card';
2401
2402   }
2403
2404   return $error;
2405
2406 }
2407
2408
2409 =item tokenized PAYINFO
2410
2411 Convenience wrapper for L<FS::payinfo_Mixin/tokenized>
2412
2413 PAYINFO is required.
2414
2415 Can be run as class or object method, never loads from object.
2416
2417 =cut
2418
2419 sub tokenized {
2420   my $this = shift;
2421   my $payinfo = shift;
2422   FS::cust_pay->tokenized($payinfo);
2423 }
2424
2425 =item token_check [ quiet => 1, queue => 1, daily => 1 ]
2426
2427 NOT A METHOD.  Acts on all customers.  Placed here because it makes
2428 use of module-internal methods, and to keep everything that uses
2429 Billing::OnlinePayment all in one place.
2430
2431 Tokenizes all tokenizable card numbers from payinfo in cust_payby and
2432 CARD transactions in cust_pay_pending, cust_pay, cust_pay_void and cust_refund.
2433
2434 If the I<queue> flag is set, newly tokenized records will be immediately
2435 committed, regardless of AutoCommit, so as to release the mutex on the record.
2436
2437 If all configured gateways have the ability to tokenize, detection of an
2438 untokenizable record will cause a fatal error.  However, if the I<queue> flag
2439 is set, this will instead cause a critical error to be recorded in the log,
2440 and any other tokenizable records will still be committed.
2441
2442 If the I<daily> flag is also set, detection of existing untokenized records will
2443 record an info message in the system log (because they should have never appeared
2444 in the first place.)  Tokenization will still be attempted.
2445
2446 If any configured gateways do NOT have the ability to tokenize, or if a
2447 default gateway is not configured, then untokenized records are not considered
2448 a threat, and no critical errors will be generated in the log.
2449
2450 =cut
2451
2452 sub token_check {
2453   #acts on all customers
2454   my %opt = @_;
2455   my $debug = !$opt{'quiet'} || $DEBUG;
2456   my $hascritical = 0;
2457
2458   warn "token_check called with opts\n".Dumper(\%opt) if $debug;
2459
2460   # force some explicitness when invoking this method
2461   die "token_check must run with queue flag if run with daily flag"
2462     if $opt{'daily'} && !$opt{'queue'};
2463
2464   my $conf = FS::Conf->new;
2465
2466   my $log = FS::Log->new('FS::cust_main::Billing_Realtime::token_check');
2467
2468   my $cache = {}; #cache for module info
2469
2470   # look for a gateway that can and can't tokenize
2471   my $require_tokenized = 1;
2472   my $someone_tokenizing = 0;
2473   foreach my $gateway (
2474     FS::payment_gateway->all_gateways(
2475       'method'  => 'CC',
2476       'conf'    => $conf,
2477       'nofatal' => 1,
2478     )
2479   ) {
2480     if (!$gateway) {
2481       # no default gateway, no promise to tokenize
2482       # can just load other gateways as-needeed below
2483       $require_tokenized = 0;
2484       last if $someone_tokenizing;
2485       next;
2486     }
2487     my $info = _token_check_gateway_info($cache,$gateway);
2488     die $info unless ref($info); # means it's an error message
2489     if ($info->{'can_tokenize'}) {
2490       $someone_tokenizing = 1;
2491     } else {
2492       # a configured gateway can't tokenize, that's all we need to know right now
2493       # can just load other gateways as-needeed below
2494       $require_tokenized = 0;
2495       last if $someone_tokenizing;
2496     }
2497   }
2498
2499   unless ($someone_tokenizing) { #no need to check, if no one can tokenize
2500     warn "no gateways tokenize\n" if $debug;
2501     return;
2502   }
2503
2504   warn "REQUIRE TOKENIZED" if $require_tokenized && $debug;
2505
2506   # upgrade does not call this with autocommit turned on,
2507   # and autocommit will be ignored if opt queue is set,
2508   # but might as well be thorough...
2509   my $oldAutoCommit = $FS::UID::AutoCommit;
2510   local $FS::UID::AutoCommit = 0;
2511   my $dbh = dbh;
2512
2513   # for retrieving data in chunks
2514   my $step = 500;
2515   my $offset = 0;
2516
2517   ### Tokenize cust_payby
2518
2519   my @recnums;
2520
2521 CUSTLOOP:
2522   while (my $custnum = _token_check_next_recnum($dbh,'cust_main',$step,\$offset,\@recnums)) {
2523     my $cust_main = FS::cust_main->by_key($custnum);
2524     my $payment_gateway;
2525     foreach my $cust_payby ($cust_main->cust_payby('CARD','DCRD')) {
2526
2527       # see if it's already tokenized
2528       if ($cust_payby->tokenized) {
2529         warn "cust_payby ".$cust_payby->get($cust_payby->primary_key)." already tokenized" if $debug;
2530         next;
2531       }
2532
2533       if ($require_tokenized && $opt{'daily'}) {
2534         $log->info("Untokenized card number detected in cust_payby ".$cust_payby->custpaybynum. '; tokenizing');
2535         $dbh->commit or die $dbh->errstr; # commit log message
2536       }
2537
2538       # only load gateway if we need to, and only need to load it once
2539       $payment_gateway ||= $cust_main->_payment_gateway({
2540         'method'  => 'CC',
2541         'conf'    => $conf,
2542         'nofatal' => 1, # handle lack of gateway smoothly below
2543       });
2544       unless ($payment_gateway) {
2545         # no reason to have untokenized card numbers saved if no gateway,
2546         #   but only a problem if we expected everyone to tokenize card numbers
2547         unless ($require_tokenized) {
2548           warn "Skipping cust_payby for cust_main ".$cust_main->custnum.", no payment gateway" if $debug;
2549           next CUSTLOOP; # can skip rest of customer
2550         }
2551         my $error = "No gateway found for custnum ".$cust_main->custnum;
2552         if ($opt{'queue'}) {
2553           $hascritical = 1;
2554           $log->critical($error);
2555           $dbh->commit or die $dbh->errstr; # commit error message
2556           next; # not next CUSTLOOP, want to record error for every cust_payby
2557         }
2558         $dbh->rollback if $oldAutoCommit;
2559         die $error;
2560       }
2561
2562       my $info = _token_check_gateway_info($cache,$payment_gateway);
2563       unless (ref($info)) {
2564         # only throws error if Business::OnlinePayment won't load,
2565         #   which is just cause to abort this whole process, even if queue
2566         $dbh->rollback if $oldAutoCommit;
2567         die $info; # error message
2568       }
2569       # no fail here--a configured gateway can't tokenize, so be it
2570       unless ($info->{'can_tokenize'}) {
2571         warn "Skipping ".$cust_main->custnum." cannot tokenize" if $debug;
2572         next;
2573       }
2574
2575       # time to tokenize
2576       $cust_payby = $cust_payby->select_for_update;
2577       my %tokenopts = (
2578         'payment_gateway' => $payment_gateway,
2579         'cust_payby'      => $cust_payby,
2580       );
2581       my $error = $cust_main->realtime_tokenize(\%tokenopts);
2582       if ($cust_payby->tokenized) { # implies no error
2583         $error = $cust_payby->replace;
2584       } else {
2585         $error ||= 'Unknown error';
2586       }
2587       if ($error) {
2588         $error = "Error tokenizing cust_payby ".$cust_payby->custpaybynum.": ".$error;
2589         if ($opt{'queue'}) {
2590           $hascritical = 1;
2591           $log->critical($error);
2592           $dbh->commit or die $dbh->errstr; # commit log message, release mutex
2593           next; # not next CUSTLOOP, want to record error for every cust_payby
2594         }
2595         $dbh->rollback if $oldAutoCommit;
2596         die $error;
2597       }
2598       $dbh->commit or die $dbh->errstr if $opt{'queue'}; # release mutex
2599       warn "TOKENIZED cust_payby ".$cust_payby->get($cust_payby->primary_key) if $debug;
2600     }
2601     warn "cust_payby upgraded for custnum ".$cust_main->custnum if $debug;
2602
2603   }
2604
2605   ### Tokenize/mask transaction tables
2606
2607   # allow tokenization of closed cust_pay/cust_refund records
2608   local $FS::payinfo_Mixin::allow_closed_replace = 1;
2609
2610   # grep assistance:
2611   #   $cust_pay_pending->replace, $cust_pay->replace, $cust_pay_void->replace, $cust_refund->replace all run here
2612   foreach my $table ( qw(cust_pay_pending cust_pay cust_pay_void cust_refund) ) {
2613     warn "Checking $table" if $debug;
2614
2615     # FS::Cursor does not seem to work over multiple commits (gives cursor not found errors)
2616     # loading only record ids, then loading individual records one at a time
2617     my $tclass = 'FS::'.$table;
2618     $offset = 0;
2619     @recnums = ();
2620
2621     while (my $recnum = _token_check_next_recnum($dbh,$table,$step,\$offset,\@recnums)) {
2622       my $record = $tclass->by_key($recnum);
2623       unless ($record->payby eq 'CARD') {
2624         warn "Skipping non-card record for $table ".$record->get($record->primary_key) if $debug;
2625         next;
2626       }
2627       if (FS::cust_main::Billing_Realtime->tokenized($record->payinfo)) {
2628         warn "Skipping tokenized record for $table ".$record->get($record->primary_key) if $debug;
2629         next;
2630       }
2631       if (!$record->payinfo) { #shouldn't happen, but at least it's not a card number
2632         warn "Skipping blank payinfo for $table ".$record->get($record->primary_key) if $debug;
2633         next;
2634       }
2635       if ($record->payinfo =~ /N\/A/) { # ??? Not sure why we do this, but it's not a card number
2636         warn "Skipping NA payinfo for $table ".$record->get($record->primary_key) if $debug;
2637         next;
2638       }
2639
2640       if ($require_tokenized && $opt{'daily'}) {
2641         $log->info("Untokenized card number detected in $table ".$record->get($record->primary_key). ';tokenizing');
2642         $dbh->commit or die $dbh->errstr; # commit log message
2643       }
2644
2645       my $cust_main = $record->cust_main;
2646       if (!$cust_main) {
2647         # might happen for cust_pay_pending from failed verify records,
2648         #   in which case we attempt tokenization without cust_main
2649         # everything else should absolutely have a cust_main
2650         if ($table eq 'cust_pay_pending' and !$record->custnum ) {
2651           # override the usual safety check and allow the record to be
2652           # updated even without a custnum.
2653           $record->set('custnum_pending', 1);
2654         } else {
2655           my $error = "Could not load cust_main for $table ".$record->get($record->primary_key);
2656           if ($opt{'queue'}) {
2657             $hascritical = 1;
2658             $log->critical($error);
2659             $dbh->commit or die $dbh->errstr; # commit log message
2660             next;
2661           }
2662           $dbh->rollback if $oldAutoCommit;
2663           die $error;
2664         }
2665       }
2666
2667       my $gateway;
2668
2669       # use the gatewaynum specified by the record if possible
2670       $gateway = FS::payment_gateway->by_key_with_namespace(
2671         'gatewaynum' => $record->gatewaynum,
2672       ) if $record->gateway;
2673
2674       # otherwise use the cust agent gateway if possible (which realtime_refund_bop would do)
2675       # otherwise just use default gateway
2676       unless ($gateway) {
2677
2678         $gateway = $cust_main
2679                  ? $cust_main->agent->payment_gateway
2680                  : FS::payment_gateway->default_gateway;
2681
2682         # check for processor mismatch
2683         unless ($table eq 'cust_pay_pending') { # has no processor table
2684           if (my $processor = $record->processor) {
2685
2686             my $conf_processor = $gateway->gateway_module;
2687             my %bop_options = $gateway->gatewaynum
2688                             ? $gateway->options
2689                             : @{ $gateway->get('options') };
2690
2691             # this is the same standard used by realtime_refund_bop
2692             unless (
2693               ($processor eq $conf_processor) ||
2694               (($conf_processor eq 'CardFortress') && ($processor eq $bop_options{'gateway'}))
2695             ) {
2696
2697               # processors don't match, so refund already cannot be run on this object,
2698               # regardless of what we do now...
2699               # but unless we gotta tokenize everything, just leave well enough alone
2700               unless ($require_tokenized) {
2701                 warn "Skipping mismatched processor for $table ".$record->get($record->primary_key) if $debug;
2702                 next;
2703               }
2704               ### no error--we'll tokenize using the new gateway, just to remove stored payinfo,
2705               ### because refunds are already impossible for this record, anyway
2706
2707             } # end processor mismatch
2708
2709           } # end record has processor
2710         } # end not cust_pay_pending
2711
2712       }
2713
2714       # means no default gateway, no promise to tokenize, can skip
2715       unless ($gateway) {
2716         warn "Skipping missing gateway for $table ".$record->get($record->primary_key) if $debug;
2717         next;
2718       }
2719
2720       my $info = _token_check_gateway_info($cache,$gateway);
2721       unless (ref($info)) {
2722         # only throws error if Business::OnlinePayment won't load,
2723         #   which is just cause to abort this whole process, even if queue
2724         $dbh->rollback if $oldAutoCommit;
2725         die $info; # error message
2726       }
2727
2728       # a configured gateway can't tokenize, move along
2729       unless ($info->{'can_tokenize'}) {
2730         warn "Skipping, cannot tokenize $table ".$record->get($record->primary_key) if $debug;
2731         next;
2732       }
2733
2734       warn "ATTEMPTING GATEWAY-ONLY TOKENIZE" if $debug && !$cust_main;
2735
2736       # if we got this far, time to mutex
2737       $record->select_for_update;
2738
2739       # no clear record of name/address/etc used for transaction,
2740       # but will load name/phone/id from customer if run as an object method,
2741       # so we try that if we can
2742       my %tokenopts = (
2743         'payment_gateway' => $gateway,
2744         'method'          => 'CC',
2745         'payinfo'         => $record->payinfo,
2746         'paydate'         => $record->paydate,
2747       );
2748       my $error = $cust_main
2749                 ? $cust_main->realtime_tokenize(\%tokenopts)
2750                 : FS::cust_main::Billing_Realtime->realtime_tokenize(\%tokenopts);
2751       if (FS::cust_main::Billing_Realtime->tokenized($tokenopts{'payinfo'})) { # implies no error
2752         $record->payinfo($tokenopts{'payinfo'});
2753         $error = $record->replace;
2754       } else {
2755         $error ||= 'Unknown error';
2756       }
2757       if ($error) {
2758         $error = "Error tokenizing $table ".$record->get($record->primary_key).": ".$error;
2759         if ($opt{'queue'}) {
2760           $hascritical = 1;
2761           $log->critical($error);
2762           $dbh->commit or die $dbh->errstr; # commit log message, release mutex
2763           next;
2764         }
2765         $dbh->rollback if $oldAutoCommit;
2766         die $error;
2767       }
2768       $dbh->commit or die $dbh->errstr if $opt{'queue'}; # release mutex
2769       warn "TOKENIZED $table ".$record->get($record->primary_key) if $debug;
2770
2771     } # end record loop
2772   } # end table loop
2773
2774   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2775
2776   return $hascritical ? 'Critical errors occurred on some records, see system log' : '';
2777 }
2778
2779 # not a method!
2780 sub _token_check_next_recnum {
2781   my ($dbh,$table,$step,$offset,$recnums) = @_;
2782   my $recnum = shift @$recnums;
2783   return $recnum if $recnum;
2784   my $tclass = 'FS::'.$table;
2785   my $sth = $dbh->prepare(
2786     'SELECT '.$tclass->primary_key.
2787     ' FROM '.$table.
2788     " WHERE ( is_tokenized IS NULL OR is_tokenized = '' ) ".
2789     ' ORDER BY '.$tclass->primary_key.
2790     ' LIMIT '.$step.
2791     ' OFFSET '.$$offset
2792   ) or die $dbh->errstr;
2793   $sth->execute() or die $sth->errstr;
2794   my @recnums;
2795   while (my $rec = $sth->fetchrow_hashref) {
2796     push @$recnums, $rec->{$tclass->primary_key};
2797   }
2798   $sth->finish();
2799   $$offset += $step;
2800   return shift @$recnums;
2801 }
2802
2803 # not a method!
2804 sub _token_check_gateway_info {
2805   my ($cache,$payment_gateway) = @_;
2806
2807   return $cache->{$payment_gateway->gateway_module}
2808     if $cache->{$payment_gateway->gateway_module};
2809
2810   my $info = {};
2811   $cache->{$payment_gateway->gateway_module} = $info;
2812
2813   my $namespace = $payment_gateway->gateway_namespace;
2814   return $info unless $namespace eq 'Business::OnlinePayment';
2815   $info->{'is_bop'} = 1;
2816
2817   # only need to load this once,
2818   # don't want to load if nothing is_bop
2819   unless ($cache->{'Business::OnlinePayment'}) {
2820     eval "use $namespace";
2821     return "Error initializing Business:OnlinePayment: ".$@ if $@;
2822     $cache->{'Business::OnlinePayment'} = 1;
2823   }
2824
2825   my $transaction = new $namespace( $payment_gateway->gateway_module,
2826                                     _bop_options({ 'payment_gateway' => $payment_gateway }),
2827                                   );
2828
2829   return $info unless $transaction->can('info');
2830   $info->{'can_info'} = 1;
2831
2832   my %supported_actions = $transaction->info('supported_actions');
2833   $info->{'can_tokenize'} = 1
2834     if $supported_actions{'CC'}
2835       && grep /^Tokenize$/, @{$supported_actions{'CC'}};
2836
2837   # not using this any more, but for future reference...
2838   $info->{'void_requires_card'} = 1
2839     if $transaction->info('CC_void_requires_card');
2840
2841   return $info;
2842 }
2843
2844 =back
2845
2846 =head1 BUGS
2847
2848 =head1 SEE ALSO
2849
2850 L<FS::cust_main>, L<FS::cust_main::Billing>
2851
2852 =cut
2853
2854 1;