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