X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=PayflowPro.pm;h=d95affca2018469228b9a37cf994d78f2e3a9cbc;hb=HEAD;hp=446a13476eedbc9e70bc28b2d27bcd032f48206e;hpb=b07276604fe7412f98ad434dc7aef51b91a80b52;p=Business-OnlinePayment-PayflowPro.git diff --git a/PayflowPro.pm b/PayflowPro.pm index 446a134..d95affc 100644 --- a/PayflowPro.pm +++ b/PayflowPro.pm @@ -3,52 +3,44 @@ 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_03'; +$VERSION = '1.01'; $VERSION = eval $VERSION; $DEBUG = 0; -sub request_id { - my $self = shift; - my $md5 = Digest::MD5->new(); - $md5->add( $$, time(), rand(time) ); - return $md5->hexdigest(); +# 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 $@; } -sub param { +# return current request_id or generate a new one if not yet set +sub request_id { my $self = shift; - my @args = @_; - - $self->{__PARAM} ||= {}; - my $param = $self->{__PARAM}; - - if (@args) { - if ( @args % 2 == 0 ) { - %$param = ( %$param, @args ); - } - elsif ( @args == 1 ) { - my $arg = shift; - if ( ref($arg) eq "HASH" ) { - %$param = ( %$param, %$arg ); - return keys %$arg; - } - else { - return $param->{$arg}; - } - } - else { - croak("param: invalid arguments: @_\n"); - } + if ( ref($self) ) { + $self->{"__request_id"} = shift if (@_); # allow value change/reset + $self->{"__request_id"} = $self->_new_request_id() + unless ( $self->{"__request_id"} ); + return $self->{"__request_id"}; } else { - return ( keys %$param ); + return $self->_new_request_id(); } } +sub _new_request_id { + my $self = shift; + my $md5 = Digest::MD5->new(); + $md5->add( $$, time(), rand(time) ); + return $md5->hexdigest(); +} + sub debug { my $self = shift; @@ -65,44 +57,42 @@ sub debug { return ref($self) ? ( $self->{"__DEBUG"} || $DEBUG ) : $DEBUG; } -sub _deprecate { - my $self = shift; - carp( "method '", __PACKAGE__, "::$_[0]' is deprecated" ); - return $self->param(@_); -} - -# NOTE: for bigger picture perhaps we get rid of build_subs() some day -# and instead use something like param() as a standard method? - -# deprecated methods: -sub cert_path { return shift->_deprecate( "cert_path", @_ ); } - -# custom methods: -sub avs_code { return shift->param( "avs_code", @_ ); } -sub cvv2_code { return shift->param( "cvv2_code", @_ ); } -sub order_number { return shift->param( "order_number", @_ ); } -sub partner { return shift->param( "partner", @_ ); } -sub vendor { return shift->param( "vendor", @_ ); } +# cvv2_code: support legacy code and but deprecate method +sub cvv2_code { shift->cvv2_response(@_); } sub set_defaults { my $self = shift; my %opts = @_; # standard B::OP methods/data - $self->server("payflow.verisign.com"); + $self->server("payflowpro.paypal.com"); $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 + ) + ); + # module specific data if ( $opts{debug} ) { $self->debug( $opts{debug} ); delete $opts{debug}; } - $self->param( - "test_server" => "pilot-payflowpro.verisign.com", - %opts, - ); + # HTTPS Interface Dev Guide: must be set but will be removed in future + $self->client_certification_id("ClientCertificationIdNotSet"); + + # required: 45 secs recommended by HTTPS Interface Dev Guide + $self->client_timeout(45); + + $self->test_server("pilot-payflowpro.paypal.com"); } sub _map_fields { @@ -180,10 +170,10 @@ sub submit { my $zip = $content{'zip'}; $zip =~ s/[^[:alnum:]]//g; - $self->server( $self->param("test_server") ) if $self->test_transaction; + $self->server( $self->test_server ) if $self->test_transaction; - my $vendor = $self->param("vendor"); - my $partner = $self->param("partner"); + my $vendor = $self->vendor; + my $partner = $self->partner; $self->_revmap_fields( @@ -214,22 +204,35 @@ 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 ); + + # NOTE: we croak above if transaction_type ne 'C' if ( $self->transaction_type() eq 'C' ) { # credit card - if ( $content{'action'} =~ /^[CDV]$/ - && defined( $content{'ORIGID'} ) - && length( $content{'ORIGID'} ) ) - { + if ( defined( $content{'ORIGID'} ) && length( $content{'ORIGID'} ) ) { push @required, qw(ORIGID); } else { - - # never get here, we croak above if transaction_type ne 'C' push @required, qw(AMT ACCT EXPDATE); } } + $self->required_fields(@required); my %params = $self->get_fields( @@ -238,20 +241,31 @@ sub submit { ACCT CVV2 EXPDATE AMT FIRSTNAME LASTNAME NAME EMAIL COMPANYNAME STREET CITY STATE ZIP COUNTRY + SHIPTOFIRSTNAME SHIPTOLASTNAME + SHIPTOSTREET SHIPTOCITY SHIPTOSTATE SHIPTOZIP SHIPTOCOUNTRY + CUSTCODE ) ); - # get header data, get request_id from %content if defined for ease of use - my %req_headers = %{ $self->param("headers") || {} }; + # get header data + my %req_headers = %{ $self->headers || {} }; + + # get request_id from %content if defined for ease of use if ( defined $content{"request_id"} ) { - $req_headers{"X-VPS-REQUEST-ID"} = $content{"request_id"}; + $self->request_id( $content{"request_id"} ); } - unless ( defined( $req_headers{"X-VPS-REQUEST-ID"} ) ) { - $req_headers{"X-VPS-REQUEST-ID"} = $self->request_id(); + + unless ( defined( $req_headers{"X-VPS-Request-ID"} ) ) { + $req_headers{"X-VPS-Request-ID"} = $self->request_id(); } - unless ( defined( $req_headers{"X-VPS-VIT-CLIENT-CERTIFICATION-ID"} ) ) { - $req_headers{"X-VPS-VIT-CLIENT-CERTIFICATION-ID"} = - $self->param("client_certification_id"); + + unless ( defined( $req_headers{"X-VPS-VIT-Client-Certification-Id"} ) ) { + $req_headers{"X-VPS-VIT-Client-Certification-Id"} = + $self->client_certification_id; + } + + unless ( defined( $req_headers{"X-VPS-Client-Timeout"} ) ) { + $req_headers{"X-VPS-Client-Timeout"} = $self->client_timeout(); } my %options = ( @@ -259,33 +273,60 @@ sub submit { "headers" => \%req_headers, ); - my ( $page, $resp, %resp_headers ) = - $self->https_post( \%options, \%params ); - - $self->param( - "transaction_response" => { - page => $page, - response => $resp, - headers => \%resp_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_string ); + + $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"; } @@ -295,14 +336,14 @@ sub submit { } $self->avs_code($avs_code); - $self->cvv2_code( $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 { @@ -310,6 +351,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__ @@ -324,9 +397,9 @@ Business::OnlinePayment::PayflowPro - Payflow Pro backend for Business::OnlinePa my $tx = new Business::OnlinePayment( 'PayflowPro', - 'vendor' => 'your_vendor', - 'partner' => 'your_partner', - 'client_certification_id' => 'assigned_certification_id', + 'vendor' => 'your_vendor', + 'partner' => 'your_partner', + 'client_certification_id' => 'GuidUpTo32Chars', ); # See the module documentation for details of content() @@ -356,7 +429,7 @@ Business::OnlinePayment::PayflowPro - Payflow Pro backend for Business::OnlinePa print( "Card processed successfully: ", $tx->authorization, "\n", "order number: ", $tx->order_number, "\n", - "CVV2 code: ", $tx->cvv2_code, "\n", + "CVV2 response: ", $tx->cvv2_response, "\n", "AVS code: ", $tx->avs_code, "\n", ); } @@ -385,18 +458,20 @@ modules supports. =item set_defaults() -This method sets the 'server' attribute to 'payflow.verisign.com' and -the port attribute to '443'. This method also sets up the +This method sets the 'server' attribute to 'payflowpro.paypal.com' +and the port attribute to '443'. This method also sets up the L described below. =item submit() =back -=head1 Module specific methods +=head1 Unofficial methods -This module provides the following methods which are not currently -part of the standard Business::OnlinePayment interface: +This module provides the following methods which are not officially +part of the standard Business::OnlinePayment interface (as of 3.00_06) +but are nevertheless supported by multiple gateways modules and +expected to be standardized soon: =over 4 @@ -404,25 +479,62 @@ part of the standard Business::OnlinePayment interface: =item L -=item L +=item L -=item L +=back -=item L +=head1 Module specific methods -=item L +This module provides the following methods which are not currently +part of the standard Business::OnlinePayment interface: -=item L +=head2 client_certification_id() -=back +This gets/sets the X-VPS-VITCLIENTCERTIFICATION-ID which is REQUIRED +and defaults to "ClientCertificationIdNotSet". This is described in +Website Payments Pro HTTPS Interface Developer's Guide as follows: + +"A random globally unique identifier (GUID) that is currently +required. This requirement will be removed in the future. At this +time, you can send any alpha-numeric ID up to 32 characters in length. + +NOTE: Once you have created this ID, do not change it. Use the same ID +for every transaction." + +=head2 client_timeout() + +Timeout value, in seconds, after which this transaction should be +aborted. Defaults to 45, the value recommended by the Website +Payments Pro HTTPS Interface Developer's Guide. + +=head2 debug() + +Enable or disble debugging. The value specified here will also set +$Business::OnlinePayment::HTTPS::DEBUG in submit() to aid in +troubleshooting problems. + +=head2 expdate_mmyy() + +The expdate_mmyy() method takes a single scalar argument (typically +the value in $content{expiration}) and attempts to parse and format +and put the date in MMYY format as required by PayflowPro +specification. If unable to parse the expiration date simply leave it +as is and let the PayflowPro system attempt to handle it as-is. + +=head2 request_id() + +It is recommended that you specify your own unique request_id for each +transaction in %content. A request_id is REQUIRED by the PayflowPro +processor. If a request_id is not set, then Digest::MD5 is used to +attempt to generate a request_id for a transaction. =head2 Deprecated methods -The following methods are deprecated and may be removed in the next -release. Values for vendor and partner should now be set using the -param() method or as arguments to Business::OnlinePayment->new(). The -value for cert_path was used to support passing a path to PFProAPI.pm -(a Perl module/SDK from Verisign/Paypal) which is no longer used. +The following methods are deprecated and may be removed in a future +release. Values for vendor and partner should now be set as arguments +to Business::OnlinePayment->new(). The value for cert_path was used +to support passing a path to PFProAPI.pm (a Perl module/SDK from +Verisign/Paypal) which is no longer used. =over 4 @@ -432,6 +544,8 @@ value for cert_path was used to support passing a path to PFProAPI.pm =item cert_path() +=item cvv2_code() + =back =head1 Settings @@ -442,7 +556,7 @@ The following default settings exist: =item server -payflow.verisign.com or test-payflow.verisign.com if +payflowpro.paypal.com or pilot-payflowpro.paypal.com if test_transaction() is TRUE =item port @@ -520,6 +634,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 @@ -568,56 +695,17 @@ follows: N - no match undef - AVS values not available -=head2 cvv2_code() +=head2 cvv2_response() -The cvv2_code() method returns the CVV2MATCH field, which is a +The cvv2_response() method returns the CVV2MATCH field, which is a response message returned with the transaction result. -=head2 expdate_mmyy() - -The expdate_mmyy() method takes a single scalar argument (typically -the value in $content{expiration}) and attempts to parse and format -and put the date in MMYY format as required by PayflowPro -specification. If unable to parse the expiration date simply leave it -as is and let the PayflowPro system attempt to handle it as-is. - -=head2 request_id() - -The request_id() method uses Digest::MD5 to attempt to generate a -request_id for a transaction. It is recommended that you specify your -own unique request_id for each transaction in %content. A request_id -is REQUIRED by the PayflowPro processor. - -=head2 param() - -The param() method is used to get/set object parameters. The param() -method may be called in several different ways: - -Get the value of 'myparam': - - my $value_or_reference = $self->param('myparam'); - -Get a list of all parameters that exist: - - my @params = $self->param(); - -Set multiple parameters at the same time: - - $self->param( - 'key1' => 'val1', - 'key2' => 'val2', - ); - -=head2 debug() - -Enable or disble debugging. The value specified here will also set -$Business::OnlinePayment::HTTPS::DEBUG in submit() to aid in -troubleshooting problems. - =head1 COMPATIBILITY -This module implements an interface to the Payflow Pro Perl API, which -can be downloaded at https://manager.paypal.com/ with a valid login. +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 and Josh Rosenbaum for additional +enhancements and bug fixes. =head1 AUTHORS