diff options
Diffstat (limited to 'IPaymentTPG.pm')
| -rw-r--r-- | IPaymentTPG.pm | 279 |
1 files changed, 279 insertions, 0 deletions
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<Business::OnlinePayment>. + +=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 <ivan-ipaymenttpg@420.am> + +=head1 SEE ALSO + +perl(1), L<Business::OnlinePayment>. + +=cut + |