lib/Business/OnlinePayment/PaySystems.pm

   1 package Business::OnlinePayment::PaySystems;
   2
   3 #use 5.008;
   4 use strict;
   5 #use warnings;
   6 use vars qw(%EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION);
   7 use Carp;
   8 use Business::OnlinePayment;
   9 use Business::CreditCard;
  10 use Net::SSLeay;
  11
  12 require Exporter;
  13
  14 our @ISA = qw(Exporter AutoLoader Business::OnlinePayment);
  15
  16 # Items to export into callers namespace by default. Note: do not export
  17 # names by default without a very good reason. Use EXPORT_OK instead.
  18 # Do not simply export all your public functions/methods/constants.
  19
  20 # This allows declaration       use Business::OnlinePayment::PaySystems ':all';
  21 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
  22 # will save memory.
  23 %EXPORT_TAGS = ( 'all' => [ qw(
  24
  25 ) ] );
  26
  27 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  28
  29 @EXPORT = qw(
  30
  31 );
  32
  33 $VERSION = '0.02';
  34
  35 # Preloaded methods go here.
  36
  37 sub set_defaults {
  38     my $self = shift;
  39     $self->server('psc.paysystems.com');
  40     $self->port('443');
  41     $self->path('/psRedirector/psclient');
  42     $self->build_subs(qw(cert order_number));
  43     my $cert;
  44     $cert = Business::OnlinePayment::PaySystems::certconst();
  45     $self->cert($cert);
  46
  47 }
  48
  49 sub map_fields {
  50     my $self = shift;
  51     my %content = $self->content();
  52     my %actions = ('normal authorization' => 'S',
  53                    'authorization only' => 'A',
  54                    'credit' => 'R',
  55                    'post authorization' => 'C',
  56                    'void' => 'R',
  57     );
  58     $content{'action'} = $actions{lc($content{'action'})};
  59     my %types = ('visa card' => 'V',
  60                  'mastercard' => 'E',
  61                  'american express card' => 'A',
  62                  'diner\'s club/carte blanche' => 'D',
  63     );
  64     $content{'type'} = cardtype($content{'card_number'})
  65       if lc($content{'type'}) eq 'cc';
  66     $content{'type'} = $types{lc($content{'type'})};
  67     $self->transaction_type($content{'type'});
  68     $content{'expiration'} =~ /(\d\d)\D*(\d\d)/ if $content{'expiration'};
  69     $content{'expiration_month'} or
  70         $content{'expiration_month'} = $1;
  71     $content{'expiration_year'} or
  72         $content{'expiration_year'} = $2;
  73     $content{'expiration'} =
  74         $content{'expiration_month'}.'/'.$content{'expiration_year'} if
  75         $content{'expiration_month'} and $content{'expiration_year'};
  76     $content{'card_corporate'} = '0';
  77     $content{'card_name'} = $content{'name'} if
  78         ($content{'name'} and !$content{'card_name'});
  79     $content{'card_name'} =
  80         $content{'first_name'}.' '.$content{'last_name'} if
  81         (($content{'first_name'} and $content{'last_name'}) and
  82         !$content{'card_name'});
  83     $content{'customer_id'} or $content{'customer_id'} = int(rand(10000));
  84     $content{'order_id'} or $content{'order_id'} = $content{'invoice_number'} if        $content{'invoice_number'};
  85     $content{'order_id'} or $content{'order_id'} = $content{'customer_id'};
  86     $content{'street'} or $content{'street'} = $content{'address'};
  87     $content{'psclient_type'} = 'cc';
  88     $content{'house_number'} = '0';
  89     $content{'po_box'} = '0';
  90     $content{'co_field'} = 'na';
  91     $content{'district'} = 'na';
  92     $content{'currency'} or $content{'currency'} = 'USD';
  93     my @localtime = localtime();
  94     $content{'date'} =
  95         1900 + $localtime[5] .'-'.$localtime[4].'-'.$localtime[3];
  96     $content{'order_date'} = $content{'date'} unless $content{'order_date'};
  97     $content{'invoice_date'} = $content{'date'} unless $content{'invoice_date'};
  98     $content{'due_date'} = $content{'date'} unless $content{'due_date'};
  99     $content{'ttext'} = 'wtfits';
 100     $self->content(%content);
 101 }
 102
 103 sub remap_fields {
 104     my($self,%map) = @_;
 105
 106     my %content = $self->content();
 107     foreach(keys %map) {
 108         $content{$map{$_}} = $content{$_};
 109     }
 110     $self->content(%content);
 111 }
 112
 113 sub get_fields {
 114     my($self,@fields) = @_;
 115
 116     my %content = $self->content();
 117     my %new = ();
 118     foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; }
 119     foreach (@fields) {
 120         $new{$_} = '' unless defined $new{$_};
 121     }
 122     return %new;
 123 }
 124
 125 sub submit {
 126     my $self = shift;
 127     my %content = $self->content();
 128     $self->map_fields;
 129     $self->remap_fields(
 130         type => 'card_type',
 131         action => 'ttype',
 132         login => 'cid',
 133         password => 'passwd',
 134         expiration => 'card_exp',
 135         cvv2 => 'card_cvv2',
 136         zip => 'zip_code',
 137         country => 'country_code',
 138         order_number => 'tid',
 139     );
 140     my %post_data;
 141     if ($content{action} =~ /normal authorization/i or
 142         $content{action} =~ /authorization only/i) {
 143         %post_data = $self->get_fields(qw(
 144         order_id amount currency ttype card_number card_cvv2 card_exp
 145         card_corporate card_name card_type first_name last_name phone email
 146         customer_id street house_number country_code po_box co_field zip_code
 147         district city state cid passwd psclient_type
 148         ));
 149     }
 150     elsif ($content{action} =~ /post authorization/i or
 151         $content{action} =~ /credit/i or
 152         $content{action} =~ /void/i) {
 153         %post_data = $self->get_fields(qw(
 154         order_id amount currency ttype tid order_date invoice_date due_date
 155         ttext cid passwd psclient_type
 156         ));
 157     }
 158     else {
 159         croak "Bad Action >$content{action}< - That action is not supported";
 160     }
 161
 162     my $post_data = Net::SSLeay::make_form(%post_data);
 163     $post_data =~ s/\+/%20/g;
 164
 165     my $path = $self->path;
 166     $path .= "?";
 167     $path .= $post_data;
 168 #print STDERR "\n\n$path\n\n";
 169
 170     #post the data
 171     #do a bunch of stuff with the response
 172     my ($page,
 173         $response,
 174         $headers,
 175         $cert,
 176         ) = Net::SSLeay::get_https3($self->server,
 177                                          $self->port,
 178                                          $path,
 179                                          );
 180     my $x509 = Net::SSLeay::PEM_get_string_X509($cert);
 181     $self->server_response($page);
 182     $self->is_success(0) unless $self->cert eq $x509;
 183     $self->error_message('Bad Certificate') unless $self->cert eq $x509;
 184     if ($page) {
 185         $self->error_message("Response returned: >$page<");
 186         chomp $page;
 187         my ($code, $tid) = split /:/, $page, 2;
 188         if ($code == 200) {
 189             $self->authorization($tid);
 190             $self->order_number($tid);
 191             $self->is_success(1);
 192         }
 193         else {
 194             $self->is_success(0);
 195         }
 196     }
 197     else {
 198         $self->is_success(0);
 199         $self->error_message("No data returned: $response");
 200     }
 201 }
 202
 203 =head1 NAME
 204
 205 Business::OnlinePayment::PaySystems - Perl extension for doing creditcard
 206 transactions through PaySystems
 207
 208 =head1 SYNOPSIS
 209
 210   use Business::OnlinePayment::PaySystems;
 211   my $tx = new Business::OnlinePayment('PaySystems');
 212   $tx->content(
 213                         type       => 'Visa',
 214                         amount     => '19.00',
 215                         card_number => '4200000000000000',
 216                         cvv2       => '123',
 217                         expiration => '0105',
 218                         first_name => 'John',
 219                         last_name  => 'Public',
 220                         action     => 'authorization only',
 221                         login      => '12345',
 222                         password   => '65432',
 223                         address    => '123 foo street',
 224                         city       => 'fooville',
 225                         state      => 'California',
 226                         zip        => '90210',
 227                         country    => 'US',
 228                         email      => 'foo@bar.com',
 229                         phone      => '1123342234',
 230     );
 231     $tx->submit;
 232     if ($tx->is_success()) {
 233         my $ordernum = $tx->order_number;
 234         print "Pre-auth of funds was successfull";
 235     }
 236     else {
 237         print $tx->error_message;
 238     }
 239
 240     my $tx2 = new Business::OnlinePayment('PaySystems');
 241     $tx2->content(
 242                         amount     => '19.00',
 243                         action     => 'post authorization',
 244                         login      => '12345',
 245                         password   => '65432',
 246                         order_number => $ordernum,
 247     );
 248     $tx2->submit;
 249     if ($tx2->is_success()) {
 250         print "Capture of funds was successful";
 251     }
 252     else {
 253         print $tx2->error_message;
 254     }
 255
 256 =head1 ABSTRACT
 257
 258     This is a Business::OnlinePayment module for PaySystems loosely based on
 259     Business::OnlinePayment::AuthorizeNet.  I should allow capture, preauth,
 260     postauth capture, credit, and voids (last two are both refunds).
 261
 262 =head1 DESCRIPTION
 263     See Synopsis, all fields are required.  When doing a postauth, credit or
 264     void card number is not required, but the order_number of the preauth
 265     transaction is.  This can be retrieved using the order_number method.
 266     The authorization method can be used to retrieve the bank authorization
 267     code if it is important to know this.  Supports Visa, MasterCard,
 268     American Express, and Diners card.
 269
 270 =head1 SEE ALSO
 271
 272     Business::OnlinePayment
 273
 274 =head1 AUTHOR
 275     Simply Marketing Inc.
 276     Support@SimplyMarketingInc.com
 277
 278     Current maintainer is Ivan Kohler <ivan-business-creditcard@420.am>.
 279     Please don't bother Simply Marketing with emails about this module.
 280
 281 =head1 COPYRIGHT AND LICENSE
 282
 283 Copyright 2003 by SimplyMarketingInc.com
 284 Copyright 2004 Ivan Kohler.  All rights reserved.
 285
 286 This program is free software; you can redistribute it and/or modify it
 287 under the same terms as Perl itself.
 288
 289 =cut
 290
 291 sub certconst {
 292     my $cert = <<EOM;
 293 -----BEGIN CERTIFICATE-----
 294 MIICDTCCAXYCAQAwDQYJKoZIhvcNAQEEBQAwTzELMAkGA1UEBhMCQ0ExCzAJBgNV
 295 BAgTAlFDMREwDwYDVQQHEwhNb250cmVhbDETMBEGA1UEChMKUGF5U3lzdGVtczEL
 296 MAkGA1UECxMCSVQwHhcNMDMwNjExMTc1MzI4WhcNMDQwNjEwMTc1MzI4WjBPMQsw
 297 CQYDVQQGEwJDQTELMAkGA1UECBMCUUMxETAPBgNVBAcTCE1vbnRyZWFsMRMwEQYD
 298 VQQKEwpQYXlTeXN0ZW1zMQswCQYDVQQLEwJJVDCBnzANBgkqhkiG9w0BAQEFAAOB
 299 jQAwgYkCgYEAyLXrbISLMwBe9exRYKEDTYn1ZoOqUeFQx5nERfKFeMJATJFFi024
 300 4ZIaONLprlmKVulGTFu43Bgid/QGr/acUQKnZQCeq8UurBwdRcHVXwy+4EFWkolY
 301 ervkMCvT988r9d1PGQ5MQBzz1xSTc7kp/PO5NhE5M4KxUXsFXqxtHAMCAwEAATAN
 302 BgkqhkiG9w0BAQQFAAOBgQBFq4CfU5pMH8g509DeLziQ/0/b35KhctRWAKvDOaUR
 303 cI/9379P1k7GMwpL5goIboD6I4iztX0R5GCptqocGCW6K6GEv27XpX5HRKlfyeGK
 304 vTANogH0GLvJKs2D436pWddmjympvXnCPWR5I0ooIYBEXpSw4akTCgAAhbCqavd5
 305 gQ==
 306 -----END CERTIFICATE-----
 307 EOM
 308     chomp $cert;
 309     return $cert;
 310 }
 311
 312 1;
 313 __END__