path: root/vSecureProcessing.pm

package Business::OnlinePayment::vSecureProcessing;

use strict;
use URI::Escape;
use Carp;
use Template;
use XML::Simple;
use Data::Dumper;
use MIME::Entity;

use Business::OnlinePayment;
use Business::OnlinePayment::HTTPS;
#use Net::SSLeay qw(post_http post_https make_headers make_form);
use vars qw($VERSION $DEBUG @ISA $me);

@ISA = qw(Business::OnlinePayment::HTTPS);
$DEBUG = 3;
$VERSION = '0.01';
$me = 'Business::OnlinePayment::vSecureProcessing';


# $server: http://dvrotsos2.kattare.com

# mapping out all possible endpoints
# but this version will only be building out "charge", "void", & "credit"
my %payment_actions = (
	'charge' => {
        path      => '/vsg2/processpayment',
    },
	'void' => {
        path      => '/vsg2/processvoid',
    },
	'refund' => {
        path      => '/vsg2/processrefund',
    },
	'authorize' => {
        path      => '/vsg2/processauth',
    },
	'authorize_cancel' => {
        path      => '/vsg2/processauthcancel',
    },
	'capture' => {
        path      => '/vsg2/processcaptureonly',
    },
	'create_token' => {
        path      => '/vsg2/createtoken',
    },
	'delete_token' => {
        path      => '/vsg2/deletetoken',
    },
	'query_token' => {
        path      => '/vsg2/querytoken',
    },
	'update_exp_date' => {
        path      => '/vsg2/updateexpiration',
    },
	'update_token' => {
        path      => '/vsg2/updatetoken',
    },

);

my %action_mapping = (
	'normal authorization'	=> 'charge',
	'credit'				=> 'refund',
	'authorization only'	=> 'authorize',
	'post authorization'	=> 'capture',
	'reverse authorization' => 'authorize_cancel'
	# void => void
);

BEGIN{
eval 'use bytes; sub blength ($) { length $_[0] }';
$@ and eval '    sub blength ($) { length $_[0] }' ;
}
sub Net::SSLeay::do_httpx3 {
    my ($method, $usessl, $site, $port, $path, $headers,
        $content, $mime_type, $crt_path, $key_path) = @_;
    my ($response, $page, $h,$v);
	my $CRLF = "\x0d\x0a";  # because \r\n is not fully portable
    if ($content) {
        $mime_type = "";#application/x-www-form-urlencoded" unless $mime_type;
        my $len = blength($content);
        #$content = "$mime_type${CRLF}Content-Length: $len$CRLF$CRLF$content";
        $content = "Cache-Control: no-cache$CRLF"
        	. "Content-Type: multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C$CRLF"
        	. "Accept: */*$CRLF"
            . "Content-Length: $len$CRLF$CRLF$content";
    } else {
        $content = "$CRLF$CRLF";
    }
    my $req = "$method $path HTTP/1.1$CRLF";
    unless (defined $headers && $headers =~ /^Host:/m) {
        $req .= "Host: $site";
        unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
            $req .= ":$port";
        }
        $req .= $CRLF;
    }
    $req .= (defined $headers ? $headers : '') . "$content";

    warn "do_httpx3($method,$usessl,$site:$port)" if $DEBUG;
    my ($http, $errs, $server_cert)
        = Net::SSLeay::httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
    return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;

    $http = '' if !defined $http;
    ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
    warn "headers >$headers< page >>$page<< http >>>$http<<<" if $DEBUG>1;
    ($response, $headers) = split /\s?\n/, $headers, 2;
    return ($page, $response, $headers, $server_cert);
};

sub Net::SSLeay::make_form {
    my (@fields) = @_;
    my $form;
    while (@fields) {
        my ($name, $data) = (shift(@fields), shift(@fields));
#       $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
#       $data =~ tr[ ][+];
        $form .= "$name=$data&";
    }
    chop $form;
    return $form;
}

sub set_defaults {
	my $self = shift;
	my %options = @_;
    
    # inistialize standard B::OP attributes
	$self->is_success(0);
    $self->$_( '' ) for qw/authorization
                           result_code
                           error_message
                           server
                           port
                           path
                           server_response/;
                           
    # B::OP creates the following accessors:
    #     server, port, path, test_transaction, transaction_type,
    #     server_response, is_success, authorization,
    #     result_code, error_message,
    
    $self->build_subs(qw/
            env platform userid gid tid appid action
            cvv_response avs_response risk_score
    /);
    
    $DEBUG = exists($options{debug}) ? $options{debug} : $DEBUG;
    
    
    
    $self->server($options{'url'});
    
    $self->gid($options{'gid'});
    
    $self->tid($options{'tid'});
    
    $self->platform($options{'platform'});
    
    $self->appid($options{'appid'});
    
    $self->env((defined($options{'env'})) ? $options{'env'} : 'live'); # 'live'/'test'
	
# 	$self->port(($options{'env'} eq 'test') ? 80 : 443);
	$self->port(443);
}



sub clean_content {
	my ($self,$content) = @_;
	my %content = $self->content();
	
	{
		no warnings 'uninitialized';
		
		# strip non-digits from card number
		my $card_number = '';
		if ( $content{card_number} ) {
		    $content{card_number} =~ s/\D//g;
		}
		
		# separate month and year values for expiry_date
		if ( $content{expiration} ) {
		    ($content{exp_month}, $content{exp_year}) = split /\//, $content{expiration};
		    $content{exp_month} = sprintf "%02d", $content{exp_month};
		    $content{exp_year}  = substr($content{exp_year},0,2) if ($content{exp_year} > 99);
		}
		
		if (!$content{'first_name'} || !$content{'last_name'} && $content{'name'}) {
		    ($content{'first_name'}, $content{'last_name'}) = split(' ', $content{'name'}, 2);
		}
		
		if ($content{'address'} =~ m/[\D ]*(\d+)\D/) {
			$content{'street_number'} = $1;
		}
	}
	warn "Content after cleaning:\n".Dumper(\%content)."\n" if ($DEBUG >2);
	$self->content(%content);
}

sub process_content {
	my $self = shift;
	$self->clean_content();
	my %content = $self->content();
	$self->action(($action_mapping{lc $content{'action'}}) ? $action_mapping{lc $content{'action'}} : lc $content{'action'});
    $self->path($payment_actions{ $self->action }{path});
    $self->appid($content{appid}) if (!$self->appid && $content{appid});
}

sub submit {
	my $self = shift;
	
    # inistialize standard B::OP attributes
	$self->is_success(0);
    $self->$_( '' ) for qw/authorization
                           result_code
                           error_message
                           server_response/;
                           
	# clean and process the $self->content info
	$self->process_content();
	my %content = $self->content;
	my $action = $self->action();
	
	my @acceptable_actions = ('charge', 'refund', 'void');
	
	unless ( grep { $action eq $_ } @acceptable_actions ) {
	    croak "'$action' is not supported at this time.";
	}
	
	# fill out the template vars
	my $template_vars = {
		
		auth => {
			platform	=> $self->platform,
			userid		=> $self->userid,
			gid			=> $self->gid,
			tid			=> $self->tid
		},
		
		payment => {
			amount			=> $content{'amount'},
			track1			=> ($content{'track1'}) ? $content{'track1'} : '',
			track2			=> ($content{'track2'}) ? $content{'track2'} : '',
			type			=> ($content{'description'}) ? $content{'description'} : '',
			cf1				=> ($content{'UDField1'}) ? $content{'UDField1'} : '',
			cf2				=> ($content{'UDField2'}) ? $content{'UDField2'} : '',
			cf3				=> '',
			account_number	=> ($content{'card_number'}) ? $content{'card_number'} : '',
			exp_month		=> $content{'exp_month'},
			exp_year		=> $content{'exp_year'},
			cvv				=> ($content{'cvv'}) ? $content{'cvv'} : ($content{'cvv2'}) ? $content{'cvv2'} : '',
			first_name		=> ($content{'first_name'}) ? $content{'first_name'} : '',
			last_name		=> ($content{'last_name'}) ? $content{'last_name'} : '',
			postal_code		=> ($content{'zip'}) ? $content{'zip'} : '',
			street_address	=> ($content{'street_number'}) ? $content{'street_number'} : '',
			industry_type	=> ($content{'IndustryInfo'} && lc($content{'IndustryInfo'}) eq 'ecommerce') ? 'ecom_3' : '',
			invoice_num		=> ($content{'invoice_number'}) ? $content{'invoice_number'} : '',
			appid			=> $self->appid(),
			recurring		=> ($content{'recurring_billing'} && $content{'recurring_billing'} eq 'YES' ) ? 1 : 0,
			response_code   => ($content{'response_code'}) ? $content{'response_code'} : '',
			reference_number=> ($content{'ref_num'}) ? $content{'ref_num'} : '',
			token           => ($content{'token'}) ? $content{'token'} : '',
			receipt         => ($content{'receipt'}) ? $content{'receipt'} : '',
			transaction_date=> ($content{'txn_date'}) ? $content{'txn_date'} : '',
			merchant_data   => ($content{'merchant_data'}) ? $content{'merchant_data'} : '',
		},
		
		# we won't be using level2 nor level3.  So I'm leaving them blank for now.
        level2 => {
        	card_type				=> '',
			purchase_code			=> '',
			country_code			=> '',
			ship_tp_postal_code		=> '',
			ship_from_postal_code	=> '',
			sales_tax				=> '',
			product_description1	=> '',
			product_description2	=> '',
			product_description3	=> '',
			product_description4	=> ''
        },
        
        level3 => {
        	purchase_order_num	=> '',
			order_date			=> '',
			duty_amount			=> '',
			alt_tax_amount		=> '',
			discount_amount		=> '',
			freight_amount		=> '',
			tax_exempt			=> '',
			line_item_count		=> '',
        	purchase_items		=> $self->_parse_line_items()
        }
    };
    
  
    # create the list of required fields based on the action
	my @required_fields = qw/ amount /;
	if ($action eq 'charge') {
	    push(@required_fields, $_) foreach (qw/ account_number cvv exp_month exp_year /);
	}elsif ($action eq 'void') {
	    push(@required_fields, $_) foreach (qw/ response_code reference_number receipt token transaction_date exp_month exp_year /);
	}elsif ($action eq 'refund') {
	    push(@required_fields, $_) foreach (qw/ merchant_data token account_number exp_month exp_year /);
    }
	
	# check the requirements are met.
	my @missing_fields;
	foreach my $field (@required_fields) {
	    push(@missing_fields, $field) if (!$template_vars->{payment}{$field});
	}
	if (scalar(@missing_fields)) {
	    croak "Missing required fields: ".join(', ', @missing_fields);
	}
	
	# read in the appropriate xml template
	my $xml_template .= _get_xml_template( $action );
    # create a template object.
    my $tt = Template->new();
	# populate the XML template.
	my $xml_data;
    $tt->process( \$xml_template, $template_vars, \$xml_data ) || croak $tt->error();
	
    warn "XML:\n$xml_data\n" if $DEBUG > 2;
    
#     my $opts = {'Content-Type' => 'multipart/form-data'};
    my $opts = {'Cache-Control' => 'no-cache', 'Content-Type' => 'multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C'};
    my $params = {param => $xml_data};
    my $content = qq|----FormBoundaryE19zNvXGzXaLvS5C
Content-Disposition: form-data; name="param"

${xml_data}
----FormBoundaryE19zNvXGzXaLvS5C--|;
	my ( $page, $server_response, %headers ) = $self->https_post( $opts, $content );
  
    # store the server response.
    $self->server_response($server_response);
    # parse the result page.
    $self->parse_response($page);
    
    if (!$self->is_success() && !$self->error_message() ) {
        if ( $DEBUG ) {
            #additional logging information, possibly too sensitive for an error msg
            # (vSecureProcessing seems to have a failure mode where they return the full
            #  original request including card number)
            $self->error_message(
              "(HTTPS response: ".$server_response.") ".
              "(HTTPS headers: ".
            join(", ", map { "$_ => ". $headers{$_} } keys %headers ). ") ".
              "(Raw HTTPS content: ".$page.")"
            );
        } else {
            $self->error_message('No error information was returned by vSecureProcessing (enable debugging for raw HTTPS response)');
        }
    }
    
}

# read $self->server_response and decipher any errors
sub parse_response {
	my $self = shift;
	my $page = shift;

    if ($self->server_response =~ /^200/) {
	    my $response = XMLin($page);
	    $self->result_code($response->{Status});
	    $self->avs_response($response->{AvsResponse});
	    $self->cvv_response($response->{CvvResponse});
	    $self->is_success($self->result_code() eq '0' ? 1 : 0);
    	if ($self->is_success()) {
    	    $self->authorization($response->{AuthIdentificationResponse});
    	}
    	# fill in error_message if there is is an error
        if ( !$self->is_success && exists($response->{ResultCode})) {
            $self->error_message('Error '.$response->{ResponseCode}.': '.$response->{ResultCode});
        }elsif ( !$self->is_success && exists($response->{Receipt}) ) {
            $self->error_message('Error '.$response->{ResponseCode}.': '.(exists($response->{Receipt})) ? $response->{Receipt} : '');
        }
	    
	}else {
	    $self->is_success(0);
	    $self->error_message('Error communicating with vSecureProcessing server');
	    return;
	}
	
	
}

sub _get_xml_template {
	my $action = shift;
	
	my $xml_template = q|<Request >
    <MerchantData> 
		<Platform>[% auth.platform %]</Platform>
		<UserId>[% auth.userid %]</UserId> 
		<GID>[% auth.gid %]</GID>
		<Tid>[% auth.tid %]</Tid>
	</MerchantData>
	|;
	
	if ($action eq 'charge') {
		$xml_template .= _get_xml_template_charge();
	}elsif($action eq 'void') {
		$xml_template .= _get_xml_template_void();
	}elsif($action eq 'authorize') {
		$xml_template .= _get_xml_template_auth();
	}elsif($action eq 'authorize_cancel') {
		$xml_template .= _get_xml_template_auth_cancel();
	}elsif($action eq 'refund') {
		$xml_template .= _get_xml_template_refund();
	}elsif($action eq 'capture') {
		$xml_template .= _get_xml_template_capture();
	}elsif($action eq 'create_token') {
		$xml_template .= _get_xml_template_create_token();
	}elsif($action eq 'delete_token') {
		$xml_template .= _get_xml_template_delete_token();
	}elsif($action eq 'query_token') {
		$xml_template .= _get_xml_template_query_token();
	}elsif($action eq 'update_exp_date') {
		$xml_template .= _get_xml_template_update_exp_date();
	}elsif($action eq 'update_token') {
		$xml_template .= _get_xml_template_update_token();
	}
	
	$xml_template .= "</Request>";
	$xml_template =~ s/[\n\t\s]*//g;
	
	return $xml_template;
}

sub _get_xml_template_charge {
	my $xml_template = q|<ProcessPayment>
		<Amount>[% payment.amount %]</Amount>
		<Trk1>[% payment.track1 %]</Trk1>
		<Trk2>[% payment.track2 %]</Trk2>
		<TypeOfSale>[% payment.type %]</TypeOfSale>
		<Cf1>[% payment.cf1 %]</Cf1>
		<Cf2>[% payment.cf2 %]</Cf2>
		<Cf3>[% payment.cf3 %]</Cf3>
		<AccountNumber>[% payment.account_number %]</AccountNumber>
		<ExpirationMonth>[% payment.exp_month %]</ExpirationMonth>
		<ExpirationYear>[% payment.exp_year %]</ExpirationYear>
		<Cvv>[% payment.cvv %]</Cvv>
		<CardHolderFirstName>[% payment.first_name %]</CardHolderFirstName>
		<CardHolderLastName>[% payment.last_name %]</CardHolderLastName>
		<AvsZip>[% payment.postal_code %]</AvsZip>
		<AvsStreet>[% payment.street_address %]</AvsStreet>
		<IndustryType>
			<IndType >[% payment.industry_type %]</IndType >
			<IndInvoice>[% payment.invoice_num %]</IndInvoice>
		</IndustryType>
		<ApplicationId>[% payment.appid %]</ApplicationId>
		<Recurring>[% payment.recurring %]</Recurring>
	</ProcessPayment>|;
	
	# other options (that we are not using right now):	
# 	<Level2PurchaseInfo>
# 		<Level2CardType>[% level2.card_type %]</Level2CardType >
# 		<PurchaseCode>[% level2.purchase_code %]</PurchaseCode>
# 		<ShipToCountryCode>[% level2.country_code %]</ShipToCountryCode>
# 		<ShipToPostalCode>[% level2.ship_tp_postal_code %]</ShipToPostalCode>
# 		<ShipFromPostalCode>[% level2.ship_from_postal_code %]</ShipFromPostalCode>
# 		<SalesTax>[% level2.sales_tax %]</SalesTax>
# 		<ProductDescription1>[% level2.product_description1 %]</ProductDescription1>
# 		<ProductDescription2>[% level2.product_description2 %]</ProductDescription2>
# 		<ProductDescription3>[% level2.product_description3 %]</ProductDescription3>
# 		<ProductDescription4>[% level2.product_description4 %]</ProductDescription4>
# 	</Level2PurchaseInfo>
# 	<Level3PurchaseInfo>
# 		<PurchaseOrderNumber>[% level3.purchase_order_num %]</PurchaseOrderNumber>
# 		<OrderDate>[% level3.order_date %]</OrderDate>
# 		<DutyAmount>[% level3.duty_amount %]</DutyAmount>
# 		<AlternateTaxAmount>[% level3.alt_tax_amount %]</AlternateTaxAmount>
# 		<DiscountAmount>[% level3.discount_amount %]</DiscountAmount>
# 		<FreightAmount>[% level3.freight_amount %]</FreightAmount>
# 		<TaxExemptFlag>[% level3.tax_exempt %]</TaxExemptFlag>
# 		<LineItemCount>[% level3.line_item_count %]</LineItemCount>
# 		<PurchaseItems>
# 			[% level3.purchase_items %]
# 		</PurchaseItems>
# 	</Level3PurchaseInfo>

	return $xml_template;
}

sub _parse_line_items {
	my $self = shift;
	my %content = $self->content();
	
	return '' if (!$content{'items'});
	
	my @line_items;
	my $template = q|			<LineItem>
				<ItemSequenceNumber>[% seq_num %]</ItemSequenceNumber>
				<ItemCode>[% code %]</ItemCode>
				<ItemDescription>[% desc %]</ItemDescription>
				<ItemQuantity>[% qty %]</ItemQuantity>
				<ItemUnitOfMeasure>[% unit %]</ItemUnitOfMeasure>
				<ItemUnitCost>[% unit_cost %]</ItemUnitCost>
				<ItemAmount>[% amount %]</ItemAmount>
				<ItemDiscountAmount>[% discount_amount %]</ItemDiscountAmount>
				<ItemTaxAmount>[% tax_amount %]</ItemTaxAmount>
				<ItemTaxRate>[% tax_rate %]</ItemTaxRate>
			</LineItem>|;
	
	
	my @items = $content{'items'};
	foreach my $item (@items) {
		# fille in the slots from $template with details in $item
		# push to @line_items
	}
	
	return join("\n", @line_items);
}

sub _get_xml_template_void {
	my $xml_template = q|<ProcessVoid>
        <Amount>[% payment.amount %]</Amount>
        <AccountNumber>[% payment.account_number %]</AccountNumber>
        <ExpirationMonth>[% payment.exp_month %]</ExpirationMonth>
        <ExpirationYear>[% payment.exp_year %]</ExpirationYear>
        <ReferenceNumber>[% payment.reference_number %]</ReferenceNumber>
        <TransactionDate/>
        <IndustryType1>[% payment.industry_type %]</IndustryType1>
        <ApplicationId>[% payment.appid %]</ApplicationId>
    </ProcessVoid>|;

	return $xml_template;
}

sub _get_xml_template_refund {
	my $xml_template = q|<ProcessRefund>
        <Amount>[% payment.amount %]</Amount>
        <AccountNumber>[% payment.account_number %]</AccountNumber>
        <ExpirationMonth>[% payment.exp_month %]</ExpirationMonth>
        <ExpirationYear>[% payment.exp_year %]</ExpirationYear>
        <ApplicationId>[% payment.appid %]</ApplicationId>
    </ProcessRefund>|;

	return $xml_template;
}

sub _get_xml_template_auth {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_auth_cancel {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_capture {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_create_token {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_delete_token {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_query_token {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_update_exp_date {
	my $xml_template = '';

	return $xml_template;
}

sub _get_xml_template_update_token {
	my $xml_template = '';

	return $xml_template;
}


1;
__END__


=head1 NAME

Business::OnlinePayment::vSecureProcessing - vSecureProcessing backend for Business::OnlinePayment

=head1 SYNOPSIS

  use Business::OnlinePayment;
  my %processor_info = (
    platform    => '####',
    gid         => 12345678901234567890,
    tid         => 01,
    user_id     => '####',
    url         => 'www.####.com'
  );
  my $tx =
    new Business::OnlinePayment( "vSecureProcessing", %processor_info);
  $tx->content(
      appid          => '######',
      type           => 'VISA',
      action         => 'Normal Authorization',
      description    => 'Business::OnlinePayment test',
      amount         => '49.95',
      customer_id    => 'tfb',
      name           => 'Tofu Beast',
      address        => '123 Anystreet',
      city           => 'Anywhere',
      state          => 'UT',
      zip            => '84058',
      card_number    => '4007000000027',
      expiration     => '09/02',
      cvv2           => '1234', #optional
  );
  $tx->submit();

  if($tx->is_success()) {
      print "Card processed successfully: ".$tx->authorization."\n";
  } else {
      print "Card was rejected: ".$tx->error_message."\n";
  }

=head1 DESCRIPTION

For detailed information see L<Business::OnlinePayment>.

=head1 METHODS AND FUNCTIONS

See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.  

=head2 result_code

Returns the response error code.

=head2 error_message

Returns the response error description text.

=head2 server_response

Returns the complete response from the server.

=head1 Handling of content(%content) data:

=head2 action

The following actions are valid

  normal authorization
  credit
  void

=head1 Setting vSecureProcessing parameters from content(%content)

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

      # param => $content{<key>}
      AccountNumber       => 'card_number',
      Cvv                 => 'cvv2',
      ExpirationMonth     => \( $month ), # MM from MM/YY of 'expiration'
      ExpirationYear      => \( $year ), # YY from MM/YY of 'expiration'
      Trk1                => 'track1',
      Trk2                => 'track2',
      CardHolderFirstName => 'first_name',
      CardHolderLastName  => 'last_name',
      Amount              => 'amount'
      AvsStreet           => 'address',
      AvsZip              => 'zip',
      Cf1                 => 'UDField1',
      Cf2                 => 'UDField2',
      IndustryType        => 'IndustryInfo',

=head1 NOTE

=head1 COMPATIBILITY

Business::OnlinePayment::vSecureProcessing uses vSecureProcessing XML Document Version: 140901 (September 1, 2014).

See http://www.vsecureprocessing.com/ for more information.

=head1 AUTHORS

Original author: Alex Brelsfoard

Current maintainer: Alex Brelsfoard

=head1 COPYRIGHT

Copyright (c) 2015 Freeside Internet Services, Inc.

All rights reserved.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 ADVERTISEMENT

Need a complete, open-source back-office and customer self-service solution?
The Freeside software includes support for credit card and electronic check
processing with vSecureProcessing and over 50 other gateways, invoicing, integrated
trouble ticketing, and customer signup and self-service web interfaces.

http://freeside.biz/freeside/

=head1 SEE ALSO

perl(1). L<Business::OnlinePayment>.

=cut