From 0cd63fdf0f05f7cf304d07707ddd2dae1cce268a Mon Sep 17 00:00:00 2001 From: plobbes Date: Sat, 22 Aug 2009 05:42:29 +0000 Subject: [PATCH] - bump version to 1.00, should have probably done this with 0.07 as it was a radical enough departure from 0.06, also BOP 3.x is no longer just a developers release - rt.cpan.org#48696 Use CGI::Util instead of CGI Josh Rosenbaum + updated code to be faster/more efficient - rt.cpan.org#48816 Request Encoding Issue & Missing fields Josh Rosenbaum + use PayPal custom encoding (not URL encoding) per PP spec + added missing shipping parameters similar to Authorize.Net - rt.cpan.org#48820 %content not reloaded after mapping breaks credits Josh Rosenbaum + fix a problem with credits where the ACCT, AMT, and EXPDATE were being required, because the ORIGID detection code was not working - addition test cases for updated code --- Changes | 17 +++++++ PayflowPro.pm | 160 ++++++++++++++++++++++++++++++++++++++++++++++++---------- t/bop.t | 42 ++++++++++++++- 3 files changed, 190 insertions(+), 29 deletions(-) diff --git a/Changes b/Changes index 6716675..9011bb3 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,22 @@ Revision history for Perl extension Business::OnlinePayment::PayflowPro. +1.00 Sat Aug 22 01:13:34 EDT 2009 plobbes + - bump version to 1.00, should have probably done this with + 0.07 as it was a radical enough departure from 0.06, also + BOP 3.x is no longer just a developers release + - rt.cpan.org#48696 Use CGI::Util instead of CGI + Josh Rosenbaum + + updated code to be faster/more efficient + - rt.cpan.org#48816 Request Encoding Issue & Missing fields + Josh Rosenbaum + + use PayPal custom encoding (not URL encoding) per PP spec + + added missing shipping parameters similar to Authorize.Net + - rt.cpan.org#48820 %content not reloaded after mapping breaks credits + Josh Rosenbaum + + fix a problem with credits where the ACCT, AMT, and + EXPDATE were being required, because the ORIGID detection + code was not working + 0.07 Tue Apr 14 13:49:50 EDT 2009 plobbes - update server names per latest PayPal docs: payflow.verisign.com => payflowpro.verisign.com diff --git a/PayflowPro.pm b/PayflowPro.pm index 10e5f2c..6f49649 100644 --- a/PayflowPro.pm +++ b/PayflowPro.pm @@ -3,21 +3,28 @@ package Business::OnlinePayment::PayflowPro; use strict; use vars qw($VERSION $DEBUG); use Carp qw(carp croak); -use CGI; use Digest::MD5; use Business::OnlinePayment::HTTPS 0.06; use base qw(Business::OnlinePayment::HTTPS); -$VERSION = '0.07'; +$VERSION = '1.00'; $VERSION = eval $VERSION; $DEBUG = 0; +# CGI::Util was included starting with Perl 5.6. For previous +# Perls, let them use the old simple CGI method of unescaping +my $no_cgi_util; +BEGIN { + eval { require CGI::Util; }; + $no_cgi_util = 1 if $@; +} + # return current request_id or generate a new one if not yet set sub request_id { my $self = shift; if ( ref($self) ) { - $self->{"__request_id"} = shift if (@_); # allow value change/reset + $self->{"__request_id"} = shift if (@_); # allow value change/reset $self->{"__request_id"} = $self->_new_request_id() unless ( $self->{"__request_id"} ); return $self->{"__request_id"}; @@ -62,14 +69,16 @@ sub set_defaults { $self->port("443"); $self->path("/transaction"); - $self->build_subs(qw( - partner vendor - client_certification_id client_timeout - headers test_server - cert_path - order_number avs_code cvv2_response - response_page response_code response_headers - )); + $self->build_subs( + qw( + partner vendor + client_certification_id client_timeout + headers test_server + cert_path + order_number avs_code cvv2_response + response_page response_code response_headers + ) + ); # module specific data if ( $opts{debug} ) { @@ -83,7 +92,7 @@ sub set_defaults { # required: 45 secs recommended by HTTPS Interface Dev Guide $self->client_timeout(45); - $self->test_server( "pilot-payflowpro.paypal.com" ); + $self->test_server("pilot-payflowpro.paypal.com"); } sub _map_fields { @@ -195,8 +204,23 @@ sub submit { STATE => 'state', ZIP => \$zip, # 'zip' with non-alnums removed COUNTRY => 'country', + + # As of 8/18/2009: CUSTCODE appears to be cut off at 18 + # characters and isn't currently reportable. Consider storing + # local customer ids in the COMMENT1/2 fields as a workaround. + CUSTCODE => 'customer_id', + SHIPTOFIRSTNAME => 'ship_first_name', + SHIPTOLASTNAME => 'ship_last_name', + SHIPTOSTREET => 'ship_address', + SHIPTOCITY => 'ship_city', + SHIPTOSTATE => 'ship_state', + SHIPTOZIP => 'ship_zip', + SHIPTOCOUNTRY => 'ship_country', ); + # Reload %content as _revmap_fields makes our copy old/invalid! + %content = $self->content; + my @required = qw( TRXTYPE TENDER PARTNER VENDOR USER PWD ); if ( $self->transaction_type() eq 'C' ) { # credit card if ( $content{'action'} =~ /^[CDV]$/ @@ -219,6 +243,9 @@ sub submit { ACCT CVV2 EXPDATE AMT FIRSTNAME LASTNAME NAME EMAIL COMPANYNAME STREET CITY STATE ZIP COUNTRY + SHIPTOFIRSTNAME SHIPTOLASTNAME + SHIPTOSTREET SHIPTOCITY SHIPTOSTATE SHIPTOZIP SHIPTOCOUNTRY + CUSTCODE ) ); @@ -248,29 +275,60 @@ sub submit { "headers" => \%req_headers, ); + # Payflow Pro does not use URL encoding for the request. The + # following implements their custom encoding scheme. Per the + # developer docs, the PARMLIST Syntax Guidelines are: + # - Spaces are allowed in values + # - Enclose the PARMLIST in quotation marks ("") + # - Do not place quotation marks ("") within the body of the PARMLIST + # - Separate all PARMLIST name-value pairs using an ampersand (&) + # + # Because '&' and '=' have special meanings/uses values containing + # these special characters must be encoded using a special "length + # tag". The "length tag" is simply the length of the "value" + # enclosed in square brackets ([]) and appended to the "name" + # portion of the name-value pair. + # + # For more details see the sections 'Using Special Characters in + # Values' and 'PARMLIST Syntax Guidelines' in the PayPal Payflow + # Pro Developer's Guide + # + # NOTE: we pass a string to https_post so it does not do encoding + my $params_string = join( + '&', + map { + my $key = $_; + my $value = defined( $params{$key} ) ? $params{$key} : ''; + if ( index( $value, '&' ) != -1 || index( $value, '=' ) != -1 ) { + $key = $key . "[" . length($value) . "]"; + } + "$key=$value"; + } keys %params + ); + my ( $page, $resp, %resp_headers ) = - $self->https_post( \%options, \%params ); + $self->https_post( \%options, $params_string ); - $self->response_code( $resp ); - $self->response_page( $page ); + $self->response_code($resp); + $self->response_page($page); $self->response_headers( \%resp_headers ); # $page should contain name=value[[&name=value]...] pairs - my $cgi = CGI->new("$page"); + my $response = $self->_get_response( \$page ); # AVS and CVS values may be set on success or failure my $avs_code; - if ( defined $cgi->param("AVSADDR") or defined $cgi->param("AVSZIP") ) { - if ( $cgi->param("AVSADDR") eq "Y" && $cgi->param("AVSZIP") eq "Y" ) { + if ( defined $response->{"AVSADDR"} or defined $response->{"AVSZIP"} ) { + if ( $response->{"AVSADDR"} eq "Y" && $response->{"AVSZIP"} eq "Y" ) { $avs_code = "Y"; } - elsif ( $cgi->param("AVSADDR") eq "Y" ) { + elsif ( $response->{"AVSADDR"} eq "Y" ) { $avs_code = "A"; } - elsif ( $cgi->param("AVSZIP") eq "Y" ) { + elsif ( $response->{"AVSZIP"} eq "Y" ) { $avs_code = "Z"; } - elsif ( $cgi->param("AVSADDR") eq "N" or $cgi->param("AVSZIP") eq "N" ) + elsif ( $response->{"AVSADDR"} eq "N" or $response->{"AVSZIP"} eq "N" ) { $avs_code = "N"; } @@ -280,14 +338,14 @@ sub submit { } $self->avs_code($avs_code); - $self->cvv2_response( $cgi->param("CVV2MATCH") ); - $self->result_code( $cgi->param("RESULT") ); - $self->order_number( $cgi->param("PNREF") ); - $self->error_message( $cgi->param("RESPMSG") ); - $self->authorization( $cgi->param("AUTHCODE") ); + $self->cvv2_response( $response->{"CVV2MATCH"} ); + $self->result_code( $response->{"RESULT"} ); + $self->order_number( $response->{"PNREF"} ); + $self->error_message( $response->{"RESPMSG"} ); + $self->authorization( $response->{"AUTHCODE"} ); # RESULT must be an explicit zero, not just numerically equal - if ( $cgi->param("RESULT") eq "0" ) { + if ( defined( $response->{"RESULT"} ) && $response->{"RESULT"} eq "0" ) { $self->is_success(1); } else { @@ -295,6 +353,38 @@ sub submit { } } +# Process the response page for params. Based on parse_params in CGI +# by Lincoln D. Stein. +sub _get_response { + my ( $self, $page ) = @_; + + my %response; + + if ( !defined($page) || ( ref($page) && !defined($$page) ) ) { + return \%response; + } + + my ( $param, $value ); + foreach ( split( /[&;]/, ref($page) ? $$page : $page ) ) { + ( $param, $value ) = split( '=', $_, 2 ); + next unless defined $param; + $value = '' unless defined $value; + + if ($no_cgi_util) { # use old pre-CGI::Util method of unescaping + $param =~ tr/+/ /; # pluses become spaces + $param =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; + $value =~ tr/+/ /; # pluses become spaces + $value =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; + } + else { + $param = CGI::Util::unescape($param); + $value = CGI::Util::unescape($value); + } + $response{$param} = $value; + } + return \%response; +} + 1; __END__ @@ -546,6 +636,19 @@ from content(%content): ZIP => \$zip, # 'zip' with non-alphanumerics removed COUNTRY => 'country', + # As of 8/18/2009: CUSTCODE appears to be cut off at 18 + # characters and isn't currently reportable. Consider storing + # local customer ids in the COMMENT1/2 fields as a workaround. + CUSTCODE => 'customer_id', + + SHIPTOFIRSTNAME => 'ship_first_name', + SHIPTOLASTNAME => 'ship_last_name', + SHIPTOSTREET => 'ship_address', + SHIPTOCITY => 'ship_city', + SHIPTOSTATE => 'ship_state', + SHIPTOZIP => 'ship_zip', + SHIPTOCOUNTRY => 'ship_country', + The required Payflow Pro parameters for credit card transactions are: TRXTYPE TENDER PARTNER VENDOR USER PWD ORIGID @@ -603,7 +706,8 @@ response message returned with the transaction result. As of 0.07, this module communicates with the Payflow gateway directly and no longer requires the Payflow Pro SDK or other download. Thanks -to Phil Lobbes for this great work. +to Phil Lobbes for this great work and Josh Rosenbaum for additional +enhancements and bug fixes. =head1 AUTHORS diff --git a/t/bop.t b/t/bop.t index 6c9274d..8739379 100644 --- a/t/bop.t +++ b/t/bop.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::More tests => 24; +use Test::More tests => 30; use Business::OnlinePayment; @@ -98,3 +98,43 @@ my $driver = "PayflowPro"; is( $obj->request_id($id), $id, "request_id() can be set" ); is( $obj->request_id, $id, "request_id() remains set" ); } + +{ # _get_response - response parsing + my $obj = $package->new($driver); + + is_deeply( + $obj->_get_response('%66%6F%78=%71%75%69%63%6B%20%25%26%3B&e=3+3'), + { fox => 'quick %&;', e => '3 3' }, + "_get_response 1 returns correct value" + ); + is_deeply( + $obj->_get_response('Foo=&&&&;;ab=t+t;q=2'), + { Foo => '', ab => 't t', q => '2' }, + "_get_response 2 returns correct value" + ); + is_deeply( + $obj->_get_response('f=s'), + { f => 's' }, + "_get_response 3 returns correct value" + ); + is_deeply( $obj->_get_response(''), + {}, "_get_response 4 returns correct value" ); + is_deeply( $obj->_get_response(undef), + {}, "_get_response 5 returns correct value" ); + is_deeply( + $obj->_get_response( +'RESULT=0&PNREF=QAAA1DF4B4F4&RESPMSG=Approved&AUTHCODE=111PNQ&AVSADDR=X&AVSZIP=X&CVV2MATCH=Y&IAVS=X' + ), + { + RESULT => '0', + PNREF => 'QAAA1DF4B4F4', + RESPMSG => 'Approved', + AUTHCODE => '111PNQ', + AVSADDR => 'X', + AVSZIP => 'X', + CVV2MATCH => 'Y', + IAVS => 'X' + }, + "_get_response 6 returns correct value" + ); +} -- 2.11.0