initial importHEADSTARTmaster

11 files changed, 517 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..11b2d7a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,6 @@
+Revision history for Perl extension Business::OnlinePayment::IPaymentTPG.
+
+0.01  Mon Mar 18 01:17:32 2002
+	- original version; created by h2xs 1.21 with options
+		-A -X -n Business::OnlinePayment::IPaymentTPG
+
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
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..c926c65
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,11 @@
+Changes
+IPaymentTPG.pm
+Makefile.PL
+MANIFEST
+README
+t/bad_auth.t
+t/bop.t
+t/capture.t
+t/check.t
+t/credit_card.t
+t/load.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..89f9ff9
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Business::OnlinePayment::IPaymentTPG',
+    'VERSION_FROM'	=> 'IPaymentTPG.pm', # finds $VERSION
+    'PREREQ_PM'		=> { 'Business::OnlinePayment' => 0,
+                             'Crypt::Blowfish' => 0,
+                             #'IO::Socket::INET' => 0,
+                           },
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'IPaymentTPG.pm', # retrieve abstract from module
+       AUTHOR     => 'Ivan Kohler <ivan-ipaymenttpg@420.am>') : ()),
+);
diff --git a/README b/README
new file mode 100644
index 0000000..3348d46
--- /dev/null
+++ b/README
@@ -0,0 +1,25 @@
+Copyright (c) 2002 Ivan Kohler
+All rights reserved. This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+This is Business::OnlinePayment::IPaymentTPG, an Business::OnlinePayment
+backend module for the iPayment Transaction Processing Gateway.  It is only
+useful if you have a merchant account with iPayment, Inc.:
+http://www.ipaymentinc.com/tpg.asp
+
+This module implements the interface documented in:
+
+https://tpg1.ipaymenttechnologies.com/docs/
+
+It is (rather loosely at this point) based on
+Business::OnlinePayment::AuthorizeNet written by Jason Kohles.
+
+#There are additional tests in t2/ that may be useful to you once you have a
+# XXXX
+
+Ivan Kohler <ivan-ipaymenttpg@420.am>
+
+Business::OnlinePayment is a generic interface for processing payments through
+online credit card processors, online check acceptance houses, etc.  (If you
+like buzzwords, call it an "multiplatform ecommerce-enabling middleware
+solution").
diff --git a/t/bad_auth.t b/t/bad_auth.t
new file mode 100644
index 0000000..2db45af
--- /dev/null
+++ b/t/bad_auth.t
@@ -0,0 +1,42 @@
+BEGIN { $| = 1; print "1..1\n"; }
+
+use Business::OnlinePayment;
+
+my $tx = new Business::OnlinePayment("IPaymentTPG",
+);
+
+$tx->content(
+    login          => 'testing', #CHANGE THESE TO TEST
+    password       => 'testing',
+    type           => 'VISA',
+    action         => 'Normal Authorization',
+    description    => 'Business::OnlinePayment::IPaymentTPG visa test',
+    amount         => '0.01',
+    first_name     => 'Tofu',
+    last_name      => 'Beast',
+    address        => '123 Anystreet',
+    city           => 'Anywhere',
+    state          => 'UT',
+    zip            => '84058',
+    country        => 'US',
+    email          => 'ivan-linkpoint@420.am',
+#    card_number    => '4007000000027',
+    card_number    => '0000000000000',
+    expiration     => '12/2002',
+    result         => 'DECLINE',
+);
+
+$tx->test_transaction(1);
+
+$tx->submit();
+
+if($tx->is_success()) {
+    print "not ok 1\n";
+    $auth = $tx->authorization;
+    warn "********* $auth ***********\n";
+} else {
+    print "ok 1\n";
+    warn '***** '. $tx->error_message. " *****\n";
+    exit;
+}
+
diff --git a/t/bop.t b/t/bop.t
new file mode 100644
index 0000000..64332c5
--- /dev/null
+++ b/t/bop.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Business::OnlinePayment;
+$loaded = 1;
+print "ok 1\n";
diff --git a/t/capture.t b/t/capture.t
new file mode 100644
index 0000000..92d9169
--- /dev/null
+++ b/t/capture.t
@@ -0,0 +1,63 @@
+BEGIN { $| = 1; print "1..2\n"; }
+
+#print "ok 1 # Skipped: need a valid iPayment login/password to test\n";
+#print "ok 2 # Skipped: need a valid iPayment login/password to test\n";
+#exit;
+
+use Business::OnlinePayment;
+
+my $tx = new Business::OnlinePayment("IPaymentTPG");
+$tx->content(
+    login          => 'testing',# CHANGE THESE TO TEST
+    password       => 'testing',#
+    type           => 'VISA',
+    action         => 'Authorization Only',
+    description    => 'Business::OnlinePayment visa 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',
+    card_number    => '4007000000027',
+    expiration     => '08/06',
+);
+$tx->test_transaction(1); # test, dont really charge
+$tx->submit();
+
+unless($tx->is_success()) {
+    print "not ok 1\n";
+    print "not ok 2\n";
+} else {
+    my $order_number = $tx->order_number;
+    #warn $order_number;
+    print "ok 1\n";
+
+    my $settle_tx = new Business::OnlinePayment("IPaymentTPG");
+    $settle_tx->content(
+      type           => 'VISA',
+      login          => 'testing', # CHANGE THESE TO TEST
+      password       => 'testing', #
+      action         => 'Post Authorization',
+      description    => 'Business::OnlinePayment visa test',
+      amount         => '49.95',
+      invoice_number => '100100',
+      order_number   => $order_number,
+      card_number    => '4007000000027',
+      expiration     => '08/06',
+    );
+
+    $settle_tx->test_transaction(1); # test, dont really charge
+    $settle_tx->submit();
+
+    if($settle_tx->is_success()) {
+        print "ok 2\n";
+    } else {
+        #warn $settle_tx->error_message;
+        print "not ok 2\n";
+    }
+
+}
diff --git a/t/check.t b/t/check.t
new file mode 100644
index 0000000..87efff2
--- /dev/null
+++ b/t/check.t
@@ -0,0 +1,32 @@
+BEGIN { $| = 1; print "1..1\n"; }
+
+print "ok 1 # Skipped: ACH unimplemented with this processor\n"; exit;
+
+use Business::OnlinePayment;
+
+# checks are broken it seems
+my $ctx = new Business::OnlinePayment("IPaymentTPG");
+$ctx->content(
+    type           => 'CHECK',
+    login          => 'testing',
+    password       => 'testing',
+    action         => 'Normal Authorization',
+    amount         => '49.95',
+    invoice_number => '100100',
+    customer_id    => 'jsk',
+    first_name     => 'Tofu',
+    last_name      => 'Beast',
+    account_number => '12345',
+    routing_code   => '123456789',
+    bank_name      => 'First National Test Bank',
+);
+$ctx->test_transaction(1); # test, dont really charge
+$ctx->submit();
+
+print $ctx->is_success()."\n";
+
+if($ctx->is_success()) {
+    print "ok 1\n";
+} else {
+    print "not ok 1 (".$ctx->error_message().")\n";
+}
diff --git a/t/credit_card.t b/t/credit_card.t
new file mode 100644
index 0000000..349caae
--- /dev/null
+++ b/t/credit_card.t
@@ -0,0 +1,35 @@
+BEGIN { $| = 1; print "1..1\n"; }
+
+#testing/testing is valid and seems to work...
+#print "ok 1 # Skipped: need a valid iPayment login/password to test\n"; exit;
+
+use Business::OnlinePayment;
+
+my $tx = new Business::OnlinePayment("IPaymentTPG");
+$tx->content(
+    login          => 'testing',  #CHANGE THESE TO TEST
+    password       => 'testing',  #
+    type           => 'VISA',
+    action         => 'Normal Authorization',
+    description    => 'Business::OnlinePayment visa 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',
+    card_number    => '4007000000027',
+    expiration     => '08/06',
+);
+$tx->test_transaction(1); # test, dont really charge
+$tx->submit();
+
+if($tx->is_success()) {
+    print "ok 1\n";
+} else {
+    #warn $tx->error_message;
+    print "not ok 1\n";
+}
diff --git a/t/load.t b/t/load.t
new file mode 100644
index 0000000..41b0e43
--- /dev/null
+++ b/t/load.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Business::OnlinePayment::IPaymentTPG;
+$loaded = 1;
+print "ok 1\n";