summaryrefslogtreecommitdiff
path: root/lib/Business/OnlinePayment/PaySystems.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Business/OnlinePayment/PaySystems.pm')
-rw-r--r--lib/Business/OnlinePayment/PaySystems.pm313
1 files changed, 313 insertions, 0 deletions
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 <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__
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 17:09:17 +0000