From e78d021db559459eb8db8474d08838817797baae Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 13 Oct 2005 06:06:24 +0000 Subject: [PATCH 1/1] initial import --- Changes | 6 + MANIFEST | 8 + META.yml | 15 ++ Makefile.PL | 17 ++ README | 29 +++ getpaysystemscert.pl | 49 +++++ lib/Business/OnlinePayment/PaySystems.pm | 313 +++++++++++++++++++++++++++++++ t/Business-OnlinePayment-PaySystems.t | 131 +++++++++++++ 8 files changed, 568 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100755 getpaysystemscert.pl create mode 100644 lib/Business/OnlinePayment/PaySystems.pm create mode 100644 t/Business-OnlinePayment-PaySystems.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..0c3a17a --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Business::OnlinePayment::PaySystems. + +0.01 Sun Dec 7 13:30:16 2003 + - original version; created by h2xs 1.23 with options + -AX -b 5.8.0 -n Business::OnlinePayment::PaySystems + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..6d684df --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Changes +Makefile.PL +MANIFEST +README +getpaysystemscert.pl +t/Business-OnlinePayment-PaySystems.t +lib/Business/OnlinePayment/PaySystems.pm +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..fa581e8 --- /dev/null +++ b/META.yml @@ -0,0 +1,15 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: Business-OnlinePayment-PaySystems +version: 0.01 +version_from: lib/Business/OnlinePayment/PaySystems.pm +installdirs: site +requires: + Business::OnlinePayment: 2.0 + Net::SSLeay: 1.25 + Term::ReadLine: 0 + Term::ReadLine::Gnu: 0 + Test::More: 0 + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..2684e69 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,17 @@ +use 5.008; +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::PaySystems', + VERSION_FROM => 'lib/Business/OnlinePayment/PaySystems.pm', # finds $VERSION + PREREQ_PM => {Business::OnlinePayment => '2.0', + Business::CreditCard => 0, + Net::SSLeay => '1.25', + Term::ReadLine => 0, + Term::ReadLine::Gnu => 0, + Test::More => 0,}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/Business/OnlinePayment/PaySystems.pm', # retrieve abstract from module + AUTHOR => 'Support ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..9508733 --- /dev/null +++ b/README @@ -0,0 +1,29 @@ +Business/OnlinePayment/PaySystems version 0.01 +============================================== + +Module for doing creditcard transactions with PaySystems + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +Net::SSLeay +Business::OnlinePayment +Test::More + +COPYRIGHT AND LICENCE + +Put the correct copyright and licence information here. + +Copyright (C) 2003 SimplyMarketingInc.com + + diff --git a/getpaysystemscert.pl b/getpaysystemscert.pl new file mode 100755 index 0000000..834aa65 --- /dev/null +++ b/getpaysystemscert.pl @@ -0,0 +1,49 @@ +#!/usr/local/bin/perl + +#this is a hacked up version of one of the examples in the Net::SSLeay +#documentation, It will return a x509 cert and contents sufficient for +#use in Business::OnlinePayment::FnsVanuatu just use +# perl ./getfnscert.pl >> FnsVanuatu.pm to append the new data +# you'll have to edit things to make it go in the certconst subroutine + use Socket; + use Net::SSLeay qw(die_now die_if_ssl_error) ; + Net::SSLeay::load_error_strings(); + Net::SSLeay::SSLeay_add_ssl_algorithms(); + Net::SSLeay::randomize(); + + ($dest_serv, $port, $msg) = ('psc.paysystems.com', '443', 'GET /'); + $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/; + $dest_ip = gethostbyname ($dest_serv); + $dest_serv_params = sockaddr_in($port, $dest_ip); + + socket (S, &AF_INET, &SOCK_STREAM, 0) or die "socket: $!"; + connect (S, $dest_serv_params) or die "connect: $!"; + select (S); $| = 1; select (STDOUT); # Eliminate STDIO buffering + + # The network connection is now open, lets fire up SSL + + $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!"); + Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL) + and die_if_ssl_error("ssl ctx set options"); + $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!"); + Net::SSLeay::set_fd($ssl, fileno(S)); # Must use fileno + $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect"); +# print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n"; + print Net::SSLeay::dump_peer_certificate($ssl),"\n"; + my $cert = Net::SSLeay::get_peer_certificate($ssl); + print Net::SSLeay::PEM_get_string_X509($cert),"\n"; +# print Net::SSLeay::get_verify_result($ssl),"\n"; + # Exchange data + + $res = Net::SSLeay::write($ssl, $msg); # Perl knows how long $msg is + die_if_ssl_error("ssl write"); + shutdown S, 1; # Half close --> No more output, sends EOF to server + $got = Net::SSLeay::read($ssl); # Perl returns undef on failure + die_if_ssl_error("ssl read"); +# print $got; + + Net::SSLeay::free ($ssl); # Tear down connection + Net::SSLeay::CTX_free ($ctx); + close S; + + diff --git a/lib/Business/OnlinePayment/PaySystems.pm b/lib/Business/OnlinePayment/PaySystems.pm new file mode 100644 index 0000000..df118a2 --- /dev/null +++ b/lib/Business/OnlinePayment/PaySystems.pm @@ -0,0 +1,313 @@ +package Business::OnlinePayment::PaySystems; + +#use 5.008; +use strict; +#use warnings; +use vars qw(%EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION); +use Carp; +use Business::OnlinePayment; +use Business::CreditCard; +use Net::SSLeay; + +require Exporter; + +our @ISA = qw(Exporter AutoLoader Business::OnlinePayment); + +# Items to export into callers namespace by default. Note: do not export +# names by default without a very good reason. Use EXPORT_OK instead. +# Do not simply export all your public functions/methods/constants. + +# This allows declaration use Business::OnlinePayment::PaySystems ':all'; +# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK +# will save memory. +%EXPORT_TAGS = ( 'all' => [ qw( + +) ] ); + +@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +@EXPORT = qw( + +); + +$VERSION = '0.02'; + +# Preloaded methods go here. + +sub set_defaults { + my $self = shift; + $self->server('psc.paysystems.com'); + $self->port('443'); + $self->path('/psRedirector/psclient'); + $self->build_subs(qw(cert order_number)); + my $cert; + $cert = Business::OnlinePayment::PaySystems::certconst(); + $self->cert($cert); + +} + +sub map_fields { + my $self = shift; + my %content = $self->content(); + my %actions = ('normal authorization' => 'S', + 'authorization only' => 'A', + 'credit' => 'R', + 'post authorization' => 'C', + 'void' => 'R', + ); + $content{'action'} = $actions{lc($content{'action'})}; + my %types = ('visa card' => 'V', + 'mastercard' => 'E', + 'american express card' => 'A', + 'diner\'s club/carte blanche' => 'D', + ); + $content{'type'} = cardtype($content{'card_number'}) + if lc($content{'type'}) eq 'cc'; + $content{'type'} = $types{lc($content{'type'})}; + $self->transaction_type($content{'type'}); + $content{'expiration'} =~ /(\d\d)\D*(\d\d)/ if $content{'expiration'}; + $content{'expiration_month'} or + $content{'expiration_month'} = $1; + $content{'expiration_year'} or + $content{'expiration_year'} = $2; + $content{'expiration'} = + $content{'expiration_month'}.'/'.$content{'expiration_year'} if + $content{'expiration_month'} and $content{'expiration_year'}; + $content{'card_corporate'} = '0'; + $content{'card_name'} = $content{'name'} if + ($content{'name'} and !$content{'card_name'}); + $content{'card_name'} = + $content{'first_name'}.' '.$content{'last_name'} if + (($content{'first_name'} and $content{'last_name'}) and + !$content{'card_name'}); + $content{'customer_id'} or $content{'customer_id'} = int(rand(10000)); + $content{'order_id'} or $content{'order_id'} = $content{'invoice_number'} if $content{'invoice_number'}; + $content{'order_id'} or $content{'order_id'} = $content{'customer_id'}; + $content{'street'} or $content{'street'} = $content{'address'}; + $content{'psclient_type'} = 'cc'; + $content{'house_number'} = '0'; + $content{'po_box'} = '0'; + $content{'co_field'} = 'na'; + $content{'district'} = 'na'; + $content{'currency'} or $content{'currency'} = 'USD'; + my @localtime = localtime(); + $content{'date'} = + 1900 + $localtime[5] .'-'.$localtime[4].'-'.$localtime[3]; + $content{'order_date'} = $content{'date'} unless $content{'order_date'}; + $content{'invoice_date'} = $content{'date'} unless $content{'invoice_date'}; + $content{'due_date'} = $content{'date'} unless $content{'due_date'}; + $content{'ttext'} = 'wtfits'; + $self->content(%content); +} + +sub remap_fields { + my($self,%map) = @_; + + my %content = $self->content(); + foreach(keys %map) { + $content{$map{$_}} = $content{$_}; + } + $self->content(%content); +} + +sub get_fields { + my($self,@fields) = @_; + + my %content = $self->content(); + my %new = (); + foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; } + foreach (@fields) { + $new{$_} = '' unless defined $new{$_}; + } + return %new; +} + +sub submit { + my $self = shift; + my %content = $self->content(); + $self->map_fields; + $self->remap_fields( + type => 'card_type', + action => 'ttype', + login => 'cid', + password => 'passwd', + expiration => 'card_exp', + cvv2 => 'card_cvv2', + zip => 'zip_code', + country => 'country_code', + order_number => 'tid', + ); + my %post_data; + if ($content{action} =~ /normal authorization/i or + $content{action} =~ /authorization only/i) { + %post_data = $self->get_fields(qw( + order_id amount currency ttype card_number card_cvv2 card_exp + card_corporate card_name card_type first_name last_name phone email + customer_id street house_number country_code po_box co_field zip_code + district city state cid passwd psclient_type + )); + } + elsif ($content{action} =~ /post authorization/i or + $content{action} =~ /credit/i or + $content{action} =~ /void/i) { + %post_data = $self->get_fields(qw( + order_id amount currency ttype tid order_date invoice_date due_date + ttext cid passwd psclient_type + )); + } + else { + croak "Bad Action >$content{action}< - That action is not supported"; + } + + my $post_data = Net::SSLeay::make_form(%post_data); + $post_data =~ s/\+/%20/g; + + my $path = $self->path; + $path .= "?"; + $path .= $post_data; +#print STDERR "\n\n$path\n\n"; + + #post the data + #do a bunch of stuff with the response + my ($page, + $response, + $headers, + $cert, + ) = Net::SSLeay::get_https3($self->server, + $self->port, + $path, + ); + my $x509 = Net::SSLeay::PEM_get_string_X509($cert); + $self->server_response($page); + $self->is_success(0) unless $self->cert eq $x509; + $self->error_message('Bad Certificate') unless $self->cert eq $x509; + if ($page) { + $self->error_message("Response returned: >$page<"); + chomp $page; + my ($code, $tid) = split /:/, $page, 2; + if ($code == 200) { + $self->authorization($tid); + $self->order_number($tid); + $self->is_success(1); + } + else { + $self->is_success(0); + } + } + else { + $self->is_success(0); + $self->error_message("No data returned: $response"); + } +} + +=head1 NAME + +Business::OnlinePayment::PaySystems - Perl extension for doing creditcard +transactions through PaySystems + +=head1 SYNOPSIS + + use Business::OnlinePayment::PaySystems; + my $tx = new Business::OnlinePayment('PaySystems'); + $tx->content( + type => 'Visa', + amount => '19.00', + card_number => '4200000000000000', + cvv2 => '123', + expiration => '0105', + first_name => 'John', + last_name => 'Public', + action => 'authorization only', + login => '12345', + password => '65432', + address => '123 foo street', + city => 'fooville', + state => 'California', + zip => '90210', + country => 'US', + email => 'foo@bar.com', + phone => '1123342234', + ); + $tx->submit; + if ($tx->is_success()) { + my $ordernum = $tx->order_number; + print "Pre-auth of funds was successfull"; + } + else { + print $tx->error_message; + } + + my $tx2 = new Business::OnlinePayment('PaySystems'); + $tx2->content( + amount => '19.00', + action => 'post authorization', + login => '12345', + password => '65432', + order_number => $ordernum, + ); + $tx2->submit; + if ($tx2->is_success()) { + print "Capture of funds was successful"; + } + else { + print $tx2->error_message; + } + +=head1 ABSTRACT + + This is a Business::OnlinePayment module for PaySystems loosely based on + Business::OnlinePayment::AuthorizeNet. I should allow capture, preauth, + postauth capture, credit, and voids (last two are both refunds). + +=head1 DESCRIPTION + See Synopsis, all fields are required. When doing a postauth, credit or + void card number is not required, but the order_number of the preauth + transaction is. This can be retrieved using the order_number method. + The authorization method can be used to retrieve the bank authorization + code if it is important to know this. Supports Visa, MasterCard, + American Express, and Diners card. + +=head1 SEE ALSO + + Business::OnlinePayment + +=head1 AUTHOR + Simply Marketing Inc. + Support@SimplyMarketingInc.com + + Current maintainer is Ivan Kohler . + Please don't bother Simply Marketing with emails about this module. + +=head1 COPYRIGHT AND LICENSE + +Copyright 2003 by SimplyMarketingInc.com +Copyright 2004 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. + +=cut + +sub certconst { + my $cert = < 1' to 'tests => last_test_to_print'; + +use Test::More tests => 22; +use Term::ReadLine; + +BEGIN { use_ok('Business::OnlinePayment::PaySystems') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + + +my $term = new Term::ReadLine 'foo'; +diag("Please enter a test account for PaySystems"); +my $prompt = "login: "; +my $login = $term->readline($prompt); +diag("Please enter the password for the test account $login"); +$prompt = "password: "; +my $pass = $term->readline($prompt); +diag("Please enter a valid creditcard to test against "); +diag("It will be charged 2 dollars "); +$prompt = "card number: "; +my $cc = $term->readline($prompt); +diag("Please enter an expiry in the form MMYY"); +$prompt = "MMYY: "; +my $exp = $term->readline($prompt); +diag("Please enter a cvv2"); +$prompt = "cvv2: "; +my $cvv2 = $term->readline($prompt); + + +diag("\n\nTrying Normal Authorization\n\n"); + +my $transaction; +ok($transaction = new Business::OnlinePayment('PaySystems'), 'new PaySystems'); +ok($transaction->content( + type => 'Visa', + amount => '1.00', + card_number => $cc, + cvv2 => $cvv2, + expiration => $exp, + first_name => 'John', + last_name => 'Public', + action => 'NORMAL authorization', + login => $login, + password => $pass, + address => '123 foo street', + city => 'fooville', + state => 'California', + zip => '90210', + country => 'US', + email => 'foo@bar.com', + customer_ip => '123.123.123.123', + phone => '1123342234', + ), + 'content'); +ok($transaction->submit(), 'submit'); + +ok($transaction->is_success(), 'is success'); + +my $authcode; +ok($authcode = $transaction->authorization(), "authorization $authcode"); +my $err; +ok($err = $transaction->error_message(), "error $err"); +my $on; +ok($on = $transaction->order_number(), "order number $on"); + +diag("\n\norder number: $on auth: $authcode Error: $err\n\n"); + + +diag("\n\nTrying Authorization Only\n\n"); +ok($tx = new Business::OnlinePayment('PaySystems'), 'new PaySystems 2'); +ok($tx ->content( + type => 'Visa', + amount => '1.00', + card_number => $cc, + cvv2 => $cvv2, + expiration => $exp, + first_name => 'John', + last_name => 'Public', + action => 'authorization only', + login => $login, + password => $pass, + address => '123 foo street', + city => 'fooville', + state => 'California', + zip => '90210', + country => 'US', + email => 'foo@bar.com', + customer_ip => '123.123.123.123', + phone => '1123342234', + + ), + 'new content'); + +ok($tx->submit(), 'submit'); +$authcode = $err = $on = ''; +ok($tx->is_success(), 'is success'); +ok($authcode = $tx->authorization(), "authorization $authcode"); +ok($err = $tx->error_message(), "error $err"); +ok($on = $tx->order_number(), "order number $on"); +my $ordernum = $on; + +diag("\n\norder_number: $on auth: $authcode err: $err\n\n"); + + +diag("\n\nTrying Post Authorization\n\n"); +ok($tx2 = new Business::OnlinePayment('PaySystems'), 'new PaySystems 3'); +ok($tx2->content( + amount => '1.00', + action => 'post authorization', + login => $login, + password => $pass, + order_number => $ordernum, + ), + 'new content'); +ok($tx2->submit, 'submit'); +$authcode = $err = $on = ''; +ok($tx2->is_success(), 'is success'); +ok($authcode = $tx2->authorization(), "authorization $authcode"); +ok($err = $tx2->error_message(), "error $err"); +ok($on = $tx2->order_number(), "order number $on"); + +diag("\n\norder_number: $on auth: $authcode err: $err\n\n"); + -- 2.11.0