Correct [log type=error|debug] final newline behavior
[interchange.git] / lib / Vend / Payment / PayflowPro.pm
1 # Vend::Payment::PayflowPro - Interchange support for PayPal Payflow Pro HTTPS POST
2 #
3 # Copyright (C) 2002-2013 Interchange Development Group and others
4 # Copyright (C) 1999-2002 Red Hat, Inc.
5 #
6 # This program is distributed in the hope that it will be useful,
7 # but WITHOUT ANY WARRANTY; without even the implied warranty of
8 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9 # GNU General Public License for more details.
10 #
11 # You should have received a copy of the GNU General Public
12 # License along with this program; if not, write to the Free
13 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
14 # MA  02110-1301  USA.
15
16 package Vend::Payment::PayflowPro;
17
18 =head1 NAME
19
20 Vend::Payment::PayflowPro - Interchange support for PayPal Payflow Pro HTTPS POST and PayPal Express Checkout
21
22 =head1 SYNOPSIS
23
24     &charge=payflowpro
25
26         or
27
28     [charge mode=payflowpro param1=value1 param2=value2]
29
30 =head1 PREREQUISITES
31
32     The following Perl modules:
33        LWP
34        Crypt::SSLeay
35        HTTP::Request
36        HTTP::Headers
37
38     OpenSSL
39
40 PayPal's Payflow Pro HTTPS POST does NOT require the proprietary binary-only
41 shared library that was used for the Verisign Payflow Pro service.
42
43 =head1 DESCRIPTION
44
45 The Vend::Payment::PayflowPro module implements the payflowpro() payment routine
46 for use with Interchange.
47
48 It also allows you to accept PayPal via their Express Checkout (your
49 PayPal account must be linked to your PayPal Manager account to do so).
50
51 It is compatible on a call level with the other Interchange payment
52 modules -- in theory (and even usually in practice) you could switch
53 from a different payment module to PayflowPro with a few configuration
54 file changes.
55
56 To enable this module, place this directive in F<interchange.cfg>:
57
58     Require module Vend::Payment::PayflowPro
59
60 This I<must> be in interchange.cfg or a file included from it.
61
62 NOTE: Make sure CreditCardAuto is off (default in Interchange demos).
63
64 The mode can be named anything, but the C<gateway> parameter must be set
65 to C<payflowpro>. To make it the default payment gateway for all credit
66 card transactions in a specific catalog, you can set in F<catalog.cfg>:
67
68     Variable  MV_PAYMENT_MODE  payflowpro
69
70 It uses several of the standard settings from Interchange payment. Any time
71 we speak of a setting, it is obtained either first from the tag/call options,
72 then from an Interchange order Route named for the mode, then finally a
73 default global payment variable. For example, the C<id> parameter would
74 be specified by:
75
76     [charge mode=payflowpro id=YourPayflowProID]
77
78 or
79
80     Route payflowpro id YourPayflowProID
81
82 or with only Payflow Pro as a payment provider
83
84     Variable MV_PAYMENT_ID YourPayflowProID
85
86 The active settings are:
87
88 =over 4
89
90 =item id
91
92 Your account ID, supplied by PayPal when you sign up.
93 Global parameter is MV_PAYMENT_ID.
94
95 =item secret
96
97 Your account password, selected by you or provided by PayPal when you sign up.
98 Global parameter is MV_PAYMENT_SECRET.
99
100 =item partner
101
102 Your account partner, selected by you or provided by PayPal when you
103 sign up. Global parameter is MV_PAYMENT_PARTNER.
104
105 =item vendor
106
107 Your account vendor, selected by you or provided by PayPal when you
108 sign up. Global parameter is MV_PAYMENT_VENDOR.
109
110 =item transaction
111
112 The type of transaction to be run. Valid values are:
113
114     Interchange         Payflow Pro
115     ----------------    -----------------
116     sale                S
117     auth                A
118     credit              C
119     void                V
120     settle              D (from previous A trans)
121
122 Default is C<auth>.
123
124 =item accept_for_review
125
126 When using Fraud Protection Service, controls whether to accept orders
127 that triggered filters. Set to 1 to accept. You should also consider
128 changing the C<status> column of the transactions table to show that the
129 order was flagged. Something like this in F<etc/log_transaction>:
130
131     status: [calc]return $Session->{payment_result}{RESULT} =~ /^12[67]$/ ? 'flagged' : 'pending';[/calc]
132
133 =item check_sub
134
135 Name of a Sub or GlobalSub to be called after the result hash has been
136 received from PayPal. A reference to the modifiable result hash is
137 passed into the subroutine, and it should return true (in the Perl truth
138 sense) if its checks were successful, or false if not. The transaction type
139 is passed in as a second arg, if needed.
140
141 This can come in handy since, strangely, PayPal has no option to decline
142 a charge when AVS or CSC data come back negative.
143
144 If you want to fail based on a bad AVS check, make sure you're only
145 doing an auth -- B<not a sale>, or your customers would get charged on
146 orders that fail the AVS check and never get logged in your system!
147
148 Add the parameters like this:
149
150     Route  payflowpro  check_sub  avs_check
151
152 This is a matching sample subroutine you could put in interchange.cfg:
153
154     GlobalSub <<EOR
155     sub avs_check {
156         my ($result) = @_;
157         my ($addr, $zip) = @{$result}{qw( AVSADDR AVSZIP )};
158         return 1 if $addr eq 'Y' or $zip eq 'Y';
159         return 1 if $addr eq 'X' and $zip eq 'X';
160         return 1 if $addr !~ /\S/ and $zip !~ /\S/;
161         $result->{RESULT} = 112;
162         $result->{RESPMSG} = "The billing address you entered does not match the cardholder's billing address";
163         return 0;
164     }
165     EOR
166
167 That would work equally well as a Sub in catalog.cfg. It will succeed if
168 either the address or zip is 'Y', or if both are unknown. If it fails,
169 it sets the result code and error message in the result hash using
170 PayPal's own (otherwise unused) 112 result code, meaning C<Failed AVS
171 check>.
172
173 Of course you can use this sub to do any other post-processing you
174 want as well.
175
176 =back
177
178 B<The following are specific to PayPal Express Checkout:>
179
180 =over 4
181
182 =item returnurl
183
184 B<Required.> URL where the buyer will return to. Usually set to something like:
185
186     __SECURE_SERVER____CGI_URL__/ord/paypalgetrequest
187
188 Create the page in F<pages/ord/paypalgetrequest.html> with contents of:
189
190     [charge route="payflowpro" action="get"]
191     [if value country eq GB]
192         [value name=country set="UK" hide=1]
193     [/if]
194     [bounce href="[area href=ord/paypalcheckout]"]
195
196 also, set up F<pages/ord/paypalsetrequest.html>, with contents of:
197
198     [charge route="payflowpro" action="set"]
199
200     [if session paypal_token]
201         [bounce href="https://www.[if variable INDEV]sandbox.[/if]paypal.com/cgi-bin/webscr?cmd=_express-checkout&token=[data session paypal_token]"]
202     [else]
203         [bounce href="[area href=__CHECKOUT_PAGE__]"]
204     [/else]
205     [/if]
206
207 Then add the PayPal Checkout button to your basket page:
208
209     <a href="[area ord/paypalsetrequest]"><img src="https://www.paypal.com/en_US/i/btn/btn_xpressCheckout.gif" alt="Checkout with PayPal"></a>
210
211 Add a F<pages/ord/paypalcheckout.html> page similar to your regular
212 checout page, but you may want to disable the editing of the address
213 fields. In addition, you should remove the
214 F<include/checkout/payment_method> and
215 F<include/checout/*_browser_payment> includes, and change the final
216 C<Place Order> button to include the order profile:
217
218     [button 
219         name="mv_click"
220         text="[L]Place Order[/L]"
221         wait-text="-- [L]Wait[/L] --"
222         form=checkout
223     ]
224         mv_order_profile=paypal
225         mv_todo=submit
226     [/button]
227
228 In F<etc/log_transction>, immediately after the 
229 [elsif variable MV_PAYMENT_MODE]
230 line, look for the [charge] tag, and alter it to include the C<action>
231 parameter, like so:
232
233     [charge route="[var MV_PAYMENT_MODE]" action="[if value mv_order_profile eq paypal]do[/if]" amount="...
234
235 Add into the end of the C<[import table=transactions type=LINE continue=NOTES no-commit=1]> section of F<etc/log_transaction>:
236
237     pptransactionid: [calc]$Session->{payment_result}{TRANSACTIONID}[/calc]
238     pppaymenttype: [calc]$Session->{payment_result}{PAYMENTTYPE}[/calc]
239     pppendingreason: [calc]$Session->{payment_result}{PENDINGREASON}[/calc]
240     ppcorrelationid: [calc]$Session->{payment_result}{CORRELATIONID}[/calc]
241     pppayerstatus: [value pppayer_status]
242     ppaddressstatus: [value ppaddress_status]
243
244 and add these 6 new columns into your transactions table as type
245 varchar(256). The CorrelationID is the one you need in any dispute with
246 them. The payerstatus and addressstatus results may be useful in the
247 order fulfillment process.
248
249 Add to F<etc/profiles.order>, something like:
250
251     __NAME__                            paypal
252
253     __COMMON_ORDER_PROFILE__
254     email=required
255     email=email
256     &fatal = yes
257     &setcheck = end_profile 1
258
259     &set = mv_payment Incomplete
260
261     [if variable MV_PAYMENT_MODE]
262     [value name=mv_payment_realtime set=""]
263     &set=mv_payment PayPal ([var MV_PAYMENT_MODE])
264     &set=mv_payment_realtime 1
265     [else]
266     &set=mv_payment PayPal
267     [/else]
268     [/if]
269
270     &final = yes
271     &setcheck = end_profile 1
272     &setcheck = payment_method paypal
273
274     __END__
275
276 =item cancelurl
277
278 B<Required.> URL to go to if the buyer cancels. Usually set to your checkout page:
279
280     __SECURE_SERVER____CGI_URL__/__CHECKOUT_PAGE__
281
282 =item headerimg
283
284 URL to your custom image to show the buyer during their PayPal.com session.
285
286 =item reqconfirmshipping
287
288 This specifies that a Paypal customer must have his address 'confirmed'
289
290 =item addressoverride
291
292 This specifies that you will ship only to the address IC has on file
293 (including the name and email); your customer needs to login to IC first
294 before going to Paypal
295
296 =item use_billing_override
297
298 Sends billing address instead of shipping to PayPal (use with
299 addressoverride)
300
301 =back
302
303 B<End PayPal>
304
305 The following should rarely be used, as the supplied defaults are
306 usually correct.
307
308 =over 4
309
310 =item remap
311
312 This remaps the form variable names to the ones needed by PayPal. See
313 the C<Payment Settings> heading in the Interchange documentation for use.
314
315 =item host
316
317 The payment gateway host to use, to override the default.
318
319 =back
320
321 =head2 Troubleshooting
322
323 Try the instructions above, then enable test mode. A test order should
324 complete.
325
326 Then move to live mode and try a sale with the card number C<4111 1111
327 1111 1111> and a valid future expiration date. The sale should be denied,
328 and the reason should be in [data session payment_error].
329
330 If it doesn't work:
331
332 =over 4
333
334 =item *
335
336 Make sure you "Require"d the module in interchange.cfg:
337
338     Require module Vend::Payment::PayflowPro
339
340 =item *
341
342 Check the error logs, both catalog and global.
343
344 =item *
345
346 Make sure you set your account ID and secret properly.
347
348 =item *
349
350 Try an order, then put this code in a page:
351
352     <pre>
353     [calcn]
354         my $string = $Tag->uneval( { ref => $Session->{payment_result} });
355         $string =~ s/{/{\n/;
356         $string =~ s/,/,\n/g;
357         return $string;
358     [/calcn]
359     </pre>
360
361 That should show what happened.
362
363 =item *
364
365 If all else fails, consultants are available to help with
366 integration for a fee. You can find consultants by asking on the
367 C<interchange-biz@icdevgroup.org> mailing list.
368
369 =back
370
371 =head1 NOTE
372
373 See this URL for Payflow Pro documentation:
374     https://developer.paypal.com/webapps/developer/docs/classic/payflow/gs_payflow/
375
376 See this URL for PayPal Express Checkout documentation:
377     https://developer.paypal.com/webapps/developer/docs/classic/express-checkout/gs_expresscheckout/
378
379 There is actually nothing in the package Vend::Payment::PayflowPro.
380 It changes packages to Vend::Payment and places things there.
381
382 =head1 AUTHORS
383
384     Josh Lavin <josh@perusion.com>
385     Tom Tucker <tom@ttucker.com>
386     Mark Johnson <mark@endpoint.com>
387     Jordan Adler
388     David Christensen <david@endpoint.com>
389     Cameron Prince <cameronbprince@yahoo.com>
390     Mike Heins <mike@perusion.com>
391     Jon Jensen <jon@endpoint.com>
392
393 =cut
394
395 package Vend::Payment;
396
397 use Config;
398
399 BEGIN {
400     eval {
401         require LWP;
402         require HTTP::Request;
403         require HTTP::Headers;
404         require Crypt::SSLeay;
405     };
406     if ($@) {
407         die "Required modules for PayPal Payflow Pro HTTPS NOT found. $@\n";
408     }
409 }
410
411 sub payflowpro {
412     my ($user, $amount) = @_;
413 # Uncomment all the following lines to use the debug statement. It strips
414 # the arg of any sensitive credit card information and is safe
415 # (and recommended) to enable in production.
416 #
417 #    my $debug_user = ::uneval($user);
418 #    $debug_user =~ s{('mv_credit_card_[^']+' => ')((?:\\'|\\|[^\\']*)*)(')}{$1 . ('X' x length($2)) . $3}ge;
419 #::logDebug("payflowpro called\n" . $debug_user);
420
421     my ($opt, $secret);
422     if (ref $user) {
423         $opt = $user;
424         $user = $opt->{id} || undef;
425         $secret = $opt->{secret} || undef;
426     }
427     else {
428         $opt = {};
429     }
430     my %actual;
431     if ($opt->{actual}) {
432         %actual = %{$opt->{actual}};
433     }
434     else {
435         %actual = map_actual();
436     }
437
438     if (! $user) {
439         $user = charge_param('id')
440             or return (
441                 MStatus => 'failure-hard',
442                 MErrMsg => errmsg('No account id'),
443             );
444     }
445 #::logDebug("payflowpro user $user");
446
447     if (! $secret) {
448         $secret = charge_param('secret')
449             or return (
450                 MStatus => 'failure-hard',
451                 MErrMsg => errmsg('No account password'),
452             );
453     }
454
455     my $accept_for_review = $opt->{accept_for_review} || charge_param('accept_for_review');
456
457 #::logDebug("payflowpro OrderID: |$opt->{order_id}|");
458
459     my ($server, $port);
460     if (! $opt->{host} and charge_param('test')) {
461 #::logDebug("payflowpro: setting server to pilot/test mode");
462         $server = 'pilot-payflowpro.paypal.com';
463         $port = '443';
464     }
465     else {
466 #::logDebug("payflowpro: setting server based on options");
467         $server = $opt->{host} || 'payflowpro.paypal.com';
468         $port = $opt->{port} || '443';
469     }
470
471     my $uri = "https://$server:$port/transaction";
472 #::logDebug("payflowpro: using uri: $uri");
473
474     $actual{mv_credit_card_exp_month} =~ s/\D//g;
475     $actual{mv_credit_card_exp_month} =~ s/^0+//;
476     $actual{mv_credit_card_exp_year}  =~ s/\D//g;
477     $actual{mv_credit_card_exp_year}  =~ s/\d\d(\d\d)/$1/;
478     $actual{mv_credit_card_number}    =~ s/\D//g;
479
480     my $exp = sprintf '%02d%02d',
481         $actual{mv_credit_card_exp_month},
482         $actual{mv_credit_card_exp_year};
483
484     my %type_map = (qw/
485         sale          S
486         auth          A
487         authorize     A
488         void          V
489         settle        D
490         settle_prior  D
491         credit        C
492         mauthcapture  S
493         mauthonly     A
494         mauthdelay    D
495         mauthreturn   C
496         S             S
497         C             C
498         D             D
499         V             V
500         A             A
501     /);
502
503     my $transtype = $opt->{transaction} || charge_param('transaction') || 'A';
504
505     $transtype = $type_map{$transtype}
506         or return (
507                 MStatus => 'failure-hard',
508                 MErrMsg => errmsg('Unrecognized transaction: %s', $transtype),
509             );
510
511     my $order_id = gen_order_id($opt);
512
513     my $precision = $opt->{precision} || charge_param('precision') || 2;
514
515     $amount = $opt->{total_cost} if ! $amount;
516
517     if (! $amount) {
518         $amount = Vend::Interpolate::total_cost();
519         $amount = Vend::Util::round_to_frac_digits($amount, $precision);
520     }
521
522     my $shipping = $opt->{shipping} || '';
523
524     if (! $shipping) {
525         $shipping = Vend::Interpolate::tag_shipping();
526         $shipping = Vend::Util::round_to_frac_digits($shipping, $precision);
527     }
528
529     my $salestax = $opt->{salestax} || '';
530
531     if (! $salestax) {
532         $salestax = Vend::Interpolate::salestax();
533         $salestax = Vend::Util::round_to_frac_digits($salestax, $precision);
534     }
535
536     my $subtotal = $opt->{subtotal} || '';
537
538     if (! $subtotal) {
539         $subtotal = Vend::Interpolate::subtotal();
540         $subtotal = Vend::Util::round_to_frac_digits($subtotal, $precision);
541     }
542
543     my $phone = $actual{phone_day} || $actual{phone_night};
544     $phone =~ s/\D//g;
545
546     my %varmap = (qw/
547         ACCT             mv_credit_card_number
548         CVV2             mv_credit_card_cvv2
549         BILLTOFIRSTNAME  b_fname
550         BILLTOLASTNAME   b_lname
551         BILLTOSTREET     b_address
552         BILLTOCITY       b_city
553         BILLTOSTATE      b_state
554         BILLTOZIP        b_zip
555         SHIPTOFIRSTNAME  fname
556         SHIPTOLASTNAME   lname
557         SHIPTOSTREET     address
558         SHIPTOCITY       city
559         SHIPTOSTATE      state
560         SHIPTOZIP        zip
561         BILLTOEMAIL      email
562         EMAIL            email
563         COMMENT1         comment1
564         COMMENT2         comment2
565     /);
566
567     my $action = $opt->{action};
568     $action =~ s/set/S/;
569     $action =~ s/get/G/;
570     $action =~ s/do/D/;
571
572     my $tender;
573     $tender = $action ? 'P' : 'C';   # tender must be P for PayPal
574
575     my $tdb = dbref('transactions') or die errmsg("cannot open transactions table");
576     my $existing_trans = $tdb->foreign($order_id, 'order_id');  # lookup order_id in transactions, to see what payment_method was.
577     if($existing_trans) {
578         my $pay_method = $tdb->field($existing_trans, 'payment_method');
579         $tender = 'P' if $pay_method =~ /^PayPal/i;
580     }
581
582     my %query = (
583         AMT            => $amount,
584         CURRENCY       => 'USD',
585         TENDER         => $tender,
586         PWD            => $secret,
587         USER           => $user,
588         TRXTYPE        => $transtype,
589         CUSTIP         => $Vend::Session->{ohost},
590         TAXAMT         => $salestax,
591         TAXEXEMPT      => ($salestax > 0) ? 'N' : 'Y',
592         FREIGHTAMT     => $shipping,
593         BILLTOPHONENUM => $phone,
594         BILLTOCOUNTRY  => ($actual{b_country} eq 'UK') ? 'GB' : $actual{b_country},
595         SHIPTOCOUNTRY  => ($actual{country} eq 'UK') ? 'GB' : $actual{country},
596     );
597     my %paypal_query = (
598         ACTION               => $action,
599         RETURNURL            => charge_param('returnurl'),
600         CANCELURL            => charge_param('cancelurl'),
601         TOKEN                => ($action eq 'S' ? '' : $Vend::Session->{paypal_token}),
602         ALLOWNOTE            => charge_param('allow_note'),
603         REQBILLINGADDRESS    => charge_param('reqbillingaddress'),
604         REQCONFIRMSHIPPING   => charge_param('reqconfirmshipping'),
605         PAGESTYLE            => charge_param('pagestyle'),
606         HDRIMG               => charge_param('headerimg'),
607         HDRBORDERCOLOR       => charge_param('headerbordercolor'),
608         HDRBACKCOLOR         => charge_param('headerbackcolor'),
609         PAYFLOWCOLOR         => charge_param('payflowcolor'),
610         ITEMAMT              => $subtotal,
611         PAYERID              => $CGI::values{payerid} || $::Values->{pppayerid},
612         NOTETOBUYER          => charge_param('note_to_buyer') || '*** Discounts and coupons will be shown and applied before final payment',
613         PAYMENTREQUEST_0_AMT => $amount,
614     );
615     if($tender eq 'P') {
616         @query{keys %paypal_query} = values %paypal_query;
617         my $i = 0;
618         if ($action ne 'D') {
619             for my $it ( @{ $::Carts->{main} } ) {
620                 my $it_price = Vend::Data::item_price($it);
621                 my $disc_price = Vend::Interpolate::discount_price( $it, $it_price, $it->{quantity} );
622 #::logDebug("payflowpro: prices for $it->{code}: it_price=$it_price, disc_price=$disc_price");
623                 $query{ 'L_PAYMENTREQUEST_0_NAME'   . $i } = $it->{description} || Vend::Data::item_description($it);
624                 $query{ 'L_PAYMENTREQUEST_0_NUMBER' . $i } = $it->{code};
625                 $query{ 'L_PAYMENTREQUEST_0_DESC'   . $i } = Vend::Data::item_description($it);
626                 $query{ 'L_PAYMENTREQUEST_0_AMT'    . $i } = $disc_price;
627                 $query{ 'L_PAYMENTREQUEST_0_QTY'    . $i } = $it->{quantity};
628                 ##$query{'L_PAYMENTREQUEST_0_TAXAMT'    .$i} = ($disc_price/$itemTotal * $taxTotal);
629                 $i++;
630             }
631         }
632         $opt->{check_sub} = undef;
633     }
634     else {
635         my $i = 1;
636         for my $it (@{$::Carts->{main}}) {
637         my $it_price = Vend::Data::item_price($it);
638         my $disc_price = Vend::Interpolate::discount_price($it, $it_price, $it->{quantity});
639             $query{'L_NAME' . $i} = $it->{description} || Vend::Data::item_description($it);
640             $query{'L_COST' . $i} = $disc_price;
641             $query{'L_QTY'  . $i} = $it->{quantity};
642             $query{'L_SKU'  . $i} = $it->{code};
643             ##$query{'L_TAXAMT'.$i} = ($disc_price/$itemTotal * $taxTotal);
644             $i++;
645         }
646     }
647
648     $query{PARTNER}  = $opt->{partner} || charge_param('partner');
649     $query{VENDOR}   = $opt->{vendor}  || charge_param('vendor');
650     $query{COMMENT1} = $order_id if ! $actual{comment1};
651
652     if($action =~ /[SG]/) {
653         ## if a PayPal set/get, don't want address, just email.
654         $query{EMAIL} = $actual{$varmap{EMAIL}} if defined $actual{$varmap{EMAIL}};
655     }
656     elsif($action eq 'D') {
657         ## don't want some.
658         delete $query{ACCT};
659         delete $query{CVV2};
660         for (keys %varmap) {
661             $query{$_} = $actual{$varmap{$_}} if defined $actual{$varmap{$_}};
662         }
663     }
664     else {
665         if ( $Vend::Session->{admin} and $::Values->{order_desk_entry} ) {
666             delete $query{CUSTIP};    # prevent 'IP/Address Mismatch' fraud reports for UI orders
667         }
668         ## these not for PayPal authorizations, only capture/void (and credit cards):
669         $query{ORIGID} = $order_id;
670         $query{EXPDATE} = $exp;
671         for (keys %varmap) {
672             $query{$_} = $actual{$varmap{$_}} if defined $actual{$varmap{$_}};
673         }
674     }
675
676 # Uncomment all the following block to use the debug statement. It strips
677 # the arg of any sensitive credit card information and is safe
678 # (and recommended) to enable in production.
679 #
680 #    {
681 #        my %munged_query = %query;
682 #        $munged_query{PWD} = 'X';
683 #        $munged_query{ACCT} =~ s/^(\d{4})(.*)/$1 . ('X' x length($2))/e;
684 #        $munged_query{CVV2} =~ s/./X/g;
685 #        $munged_query{EXPDATE} =~ s/./X/g;
686 #::logDebug("payflowpro query: " . ::uneval(\%munged_query));
687 #    }
688
689     my $timeout = $opt->{timeout} || 45;
690     die "Bad timeout value, security violation." unless $timeout && $timeout !~ /\D/;
691     die "Bad port value, security violation." unless $port && $port !~ /\D/;
692     die "Bad server value, security violation." unless $server && $server !~ /[^-\w.]/;
693
694     my $result = {};
695
696     my (@query, @debug_query);
697     for my $key (keys %query) {
698         my $val = $query{$key};
699         $val =~ s/["\$\n\r]//g;
700         my $len = length($val);
701         $key .= "[$len]";
702         push @query, "$key=$val";
703         $val =~ s/./X/g
704             if $key =~ /^(?:PWD|ACCT|CVV2|EXPDATE)\b/;
705         push @debug_query, "$key=$val";
706     }
707     my $string = join '&', @query;
708     my $debug_string = join '&', @debug_query;
709
710         my $reqid = $transtype =~ /^[DVC]$/ ? ($order_id . int(rand(100))) : $order_id;
711 #::logDebug("payflowpro using X-VPS-Request-Id = $reqid");
712
713     my %headers = (
714         'Content-Type'                    => 'text/namevalue',
715         'X-VPS-Request-Id'                => $reqid,
716         'X-VPS-Timeout'                   => $timeout,
717         'X-VPS-VIT-Client-Architecture'   => $Config{archname},
718         'X-VPS-VIT-Client-Type'           => 'Perl',
719         'X-VPS-VIT-Client-Version'        => $VERSION,
720         'X-VPS-VIT-Integration-Product'   => 'Interchange',
721         'X-VPS-VIT-Integration-Version'   => $::VERSION,
722         'X-VPS-VIT-OS-Name'               => $Config{osname},
723         'X-VPS-VIT-OS-Version'            => $Config{osvers},
724         'PAYPAL-NVP'                      => ($tender eq 'P' ? 'Y' : ''),
725     );
726 # Debug statement is stripped of any sensitive card data and is safe (and
727 # recommended) to enable in production.
728 #
729 #::logDebug(qq{--------------------\nPosting to PayflowPro: \n\t$order_id\n\t$uri "$debug_string"});
730
731     my $headers = HTTP::Headers->new(%headers);
732     my $request = HTTP::Request->new('POST', $uri, $headers, $string);
733     my $ua = LWP::UserAgent->new(timeout => $timeout);
734     $ua->agent('Vend::Payment::PayflowPro');
735     my $response = $ua->request($request);
736     my $resultstr = $response->content;
737 #::logDebug(qq{PayflowPro response:\n\t$resultstr\n--------------------});
738
739     unless ( $response->is_success ) {
740         return (
741             RESULT => -1,
742             RESPMSG => 'System Error',
743             MStatus => 'failure-hard',
744             MErrMsg => 'System Error',
745             lwp_response => $resultstr,
746         );
747     }
748
749     %$result = split /[&=]/, $resultstr;
750     if($tender eq 'P') {
751         for(keys %$result) {
752             my $v = delete $result->{$_};
753             $_ =~ s|\[\d+\]$||;   # remove length tags for NVP
754             $_ =~ s|^PAYMENTINFO_0_||;  # also strip 'paymentinfo_0'
755             $result->{$_} = $v;
756         }
757     }
758
759     my $decline = $result->{RESULT};
760
761     if (
762         $result->{RESULT} =~ /^0|12[67]$/
763             and
764         my $check_sub_name = $opt->{check_sub} || charge_param('check_sub')
765     ) {
766         my $check_sub = $Vend::Cfg->{Sub}{$check_sub_name}
767             || $Global::GlobalSub->{$check_sub_name};
768         if (ref $check_sub eq 'CODE') {
769             $decline =
770                 !$check_sub->(
771                     $result,
772                     $transtype,
773                 );
774 #::logDebug(qq{payflowpro called check_sub sub=$check_sub_name decline=$decline});
775         }
776         else {
777             logError("payflowpro: non-existent check_sub routine %s.", $check_sub_name);
778         }
779     }
780
781     my %result_map = (qw/
782         MStatus        ICSTATUS
783         pop.status     ICSTATUS
784         order-id       PNREF
785         pop.order-id   PNREF
786         pop.auth-code  AUTHCODE
787         pop.avs_code   AVSZIP
788         pop.avs_zip    AVSZIP
789         pop.avs_addr   AVSADDR
790     /);
791
792     if ($accept_for_review and $decline =~ /^12[67]$/) {   ## flagged for review, or not screened by filters
793         $result->{ICSTATUS} = 'success';
794     }
795     elsif ($decline) {
796         $result->{ICSTATUS} = 'failed';
797         my $msg = errmsg("Charge error: %s Reason: %s. Please call in your order or try again.",
798             $result->{RESULT} || 'no details available',
799             $result->{RESPMSG} || 'unknown error',
800         );
801         $result->{MErrMsg} = $result{'pop.error-message'} = $msg;
802     }
803     else {
804         $result->{ICSTATUS} = 'success';
805         if($result->{TOKEN}) {
806             ## PayPal transaction.
807             $Vend::Session->{paypal_token} = $result->{TOKEN};
808             if($action eq 'G') {
809                 ## save address details in Values...
810                 my %val_map = (qw/
811                     email             EMAIL
812                     pppayerid         PAYERID
813                     pppayer_status    PAYERSTATUS
814                     gift_note         NOTE
815                     fname             FIRSTNAME
816                     lname             LASTNAME
817                     address1          SHIPTOSTREET
818                     address2          SHIPTOSTREET2
819                     city              SHIPTOCITY
820                     state             SHIPTOSTATE
821                     zip               SHIPTOZIP
822                     country           SHIPTOCOUNTRY
823                     company           SHIPTOBUSINESS
824                     phone_day         PHONENUM
825                     b_address1        STREET
826                     b_address2        STREET2
827                     b_city            CITY
828                     b_state           STATE
829                     b_zip             ZIP
830                     b_country         COUNTRYCODE
831                     ppaddress_status  ADDRESSSTATUS
832                 /);
833                 for (keys %val_map) {
834                     $::Values->{$_} = $result->{$val_map{$_}}
835                         if defined $result->{$val_map{$_}};
836                 }
837             }
838         }
839     }
840
841     for (keys %result_map) {
842         $result->{$_} = $result->{$result_map{$_}}
843             if defined $result->{$result_map{$_}};
844     }
845
846 #::logDebug('payflowpro result: ' . ::uneval($result));
847     return %$result;
848 }
849
850 package Vend::Payment::PayflowPro;
851
852 1;