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