IPaymentTPG.pm

   1 package Business::OnlinePayment::IPaymentTPG;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA);
   5 use AutoLoader;
   6 use IO::Socket::INET;
   7 use Business::OnlinePayment;
   8 #use Crypt::Blowfish;
   9
  10 @ISA = qw(Business::OnlinePayment);
  11
  12 $VERSION = '0.01';
  13
  14 sub set_defaults {
  15   my $self = shift;
  16   $self->server('205.137.49.250');
  17   $self->port('8003');
  18
  19   $self->build_subs('order_number');
  20
  21 }
  22
  23 sub map_fields {
  24     my($self) = @_;
  25
  26     my %content = $self->content();
  27
  28     #ACTION MAP
  29     my %actions = ('normal authorization' => 'B', #both
  30                    'authorization only'   => 'O', #open
  31                    'credit'               => 'C', #credit
  32                    'post authorization'   => 'S', #sell
  33                   );
  34     $content{'action'} = $actions{lc($content{'action'})} || $content{'action'};
  35
  36     # stuff it back into %content
  37     $self->content(%content);
  38 }
  39
  40
  41 sub build_subs {
  42     my $self = shift;
  43     foreach(@_) {
  44         #no warnings; #not 5.005
  45         local($^W)=0;
  46         eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
  47     }
  48 }
  49
  50 sub get_fields {
  51     my($self,@fields) = @_;
  52
  53     my %content = $self->content();
  54     my %new = ();
  55     foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; }
  56     return %new;
  57 }
  58
  59
  60 sub submit {
  61     my($self) = @_;
  62
  63     $self->map_fields();
  64
  65 #    my %content = $self->content;
  66
  67     $self->required_fields(qw( login password
  68                                action card_number expiration amount ) );
  69
  70     my %d = $self->get_fields(qw(
  71       login password action card_number expiration amount
  72       phone invoice_number zip email
  73     ));
  74
  75     $d{expiration} =~ s/\D//g;
  76
  77     substr($d{expiration},2,2,'') if length($d{expiration}) == 6;
  78
  79     $d{amount} = sprintf("%.2f",$d{amount});
  80     $d{amount} =~ s/\.//;
  81
  82     my($address1,$address2);
  83     {
  84       local($^W)=0;
  85       $d{phone} =~ s/\D//g;
  86
  87       $d{zip} =~ s/\W//g;
  88
  89       ($address1,$address2) = split(/,\s*/, $d{address}, 2); #hmm
  90
  91     }
  92
  93     #66
  94     my $req4 = pack("A4A10A20A1A16A4A10A1",
  95       'REQ4',          #SEGMENT_ID
  96       $d{login},       #ID_CODE
  97       $d{password},    #PASSWORD
  98       $d{action},      #TYPE
  99       $d{card_number}, #CC
 100       $d{expiration},  #EXP
 101       $d{amount},      #AMOUNT
 102       1,               #OPT
 103     );
 104
 105     #372
 106     my $opt1;
 107     {
 108       local($^W)=0;
 109       $opt1 = pack("A4A5A10A10A9A3A40A40A40A40A25A2A25A40A40A4A10A25",
 110         'OPT1',             #SEGMENT_ID
 111         '30000',            #TIMEOUT
 112         $d{phone},          #ANI
 113         $d{invoice_number}, #SEQNO
 114         $d{zip},            #ZIP
 115         '',                 #CVV2
 116         '',                 #DESCRIPTOR
 117         $d{email},          #EMAIL
 118         $address1,          #ADDRESS1
 119         $address2,          #ADDRESS2
 120         $d{city},           #CITY
 121         $d{state},          #STATE
 122         $d{country},        #COUNTRY
 123         $d{first_name},     #FIRST_NAME
 124         $d{last_name},      #LAST_NAME
 125         'US',               #CURRENCY
 126         $d{order_number},   #TRACKING_NO
 127         'CRYPT_KEY',        #CRYPT_KEY
 128       );
 129     }
 130
 131     #send to server
 132     my $sock = new IO::Socket::INET
 133       PeerAddr => $self->server,
 134       PeerPort => $self->port,
 135       Proto    => 'tcp',
 136       Timeout  => 10,
 137     or die "can't connect to ". $self->server. ":". $self->port. " : $!";
 138
 139     print $sock "000438$req4$opt1"; ; #66 + 372, only one record for now
 140
 141     my $message_length;
 142     my $num = read $sock, $message_length, 6;
 143     die "expected 6 byte MESSAGE_LENGTH response from server, got $num: $!"
 144       unless $num == 6;
 145
 146     #34 - only one record for now
 147     die "expected MESSAGE_LENGTH 34 from server, got $message_length"
 148       unless $message_length == 34;
 149
 150     my $res1;
 151     my $read_length = read $sock, $res1, $message_length;
 152     die "expected 34 byte RES1 message from server, got $read_length"
 153       unless $read_length == 34;
 154
 155     my( $segment_id, $response, $tracking_no, $seqno ) =
 156       unpack("A4A10A10A10", $res1);
 157
 158     die "expected SEGMENT_ID=RES1 from server, got $segment_id"
 159       unless $segment_id eq 'RES1';
 160
 161     my($result,$mapp,$avs,$card,$ani,$new,$transaction,$cvv2,$ssv,$bin_blocker)=
 162       split('',$response);
 163
 164     if ( $result =~ /^[127]$/ ) {
 165       $self->is_success(1);
 166       $self->result_code($response);
 167       $self->authorization($tracking_no);
 168       $self->order_number($tracking_no);
 169       #$seq_no ?
 170     } else {
 171       $self->is_success(0);
 172       $self->result_code($response);
 173
 174       my %resultmap = (
 175         '0' => 'Not available or System Down',
 176         '1' => 'Optn Approved',
 177         '2' => 'Sell Approved',
 178         '3' => 'Open Declined',
 179         '4' => 'Sell Decliend',
 180         '5' => 'Invalid Message',
 181         '6' => 'Closed Merchant Account',
 182         '7' => 'Credit Approved',
 183         '8' => 'Credit Declined',
 184       );
 185
 186       my %cardmap = (
 187         '0' => 'N/A',
 188         '1' => 'Good',
 189         #'2' => 'Card Limit',
 190         '2' => 'Card Over Limit',
 191         #'3' => 'Exp',
 192         '3' => 'Expired',
 193         '4' => 'Card Blocked',
 194         #'5' => 'MOD-10',
 195         '5' => 'Invalid credit card number',
 196         '6' => 'Test card',
 197         '7' => 'Chargeback',
 198       );
 199
 200       my $error = $resultmap{$result};
 201       $error .= ": $cardmap{$card}" if $card;
 202
 203       $self->error_message($error);
 204     }
 205
 206 }
 207
 208 1;
 209 __END__
 210
 211 =head1 NAME
 212
 213 Business::OnlinePayment::IPaymentTPG - iPayment TPG backend for Business::OnlinePayment
 214
 215 =head1 SYNOPSIS
 216
 217   use Business::OnlinePayment;
 218
 219     my $tx = new Business::OnlinePayment( 'IPaymentTPG',
 220     );
 221
 222   $tx->content(
 223       type           => 'VISA',
 224       action         => 'Normal Authorization',
 225       description    => 'Business::OnlinePayment test',
 226       amount         => '49.95',
 227       invoice_number => '100100',
 228       customer_id    => 'jsk',
 229       first_name     => 'Tofu',
 230       last_name      => 'Beast',
 231       address        => '123 Anystreet',
 232       city           => 'Anywhere',
 233       state          => 'UT',
 234       zip            => '84058',
 235       email          => 'ivan-ipaymenttpg@420.am',
 236       card_number    => '4007000000027',
 237       expiration     => '09/02',
 238   );
 239   $tx->submit();
 240
 241   if($tx->is_success()) {
 242       print "Card processed successfully: ".$tx->authorization."\n";
 243   } else {
 244       print "Card was rejected: ".$tx->error_message."\n";
 245   }
 246
 247 =head1 SUPPORTED TRANSACTION TYPES
 248
 249 =head2 Visa, MasterCard, American Express, JCB, Discover/Novus, Carte blanche/Diners Club
 250
 251 =head1 DESCRIPTION
 252
 253 For detailed information see L<Business::OnlinePayment>.
 254
 255 =head1 NOTE
 256
 257 Unlike Business::OnlinePayment or pre-3.0 verisons of
 258 Business::OnlinePayment::AuthorizeNet, 3.1 requires separate first_name and
 259 last_name fields.
 260
 261 =head1 COMPATIBILITY
 262
 263 This module implements the interface documented in
 264 https://tpg1.ipaymenttechnologies.com/docs/
 265
 266 =head1 BUGS
 267
 268 The documentation lacks specifics on the encryption implementation.
 269
 270 =head1 AUTHOR
 271
 272 Ivan Kohler <ivan-ipaymenttpg@420.am>
 273
 274 =head1 SEE ALSO
 275
 276 perl(1),  L<Business::OnlinePayment>.
 277
 278 =cut
 279