From: mark Date: Wed, 7 Oct 2009 16:38:40 +0000 (+0000) Subject: New Paymentech module renamed X-Git-Url: http://git.freeside.biz/gitweb/?p=Business-OnlinePayment-PaymenTech.git;a=commitdiff_plain;h=c95a7bc2db620dd2eb857102511598b6c0bbca6f New Paymentech module renamed --- c95a7bc2db620dd2eb857102511598b6c0bbca6f 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 ', + 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. + +=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();