From 99a03593b7904a1884b3922508fed19df5a9c852 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 24 Oct 2003 16:43:19 +0000 Subject: [PATCH 1/1] initial import --- Changes | 6 ++ IPaymentTPG.pm | 279 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ MANIFEST | 11 +++ Makefile.PL | 14 +++ README | 25 +++++ t/bad_auth.t | 42 +++++++++ t/bop.t | 5 + t/capture.t | 63 +++++++++++++ t/check.t | 32 +++++++ t/credit_card.t | 35 +++++++ t/load.t | 5 + 11 files changed, 517 insertions(+) create mode 100644 Changes create mode 100644 IPaymentTPG.pm create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 t/bad_auth.t create mode 100644 t/bop.t create mode 100644 t/capture.t create mode 100644 t/check.t create mode 100644 t/credit_card.t create mode 100644 t/load.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..11b2d7a --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Business::OnlinePayment::IPaymentTPG. + +0.01 Mon Mar 18 01:17:32 2002 + - original version; created by h2xs 1.21 with options + -A -X -n Business::OnlinePayment::IPaymentTPG + diff --git a/IPaymentTPG.pm b/IPaymentTPG.pm new file mode 100644 index 0000000..88c6b6d --- /dev/null +++ b/IPaymentTPG.pm @@ -0,0 +1,279 @@ +package Business::OnlinePayment::IPaymentTPG; + +use strict; +use vars qw($VERSION @ISA); +use AutoLoader; +use IO::Socket::INET; +use Business::OnlinePayment; +#use Crypt::Blowfish; + +@ISA = qw(Business::OnlinePayment); + +$VERSION = '0.01'; + +sub set_defaults { + my $self = shift; + $self->server('205.137.49.250'); + $self->port('8003'); + + $self->build_subs('order_number'); + +} + +sub map_fields { + my($self) = @_; + + my %content = $self->content(); + + #ACTION MAP + my %actions = ('normal authorization' => 'B', #both + 'authorization only' => 'O', #open + 'credit' => 'C', #credit + 'post authorization' => 'S', #sell + ); + $content{'action'} = $actions{lc($content{'action'})} || $content{'action'}; + + # stuff it back into %content + $self->content(%content); +} + + +sub build_subs { + my $self = shift; + foreach(@_) { + #no warnings; #not 5.005 + local($^W)=0; + eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }"; + } +} + +sub get_fields { + my($self,@fields) = @_; + + my %content = $self->content(); + my %new = (); + foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; } + return %new; +} + + +sub submit { + my($self) = @_; + + $self->map_fields(); + +# my %content = $self->content; + + $self->required_fields(qw( login password + action card_number expiration amount ) ); + + my %d = $self->get_fields(qw( + login password action card_number expiration amount + phone invoice_number zip email + )); + + $d{expiration} =~ s/\D//g; + + substr($d{expiration},2,2,'') if length($d{expiration}) == 6; + + $d{amount} = sprintf("%.2f",$d{amount}); + $d{amount} =~ s/\.//; + + my($address1,$address2); + { + local($^W)=0; + $d{phone} =~ s/\D//g; + + $d{zip} =~ s/\W//g; + + ($address1,$address2) = split(/,\s*/, $d{address}, 2); #hmm + + } + + #66 + my $req4 = pack("A4A10A20A1A16A4A10A1", + 'REQ4', #SEGMENT_ID + $d{login}, #ID_CODE + $d{password}, #PASSWORD + $d{action}, #TYPE + $d{card_number}, #CC + $d{expiration}, #EXP + $d{amount}, #AMOUNT + 1, #OPT + ); + + #372 + my $opt1; + { + local($^W)=0; + $opt1 = pack("A4A5A10A10A9A3A40A40A40A40A25A2A25A40A40A4A10A25", + 'OPT1', #SEGMENT_ID + '30000', #TIMEOUT + $d{phone}, #ANI + $d{invoice_number}, #SEQNO + $d{zip}, #ZIP + '', #CVV2 + '', #DESCRIPTOR + $d{email}, #EMAIL + $address1, #ADDRESS1 + $address2, #ADDRESS2 + $d{city}, #CITY + $d{state}, #STATE + $d{country}, #COUNTRY + $d{first_name}, #FIRST_NAME + $d{last_name}, #LAST_NAME + 'US', #CURRENCY + $d{order_number}, #TRACKING_NO + 'CRYPT_KEY', #CRYPT_KEY + ); + } + + #send to server + my $sock = new IO::Socket::INET + PeerAddr => $self->server, + PeerPort => $self->port, + Proto => 'tcp', + Timeout => 10, + or die "can't connect to ". $self->server. ":". $self->port. " : $!"; + + print $sock "000438$req4$opt1"; ; #66 + 372, only one record for now + + my $message_length; + my $num = read $sock, $message_length, 6; + die "expected 6 byte MESSAGE_LENGTH response from server, got $num: $!" + unless $num == 6; + + #34 - only one record for now + die "expected MESSAGE_LENGTH 34 from server, got $message_length" + unless $message_length == 34; + + my $res1; + my $read_length = read $sock, $res1, $message_length; + die "expected 34 byte RES1 message from server, got $read_length" + unless $read_length == 34; + + my( $segment_id, $response, $tracking_no, $seqno ) = + unpack("A4A10A10A10", $res1); + + die "expected SEGMENT_ID=RES1 from server, got $segment_id" + unless $segment_id eq 'RES1'; + + my($result,$mapp,$avs,$card,$ani,$new,$transaction,$cvv2,$ssv,$bin_blocker)= + split('',$response); + + if ( $result =~ /^[127]$/ ) { + $self->is_success(1); + $self->result_code($response); + $self->authorization($tracking_no); + $self->order_number($tracking_no); + #$seq_no ? + } else { + $self->is_success(0); + $self->result_code($response); + + my %resultmap = ( + '0' => 'Not available or System Down', + '1' => 'Optn Approved', + '2' => 'Sell Approved', + '3' => 'Open Declined', + '4' => 'Sell Decliend', + '5' => 'Invalid Message', + '6' => 'Closed Merchant Account', + '7' => 'Credit Approved', + '8' => 'Credit Declined', + ); + + my %cardmap = ( + '0' => 'N/A', + '1' => 'Good', + #'2' => 'Card Limit', + '2' => 'Card Over Limit', + #'3' => 'Exp', + '3' => 'Expired', + '4' => 'Card Blocked', + #'5' => 'MOD-10', + '5' => 'Invalid credit card number', + '6' => 'Test card', + '7' => 'Chargeback', + ); + + my $error = $resultmap{$result}; + $error .= ": $cardmap{$card}" if $card; + + $self->error_message($error); + } + +} + +1; +__END__ + +=head1 NAME + +Business::OnlinePayment::IPaymentTPG - iPayment TPG backend for Business::OnlinePayment + +=head1 SYNOPSIS + + use Business::OnlinePayment; + + my $tx = new Business::OnlinePayment( 'IPaymentTPG', + ); + + $tx->content( + type => 'VISA', + action => 'Normal Authorization', + description => 'Business::OnlinePayment test', + amount => '49.95', + invoice_number => '100100', + customer_id => 'jsk', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + email => 'ivan-ipaymenttpg@420.am', + card_number => '4007000000027', + expiration => '09/02', + ); + $tx->submit(); + + if($tx->is_success()) { + print "Card processed successfully: ".$tx->authorization."\n"; + } else { + print "Card was rejected: ".$tx->error_message."\n"; + } + +=head1 SUPPORTED TRANSACTION TYPES + +=head2 Visa, MasterCard, American Express, JCB, Discover/Novus, Carte blanche/Diners Club + +=head1 DESCRIPTION + +For detailed information see L. + +=head1 NOTE + +Unlike Business::OnlinePayment or pre-3.0 verisons of +Business::OnlinePayment::AuthorizeNet, 3.1 requires separate first_name and +last_name fields. + +=head1 COMPATIBILITY + +This module implements the interface documented in +https://tpg1.ipaymenttechnologies.com/docs/ + +=head1 BUGS + +The documentation lacks specifics on the encryption implementation. + +=head1 AUTHOR + +Ivan Kohler + +=head1 SEE ALSO + +perl(1), L. + +=cut + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..c926c65 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,11 @@ +Changes +IPaymentTPG.pm +Makefile.PL +MANIFEST +README +t/bad_auth.t +t/bop.t +t/capture.t +t/check.t +t/credit_card.t +t/load.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..89f9ff9 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,14 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Business::OnlinePayment::IPaymentTPG', + 'VERSION_FROM' => 'IPaymentTPG.pm', # finds $VERSION + 'PREREQ_PM' => { 'Business::OnlinePayment' => 0, + 'Crypt::Blowfish' => 0, + #'IO::Socket::INET' => 0, + }, + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'IPaymentTPG.pm', # retrieve abstract from module + AUTHOR => 'Ivan Kohler ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..3348d46 --- /dev/null +++ b/README @@ -0,0 +1,25 @@ +Copyright (c) 2002 Ivan Kohler +All rights reserved. This program is free software; you can redistribute it +and/or modify it under the same terms as Perl itself. + +This is Business::OnlinePayment::IPaymentTPG, an Business::OnlinePayment +backend module for the iPayment Transaction Processing Gateway. It is only +useful if you have a merchant account with iPayment, Inc.: +http://www.ipaymentinc.com/tpg.asp + +This module implements the interface documented in: + +https://tpg1.ipaymenttechnologies.com/docs/ + +It is (rather loosely at this point) based on +Business::OnlinePayment::AuthorizeNet written by Jason Kohles. + +#There are additional tests in t2/ that may be useful to you once you have a +# XXXX + +Ivan Kohler + +Business::OnlinePayment is a generic interface for processing payments through +online credit card processors, online check acceptance houses, etc. (If you +like buzzwords, call it an "multiplatform ecommerce-enabling middleware +solution"). diff --git a/t/bad_auth.t b/t/bad_auth.t new file mode 100644 index 0000000..2db45af --- /dev/null +++ b/t/bad_auth.t @@ -0,0 +1,42 @@ +BEGIN { $| = 1; print "1..1\n"; } + +use Business::OnlinePayment; + +my $tx = new Business::OnlinePayment("IPaymentTPG", +); + +$tx->content( + login => 'testing', #CHANGE THESE TO TEST + password => 'testing', + type => 'VISA', + action => 'Normal Authorization', + description => 'Business::OnlinePayment::IPaymentTPG visa test', + amount => '0.01', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + country => 'US', + email => 'ivan-linkpoint@420.am', +# card_number => '4007000000027', + card_number => '0000000000000', + expiration => '12/2002', + result => 'DECLINE', +); + +$tx->test_transaction(1); + +$tx->submit(); + +if($tx->is_success()) { + print "not ok 1\n"; + $auth = $tx->authorization; + warn "********* $auth ***********\n"; +} else { + print "ok 1\n"; + warn '***** '. $tx->error_message. " *****\n"; + exit; +} + diff --git a/t/bop.t b/t/bop.t new file mode 100644 index 0000000..64332c5 --- /dev/null +++ b/t/bop.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Business::OnlinePayment; +$loaded = 1; +print "ok 1\n"; diff --git a/t/capture.t b/t/capture.t new file mode 100644 index 0000000..92d9169 --- /dev/null +++ b/t/capture.t @@ -0,0 +1,63 @@ +BEGIN { $| = 1; print "1..2\n"; } + +#print "ok 1 # Skipped: need a valid iPayment login/password to test\n"; +#print "ok 2 # Skipped: need a valid iPayment login/password to test\n"; +#exit; + +use Business::OnlinePayment; + +my $tx = new Business::OnlinePayment("IPaymentTPG"); +$tx->content( + login => 'testing',# CHANGE THESE TO TEST + password => 'testing',# + type => 'VISA', + action => 'Authorization Only', + description => 'Business::OnlinePayment visa test', + amount => '49.95', + invoice_number => '100100', + customer_id => 'jsk', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + card_number => '4007000000027', + expiration => '08/06', +); +$tx->test_transaction(1); # test, dont really charge +$tx->submit(); + +unless($tx->is_success()) { + print "not ok 1\n"; + print "not ok 2\n"; +} else { + my $order_number = $tx->order_number; + #warn $order_number; + print "ok 1\n"; + + my $settle_tx = new Business::OnlinePayment("IPaymentTPG"); + $settle_tx->content( + type => 'VISA', + login => 'testing', # CHANGE THESE TO TEST + password => 'testing', # + action => 'Post Authorization', + description => 'Business::OnlinePayment visa test', + amount => '49.95', + invoice_number => '100100', + order_number => $order_number, + card_number => '4007000000027', + expiration => '08/06', + ); + + $settle_tx->test_transaction(1); # test, dont really charge + $settle_tx->submit(); + + if($settle_tx->is_success()) { + print "ok 2\n"; + } else { + #warn $settle_tx->error_message; + print "not ok 2\n"; + } + +} diff --git a/t/check.t b/t/check.t new file mode 100644 index 0000000..87efff2 --- /dev/null +++ b/t/check.t @@ -0,0 +1,32 @@ +BEGIN { $| = 1; print "1..1\n"; } + +print "ok 1 # Skipped: ACH unimplemented with this processor\n"; exit; + +use Business::OnlinePayment; + +# checks are broken it seems +my $ctx = new Business::OnlinePayment("IPaymentTPG"); +$ctx->content( + type => 'CHECK', + login => 'testing', + password => 'testing', + action => 'Normal Authorization', + amount => '49.95', + invoice_number => '100100', + customer_id => 'jsk', + first_name => 'Tofu', + last_name => 'Beast', + account_number => '12345', + routing_code => '123456789', + bank_name => 'First National Test Bank', +); +$ctx->test_transaction(1); # test, dont really charge +$ctx->submit(); + +print $ctx->is_success()."\n"; + +if($ctx->is_success()) { + print "ok 1\n"; +} else { + print "not ok 1 (".$ctx->error_message().")\n"; +} diff --git a/t/credit_card.t b/t/credit_card.t new file mode 100644 index 0000000..349caae --- /dev/null +++ b/t/credit_card.t @@ -0,0 +1,35 @@ +BEGIN { $| = 1; print "1..1\n"; } + +#testing/testing is valid and seems to work... +#print "ok 1 # Skipped: need a valid iPayment login/password to test\n"; exit; + +use Business::OnlinePayment; + +my $tx = new Business::OnlinePayment("IPaymentTPG"); +$tx->content( + login => 'testing', #CHANGE THESE TO TEST + password => 'testing', # + type => 'VISA', + action => 'Normal Authorization', + description => 'Business::OnlinePayment visa test', + amount => '49.95', + invoice_number => '100100', + customer_id => 'jsk', + first_name => 'Tofu', + last_name => 'Beast', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + card_number => '4007000000027', + expiration => '08/06', +); +$tx->test_transaction(1); # test, dont really charge +$tx->submit(); + +if($tx->is_success()) { + print "ok 1\n"; +} else { + #warn $tx->error_message; + print "not ok 1\n"; +} diff --git a/t/load.t b/t/load.t new file mode 100644 index 0000000..41b0e43 --- /dev/null +++ b/t/load.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Business::OnlinePayment::IPaymentTPG; +$loaded = 1; +print "ok 1\n"; -- 2.11.0