File Coverage

blib/lib/Business/CPI/Gateway/PayPal.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Business::CPI::Gateway::PayPal;
2             # ABSTRACT: Business::CPI's PayPal driver
3              
4 3     3   45690 use Moo;
  3         37154  
  3         14  
5 3     3   5737 use DateTime;
  0            
  0            
6             use DateTime::Format::Strptime;
7             use Business::CPI::Gateway::PayPal::IPN;
8             use Business::PayPal::NVP;
9             use Data::Dumper;
10             use Carp 'croak';
11              
12             our $VERSION = '0.905'; # VERSION
13              
14             extends 'Business::CPI::Gateway::Base';
15             with 'Business::CPI::Role::Gateway::FormCheckout';
16              
17             has sandbox => (
18             is => 'rw',
19             default => sub { 0 },
20             );
21              
22             has '+checkout_url' => (
23             default => sub {
24             my $sandbox = shift->sandbox ? 'sandbox.' : '';
25             return "https://www.${sandbox}paypal.com/cgi-bin/webscr";
26             },
27             lazy => 1,
28             );
29              
30             has '+currency' => (
31             default => sub { 'USD' },
32             );
33              
34             # TODO: make it lazy, and croak if needed
35             has api_username => (
36             is => 'ro',
37             required => 0,
38             );
39              
40             has api_password => (
41             is => 'ro',
42             required => 0,
43             );
44              
45             has signature => (
46             is => 'ro',
47             required => 0,
48             );
49              
50             has nvp => (
51             is => 'ro',
52             lazy => 1,
53             default => sub {
54             my $self = shift;
55              
56             return Business::PayPal::NVP->new(
57             test => {
58             user => $self->api_username,
59             pwd => $self->api_password,
60             sig => $self->signature,
61             },
62             live => {
63             user => $self->api_username,
64             pwd => $self->api_password,
65             sig => $self->signature,
66             },
67             branch => $self->sandbox ? 'test' : 'live'
68             );
69             }
70             );
71              
72             has date_format => (
73             is => 'ro',
74             lazy => 1,
75             default => sub {
76             DateTime::Format::Strptime->new(
77             pattern => '%Y-%m-%dT%H:%M:%SZ',
78             time_zone => 'UTC',
79             );
80             },
81             );
82              
83             sub notify {
84             my ( $self, $req ) = @_;
85              
86             my $ipn = Business::CPI::Gateway::PayPal::IPN->new(
87             query => $req,
88             gateway_url => $self->checkout_url,
89             );
90              
91             croak 'Invalid IPN request' unless $ipn->is_valid;
92              
93             my %vars = %{ $ipn->vars };
94              
95             $self->log->info("Received notification $vars{ipn_track_id} for transaction $vars{txn_id}.");
96              
97             my $r = {
98             payment_id => $vars{invoice},
99             status => $self->_interpret_status($vars{payment_status}),
100             gateway_transaction_id => $vars{txn_id},
101             exchange_rate => $vars{exchange_rate},
102             net_amount => ($vars{settle_amount} || $vars{mc_gross}) - ($vars{mc_fee} || 0),
103             amount => $vars{mc_gross},
104             fee => $vars{mc_fee},
105             date => $vars{payment_date},
106             payer => {
107             name => $vars{first_name} . ' ' . $vars{last_name},
108             email => $vars{payer_email},
109             }
110             };
111              
112             if ($self->log->is_debug) {
113             $self->log->debug("The notification data is:\n" . Dumper($r));
114             $self->log->debug("The request data is:\n" . Dumper($req));
115             }
116              
117             return $r;
118             }
119              
120             sub _interpret_status {
121             my ($self, $status) = @_;
122              
123             for ($status) {
124             /^Completed$/ ||
125             /^Processed$/ and return 'completed';
126              
127             /^Denied$/ ||
128             /^Expired$/ ||
129             /^Failed$/ and return 'failed';
130              
131             /^Voided$/ ||
132             /^Refunded$/ ||
133             /^Reversed$/ and return 'refunded';
134              
135             /^Pending$/ and return 'processing';
136             }
137              
138             return 'unknown';
139             }
140              
141             sub query_transactions {
142             my ($self, $info) = @_;
143              
144             my $final_date = $info->{final_date} || DateTime->now(time_zone => 'UTC');
145             my $initial_date = $info->{initial_date} || $final_date->clone->subtract(days => 30);
146              
147             my %search = $self->nvp->send(
148             METHOD => 'TransactionSearch',
149             STARTDATE => $initial_date->strftime('%Y-%m-%dT%H:%M:%SZ'),
150             ENDDATE => $final_date->strftime('%Y-%m-%dT%H:%M:%SZ'),
151             );
152              
153             if ($search{ACK} ne 'Success') {
154             croak "Error in the query: " . Dumper(\%search);
155             }
156              
157             while (my ($k, $v) = each %search) {
158             if ($k =~ /^L_TYPE(.*)$/) {
159             my $deleted_key = "L_TRANSACTIONID$1";
160             if (lc($v) ne 'payment') {
161             delete $search{$deleted_key};
162             }
163             }
164             }
165              
166             my @transaction_ids = map { $search{$_} } grep { /^L_TRANSACTIONID/ } keys %search;
167              
168             my @transactions = map { $self->get_transaction_details($_) } @transaction_ids;
169              
170             return {
171             current_page => 1,
172             results_in_this_page => scalar @transaction_ids,
173             total_pages => 1,
174             transactions => \@transactions,
175             };
176             }
177              
178             sub get_transaction_details {
179             my ( $self, $id ) = @_;
180              
181             my %details = $self->nvp->send(
182             METHOD => 'GetTransactionDetails',
183             TRANSACTIONID => $id,
184             );
185              
186             if ($details{ACK} ne 'Success') {
187             croak "Error in the details fetching: " . Dumper(\%details);
188             }
189              
190             return {
191             payment_id => $details{INVNUM},
192             status => lc($details{PAYMENTSTATUS}),
193             amount => $details{AMT},
194             net_amount => $details{SETTLEAMT},
195             tax => $details{TAXAMT},
196             exchange_rate => $details{EXCHANGERATE},
197             date => $self->date_format->parse_datetime( $details{ORDERTIME} ),
198             buyer_email => $details{EMAIL},
199             gateway_transaction_id => $id,
200             };
201             }
202              
203             sub _checkout_form_main_map {
204             {
205             receiver_id => 'business',
206             currency => 'currency_code',
207             form_encoding => 'charset',
208             }
209             }
210              
211             sub _checkout_form_item_map {
212             my ($self, $i) = @_;
213              
214             {
215             id => "item_number_$i",
216             description => "item_name_$i",
217             price => "amount_$i",
218             quantity => "quantity_$i",
219             weight => {
220             name => "weight_$i",
221             coerce => sub { $_[0] }, # think about weight_unit
222             },
223             shipping => "shipping_$i",
224             shipping_additional => "shipping2_$i",
225             }
226             }
227              
228             sub _checkout_form_buyer_map {
229             {
230             email => 'email',
231             address_line1 => 'address1',
232             address_line2 => 'address2',
233             address_city => 'city',
234             address_state => 'state',
235             address_country => {
236             name => 'country',
237             coerce => sub { uc $_[0] },
238             },
239             address_zip_code => 'zip',
240             }
241             }
242              
243             sub _checkout_form_cart_map {
244             {
245             discount => 'discount_amount_cart',
246             handling => 'handling_cart',
247             tax => 'tax_cart',
248             }
249             }
250              
251             around _get_hidden_inputs_for_items => sub {
252             my ($orig, $self, $items) = @_;
253              
254             my $add_weight_unit = sub {
255             for (@$items) {
256             return 1 if $_->weight;
257             }
258             return 0;
259             }->();
260              
261             my @result = $self->$orig($items);
262              
263             if ($add_weight_unit) {
264             push @result, ( "weight_unit" => 'kgs' );
265             }
266              
267             return @result;
268             };
269              
270             sub get_hidden_inputs {
271             my ($self, $info) = @_;
272              
273             return (
274             # -- make paypal accept multiple items (cart)
275             cmd => '_ext-enter',
276             redirect_cmd => '_cart',
277             upload => 1,
278             # --
279              
280             invoice => $info->{payment_id},
281             no_shipping => $info->{buyer}->address_line1 ? 0 : 1,
282              
283             $self->_get_hidden_inputs_main(),
284             $self->_get_hidden_inputs_for_buyer($info->{buyer}),
285             $self->_get_hidden_inputs_for_items($info->{items}),
286             $self->_get_hidden_inputs_for_cart($info->{cart}),
287             );
288             }
289              
290             1;
291              
292             __END__