- 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

diff --git a/Changes b/Changes
index 6716675..9011bb3 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,22 @@
 Revision history for Perl extension Business::OnlinePayment::PayflowPro.
 
 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
 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 (file)
--- 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 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);
 
 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;
 
 $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) ) {
 # 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"};
         $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->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} ) {
 
     # 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);
 
     # 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 {
 }
 
 sub _map_fields {


@@ -195,8 +204,23 @@ sub submit {
         STATE       => 'state',
         ZIP         => \$zip,          # 'zip' with non-alnums removed
         COUNTRY     => 'country',
         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]$/
     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
           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,
     );
 
         "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 ) =
     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
     $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;
 
     # 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";
         }
             $avs_code = "Y";
         }

-        elsif ( $cgi->param("AVSADDR") eq "Y" ) {
+        elsif ( $response->{"AVSADDR"} eq "Y" ) {

             $avs_code = "A";
         }
             $avs_code = "A";
         }

-        elsif ( $cgi->param("AVSZIP") eq "Y" ) {
+        elsif ( $response->{"AVSZIP"} eq "Y" ) {

             $avs_code = "Z";
         }
             $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";
         }
         {
             $avs_code = "N";
         }


@@ -280,14 +338,14 @@ sub submit {
     }
 
     $self->avs_code($avs_code);
     }
 
     $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
 
     # 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 {
         $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__
 1;
 
 __END__


@@ -546,6 +636,19 @@ from content(%content):
       ZIP         => \$zip, # 'zip' with non-alphanumerics removed
       COUNTRY     => 'country',
 
       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
 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
 
 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
 
 
 =head1 AUTHORS
 

diff --git a/t/bop.t b/t/bop.t
index 6c9274d..8739379 100644 (file)
--- a/t/bop.t
+++ b/t/bop.t
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
 
 use strict;
 use warnings;

-use Test::More tests => 24;
+use Test::More tests => 30;

 
 use Business::OnlinePayment;
 
 
 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" );
 }
     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"
+    );
+}