PayPal.pm

   1 package Business::OnlineThirdPartyPayment::PayPal;
   2
   3 use strict;
   4 use base 'Business::OnlineThirdPartyPayment';
   5
   6 use strict;
   7 use LWP;
   8 use JSON;
   9 use URI;
  10 use Cache::FileCache;
  11 use Crypt::CBC;
  12
  13 our $VERSION = '0.01';
  14 our $ENDPOINT_SANDBOX = 'api.sandbox.paypal.com';
  15 our $ENDPOINT_LIVE    = 'api.paypal.com';
  16
  17 our $DEBUG = 0;
  18
  19 sub set_defaults {
  20   my $self = shift;
  21   my %args = @_;
  22   $self->build_subs(qw(username password error_object host access_token));
  23   if ( $args{debug} ) {
  24     $DEBUG = $args{debug};
  25   }
  26 }
  27
  28 sub authenticate {
  29   my $self = shift;
  30   my $host = shift;
  31
  32   die "PayPal client ID (username) must be configured\n"
  33     unless $self->username;
  34   die "PayPay client secret (password) must be configured\n"
  35     unless $self->password;
  36
  37   $self->{cache} = Cache::FileCache->new(
  38     { cache_root => File::Spec->tmpdir,
  39       namespace  => 'BOTP-PayPal' }
  40   );
  41   $self->{cipher} = Crypt::CBC->new( -key     => $self->password,
  42                                      -cipher  => 'Blowfish' );
  43
  44   if ( my $token = $self->cache->get($self->username) ) {
  45     $self->access_token( $self->cipher->decrypt($token) );
  46   } else {
  47     my $ua = LWP::UserAgent->new;
  48     my $auth_request = HTTP::Request->new(POST => "$host/v1/oauth2/token");
  49     $auth_request->header('Accept' => 'application/json');
  50     # documentation says application/json; it lies.
  51     $auth_request->header('Content-Type'=>
  52                               'application/x-www-form-urlencoded');
  53     $auth_request->authorization_basic( $self->username, $self->password );
  54     $auth_request->content('grant_type=client_credentials');
  55     warn "Sending authentication request.\n" if $DEBUG;
  56     my $auth_response = $ua->request($auth_request);
  57     unless ( $auth_response->is_success ) {
  58       die "Authentication failed: ".$auth_response->status_line."\n".
  59         $auth_response->content;
  60     }
  61     warn "Authentication response:\n".$auth_response->content."\n\n"
  62       if $DEBUG > 2;
  63     my $hash = decode_json($auth_response->content);
  64     my $token = $hash->{access_token};
  65     $self->access_token($token);
  66     $self->cache->set($self->username, $self->cipher->encrypt( $token ),
  67       $hash->{expires_in} - 5);
  68   }
  69   return $self->access_token;
  70 }
  71
  72 sub cache { $_[0]->{cache} }
  73
  74 sub cipher { $_[0]->{cipher} }
  75
  76 sub rest {
  77   my ($self, $path, $content) = @_;
  78   my $host = $self->host;
  79
  80   if ( $self->test_transaction ) {
  81     $host ||= $ENDPOINT_SANDBOX;
  82   } else {
  83     $host ||= $ENDPOINT_LIVE;
  84   }
  85   $host = 'https://'.$host;
  86
  87   my $token = $self->access_token || $self->authenticate($host);
  88   my $ua = LWP::UserAgent->new;
  89
  90   my $json_request = encode_json($content);
  91   warn "REQUEST:\n$json_request\n\n" if $DEBUG >= 2;
  92
  93   my $url = $host . $path;
  94   warn "Sending to $url\n" if $DEBUG;
  95
  96   my $request = HTTP::Request->new(POST => $url);
  97   $request->header('Accept'         => 'application/json');
  98   $request->header('Authorization'  => "Bearer $token");
  99   $request->header('Content-Type'   => 'application/json');
 100   $request->content($json_request);
 101
 102   my $response = $ua->request($request);
 103   if ( !$response ) {
 104     die "API request failed: ".$response->status_line."\n".
 105         $response->content;
 106   }
 107   warn "RESPONSE:" . $response->status_line."\n".$response->content."\n\n"
 108     if $DEBUG >= 2;
 109
 110   if ( $response->is_success ) {
 111     $self->is_success(1);
 112     return decode_json($response->content);
 113   } else {
 114     $self->is_success(0);
 115     if ( $response->content ) {
 116       my $error = decode_json($response->content);
 117       $self->error_object($error);
 118       my $error_message = sprintf("%s: %s",
 119                     $error->{'name'}, $error->{'message'});
 120       if ( $error->{'details'} ) {
 121         foreach (@{ $error->{'details'} }) {
 122           $error_message .= sprintf("\n%s:\t%s", $_->{'field'}, $_->{'issue'});
 123         }
 124       }
 125       $self->error_message($error_message);
 126       return $error;
 127     } else {
 128       $self->error_object({});
 129       $self->error_message($response->status_line);
 130       return {};
 131     }
 132   }
 133 }
 134
 135 sub create {
 136   my $self = shift;
 137   my %content = @_;
 138   my $return_url = URI->new($self->return_url)
 139     or die "return_url required";
 140   my $cancel_url = URI->new($self->cancel_url)
 141     or die "cancel_url required";
 142
 143   my $request =
 144     {
 145       intent  => 'sale',
 146       payer   => {
 147         payment_method  => 'paypal',
 148       },
 149       transactions => [
 150         {
 151           amount => {
 152             total => $content{'amount'},
 153             currency => ($content{'currency'} || 'USD'),
 154           },
 155           description => $content{'description'},
 156         },
 157       ],
 158       redirect_urls => {
 159         return_url => $return_url->as_string,
 160         cancel_url => $cancel_url->as_string,
 161       },
 162     };
 163
 164   my $response = $self->rest('/v1/payments/payment', $request);
 165
 166   if ( $self->is_success ) {
 167     $self->token($response->{'id'});
 168
 169     my %links = map { $_->{rel} => $_->{href} } @{ $response->{'links'} };
 170     $self->redirect($links{'approval_url'});
 171     # other links are "self", which is where we just posted,
 172     # and "execute_url", which we can determine from the payment id
 173   }
 174 }
 175
 176 sub execute {
 177   my $self = shift;
 178   my %params = @_;
 179   #my $payer_id = $params{'payer_id'} # documentation is wrong here
 180   my $payer_id = $params{'PayerID'}
 181     or die "cannot complete payment: missing PayerID"; #payer_id";
 182
 183   my $request = { 'payer_id' => $payer_id };
 184   $self->order_number($self->token);
 185   my $execute_path = '/v1/payments/payment/' . $self->token. '/execute';
 186   $self->rest($execute_path, $request);
 187 }
 188
 189 1;
 190 __END__
 191
 192 =head1 NAME
 193
 194 Business::OnlineThirdPartyPayment::PayPal
 195
 196 =head1 DESCRIPTION
 197
 198 Business::OnlineThirdPartyPayment module for payments from PayPal accounts.
 199
 200 =head1 AUTHOR
 201
 202 Mark Wells <mark@freeside.biz>
 203
 204 Based in part on Net::PayPal, by Sherzod B. Ruzmetov <sherzodr@cpan.org>.
 205
 206 =head1 COPYRIGHT
 207
 208 Copyright (c) 2013 Freeside Internet Services, Inc.
 209
 210 All rights reserved. This program is free software; you can redistribute
 211 it and/or modify it under the same terms as Perl itself.
 212
 213 =head1 SEE ALSO
 214
 215 perl(1). L<Business::OnlineThirdPartyPayment>.
 216
 217 =cut
 218