+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
+
projects / Business-OnlinePayment-IPaymentTPG.git / commitdiff