initial import master Business_OnlinePayment_PaySystems_0_02_01
authorivan <ivan>
Thu, 13 Oct 2005 06:06:24 +0000 (06:06 +0000)
committerivan <ivan>
Thu, 13 Oct 2005 06:06:24 +0000 (06:06 +0000)
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
getpaysystemscert.pl [new file with mode: 0755]
lib/Business/OnlinePayment/PaySystems.pm [new file with mode: 0644]
t/Business-OnlinePayment-PaySystems.t [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
index 0000000..2684e69
--- /dev/null
@@ -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 <Support@simplymarketinginc.com>') : ()),
+);
diff --git a/README b/README
new file mode 100644 (file)
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 (executable)
index 0000000..834aa65
--- /dev/null
@@ -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 (file)
index 0000000..df118a2
--- /dev/null
@@ -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 <ivan-business-creditcard@420.am>.
+    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 = <<EOM;
+-----BEGIN CERTIFICATE-----
+MIICDTCCAXYCAQAwDQYJKoZIhvcNAQEEBQAwTzELMAkGA1UEBhMCQ0ExCzAJBgNV
+BAgTAlFDMREwDwYDVQQHEwhNb250cmVhbDETMBEGA1UEChMKUGF5U3lzdGVtczEL
+MAkGA1UECxMCSVQwHhcNMDMwNjExMTc1MzI4WhcNMDQwNjEwMTc1MzI4WjBPMQsw
+CQYDVQQGEwJDQTELMAkGA1UECBMCUUMxETAPBgNVBAcTCE1vbnRyZWFsMRMwEQYD
+VQQKEwpQYXlTeXN0ZW1zMQswCQYDVQQLEwJJVDCBnzANBgkqhkiG9w0BAQEFAAOB
+jQAwgYkCgYEAyLXrbISLMwBe9exRYKEDTYn1ZoOqUeFQx5nERfKFeMJATJFFi024
+4ZIaONLprlmKVulGTFu43Bgid/QGr/acUQKnZQCeq8UurBwdRcHVXwy+4EFWkolY
+ervkMCvT988r9d1PGQ5MQBzz1xSTc7kp/PO5NhE5M4KxUXsFXqxtHAMCAwEAATAN
+BgkqhkiG9w0BAQQFAAOBgQBFq4CfU5pMH8g509DeLziQ/0/b35KhctRWAKvDOaUR
+cI/9379P1k7GMwpL5goIboD6I4iztX0R5GCptqocGCW6K6GEv27XpX5HRKlfyeGK
+vTANogH0GLvJKs2D436pWddmjympvXnCPWR5I0ooIYBEXpSw4akTCgAAhbCqavd5
+gQ==
+-----END CERTIFICATE-----
+EOM
+    chomp $cert;
+    return $cert;
+}
+
+1;
+__END__
diff --git a/t/Business-OnlinePayment-PaySystems.t b/t/Business-OnlinePayment-PaySystems.t
new file mode 100644 (file)
index 0000000..ea466a4
--- /dev/null
@@ -0,0 +1,131 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Business-OnlinePayment-PaySystems.t'
+
+#########################
+
+# change 'tests => 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");
+