path: root/IPaymentTPG.pm

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