package Business::OnlinePayment::PayflowPro;

use strict;
use vars qw($VERSION $DEBUG);
use Carp qw(carp croak);
use CGI;
use Digest::MD5;

use base qw(Business::OnlinePayment::HTTPS);

$VERSION = '0.07_02';
$VERSION = eval $VERSION;
$DEBUG   = 0;

sub request_id {
    my $self = shift;
    my $md5  = Digest::MD5->new();
    $md5->add( $$, time(), rand(time) );
    return $md5->hexdigest();
}

sub param {
    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");
        }
    }
    else {
        return ( keys %$param );
    }
}

sub debug {
    my $self = shift;

    if (@_) {
        my $level = shift || 0;
        if ( ref($self) ) {
            $self->{"__DEBUG"} = $level;
        }
        else {
            $DEBUG = $level;
        }
        $Business::OnlinePayment::HTTPS::DEBUG = $level;
    }
    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",       @_ ); }

sub set_defaults {
    my $self = shift;
    my %opts = @_;

    # standard B::OP methods/data
    $self->server("payflow.verisign.com");
    $self->port("443");
    $self->path("/transaction");

    # module specific data
    if ( $opts{debug} ) {
        $self->debug( $opts{debug} );
        delete $opts{debug};
    }

    $self->param(
        "test_server" => "pilot-payflowpro.verisign.com",
        %opts,
    );
}

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 _revmap_fields {
    my ( $self, %map ) = @_;
    my %content = $self->content();
    foreach ( keys %map ) {
        $content{$_} =
          ref( $map{$_} )
          ? ${ $map{$_} }
          : $content{ $map{$_} };
    }
    $self->content(%content);
}

sub expdate_mmyy {
    my $self       = shift;
    my $expiration = shift;
    my $expdate_mmyy;
    if ( defined($expiration) and $expiration =~ /^(\d+)\D+\d*(\d{2})$/ ) {
        my ( $month, $year ) = ( $1, $2 );
        $expdate_mmyy = sprintf( "%02d", $month ) . $year;
    }
    return defined($expdate_mmyy) ? $expdate_mmyy : $expiration;
}

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

    $self->_map_fields();

    my %content = $self->content;

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

    my $expdate_mmyy = $self->expdate_mmyy( $content{"expiration"} );
    my $zip          = $content{'zip'};
    $zip =~ s/[^[:alnum:]]//g;

    $self->server( $self->param("test_server") ) if $self->test_transaction;

    my $vendor  = $self->param("vendor");
    my $partner = $self->param("partner");

    $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 => $vendor ? \$vendor : 'login',
        PARTNER  => \$partner,
        USER     => 'login',
        PWD      => 'password',
        TRXTYPE  => 'action',
        TENDER   => 'type',
        ORIGID   => 'order_number',
        COMMENT1 => 'description',
        COMMENT2 => 'invoice_number',

        ACCT    => 'card_number',
        CVV2    => 'cvv2',
        EXPDATE => \$expdate_mmyy,    # 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
          )
    );

    # get header data, get request_id from %content if defined for ease of use
    my %req_headers = %{ $self->param("headers") || {} };
    if ( defined $content{"request_id"} ) {
        $req_headers{"X-VPS-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-VIT-CLIENT-CERTIFICATION-ID"} ) ) {
        $req_headers{"X-VPS-VIT-CLIENT-CERTIFICATION-ID"} =
          $self->param("client_certification_id");
    }

    my %options = (
        "Content-Type" => "text/namevalue",
        "headers"      => \%req_headers,
    );

    my ( $page, $resp, %resp_headers ) =
      $self->https_post( \%options, \%params );

    $self->param(
        "transaction_response" => {
            page     => $page,
            response => $resp,
            headers  => \%resp_headers,
        },
    );

    # $page should contain name=value[[&name=value]...] pairs
    my $cgi = CGI->new("$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" ) {
            $avs_code = "Y";
        }
        elsif ( $cgi->param("AVSADDR") eq "Y" ) {
            $avs_code = "A";
        }
        elsif ( $cgi->param("AVSZIP") eq "Y" ) {
            $avs_code = "Z";
        }
        elsif ( $cgi->param("AVSADDR") eq "N" or $cgi->param("AVSZIP") eq "N" )
        {
            $avs_code = "N";
        }
        else {
            $avs_code = "";
        }
    }

    $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") );

    # RESULT must be an explicit zero, not just numerically equal
    if ( $cgi->param("RESULT") eq "0" ) {
        $self->is_success(1);
    }
    else {
        $self->is_success(0);
    }
}

1;

__END__

=head1 NAME

Business::OnlinePayment::PayflowPro - Payflow Pro backend for Business::OnlinePayment

=head1 SYNOPSIS

  use Business::OnlinePayment;
  
  my $tx = new Business::OnlinePayment(
      'PayflowPro',
      'vendor'    => 'your_vendor',
      'partner'   => 'your_partner',
      'client_certification_id' => 'assigned_certification_id',
  );
  
  # See the module documentation for details of content()
  $tx->content(
      type           => 'VISA',
      action         => 'Normal Authorization',
      description    => 'Business::OnlinePayment::PayflowPro test',
      amount         => '49.95',
      invoice_number => '100100',
      customer_id    => 'jsk',
      name           => 'Jason Kohles',
      address        => '123 Anystreet',
      city           => 'Anywhere',
      state          => 'GA',
      zip            => '30004',
      email          => 'ivan-payflowpro@420.am',
      card_number    => '4111111111111111',
      expiration     => '12/09',
      cvv2           => '123',
      order_number   => 'string',
      request_id     => 'unique_identifier_for_transaction',
  );
  
  $tx->submit();
  
  if ( $tx->is_success() ) {
      print(
          "Card processed successfully: ", $tx->authorization, "\n",
          "order number: ",                $tx->order_number,  "\n",
          "CVV2 code: ",                   $tx->cvv2_code,     "\n",
          "AVS code: ",                    $tx->avs_code,      "\n",
      );
  }
  else {
      my $info = "";
      $info = " (CVV2 mismatch)" if ( $tx->result_code == 114 );
      
      print(
          "Card was rejected: ", $tx->error_message, $info, "\n",
          "order number: ",      $tx->order_number,         "\n",
      );
  }

=head1 DESCRIPTION

This module is a back end driver that implements the interface
specified by L<Business::OnlinePayment> to support payment handling
via the PayPal's Payflow Pro Internet payment solution.

See L<Business::OnlinePayment> for details on the interface this
modules supports.

=head1 Standard methods

=over 4

=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
L</Module specific methods> described below.

=item submit()

=back

=head1 Module specific methods

This module provides the following methods which are not currently
part of the standard Business::OnlinePayment interface:

=over 4

=item L<order_number()|/order_number()>

=item L<avs_code()|/avs_code()>

=item L<cvv2_code()|/cvv2_code()>

=item L<expdate_mmyy()|/expdate_mmyy()>

=item L<requeset_id()/request_id()>

=item L<param()|/param()>

=item L<debug()|/debug()>

=back

=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.

=over 4

=item vendor()

=item partner()

=item cert_path()

=back

=head1 Settings

The following default settings exist:

=over 4

=item server

payflow.verisign.com or test-payflow.verisign.com if
test_transaction() is TRUE

=item port

443

=back

=head1 Handling of content(%content)

The following rules apply to content(%content) data:

=head2 action

If 'action' matches one of the following keys it is replaced by the
right hand side value:

  'normal authorization' => 'S', # Sale transaction
  'credit'               => 'C', # Credit (refund)
  'authorization only'   => 'A', # Authorization
  'post authorization'   => 'D', # Delayed Capture
  'void'                 => 'V',

If 'action' is 'C', 'D' or 'V' and 'order_number' is not set then
'amount', 'card_number' and 'expiration' must be set.

=head2 type

If 'type' matches one of the following keys it is replaced by the
right hand side value:

  'visa'               => 'C',
  'mastercard'         => 'C',
  'american express'   => 'C',
  'discover'           => 'C',
  'cc'                 => 'C',

The value of 'type' is used to set transaction_type().  Currently this
module only supports a transaction_type() of 'C' any other values will
cause Carp::croak() to be called in submit().

Note: Payflow Pro supports multiple credit card types, including:
American Express/Optima, Diners Club, Discover/Novus, Enroute, JCB,
MasterCard and Visa.

=head1 Setting Payflow Pro parameters from content(%content)

The following rules are applied to map data to Payflow Pro parameters
from content(%content):

      # PFP param => $content{<key>}
      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-alphanumerics removed
      COUNTRY     => 'country',

The required Payflow Pro parameters for credit card transactions are:

  TRXTYPE TENDER PARTNER VENDOR USER PWD ORIGID

=head1 Mapping Payflow Pro transaction responses to object methods

The following methods provides access to the transaction response data
resulting from a Payflow Pro request (after submit()) is called:

=head2 order_number()

This order_number() method returns the PNREF field, also known as the
PayPal Reference ID, which is a unique number that identifies the
transaction.

=head2 result_code()

The result_code() method returns the RESULT field, which is the
numeric return code indicating the outcome of the attempted
transaction.

A RESULT of 0 (zero) indicates the transaction was approved and
is_success() will return '1' (one/TRUE).  Any other RESULT value
indicates a decline or error and is_success() will return '0'
(zero/FALSE).

=head2 error_message()

The error_message() method returns the RESPMSG field, which is a
response message returned with the transaction result.

=head2 authorization()

The authorization() method returns the AUTHCODE field, which is the
approval code obtained from the processing network.

=head2 avs_code()

The avs_code() method returns a combination of the AVSADDR and AVSZIP
fields from the transaction result.  The value in avs_code is as
follows:

  Y     - Address and ZIP match
  A     - Address matches but not ZIP
  Z     - ZIP matches but not address
  N     - no match
  undef - AVS values not available

=head2 cvv2_code()

The cvv2_code() 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.

=head1 AUTHORS

Ivan Kohler <ivan-payflowpro@420.am>

Phil Lobbes E<lt>phil at perkpartners.comE<gt>

Based on Business::OnlinePayment::AuthorizeNet written by Jason Kohles.

=head1 SEE ALSO

perl(1), L<Business::OnlinePayment>, L<Carp>, and the PayPal
Integration Center Payflow Pro resources at
L<https://www.paypal.com/IntegrationCenter/ic_payflowpro.html>

=cut
