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