site/cgi-bin/modules/BSE/PayPal.pm

   1 package BSE::PayPal;
   2 use strict;
   3 use BSE::Cfg;
   4 use BSE::Util::HTML;
   5 use BSE::Shop::Util qw(:payment);
   6 use Carp qw(confess);
   7
   8 our $VERSION = "1.004";
   9
  10 use constant DEF_TEST_WS_URL => "https://api-3t.sandbox.paypal.com/nvp";
  11 use constant DEF_TEST_REFRESH_URL => "https://www.sandbox.paypal.com/webscr";
  12
  13 use constant DEF_LIVE_WS_URL => "https://api-3t.paypal.com/nvp";
  14 use constant DEF_LIVE_REFRESH_URL => "https://www.paypal.com/cgibin/webscr";
  15
  16 my %defs =
  17   (
  18    test_ws_url => DEF_TEST_WS_URL,
  19    test_refresh_url => DEF_TEST_REFRESH_URL,
  20
  21    live_ws_url => DEF_LIVE_WS_URL,
  22    live_refresh_url => DEF_LIVE_REFRESH_URL,
  23   );
  24
  25 sub _test {
  26   my ($cfg) = @_;
  27
  28   return $cfg->entry("paypal", "test", 1);
  29 }
  30
  31 sub _cfg {
  32   my ($cfg, $key) = @_;
  33
  34   my $realkey = _test($cfg) ? "test_$key" : "live_$key";
  35   if (exists $defs{$realkey}) {
  36     return $cfg->entry("paypal", $realkey, $defs{$realkey});
  37   }
  38   else {
  39     return $cfg->entryErr("paypal", $realkey);
  40   }
  41 }
  42
  43 sub _base_ws_url {
  44   my ($cfg) = @_;
  45
  46   return _cfg($cfg, "ws_url");
  47 }
  48
  49 sub _base_refresh_url {
  50   my ($cfg) = @_;
  51
  52   return _cfg($cfg, "refresh_url");
  53 }
  54
  55 sub _api_signature {
  56   my ($cfg) = @_;
  57
  58   return _cfg($cfg, "api_signature");
  59 }
  60
  61 sub _api_username {
  62   my ($cfg) = @_;
  63
  64   return _cfg($cfg, "api_username");
  65 }
  66
  67 sub _api_password {
  68   my ($cfg) = @_;
  69
  70   return _cfg($cfg, "api_password");
  71 }
  72
  73 sub _format_amt {
  74   my ($price) = @_;
  75
  76   return sprintf("%d.%02d", int($price / 100), $price % 100);
  77 }
  78
  79 sub _order_amt {
  80   my ($order) = @_;
  81
  82   return _format_amt($order->total);
  83 }
  84
  85 sub _order_currency {
  86   my ($order) = @_;
  87
  88   return BSE::Cfg->single->entry("shop", "currency_code", "AUD")
  89 }
  90
  91 sub payment_url {
  92   my ($class, %opts) = @_;
  93
  94   my $order = delete $opts{order}
  95     or confess "Missing order";
  96   my $rmsg = delete $opts{msg}
  97     or confess "Missing msg";
  98   my $who = delete $opts{user} || "U";
  99   my $cfg = BSE::Cfg->single;
 100
 101   my %info = _set_express_checkout($cfg, $order, $who, $rmsg)
 102     or return;
 103
 104   $order->set_paypal_token($info{TOKEN});
 105   $order->save;
 106
 107   my $url = _make_url(_base_refresh_url($cfg),
 108                       {
 109                        cmd => "_express-checkout",
 110                        token => $info{TOKEN},
 111                        useraction => "confirm",
 112                        AMT => _order_amt($order),
 113                        CURRENCYCODE => _order_currency($order)
 114                       }
 115                      );
 116
 117 #   BSE::TB::AuditLog->log
 118 #       (
 119 #        component => "shop:paypal:paymenturl",
 120 #        level => "debug",
 121 #        object => $order,
 122 #        actor => $who,
 123 #        msg => "URL $url",
 124 #       );
 125
 126   return $url;
 127 }
 128
 129 # the _api_*() functions will die if not configured
 130 sub configured {
 131   my $cfg = BSE::Cfg->single;
 132
 133   return eval
 134     {
 135       _api_username($cfg) && _api_password($cfg) && _api_signature($cfg);
 136       1;
 137     };
 138 }
 139
 140 sub pay_order {
 141   my ($class, %opts) = @_;
 142
 143   my $order = delete $opts{order}
 144     or confess "Missing order";
 145   my $req = delete $opts{req}
 146     or confess "Missing req";
 147   my $rmsg = delete $opts{msg}
 148     or confess "Missing msg";
 149
 150   my $cgi = $req->cgi;
 151   my $cfg = $req->cfg;
 152   my $token = $cgi->param("token");
 153   unless ($token) {
 154     $$rmsg = $req->catmsg("msg:bse/shop/paypal/notoken");
 155     return;
 156   }
 157   my $payerid = $cgi->param("PayerID");
 158   unless ($payerid) {
 159     $$rmsg = $req->catmsg("msg:bse/shop/paypal/nopayerid");
 160     return;
 161   }
 162   unless ($token eq $order->paypal_token) {
 163     print STDERR "cgi $token order ", $order->paypal_token, "\n";
 164     $$rmsg = $req->catmsg("msg:bse/shop/paypal/badtoken");
 165     return;
 166   }
 167
 168   my %info;
 169   if (_do_express_checkout_payment
 170       ($cfg, $rmsg, $order, scalar($req->siteuser), $token, $payerid, \%info)) {
 171     $order->set_paypal_tran_id($info{TRANSACTIONID});
 172
 173   }
 174   elsif (keys %info) {
 175     unless ($info{L_ERRORCODE}
 176             && $info{L_ERRORCODE} == 10415
 177             && $info{CHECKOUTSTATUS}
 178             && $info{CHECKOUTSTATUS} eq "PaymentActionCompleted"
 179             && $info{PAYMENTREQUEST_0_TRANSACTIONID}) {
 180       return; # something else went wrong
 181     }
 182
 183     # already processed, maybe there was an error when the user first
 184     # returned, treat it as completed
 185     $order->set_paypal_tran_id($info{PAYMENTREQUEST_0_TRANSACTIONID});
 186   }
 187   $order->set_paypal_token("");
 188   $order->set_paidFor(1);
 189   $order->set_paymentType(PAYMENT_PAYPAL);
 190   $order->set_stage("unprocessed");
 191   $order->set_complete(1);
 192   $order->save;
 193   BSE::TB::AuditLog->log
 194       (
 195        component => "shop:paypal:pay",
 196        level => "notice",
 197        object => $order,
 198        actor => scalar($req->siteuser) || "U",
 199        msg => "Apply PayPal payment to Order No. " . $order->id . ", transaction ".$order->paypal_tran_id,
 200       );
 201
 202   return 1;
 203 }
 204
 205 sub refund_order {
 206   my ($class, %opts) = @_;
 207
 208   my $order = delete $opts{order}
 209     or confess "Missing order";
 210   my $rmsg = delete $opts{msg}
 211     or confess "Missing msg";
 212   my $req = delete $opts{req}
 213     or confess "Missing req";
 214
 215   unless ($order->paymentType eq PAYMENT_PAYPAL) {
 216     $$rmsg = "This order was not paid by PayPal";
 217     return;
 218   }
 219
 220   my $cfg = BSE::Cfg->single;
 221   my %info = _do_refund_transaction($cfg, $rmsg, $order, scalar($req->user))
 222     or return;
 223
 224   $order->set_paidFor(0);
 225   $order->save;
 226
 227   BSE::TB::AuditLog->log
 228       (
 229        component => "shop:paypal:refund",
 230        level => "notice",
 231        object => $order,
 232        actor => scalar($req->user) || "U",
 233        msg => "Refund PayPal payment on Order No. " . $order->id . ", transaction $info{REFUNDTRANSACTIONID}",
 234       );
 235
 236   return 1;
 237 }
 238
 239 sub _do_refund_transaction {
 240   my ($cfg, $rmsg, $order, $who) = @_;
 241
 242   my %params =
 243     (
 244      VERSION => "62.0",
 245      TRANSACTIONID => $order->paypal_tran_id,
 246      REFUNDTYPE => "Full",
 247     );
 248
 249   my %info = _api_req($cfg, $rmsg, $order, $who, "RefundTransaction", \%params)
 250     or return;
 251
 252   return %info;
 253 }
 254
 255 sub _make_qparam {
 256   my ($param) = @_;
 257
 258   return join("&", map { "$_=".escape_uri($param->{$_}) } sort keys %$param);
 259 }
 260
 261 sub _make_url {
 262   my ($base, $param) = @_;
 263
 264   my $sep = $base =~ /\?/ ? "&" : "?";
 265
 266   return $base . $sep . _make_qparam($param);
 267 }
 268
 269 sub _shop_url {
 270   my ($cfg, $action, @params) = @_;
 271
 272   return $cfg->user_url("shop", $action, @params);
 273 }
 274
 275 sub _populate_from_order {
 276   my ($params, $order, $cfg) = @_;
 277
 278   $params->{AMT} = _order_amt($order);
 279   $params->{CURRENCYCODE} = _order_currency($order);
 280
 281   my $index = 0;
 282   my $item_total = 0;
 283   for my $item ($order->items) {
 284     $params->{"L_NAME$index"} = $item->title;
 285     $params->{"L_AMT$index"} = _format_amt($item->price);
 286     $params->{"L_QTY$index"} = $item->units;
 287     $params->{"L_NUMBER$index"} = $item->product_code
 288       if $item->product_code;
 289     $item_total += $item->units * $item->price;
 290     ++$index;
 291   }
 292   $params->{ITEMAMT} = _format_amt($item_total);
 293   $params->{SHIPPINGAMT} = _format_amt($order->shipping_cost)
 294     if $order->shipping_cost;
 295
 296   # use our shipping information
 297   my $country_code = $order->deliv_country_code;
 298   if ($country_code && $cfg->entry("paypal", "shipping", 1)) {
 299     $params->{SHIPTONAME} = $order->delivFirstName . " " . $order->delivLastName;
 300     $params->{SHIPTOSTREET} = $order->delivStreet;
 301     $params->{SHIPTOSTREET2} = $order->delivStreet2;
 302     $params->{SHIPTOCITY} = $order->delivSuburb;
 303     $params->{SHIPTOSTATE} = $order->delivState;
 304     $params->{SHIPTOZIP} = $order->delivPostCode;
 305     $params->{SHIPTOCOUNTRYCODE} = $country_code;
 306     $params->{ADDROVERRIDE} = 1;
 307   }
 308   else {
 309     $params->{NOSHIPPING} = 1;
 310   }
 311 }
 312
 313 sub _set_express_checkout {
 314   my ($cfg, $order, $who, $rmsg) = @_;
 315
 316   my %params =
 317     (
 318      $cfg->entriesCS("paypal custom"),
 319      VERSION => "62.0",
 320      RETURNURL => _shop_url($cfg, "paypalret", order => $order->randomId),
 321      CANCELURL => _shop_url($cfg, "paypalcan", order => $order->randomId),
 322      PAYMENTACTION => "Sale",
 323     );
 324
 325   _populate_from_order(\%params, $order, $cfg);
 326
 327   my %info = _api_req($cfg, $rmsg, $order, $who,"SetExpressCheckout",
 328                       \%params)
 329     or return;
 330
 331   unless ($info{TOKEN}) {
 332     $$rmsg = "No token returned by PayPal";
 333     return;
 334   }
 335
 336   return %info;
 337 }
 338
 339  sub _get_express_checkout_details {
 340    my ($cfg, $order, $who, $rmsg, $token) = @_;
 341
 342    my %params =
 343      (
 344       TOKEN => $token,
 345       VERSION => "62.0",
 346      );
 347
 348    my %info = _api_req($cfg, $rmsg, $order, $who, "GetExpressCheckoutDetails",
 349                       \%params)
 350      or return;
 351
 352    return %info;
 353 }
 354
 355 sub _do_express_checkout_payment {
 356   my ($cfg, $rmsg, $order, $who, $token, $payerid, $info) = @_;
 357
 358   my %params =
 359     (
 360      VERSION => "62.0",
 361      PAYMENTACTION => "Sale",
 362      TOKEN => $token,
 363      PAYERID => $payerid,
 364     );
 365
 366   _populate_from_order(\%params, $order, $cfg);
 367
 368   my %info = _api_req($cfg, $rmsg, $order, $who || "U", "DoExpressCheckoutPayment",
 369                       \%params, $info)
 370     or return;
 371
 372   return %info;
 373 }
 374
 375 # Low level API request
 376 sub _api_req {
 377   my ($cfg, $rmsg, $order, $who, $method, $param, $info) = @_;
 378
 379   $who ||= "U";
 380
 381   require LWP::UserAgent;
 382   my $ua = LWP::UserAgent->new;
 383   $param->{METHOD} = $method;
 384   $param->{USER} = _api_username($cfg);
 385   $param->{PWD} = _api_password($cfg);
 386   $param->{SIGNATURE} = _api_signature($cfg);
 387
 388   my $post = _make_qparam($param);
 389
 390   my $req = HTTP::Request->new(POST => _base_ws_url($cfg));
 391   $req->content($post);
 392
 393   my $result = $ua->request($req);
 394
 395   require BSE::TB::AuditLog;
 396   BSE::TB::AuditLog->log
 397       (
 398        component => "shop:paypal",
 399        function => $method,
 400        level => "info",
 401        object => $order,
 402        actor => $who,
 403        msg => "PayPal $method request",
 404        dump => "Request:<<\n" . $req->as_string . "\n>>\n\nResult:<<\n" . $result->as_string . "\n>>",
 405       );
 406
 407   my %info;
 408   for my $entry (split /&/, $result->decoded_content) {
 409     my ($key, $value) = split /=/, $entry, 2;
 410     $info{$key} = unescape_uri($value);
 411   }
 412
 413   %$info = %info if $info;
 414   unless ($info{ACK} =~ /^Success/) {
 415     BSE::TB::AuditLog->log
 416         (
 417          component => "shop:paypal",
 418          function => $method,
 419          level => "crit",
 420          object => $order,
 421          actor => $who,
 422          msg => "PayPal $method failure",
 423          dump => $result->as_string,
 424         );
 425     $$rmsg = $info{L_LONGMESSAGE0};
 426     return;
 427   }
 428
 429   return %info;
 430 }
 431
 432 1;