view release on metacpan or  search on metacpan

OCV.pm  view on Meta::CPAN

		# should be done, leave the OCV to reject dud card data.
		# However, a sanity check is applied to the amount field: 1) fail 
		# if the amount is not a natural number (recall the amount is in 
		# cents); 2) fail if the amount is less than $self->{'minamount'} 
		# or greater than $self->{'maxamount'}.

		$@ = '';
		my $a = $args->{'amount'};
		$@ = "invalid amount [$a]" unless $a =~ /^\d+$/;
		$@ = "amount too small [$a]" if (defined($self->{'minamount'}) 
				and $a < $self->{'minamount'});
		$@ = "amount too large [$a]" if (defined($self->{'maxamount'}) 
				and $a > $self->{'maxamount'});

		$@ = 'no card data' unless $args->{'carddata'};
		$@ = 'no card expiry' unless $args->{'cardexpiry'};

		# an excessively long TxnRef, if used, will be truncated - given that
		# this truncation may cause duplicate IDs, it's probably better to 
		# fail here
		$@ = 'no/null TxnRef' unless $args->{'txnref'};
		$@ = "TxnRef too long: [$args->{'txnref'}] > " . TXNREFLEN
			if (length($args->{'txnref'}) > TXNREFLEN);

		return undef if $@;
	}
	} # end local warning override

	# save the txn ref for future reference
	$self->{'lasttxnref'} = $args->{'txnref'};


	# log the transaction request
	{
		# for the sake of completeness, add the clientid to the args, even
		# though it will be forced in _message
		$args->{'clientid'} = $self->{'clientid'};

		# log only the first and last four characters of the supplied card no.
		# - don't use \d, as a user may provide garbage input
		# - using {,} and *? doesn't make for the most efficient regexp, but is 
		#   the only way I could think of getting at most the first & last 4 
		#   characters of an arbitrary string.
		# - (MINOR) SECURITY NOTE: I initially (arbitrarily) chose to log the 
		#	first + last four digits of the card number, however I discovered 
		#   the Ingenico OCV server logs (in their so-called journal files)
		#   the first 6 and last 3 digits. That is, between the two of us
		#   you could get 10 digits... Sure, you've still got 6 or more to 
		#   go, but there's no real reason to not err on the side of caution. 
		#   Thus, I now only log the first four and last three.
		$args->{'carddata'} =~ /^(.{0,4})(.*?)(.{0,3})$/;
		local $args->{'carddata'} = $1 . ('.' x length($2)) . $3;

		# write the message data sorted in order of the message specification
		my @m = $self->_ssort($Requests{$type}, $args);
		$self->logtxn(\@m);
	}

	# send a Transaction message (and receive a response as required) 
	# - confirm that the TxnRef is consistant (as per Ingenico guidelines)
	#   - I guess it is possible for transactions requests/responses to get 
	#     mixed up if someone misses a beat.

	# send a request of $type, receive the TT_TRANS_RESPONSE message
	my $m = $self->_message($args, $type, TT_TRANS_RESPONSE);

	return undef unless $m;

	# log and check the response, unless polled
	unless ($args->{polledmode} and $args->{polledmode} == POLL_NONBLOCK)
	{
		# log the transaction response
		$self->logtxn($m);

		unless ($args->{txnref} eq $m->[4])
		{
			$@ = "inconsistant TxnRef: sent [$args->{txnref}], " . 
				"got [$m->[4]]";
			carp($@);
			return undef;
		}
	}

	return $m;
}

############################################
# The following are wrappers around _transaction, one for each "transaction"
# type. Note that due to the way the arguments are parsed, arguments listed 
# before the @_ can be overridden by the caller (@_); arguments listed after 
# @_ can't be overridden by the caller.
# - the 'nb' subroutines are 'non busy' (or 'non blocking', take your pick),
#   that is they'll simply return when SERVER BUSY responses are encountered
#   The non-'nb' subs will attempt to retry BUSY responses, up to a point.
# - all transactions need a unique Transaction Reference ID, except for status
# - note that new transaction references should be generated for each attempt, 
#   successful or not, busy or not.
sub nbpurchase
{
	my $self = shift;
	my $n = ref($self->{'txnref'}) eq 'CODE' ? &{$self->{'txnref'}} : 
		$self->{'txnref'}++;

	$self->_transaction(TT_TRANS_PURCHASE, TxnRef => $n, @_, AuthNum => '');
}

sub nbrefund
{
	my $self = shift;
	my $n = ref($self->{'txnref'}) eq 'CODE' ? &{$self->{'txnref'}} : 
		$self->{'txnref'}++;

	$self->_transaction(TT_TRANS_REFUND, TxnRef => $n, @_, AuthNum => '');
}

sub nbpreauth
{
	my $self = shift;
	my $n = ref($self->{'txnref'}) eq 'CODE' ? &{$self->{'txnref'}} : 
		$self->{'txnref'}++;
	$self->_transaction(TT_TRANS_PREAUTH, TxnRef => $n, @_, AuthNum => '');