package Business::OnlinePayment::InternetSecure;

use 5.008;
use strict;
use warnings;

use Carp;
use Encode;
use Net::SSLeay qw(make_form post_https);
use XML::Simple qw(xml_in xml_out);

use base qw(Business::OnlinePayment Exporter);


our $VERSION = '0.05';


use constant SUCCESS_CODES => qw(2000 90000 900P1);

use constant CARD_TYPES => {
				AM => 'American Express',
				JB => 'JCB',
				MC => 'MasterCard',
				NN => 'Discover',
				VI => 'Visa',
			};


# Convenience functions to avoid undefs and escape products strings
sub _def($) { defined $_[0] ? $_[0] : '' }
sub _esc($) { local $_ = shift; tr/|:/ /s; tr/"`/'/s; return $_ }


sub set_defaults {
	my ($self) = @_;

	$self->server('secure.internetsecure.com');
	$self->port(443);
	$self->path('/process.cgi');

	$self->build_subs(qw(
				receipt_number	order_number	uuid	guid
				date
				card_type	cardholder
				total_amount	tax_amounts
				avs_code	cvv2_response
			));
	
	# Just in case someone tries to call tax_amounts() *before* submit()
	$self->tax_amounts( {} );
}

# Backwards-compatible support for renamed fields
sub avs_response { shift()->avs_code(@_) }
sub sales_number { shift()->order_number(@_) }


# Combine get_fields and remap_fields for convenience.  Unlike OnlinePayment's
# remap_fields, this doesn't modify content(), and can therefore be called
# more than once.  Also, unlike OnlinePayment's get_fields in 3.x, this doesn't
# exclude undefs.
#
sub get_remap_fields {
	my ($self, %map) = @_;

	my %content = $self->content();
	my %data;

	while (my ($to, $from) = each %map) {
		$data{$to} = $content{$from};
	}

	return %data;
}

# Since there's no standard format for expiration dates, we try to do our best
#
sub parse_expdate {
	my ($self, $str) = @_;

	local $_ = $str;

	my ($y, $m);

	if (/^(\d{4})\W(\d{1,2})$/ ||		# YYYY.MM  or  YYYY-M
			/^(\d\d)\W(\d)$/ ||	# YY/M  or  YY-M
			/^(\d\d)[.-](\d\d)$/) {	# YY-MM
		($y, $m) = ($1, $2);
	} elsif (/^(\d{1,2})\W(\d{4})$/ ||	# MM-YYYY  or  M/YYYY
			/^(\d)\W(\d\d)$/ ||	# M/YY  or  M-YY
			/^(\d\d)\/?(\d\d)$/) {	# MM/YY  or  MMYY
		($y, $m) = ($2, $1);
	} else {
		croak "Unable to parse expiration date: $str";
	}

	$y += 2000 if $y < 2000;  # Aren't we glad Y2K is behind us?

	return ($y, $m);
}

# Convert a single product into a product string
#
sub prod_string {
	my ($self, $currency, %data) = @_;

	croak "Missing amount in product" unless defined $data{amount};

	my @flags = ($currency);

	my @taxes;
	if (ref $data{taxes}) {
		@taxes = @{ $data{taxes} };
	} elsif ($data{taxes}) {
		@taxes = split ' ' => $data{taxes};
	}

	foreach (@taxes) {
		croak "Unknown tax code $_" unless /^(GST|PST|HST)$/i;
		push @flags, uc $_;
	}

	if ($self->test_transaction) {
		push @flags, $self->test_transaction < 0 ? 'TESTD' : 'TEST';
	}

	return join '::' =>
				sprintf('%.2f' => $data{amount}),
				$data{quantity} || 1,
				_esc _def $data{sku},
				_esc _def $data{description},
				join('' => map "{$_}" => @flags),
				;
}

# Generate the XML document for this transaction
#
sub to_xml {
	my ($self) = @_;

	my %content = $self->content;

	# Backwards-compatible support for exp_date
	if (exists $content{exp_date} && ! exists $content{expiration}) {
		$content{expiration} = delete $content{exp_date};
		$self->content(%content);
	}

	$self->required_fields(qw(action card_number expiration));

	croak "Unsupported transaction type: $content{type}"
		if $content{type} &&
			! grep lc($content{type}) eq lc($_),
				values %{+CARD_TYPES}, 'CC';
	
	croak 'Unsupported action'
		unless $content{action} =~ /^Normal Authori[zs]ation$/i;
	
	$content{currency} = uc($content{currency} || 'CAD');
	croak "Unknown currency code ", $content{currency}
		unless $content{currency} =~ /^(CAD|USD)$/;
	
	my %data = $self->get_remap_fields(qw(
			xxxCard_Number		card_number

			xxxName			name
			xxxCompany		company
			xxxAddress		address
			xxxCity			city
			xxxProvince		state
			xxxPostal		zip
			xxxCountry		country
			xxxPhone		phone
			xxxEmail		email

			xxxShippingName		ship_name
			xxxShippingCompany	ship_company
			xxxShippingAddress	ship_address
			xxxShippingCity		ship_city
			xxxShippingProvince	ship_state
			xxxShippingPostal	ship_zip
			xxxShippingCountry	ship_country
			xxxShippingPhone	ship_phone
			xxxShippingEmail	ship_email
		));
	
	$data{MerchantNumber} = $self->merchant_id;

	$data{xxxCard_Number} =~ tr/- //d;
	$data{xxxCard_Number} =~ s/^[^3-6]/4/ if $self->test_transaction;

	my ($y, $m) = $self->parse_expdate($content{expiration});
	$data{xxxCCYear} = sprintf '%.4u' => $y;
	$data{xxxCCMonth} = sprintf '%.2u' => $m;

	if (defined $content{cvv2} && $content{cvv2} ne '') {
		$data{CVV2} = 1;
		$data{CVV2Indicator} = $content{cvv2};
	} else {
		$data{CVV2} = 0;
		$data{CVV2Indicator} = '';
	}
	
	if (ref $content{description}) {
		$data{Products} = join '|' => map $self->prod_string(
						$content{currency},
						taxes => $content{taxes},
						%$_),
					@{ $content{description} };
	} else {
		$self->required_fields(qw(amount));
		$data{Products} = $self->prod_string(
					$content{currency},
					taxes       => $content{taxes},
					amount      => $content{amount},
					description => $content{description},
				);
	}

	# The encode() makes sure to a) strip off non-Latin-1 characters, and
	# b) turn off the utf8 flag, which confuses XML::Simple
	encode('ISO-8859-1', xml_out(\%data,
		NoAttr		=> 1,
		RootName	=> 'TranxRequest',
		SuppressEmpty	=> undef,
		XMLDecl		=> '<?xml version="1.0" encoding="iso-8859-1" standalone="yes"?>',
	));
}

# Map the various fields from the response, and put their values into our
# object for retrieval.
#
sub infuse {
	my ($self, $data, %map) = @_;

	while (my ($k, $v) = each %map) {
		no strict 'refs';
		$self->$k($data->{$v});
	}
}

sub extract_tax_amounts {
	my ($self, $response) = @_;

	my %tax_amounts;

	my $products = $response->{Products};
	return unless $products;

	foreach my $node (@$products) {
		my $flags = $node->{flags};
		if ($flags &&
			grep($_ eq '{TAX}', @$flags) &&
			grep($_ eq '{CALCULATED}', @$flags))
		{
			$tax_amounts{ $node->{code} } = $node->{subtotal};
		}
	}

	return %tax_amounts;
}

# Parse the server's response and set various fields
#
sub parse_response {
	my ($self, $response) = @_;

	$self->server_response($response);

	local $/ = "\n";  # Make sure to avoid bug #17687
	
	$response = xml_in($response,
 			ForceArray => [qw(product flag)],
 			GroupTags => { qw(Products product flags flag) },
 			KeyAttr => [],
 			SuppressEmpty => undef,
		);
	
	$self->infuse($response,
			result_code	=> 'Page',
			error_message	=> 'Verbiage',
			authorization	=> 'ApprovalCode',
			avs_code	=> 'AVSResponseCode',
			cvv2_response	=> 'CVV2ResponseCode',

			receipt_number	=> 'ReceiptNumber',
			order_number	=> 'SalesOrderNumber',
			uuid		=> 'GUID',
			guid		=> 'GUID',

			date		=> 'Date',
			cardholder	=> 'xxxName',
			card_type	=> 'CardType',
			total_amount	=> 'TotalAmount',
			);
	
	$self->is_success(scalar grep $self->result_code eq $_, SUCCESS_CODES);

	# Completely undocumented field that sometimes override <Verbiage>
	$self->error_message($response->{Error}) if $response->{Error};

	# Delete error_message if transaction was successful
	$self->error_message(undef) if $self->is_success;
	
	$self->card_type(CARD_TYPES->{$self->card_type});
	
	$self->tax_amounts( { $self->extract_tax_amounts($response) } );

	return $self;
}

sub submit {
	my ($self) = @_;

	croak "Missing required argument 'merchant_id'"
		unless defined $self->{merchant_id};

	my ($page, $response, %headers) = 
		post_https(
				$self->server,
				$self->port,
				$self->path,
				undef,
				make_form(
					xxxRequestMode => 'X',
					xxxRequestData => $self->to_xml,
				)
			);

	croak 'Error connecting to server' unless $page;
	croak 'Server responded, but not in XML' unless $page =~ /^<\?xml/;

	# The response is marked UTF-8, but it's really Latin-1.  Sigh.
	$page =~ s/^(<\?xml.*?) encoding="utf-8"/$1 encoding="iso-8859-1"/si;

	$self->parse_response($page);
}


1;

__END__


=head1 NAME

Business::OnlinePayment::InternetSecure - InternetSecure backend for Business::OnlinePayment

=head1 SYNOPSIS

  use Business::OnlinePayment;

  $txn = new Business::OnlinePayment 'InternetSecure',
  					merchant_id => '0000';

  $txn->content(
	action		=> 'Normal Authorization',

  	type		=> 'Visa',			# Optional
	card_number	=> '4111 1111 1111 1111',
	expiration	=> '2004-07',
	cvv2		=> '000',			# Optional

	name		=> "Fr\x{e9}d\x{e9}ric Bri\x{e8}re",
	company		=> '',
	address		=> '123 Street',
	city		=> 'Metropolis',
	state		=> 'ZZ',
	zip		=> 'A1A 1A1',
	country		=> 'CA',
	phone		=> '(555) 555-1212',
	email		=> 'fbriere@fbriere.net',

	amount		=> 49.95,
	currency	=> 'CAD',
	taxes		=> 'GST PST',
	description	=> 'Test transaction',
	);

  $txn->submit;

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

=head1 DESCRIPTION

C<Business::OnlinePayment::InternetSecure> is an implementation of
C<Business::OnlinePayment> that allows for processing online credit card
payments through InternetSecure.

See L<Business::OnlinePayment> for more information about the generic
Business::OnlinePayment interface.

=head1 CREATOR

Object creation is done via C<Business::OnlinePayment>; see its manpage for
details.  The B<merchant_id> processor option is required, and corresponds
to the merchant ID assigned to you by InternetSecure.

=head1 METHODS

=head2 Transaction setup and transmission

=over 4

=item content( CONTENT )

Sets up the data prior to a transaction.  CONTENT is an associative array
(hash), containing some of the following fields:

=over 4

=item action (required)

What to do with the transaction.  Only C<Normal Authorization> is supported
at the moment.

=item type

Transaction type, being one of the following:

=over 4

=item - Visa

=item - MasterCard

=item - American Express

=item - Discover

=item - JCB

=item - CC

=back

(This is actually ignored for the moment, and can be left blank or undefined.)

=item card_number (required)

Credit card number.  Spaces and dashes are automatically removed.

=item expiration (required)

Credit card expiration date.  Since C<Business::OnlinePayment> does not specify
any syntax, this module is rather lax regarding what it will accept.  The
recommended syntax is C<YYYY-MM>, but forms such as C<MM/YYYY> or C<MMYY> are
allowed as well.

=item cvv2

Three- or four-digit verification code printed on the card.  This can be left
blank or undefined, in which case no check will be performed.  Whether or not a
transaction will be declined in case of a mismatch depends on the merchant
account configuration.

This number may be called Card Verification Value (CVV2), Card Validation
Code (CVC2) or Card Identification number (CID), depending on the card issuer.

=item description

A short description of the transaction.  See L<"Products list syntax"> for
an alternate syntax that allows a list of products to be specified.

=item amount (usually required)

Total amount to be billed, excluding taxes if they are to be added separately
by InternetSecure.

This field is required if B<description> is a string, but should be left
undefined if B<description> contains a list of products instead, as outlined
in L<"Products list syntax">.

=item currency

Currency of all amounts for this order.  This can currently be either
C<CAD> (default) or C<USD>.

=item taxes

Taxes to be added automatically to B<amount> by InternetSecure.  Available
taxes are C<GST>, C<PST> and C<HST>.

This argument can either be a single string of taxes concatenated with spaces
(such as C<GST PST>), or a reference to an array of taxes (such as C<[ "GST",
"PST" ]>).

=item name / company / address / city / state / zip / country / phone / email

Customer information.  B<country> should be a two-letter code taken from ISO
3166-1.

=back

=item submit()

Submit the transaction to InternetSecure.

=back

=head2 Post-submission methods

=over 4

=item is_success()

Returns true if the transaction was submitted successfully.

=item result_code()

Response code returned by InternetSecure.

=item error_message()

Error message if the transaction was unsuccessful; C<undef> otherwise.  (You
should not rely on this to test whether a transaction was successful; use
B<is_success>() instead.)

=item receipt_number()

Receipt number (a string, actually) of this transaction, unique to all
InternetSecure transactions.

=item order_number()

Sales order number of this transaction.  This is a number, unique to each
merchant, which is incremented by 1 each time.

=item uuid()

Universally Unique Identifier associated to this transaction.  This is a
128-bit value returned as a 36-character string such as
C<f81d4fae-7dec-11d0-a765-00a0c91e6bf6>.  See RFC 4122 for more details on
UUIDs.

B<guid>() is provided as an alias to this method.

=item authorization()

Authorization code for this transaction.

=item avs_code() / cvv2_response()

Results of the AVS and CVV2 checks.  See the InternetSecure documentation for
the list of possible values.

=item date()

Date and time of the transaction.  Format is C<YYYY/MM/DD hh:mm:ss>.

=item total_amount()

Total amount billed for this order, including taxes.

=item tax_amounts()

Returns a I<reference> to a hash that maps taxes, which were listed under the
B<taxes> argument to B<submit>(), to the amount that was calculated by
InternetSecure.

=item cardholder()

Cardholder's name.  This is currently a mere copy of the B<name> field passed
to B<submit>().

=item card_type()

Type of the credit card used for the submitted order, being one of the
following:

=over 4

=item - Visa

=item - MasterCard

=item - American Express

=item - Discover

=item - JCB

=back


=back


=head1 NOTES

=head2 Products list syntax

Optionally, the B<description> field of B<content>() can contain a reference
to an array of products, instead of a simple string.  Each element of this
array represents a different product, and must be a reference to a hash with
the following fields:

=over 4

=item amount (required)

Unit price of this product.

=item quantity

Ordered quantity of this product.

=item sku

Internal code for this product.

=item description

Description of this product

=item taxes

Taxes that should be automatically added to this product.  If specified, this
overrides the B<taxes> field passed to B<content>().

=back

When using a products list, the B<amount> field passed to B<content>() should
be left undefined.


=head2 Character encoding

When using non-ASCII characters, all data provided to B<contents>() should
have been decoded beforehand via the C<Encode> module, unless your data is in
ISO-8859-1 and you haven't meddled with the C<encoding> pragma.  (Please
don't.)

InternetSecure currently does not handle characters outside of ISO-8859-1, so
these will be replaced with C<?> before being transmitted.


=head1 EXPORT

None by default.


=head1 SEE ALSO

L<Business::OnlinePayment>

=head1 AUTHOR

Original author: Frédéric Brière, E<lt>fbriere@fbriere.netE<gt>.  Please don't
bother Frédéric with emails about this module.

Currentuly (minimally) maintained by Ivan Kohler.  See
http://rt.cpan.org/Public/Bug/Report.html?Queue=Business-OnlinePayment-InternetSecure to submit patches and bug reports.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Frédéric Brière

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.

=cut