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->server('pilot-payflowpro.verisign.com');
    $self->port('443');

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

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

    my %content = $self->content();

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

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

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

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

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

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

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

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

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

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

    $self->map_fields();

    my %content = $self->content;

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

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

    if ( defined( $content{'expiration'} ) && 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->server('test-payflow.verisign.com') if $self->test_transaction;

    $self->revmap_fields(

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

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

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

    my @required = qw( TRXTYPE TENDER PARTNER VENDOR USER PWD );
    if ( $self->transaction_type() eq 'C' ) {    # credit card
        if (   $content{'action'} =~ /^[CDV]$/
            && 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(
        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->cert_path;
    my ( $response, $resultstr ) =
      pfprov4( $self->server, $self->port, arrangeParams(\%params), 25 );

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

    $self->avs_code($avs_code);
    $self->cvv2_code( $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 ( $response->{'RESULT'} eq '0' ) {
        $self->is_success(1);
    }
    else {
        $self->is_success(0);
    }
}

sub arrangeParams {
				my $parmlist = shift;
				my %cleanparms;
				foreach my $key (keys %$parmlist) {
					$parmlist->{$key}=~s/"/'/; #quotes (") are not allowed
					my $length = length($parmlist->{$key}); #we specify the length to allow special chars
					$cleanparms{$key . '[' . $length . ']' } = $parmlist->{$key} if $parmlist->{$key};
				}
				my $str;
				foreach my $key (sort keys %cleanparms) { $str.=$key . '=' . $cleanparms{$key} . '&';
				# print 	$key . '=' . $cleanparms{$key} . "&\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->new(
    'Content-Type'                      => 'text/namevalue',
    'X-VPS-Timeout'                     => '30',
    'X-VPS-VIT-Client-Architecture'     => 'x86',
    'X-VPS-VIT-Client-Certification-Id' => '13',
    'X-VPS-VIT-Client-Type'             => 'Perl',
    'X-VPS-VIT-Client-Version'          => '0.1-dev',
    'X-VPS-VIT-Integration-Product'     => 'Payment::VeriSign',
    'X-VPS-VIT-Integration-Version'     => '0.01',
    'X-VPS-VIT-OS-Name'                 => 'FreeBSD',
    'X-VPS-VIT-OS-Version'              => '5.4-STABLE',
    'X-VPS-Request-Id'                  => $request_id
);

my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new($method, $uri, $headers, $parmlist);
my $response = $ua->request($request);
#print qq{/mainZero/main0/Users/rperry/perl/pfpro_v4.pl $host $port $parmlist $timeout\n=========================\n};
#print $response->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->content . "\n";
#print "Full debug response:\n\n" . Dumper($response);return ($response, undef);
return ($response, undef);
}


1;