- 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

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"
+    );
+}