File Coverage

blib/lib/Business/OnlinePayment/CardFortress.pm
Criterion Covered Total %
statement 18 47 38.3
branch 0 18 0.0
condition 0 3 0.0
subroutine 6 9 66.6
pod 1 2 50.0
total 25 79 31.6


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