File Coverage

blib/lib/Business/CPI/Gateway/Base.pm
Criterion Covered Total %
statement 41 65 63.0
branch 6 12 50.0
condition 0 2 0.0
subroutine 9 17 52.9
pod 8 8 100.0
total 64 104 61.5


line stmt bran cond sub pod time code
1             package Business::CPI::Gateway::Base;
2             # ABSTRACT: Father of all gateways
3 6     6   4273 use Moo;
  6         12  
  6         39  
4 6     6   6356 use Locale::Currency ();
  6         111005  
  6         187  
5 6     6   8139 use Data::Dumper;
  6         48954  
  6         559  
6 6     6   57 use Carp qw/croak/;
  6         11  
  6         325  
7 6     6   3208 use Business::CPI::Util::Types qw/UserAgent HTTPResponse/;
  6         22  
  6         78  
8 6     6   3529 use Types::Standard qw/Maybe/;
  6         11  
  6         42  
9 6     6   7638 use LWP::UserAgent;
  6         282143  
  6         4572  
10              
11             with 'Business::CPI::Role::Gateway::Base';
12              
13             our $VERSION = '0.923'; # VERSION
14              
15             has receiver_id => (
16             is => 'ro',
17             );
18              
19             has checkout_url => (
20             is => 'rw',
21             );
22              
23             has checkout_with_token => (
24             is => 'ro',
25             default => sub { 0 },
26             );
27              
28             has currency => (
29             isa => sub {
30             my $curr = uc($_[0]);
31              
32             for (Locale::Currency::all_currency_codes()) {
33             return 1 if $curr eq uc($_);
34             }
35              
36             die "Must be a valid currency code";
37             },
38             coerce => sub { uc $_[0] },
39             is => 'ro',
40             );
41              
42             has user_agent => (
43             is => 'rwp',
44             isa => UserAgent,
45             lazy => 1,
46             builder => '_build_user_agent',
47             );
48              
49             has most_recent_request => (
50             is => 'rwp',
51             isa => Maybe[HTTPResponse],
52             );
53              
54             has error => ( is => 'rwp' );
55              
56             sub new_account {
57 1     1 1 1 my ($self, $account) = @_;
58              
59 1         7 return $self->account_class->new(
60             _gateway => $self,
61             %$account
62             );
63             }
64              
65             sub new_cart {
66 6     6 1 4878 my ( $self, $info ) = @_;
67              
68 6 50       63 if ($self->log->is_debug) {
69 0         0 $self->log->debug("Building a cart with: " . Dumper($info));
70             }
71              
72 6 100       8 my @items = @{ delete $info->{items} || [] };
  6         47  
73 6 100       11 my @receivers = @{ delete $info->{receivers} || [] };
  6         36  
74              
75 6         39 my $buyer_class = $self->buyer_class;
76 6         321 my $cart_class = $self->cart_class;
77              
78             # We might be using a more generic Account class
79 6 50       296 if ($buyer_class->does('Business::CPI::Role::Account')) {
80 0         0 $info->{buyer}{_gateway} = $self;
81             }
82              
83             $self->log->debug(
84 6         301 "Loaded buyer class $buyer_class and cart class $cart_class."
85             );
86              
87 6         63 my $buyer = $buyer_class->new( delete $info->{buyer} );
88              
89 6         14446 $self->log->info("Built cart for buyer " . $buyer->email);
90              
91 6         92 my $cart = $cart_class->new(
92             _gateway => $self,
93             buyer => $buyer,
94             %$info,
95             );
96              
97 6         258 for (@items) {
98 6         40 $cart->add_item($_);
99             }
100              
101 6         17 for (@receivers) {
102 2         9 $cart->add_receiver($_);
103             }
104              
105 6         38 return $cart;
106             }
107              
108             sub map_object {
109 0     0 1   my ($self, $map, $obj) = @_;
110              
111 0           my @result;
112              
113 0           while (my ($bcpi_key, $gtw_key) = each %$map) {
114 0           my $value = $obj->$bcpi_key;
115 0 0         next unless $value;
116              
117 0           my $name = $gtw_key;
118              
119 0 0         if (ref $gtw_key) {
120 0           $name = $gtw_key->{name};
121 0           $value = $gtw_key->{coerce}->($name);
122             }
123              
124 0           push @result, ( $name, $value );
125             }
126              
127 0           return @result;
128             }
129              
130 0     0 1   sub get_notification_details { shift->_unimplemented }
131              
132 0     0 1   sub query_transactions { shift->_unimplemented }
133              
134 0     0 1   sub get_transaction_details { shift->_unimplemented }
135              
136 0     0 1   sub notify { shift->_unimplemented }
137              
138 0     0 1   sub get_checkout_code { shift->_unimplemented }
139              
140             sub _unimplemented {
141 0     0     my $self = shift;
142 0           die "Not implemented.";
143             }
144              
145             sub _build_user_agent {
146 0     0     my ($self) = @_;
147              
148 0           my $class_name = ref $self;
149 0   0       my $version = eval { $self->VERSION } || 'devel';
150              
151 0           return LWP::UserAgent->new(agent => "$class_name/$version");
152             }
153              
154             around BUILDARGS => sub {
155             my $orig = shift;
156             my $self = shift;
157             my $args = $self->$orig(@_);
158              
159             if ($args->{receiver_email}) {
160             croak 'receiver_email attribute has been removed - use receiver_id instead';
161             }
162              
163             return $args;
164             };
165              
166             1;
167              
168             __END__