package Eway;

use LWP::UserAgent;
use XML::Parser;
use vars qw/$GATEWAY_URL $GATEWAY_PORT $certfile $DEBUG/;
use Data::Dumper;

# This version, at least, is known to verify certs properly
use Crypt::SSLeay 0.27;

BEGIN {
	$GATEWAY_URL = "https://www.eway.com.au/gateway/xmlpayment.asp";
	$certfile = "/tmp/eway-thawte.crt";
	if(! -e $certfile || 1) {
		open $fh,">$certfile" or die "$certfile: $!\n";
print $fh <<__EOF__;
-----BEGIN TRUSTED CERTIFICATE-----
MIIDIzCCAoygAwIBAgIEMAAAAjANBgkqhkiG9w0BAQUFADBfMQswCQYDVQQGEwJV
UzEXMBUGA1UEChMOVmVyaVNpZ24sIEluYy4xNzA1BgNVBAsTLkNsYXNzIDMgUHVi
bGljIFByaW1hcnkgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwHhcNMDQwNTEzMDAw
MDAwWhcNMTQwNTEyMjM1OTU5WjBMMQswCQYDVQQGEwJaQTElMCMGA1UEChMcVGhh
d3RlIENvbnN1bHRpbmcgKFB0eSkgTHRkLjEWMBQGA1UEAxMNVGhhd3RlIFNHQyBD
QTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA1NNn0I0Vf67NMf59HZGhPwtx
PKzMyGT7Y/wySweUvW+Aui/hBJPAM/wJMyPpC3QrccQDxtLN4i/1CWPN/0ilAL/g
5/OIty0y3pg25gqtAHvEZEo7hHUD8nCSfQ5i9SGraTaEMXWQ+L/HbIgbBpV8yeWo
3nWhLHpo39XKHIdYYBkCAwEAAaOB/jCB+zASBgNVHRMBAf8ECDAGAQH/AgEAMAsG
A1UdDwQEAwIBBjARBglghkgBhvhCAQEEBAMCAQYwKAYDVR0RBCEwH6QdMBsxGTAX
BgNVBAMTEFByaXZhdGVMYWJlbDMtMTUwMQYDVR0fBCowKDAmoCSgIoYgaHR0cDov
L2NybC52ZXJpc2lnbi5jb20vcGNhMy5jcmwwMgYIKwYBBQUHAQEEJjAkMCIGCCsG
AQUFBzABhhZodHRwOi8vb2NzcC50aGF3dGUuY29tMDQGA1UdJQQtMCsGCCsGAQUF
BwMBBggrBgEFBQcDAgYJYIZIAYb4QgQBBgpghkgBhvhFAQgBMA0GCSqGSIb3DQEB
BQUAA4GBAFWsY+reod3SkF+fC852vhNRj5PZBSvIG3dLrWlQoe7e3P3bB+noOZTc
q3J5Lwa/q4FwxKjt6lM07e8eU9kGx1Yr0Vz00YqOtCuxN5BICEIlxT6Ky3/rbwTR
bcV0oveifHtgPHfNDs5IAn8BL7abN+AqKjbc1YXWrOU/VG+WHgWv
-----END TRUSTED CERTIFICATE-----
__EOF__
		close $fh;
	}
}

sub _crunch_xml {
	my ($tree) = @_;
	return undef if @$tree == 0;
	if(@$tree == 2 && $tree->[0] eq '0') {
		return $tree->[1];
	}
	my %foo = @$tree;
	delete $foo{0};
	my %subtree;
	foreach my $tag (keys %foo) {
		my @x = @{$foo{$tag}};
		shift @x;
		$subtree{$tag} = _crunch_xml(\@x);
	}
	return \%subtree;
}


sub transact {
	my ($self,%param) = @_;
	
	local $ENV{HTTPS_CA_FILE} = $certfile;
  	foreach (values %param) {
		s/&/&amp;/g;
		s/</&lt;/g;
		s/>/&gt;/g;
	}
	my %xmlstruct = (
		ewayCustomerID => $param{customerId},
		ewayTotalAmount => $param{amount},
		ewayCustomerFirstName => $param{firstName},
		ewayCustomerLastName => $param{lastName},
		ewayCustomerEmail => $param{email},
		ewayCustomerAddress => $param{address},
		ewayCustomerPostcode => $param{postcode},
		ewayCustomerInvoiceDescription => $param{invoiceDesc},
		ewayCustomerInvoiceRef => $param{invoiceRef},
		ewayCardHoldersName => $param{cardHolderName},
		ewayCardNumber => $param{cardNumber},
		ewayCardExpiryMonth => $param{cardExpiryMonth},
		ewayCardExpiryYear => $param{cardExpiryYear},
		ewayTrxnNumber => $param{trxnNumber},
		ewayOption1 => 0,
		ewayOption2 => 0,
		ewayOption3 => 0
	);
	
	my $request_data = join("\n",
		"<ewaygateway>",
		(map {"<$_>".$xmlstruct{$_}."</$_>"} keys %xmlstruct),
		"</ewaygateway>"
	);

	my $ua = LWP::UserAgent->new();

	my $request = HTTP::Request->new(
		POST => $GATEWAY_URL,
		undef,
		$request_data
	);
	print STDERR $request->as_string,"\n-------------\n" if $DEBUG;
	my $response = $ua->request($request);
	print STDERR $response->as_string,"\n------------\n" if $DEBUG;

	my $parser = XML::Parser->new(Style=>'Tree');
	my $tree = $parser->parse($response->content());
	my %resp;
	$tree = _crunch_xml($tree);
	if(!$tree->{ewayResponse}) {
		# XXX Make this more sensible
		$resp->{status} = "False";
		$resp->{error} = "Unable to parse returned data. DO NOT REATTEMPT.";
	}
	@resp{qw/status error amount trxnNumber authCode/} = 
		@{$tree->{ewayResponse}}{ewayTrxnStatus,ewayTrxnError,
			ewayReturnAmount,ewayTrxnNumber,ewayAuthCode};
	$resp{status} = ($resp{status} eq "True")?1:0;
	print STDERR Dumper(\%resp) if $DEBUG; 
	return \%resp;
}	

my @luhnTable = (0,2,4,6,8,1,3,5,7,9);
sub check_card_number {
	my ($self,$number) = @_;
	
	$number =~ s/\s//g;
	return undef if $number =~/\D/ || $number eq '';

	my $sum = 0; my $mult = 0;
	while($number ne '') {
		$sum += (chop $number);
		$sum += $luhnTable[chop $number];
	}
	return !($sum%10);
}

package main;

use Data::Dumper;

$Eway::GATEWAY_URL =
	"https://www.eway.com.au/gateway/xmltest/TestPage.asp";

$Eway::DEBUG = 1;
my $ret = Eway->transact (
	customerId => 12345678,
	invoiceDesc => "1000 widgets",
	firstName => "Bob",
	lastName => "Smith",
	cardHolderName => "MR BOB SMITH",
	cardNumber => "4646464646464646",
	cardExpiryMonth => "01",
	cardExpiryYear => "09",
	trxnNumber => 1,
	amount => 50
);

1;