New Paymentech module renamed

8 files changed, 415 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..a616435
--- /dev/null
+++ b/Changes
@@ -0,0 +1,4 @@
+Revision history for Business-OnlinePayment-PaymenTech
+
+2.00    Wed Oct  7 09:25:34 PDT 2009
+        Complete rewrite to use the XML interface directly.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..971978f
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,7 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Business/OnlinePayment/PaymenTech.pm
+t/00-load.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..d0b1788
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Business::OnlinePayment::PaymenTech',
+    AUTHOR              => 'Mark Wells <mark@freeside.biz>',
+    VERSION_FROM        => 'lib/Business/OnlinePayment/PaymenTech.pm',
+    ABSTRACT_FROM       => 'lib/Business/OnlinePayment/PaymenTech.pm',
+    ($ExtUtils::MakeMaker::VERSION >= 6.3002
+      ? ('LICENSE'=> 'perl')
+      : ()),
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'Business-OnlinePayment-PaymenTech-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..070a625
--- /dev/null
+++ b/README
@@ -0,0 +1,27 @@
+Business-OnlinePayment-PaymenTech is a Business::OnlinePayment 
+module for processing credit card payments through the Chase 
+Paymentech Orbital Gateway.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc Business::OnlinePayment::PaymenTech
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2009 Mark Wells
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
diff --git a/lib/Business/OnlinePayment/PaymenTech.pm b/lib/Business/OnlinePayment/PaymenTech.pm
new file mode 100644
index 0000000..bbbae48
--- /dev/null
+++ b/lib/Business/OnlinePayment/PaymenTech.pm
@@ -0,0 +1,282 @@
+package Business::OnlinePayment::PaymenTech;
+
+use strict;
+use Carp;
+use Business::OnlinePayment::HTTPS;
+use XML::Simple;
+use Tie::IxHash;
+use vars qw($VERSION $DEBUG @ISA $me);
+
+@ISA = qw(Business::OnlinePayment::HTTPS);
+$VERSION = '2.00';
+$DEBUG = 0;
+$me='Business::OnlinePayment::PaymenTech';
+
+my %request_header = (
+  'MIME-VERSION'    =>    '1.0',
+  'Content-Transfer-Encoding' => 'text',
+  'Request-Number'  =>    1,
+  'Document-Type'   =>    'Request',
+  #'Trace-Number'    =>    1,
+  'Interface-Version' =>  "$me $VERSION",
+); # Content-Type has to be passed separately
+
+tie my %new_order, 'Tie::IxHash', (
+  OrbitalConnectionUsername => ':login',
+  OrbitalConnectionPassword => ':password',
+  IndustryType              => 'EC', # Assume industry = Ecommerce
+  MessageType               => ':message_type',
+  BIN                       => ':bin',
+  MerchantID                => ':merchant_id',
+  TerminalID                => ':terminal_id',
+  CardBrand                 => '',
+  AccountNum                => ':card_number',
+  Exp                       => ':expiration',
+  CurrencyCode              => ':currency_code',
+  CurrencyExponent          => ':currency_exp',
+  CardSecValInd             => ':cvvind',
+  CardSecVal                => ':cvv2',
+#  AVSname                   => ':name', not needed
+  AVSzip                    => ':zip',
+  AVSaddress1               => ':address',
+  AVScity                   => ':city',
+  AVSstate                  => ':state',
+  OrderID                   => ':invoice_number',
+  Amount                    => ':amount',
+  Comments                  => ':email', # as per B:OP:WesternACH
+);
+
+my %defaults = (
+  terminal_id => '001',
+  currency    => 'USD',
+  cvvind      => '',
+);
+
+my @required = ( qw(
+  login
+  password
+  action
+  bin
+  merchant_id
+  card_number
+  expiration
+  currency
+  address
+  city
+  zip
+  invoice_number
+  amount
+  )
+);
+
+my %currency_code = (
+# Per ISO 4217.  Add to this as needed.
+  USD => [840, 2],
+  CAD => [124, 2],
+  MXN => [484, 2],
+);
+
+sub set_defaults {
+    my $self = shift;
+
+    $self->server('orbitalvar1.paymentech.net') unless $self->server; # this is the test server.
+    $self->port('443') unless $self->port;
+    $self->path('/authorize') unless $self->path;
+
+    $self->build_subs(qw( TxRefNum ProcStatus ApprovalStatus StatusMsg Response ));
+
+}
+
+sub build {
+  my $self = shift;
+  my %content = $self->content();
+  my $skel = shift;
+  tie my %data, 'Tie::IxHash';
+  ref($skel) eq 'HASH' or die 'Tried to build non-hash';
+  foreach my $k (keys(%$skel)) {
+    my $v = $skel->{$k};
+    # Not recursive like B:OP:WesternACH; Paymentech requests are only one layer deep.
+    if($v =~ /^:(.*)/) {
+      # Get the content field with that name.
+      $data{$k} = $content{$1};
+    }
+    else {
+      $data{$k} = $v;
+    }
+  }
+  return \%data;
+}
+
+sub map_fields {
+    my($self) = @_;
+
+    my %content = $self->content();
+    foreach(qw(merchant_id terminal_id currency)) {
+      $content{$_} = $self->{$_} if exists($self->{$_});
+    }
+
+    $self->required_fields('action');
+    my %message_type = 
+                  ('normal authorization' => 'AC',
+                   'authorization only'   => 'A',
+                   'credit'               => 'R',
+                   'post authorization'   => 'MFC', # for our use, doesn't go in the request
+                   ); 
+    $content{'message_type'} = $message_type{lc($content{'action'})} 
+      or die "unsupported action: '".$content{'action'}."'";
+    if($content{'message_type'} eq 'MFC') {
+      die 'MarkForCapture not implemented';
+      # for later implementation
+    }
+
+    foreach (keys(%defaults) ) {
+      $content{$_} = $defaults{$_} if !defined($content{$_});
+    }
+    $DB::single=1;
+    if(length($content{merchant_id}) == 12) {
+      $content{bin} = '000002' # PNS
+    }
+    elsif(length($content{merchant_id}) == 6) {
+      $content{bin} = '000001' # Salem
+    }
+    else {
+      die "invalid merchant ID: '".$content{merchant_id}."'";
+    }
+
+    @content{qw(currency_code currency_exp)} = @{$currency_code{$content{currency}}}
+      if $content{currency};
+
+    if($content{card_number} =~ /^(4|6011)/) { # Matches Visa and Discover transactions
+      if(defined($content{cvv2})) {
+        $content{cvvind} = 1; # "Value is present"
+      }
+      else {
+        $content{cvvind} = 9; # "Value is not available"
+      }
+    }
+    $content{amount} = int($content{amount}*100);
+    $content{name} = $content{first_name} . ' ' . $content{last_name};
+# According to the spec, the first 8 characters of this have to be unique.
+# The test server doesn't enforce this, but we comply anyway to the extent possible.
+    if($content{invoice_number}) {
+      # Mark it so that it's obvious that this is an invoice number
+      $content{invoice_number} = 'INV '.$content{invoice_number};
+    }
+    else {
+      # Otherwise, make something up!
+      $content{invoice_number} ||= sprintf("%04x%04x",time % 2**16,int(rand() * 2**16));
+    }
+
+    $content{expiration} =~ s/\D//g; # Because Freeside sends it as mm/yy, not mmyy.
+
+    $self->content(%content);
+    return;
+}
+
+sub submit {
+  my($self) = @_;
+  $DB::single = $DEBUG;
+
+  $self->map_fields();
+
+  # This will change when we add e-check support
+  my @required_fields = @required;
+
+  $self->required_fields(@required_fields);
+
+  # This will change when we add mark-for-capture support
+  my $request = { NewOrder => $self->build(\%new_order) }; 
+
+  my $post_data = XMLout({ Request => $request }, KeepRoot => 1, NoAttr => 1, NoSort => 1);
+
+  if (!$self->test_transaction()) {
+    $self->server('orbital1.paymentech.net');
+  }
+
+  warn $post_data if $DEBUG;
+  $DB::single = $DEBUG;
+  my($page,$server_response,%headers) =
+    $self->https_post( { 'Content-Type' => 'application/PTI47', 
+                         'headers' => \%request_header } ,
+                          $post_data);
+
+  warn $page if $DEBUG;
+
+  my $response;
+  my $error = '';
+  if ($server_response =~ /200/){
+    $response = XMLin($page, KeepRoot => 0);
+    $self->Response($response);
+    my ($r) = values(%$response);
+    if(!exists($r->{'ProcStatus'})) {
+      $error = "Malformed response: '$page'";
+    }
+    elsif($r->{'ProcStatus'} != 0 || $r->{'ApprovalStatus'} != 1) {
+      $error = "Transaction error: '". ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'";
+    }
+    else {
+      # success!
+      $self->is_success(1);
+      $self->authorization($r->{'TxRefNum'});
+    }
+  }else{
+    $error = "Server error: '$server_response'";
+  }
+  $self->error_message($error);
+  $self->is_success(0) if $error;
+
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Business::OnlinePayment::PaymenTech - Chase Paymentech backend for Business::OnlinePayment
+
+=head1 SYNOPSIS
+
+$trans = new Business::OnlinePayment('PaymenTech');
+$trans->content(
+  login           => "login",
+  password        => "password",
+  merchant_id     => "000111222333",
+  terminal_id     => "001",
+  type            => "CC",
+  card_number     => "5500000000000004",
+  expiration      => "0211",
+  address         => "123 Anystreet",
+  city            => "Sacramento",
+  zip             => "95824",
+  action          => "Normal Authorization",
+  amount          => "24.99",
+
+);
+
+$trans->submit;
+if($trans->is_approved) {
+  print "Approved: ".$trans->authorization;
+
+} else {
+  print "Failed: ".$trans->error_message;
+
+}
+
+=head1 NOTES
+
+The only supported transaction types are Normal Authorization and Credit.  Paymentech 
+supports separate Authorize and Capture actions as well as recurring billing, but 
+those are not yet implemented.
+
+Electronic check processing is not yet supported.
+
+=head1 AUTHOR
+
+Mark Wells, mark@freeside.biz
+
+=head1 SEE ALSO
+
+perl(1). L<Business::OnlinePayment>.
+
+=cut
+
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..b8e989c
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+	use_ok( 'Business::OnlinePayment::PaymenTech' );
+}
+
+diag( "Testing Business::OnlinePayment::PaymenTech $Business::OnlinePayment::PaymenTech::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..8b69a7b
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,55 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open( my $fh, '<', $filename )
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+TODO: {
+  local $TODO = "Need to replace the boilerplate text";
+
+  not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+  );
+
+  not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+  );
+
+  module_boilerplate_ok('lib/Business/OnlinePayment/PaymenTech.pm');
+
+
+}
+
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..ee8b18a
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();