File Coverage

blib/lib/Business/OnlinePayment/CardFortress.pm
Criterion Covered Total %
statement 24 48 50.0
branch 3 18 16.6
condition 0 3 0.0
subroutine 7 9 77.7
pod 1 2 50.0
total 35 80 43.7


line stmt bran cond sub pod time code
1             package Business::OnlinePayment::CardFortress;
2              
3 2     2   13297 use base qw( Business::OnlinePayment::HTTPS );
  2         4  
  2         831  
4              
5 2     2   35401 use warnings;
  2         3  
  2         45  
6 2     2   7 use strict;
  2         5  
  2         29  
7             #use vars qw( $DEBUG $me );
8 2     2   471 use File::Slurp;
  2         7445  
  2         107  
9 2     2   796 use MIME::Base64;
  2         886  
  2         92  
10 2     2   788 use Crypt::OpenSSL::RSA;
  2         5949  
  2         858  
11              
12             our $VERSION = 0.03;
13              
14             sub _info {
15             {
16 0     0   0 'info_compat' => '0.01',
17             'module_version' => $VERSION,
18             'supported_types' => [ 'CC' ],
19             'supported_actions' => { 'CC' => [
20             'Normal Authorization',
21             'Authorization Only',
22             'Post Authorization',
23             'Void',
24             'Credit',
25             'Tokenize',
26             ],
27             },
28             'token_support' => 1,
29             #need to figure out how to pass through for gateways that do... an option?
30             #'CC_void_requires_card' => 1,
31             };
32             }
33              
34             sub set_defaults {
35 2     2 0 1711 my $self = shift;
36 2         8 my %opts = @_;
37            
38 2 50       40 $self->server('gw.cardfortress.com') unless $self->server;
39              
40 2 50       84 $self->port('443') unless $self->port;
41 2 50       74 $self->path('/bop/index.html') unless $self->path;
42              
43 2         54 $self->build_subs(qw( order_number avs_code cvv2_response
44             response_page response_code response_headers
45             card_token private_key txn_date
46             ));
47             }
48              
49             sub submit {
50 0     0 1   my $self = shift;
51              
52 0 0         $self->server('test.cardfortress.com') if $self->test_transaction;
53              
54 0           my %content = $self->content;
55 0           $content{$_} = $self->$_() for qw( gateway gateway_login gateway_password );
56              
57 0           $content{$_} = $self->$_() for grep $self->can($_), qw( bop_options );
58              
59 0           my ($page,$server_response,%headers) = $self->https_post(%content);
60              
61 0 0         die "$server_response\n" unless $server_response =~ /^200/;
62              
63 0           my %response = ();
64             #this encoding good enough? wfm... if something's easier for other
65             #languages they can always use a different URL
66 0           foreach my $line ( grep /^\w+=/, split(/\n/, $page) ) {
67 0 0         $line =~ /^(\w+)=(.*)$/ or next;
68 0           $response{$1} = $2;
69             }
70              
71 0           foreach (qw( is_success error_message failure_status
72             authorization order_number
73             fraud_score fraud_transaction_id
74             result_code avs_code cvv2_response
75             card_token
76             txn_date
77             )) {
78 0           $self->$_($response{$_});
79             }
80              
81             #map these to gateway_response_code, etc?
82             # response_code()
83             # response_headers()
84             # response_page()
85              
86             #handle the challenge/response handshake
87 0 0         if ( $self->error_message eq '_challenge' ) { #XXX infinite loop protection?
88              
89 0 0         my $private_key = $self->private_key
90             or die "no private key available";
91              
92 0 0 0       $private_key = read_file($private_key)
93             if $private_key !~ /-----BEGIN/ && -r $private_key;
94              
95             #decrypt the challenge with the private key
96 0           my $challenge = decode_base64($response{'card_challenge'});
97              
98             #here is the hardest part to implement at each client side
99 0           my $rsa_priv = Crypt::OpenSSL::RSA->new_private_key($private_key);
100 0           my $response = $rsa_priv->decrypt($challenge);
101              
102             #try the transaction again with the challenge response
103             # (B:OP could sure use a better way to alter one value)
104 0           my %content = $self->content;
105 0           $content{'card_response'} = encode_base64($response, '');
106 0           $self->content(%content);
107 0           $self->submit;
108             }
109              
110             }
111              
112             1;
113              
114             __END__