add eway credit card driver and shop integration
authorTony Cook <tony@develop-help.com>
Mon, 28 Nov 2011 03:49:33 +0000 (14:49 +1100)
committerTony Cook <tony@develop-help.com>
Wed, 7 Dec 2011 02:44:09 +0000 (13:44 +1100)
MANIFEST
site/cgi-bin/modules/BSE/UI/Shop.pm
site/cgi-bin/modules/DevHelp/Payments.pod
site/cgi-bin/modules/DevHelp/Payments/Eway.pm [new file with mode: 0644]
site/cgi-bin/modules/DevHelp/Payments/Test.pm
t/t64eway.t [new file with mode: 0644]

index 4104b35..caabab4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -294,6 +294,7 @@ site/cgi-bin/modules/DevHelp/Formatter.pm
 site/cgi-bin/modules/DevHelp/HTML.pm
 site/cgi-bin/modules/DevHelp/LoaderData.pm
 site/cgi-bin/modules/DevHelp/Payments.pod
+site/cgi-bin/modules/DevHelp/Payments/Eway.pm
 site/cgi-bin/modules/DevHelp/Payments/Inpho.pm
 site/cgi-bin/modules/DevHelp/Payments/SecurePay.pm
 site/cgi-bin/modules/DevHelp/Payments/SecurePayXML.pm
@@ -831,6 +832,7 @@ t/t60securepayxml.t
 t/t61fastway.t
 t/t62auspost.t
 t/t63nabtransactxml.t
+t/t64eway.t
 t/t70thumbim.t
 t/t80catalog.t
 t/t85message.t
index e458dfc..81fcbaf 100644 (file)
@@ -17,7 +17,7 @@ use BSE::Shipping;
 use BSE::Countries qw(bse_country_code);
 use BSE::Util::Secure qw(make_secret);
 
-our $VERSION = "1.019";
+our $VERSION = "1.020";
 
 use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
 
@@ -869,6 +869,19 @@ my %nostore =
    cardVerify => 1,
   );
 
+my %bill_ccmap =
+  (
+   # hash of CC payment parameter names to arrays of billing address fields
+   firstname => "billFirstName",
+   lastname => "billLastName",
+   address1 => "billStreet",
+   address2 => "billStreet2",
+   postcode => "billPostCode",
+   state => "billState",
+   suburb => "billSuburb",
+   email => "billEmail",
+  );
+
 sub req_payment {
   my ($class, $req, $errors) = @_;
 
@@ -1073,6 +1086,7 @@ sub req_payment {
   if ($paymentType == PAYMENT_CC) {
     my $ccNumber = $cgi->param('cardNumber');
     my $ccExpiry = $cgi->param('cardExpiry');
+    my $ccName   = $cgi->param('cardHolder');
     
     if ($ccprocessor) {
       my $cc_class = credit_card_class($cfg);
@@ -1085,12 +1099,23 @@ sub req_payment {
       my $expiry = sprintf("%04d%02d", $year, $month);
       my $verify = $cgi->param('cardVerify');
       defined $verify or $verify = '';
-      my $result = $cc_class->payment(orderno=>$order->{id},
-                                     amount => $order->{total},
-                                     cardnumber => $ccNumber,
-                                     expirydate => $expiry,
-                                     cvv => $verify,
-                                     ipaddress => $ENV{REMOTE_ADDR});
+      my %more;
+      while (my ($cc_field, $order_field) = each %bill_ccmap) {
+       if ($order->$order_field()) {
+         $more{$cc_field} = $order->$order_field();
+       }
+      }
+      my $result = $cc_class->payment
+       (
+        orderno => $order->{id},
+        amount => $order->{total},
+        cardnumber => $ccNumber,
+        nameoncard => $ccName,
+        expirydate => $expiry,
+        cvv => $verify,
+        ipaddress => $ENV{REMOTE_ADDR},
+        %more,
+       );
       unless ($result->{success}) {
        use Data::Dumper;
        print STDERR Dumper($result);
index d30c4a9..898d8f3 100644 (file)
@@ -71,6 +71,10 @@ cardnumber - the credit card number.  Required.
 
 =item *
 
+nameoncard - the card holder's name.  Required.
+
+=item *
+
 expirydate - the credit card expiry date in the format C<YYYYMM>.
 Other formats may be accepted but the YYYYMM format must be accepted.
 Required.
@@ -85,6 +89,15 @@ ipaddress - IP Address of the requestor.  Required by some providers.
 
 =item *
 
+firstname, lastname, address1, address2, address3, postcode, state,
+suburb, email, countrycode - customer contact information.
+
+=item *
+
+description - description of the order.
+
+=item *
+
 currency - currency as an international money symbol, such as AUD, or
 USD.  If supplied and your provider doesn't support the given symbol,
 payment() should fail.  Optional.
diff --git a/site/cgi-bin/modules/DevHelp/Payments/Eway.pm b/site/cgi-bin/modules/DevHelp/Payments/Eway.pm
new file mode 100644 (file)
index 0000000..dfbd0c9
--- /dev/null
@@ -0,0 +1,328 @@
+package DevHelp::Payments::Eway;
+use strict;
+use XML::LibXML;
+use LWP::UserAgent;
+use Carp qw(confess);
+
+our $VERSION = "1.000";
+
+use constant LIVE_URL => "https://www.eway.com.au/gateway_cvn/xmlpayment.asp";
+use constant
+  TEST_URL => "https://www.eway.com.au/gateway_cvn/xmltest/testpage.asp";
+
+sub new {
+  my ($class, $cfg) = @_;
+
+  my $section = "eway payments";
+  my $debug = $cfg->entry($section, "debug", 0);
+  my $test = $cfg->entry($section, "test");
+  defined $test or confess "You must set [$section].test to 1 or 0";
+
+  my $def_url = $test ? TEST_URL : LIVE_URL;
+  my $url_key = $test ? "test_url" : "url";
+  my $url = $cfg->entry($section, $url_key, $def_url);
+
+  my $merchant_id = $test
+    ? $cfg->entry($section, "testmerchantid", "87654321")
+    : $cfg->entryErr($section, "merchantid");
+  my $timeout = $cfg->entry($section, "timeout", 60);
+  my $po_prefix = $cfg->entry($section, "prefix", "");
+
+  if ($debug) {
+    print STDERR <<DEBUG;
+eWAY configuration:
+  Test: $test
+  URL: $url
+  merchantId: $merchant_id
+  timeout: $timeout
+  prefix: $po_prefix
+DEBUG
+  }
+
+  return bless
+    {
+     test => $test,
+     debug => $debug,
+     merchant_id => $merchant_id,
+     url => $url,
+     timeout => $timeout,
+     prefix => $po_prefix,
+    }, $class;
+}
+
+sub payment {
+  my ($self, %opts) = @_;
+
+  for my $field (qw(orderno amount cardnumber nameoncard expirydate cvv)) {
+    exists $opts{$field} && $opts{$field} =~ /\S/
+      or confess "Missing required payment field $field";
+  }
+
+  my $orderno = $opts{orderno};
+  my $amount = $opts{amount};
+  my $card_number = $opts{cardnumber};
+  my $name_on_card = $opts{nameoncard};
+  my $expiry = $opts{expirydate};
+  my $cvv = $opts{cvv};
+
+  if (defined $opts{currency} && $opts{currency} ne 'AUD') {
+    return
+      {
+       success => 0,
+       error => 'Unsupported currency',
+       statuscode => 5,
+      };
+  }
+
+  my ($year, $month) = $expiry =~ /^[0-9]{2}([0-9]{2})([0-9]{2})$/
+    or confess "Invalid expiry date $expiry\n";
+
+  $amount =~ /^[0-9]+$/
+    or confess "Invalid amount $amount\n";
+
+  # eway's requests are simple name => value XML
+  my @req =
+    (
+     ewayCustomerID => $self->{merchant_id},
+     ewayTotalAmount => $amount,
+     ewayCustomerFirstName => _limit(_first($opts{firstname}, ""), 50),
+     ewayCustomerLastName => _limit(_first($opts{lastname}, ""), 50),
+     ewayCustomerEmail => _limit(_first($opts{email}, ""), 50),
+     ewayCustomerAddress =>
+     _limit(join(" ", grep defined, @opts{qw/address1 address2 address3 state suburb countrycode/}), 255),
+     ewayCustomerPostcode => _limit(_first($opts{postcode}, ""), 6),
+     ewayCustomerInvoiceDescription => _limit(_first($opts{description}, ""), 255),
+     ewayCustomerInvoiceRef => $self->{prefix} . $orderno,
+     ewayCardHoldersName => _limit($name_on_card, 50),
+     ewayCardNumber => $card_number,
+     ewayCardExpiryMonth => $month,
+     ewayCardExpiryYear => $year,
+     ewayTrxnNumber => "",
+     ewayOption1 => "",
+     ewayOption2 => "",
+     ewayOption3 => "",
+     ewayCVN => $cvv,
+    );
+
+  my $failure;
+  my $result = $self->_request(\@req, \$failure)
+    or return $failure;
+
+  # sometimes this is:
+  #  99,error message
+  #  error message
+  my $error = $result->{ewayTrxnError};
+  my ($code, $message);
+  if ($error =~ /^(\d+),(.*)/) {
+    $code = 0 + $1;
+    $message = $2 || _error_message($1);
+  }
+  else {
+    $code = -1;
+    $message = $error;
+  }
+  if (!exists $result->{ewayTrxnStatus}
+      || $result->{ewayTrxnStatus} ne "True") {
+    return
+      {
+       success => 0,
+       error => $message,
+       statuscode => $code,
+      };
+  }
+
+  return
+    {
+     success => 1,
+     statuscode => $code,
+     error => _error_message($code),
+     receipt => $result->{ewayAuthCode},
+     transactionid => $result->{ewayTrxnNumber},
+    };
+}
+
+sub _request {
+  my ($self, $req, $rfailure) = @_;
+
+  my $doc = XML::LibXML->createDocument();
+  my $root = $doc->createElement("ewaygateway");
+  $doc->setDocumentElement($root);
+  unless (@$req % 2 == 0) {
+    if ($self->{debug}) {
+      for my $i (0..$#$req) {
+       print STDERR " $i: '$req->[$i]'\n";
+      }
+    }
+    confess "Odd number of request parameters";
+  }
+
+  my $cc_num = 'UNKNOWN';
+  for (my $i = 0; $i < @$req; $i += 2) {
+    my ($key, $value) = ( $req->[$i], $req->[$i+1] );
+
+    if ($key eq "ewayCardNumber") {
+      $cc_num = $value;
+    }
+
+    my $ele = $doc->createElement($key);
+    my $text = $doc->createTextNode($value);
+    $ele->appendChild($text);
+    $root->appendChild($ele);
+  }
+
+  my $req_content = $doc->toString;
+  if ($self->{debug}) {
+    my $dump = $req_content;
+    $dump =~ s/\Q$cc_num/XXX/;
+
+    print STDERR "Request: >>$dump<<\n";
+  }
+
+  my $ua = LWP::UserAgent->new;
+  my $http_request = HTTP::Request->new(POST => $self->{url});
+  $http_request->content($req_content);
+
+  my $response = $ua->request($http_request);
+  unless ($response->is_success) {
+    if ($self->{debug}) {
+      print STDERR "Comms failure: ", $response->status_line, "\n";
+    }
+    $$rfailure =
+      {
+       success => 0,
+       error => 'Communications error: ' . $response->status_line,
+       statuscode => -1,
+      };
+    return;
+  }
+
+  my $parser = XML::LibXML->new;
+  my $res_content = $response->decoded_content;
+
+  if ($self->{debug}) {
+    print STDERR "Response: >>$res_content<<\n";
+  }
+
+  my $rdoc;
+  eval {
+    $rdoc = $parser->parse_string($res_content);
+    1;
+  } or do {
+    print STDERR "Could not parse response: ", $@, "\n";
+    $$rfailure =
+      {
+       success => 0,
+       error => "Parse error: " . $@,
+       errorcode => -1,
+      };
+
+    return;
+  };
+
+  my $res_root = $rdoc->documentElement;
+  my %result;
+  for my $child ($res_root->childNodes) {
+    my $name = $child->nodeName;
+    my @kids = $child->childNodes;
+    my $value = join '', map { $_->can("data") ? $_->data : "" } @kids;
+    $result{$name} = $value;
+  }
+
+  return \%result;
+}
+
+my %messages =
+  (
+   0 => "Transaction Approved",
+   1 => "Refer to Issuer",
+   2 => "Refer to Issuer, special",
+   3 => "No Merchant",
+   4 => "Pick Up Card",
+   5 => "Do Not Honour",
+   6 => "Error",
+   7 => "Pick Up Card, Special",
+   8 => "Honour With Identification",
+   9 => "Request In Progress",
+   10 => "Approved For Partial Amount",
+   11 => "Approved, VIP",
+   12 => "Invalid Transaction",
+   13 => "Invalid Amount",
+   14 => "Invalid Card Number",
+   15 => "No Issuer",
+   16 => "Approved, Update Track 3",
+   19 => "Re-enter Last Transaction",
+   21 => "No Action Taken",
+   22 => "Suspected Malfunction",
+   23 => "Unacceptable Transaction Fee",
+   25 => "Unable to Locate Record On File",
+   30 => "Format Error",
+   31 => "Bank Not Supported By Switch",
+   33 => "Expired Card, Capture",
+   34 => "Suspected Fraud, Retain Card",
+   35 => "Card Acceptor, Contact Acquirer, Retain Card",
+   36 => "Restricted Card, Retain Card",
+   37 => "Contact Acquirer Security Department, Retain Card",
+   38 => "PIN Tries Exceeded, Capture",
+   39 => "No Credit Account",
+   40 => "Function Not Supported",
+   41 => "Lost Card",
+   42 => "No Universal Account",
+   43 => "Stolen Card",
+   44 => "No Investment Account",
+   51 => "Insufficient Funds",
+   52 => "No Cheque Account",
+   53 => "No Savings Account",
+   54 => "Expired Card",
+   55 => "Incorrect PIN",
+   56 => "No Card Record",
+   57 => "Function Not Permitted to Cardholder",
+   58 => "Function Not Permitted to Terminal",
+   59 => "Suspected Fraud",
+   60 => "Acceptor Contact Acquirer",
+   61 => "Exceeds Withdrawal Limit",
+   62 => "Restricted Card",
+   63 => "Security Violation",
+   64 => "Original Amount Incorrect",
+   66 => "Acceptor Contact Acquirer, Security",
+   67 => "Capture Card",
+   75 => "PIN Tries Exceeded",
+   82 => "CVV Validation Error",
+   90 => "Cutoff In Progress",
+   91 => "Card Issuer Unavailable",
+   92 => "Unable To Route Transaction",
+   93 => "Cannot Complete, Violation Of The Law",
+   94 => "Duplicate Transaction",
+   96 => "System Error",
+  );
+
+sub _error_message {
+  my ($code) = @_;
+
+  return $messages{$code+0} || "Unknown error $code";
+}
+
+sub _first {
+  for my $value (@_) {
+    defined $value and return $value;
+  }
+
+  return;
+}
+
+sub _limit {
+  my ($value, $limit) = @_;
+
+  $value =~ s/\s+/ /g;
+  length $value <= $limit
+    and return $value;
+
+  substr($value, $limit) = "";
+
+  if ($limit > 20) {
+    $value =~ s/ \S{1,5}$//;
+  }
+
+  return $value;
+}
+
+1;
index 459c346..a7a90da 100644 (file)
@@ -15,7 +15,7 @@ sub payment {
 
   my $cfg = $self->{cfg};
 
-  for my $name (qw/orderno amount cardnumber expirydate ipaddress cvv/) {
+  for my $name (qw/orderno amount cardnumber nameoncard expirydate ipaddress cvv/) {
     defined $args{$name}
       or confess "Missing $name argument";
   }
diff --git a/t/t64eway.t b/t/t64eway.t
new file mode 100644 (file)
index 0000000..a46ff8d
--- /dev/null
@@ -0,0 +1,129 @@
+#!perl -w
+use strict;
+use Test::More tests => 17;
+
+++$|;
+
+my $debug = 1;
+
+my $gotmodule;
+BEGIN { $gotmodule = use_ok('DevHelp::Payments::Eway'); }
+
+my %cfg_good =
+  (
+   test=>1,
+   debug => $debug,
+  );
+
+my $cfg = bless \%cfg_good, 'Test::Cfg';
+
+my $payment = DevHelp::Payments::Eway->new($cfg);
+
+ok($payment, 'make payment object');
+
+{
+  my %req =
+    (  
+     cardnumber => '4444333322221111',
+     expirydate => '200708',
+     nameoncard => "Joseph Bloe",
+     amount => 1000,
+     orderno => time,
+     cvv => "123",
+    );
+
+  my $result = $payment->payment(%req);
+  ok($result->{success}, "successful");
+  ok($result->{receipt}, "got a receipt");
+  ok($result->{transactionid}, "got a transaction id");
+}
+
+{
+  my %req =
+    (  
+     cardnumber => '4444333322221111',
+     expirydate => '200708',
+     nameoncard => "Joseph Bloe",
+     amount => 1000,
+     orderno => time,
+     cvv => "123",
+     currency => "AUD",
+    );
+
+  my $result = $payment->payment(%req);
+  ok($result->{success}, "successful with AUD");
+  ok($result->{receipt}, "got a receipt");
+  ok($result->{transactionid}, "got a transaction id");
+}
+
+{ # supply everything
+  my %req =
+    (  
+     cardnumber => '4444333322221111',
+     expirydate => '200708',
+     nameoncard => "Joseph Bloe",
+     amount => 1000,
+     orderno => time,
+     cvv => "123",
+     currency => "AUD",
+     firstname => "Joseph",
+     lastname => "Bloe",
+     address1 => "Unit 1",
+     address2 => "56 Unknown Pde",
+     suburb => "Sydney",
+     postcode => "2345",
+     state => "NSW",
+     countrycode => "AU",
+     email => 'test@example.com',
+     description => "Test transaction",
+     ipaddress => "127.0.0.1",
+    );
+
+  my $result = $payment->payment(%req);
+  ok($result->{success}, "successful with details");
+  ok($result->{receipt}, "got a receipt");
+  ok($result->{transactionid}, "got a transaction id");
+}
+
+{
+  my %req =
+    (
+     cardnumber => '4242424242424242',
+     expirydate => '200708',
+     nameoncard => "Joseph Bloe",
+     amount => 1000,
+     orderno => time,
+     cvv => "321",
+    );
+  my $result = $payment->payment(%req);
+  ok(!$result->{success}, "failure (bad card number)");
+  ok($result->{statuscode}, "got an error code");
+  like($result->{error}, qr/credit card/, "error should mention credit card");
+}
+
+{
+  my %req =
+    (
+     cardnumber => '4444333322221111',
+     expirydate => '200708',
+     nameoncard => "Joseph Bloe",
+     amount => 1001,
+     orderno => time,
+     cvv => "321",
+    );
+  my $result = $payment->payment(%req);
+  ok(!$result->{success}, "failure (generated error)");
+  like($result->{statuscode}, qr/[0-9]+/, "got a numeric error code");
+  like($result->{error}, qr/^Refer to Issuer/, "match expected message");
+}
+
+package Test::Cfg;
+
+sub entry {
+  my ($self, $section, $key, $def) = @_;
+
+  $section eq 'eway payments' or die;
+  exists $self->{$key} or return $def;
+
+  return $self->{$key};
+}