use strict;
use base 'Business::OnlineThirdPartyPayment';
-use vars qw($VERSION $DEBUG);
use strict;
use LWP;
use JSON;
-use Net::PayPal; # for authentication, mostly
use URI;
-use Cache::FileCache; # for ID strings
+use Cache::FileCache;
+use Crypt::CBC;
-$VERSION = '0.01';
+our $VERSION = '0.01';
+our $ENDPOINT_SANDBOX = 'api.sandbox.paypal.com';
+our $ENDPOINT_LIVE = 'api.paypal.com';
-$DEBUG = 2;
+our $DEBUG = 0;
sub set_defaults {
my $self = shift;
- $self->build_subs(qw(order_number result_code error_message error_object
- cache_root));
+ my %args = @_;
+ $self->build_subs(qw(username password error_object host access_token));
+ if ( $args{debug} ) {
+ $DEBUG = $args{debug};
+ }
}
-sub client {
+sub authenticate {
my $self = shift;
- my %content = $self->content;
- $self->{'client'} ||=
- Net::PayPal->new($content{'login'}, $content{'password'});
+ my $host = shift;
+
+ die "PayPal client ID (username) must be configured\n"
+ unless $self->username;
+ die "PayPay client secret (password) must be configured\n"
+ unless $self->password;
+
+ $self->{cache} = Cache::FileCache->new(
+ { cache_root => File::Spec->tmpdir,
+ namespace => 'BOTP-PayPal' }
+ );
+ $self->{cipher} = Crypt::CBC->new( -key => $self->password,
+ -cipher => 'Blowfish' );
+
+ if ( my $token = $self->cache->get($self->username) ) {
+ $self->access_token( $self->cipher->decrypt($token) );
+ } else {
+ my $ua = LWP::UserAgent->new;
+ my $auth_request = HTTP::Request->new(POST => "$host/v1/oauth2/token");
+ $auth_request->header('Accept' => 'application/json');
+ # documentation says application/json; it lies.
+ $auth_request->header('Content-Type'=>
+ 'application/x-www-form-urlencoded');
+ $auth_request->authorization_basic( $self->username, $self->password );
+ $auth_request->content('grant_type=client_credentials');
+ warn "Sending authentication request.\n" if $DEBUG;
+ my $auth_response = $ua->request($auth_request);
+ unless ( $auth_response->is_success ) {
+ die "Authentication failed: ".$auth_response->status_line."\n".
+ $auth_response->content;
+ }
+ warn "Authentication response:\n".$auth_response->content."\n\n"
+ if $DEBUG > 2;
+ my $hash = decode_json($auth_response->content);
+ my $token = $hash->{access_token};
+ $self->access_token($token);
+ $self->cache->set($self->username, $self->cipher->encrypt( $token ),
+ $hash->{expires_in} - 5);
+ }
+ return $self->access_token;
}
-sub cache {
- my $self = shift;
- $self->{'cache'} ||=
- Cache::FileCache->new(
- { namespace => 'PayPal',
- default_expires_in => 3600,
- cache_root => $self->cache_root
- } );
-}
+sub cache { $_[0]->{cache} }
-sub submit {
- my $self = shift;
- my %content = $self->content;
- my $action = lc($content{'action'});
- if ( $action eq 'authorization only' ) {
- $self->create_payment;
- } elsif ( $action eq 'post authorization' ) {
- $self->execute_payment;
- }
-}
+sub cipher { $_[0]->{cipher} }
sub rest {
- # a wrapper for the one in Net::PayPal, with better error handling
- my ($self, $path, $request) = @_;
- my $json_request = encode_json($request);
+ my ($self, $path, $content) = @_;
+ my $host = $self->host;
+
+ if ( $self->test_transaction ) {
+ $host ||= $ENDPOINT_SANDBOX;
+ } else {
+ $host ||= $ENDPOINT_LIVE;
+ }
+ $host = 'https://'.$host;
+
+ my $token = $self->access_token || $self->authenticate($host);
+ my $ua = LWP::UserAgent->new;
+
+ my $json_request = encode_json($content);
warn "REQUEST:\n$json_request\n\n" if $DEBUG >= 2;
- my $raw_res =
- $self->client->rest('POST', $path, $json_request, 1);
- # last argument is "dump_responce" [sic]--tells Net::PayPal to dump the
- # HTTP::Response object instead of returning (part of) the error status
- my $res;
- # deal with certain ambiguities from Data::Dumper
- { my $VAR1;
- eval "$raw_res";
- $res = $VAR1; }
- if ( !defined($res) || !ref($res) || !$res->isa('HTTP::Response') ) {
- die "Nonsense output from Net::PayPal REST call:\n$raw_res\n\n";
+
+ my $url = $host . $path;
+ warn "Sending to $url\n" if $DEBUG;
+
+ my $request = HTTP::Request->new(POST => $url);
+ $request->header('Accept' => 'application/json');
+ $request->header('Authorization' => "Bearer $token");
+ $request->header('Content-Type' => 'application/json');
+ $request->content($json_request);
+
+ my $response = $ua->request($request);
+ if ( !$response ) {
+ die "API request failed: ".$response->status_line."\n".
+ $response->content;
}
- warn "RESPONSE:" . $res->status_line . "\n" . $res->content . "\n\n"
+ warn "RESPONSE:" . $response->status_line."\n".$response->content."\n\n"
if $DEBUG >= 2;
- if ( $res->is_success ) {
+ if ( $response->is_success ) {
$self->is_success(1);
- return decode_json($res->content);
+ return decode_json($response->content);
} else {
$self->is_success(0);
- if ( $res->content ) {
- my $response = decode_json($res->content);
- $self->error_object($response);
- my $error = sprintf("%s: %s",
- $response->{'name'}, $response->{'message'});
- if ( $response->{'details'} ) {
- foreach (@{ $response->{'details'} }) {
- $error .= sprintf("\n%s:\t%s", $_->{'field'}, $_->{'issue'});
+ if ( $response->content ) {
+ my $error = decode_json($response->content);
+ $self->error_object($error);
+ my $error_message = sprintf("%s: %s",
+ $error->{'name'}, $error->{'message'});
+ if ( $error->{'details'} ) {
+ foreach (@{ $error->{'details'} }) {
+ $error_message .= sprintf("\n%s:\t%s", $_->{'field'}, $_->{'issue'});
}
}
- $self->error_message($error);
- return $response;
+ $self->error_message($error_message);
+ return $error;
} else {
$self->error_object({});
- $self->error_message($res->status_line);
+ $self->error_message($response->status_line);
return {};
}
}
}
-sub create_payment {
+sub create {
my $self = shift;
- my %content = $self->content;
- my $ref = $content{'reference'}
- or die "reference required";
- my $return_url = URI->new($content{'callback_url'})
- or die "callback_url required";
- $return_url->query_form( $return_url->query_form(), 'ref' => $ref );
- my $cancel_url = URI->new($content{'cancel_url'})
+ my %content = @_;
+ my $return_url = URI->new($self->return_url)
+ or die "return_url required";
+ my $cancel_url = URI->new($self->cancel_url)
or die "cancel_url required";
- $cancel_url->query_form( $cancel_url->query_form(), 'ref' => $ref );
my $request =
{
my $response = $self->rest('/v1/payments/payment', $request);
if ( $self->is_success ) {
- $self->order_number($response->{'id'});
- $self->cache->set( "REF-$ref" => $response->{'id'} );
+ $self->token($response->{'id'});
my %links = map { $_->{rel} => $_->{href} } @{ $response->{'links'} };
- $self->popup_url($links{'approval_url'});
+ $self->redirect($links{'approval_url'});
# other links are "self", which is where we just posted,
# and "execute_url", which we can determine from the payment id
}
}
-sub execute_payment {
+sub execute {
my $self = shift;
- my %content = $self->content;
- # at this point the transaction is already set up
- # (right? the workflow in this is horribly confusing...)
- if ( !$self->authorization ) {
- die "No authorization was received for this payment.\n";
- }
- my $request = { 'payer_id' => $self->authorization };
- my $execute_path = '/v1/payments/payment/' . $self->order_number . '/execute';
+ my %params = @_;
+ #my $payer_id = $params{'payer_id'} # documentation is wrong here
+ my $payer_id = $params{'PayerID'}
+ or die "cannot complete payment: missing PayerID"; #payer_id";
+
+ my $request = { 'payer_id' => $payer_id };
+ $self->order_number($self->token);
+ my $execute_path = '/v1/payments/payment/' . $self->token. '/execute';
$self->rest($execute_path, $request);
}
-sub reference {
- my $self = shift;
- my $data = shift; # hashref of query params included in the callback URL
-
- $self->authorization($data->{'PayerID'});
- my $ref = $data->{'ref'};
- my $id = $self->cache->get("REF-$ref");
- if (!$id) {
- $self->error_message("Payment reference '$ref' not found.");
- $self->is_success(0);
- }
- $self->order_number($id);
- $ref;
-}
-
1;
__END__
Mark Wells <mark@freeside.biz>
+Based in part on Net::PayPal, by Sherzod B. Ruzmetov <sherzodr@cpan.org>.
+
=head1 SEE ALSO
perl(1). L<Business::OnlineThirdPartyPayment>.