File Coverage

blib/lib/Business/OnlinePayment/Mock.pm
Criterion Covered Total %
statement 21 45 46.6
branch 1 14 7.1
condition n/a
subroutine 8 10 80.0
pod 4 4 100.0
total 34 73 46.5


line stmt bran cond sub pod time code
1             package Business::OnlinePayment::Mock;
2 4     4   18943 use strict;
  4         12  
  4         130  
3 4     4   24 use warnings;
  4         10  
  4         120  
4              
5              
6              
7 4     4   626 use Business::OnlinePayment;
  4         3755  
  4         104  
8 4     4   2091 use Business::OnlinePayment::HTTPS;
  4         97700  
  4         183  
9 4     4   2056 use parent qw(Business::OnlinePayment::HTTPS);
  4         1432  
  4         33  
10             our $me = 'Business::OnlinePayment::Mock';
11              
12             our $VERSION = '0.006'; # VERSION
13             # PODNAME: Business::OnlinePayment::Mock
14             # ABSTRACT: A backend for mocking fake results for test cards
15              
16             our $mock_responses;
17              
18             our $default_mock = {
19             error_message => 'Declined',
20             is_success => 0,
21             error_code => 100,
22             order_number => sub { time },
23             };
24              
25             sub _info {
26             return {
27 3     3   41 info_compat => '0.01',
28             gateway_name => 'Mock',
29             gateway_url => 'http://www.example.com',
30             module_version => $VERSION,
31             supported_types => ['CC'],
32             supported_actions => {
33             CC => [
34              
35             # 'Tokenize', # TODO
36             'Normal Authorization',
37             'Post Authorization',
38             'Authorization Only',
39             'Credit',
40             'Void',
41             'Auth Reversal',
42             ],
43             },
44             };
45             }
46              
47              
48             sub set_default_mock {
49 1     1 1 12331 my ($self, $default) = @_;
50              
51 1         7 $default_mock = $default;
52             }
53              
54              
55             sub set_mock_response {
56 2     2 1 3844 my ($self, $response, $set_as_default) = @_;
57              
58 2         10 $mock_responses->{ delete $response->{'action'} }->{ delete $response->{'card_number'} } = $response;
59              
60 2 50       10 $self->set_as_default($response) if $set_as_default;
61             }
62              
63              
64             sub test_transaction {
65 0     0 1   my $self = shift;
66              
67 0           $self->{'test_transaction'} = 1;
68 0           $self->server('example.com');
69 0           $self->port(443);
70 0           $self->path('/example.html');
71              
72 0           return $self->{'test_transaction'};
73             }
74              
75              
76             sub submit {
77 0     0 1   my $self = shift;
78 0           my %content = $self->content();
79 0 0         die 'Missing action' unless $content{'action'};
80              
81 0           my $action;
82 0           foreach my $a (@{ $self->_info()->{'supported_actions'}->{'CC'} }) {
  0            
83 0 0         if (lc $a eq lc $content{'action'}) {
84 0           $action = $a;
85 0           last;
86             }
87             }
88 0 0         die 'Unsupported action' unless $action;
89              
90 0 0         my $result = { %{ $mock_responses->{$action}->{ $content{'card_number'} } || $default_mock } }; # cheap clone
  0            
91              
92 0           foreach my $k (keys %{$result}) {
  0            
93 0           my $val = $result->{$k};
94 0 0         $result->{$k} = ref $val eq 'CODE' ? $val->(\%content) : $val;
95 0 0         $self->$k($result->{$k}) if $self->can($k);
96             }
97              
98 0           return $result;
99             }
100              
101             1;
102              
103             __END__