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   13809 use strict;
  4         10  
  4         104  
3 4     4   18 use warnings;
  4         7  
  4         99  
4              
5              
6              
7 4     4   561 use Business::OnlinePayment;
  4         3120  
  4         87  
8 4     4   1593 use Business::OnlinePayment::HTTPS;
  4         79314  
  4         152  
9 4     4   1567 use parent qw(Business::OnlinePayment::HTTPS);
  4         1015  
  4         22  
10             our $me = 'Business::OnlinePayment::Mock';
11              
12             our $VERSION = '0.007'; # 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 4     4   37 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             'PreAuth'
43             ],
44             },
45             };
46             }
47              
48              
49             sub set_default_mock {
50 1     1 1 9983 my ($self, $default) = @_;
51              
52 1         7 $default_mock = $default;
53             }
54              
55              
56             sub set_mock_response {
57 3     3 1 21154 my ($self, $response, $set_as_default) = @_;
58              
59 3         14 $mock_responses->{ delete $response->{'action'} }->{ delete $response->{'card_number'} } = $response;
60              
61 3 50       14 $self->set_as_default($response) if $set_as_default;
62             }
63              
64              
65             sub test_transaction {
66 0     0 1   my $self = shift;
67              
68 0           $self->{'test_transaction'} = 1;
69 0           $self->server('example.com');
70 0           $self->port(443);
71 0           $self->path('/example.html');
72              
73 0           return $self->{'test_transaction'};
74             }
75              
76              
77             sub submit {
78 0     0 1   my $self = shift;
79 0           my %content = $self->content();
80 0 0         die 'Missing action' unless $content{'action'};
81              
82 0           my $action;
83 0           foreach my $a (@{ $self->_info()->{'supported_actions'}->{'CC'} }) {
  0            
84 0 0         if (lc $a eq lc $content{'action'}) {
85 0           $action = $a;
86 0           last;
87             }
88             }
89 0 0         die 'Unsupported action' unless $action;
90              
91 0 0         my $result = { %{ $mock_responses->{$action}->{ $content{'card_number'} } || $default_mock } }; # cheap clone
  0            
92              
93 0           foreach my $k (keys %{$result}) {
  0            
94 0           my $val = $result->{$k};
95 0 0         $result->{$k} = ref $val eq 'CODE' ? $val->(\%content) : $val;
96 0 0         $self->$k($result->{$k}) if $self->can($k);
97             }
98              
99 0           return $result;
100             }
101              
102             1;
103              
104             __END__