r56362 - in /branches/upstream/libbusiness-onlinepayment-paymentech-perl: ./ current/ current/lib/ current/lib/Business/ current/lib/Business/OnlinePayment/ current/t/
ivan at users.alioth.debian.org
ivan at users.alioth.debian.org
Sun Apr 18 06:57:00 UTC 2010
Author: ivan
Date: Sun Apr 18 06:56:48 2010
New Revision: 56362
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=56362
Log:
[svn-inject] Installing original source of libbusiness-onlinepayment-paymentech-perl
Added:
branches/upstream/libbusiness-onlinepayment-paymentech-perl/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Changes
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/MANIFEST
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/META.yml
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Makefile.PL
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/README
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/PaymenTech.pm
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/00-load.t
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/boilerplate.t
branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/pod.t
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Changes?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Changes (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Changes Sun Apr 18 06:56:48 2010
@@ -1,0 +1,21 @@
+Revision history for Business-OnlinePayment-PaymenTech
+
+2.03 Sun Jan 24 13:19:29 PST 2010
+ - Truncate all request fields to their maximum lengths
+ - doc: in synopsis example, move merchant_id/terminal_id from content
+ call to new constructor, and add currency. also indent the example
+ code so it formats properly
+ - Rework result handling: show ProcStatusMsg/StatusMsg if present even
+ when HTTP status != 200, decode parameters like StatusMsg that come
+ through as a hashref with length and content
+
+2.02 Wed Jan 13 18:40:06 PST 2010
+ - Add B:OP, B:OP:HTTPS and XML::Simple to Makefile.PL PREREQ_PM
+ (closes: CPAN#53646)
+ - Add t/boilerplate.t to MANIFEST
+
+2.01 Sun Nov 29 12:59:44 PST 2009
+ Added support for MarkForCapture and Reversal transactions.
+
+2.00 Wed Oct 7 09:25:34 PDT 2009
+ Complete rewrite to use the XML interface directly.
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/MANIFEST?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/MANIFEST (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/MANIFEST Sun Apr 18 06:56:48 2010
@@ -1,0 +1,9 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Business/OnlinePayment/PaymenTech.pm
+t/00-load.t
+t/boilerplate.t
+t/pod.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/META.yml?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/META.yml (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/META.yml Sun Apr 18 06:56:48 2010
@@ -1,0 +1,25 @@
+--- #YAML:1.0
+name: Business-OnlinePayment-PaymenTech
+version: 2.03
+abstract: Chase Paymentech backend for Business::OnlinePayment
+author:
+ - Mark Wells <mark at freeside.biz>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Business::OnlinePayment: 3
+ Business::OnlinePayment::HTTPS: 0
+ Test::More: 0
+ XML::Simple: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Makefile.PL?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Makefile.PL (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/Makefile.PL Sun Apr 18 06:56:48 2010
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Business::OnlinePayment::PaymenTech',
+ AUTHOR => 'Mark Wells <mark at 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,
+ 'Business::OnlinePayment' => 3,
+ 'Business::OnlinePayment::HTTPS' => 0,
+ 'XML::Simple' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Business-OnlinePayment-PaymenTech-*' },
+);
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/README?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/README (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/README Sun Apr 18 06:56:48 2010
@@ -1,0 +1,28 @@
+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-2010 Mark Wells
+Copyright (C) 2009-2010 Freeside Internet Services, Inc.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/PaymenTech.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/PaymenTech.pm?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/PaymenTech.pm (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/lib/Business/OnlinePayment/PaymenTech.pm Sun Apr 18 06:56:48 2010
@@ -1,0 +1,358 @@
+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);
+
+ at ISA = qw(Business::OnlinePayment::HTTPS);
+$VERSION = '2.03';
+$DEBUG = 0;
+$me='Business::OnlinePayment::PaymenTech';
+
+my %request_header = (
+ 'MIME-VERSION' => '1.0',
+ 'Content-Transfer-Encoding' => 'text',
+ 'Request-Number' => 1,
+ 'Document-Type' => 'Request',
+ 'Interface-Version' => "$me $VERSION",
+); # Content-Type has to be passed separately
+
+tie my %new_order, 'Tie::IxHash', (
+ OrbitalConnectionUsername => [ ':login', 32 ],
+ OrbitalConnectionPassword => [ ':password', 32 ],
+ IndustryType => [ 'EC', 2 ],
+ MessageType => [ ':message_type', 2 ],
+ BIN => [ ':bin', 6 ],
+ MerchantID => [ ':merchant_id', 12 ],
+ TerminalID => [ ':terminal_id', 3 ],
+ CardBrand => [ '', 2 ],
+ AccountNum => [ ':card_number', 19 ],
+ Exp => [ ':expiration', 4 ],
+ CurrencyCode => [ ':currency_code', 3 ],
+ CurrencyExponent => [ ':currency_exp', 6 ],
+ CardSecValInd => [ ':cvvind', 1 ],
+ CardSecVal => [ ':cvv2', 4 ],
+ AVSzip => [ ':zip', 10 ],
+ AVSaddress1 => [ ':address', 30 ],
+ AVScity => [ ':city', 20 ],
+ AVSstate => [ ':state', 2 ],
+ OrderID => [ ':invoice_number', 22 ],
+ Amount => [ ':amount', 12 ],
+ Comments => [ ':email', 64 ],
+ TxRefNum => [ ':order_number', 40 ],# used only for Refund
+);
+
+tie my %mark_for_capture, 'Tie::IxHash', (
+ OrbitalConnectionUsername => [ ':login', 32 ],
+ OrbitalConnectionPassword => [ ':password', 32 ],
+ OrderID => [ ':invoice_number', 22 ],
+ Amount => [ ':amount', 12 ],
+ BIN => [ ':bin', 6 ],
+ MerchantID => [ ':merchant_id', 12 ],
+ TerminalID => [ ':terminal_id', 3 ],
+ TxRefNum => [ ':order_number', 40 ],
+);
+
+tie my %reversal, 'Tie::IxHash', (
+ OrbitalConnectionUsername => [ ':login', 32 ],
+ OrbitalConnectionPassword => [ ':password', 32 ],
+ TxRefNum => [ ':order_number', 40 ],
+ TxRefIdx => [ '0', 4 ],
+ OrderID => [ ':invoice_number', 22 ],
+ BIN => [ ':bin', 6 ],
+ MerchantID => [ ':merchant_id', 12 ],
+ TerminalID => [ ':terminal_id', 3 ],
+ OnlineReversalInd => [ 'Y', 1 ],
+# Always attempt to reverse authorization.
+);
+
+my %defaults = (
+ terminal_id => '001',
+ currency => 'USD',
+ cvvind => '',
+);
+
+my @required = ( qw(
+ login
+ password
+ action
+ bin
+ merchant_id
+ 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(
+ order_number
+ ));
+
+ #leaking gateway-specific anmes? need to be mapped to B:OP standards :)
+ # ProcStatus
+ # ApprovalStatus
+ # StatusMsg
+ # RespCode
+ # AuthCode
+ # AVSRespCode
+ # CVV2RespCode
+ # 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};
+ my $l;
+ ($v, $l) = @$v if(ref $v eq 'ARRAY');
+ if($v =~ /^:(.*)/) {
+ # Get the content field with that name.
+ $data{$k} = $content{$1};
+ }
+ else {
+ $data{$k} = $v;
+ }
+ # Ruthlessly enforce field length.
+ $data{$k} = substr($data{$k}, 0, $l) if($data{$k} and $l);
+ }
+ 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',
+ 'void' => 'V',
+ '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'}."'";
+
+ foreach (keys(%defaults) ) {
+ $content{$_} = $defaults{$_} if !defined($content{$_});
+ }
+ 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}) {
+ # Choose one arbitrarily
+ $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();
+ my %content = $self->content;
+
+ my @required_fields = @required;
+
+ my $request;
+ if( $content{'message_type'} eq 'MFC' ) {
+ $request = { MarkForCapture => $self->build(\%mark_for_capture) };
+ push @required_fields, 'order_number';
+ }
+ elsif( $content{'message_type'} eq 'V' ) {
+ $request = { Reversal => $self->build(\%reversal) };
+ }
+ else {
+ $request = { NewOrder => $self->build(\%new_order) };
+ push @required_fields, qw(
+ card_number
+ expiration
+ currency
+ address
+ city
+ zip
+ );
+ }
+
+ $self->required_fields(@required_fields);
+
+ 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 = XMLin($page, KeepRoot => 0);
+ #$self->Response($response);
+
+ #use Data::Dumper;
+ #warn Dumper($response) if $DEBUG;
+
+ my ($r) = values(%$response);
+ #foreach(qw(ProcStatus RespCode AuthCode AVSRespCode CVV2RespCode)) {
+ # if(exists($r->{$_}) and
+ # !ref($r->{$_})) {
+ # $self->$_($r->{$_});
+ # }
+ #}
+
+ foreach (keys %$r) {
+
+ #turn empty hashrefs into the empty string
+ $r->{$_} = '' if ref($r->{$_}) && ! keys %{ $r->{$_} };
+
+ #turn hashrefs with content into scalars
+ $r->{$_} = $r->{$_}{'content'}
+ if ref($r->{$_}) && exists($r->{$_}{'content'});
+ }
+
+ if ($server_response !~ /^200/) {
+
+ $self->is_success(0);
+ my $error = "Server error: '$server_response'";
+ $error .= " / Transaction error: '".
+ ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
+ if $r->{'ProcStatus'} != 0;
+ $self->error_message($error);
+
+ } else {
+
+ if ( !exists($r->{'ProcStatus'}) ) {
+
+ $self->is_success(0);
+ $self->error_message( "Malformed response: '$page'" );
+
+ } elsif ( $r->{'ProcStatus'} != 0 or
+ # NewOrders get ApprovalStatus, Reversals don't.
+ ( exists($r->{'ApprovalStatus'}) ?
+ $r->{'ApprovalStatus'} != 1 :
+ $r->{'StatusMsg'} ne 'Approved' )
+ )
+ {
+
+ $self->is_success(0);
+ $self->error_message( "Transaction error: '".
+ ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
+ );
+
+ } else { # success!
+
+ $self->is_success(1);
+ # For credits, AuthCode is empty and gets converted to a hashref.
+ $self->authorization($r->{'AuthCode'}) if !ref($r->{'AuthCode'});
+ $self->order_number($r->{'TxRefNum'});
+ }
+
+ }
+
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Business::OnlinePayment::PaymenTech - Chase Paymentech backend for Business::OnlinePayment
+
+=head1 SYNOPSIS
+
+ $trans = new Business::OnlinePayment('PaymenTech',
+ merchant_id => "000111222333",
+ terminal_id => "001",
+ currency => "USD", # CAD, MXN
+ );
+
+ $trans->content(
+ login => "login",
+ password => "password",
+ 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
+
+Electronic check processing and recurring billing are not yet supported.
+
+=head1 AUTHOR
+
+Mark Wells, mark at freeside.biz
+
+=head1 SEE ALSO
+
+perl(1). L<Business::OnlinePayment>.
+
+=cut
+
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/00-load.t?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/00-load.t (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/00-load.t Sun Apr 18 06:56:48 2010
@@ -1,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" );
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/boilerplate.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/boilerplate.t?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/boilerplate.t (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/boilerplate.t Sun Apr 18 06:56:48 2010
@@ -1,0 +1,49 @@
+#!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]/,
+ );
+}
+
+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');
+
Added: branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/pod.t?rev=56362&op=file
==============================================================================
--- branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/pod.t (added)
+++ branches/upstream/libbusiness-onlinepayment-paymentech-perl/current/t/pod.t Sun Apr 18 06:56:48 2010
@@ -1,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();
More information about the Pkg-perl-cvs-commits
mailing list