Business-OCV
view release on metacpan or search on metacpan
#
# warn "Warning: $@" if $@;
#
# if ($m and defined($m->Result))
# {
# $m->Result == TRANS_APPROVED and print "Result: APPROVED\n";
# $m->Result == TRANS_INPROGRESS and print "Result: INPROGRESS\n";
# $m->Result == TRANS_DECLINED and print "Result: DECLINED: " .
# $m->ResponseText . ($m->Retry ? " RETRY":"") . "\n";
# }
#
# defined($m);
# }
# or do # catch
# {
# print "Error: $@\n";
# undef;
# };
#
# Any number of communications failures may occur between this client and
# the OCV server. Some of these error conditions could cause the command-
# response sequence to become missynchronised, thus it is advised that the
# connection be closed and re-opened upon error. A flush() method is
# provided if you wish to attempt to "manually" resynchronise. A
# reset() method is also provided: it closes the OCV connection,
# reopens the log file/s, and reopens the OCV connection. This should
# reset things to a virgin state. A reset() may also be in order in
# response to a HUP signal.
#
#
# NOTES/CLARIFICATIONS ON THE OCV SERVER DOCUMENTATION
#
# - Pre-authorisations and Completions
# These transactions are handled completely by the bank - that is, the
# OCV server doesn't do anything special with them. Moreover, they're
# apparently treated as disparate transactions - the OCV server (at least,
# possibly also the bank) does nothing to ensure pre-auths and completions
# match (card data, amount, etc). For example, it is apparently possible
# for a completion with a given preauth number to 'succeed' even when the
# card data does not match that of the pre-auth transaction. It appears
# that behaviour in these situations is undefined - it is up to the client
# to make sure the data match.
#
# Generally, a completion is equivalent to a purchase.
#
# - Accounts
# Each transaction to the bank must provide a merchant ID (to identify
# the merchant (e.g. bank account details)), and terminal ID (to identify
# the hardware). OCV "accounts" are used to abstract these details, and
# more importantly to allow concurrent transactions (requires multiple
# VPPs, which in turn requires both a multiple-VPP license from Ingenico and
# multiple merchant IDs and/or terminal IDs from the bank). The client (us)
# simply specifies which account to use and the server allocates the first
# available VPP allocated to that account. It returns the MerchantID and
# TerminalID as part of the RESPONSE message, if the client is interested.
#
# The account number 0 is the 'Default' account and cannot be removed.
# The Default account is for the OCV Server's internal use and must not be
# used by clients. Note that the Default account must have a VPP assigned to
# it (which is why you get 6 accounts when you purchase a 5 account license).
# Further, when processing concurrent transactions, if an account is busy
# you'll get a SERVER BUSY response so it pays to allocate as many VPPs to
# an account as possible (and make sure to retry BUSY responses).
#
# OCV DEVELOPMENT SERVER BUGS
#
# The OCV 'Development Server' supplied by Ingenico for testing and
# development purposes has a few bugs which mean it's not an entirely
# reliable means of testing your code. As of v.1.15, it:
# - often locks up and/or crashes with dud messages
# - does not respond well to polled requests. It 'locks' the account after
# serving some polled requests (i.e. subsequent transactions on the
# account return SERVER BUSY or RECORD NOT FOUND). In addition, on
# subsequent connections it erroneously sends a response to the polled
# request which mis-synchronises the rest of the communications.
# - does not return full details for status requests (for example, it omits
# the settlement date, card info, merchant + terminal IDs)
#
# OCV LIVE SERVER BUGS
#
# Unfortunately the Ingenico 'live' server (v2.08) has also shown problems,
# with one issue of a complete lockup after a totals requests (the NT registry
# had to be edited to restore service). Additionally, the server is found to
# issue unsolicted 'logon responses' around once per week. Ingenico have
# advised this is an "undocumented feature".
# To work around this, LOGON responses to non-LOGON requests are
# transparently discarded (the event is logged).
#
#
# MISCELLANEOUS NOTES ON THE CODE
#
# As is discussed below in "Message Format Specifications", each OCV
# message is described via a table of field name => data type pairs.
# Internally these are manipulated via hashes (see notes in the code
# for the details). The use of hashes has required a bit of mucking
# about due to a hash's unpredictable ordering, though at the time
# of writing there was mention of "pseduo-hashes", i.e. arrays which
# support string indices, with perl automatically managing the mapping
# from string to index. Perhaps if/when perl's pseudo-hashes become
# standard the code can be simplified and performance probably improved,
# for what it's worth :-).
#
#
######################################################################
#
# RCS Identifier:
# $Id:$
#
# Change Log:
# $Log:$
#
#
######################################################################
#
use strict; # try and pick up silly errors at compile time
use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $OCV_VERSION
$AUTOLOAD $debug/;
$VERSION = 0.1; # this module
{
my $r;
my $args = {};
return {} unless @_; # no arguments
$@ = "odd number of elements in arg list", return undef if (@_ % 2);
while (defined(my $k = shift @_)) { $args->{_strip($k)} = shift @_; }
return $args;
}
######################################################################
# The OCV Object
sub new
# Create an OCV object.
# Required Arguments:
# Server => 'host[:port]' (default port is SERVER_PORT)
# ClientID => Client ID (funnily enough)
# Selected Optional Arguments (see the instance data for the rest):
# AccountNum => Default Account Number to use for Transactions and Totals
#
{
my ($class, @args) = @_;
my $args; # -> %args
return undef unless $args = _args(@args);
# instance data
my $self =
{
server => '', # '' => avoid undef warnings below
port => '',
clientid => '',
accountnum => undef,
timeout => 120, # socket timeout (2 mins, from OCV spec)
debug => 0, # log debugging messages if set
txnref => time() * 100,# seed default transaction reference no.
polledmode => POLL_BLOCK, # default polling mode
logdir => '', # base log directory
txnlog => undef, # server transaction log filename (def. STDOUT)
logseparator => LOGSEPARATOR, # field separator for txn log
debuglog => undef, # OCV 'debug' log filename (default STDERR)
minamount => 100, # minimum accepted amount (cents)
maxamount => 100000, # maximum accepted amount (cents)
# list of strings to censor from the debug log
# - generally intended to filter 'dynamic' data (i.e. card numbers),
# but can be initialised with a static list of strings
# - card numbers are added with each transaction in _transaction()
debugfilter => [],
# parameters for dealing with SERVER BUSY
busywait => 6, # average time between attempts t = (T/2,3T/2)
busyattempts => 15, # maximum number of attempts
};
# merge arguments
while (my ($k, $v) = each %{$args})
{
$self->{$k} = $v;
}
bless ($self, $class);
# break apart server:port
# - accept "server", "server:", "server:port"
$self->{'server'} =~ /^(.*?)(?::(\d*))?$/;
$self->{'server'} = $1;
$self->{'port'} = $2 || SERVER_PORT unless $self->{'port'};
# check required arguments
$@ = "invalid Server[:Port]", return undef
unless ($self->{'server'} and $self->{'port'});
$@ = "invalid ClientID: [$self->{clientid}] too long", return undef
if length($self->{clientid}) > CLIENTIDLEN;
$@ = "invalid ClientID: [$self->{clientid}] invalid chars", return undef
unless $self->{clientid} =~ /^[\w\.\-]+$/;
$@ = "invalid DebugFilter: not an array ref", return undef
unless ref($self->{debugfilter}) eq 'ARRAY';
# initialise logging, defaulting to copies of STD(OUT|ERR)
$self->{'txnlog'} = '&STDOUT' unless $self->{'txnlog'};
$self->{'debuglog'} = '&STDERR' unless $self->{'debuglog'};
return undef unless $self->logreopen(); # open the logs
# create a socket with which to communicate to the OCV server
# convert the supplied server address into packed form
# - will fail for invalid addresses
my $inet_n;
$@ = "cannot determine server address from [$self->{'server'}]",
return undef unless $inet_n = inet_aton($self->{'server'});
$self->{'serveraddr'} = inet_ntoa($inet_n); # and back again, for reference
$self->{'sockaddr'} = sockaddr_in($self->{'port'}, $inet_n);
# create socket and connect
return undef unless $self->connect();
return $self;
}
sub reset
# close everything and reopen
# - first flush any pending input to the debug log, some of it may be useful...
{
my ($self) = @_;
$self->flush();
$self->close and
$self->logreopen and
$self->open;
}
# 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 => '');
}
sub nbcompletion
{
my $self = shift;
my $n = ref($self->{'txnref'}) eq 'CODE' ? &{$self->{'txnref'}} :
$self->{'txnref'}++;
$self->_transaction(TT_TRANS_COMPLETION, TxnRef => $n, @_);
}
sub nbstatus
# Get the status of a given transaction, specified by its Transaction
# reference number (string), TxnRef. If TxnRef is not provided,
# _transaction will default to the last one.
{
shift->_transaction(TT_TRANS_STATUS,
CardData => '', CardExpiry => '', Amount => '', AuthNum => '',
@_,
PolledMode => POLL_BLOCK);
}
# the following set of subroutines will transparently retry the transaction
# in the face of SERVER BUSY responses (up to a limit)
sub _busy
{
my ($s, $self, @a) = @_;
my $m;
my $n = $self->{'busyattempts'}; # maximum no. of attempts
$m = $s->($self, @a);
while ($m and $m->ResponseCode eq TRANS_BUSY and $n-- > 0)
{
select(undef, undef, undef, $self->{'busywait'} * (0.5 + rand));
$m = $s->($self, @a);
}
return $m;
}
sub purchase { _busy(\&nbpurchase, @_) }
sub refund { _busy(\&nbrefund, @_) }
sub preauth { _busy(\&nbpreauth, @_) }
sub completion { _busy(\&nbcompletion, @_) }
sub status { _busy(\&nbstatus, @_) }
############################################
# now the 'miscellaneous' requests
sub statistics
# Server statistics
# - sends a Statistics request, receives one of two response
# Arguments:
# Reset - set to 1 to reset statistics.
# SubCode - statistics type, STATS_PERMANENT | STATS_CURRENT
# (default STATS_CURRENT)
{
my ($self, @args) = @_;
my $args;
return undef unless $args = _args(@args);
$args->{'subcode'} = STATS_CURRENT unless defined $args->{'subcode'};
$args->{'reset'} = 0 unless defined $args->{'reset'};
# sanity check - the type of response message must be valid
$@ = "invalid statistics subcode [$args->{'subcode'}]", return undef
unless exists($Responses{TT_STATS().$args->{'subcode'}});
$self->logdebug("statistics", $args );
# process the message - send Statistics request, receive
# Statistics.SubCode
# - note this 'Statistics.SubCode' representation used solely within
# this module to disambiguate the various responses
$self->_message($args, TT_STATS(), TT_STATS().$args->{'subcode'});
}
sub vppconfig
# Virtual pinpad configuration.
# - used to associate an Account with a VPP, and the VPP to a physical pinpad.
# - note that one Account can have multiple VPPs, which would allow concurrent
# transactions for that account.
# - vppstatus should be used to confirm the configuration
# Required Arguments: (see Ingenico docs for more information)
# VPPNum - Virtual pinpad to query
# NetworkType - '0' = AIIC, '1' = NII
# NetworkID
# MerchantID
# TerminalID
# AccountNum
# Enable - '1' = enable the pinpad, '0' = disable
# Optional Arguments:
# PinPadID - ID of physical pinpad unit (default 1)
{
my ($self, @args) = @_;
my $args;
return undef unless $args = _args(@args);
$args->{'pinpadid'} = 1 unless defined $args->{'pinpadid'};
$args->{'accountnum'} = $self->{'accountnum'}
unless defined $args->{'accountnum'};
$args->{'clienttype'} = 0; # unused
( run in 0.746 second using v1.01-cache-2.11-cpan-524268b4103 )