<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Business::OnlinePayment::PayflowPro_v4;

use strict;
use vars qw($VERSION);
use Carp qw(croak);
use base qw(Business::OnlinePayment);
use LWP;
use Digest::MD5 qw(md5_base64);
use Data::Dumper;
require HTTP::Request;
require HTTP::Headers;


# Payflow Pro SDK
#use PFProAPI qw( pfpro );

$VERSION = '0.06';
$VERSION = eval $VERSION;

sub set_defaults {
    my $self = shift;
#https://payflowlink.paypal.com
    $self-&gt;server('pilot-payflowpro.verisign.com');
    $self-&gt;port('443');

    $self-&gt;build_subs(
        qw(
          vendor partner cert_path order_number avs_code cvv2_code
          )
    );
}

sub map_fields {
    my ($self) = @_;

    my %content = $self-&gt;content();

    #ACTION MAP
    my %actions = (
        'normal authorization' =&gt; 'S',    # Sale transaction
        'credit'               =&gt; 'C',    # Credit (refund)
        'authorization only'   =&gt; 'A',    # Authorization
        'post authorization'   =&gt; 'D',    # Delayed Capture
        'void'                 =&gt; 'V',    # Void
    );

    $content{'action'} = $actions{ lc( $content{'action'} ) }
      || $content{'action'};

    # TYPE MAP
    my %types = (
        'visa'             =&gt; 'C',
        'mastercard'       =&gt; 'C',
        'american express' =&gt; 'C',
        'discover'         =&gt; 'C',
        'cc'               =&gt; 'C',
        #'check'            =&gt; 'ECHECK',
    );

    $content{'type'} = $types{ lc( $content{'type'} ) } || $content{'type'};

    $self-&gt;transaction_type( $content{'type'} );

    # stuff it back into %content
    $self-&gt;content(%content);
}

sub remap_fields {
    my ( $self, %map ) = @_;

    my %content = $self-&gt;content();
    foreach ( keys %map ) {
        $content{ $map{$_} } = $content{$_};
    }
    $self-&gt;content(%content);
}

sub revmap_fields {
    my ( $self, %map ) = @_;
    my %content = $self-&gt;content();
    foreach ( keys %map ) {
        $content{$_} =
          ref( $map{$_} )
          ? ${ $map{$_} }
          : $content{ $map{$_} };
    }
    $self-&gt;content(%content);
}

sub submit {
    my ($self) = @_;

    $self-&gt;map_fields();

    my %content = $self-&gt;content;

    my ( $month, $year, $zip );

    if ( $self-&gt;transaction_type() ne 'C' ) {
        croak( "PayflowPro can't (yet?) handle transaction type: "
              . $self-&gt;transaction_type() );
    }

    if ( defined( $content{'expiration'} ) &amp;&amp; length( $content{'expiration'} ) )
    {
        $content{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
          or croak "unparsable expiration $content{expiration}";

        ( $month, $year ) = ( $1, $2 );
        $month = '0' . $month if $month =~ /^\d$/;
    }

    ( $zip = $content{'zip'} ) =~ s/[^[:alnum:]]//g;

    $self-&gt;server('test-payflow.verisign.com') if $self-&gt;test_transaction;

    $self-&gt;revmap_fields(

        # (BUG?) VENDOR B::OP:PayflowPro &lt; 0.05 backward compatibility.  If
        # vendor not set use login (although test indicate undef vendor is ok)
        VENDOR      =&gt; $self-&gt;vendor ? \( $self-&gt;vendor ) : 'login',
        PARTNER     =&gt; \( $self-&gt;partner ),
        USER        =&gt; 'login',
        PWD         =&gt; 'password',
        TRXTYPE     =&gt; 'action',
        TENDER      =&gt; 'type',
        ORIGID      =&gt; 'order_number',
        COMMENT1    =&gt; 'description',
        COMMENT2    =&gt; 'invoice_number',

        ACCT        =&gt; 'card_number',
        CVV2        =&gt; 'cvv2',
        EXPDATE     =&gt; \( $month . $year ), # MM/YY from 'expiration'
        AMT         =&gt; 'amount',

        FIRSTNAME   =&gt; 'first_name',
        LASTNAME    =&gt; 'last_name',
        NAME        =&gt; 'name',
        EMAIL       =&gt; 'email',
        COMPANYNAME =&gt; 'company',
        STREET      =&gt; 'address',
        CITY        =&gt; 'city',
        STATE       =&gt; 'state',
        ZIP         =&gt; \$zip,               # 'zip' with non-alnums removed
        COUNTRY     =&gt; 'country',
    );

    my @required = qw( TRXTYPE TENDER PARTNER VENDOR USER PWD );
    if ( $self-&gt;transaction_type() eq 'C' ) {    # credit card
        if (   $content{'action'} =~ /^[CDV]$/
            &amp;&amp; defined( $content{'ORIGID'} )
            &amp;&amp; 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-&gt;required_fields(@required);

    my %params = $self-&gt;get_fields(
        qw(
          VENDOR PARTNER USER PWD TRXTYPE TENDER ORIGID COMMENT1 COMMENT2
          ACCT CVV2 EXPDATE AMT
          FIRSTNAME LASTNAME NAME EMAIL COMPANYNAME
          STREET CITY STATE ZIP COUNTRY
          )
    );

#    $ENV{'PFPRO_CERT_PATH'} = $self-&gt;cert_path;
    my ( $response, $resultstr ) =
      pfprov4( $self-&gt;server, $self-&gt;port, arrangeParams(\%params), 25 );

    # AVS and CVS values may be set on success or failure
    my $avs_code;
    if ( exists $response-&gt;{AVSADDR} || exists $response-&gt;{AVSZIP} ) {
        if ( $response-&gt;{AVSADDR} eq 'Y' &amp;&amp; $response-&gt;{AVSZIP} eq 'Y' ) {
            $avs_code = 'Y';
        }
        elsif ( $response-&gt;{AVSADDR} eq 'Y' ) {
            $avs_code = 'A';
        }
        elsif ( $response-&gt;{AVSZIP} eq 'Y' ) {
            $avs_code = 'Z';
        }
        elsif ( $response-&gt;{AVSADDR} eq 'N' || $response-&gt;{AVSZIP} eq 'N' ) {
            $avs_code = 'N';
        }
        else {
            $avs_code = '';
        }
    }

    $self-&gt;avs_code($avs_code);
    $self-&gt;cvv2_code( $response-&gt;{'CVV2MATCH'} );
    $self-&gt;result_code( $response-&gt;{'RESULT'} );
    $self-&gt;order_number( $response-&gt;{'PNREF'} );
    $self-&gt;error_message( $response-&gt;{'RESPMSG'} );
    $self-&gt;authorization( $response-&gt;{'AUTHCODE'} );

    # RESULT must be an explicit zero, not just numerically equal
    if ( $response-&gt;{'RESULT'} eq '0' ) {
        $self-&gt;is_success(1);
    }
    else {
        $self-&gt;is_success(0);
    }
}

sub arrangeParams {
				my $parmlist = shift;
				my %cleanparms;
				foreach my $key (keys %$parmlist) {
					$parmlist-&gt;{$key}=~s/"/'/; #quotes (") are not allowed
					my $length = length($parmlist-&gt;{$key}); #we specify the length to allow special chars
					$cleanparms{$key . '[' . $length . ']' } = $parmlist-&gt;{$key} if $parmlist-&gt;{$key};
				}
				my $str;
				foreach my $key (sort keys %cleanparms) { $str.=$key . '=' . $cleanparms{$key} . '&amp;';
				# print 	$key . '=' . $cleanparms{$key} . "&amp;\n";
				}
				chop($str);
				return $str;
				}
				

sub pfprov40 {
	my $host = shift;
my $port = shift;
my $parmlist = shift || arrangeParams(shift);
my $timeout = shift;
local @ARGV=( $host, $port, $parmlist, $timeout);
require '/mainZero/main0/Users/rperry/perl/pfpro_v4.pl';
	return (undef);
}


sub pfprov4 {
use strict;
use LWP;
use Digest::MD5 qw(md5_base64);
use Data::Dumper;
require HTTP::Request;
require HTTP::Headers;

my $host = shift;
my $port = shift;
my $parmlist = shift;
my $timeout = shift;
# you might not actually be using these, and I haven't actually
# implemented any support for them:
my $proxyhost = shift || '';
my $proxyport = shift || '';
my $proxylogin = shift || '';
my $proxypass = shift || '';

my $method = 'POST';
my $uri = 'https://' . $host . ':' . $port .  '/transaction';

## Here's where you get to customize: this could be anything, but I don't
## ever want a duplicate response in testing, so I just go straight off the time;
## alternatively, this could be based on some extract of the parmlist, or
## whatever:
my $request_id = md5_base64(time());

my $headers = HTTP::Headers-&gt;new(
    'Content-Type'                      =&gt; 'text/namevalue',
    'X-VPS-Timeout'                     =&gt; '30',
    'X-VPS-VIT-Client-Architecture'     =&gt; 'x86',
    'X-VPS-VIT-Client-Certification-Id' =&gt; '13',
    'X-VPS-VIT-Client-Type'             =&gt; 'Perl',
    'X-VPS-VIT-Client-Version'          =&gt; '0.1-dev',
    'X-VPS-VIT-Integration-Product'     =&gt; 'Payment::VeriSign',
    'X-VPS-VIT-Integration-Version'     =&gt; '0.01',
    'X-VPS-VIT-OS-Name'                 =&gt; 'FreeBSD',
    'X-VPS-VIT-OS-Version'              =&gt; '5.4-STABLE',
    'X-VPS-Request-Id'                  =&gt; $request_id
);

my $ua = LWP::UserAgent-&gt;new;
my $request = HTTP::Request-&gt;new($method, $uri, $headers, $parmlist);
my $response = $ua-&gt;request($request);
#print qq{/mainZero/main0/Users/rperry/perl/pfpro_v4.pl $host $port $parmlist $timeout\n=========================\n};
#print $response-&gt;content . "\n";
## Uncomment the next three lines if you want to inspect things more closely:
#print "Using server address $uri\n\n";
#print "Basic Response:\n\n" . $response-&gt;content . "\n";
#print "Full debug response:\n\n" . Dumper($response);return ($response, undef);
return ($response, undef);
}


1;
</pre></body></html>