Convert README to Markdown for nice GitHub viewing
[interchange.git] / lib / Vend / Payment / PaypalExpress.pm
1 # Vend::Payment::PaypalExpress - Interchange Paypal Express Payments module
2 #
3 # Copyright (C) 2015 Zolotek Resources Ltd
4 # All Rights Reserved.
5 #
6 # Author: Lyn St George <lyn@zolotek.net>
7 #
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2 of the License, or
11 # (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public
19 # License along with this program; if not, write to the Free
20 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
21 # MA  02111-1307  USA.
22 #
23 package Vend::Payment::PaypalExpress;
24
25 =head1 NAME
26
27 Vend::Payment::PaypalExpress - Interchange Paypal Express Payments Module
28
29 =head1 PREREQUISITES
30
31     SOAP::Lite
32     XML::Parser
33     MIME::Base64
34     URI
35     libwww-perl
36     Crypt::SSLeay
37     IO::Socket::SSL   (version 0.97 until 0.99x is fixed for the "illegal seek" error, or a later one that works)
38
39         Date::Calc - new for v1.1.0
40
41 Test for current installations with: perl -MSOAP::Lite -e 'print "It works\n"'
42
43 =head1 DESCRIPTION
44
45 The Vend::Payment::PaypalExpress module implements the paypalexpress() routine
46 for use with Interchange.
47
48 #=========================
49
50 =head1 SYNOPSIS
51
52 Quick start:
53
54 Place this module in <ic_root>/lib/Vend/Payment, and call it in <ic_root>/interchange.cfg with
55 Require module Vend::Payment::PaypalExpress. Ensure that your perl installation contains the modules
56 listed above and their pre-requisites.
57
58 Logon to your Paypal Business (not Personal) account and go to 'Profile' -> 'API access' ->
59 'Request API Credentials' -> 'Signature'. This will generate a user id, password and signature.
60
61 Add to catalog.cfg all marked 'required', optionally the others:
62 Route  paypalexpress id   xxx  (required_
63 Route  paypalexpress password xxx  (required)
64 Optionally for this updated version, you may prefix the three credentials above some unique
65 identifier, eg 'gbp', 'usd', 'sandbox' and the module will switch between them on the fly.
66 Useful if you have different Paypal a/cs in different currencies and want to choose the
67 a/c used based on the currency chosen by the customer.
68 Route  paypalexpress signature xxx (required: use the 3-token system, not the certificate system at Paypal)
69 Route  paypalexpress returnurl your_full_URL/paypalgetrequest (required)
70 Route  paypalexpress cancelurl your_full_URL/your_cancellation_page (required)
71 Route  paypalexpress host api-3t.sandbox.paypal.com  (for testing)
72 Route  paypalexpress host api-3t.paypal.com (required: live host, one of this or the above but not both)
73 Route  paypalexpress currency EUR|GBP|USD|CAD|AUD  (optional, defaults to USD)
74 Route  paypalexpress pagestyle (optional, set up at Paypal)
75 Route  paypalexpress paymentaction Sale (optional, defaults to 'Sale')
76 Route  paypalexpress headerimg 'secure URL' (optional, though must be served from a secure URL if used)
77
78 Optionally, you may set the return URL in the page as
79 <input type=hidden name=returnurl value=your_url>,
80 and similarly the cancelurl may be set in the page.
81
82 To have Paypal co-operate with your normal payment service provider, eg Authorizenet, do the following:
83
84 Leave the MV_PAYMENT_MODE variable in catalog.cfg and products/variable.txt set to your normal payment processor.
85
86 Add to etc/profiles.order:
87 __NAME__                       paypalexpress
88 __COMMON_ORDER_PROFILE__
89 &fatal = yes
90 email=required
91 email=email
92 &set=mv_payment PaypalExpress
93 &set=psp Paypal
94 &set=mv_payment_route paypalexpress
95 &final = yes
96 &setcheck = payment_method paypalexpress
97 __END__
98 or, if you want to use Paypal as a 'Buy now' button without taking any customer details, then omit the
99 __COMMON_ORDER_PROFILE__ and the two 'email=...' lines above. 
100
101 Within the 'credit_card' section of etc/profiles.order leave "MV_PAYMENT_MODE" as set,
102 and add
103 &set=psp __MV_PAYMENT_PSP__
104 &set=mv_payment_route authorizenet
105 (or your preferred gateway instead of authorizenet) as the last entries in the section.
106 NB: if you are taking offline payments then do not set mv_payment_route here, but instead set in the body
107 of the 'Buy now' button "mv_payment_route=offlinepayment
108                          mv_order_profile=credit_card" 
109 and install the OfflinePayment.pm module so as to have a named alternative payment route in catalog.cfg.
110
111 and then add
112 Variable MV_PAYMENT_PSP "foo"
113 to catalog.cfg, where "foo" is the name of your gateway or acquirer, formatted as you want it to appear
114 on the receipt. Eg, "Bank of America" (rather than boa), "AuthorizeNet" (rather than authorizenet).
115
116 In etc/log_transction, immediately after the 
117 [elsif variable MV_PAYMENT_MODE]
118         [calc]
119 insert this line: 
120         undef $Session->{payment_result}{MStatus};
121
122 and leave
123 [elsif variable MV_PAYMENT_MODE] 
124 as set (contrary to previous revisions of this document) but within the same section change the following 
125 two instances of [var MV_PAYMENT_MODE] to [value mv_payment_route]. In particular, the setting inside the
126 [charge route="..] line will specify which payment processor is used for each particular case, and you
127 need to further modify this line so that it ends up like this:
128         [tmp name="charge_succeed"][charge route="[value mv_payment_route]" pprequest="dorequest" amount="[scratch tmp_remaining]" order_id="[value mv_transaction_id]"][/tmp]
129 If the value of 'mv_payment_route' is set to 'paypalexpress', then this is the one that is run. It is only
130 called via log_transaction after the customer has returned from Paypal and clicks the 'final' pay button, 
131 hence this is where the final 'pprequest=dorequest' value is sent. 
132
133 Add into the end of the "[import table=transactions type=LINE continue=NOTES no-commit=1]" section
134 of etc/log_transaction:
135
136 psp: [value psp]
137 pptransactionid: [calc]$Session->{payment_result}{TransactionID}[/calc]
138 pprefundtransactionid: [calc]$Session->{payment_result}{RefundTransactionID}[/calc]
139 ppcorrelationid: [calc]$Session->{payment_result}{CorrelationID};[/calc]
140 pppayerstatus: [value payerstatus]
141 ppaddressstatus: [value address_status]
142
143 and add these 6 new columns into your transactions table as type varchar(256).
144 You will have records of which transactions went through which payment service providers, as well
145 as Paypal's returned IDs. The CorrelationID is the one you need in any dispute with them. The payerstatus
146 and addressstatus results may be useful in the order fulfillment process. 
147
148 Add these lines into the body of the 'submit' button that sends the customer to Paypal.
149           [run-profile name=paypalexpress]
150           [if type=explicit compare="[error all=1 show_var=1 keep=1]"]
151           mv_nextpage=ord/checkout
152           [/if]
153           [charge route="paypalexpress" pprequest="setrequest"]
154           mv_todo=return
155
156 Create a page 'ord/paypalgetrequest.html', and make it the target of the returnURL from Paypal:
157 [charge route="paypalexpress" pprequest="getrequest"]
158 [bounce href="[area ord/paypalcheckout]"]
159
160 Create a page 'paypalcheckout.html' in the pages/ord folder. This should display just the basket and address
161 or whatever you choose for the final pages, plus an IC button with:
162                           mv_order_profile=paypalexpress
163                           mv_todo=submit
164 in the body part as the submit button to finalise the order. 'dorequest' is set in log_transaction.
165
166 You may then use PaypalExpress for any transaction where the 'mv_order_profile' is set to paypalexpress
167 but still use the "credit_card" 'mv_order_profile' for other transactions, eg for Authorizenet. Of
168 course, if PaypalExpress is to be your only payment method, then simply add:
169 Variable  MV_PAYMENT_MODE paypalexpress
170 to catalog.cfg just before the paypalexpress Route entries, and this route will be the default.
171
172 Note that because Paypal do not recognise UK as a country, only GB, you need to set up shipping in
173 your country.txt for GB as well as UK. Note also that Paypal do not return the customer's telephone
174 number by default, so you may need to adjust your order profiles to compensate.
175
176 Also note that Paypal requires the user to have cookies enabled, and if they're not will return an error page with no 
177 indication of the real problem. You may want to warn users of this. 
178
179 The flow is: the first button for Paypal sends a request to Paypal to initialise the transaction and gets a token 
180 back in return. If Paypal fails to send back a token, then the module refreshes that page with an error message 
181 suggesting that the customer should use your normal payment service provider and shows the cards that you accept. 
182 Once the token is read, then your customer is taken to Paypal to login and choose his payment method. Once that is 
183 done, he returns to us and hits the 'paypalgetrequest' page. This gets his full address as held by Paypal, bounces to
184 the final 'paypalcheckout' page and populates the form with his address details. If you have both shipping
185 and billing forms on that page, the shipping address will be populated by default but you may force
186 the billing form to be populated instead by sending
187 <input type=hidden name=pp_use_billing_address value=1>
188 at the initial stage. Then the customer clicks the final 'pay now' button and the transaction is done.
189
190
191 Options that may be set either in the route or in the page:
192  * reqconfirmshipping - this specifies that a Paypal customer must have his address 'confirmed'
193  * addressoverride - this specifies that you will ship only to the address IC has on file (including
194    the name and email); your customer needs to login to IC first before going to Paypal
195  * use_billing_override - sends billing address instead of shipping to PayPal (use with addressoverride)
196  * other options are also settable.
197
198 Testing: while the obvious test choice is to use their sandbox, I've always found it a bit of a dog's breakfast
199    and never trusted it. Much better to test on the live site, and just recyle money between your personal and
200    business accounts at minimal cost to yourself, but with the confidence of knowing that test results are correct.
201
202
203 Recurring Payments:
204 you need a number of new fields in the products table for the parameters required by
205 Paypal, viz:
206 rpdeposit: gross amount for a deposit
207 rpdepositfailedaction: ContinueOnFailure - Paypal will added failed amount to outstanding balance
208   CancelOnFailure (or empty) - Paypal sets status to Pending till inital payment completes, then 
209   sends IPN to notify of either the status becoming Active or the payment failing
210 rptrialamount: nett amount
211 rptrialtaxamount:
212 rptrialshippingamount:
213 rptrialperiod: one of Day, Week, SemiMonth, Month.
214 rptrialfrequency: integer, number of periods between payments, eg "every 2 weeks"
215 rptrialtotalcycles: total number of trial payments before regular payments start
216 rpamount: nett amount for regular payments
217 rptaxamount:
218 rpshippingamount:
219 rpperiod: one of Day, Week, SemiMonth, Month
220 rpfrequency: integer, number of periods between payments, eg "every 2 weeks"
221   NB:/ multiple of period * frequency cannot be greater than one year as maximum interval between payments
222 rptotalcycles: total number of regular payments - can be empty
223 rpstartdate: leave empty to use current date. An absolute date must be in the 2011-02-25T00:00:00Z
224   format. An interval from the current date should use "2 weeks", "5 days" as the format, where
225   the period can be any given above except SemiMonth (this is always billed on the 1st and
226   15th of the month)
227 rpmaxfailedpayments: number of failures before the agreement is automatically cancelled
228 rpautobillarrears: NoAutoBill, AddToNextBilling - Paypal automatically takes requested action
229
230 Displaying the recurring payment amounts taken at order time is quite straightforward - if you want
231 to do that then put the total to be taken into the price field, nett of tax or shipping.
232 You could then modify the receipt page and receipt emails with a new field something like:
233 [if-item-field rpperiod] 
234 [tmp][item-calc]$rpno++[/item-calc][/tmp]
235 Ref: [value mv_order_number]-sub[item-calc]$rpno[/item-calc]
236 <br>ID: [data table=transactions col=order_id key='[value mv_order_number]-sub[item-calc]$rpno[/item-calc]']
237 <br>Status: [data table=transactions col=status key='[value mv_order_number]-sub[item-calc]$rpno[/item-calc]'] 
238 [/if-item-field]
239 Where:
240 ID = rpprofileid (the primary identifier on the customer's Paypal account page),
241 Ref = rpprofilereference (your order number, appended with '-subn' where n is a number from 1 to 10),
242 Status = rpprofilestatus (Pending or Active, but Cancelled and Suspended are also valid)
243
244 If you want to log the key values for each recurring profile, then add these fields to the orderline table:
245 rpperiod varchar(32)
246 rpfrequency varchar(32)
247 rpprofileid  varchar(64)
248 rpprofilereference varchar(64)
249 rpprofilestatus varchar(32)
250 rpgrossamount varchar(32)
251 rpcorrelationid varchar(64)
252
253 and at the beginning of the orderline section of log_transaction, around line 462, add
254 [calc] $rpno = 0; [/calc]
255 just before "[item-list] Added [item-code] to orderline:"
256 and then between "[item-list]" and "[import table=orderline ...]" add:
257
258 [if-item-field rpperiod]
259 [item-calc]$rpno++[/item-calc]
260 [seti rpprofileid][data table=transactions col=order_id key='[value mv_order_number]-sub[item-calc]$rpno[/item-calc]'][/seti]
261 [charge route="[value mv_payment_route]" pprequest="getrpdetails" rpprofileid="[scratchd rpprofileid]"]
262 [/if-item-field]
263
264 and then between [import ..] and [/import]
265 add:
266 rpprofileid: [scratchd rpprofileid]
267 rpprofilereference: [scratchd rpprofilereference]
268 rpprofilestatus: [scratchd rpprofilestatus]
269 rpgrossamount: [scratchd rpgrossamount]
270 rpperiod: [scratchd rpperiod]
271 rpfrequency: [scratchd rpfrequency]
272 rpcorrelationid: [scratchd rpcorrelationid]
273
274 Calling 'getrpdetails' as above returns everything Paypal holds about that transaction and makes it available
275 in scratch space:
276 rpcorrelationid
277 rpprofilereference
278 rpprofileid
279 rpdescription
280 rpprofilestatus
281 rpsubscribername
282 rpstartdate (formatted for [convert-date])
283 rptaxamount
284 rpshippingamount
285 rpamount
286 rpgrossamount (including tax and shipping, amount for each regular payment)
287 rpfrequency
288 rpperiod
289 rptotalycles (total committed to)
290 rpnextbillingdate (formatted for [convert-date])
291 rpcyclesmade (number of payments made)
292 rpcyclesfailed (number of payaments failed)
293 rpcyclesremaining (number of payments left to go)
294 rparrears (amount oustanding)
295 rpmaxfailedpayments (number of failed payments allowed by merchant)
296 rptrialamount
297 rptrialtaxamount
298 rptrialshippingamount
299 rptrialfrequency 
300 rptrialperiod
301 rptrialtotalcycles
302 rptrialgrossamount 
303 rpfinalpaymentduedate
304 rpregularamountpaid (amount paid to date)
305 rptrialamountpaid
306
307 ItemDetails now passed and displayed in the 'new style' Paypal checkout. Discounts/coupons 
308 are not passed, as there is too much scope for error with currency conversions etc which 
309 would cause Paypal to reject the transaction, but instead a note to the buyer will be displayed if 
310 the value of pp_discount_note is passed as true.
311
312 The order number is now set prior to going to Paypal, as they need a Profile Reference
313 and the most sensible way to handle this is to set the order number and append a unique 
314 reference for each recurring agreement set up. This also means that the customer's Paypal
315 account page will show the IC order number as well as Paypal's ProfileID for simpler correlation.
316
317 You may setup a recurring billing agreement and profile with or without an accompanying
318 purchase or possibly without any initial payment - if without then the amount sent is zero. 
319 # ### FIXME 
320 To allow Interchange to log a zero amount,
321 change log_transaction to: 
322 [unless scratch allowzeropayment]
323   [if scratch tmp_remaining == 0]
324         Fully paid by payment cert.
325   [/if] 
326 [/unless]
327 around line 80, and around line 221
328 [if scratchd ordernumberalreadyset]
329   Order number already set by PaypalExpress
330 [else]
331 Set order number in values: [value
332 .....
333                                                 $Session->{mv_order_number} = $Values->{mv_order_number};
334                                         [/calc]
335 [/else]
336 [/if]
337 to stop IC setting the order number again
338
339 There are also a number of functions which could be handled by an admin panel or virtual
340 terminal. 
341
342 Manage Recurring Payments:
343 this will cancel, suspend or reactive a profile. It expects to find the customer's
344 ProfileID in the orderline table as rpprofileid, and will return a new correlationid.
345 Send managerp_cancel, managerp_suspend, or managerp_reactivate from your virtual
346 terminal as a 'pprequest' along with the customer's profileID as an IC 'value'.
347
348 Modify Recurring Payments;
349 this allows you to add cycles to the payment profile, change addresses, change amount
350 to be paid. You cannot increase the amount by more than 20% pa. 
351
352 Masspay:
353 this works for a list of up to 250 recipients, but this function is apparently being phased
354 out - certainly in the UK they will not enable masspay any more. Note that the currency 
355 sent must be the same as the currency the sending account is in, and you only get one
356 ID returned for the entire masspayment. The module expects a list as [value vtmessage], 
357 consisting of four comma-separated and quoted fields per record, one record per line:
358 "email address (or paypal ID)","amount (without currency symbols)","unique ID","notes"
359 The notes field may be empty but must be quoted. You may also send a subject for the email 
360 that Paypal sends to each recipient, as [value email_subject], defaulting to 'Paypal payment' 
361 if not set. All recipients must be either email addresses or paypal IDs, not a mixture of both. 
362 All payments must be in the same currency for each list sent, and the currency set is the same 
363 as taken by the main routines; see above.
364
365 Other functions added, as Route parameters or IC or HTML values
366 allowed_payment_method: Default = any; AnyFundingSource = any chosen by buyer irrespective of profile;
367           InstantOnly = only instant payments; InstantFundingSource  = only instant methods, blocks 
368           echeck, meft, elevecheck
369 soft_descriptor: shown on customer's card receipt as transaction description
370 brand_name: overrides business name shown to customer
371 gift_message_enable: 0 or 1
372 gift_receipt_enable: 0 or 1
373 gift_receipt_enable: 0 or 1
374 gift_wrap_name: string
375 buyer_email_optin: 0 or 1
376 survey_enable: 0 or 1
377 allow_push_funding: 0 or 1
378 allow_note: 0 or 1
379 service_phone: displayed to customer at PaypalExpress
380 notify_url: for IPN callbacks
381
382 =head1 Bugs
383 Including total_type causes all child elements of the initial Set request to be ignored, thereby
384 removing recurring payment BillingAgreeements and all payment detail items from view, which
385 in turn means there is no order total and so the request is rejected.
386
387 Including brand_name does the same as above but only when a BillingAgreeement is included in the
388 request - hence the module excludes this setting when a BillingAgreeement is included, but sets
389 it otherwise. 
390
391 SOAP::Lite v0.715 may crash with an error on ln1993 of Lite.pm - backlevelling the version will make
392 this error go away.
393
394
395
396
397 =head1 Changelog
398 version 1.1.6 November 2015
399         - more minor bug fixes
400         
401 version 1.1.5 February 2015
402         - bug fix in XML entities handling
403
404 version 1.1.4 January 2015
405         - further stricter handling of XML entities
406         
407 version 1.1.3 September 2014
408         - update to allow LandingPage to be set to either Login or Billing
409         - stricter handling of XML entities to suit Paypal's stricter handling
410         
411 version 1.1.2 March 2013
412         - bugfix for rounding errors when sending basket in the 'dorequest'
413         - set $Config->{PriceField} to $::Scratch->{PriceField} if defined
414         
415 version 1.1.1 November 2012
416         - incorporated Racke's updates
417         - stripped locale tags from data displayed in the basket at Paypal
418         - truncated description field displayed in itemised basket at paypal
419         
420 version 1.1.0 October 2011
421         - major update:
422         - enabled 'item details' in initial request, so the new-style Paypal checkout page shows
423           an itemised basket
424         - updated masspay to handle multiple recipients properly
425         - added refunds, either full or partial
426         - added 'getbalance', to get the balance of the calling account or any other account for
427           which the credentials are known. If account is multi-currency, then all balances and currencies
428           are displayed in a scratch value.
429         - added 'sendcredit', which sends funds to a specified credit card. You need to know the full
430           billing address and cv2 number, and need to get Paypal to enable this function on your account
431         - added repeat payments, ie recurring billing. Up to the Paypal limit of 10 billing agreements
432           may be set up in one request. Billing agreements may be set up with optional trial periods and
433           deposits, and may be setup with or without an accompanying standard purchase. 
434         - added function to manage repeat payments, ie suspend, reactivate, or cancel
435         - added function to modify repeat payments, ie to alter the billing/shipping address or name,
436           to alter the amount or period etc
437         - added function to get details of a repeat payments billing agreement, and display the results
438           in scratch space including date of next payment, amount paid to date, etc
439         - added function to bill any outstanding arrears in a billing agreement
440         - requires Date::Calc now
441
442 version 1.0.8 July 2010
443         - fixed bug in handling of multiple PP error messages
444
445 version 1.0.7 December 2009
446         - another variation in Canadian Province names has just come to light, whereby they sometimes send
447           the 2 letter code with periods, eg B.C. as well as BC. Thanks to Steve Graham for finding this
448         - patch to allow use of the [assign] tag in shipping
449         - patch to allow 'use_billing_override' to send billing addresses
450         - patch to display Long rather than Short PP error message to customers
451           Thanks to Josh Lavin for these last three
452         
453 version 1.0.6 September 2009
454         - added 'use strict' and fixed odd errors (and removed giropay vestiges that belong in next version)
455         - made itemdetails loop through basket properly
456         - added Fraud Management Filters return messages to optional charge parameters
457 version 1.0.5, June 2009
458         - fixed bug with Canadian provinces: PP were sending shortened versions of 2 province names, and also 
459           sometimes sending the 2 letter code (possibly from older a/cs) rather than the full name. Thanks to 
460           Steve Graham for finding this.
461 version 1.0.4, May 2009
462         - re-wrote documentation, including revised and simplified method of co-operating with other payment
463           systems in log_transaction. 
464
465 version 1.0.3, 1.02.2009
466         - fixed bug in handling of thousands separator
467
468 version 1.0.2, 22.01.2009 
469         - conversion of Canadian province names to 2 letter variant is now the default
470         - fixed bug with conversion of Canadian province names to 2 letter variant
471         - changed method of reading value of pprequest
472         - added failsafe logging to orders/paypal/ in case of order route failure
473         - fixed bug whereby PP returns billing name in a shipping address
474         - added note to docs re PP requiring cookie
475         - altered internal redirection code to better handle absence of cookies (thanks to Peter Ajamian for heads-up)
476         - altered docs to reflect the new sandbox (thanks to Josh Lavin for the heads-up on that)
477         - TODO: as the new API now includes a SOAP integration of recurring/subscription billing, need 
478                 to convert existing name=value pair IPN module and integrate into this module. Will add
479                 masspay, refund and other functions at the same time. 
480
481 version 1.0.1, 24.05.2008 
482         - added error message to IC session for when Paypal returns error message instead of token.
483         - added option to convert Canadian state/province names to an uppercased 2 letter variant, so
484             as to agree with Interchange's de facto requirement for this.
485 =back
486
487 =head1 AUTHORS
488
489 Lyn St George <info@zolotek.net>
490
491 =cut
492
493 BEGIN {
494         eval {
495                 package Vend::Payment;
496                 require SOAP::Lite or die __PACKAGE__ . " requires SOAP::Lite";
497 # without this next it defaults to Net::SSL which may crash
498                 require IO::Socket::SSL or die __PACKAGE__ . " requires IO::Socket::SSL";
499                 require Net::SSLeay;
500                 require LWP::UserAgent;
501                 require HTTP::Request;
502                 require Date::Calc or die __PACKAGE__ . " requires Date::Calc";
503                 use Date::Calc qw(Add_Delta_YMD Today Today_and_Now);
504                 use POSIX 'strftime';
505         };
506
507                 $Vend::Payment::Have_Net_SSLeay = 1 unless $@;
508
509         if ($@) {
510                 $msg = __PACKAGE__ . ' requires SOAP::Lite, IO::Socket::SSL and Date::Calc ' . $@;
511                 ::logGlobal ($msg);
512                 die $msg;
513         }
514
515         ::logGlobal("%s v1.1.6e 20151002 payment module loaded",__PACKAGE__)
516                 unless $Vend::Quiet or ! $Global::VendRoot;
517 }
518
519 package Vend::Payment;
520 #use SOAP::Lite +trace; # ### debugging only ###
521 use strict;
522
523     my (%result, $header, $service, $version, $xmlns, $currency);
524
525 sub paypalexpress {
526     my ($token, $request, $method, $response, $in, $opt, $actual, $basket, $itemCode, $tax, $invoiceID);
527         my ($item, $itm, $basket, $setrpbillagreement, $rpprofile, $db, $dbh, $sth, $noteText);
528
529         foreach my $x (@_) {
530                     $in = { 
531                                 pprequest => $x->{'pprequest'},
532                            }
533         }
534
535 #::logDebug("PP".__LINE__.": sandbox=$::Values->{ppsandbox} ". charge_param('sandbox'). "req=".charge_param('pprequest'));
536         my $pprequest   = charge_param('pprequest') || $::Values->{'pprequest'} || $in->{'pprequest'} || 'setrequest'; # 'setrequest' must be the default for standard Paypal. 
537         my $sandbox     = charge_param('sandbox') || $::Values->{'sandbox'} || $::Values->{'ppsandbox'} || ''; # 1 or true to use for testing
538            $sandbox     = '' unless $sandbox =~ /sandbox|1/;
539            $sandbox     = "sandbox." if $sandbox =~ /sandbox|1/;
540            $::Values->{'ppsandbox'} = $::Values->{'sandbox'} = '';
541            $::Scratch->{'mstatus'} = '';
542 #::logDebug("PP".__LINE__.": sandbox=$sandbox passwd=".charge_param('password')." sig=".charge_param('signature'));
543
544            $currency = $::Values->{'iso_currency_code'} || $::Values->{'currency_code'} || $::Scratch->{'iso_currency_code'}  || 
545                                    $Vend::Cfg->{'Locale'}{'iso_currency_code'} || charge_param('currency')  || $::Variable->{MV_PAYMENT_CURRENCY} || 'USD';
546            $::Scratch->{'iso_currency_code'} ||= $currency;
547
548 # Credentials, prefixed with lower-cased account name if using 'getbalance' for more than one account
549         my $account     = lc($pprequest) if $pprequest =~ /getbalance_/ || '';
550            $account     =~ s/getbalance_//;
551            $account     .= '_' if length $account;
552            $sandbox     = "sandbox." if $account =~ /sandbox/;
553     my ($username, $password, $signature);
554     if (length $sandbox && charge_param('sandbox_id')) {
555         $username   = charge_param('sandbox_id');
556         $password   = charge_param('sandbox_password');
557         $signature  = charge_param('sandbox_signature');
558                 }
559     else {
560         $username    = charge_param($account . 'id');
561         $password    = charge_param($account . 'password');
562         $signature   = charge_param($account . 'signature');
563     }
564     
565     unless ($username && $password && $signature) {
566          return (
567                         MStatus => 'failure-hard',
568                         MErrMsg => errmsg('Bad credentials'),
569                  );
570     }
571
572         my $ppcheckreturn = $::Values->{'ppcheckreturn'} || 'ord/checkout';
573         my $checkouturl = $::Tag->area({ href => "$ppcheckreturn" });
574 #::logDebug("PP".__LINE__.": req=$pprequest; sandbox=$sandbox;");
575 #::logDebug("PP".__LINE__.": pf=" . $Vend::Cfg->{'PriceField'} . " $::Scratch->{'PriceField'};  amt=" . Vend::Interpolate::total_cost() . "-" . charge_param('amount') ."-". $::Values->{'amount'});
576            $Vend::Cfg->{'PriceField'} = delete $::Scratch->{'PriceField'} if defined $::Scratch->{'PriceField'};
577 #::logDebug("PP".__LINE__.": pf=" . $Vend::Cfg->{'PriceField'} . " $::Scratch->{'PriceField'};  amt=" . Vend::Interpolate::total_cost() . "-" . charge_param('amount') ."-". $::Values->{'amount'});
578
579 #       my $amount =  charge_param('amount') || Vend::Interpolate::total_cost() || $::Values->{amount}; # required
580         my $amount =  charge_param('amount') || Vend::Interpolate::total_cost() || $::Values->{'amount'}; # required
581            $amount =~ s/^\D*//g;
582            $amount =~ s/\s*//g;
583            $amount =~ s/,//g;
584
585 # for a SET request
586         my $host               = charge_param('host') ||  'api-3t.paypal.com'; #  testing 3-token system is 'api-3t.sandbox.paypal.com'.
587            $host               = 'api-3t.sandbox.paypal.com' if length $sandbox;
588         my $ipnhost                        = 'www.paypal.com';
589            $ipnhost            = 'www.sandbox.paypal.com' if length $sandbox;
590         my $setordernumber     = charge_param('setordernumber') || '1'; # unset to revert to using a temp order number until order settled
591            $invoiceID          = $::Values->{'inv_no'} || $::Values->{'mv_transaction_id'} || $::Values->{'order_number'} || '' unless $setordernumber; # optional
592         my $ordercounter       = charge_param('order_counter') || 'etc/order.number';
593         my $returnURL          = charge_param('returnurl') or die "No return URL found\n"; # required
594         my $cancelURL          = charge_param('cancelurl') or die "No cancel URL found\n"; # required
595         my $notifyURL          = charge_param('notifyurl') || ''; # for IPN
596         my $maxAmount          = $::Values->{'maxamount'} || $amount * '2';  # optional
597            $maxAmount          = sprintf '%.2f', $maxAmount;
598         my $orderDescription   = '';
599         my $address            = '';
600         my $reqConfirmShipping = $::Values->{'reqconfirmshipping'} || charge_param('reqconfirmshipping') || ''; # you require that the customer's address must be "confirmed"
601         my $returnFMFdetails   = $::Values->{'returnfmfdetails'} || charge_param('returnfmfdetails') || '0'; # set '1' to return FraudManagementFilter details
602         my $noShipping         = $::Values->{'noshipping'} || charge_param('noshipping') || ''; # no shipping displayed on Paypal pages
603         my $addressOverride    = $::Values->{'addressoverride'} || charge_param('addressoverride') || ''; # if '1', Paypal displays address given in SET request, not the one on Paypal's file
604
605 # new style checkout 'co-branding' options
606         my $localeCode         = $::Values->{'localecode'} || $::Session->{'mv_locale'} || charge_param('localecode') || 'US';
607         my $pageStyle          = $::Values->{'pagestyle'} || charge_param('pagestyle') || ''; # set in Paypal account
608         my $headerImg          = $::Values->{'headerimg'} || charge_param('headerimg') || ''; # max 750x90, classic checkout, left-aligned, from your secure site
609         my $logoImg            = $::Values->{'logoimg'} || charge_param('logoimg') || ''; # max 190x60, 'new style checkout', centred in 'cart area', from your secure site
610         my $cartBorderColor    = $::Values->{'cartbordercolor'} || charge_param('cartbordercolor'); # hex code, without '#'
611         my $headerBorderColor  = $::Values->{'headerbordercolor'} || charge_param('headerbordercolor') || '';
612         my $headerBackColor    = $::Values->{'headerbackcolor'} || charge_param('headerbackcolor') || '';
613         my $payflowColor       = $::Values->{'payflowcolor'} || charge_param('payflowcolor') || '';
614
615         my $paymentAction      = $::Values->{'paymentaction'} || charge_param('paymentaction') || 'Sale'; # others: 'Order', 'Authorization'
616         my $buyerEmail         = $::Values->{'buyeremail'} || '';
617         my $custom             = $::Scratch->{'mv_currency'} || $::Scratch->{'mv_locale'}; 
618        $custom           ||= 'en_' . lc(substr($currency,0,1));
619 # these next taken from IC after customer has logged in, and used in '$addressOverride'
620         my $usebill  = $::Values->{'use_billing_override'} || charge_param('use_billing_override');
621         my $name     = $usebill ? "$::Values->{'b_fname'} $::Values->{'b_lname'}" || '' : "$::Values->{'fname'} $::Values->{'lname'}" || '';
622         my $address1 = $usebill ? $::Values->{'b_address1'} : $::Values->{'address1'};
623         my $address2 = $usebill ? $::Values->{'b_address2'} : $::Values->{'address2'};
624         my $city     = $usebill ? $::Values->{'b_city'} : $::Values->{'city'};
625         my $state    = $usebill ? $::Values->{'b_state'} : $::Values->{'state'};
626         my $zip      = $usebill ? $::Values->{'b_zip'} : $::Values->{'zip'};
627         my $country  = $usebill ? $::Values->{'b_country'} : $::Values->{'country'};
628            $country  = 'GB' if ($country eq 'UK'); # plonkers reject UK
629         my $phone    = $::Values->{'phone_day'} || $::Values->{'phone_night'};
630 #::logDebug("PP".__LINE__.": usebill=$usebill, name=$name, address1=$address1, city=$city");
631
632 # for a Do request, and Set with item details
633         my $dsmode            = $::Variable->{'DSMODE'}; # for any custom shipping tags
634         my $itemTotal     = $::Values->{'itemtotal'} || Vend::Interpolate::subtotal() || $::Session->{'ppitemTotal'} || '';
635            $itemTotal     = sprintf '%.2f', $itemTotal;
636         my $shipTotal     = $::Values->{'shiptotal'} || Vend::Interpolate::tag_shipping() || $::Session->{'ppshipTotal'} || '' unless  $::Variable->{'DSMODE'};
637            $shipTotal     = $::Tag->$dsmode() if $::Variable->{'DSMODE'};
638            $shipTotal     = sprintf '%.2f', $shipTotal;
639         my $taxTotal      = $::Values->{'taxtotal'} || Vend::Interpolate::salestax() || $::Session->{'pptaxTotal'} || '';
640            $taxTotal      = sprintf '%.2f', $taxTotal;
641         my $handlingTotal = $::Values->{'handlingtotal'} || Vend::Ship::tag_handling() || $::Session->{'pphandlingTotal'} || '';
642            $handlingTotal = sprintf '%.2f', $handlingTotal;
643
644         my $buttonSource        = $::Values->{'buttonsource'} || charge_param('buttonsource') || ''; # for third party source
645         my $paymentDetailsItem  = $::Values->{'paymentdetailsitem'} || charge_param('paymentdetailsitem') || ''; # set '1' to include item details
646         my $transactionID       = $::Values->{'transactionid'} || ''; # returned upon success, but not for recurring billing, only the correlationid
647         my $correlationID       = $::Values->{'correlationid'} || ''; # use for any dispute with Paypal
648         my $refundtransactionID = $::Values->{'refundtransactionid'} || ''; # log for reference
649         my $quantity            = $::Tag->nitems() || '1';
650
651         my $itemised_basket_off = delete $::Values->{'itemised_basket_off'} || charge_param('itemised_basket_off');
652
653 # if $paymentDetailsItem is set, then need to pass an item amount to keep Paypal happy
654         my $itemAmount   = $amount / $quantity;
655            $itemAmount   = sprintf '%.2f', $itemAmount;
656            $amount       = sprintf '%.2f', $amount;
657         my $receiverType = $::Values->{'receiverType'} || charge_param('receivertype') || 'EmailAddress'; # used in MassPay
658            $version      = '122.0'; # '97.0', '74.0';
659         my $order_id  = gen_order_id($opt);
660 #::logDebug("PP".__LINE__.": oid=$order_id; amount=$amount, itemamount=$itemAmount; tax=$taxTotal, ship=$shipTotal, hdl=$handlingTotal");
661
662 # new fields for v 1.1.0 and API v 74
663         my $softDescriptor    = $::Values->{'soft_descriptor'} || charge_param('soft_descriptor'); # appears on customer's card statement
664         my $sellerDetails     = $::Values->{'seller_details'} || charge_param('seller_details'); # will appear in eBay emails
665         my $allowNote         = $::Values->{'allow_note'} || charge_param('allow_note'); # allow customer to enter note at Paypal
666         my $brandName         = $::Values->{'brand_name'} || charge_param('brand_name'); # max 127 chars, over-rides the business name at Paypal
667         my $servicePhone      = $::Values->{'service_phone'} || charge_param('service_phone'); # displayed to customer
668         my $giftMessageEnable = $::Values->{'gift_message_enable'} || charge_param('gift_message_enable'); # 0 or 1
669         my $giftReceiptEnable = $::Values->{'gift_receipt_enable'} || charge_param('gift_receipt_enable'); # 0 or 1
670         my $giftWrapEnable    = $::Values->{'gift_wrap_enable'} || charge_param('gift_wrap_enable'); # 0 or 1
671         my $giftWrapName      = $::Values->{'gift_wrap_name'}; 
672         my $giftWrapAmount    = $::Values->{'gift_wrap_amount'};
673         my $buyerEmailOptin   = $::Values->{'buyer_email_optin'} || charge_param('buyer_email_optin');  # 0 or 1
674         my $surveyEnable      = $::Values->{'survey_enable'} || charge_param('survey_enable'); # 0 or 1
675         my $surveyQuestion    = $::Values->{'survey_question'} || charge_param('survey_question');
676         my $surveyChoice      = $::Values->{'survey_choice'} || charge_param('survey_choice');
677         my $allowPushFunding  = $::Values->{'allow_push_funding'} || charge_param('allow_push_funding'); # 0 or `
678         my $allowedPayMethod  = $::Values->{'allowed_payment_method'} || charge_param('allowed_payment_method'); #
679         my $landingPage       = $::Values->{'landing_page'} || charge_param('landing_page');
680         my $solutionType      = $::Values->{'solution_type'} || charge_param('solution_type');
681         my $totalType         = $::Values->{'total_type'} || charge_param('total_type') || 'EstimatedTotal'; # or 'Total' if is known accurately
682         
683         my $errordisplayoff   = charge_param('errordisplayoff') || '';
684
685
686
687         # for Giropay
688         my $giropaySuccessURL = $::Values->{'giropay_success_url'} || charge_param('giropay_success_url');
689         my $giropayCancelURL  = $::Values->{'giropay_cancel_url'} || charge_param('giropay_cancel_url');
690         my $BanktxnPendingURL = $::Values->{'bnktxn_pending_url'} || charge_param('bnktxn_pending_url');
691         my $giropayaccepted   = $::Values->{'giropay_accepted'} || charge_param('giropay_accepted') || '1';
692         my $giropayurl        = "https://www." . $sandbox . "paypal.com/cgi-bin/webscr?cmd=_complete-express-checkout";
693
694 #-----------------------------------------------------------------------------------------------
695         # for operations through the payment terminal, eg 'masspay', 'refund' etc
696         my  $refundType    = $::Values->{'refundtype'} || 'Full'; # either 'Full' or 'Partial'
697         my  $memo          = $::Values->{'memo'} || '';
698         my  $orderid       = $::Values->{'mv_order_id'} || '';
699         my  $emailSubject  = $::Values->{'emailsubject'} || ''; # subject line of email
700         my  $receiverEmail = $::Values->{'receiveremail'} || ''; # address of refund recipient
701
702
703         $xmlns = 'urn:ebay:api:PayPalAPI';
704
705             $service = SOAP::Lite->proxy("https://$host/2.0/")->uri($xmlns);
706             # Ignore the paypal typecasting returned
707             *SOAP::Deserializer::typecast = sub {shift; return shift};
708
709 #-------------------------------------------------------------------------------------------------
710 ### Create the Security Header
711 #
712             $header = SOAP::Header->name("RequesterCredentials" =>
713                                         \SOAP::Header->value(
714                                                 SOAP::Data->name("Credentials" =>
715                                                         \SOAP::Data->value(
716                                                                 SOAP::Data->name("Username" => $username )->type("xs:string"),
717                                                                 SOAP::Data->name("Password" => $password )->type("xs:string"),
718                                                                 SOAP::Data->name("Signature" => $signature)->type("xs:string")
719                                                         )
720                                                 )
721                                                  ->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})
722                                         )
723                                 )
724                                  ->attr({xmlns=>$xmlns})->mustUnderstand("1");
725
726
727 #--------------------------------------------------------------------------------------------------
728 ### Create a SET request and method, and read response
729 #
730         my ($item,$itm,@pditems,@pdi,$pdi,$pdiamount,$itemtotal,$pdisubtotal,$cntr,$pditotalamount,$rpamount,$itemname,$itemdesc);
731
732         if ($pprequest eq 'setrequest') {
733           if (charge_param('setordernumber') == '1') {
734                   $invoiceID = $::Values->{'inv_no'} || Vend::Interpolate::tag_counter( $ordercounter );
735                   $::Values->{'mv_order_number'} = $::Session->{'mv_order_number'} = $invoiceID;
736                   $::Scratch->{'ordernumberalreadyset'} = '1';
737           }
738
739 # start with required elements, add optional elements if they exist
740                    my @setreq = (
741                                        SOAP::Data->name("ReturnURL" => $returnURL)->type(""),
742                                        SOAP::Data->name("CancelURL" => $cancelURL)->type(""),
743                                                 );
744                 push @setreq,  SOAP::Data->name("ReqConfirmShipping" => $reqConfirmShipping)->type("xs:string") if $reqConfirmShipping;
745                 push @setreq,  SOAP::Data->name("NoShipping" => $noShipping)->type("xs:string") if $noShipping;
746                 push @setreq,  SOAP::Data->name("AddressOverride" => $addressOverride)->type("xs:string") if $addressOverride;
747                 push @setreq,  SOAP::Data->name("PageStyle" => $pageStyle)->type("xs:string") if $pageStyle;
748                 push @setreq,  SOAP::Data->name("BuyerEmail" => $buyerEmail)->type("xs:string") if $buyerEmail;
749                 push @setreq,  SOAP::Data->name("cpp-header-image" => $headerImg)->type("xs:string") if $headerImg;
750                 push @setreq,  SOAP::Data->name("cpp-logo-image" => $logoImg)->type("xs:string") if $logoImg;
751                 push @setreq,  SOAP::Data->name("cpp-header-border-color" => $headerBorderColor)->type("xs:string") if $headerBorderColor;
752                 push @setreq,  SOAP::Data->name("cpp-header-back-color" => $headerBackColor)->type("xs:string") if $headerBackColor;
753                 push @setreq,  SOAP::Data->name("cpp-payflow-color" => $payflowColor)->type("xs:string") if $payflowColor;
754                 push @setreq,  SOAP::Data->name("cpp-cart-border-color" => $cartBorderColor)->type("xs:string") if $cartBorderColor;
755                 push @setreq,  SOAP::Data->name("LandingPage" => $landingPage)->type("") if $landingPage;
756                 push @setreq,  SOAP::Data->name("SolutionType" => $solutionType)->type("") if $solutionType;
757                 push @setreq,  SOAP::Data->name("MaxAmount" => $maxAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $maxAmount;
758                 push @setreq,  SOAP::Data->name("CustomerServiceNumber" => $servicePhone)->type("xs:string") if $servicePhone;
759                 push @setreq,  SOAP::Data->name("GiftMessageEnable" => $giftMessageEnable)->type("xs:string") if $giftMessageEnable; # 0 or 1
760                 push @setreq,  SOAP::Data->name("GiftReceiptEnable" => $giftReceiptEnable)->type("xs:string") if $giftReceiptEnable; # 0 or 1
761                 push @setreq,  SOAP::Data->name("GiftWrapEnable" => $giftWrapEnable)->type("xs:string") if $giftWrapEnable; # 0 or 1
762                 push @setreq,  SOAP::Data->name("GiftWrapName" => $giftWrapName)->type("xs:string") if $giftWrapName; # 25 chars
763                 push @setreq,  SOAP::Data->name("GiftWrapAmount" => $giftWrapAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $giftWrapAmount;
764                 push @setreq,  SOAP::Data->name("BuyerEmailOptinEnable" => $buyerEmailOptin)->type("xs:string") if $buyerEmailOptin; # 0 or 1
765                 push @setreq,  SOAP::Data->name("SurveyEnable" => $surveyEnable)->type("xs:string") if $surveyEnable; # 0 or 1
766                 push @setreq,  SOAP::Data->name("SurveyQuestion" => $surveyQuestion)->type("xs:string") if $surveyQuestion; # max 50 chars
767                 push @setreq,  SOAP::Data->name("SurveyChoice" => $surveyChoice)->type("xs:string") if $surveyChoice; # max 15 chars
768                 push @setreq,  SOAP::Data->name("LocaleCode" => $localeCode)->type("xs:string") if $localeCode;
769                 push @setreq,  SOAP::Data->name("AllowNote" => $allowNote)->type("xs:string") if defined $allowNote; # 0 or 1
770
771 #               push @setreq,  SOAP::Data->name("TotalType" => $totalType)->type("") if $totalType; # ### crashes ... ###
772
773
774 ::logDebug("PP".__LINE__.": itemTotal=$itemTotal; taxTotal=$taxTotal");
775
776 # now loop through the basket and put every item into iterated PaymentDetailsItem blocks, and 
777 # recurring payments items into iterated BillingAgreeement blocks. Explicit arrays not needed.
778
779                   foreach  $item (@{$::Carts->{'main'}}) {
780                         my $rpamount_field = 'rpamount_' . lc($currency) || 'rpamount';
781                           $itm = {
782                                           sku => $item->{'code'},
783                                           quantity => $item->{'quantity'},
784                                           amount => Vend::Data::item_price($item),
785                                           title => Vend::Data::item_field($item, 'title'),
786                                           description => Vend::Data::item_field($item, 'description'),
787                                           comment => Vend::Data::item_field($item, 'comment'),
788                                           rpamount => Vend::Data::item_field($item, 'rpamount'),
789                                           rpamount_field => Vend::Data::item_field($item, $rpamount_field),
790                                           };
791
792                         $itm->{'title'} = _pplocfilter( $itm->{'title'} );
793                         $itm->{'comment'} = _pplocfilter( $itm->{'comment'} );
794                         $itm->{'description'} = _pplocfilter( $itm->{'description'} );
795                         $itemname = $itm->{'title'} || $itm->{'description'};
796                         $itemname = _ppxmlfilter( $itemname );
797                         $itemname = substr($itemname,0,126);
798
799                         $itemdesc = $itm->{'description'} if $itm->{'title'};
800                         $itemdesc = $itm->{'comment'} unless $itm->{'title'};
801                         $itemdesc = _ppxmlfilter( $itemdesc );
802                         $itemdesc = substr($itemdesc,0,126);
803
804                         $pdiamount = $itm->{'amount'};
805                         $pdiamount = sprintf '%.02f', $pdiamount;
806                         $pdisubtotal = $pdiamount * $itm->{'quantity'};
807 #::logDebug("PP".__LINE__.": pdi: sku=$itm->{sku}, desc=$itm->{description}, qty=$itm->{quantity}; amt=$itm->{amount}; rpamt=$itm->{rpamount}; fld=$rpamount_field; cur=$currency; payact=$paymentAction");
808
809                     $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
810           if ($rpamount) {
811 #::logDebug("PP".__LINE__.": cntr=$cntr;  rpamount=$rpamount"); 
812
813             $setrpbillagreement = (
814                                            SOAP::Data->name("BillingAgreementDetails" =>
815                                            \SOAP::Data->value(
816                                             SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),
817                                                 SOAP::Data->name("BillingAgreementDescription" => $itm->{'description'})->type(""),
818                                                       )
819                                                     )->type("ns:BillingAgreementDetailsType"),
820                                                 );
821
822                   if ($cntr > '9') {
823                         $::Session->{'errors'}{'Paypal'} = "Paypal will not accept more than ten subscriptions in one order - please remove some and purchase them in
824                         a second order";
825                         return();
826                   };
827           $cntr++;
828         
829         $::Scratch->{'allowzeroamount'} = '1'; # use in log_transaction
830         push @setreq, $setrpbillagreement;
831
832           } # if RecPay item in basket loop
833 #
834 # Finished with BillingAgreeements, now for PaymentDetailsItem in basket loop
835 # Separate block for each item: also include those which are RecPay items
836 #
837                           $pditotalamount += $pdisubtotal; # to overcome rounding errors in currency conversions
838 ::logDebug("PP".__LINE__.":amt=$amount; pditotalamount=$pditotalamount; pdiamount=$pdiamount");
839
840                        @pdi = SOAP::Data->name("Name" => $itemname)->type("");
841               push @pdi, SOAP::Data->name("Amount" => $pdiamount)->attr({"currencyID" => $currency})->type("");
842               push @pdi, SOAP::Data->name("Number" => $itm->{'sku'})->type("");
843               push @pdi, SOAP::Data->name("Description" => $itemdesc)->type("");
844               push @pdi, SOAP::Data->name("Quantity" => $itm->{'quantity'})->type("") if $itm->{'quantity'};
845               push @pdi, SOAP::Data->name("ItemWeight" => $itm->{'weight'})->type("") if $itm->{'weight'};
846               push @pdi, SOAP::Data->name("ItemWidth" => $itm->{'width'})->type("") if $itm->{'width'};
847               push @pdi, SOAP::Data->name("ItemLength" => $itm->{'length'})->type("") if $itm->{'length'};
848               push @pdi, SOAP::Data->name("ItemHeight" => $itm->{'height'})->type("") if $itm->{'height'};
849               push @pdi, SOAP::Data->name("ItemURL" => $itm->{'murl'})->type("") if $itm->{'url'};
850               push @pdi, SOAP::Data->name("ItemCategory" => $itm->{'category'})->type("") if $itm->{'category'}; # required as 'Digital' for digital goods, else optional as 'Physical'
851
852                  $pdi  = (
853                         SOAP::Data->name("PaymentDetailsItem" =>
854                         \SOAP::Data->value(
855                                           @pdi,
856                             )
857                           )->type("ebl:PaymentDetailsItemType"),
858                         );
859
860                   push @pditems, $pdi unless length $rpamount;
861                         $cntr++;
862           } # foreach item in basket
863
864 #
865 # Finished basket loop for each item, now for PaymentDetails
866 #
867 ::logDebug("PP".__LINE__.": vship=$::Values->{'shiptotal'}; tag=" .Vend::Interpolate::tag_shipping());
868 # calculate here so as to avoid rounding errors and rejection at Paypal
869         my $itemtotal     = $pditotalamount;
870            $itemtotal     = sprintf '%.2f', $itemtotal;
871            $::Session->{'ppitemTotal'} = $itemtotal;
872         my $shiptotal     = $::Values->{'shiptotal'} || Vend::Interpolate::tag_shipping() || '' unless  $::Variable->{'DSMODE'};
873            $shiptotal     = $::Tag->$dsmode() if $::Variable->{'DSMODE'};
874            $shiptotal     = sprintf '%.2f', $shiptotal;
875            $::Session->{'ppshipTotal'} = $shiptotal;
876         my $handlingtotal = $::Values->{'handlingtotal'} || Vend::Ship::tag_handling() || '';
877            $handlingtotal = sprintf '%.2f', $handlingtotal;
878            $::Session->{'pphandlingTotal'} = $handlingtotal;
879         my $taxtotal      = $::Values->{'taxtotal'} || Vend::Interpolate::salestax() || '';
880            $taxtotal      = sprintf '%.2f', $taxtotal;
881            $::Session->{'pptaxTotal'} = $taxtotal;
882 ::logDebug("PP".__LINE__.": tax=$::Values->{taxtotal}; ". Vend::Interpolate::salestax());
883            $amount = $itemtotal + $shiptotal + $taxtotal + $handlingtotal;
884
885            my $shiptoaddress = (
886                        SOAP::Data->name("ShipToAddress" =>
887                        \SOAP::Data->value(
888                         SOAP::Data->name("Name" => $name)->type(""),
889                         SOAP::Data->name("Street1" => $address1)->type(""),
890                         SOAP::Data->name("Street2" => $address2)->type(""),
891                         SOAP::Data->name("CityName" => $city)->type(""),
892                         SOAP::Data->name("StateOrProvince" => $state)->type(""),
893                         SOAP::Data->name("PostalCode" => $zip)->type(""),
894                         SOAP::Data->name("Country" => $country)->type(""),
895                         SOAP::Data->name("Phone" => $phone)->type(""),
896                             )
897                           )
898                         ) if length $address1;
899
900                 my @pd =  SOAP::Data->name("OrderTotal" => $amount)->attr({"currencyID" => $currency})->type('');
901                 push @pd, SOAP::Data->name("ItemTotal" => $itemtotal)->attr({"currencyID" => $currency})->type("") if $itemtotal;
902                 push @pd, SOAP::Data->name("TaxTotal" => $taxtotal)->attr({"currencyID" => $currency})->type("") if $taxtotal;
903                 push @pd, SOAP::Data->name("ShippingTotal" => $shiptotal)->attr({"currencyID" => $currency})->type("") if $shiptotal;
904                 push @pd, SOAP::Data->name("HandlingTotal" => $handlingtotal)->attr({"currencyID" => $currency})->type("") if $handlingtotal;
905                 push @pd, SOAP::Data->name("InvoiceID" => $invoiceID)->type("") if length $invoiceID;
906                 push @pd, SOAP::Data->name("NotifyURL" => $notifyURL)->type("") if $notifyURL;
907                 push @pd, SOAP::Data->name("Custom" => $custom)->type("") if $custom;
908 #               push @pd, SOAP::Data->name("TransactionID" => $order_id)->type(""); # ###
909                 push @pd, $shiptoaddress if length $addressOverride;
910                 
911                 my $discount = $Vend::Session->{discount} || '';
912 ::logDebug("PP:".__LINE__." discount=$discount " . ::uneval($discount));
913
914 #
915 # discounts are not shown at paypal
916 #
917                 push @pd, @pditems unless $itemised_basket_off == '1' or length $discount;
918 #::logDebug("PP".__LINE__.": ppdiscnote=$::Values->{pp_discount_note}; note=$::Values->{pp_note_to_buyer}");
919                 my $note_to_buyer = $::Values->{'pp_discount_note'};
920                  push @pd, SOAP::Data->name("NoteToBuyer" => $note_to_buyer)->type("") if length $note_to_buyer;
921                 $::Values->{'pp_discount_note'} = '';
922                 push @pd, SOAP::Data->name("OrderDescription" => $note_to_buyer)->type("") if $custom;
923 #
924 # neither NoteToBuyer nor OrderDescription show at the new-style dumbed-down paypal splash page ...
925 #
926
927         my $paymentDetails = (
928                         SOAP::Data->name("PaymentDetails" =>
929                         \SOAP::Data->value(
930                                         @pd,
931                                         )
932                                   )->type(""),
933                                 );
934
935           push @setreq, $paymentDetails;
936           push @setreq, SOAP::Data->name("BrandName" => $brandName)->type("") if $brandName;
937
938
939                                                         
940         my ($bt,$rpdesc,$rpAgreementAmount,$rpStartDate);                                               
941
942 # rpStartDate > dateTime
943         my @maxrpamt;
944         my @setrpbill;
945         my $cntr = '0';
946
947 #::logDebug("PP".__LINE__.": setreq=".::uneval(@setreq)); # ### NOTE 
948
949 # Destroy the token here at the start of a new request, rather than after a 'dorequest' has completed,
950 # as Paypal use it to reject duplicate payments resulting from clicking the final 'pay' button more
951 # than once.
952   
953    undef $result{'Token'};
954
955                 $request = SOAP::Data->name("SetExpressCheckoutRequest" =>
956                                 \SOAP::Data->value(
957                                  SOAP::Data->name("Version" => $version)->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
958                                  SOAP::Data->name("SetExpressCheckoutRequestDetails" =>
959                                  \SOAP::Data->value(@setreq
960                                        )
961                                      ) ->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
962                                )
963                              );
964
965             $method = SOAP::Data->name('SetExpressCheckoutReq')->attr({xmlns=>$xmlns});
966             $response = $service->call($header, $method => $request);
967
968       my $result_hashref = $response->valueof('//SetExpressCheckoutResponse');
969       unless ($result_hashref) {
970           $Tag->error({ name => 'paypal_failure', set => errmsg('Unable to parse the PayPal response') });
971           return $Tag->deliver({ location => $checkouturl });
972       }
973             %result = %$result_hashref;
974                 $::Scratch->{'token'} = $result{'Token'};
975 #::logDebug("PP".__LINE__.": result= ".::uneval(%result)); # ### NOTE  
976    if (!$result{'Token'}) {
977     if ($result{'Ack'} eq 'Failure') {
978                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
979                         for my $i (0 .. 3) {
980                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
981                                         }
982                          }
983     else {
984        my $accepted = uc($::Variable->{CREDIT_CARDS_ACCEPTED});
985        $::Session->{'errors'}{'PaypalExpress'} = errmsg("Paypal is currently unavailable - please use our secure payment system instead. We accept $accepted cards");
986              }
987            return $Tag->deliver({ location => $checkouturl }) 
988       }
989
990 #::logDebug("PP".__LINE__.": sandbox=$sandbox; host=$host");
991 # Now go off to Paypal
992   my $redirecturl = "https://www."."$sandbox"."paypal.com/cgi-bin/webscr?cmd=_express-checkout&token=$result{Token}";
993
994 return $Tag->deliver({ location => $redirecturl }); 
995
996    }
997
998
999 #--------------------------------------------------------------------------------------------------
1000 ### Create a GET request and method, and read response
1001 #
1002  elsif ($pprequest eq 'getrequest') {
1003             $request = SOAP::Data->name("GetExpressCheckoutDetailsRequest" =>
1004                          \SOAP::Data->value(
1005                           SOAP::Data->name("Version" => $version)->type("xs:string"),
1006                          SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string")
1007                          )
1008                    ) ->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"});
1009              $method = SOAP::Data->name('GetExpressCheckoutDetailsReq')->attr({xmlns => $xmlns});
1010              $response = $service->call($header, $method => $request);
1011                  %result = %{$response->valueof('//GetExpressCheckoutDetailsResponse')};
1012 #::logDebug("PP".__LINE__.": Get Ack=$result{Ack}");
1013
1014 # populate the billing address rather than shipping address when the basket is being shipped to
1015 # another address, eg it is a wish list.
1016           if (($result{'Ack'} eq "Success") and ($::Values->{'pp_use_billing_address'} == 1)) {
1017                 $::Values->{'b_phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'};
1018                 $::Values->{'email'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
1019                 $::Values->{'payerid'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
1020                 $::Values->{'payerstatus'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
1021                 $::Values->{'payerbusiness'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
1022             $::Values->{'salutation'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
1023             $::Values->{'b_fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
1024             $::Values->{'mname'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
1025             $::Values->{'b_lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
1026             $::Values->{'suffix'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
1027             $::Values->{'address_status'}   = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
1028             $::Values->{'b_name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'PayerName'};
1029             $::Values->{'b_address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
1030             $::Values->{'b_address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
1031             $::Values->{'b_city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
1032             $::Values->{'b_state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
1033             $::Values->{'b_zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
1034             $::Values->{'b_country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1035             $::Values->{'countryname'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
1036                 $::Values->{'country'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1037                       }
1038
1039           elsif ($result{'Ack'} eq "Success") {
1040             $::Values->{'phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'} || $::Values->{phone_day} || $::Values->{phone_night};
1041                 $::Values->{'payerid'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
1042                 $::Values->{'payerstatus'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
1043                 $::Values->{'payerbusiness'}  = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
1044             $::Values->{'salutation'}     = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
1045             $::Values->{'suffix'}         = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
1046             $::Values->{'address_status'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
1047           if ($addressOverride != '1') {
1048                 $::Values->{'email'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
1049             $::Values->{'fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
1050             $::Values->{'mname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
1051             $::Values->{'lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
1052             $::Values->{'name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Name'};
1053             $::Values->{'address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
1054             $::Values->{'address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
1055             $::Values->{'city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
1056             $::Values->{'state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
1057             $::Values->{'zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
1058             $::Values->{'countryname'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
1059                 $::Values->{'country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1060                       }
1061                    }
1062                    
1063                 $::Values->{'gift_note'}   = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PaymentDetails'}{'NoteText'};
1064  
1065                    
1066                 $::Values->{'company'} = $::Values->{'b_company'} = $::Values->{'payerbusiness'};
1067                 $::Values->{'giropaytrue'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'RedirectRequired'};
1068
1069 #::logDebug("PP".__LINE__.": on=$::Values->{mv_order_number}");
1070                 $invoiceID = $::Session->{'mv_order_number'} = $::Values->{'mv_order_number'} = $result{'Custom'} unless ($::Values->{'mv_order_number'} || $invoiceID);
1071
1072 # If shipping address and name are chosen at Paypal to be different to the billing address/name, then {name} contains           
1073 # the shipping name but {fname} and {lname} still contain the billing names.
1074 ### In this case the returned 'name' may be a company name as it turns out, so what should we do?
1075    if (($::Values->{'fname'} !~ /$::Values->{'name'}/) and ($::Values->{'name'} =~ /\s/)) {
1076        $::Values->{'name'} =~ /(\S*)\s+(.*)/;
1077        $::Values->{'fname'} = $1;
1078        $::Values->{'lname'} = $2;
1079     }
1080                 
1081                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1082                         for my $i (0 .. 3) {
1083                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1084                         }
1085    
1086        $country = $::Values->{'country'} || $::Values->{'b_country'};
1087        $state = $::Values->{'state'} || $::Values->{'b_state'};
1088        $state =~ s/\.\s*//g; # yet another variation for Canadian Provinces includes periods, eg B.C. (waiting for B. C.)
1089
1090 # Remap Canadian provinces rather than lookup the db, as some Paypal names are incomplete wrt the official names. 
1091 # It seems that some PP accounts, possibly older ones, send the 2 letter abbreviation rather than the full name.
1092         if ($country eq 'CA') {         
1093                 $state = 'AB' if ($state =~ /Alberta|^AB$/i);
1094                 $state = 'BC' if ($state =~ /British Columbia|^BC$/i);
1095                 $state = 'MB' if ($state =~ /Manitoba|^MB$/i);
1096                 $state = 'NB' if ($state =~ /New Brunswick|^NB$/i);
1097                 $state = 'NL' if ($state =~ /Newfoundland|^NL$/i);
1098                 $state = 'NS' if ($state =~ /Nova Scotia|^NS$/i);
1099                 $state = 'NT' if ($state =~ /Northwest Terr|^NT$/i);
1100                 $state = 'NU' if ($state =~ /Nunavut|^NU/i);
1101                 $state = 'ON' if ($state =~ /Ontario|^ON$/i);
1102                 $state = 'PE' if ($state =~ /Prince Edward|^PE$/i);
1103                 $state = 'QC' if ($state =~ /Quebec|^QC$/i);
1104                 $state = 'SK' if ($state =~ /Saskatchewan|^SK$/i);
1105                 $state = 'YT' if ($state =~ /Yukon|^YT$/i);
1106         }
1107         
1108         $::Values->{'b_state'} = $state if ($::Values->{'pp_use_billing_address'} == 1);
1109         $::Values->{'state'} = $state;
1110   
1111   }
1112
1113 #------------------------------------------------------------------------------------------------
1114 ### Create a Do request and method, and read response. Not used for Giropay
1115 #
1116  elsif ($pprequest =~ /dorequest|modifyrp/) {
1117      #  $currency = 'EUR'; # set to currency different to that started with to force failure for testing
1118                         $invoiceID = ($::Values->{'mv_order_number'} || $::Values->{'order_number'}) unless $invoiceID;
1119                         
1120 # To further handle rounding errors with discounts, using values put in session during 'setrequest'
1121            my $orderTotal = $itemTotal + $shipTotal + $handlingTotal + $taxTotal;
1122
1123 ::logDebug("PP".__LINE__.":invID=$invoiceID; on=$::Values->{mv_order_number}; total=$amount, $orderTotal, itemtotal=$itemTotal, shiptot=$shipTotal,handTot=$handlingTotal,taxtot=$taxTotal");
1124
1125            my @pd  = (
1126                                      SOAP::Data->name("OrderTotal" => $orderTotal )->attr({"currencyID" => $currency})->type(""),
1127                                      SOAP::Data->name("ItemTotal" => $itemTotal )->attr({"currencyID" => $currency})->type(""),
1128                                      SOAP::Data->name("ShippingTotal" => $shipTotal )->attr({"currencyID" => $currency})->type(""),
1129                                      SOAP::Data->name("HandlingTotal" => $handlingTotal )->attr({"currencyID" => $currency})->type(""),
1130                                      SOAP::Data->name("TaxTotal" => $taxTotal )->attr({"currencyID" => $currency})->type(""),
1131                                      SOAP::Data->name("InvoiceID" => $invoiceID )->type(""),
1132                      );
1133
1134         my @sta  = (
1135                     SOAP::Data->name("ShipToAddress" =>
1136                     \SOAP::Data->value(
1137                      SOAP::Data->name("Name" => $name)->type("xs:string"),
1138                      SOAP::Data->name("Street1" => $address1)->type("xs:string"),
1139                      SOAP::Data->name("Street2" => $address2)->type("xs:string"),
1140                      SOAP::Data->name("CityName" => $city)->type("xs:string"),
1141                      SOAP::Data->name("StateOrProvince" => $state)->type("xs:string"),
1142                      SOAP::Data->name("PostalCode" => $zip)->type("xs:string"),
1143                      SOAP::Data->name("Country" => $country)->type("xs:string")
1144                          )
1145                        )
1146                      );
1147
1148                   my ($item,$itm,@pdi,$pdiamount,$pditax);
1149 # ### FIXME what is the point of sending item details here???? Because the API says must send here if sent in the 'set' request ...
1150                 if (($itemTotal > '0') and ($taxTotal > '0')) {
1151                   foreach  $item (@{$::Carts->{'main'}}) {
1152                           $itm = {
1153                                           number => $item->{'code'},
1154                                           quantity => $item->{'quantity'},
1155                                           description => Vend::Data::item_description($item),
1156                                           amount => Vend::Data::item_price($item),
1157                                           comment => Vend::Data::item_field($item, 'comment'),
1158                                           tax => (Vend::Data::item_price($item)/$itemTotal * $taxTotal),
1159                                           rpAmount => Vend::Data::item_field($item, 'rpamount'),
1160                                           };
1161   
1162                           $pdiamount = sprintf '%.02f', $itm->{'amount'};
1163                           $pditax = sprintf '%.02f', $itm->{'tax'};
1164                           
1165                         $itemname = $itm->{'title'} || $itm->{'description'};
1166                         $itemname = _ppxmlfilter( $itemname );
1167                         $itemname = substr($itemname,0,126);
1168
1169
1170                 my $pdi  = (
1171                         SOAP::Data->name("PaymentDetailsItem" =>
1172                         \SOAP::Data->value(
1173                          SOAP::Data->name("Name" => $itemname)->type("xs:string"),
1174                          SOAP::Data->name("Amount" => $pdiamount)->attr({"currencyID" => $currency})->type("xs:string"),
1175                          SOAP::Data->name("Number" => $itm->{'number'})->type("xs:string"),
1176                          SOAP::Data->name("Quantity" => $itm->{'quantity'})->type("xs:string"),
1177                          SOAP::Data->name("Tax" => $pditax)->type("xs:string")
1178                             )
1179                           )->type("ebl:PaymentDetailsItemType")
1180                         );
1181           push @pdi, $pdi unless $itm->{'rpAmount'} > '0';
1182           }
1183     }
1184 #----------------------------------
1185
1186         my ($shipAddress, $billAddress, $payerInfo, @schedule, $nonrp);
1187         my $cntr = '0';
1188         my $rpamount_field = 'rpamount_' . lc($currency) || 'rpamount';
1189         my $rptrialamount_field = 'rptrialamount_' . lc($currency) || 'rptrialamount';
1190         my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
1191
1192         foreach  $item (@{$::Carts->{'main'}}) {
1193             $itm = {
1194                                 rpamount_field => Vend::Data::item_field($item, $rpamount_field),
1195                                 rpamount => Vend::Data::item_field($item, 'rpamount'),
1196                         amount => Vend::Data::item_price($item),
1197                                 description => Vend::Data::item_field($item, 'description'),
1198                                 };
1199
1200
1201    $basket .= <<EOB;
1202    Item = $itm->{code}, "$itm->{rpDescription}"; Price = $itm->{price}; Qty = $itm->{quantity}; Subtotal = $itm->{subtotal} 
1203 EOB
1204
1205           my ($dorecurringbilling, $cntr);
1206           my $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
1207                  $nonrp = '1' if (! $rpamount); # only run Do request if have standard purchase as well
1208           if ($rpamount) {
1209 #               $cntr++;
1210 #::logDebug("PP".__LINE__.": cntr=$cntr; initamount=$itm->{initAmount}; rpAmount=$itm->{rpAmount}; trialAmount=$itm->{trialAmount}");   
1211             $dorecurringbilling = (
1212                                            SOAP::Data->name("BillingAgreementDetails" =>
1213                                            \SOAP::Data->value(
1214                                             SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),
1215                                                 SOAP::Data->name("BillingAgreementDescription" => $itm->{'description'})->type(""),
1216                                                       )
1217                                                     )->type("ns:BillingAgreementDetailsType"),
1218                                                 );
1219                 $cntr++;
1220                 push @pd, $dorecurringbilling;
1221           }
1222                                            
1223         };      
1224
1225                 push @pd, SOAP::Data->name("Custom" => $custom )->type("xs:string") if $custom;
1226                 push @pd, SOAP::Data->name("NotifyURL" => $notifyURL )->type("xs:string") if $notifyURL;
1227                 push @pd, SOAP::Data->name("NoteText" => delete $::Values->{'gift_note'})->type('') if $::Values->{'gift_note'};
1228                 push @pd, @sta if $addressOverride  == '1';
1229 # ###           push @pd, @pdi if $paymentDetailsItem == '1';# and ($itemTotal > '0')); 
1230 # ### NOTE problems with discounts and totals not adding up if PaymentDetailsItems are sent.
1231
1232         my $pd = (      SOAP::Data->name("PaymentDetails" =>
1233                                  \SOAP::Data->value( @pd
1234                                      ),
1235                                )->type(""),
1236                                 );
1237
1238         my @doreq = (    SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string"),
1239                          SOAP::Data->name("PaymentAction" => $paymentAction)->type(""),
1240                          SOAP::Data->name("PayerID" => $::Values->{'payerid'} )->type("xs:string"),
1241                         );
1242 # ###           push @doreq, SOAP::Data->name("ReturnFMFDetails" => '1' )->type("xs:boolean") if $returnFMFdetails == '1'; # ### crashes
1243 # ###           push @doreq, SOAP::Data->name("GiftMessage" => $giftMessage)->type("xs:string") if $giftMessage;
1244                 push @doreq, SOAP::Data->name("GiftReceiptEnable" => $giftReceiptEnable)->type("xs:string") if $giftReceiptEnable; # true | false
1245                 push @doreq, SOAP::Data->name("GiftWrapName" => $giftWrapName)->type("xs:string") if $giftWrapName; # 25 chars
1246                 push @doreq, SOAP::Data->name("GiftWrapAmount" => $giftWrapAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $giftWrapAmount;
1247                 push @doreq, SOAP::Data->name("ButtonSource" => $buttonSource )->type("xs:string") if $buttonSource;
1248                 push @doreq, SOAP::Data->name("SoftDescriptor" => $softDescriptor)->type('') if $softDescriptor;
1249                 push @doreq, SOAP::Data->name("SellerDetails" => $sellerDetails)->type('') if $sellerDetails;
1250
1251                 push @doreq, $pd;
1252
1253             $request = SOAP::Data->name("DoExpressCheckoutPaymentRequest" =>
1254                                \SOAP::Data->value(
1255                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type("xs:string"),
1256                                 SOAP::Data->name("DoExpressCheckoutPaymentRequestDetails" =>
1257                                 \SOAP::Data->value(
1258                                         @doreq,
1259                              ),
1260                            )->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"}),
1261                          ),
1262                    );
1263
1264         if (($nonrp == '1') and ($pprequest ne 'modifyrp')) {
1265                 undef $nonrp;
1266
1267         my $gwl =
1268             Vend::Payment::PaypalExpress
1269                 -> new({
1270                     order_number => $opt->{order_id},
1271                     email => $::Values->{email} || '',
1272                     amount => $amount,
1273                     Enabled => charge_param('gwl_enabled'),
1274                     LogTable => charge_param('gwl_table'),
1275                     Source => charge_param('gwl_source'),
1276                 })
1277         ;
1278             $method = SOAP::Data->name('DoExpressCheckoutPaymentReq')->attr({xmlns => $xmlns});
1279
1280         $gwl->request({ header => $header, request => $request, method => $method });
1281
1282         $gwl->start;
1283             $response = $service->call($header, $method => $request);
1284         $gwl->stop;
1285
1286             %result = %{$response->valueof('//DoExpressCheckoutPaymentResponse')};
1287         $gwl->response(\%result);
1288 #::logDebug("PP".__LINE__.": nonRP=$nonrp; Do Ack=$result{Ack}; ppreq=$pprequest");
1289          my ($rpAmount, $rpPeriod, $rpFrequency, $totalBillingCycles, $trialPeriod, $trialFrequency, $trialAmount, $trialTotalBillingCycles, @setrpprofile);
1290   
1291           if ($result{'Ack'} eq "Success") {
1292             $Session->{'payment_result'}{'Status'} = 'Success' unless (@setrpprofile);
1293             $result{'TransactionID'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionID'};
1294             $result{'PaymentStatus'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentStatus'};
1295             $result{'TransactionType'}     = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionType'};
1296             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1297             $result{'ParentTransactionID'} = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ParentTransactionID'};
1298             $result{'PaymentType'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentType'};
1299             $result{'PendingReason'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PendingReason'};
1300             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1301             $result{'ReasonCode'}          = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ReasonCode'};
1302             $result{'FeeAmount'}           = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'FeeAmount'};
1303             $result{'ExchangeRate'}        = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ExchangeRate'};
1304                 $result{'giropaytrue'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'RedirectRequired'};
1305 # 22.11.2012, v111b             
1306                 $result{'gift_note'}           = $result{'DoExpressCheckoutPaymentResponseDetails'}{'Note'};
1307
1308           }
1309           else  {
1310                           $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1311                           for my $i (0 .. 3) {
1312                               last unless $result{'Errors'};
1313                                 $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1314                           }
1315           }
1316 #::logDebug("PP".__LINE__.": Doreq result=".::uneval(\%result));
1317
1318         }
1319
1320         my $cntr = '0';
1321
1322 #
1323 # Finished with DoRequest for normal purchase, now for RecurringPayments profiles
1324 # Need to run one complete request/response cycle per Profile
1325 #
1326         foreach  $item (@{$::Carts->{'main'}}) {
1327         my (@activation,@trialperiod,$rpprofile,$rprequest,@profiledetails,@scheduledetails,@end,$cardToken);
1328
1329             $itm = {
1330                                 rpDescription => Vend::Data::item_field($item, 'description'),
1331                                 rpAutoBillOutstandingAmount => Vend::Data::item_field($item, 'rpautobillarrears'),
1332                                 rpMaxFailedPayments => Vend::Data::item_field($item, 'rpmaxfailedpayments'),
1333                                 rpStartDate => Vend::Data::item_field($item, 'rpstartdate'),
1334                                 rpAmount_field => Vend::Data::item_field($item, $rpamount_field),
1335                                 rpAmount => Vend::Data::item_field($item, 'rpamount'),
1336                                 rpShippingAmount => Vend::Data::item_field($item, 'rpshippingamount'),
1337                                 rpTaxAmount => Vend::Data::item_field($item, 'rptaxamount'),
1338                                 rpPeriod => Vend::Data::item_field($item, 'rpperiod'),
1339                                 rpFrequency => Vend::Data::item_field($item, 'rpfrequency'),
1340                                 rpTotalCycles => Vend::Data::item_field($item, 'rptotalcycles'),
1341                                 trialPeriod => Vend::Data::item_field($item, 'rptrialperiod'),
1342                                 trialFrequency => Vend::Data::item_field($item, 'rptrialfrequency'),
1343                                 trialAmount => Vend::Data::item_field($item, $rptrialamount_field),
1344                                 trialShippingAmount => Vend::Data::item_field($item, 'rptrialshippingamount'),
1345                                 trialTaxAmount => Vend::Data::item_field($item, 'rptrialtaxamount'),
1346                                 trialTotalCycles => Vend::Data::item_field($item, 'rptrialtotalcycles'),
1347                                 initAmount => Vend::Data::item_field($item, $rpdeposit_field),
1348                                 initAmountFailedAction => Vend::Data::item_field($item, 'rpdepositfailedaction'),
1349                                 };
1350
1351         my $rpStartDate = $itm->{'rpStartDate'} || $Tag->time({ body => "%Y-%m-%d" });
1352            $rpStartDate .= "T00:00:00";
1353         my $rpPeriod = $::Values->{'rpperiod'} || $itm->{'rpPeriod'};
1354            $rpPeriod = ucfirst(lc($rpPeriod)); # 'type mismatch' error if case not right ...
1355            $rpPeriod = 'SemiMonth' if $rpPeriod =~ /semimonth/i;
1356         my $trialPeriod = $::Values->{'trialperiod'} || $itm->{'trialPeriod'};
1357            $trialPeriod = ucfirst(lc($trialPeriod)); 
1358            $trialPeriod = 'SemiMonth' if $trialPeriod =~ /semimonth/i;
1359         my $rpAmount = $::Values->{'repayamount'} || $itm->{'rpAmount_field'} || $itm->{'rpAmount'};
1360            $rpAmount = sprintf '%.2f', $rpAmount;
1361         my $initamountfailedaction = $::Values->{'initamountfailedaction'} || $itm->{'initAmountFailedAction'};
1362            $initamountfailedaction = 'ContinueOnFailure' if $initamountfailedaction =~ /continueonfailure/i;
1363            $initamountfailedaction = 'CancelOnFailure' if $initamountfailedaction =~ /cancelonfailure/i;
1364
1365 #-- now for the CreateRecurringPayments request ---------------------------------------
1366 #
1367         if ($rpAmount > '0') {
1368             $rpAmount = sprintf '%.02f', $rpAmount;
1369
1370         if ($cntr > '9') {
1371           $::Session->{'errors'}{'Paypal'} = "Paypal will not accept more than ten subscriptions in one order - please remove some and purchase them in
1372           a second order";
1373           return();
1374         };
1375                 $cntr++;
1376
1377                 my $rpref = $invoiceID . "-sub" . $cntr if charge_param('setordernumber');
1378 #::logDebug("PP".__LINE__.": invID=$invoiceID; profRef=$::Values->{'rpprofilereference'}; cnt=$cntr; shipAddress1=$itm->{'shipAddress1'};  rpFreq=$itm->{rpFrequency}; rpAmount=$itm->{rpAmount}; billP=$itm->{rpPeriod}; start=$rpStartDate"); 
1379                 my $rpStartDate = $::Values->{'rpstartdate'} || $itm->{'rpStartDate'} || strftime('%Y-%m-%dT%H:%M:%S',localtime); ##today; # FIXME 'valid GMT format', required: "yyyy-mm-dd hh:mm:ss GMT"
1380 # startdate either proper date format if taken from db or terminal, or may be period hence,
1381 # eg '1 week', '3 days', '2 months'. Eg, deposit (initAmount) now plus payments starting
1382 # in 1 month. 
1383                 if ($rpStartDate =~ /\d+ \w+/){
1384                   my ($adder, $period) = split/ /, $rpStartDate ;  
1385                           $adder *= '7' if $period =~ /week/i;
1386
1387                   my ($year,$month,$day) = Add_Delta_YMD(Today(),'0',"+$adder",'0') if $period =~ /month/i;
1388                          ($year,$month,$day) = Add_Delta_YMD(Today(),'0','0',"+$adder") if $period =~ /day/i;
1389                           $month = sprintf '%02d', $month;
1390                           $day = sprintf '%02d', $day;
1391                          $rpStartDate = "$year-$month-$day" . "T00:00:00Z"; 
1392                 }
1393                    $rpStartDate .= 'T00:00:00Z' if $rpStartDate !~ /T/;
1394
1395                 my $profileReference = $::Values->{'rpprofilereference'} || $rpref;
1396                    $::Values->{'rpprofilereference'} = '';
1397 #::logDebug("PP".__LINE__.": rcStart=$rpStartDate; profRef=$profileReference");
1398
1399
1400
1401                 $shipAddress = (   SOAP::Data->name('SubscriberShippingAddress' =>
1402                                                    \SOAP::Data->value(
1403                                                         SOAP::Data->name('Name' => "$::Values->{'fname'} $::Values->{'lname'}")->type(''),
1404                                                         SOAP::Data->name('Street1' => $::Values->{'address1'})->type(''),
1405                                                         SOAP::Data->name('Street2' => $::Values->{'address2'})->type(''),
1406                                                         SOAP::Data->name('CityName' => $::Values->{'city'})->type(''),
1407                                                         SOAP::Data->name('StateOrProvince' => $::Values->{'state'})->type(''),
1408                                                         SOAP::Data->name('PostalCode' => $::Values->{'zip'})->type(''),
1409                                                         SOAP::Data->name('Country' => $::Values->{'country'})->type(''),
1410                                                         ),
1411                                                    ),
1412                                                 ) if $::Values->{'address1'};
1413
1414           my $payment = (
1415                                                    SOAP::Data->name('PaymentPeriod' => 
1416                                                         \SOAP::Data->value(
1417                                                      SOAP::Data->name('BillingPeriod' => $rpPeriod)->type(''),
1418                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'rpfrequency'} || $itm->{'rpFrequency'})->type(''), 
1419                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'rptotalcycles'} || $itm->{'rpTotalCycles'})->type(''),
1420                                                          SOAP::Data->name('Amount' => $rpAmount)->attr({'currencyID' => $currency})->type(''),
1421                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'rpshippingamount'} || $itm->{'rpShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1422                                                          SOAP::Data->name('TaxAmount' => $::Values->{'rptaxamount'} || $itm->{'rpTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1423                                                          ),
1424                                                    ),
1425                                                 );
1426
1427           my $activation = (    
1428                                                         SOAP::Data->name('ActivationDetails' => 
1429                                                         \SOAP::Data->value(
1430                                                      SOAP::Data->name('InitialAmount' => $::Values->{'initamount'} || $itm->{'initAmount'})->attr({'currencyID' => $currency})->type(''),
1431                                                          SOAP::Data->name('FailedInitialAmountAction' => $initamountfailedaction)->type(''), 
1432                                                                 ),
1433                                                           ),
1434                                                 ) if ($::Values->{'initamount'} || $itm->{'initAmount'});
1435
1436           my $trial =   ( 
1437                                                         SOAP::Data->name('TrialPeriod' => 
1438                                                         \SOAP::Data->value(
1439                                                      SOAP::Data->name('BillingPeriod' => $trialPeriod)->type(''),
1440                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'trialfrequency'} || $itm->{'trialFrequency'})->type(''), 
1441                                                          SOAP::Data->name('Amount' => $::Values->{'trialamount'} || $itm->{'trialAmount'})->attr({'currencyID' => $currency})->type(''),
1442                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'trialshippingamount'} || $itm->{'trialShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1443                                                          SOAP::Data->name('TaxAmount' => $::Values->{'trialtaxamount'} || $itm->{'trialTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1444                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'trialtotalcycles'} || $itm->{'trialTotalCycles'})->type(''),
1445                                                           ),
1446                                                         ),
1447                                                   ) if ($::Values->{'trialamount'} || $itm->{'trialAmount'});
1448
1449                 push @scheduledetails, $payment;
1450                 push @scheduledetails, $activation if length $activation;
1451                 push @scheduledetails, $trial if length $trial;
1452                 push @profiledetails, SOAP::Data->name("BillingStartDate" => $rpStartDate)->type("");
1453                 push @profiledetails, SOAP::Data->name("ProfileReference" => $profileReference)->type("");
1454                 push @profiledetails, $shipAddress if length $shipAddress;
1455                 
1456                 $rprequest = (  
1457                                           SOAP::Data->name("CreateRecurringPaymentsProfileRequest" =>
1458                                           \SOAP::Data->value(
1459                                            SOAP::Data->name("Version" => $version)->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" })->type(''),
1460                                            SOAP::Data->name("CreateRecurringPaymentsProfileRequestDetails" =>
1461                                            \SOAP::Data->value(
1462                                                 SOAP::Data->name("Token" => $::Scratch->{"token"})->type("xs:string"),
1463                                                 SOAP::Data->name("RecurringPaymentsProfileDetails" =>
1464                                                 \SOAP::Data->value(
1465                                                   @profiledetails,
1466                                                   ),
1467                                                 ),
1468                                                 SOAP::Data->name('ScheduleDetails' =>
1469                                                 \SOAP::Data->value(
1470                                                 SOAP::Data->name('Description' => $::Values->{'rpdescription'} || $itm->{'rpDescription'})->type(''),
1471                                                 @scheduledetails,
1472                                                 SOAP::Data->name('MaxFailedPayments' => $::Values->{'rpmaxfailedpayments'} || $itm->{'rpMaxFailedPayments'} || '1')->type(''),
1473                                                 SOAP::Data->name('AutoBillOutstandingAmount' => $::Values->{'rpautobillarrears'} || $itm->{'rpAutoBillOutstandingAmount'} || 'NoAutoBill')->type(''),
1474                                                   ),
1475                                                 ),
1476                                           ),
1477                                         )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1478                                   ),
1479                                 ),
1480                         );
1481
1482 #::logDebug("PP".__LINE__.": dorp=".::uneval($rprequest));
1483
1484 # send separate query to Paypal for each RP profile
1485                 $method = SOAP::Data->name('CreateRecurringPaymentsProfileReq')->attr({ xmlns => $xmlns });
1486             $response = $service->call($header, $method => $rprequest);
1487 no strict 'refs';
1488           my $error = $response->valueof('//faultstring');
1489 use strict;
1490             %result = %{$response->valueof('//CreateRecurringPaymentsProfileResponse')};
1491 #::logDebug("PP".__LINE__.": CreateRecPayresult=".::uneval(\%result));
1492
1493                  $::Session->{'errors'}{'PaypalExpress'} .= $error;
1494                  $::Session->{'errors'}{'PaypalExpress'} .= $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1495                         for my $i (0 .. 3) {
1496                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1497                         }
1498
1499           if ($result{'Ack'} eq "Success") {
1500                 $db = dbref('transactions');
1501                 $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1502             $::Session->{'payment_result'}{'Status'} = 'Success';
1503                 $::Scratch->{'charge_succeed'} = '1';
1504         $result{'order-id'} = $order_id || $opt->{'order_id'};
1505             $result{'CorrelationID'} = $result{'CreateRecurringPaymentsProfileResponse'}{'CorrelationID'};
1506
1507           my ($rpshowsubtotal, $rpshowshipping, $rpshowtax, $rpshowtotal);
1508
1509                         $result{'ProfileID'}     = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileID'};
1510                         $result{'ProfileStatus'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileStatus'};
1511                         $result{'TransactionID'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'TransactionID'};
1512                         my $profilestatus = $result{'ProfileStatus'};
1513                            $profilestatus =~ s/Profile//;
1514
1515 # In log_transaction find ProfileID from ProfileReference, run 'getrpdetails' and put into orderline tbl
1516 # pages/query/order_detail has new col for Subs, link to popup which runs 'getrpdetails' and
1517 # displays info to customer from scratch values
1518
1519         my $sql = "INSERT transactions SET code='$profileReference',order_id='$result{ProfileID}',status='$profilestatus'";
1520
1521                                 $sth = $dbh->prepare($sql);
1522                                 $sth->execute() or die $sth->errstr;
1523 #::logDebug("PP".__LINE__.": Ack=$result{'Ack'}; result=".::uneval(\%result));
1524
1525                   } # if Ack eq success
1526
1527                 } # if item rpAmount
1528
1529           } # foreach item in cart 
1530
1531         }
1532
1533 #---------------------------------------------------------------------------------------
1534 # Manage RecurringPayments: to cancel, suspend or reactivate. Use 'modify' for other ops
1535 #
1536   elsif ($pprequest =~ /managerp/) {
1537  
1538         my ($x,$action) = split(/_/, $pprequest);
1539         my $status = 'Suspended' if $action eq 'suspend';
1540            $status = 'Cancelled' if $action eq 'cancel';
1541            $status = 'Active' if $action eq 'reactivate';
1542            $action = ucfirst(lc($action));
1543
1544                 my $request  = ( 
1545                                           SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequest' =>
1546                                           \SOAP::Data->value(
1547                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1548                                            SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequestDetails' =>
1549                                            \SOAP::Data->value(
1550                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type('xs:string'),
1551                                                  SOAP::Data->name('Action' => $action)->type(''),
1552                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type('xs:string'),
1553                                                 ),
1554                                          )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1555                                   ),
1556                                 ),
1557                           );
1558
1559             $method = SOAP::Data->name('ManageRecurringPaymentsProfileStatusReq')->attr({xmlns=>$xmlns});
1560             $response = $service->call($header, $method => $request);
1561             %result = %{$response->valueof('//ManageRecurringPaymentsProfileStatusResponse')};
1562           
1563                 if ($result{'Ack'} eq 'Success') {
1564               $db  = dbref('transactions') or die errmsg("cannot open transactions table");
1565               $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1566                   $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$status',txtype='PP:RecPay-$status',status='PP:RecPay-$status' WHERE rpprofileid='$::Values->{rpprofileid}'");
1567           $sth->execute() or die $sth->errstr;
1568                 }
1569 #::logDebug("PP".__LINE__.": action=$action; result=".::uneval(%result));
1570                 return(%result);
1571
1572   }
1573
1574 #--------------------------------------------------------------------------------------------
1575 # Get full RecurringPayments details and put into scratch space
1576 #
1577   elsif ($pprequest =~ /getrpdetails/) {
1578         my ($x,$update) = split /_/, $pprequest if $pprequest =~ /_/;
1579         $::Session->{'rpupdate'} = '1' if $update;
1580         getrpdetails();
1581         return();
1582   }
1583
1584 #-----------------------------------------------------------------------------------------
1585 #  RecurringPayments: bill arrears
1586 #
1587   elsif ($pprequest eq 'billrparrears') {
1588
1589                   my $request  = ( 
1590                                           SOAP::Data->name('BillOutstandingAmountRequest' =>
1591                                           \SOAP::Data->value(
1592                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1593                                            SOAP::Data->name('BillOutstandingAmountRequestDetails' =>
1594                                            \SOAP::Data->value(
1595                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type(''),
1596                                                  SOAP::Data->name('Amount' => $amount)->attr({'currencyID' => $currency})->type(''),
1597                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type(''),
1598                                                 ),
1599                                      )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1600                                   ),
1601                                 ),
1602                           );
1603
1604             $method = SOAP::Data->name('BillOutstandingAmountReq')->attr({ xmlns => $xmlns });
1605             $response = $service->call($header, $method => $request);
1606 no strict 'refs';
1607           my $error = $response->valueof('//faultstring');
1608 use strict;
1609             %result = %{$response->valueof('//BillOutstandingAmountResponse')};
1610 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1611
1612                 return(%result);
1613
1614   }
1615
1616 #-------------------------------------------------------------------------------------------------
1617 # REFUND transaction
1618 #
1619  elsif ($pprequest =~ /refund/) {
1620            my @refundreq = (
1621                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1622                     SOAP::Data->name("TransactionID" => $transactionID)->type("ebl:TransactionId"),
1623                     SOAP::Data->name("RefundType" => $refundType)->type(""),
1624                     SOAP::Data->name("Memo" => $memo)->type("xs:string"),
1625                      );
1626
1627           push @refundreq,  SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type("cc:BasicAmountType")
1628                                         if $pprequest eq 'refund_partial';
1629                   
1630      $request = SOAP::Data->name("RefundTransactionRequest" =>
1631                 \SOAP::Data->value( 
1632                                   @refundreq
1633                                   )
1634                                 )->type("ns:RefundTransactionRequestType");
1635
1636             $method = SOAP::Data->name('RefundTransactionReq')->attr({xmlns => $xmlns});
1637             $response = $service->call($header, $method => $request);
1638             %result = %{$response->valueof('//RefundTransactionResponse')};
1639                 
1640                 if ($result{'Ack'} eq "Success") {
1641                         $::Session->{'payment_result'}{'Terminal'} = 'success';
1642                 $::Session->{'payment_result'}{'RefundTransactionID'} = $result{'RefundTransactionResponse'}{'RefundTransctionID'};
1643 #::logDebug("PP".__LINE__.": Refund result=".::uneval(%result));
1644                         return %result;
1645                         }
1646                 }
1647
1648 #-------------------------------------------------------------------------------------------------
1649 # MASSPAY transaction
1650 #
1651  elsif ($pprequest eq 'masspay') {
1652         my ($receiver, $mpamount, $ref, $note, $mpi, @mp);
1653         my $emailsubject = $::Values->{'email_subject'} || 'Paypal payment';
1654     my $message = $::Values->{'vtmessage'};
1655 #::logDebug("PP".__LINE__.": req=$pprequest; list=$message");
1656
1657         if ($message) {
1658                 $message =~ s/\r//g;
1659         foreach my $line (split /\n/, $message) {
1660 #::logDebug("PP".__LINE__.": masspay line=$line");
1661                   ($receiver, $mpamount, $ref, $note) = split /","/, $line;
1662                   $receiver =~ s/^\"//;
1663                   $note =~ s/\"$// || ' ';
1664                   $mpamount = sprintf '%.02f', $mpamount;
1665                   $mpamount =~ s/^\D+//g;
1666
1667 #  need: receiver email/ID, amount, ref, note. Note can be empty but must be quoted
1668                 if ($receiver =~ /\@/) {
1669                 $receiverType = SOAP::Data->name("ReceiverEmail" => $receiver)->type("ebl:EmailAddressType");
1670                         }
1671                 else {
1672                 $receiverType = SOAP::Data->name("ReceiverID" => $receiver)->type("xs:string");
1673                 }
1674                  $mpi = (
1675                   SOAP::Data->name("MassPayItem" =>
1676                    \SOAP::Data->value(
1677                     $receiverType,
1678                     SOAP::Data->name("Amount" => $mpamount)->attr({ "currencyID" => $currency })->type("ebl:BasicAmountType"),
1679                     SOAP::Data->name("UniqueID" => $ref)->type("xs:string"),
1680                     SOAP::Data->name("Note" => $note)->type("xs:string")
1681                     )
1682                  ) ->type("ns:MassPayItemRequestType")
1683               );
1684                 push @mp, $mpi;
1685                         }
1686                   }
1687
1688         $request = SOAP::Data->name("MassPayRequest" =>
1689                            \SOAP::Data->value(
1690                 SOAP::Data->name("Version" => $version)->type("xs:string")->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1691                             SOAP::Data->name("EmailSubject" => $emailsubject)->type("xs:string"),
1692                 @mp
1693                    )
1694                  ) ->type("ns:MassPayRequestType");
1695
1696             $method = SOAP::Data->name('MassPayReq')->attr({ xmlns => $xmlns });
1697             $response = $service->call($header, $method => $request);
1698             %result = %{$response->valueof('//MassPayResponse')};
1699                 $::Session->{'payment_result'}{'Terminal'} = 'success' if $result{'Ack'} eq 'Success';
1700 #::logDebug("PP".__LINE__.":response=$result{Ack},cID=$result{CorrelationID}");
1701 # returns only Ack and CorrelationID on success
1702 #::logDebug("PP".__LINE__.": MassPay result=".::uneval(%result));
1703                 return %result;
1704
1705       }
1706
1707 #---------------------------------------------------------------------------
1708 # IPN
1709 #
1710   elsif ($pprequest =~ /ipn/) {
1711         my $page = ::http()->{'entity'};
1712         my $query = 'https://' . $ipnhost . '/cgi-bin/webscr?cmd=_notify-validate&' . $$page;
1713 #::logDebug("PP".__LINE__.": url=$query");      
1714
1715    my $ua = LWP::UserAgent->new;
1716    my $req = HTTP::Request->new('POST' => $query);
1717           $req->content_type('text/url-encoded');
1718           $req->content();
1719    my $res = $ua->request($req);
1720    my $respcode = $res->status_line;
1721
1722          if ($res->is_success) {
1723                   if ($res->content() eq 'VERIFIED') {
1724                           foreach my $line (split /\&/, $$page) {
1725                                 my ($key, $val) = (split /=/, $line);
1726 #::logDebug("IPN: $key = $val");
1727                                 $result{$key} = $val;
1728 #::logDebug("PP".__LINE__.": IPN result=".::uneval(%result));
1729                                 return %result;
1730
1731                           }
1732                         }
1733                   }
1734           else {
1735           }
1736 #::logDebug("PP".__LINE__.": resp=$res->content()");    
1737
1738         return();
1739
1740   }
1741
1742 #-----------------------------------------------
1743 # Get balance of accounts
1744 #
1745   elsif ($pprequest =~ /getbalance/) {
1746           my ($req, $account) = split (/_/, $pprequest) if $pprequest =~ /_/;
1747                   $account ||= 'Balance';
1748                   
1749            my @balancereq = (
1750                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1751                     SOAP::Data->name("ReturnAllCurrencies" => '1')->type(""),
1752                      );
1753
1754                 $request = SOAP::Data->name("GetBalanceRequest" =>
1755                                         \SOAP::Data->value( 
1756                                          @balancereq
1757                                         )
1758                                   ) ->type("ns:GetBalanceRequestType");
1759
1760             $method = SOAP::Data->name('GetBalanceReq')->attr({xmlns => $xmlns});
1761             $response = $service->call($header, $method => $request);
1762             %result = %{$response->valueof('//GetBalanceResponse')};
1763
1764                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1765                         for my $i (0 .. 3) {
1766                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1767                         }
1768 #::logDebug("PP".__LINE__.": GetBalance result=".::uneval(%result));
1769
1770                 $::Scratch->{'paypalbalance'} = "$account ";
1771                 for my $x ($response->dataof('//BalanceHoldings')) {
1772                         $::Scratch->{'paypalbalance'} .= " :: " . $x->{'_attr'}{'currencyID'} . $x->{'_value'}['0'];
1773
1774                 return;
1775
1776                 }
1777                 
1778   }
1779
1780 #---------------------------------------------------------------------------------------
1781 # DoReferenceTransaction, ie merchant-handled repeat of varying amounts at varying times
1782 #
1783   elsif ($pprequest =~ /dorepeat/) {
1784
1785   }
1786
1787 #--------------------------------------------------------------------------------------
1788 # DoNonReferencedCredit, ie send funds to specified credit card without reference to
1789 # a previous transaction
1790 #
1791   elsif ($pprequest =~ /sendcredit/) {
1792                   
1793                 my @payeraddress = (
1794                         SOAP::Data->name("Name" => $name)->type(""),
1795                         SOAP::Data->name("Street1" => $address1)->type(""),
1796                         SOAP::Data->name("Street2" => $address2)->type(""),
1797                         SOAP::Data->name("CityName" => $city)->type(""),
1798                         SOAP::Data->name("StateOrProvince" => $state)->type(""),
1799                         SOAP::Data->name("PostalCode" => $zip)->type(""),
1800                         SOAP::Data->name("Country" => $country)->type(""),
1801                        );
1802                 push @payeraddress, SOAP::Data->name("Phone" => $phone)->type("") if $phone;
1803 #::logDebug("PP".__LINE__.":payeraddress=".::uneval(@payeraddress));
1804
1805                 my @payername = (  
1806                         SOAP::Data->name("FirstName" => $::Values->{'b_fname'} || $::Values->{'fname'})->type(""),
1807                         SOAP::Data->name("LastName" => $::Values->{'b_lname'} || $::Values->{'lname'})->type(""),
1808                                           );
1809                 push @payername, SOAP::Data->name("MiddleName" => $::Values->{'middlename'})->type("") if $::Values->{'middlename'};
1810                 push @payername, SOAP::Data->name("Salutation" => $::Values->{'salutation'})->type("") if $::Values->{'salutation'};
1811                 push @payername, SOAP::Data->name("Suffix" => $::Values->{'suffix'})->type("") if $::Values->{'suffix'};
1812 #::logDebug("PP".__LINE__.":payername=".::uneval(@payername));
1813
1814                 my @cardowner = (  
1815                         SOAP::Data->name("PayerName" => 
1816                         \SOAP::Data->value(
1817                                                   @payername,
1818                                                   ),
1819                                                 ),
1820                         SOAP::Data->name("Address" => 
1821                         \SOAP::Data->value(
1822                                                   @payeraddress,
1823                                                   ),
1824                                                 ),
1825                                           );
1826                 push @cardowner, SOAP::Data->name("Payer" => $::Values->{'email'})->type("") if $::Values->{'email'};
1827                 push @cardowner, SOAP::Data->name("PayerID" => $::Values->{'payerid'})->type("") if $::Values->{'payerid'};
1828 #::logDebug("PP".__LINE__.":cardowner=".::uneval(@cardowner));
1829
1830                 my $pan = $::CGI->{'mv_credit_card_number'};
1831                    $pan =~ s/\D*//g;
1832                 my $mvccexpyear = $::Values->{'mv_credit_card_exp_year'};
1833                    $mvccexpyear = '20' . $mvccexpyear unless $mvccexpyear =~ /^20/;
1834                 my @creditcard = (
1835                         SOAP::Data->name("CreditCardType" => $::Values->{'mv_credit_card_type'})->type(""),
1836                         SOAP::Data->name("CreditCardNumber" => $pan)->type(""),
1837                         SOAP::Data->name("ExpMonth" => $::Values->{'mv_credit_card_exp_month'})->type(""),
1838                         SOAP::Data->name("ExpYear" => $mvccexpyear)->type(""),
1839                         SOAP::Data->name("CardOwner" => 
1840                         \SOAP::Data->value(
1841                                                   @cardowner,
1842                                                   ),
1843                                                 ),
1844                                           );
1845                 push @creditcard, SOAP::Data->name("CVV2" => $::CGI->{'mv_credit_card_cvv2'})->type("") if $::CGI->{'mv_credit_card_cvv2'};
1846                 push @creditcard, SOAP::Data->name("StartMonth" => $::Values->{'mv_credit_card_start_month'})->type("") if $::Values->{'mv_credit_card_start_month'};
1847                 push @creditcard, SOAP::Data->name("StartYear" => $::Values->{'mv_credit_card_start_year'})->type("") if $::Values->{'mv_credit_card_start_month'};
1848                 push @creditcard, SOAP::Data->name("IssueNumber" => $::Values->{'mv_credit_card_issue_number'})->type("") if $::Values->{'mv_credit_card_issue_number'};
1849 #::logDebug("PP".__LINE__.":creditcard=".::uneval(@creditcard)); 
1850
1851
1852            my @docreditreq = (
1853                     SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type(""),
1854                     SOAP::Data->name("CreditCard" =>
1855                                 \SOAP::Data->value(
1856                                         @creditcard,
1857                                           ),
1858                                          ),
1859                                         );
1860                 push @docreditreq, SOAP::Data->name("Comment" => $::Values->{'vtmessage'})->type("") if $::Values->{'vtmessage'};
1861                 push @docreditreq, SOAP::Data->name("ReceiverEmail" => $::Values->{'email'})->type("") if $::Values->{'email'};
1862 #::logDebug("PP".__LINE__.":docreditreq=".::uneval(@docreditreq));
1863
1864      $request = SOAP::Data->name("DoNonReferencedCreditRequest" =>
1865                                \SOAP::Data->value(
1866                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type(""),
1867                                         SOAP::Data->name("DoNonReferencedCreditRequestDetails" =>
1868                                         \SOAP::Data->value(
1869                                           @docreditreq
1870                                        ),
1871                                      )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1872                                     ),
1873                   );
1874
1875             $method = SOAP::Data->name('DoNonReferencedCreditReq')->attr({xmlns => $xmlns});
1876             $response = $service->call($header, $method => $request);
1877             %result = %{$response->valueof('//DoNonReferencedCreditResponse')};
1878
1879 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1880                 return(%result);
1881
1882 }
1883   
1884 ##
1885 ##============================================================================================
1886 ## Interchange names are on the left, Paypal on the right
1887 ##
1888
1889  my %result_map;
1890  if ($pprequest =~ /dorequest|giropaylog/) {
1891     %result_map = ( qw/
1892                    order-id                     TransactionID
1893                    pop.order-id                 TransactionID
1894                    pop.timestamp                Timestamp
1895                    pop.auth-code                Ack
1896                    pop.status                   Ack
1897                    pop.txn-id                   TransactionID
1898                    pop.refund-txn-id    RefundTransactionID
1899                    pop.cln-id                   CorrelationID
1900         /
1901     );
1902
1903     for (keys %result_map) {
1904         $result{$_} = $result{$result_map{$_}}
1905            if defined $result{$result_map{$_}};
1906 ::logDebug('PP: '.__LINE__."result map: $result{$_}=$result{$result_map{$_}}");           
1907     }
1908   }
1909 ::logDebug("PP".__LINE__.": ack=$result{Ack}; ppreq=$pprequest");
1910   if (($result{'Ack'} eq 'Success') and ($pprequest =~ /dorequest|giropay/)) {
1911          $result{'MStatus'} = $result{'pop.status'} = 'success';
1912          $result{'order-id'} ||= $order_id || $opt->{'order_id'};
1913 ::logDebug("PP".__LINE__.": mstatus=$result{MStatus}"); 
1914            }
1915   elsif (!$result{'Ack'}) {
1916          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1917          $result{'order-id'} = '';
1918          $result{'TxType'} = 'NULL';
1919          $result{'StatusDetail'} = 'UNKNOWN status - check with Paypal';
1920            }
1921   elsif ($result{'Ack'} eq 'Failure') {
1922          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1923          $result{'order-id'} = $result{'pop.order-id'} = '';
1924          $result{'MErrMsg'} = "code $result{'ErrorCode'}: $result{'LongMessage'}\n";
1925       }
1926
1927         $::Values->{'returnurl'} = '';
1928         $::Scratch->{'pprecurringbilling'} = '';
1929
1930 ::logDebug("PP".__LINE__." result:" .::uneval(\%result));
1931     return (%result);
1932
1933 }
1934
1935 #
1936 ##------------------------------------------------------------------------------------------------
1937 #
1938
1939 sub getrpdetails {
1940
1941         my $update = $::Session->{'rpupdate'} || '';
1942         my $profileID = shift || charge_param('rpprofileid') || $::Values->{'rpprofileid'};
1943         $::Values->{'rpprofileid'} = '';
1944         $::Scratch->{'rpprofileid'} = '';
1945         $::Session->{'rpupdate'} = '';
1946 #::logDebug("PP".__LINE__.": getRPdetails: profileID=$profileID");
1947         my $request  = ( 
1948                                           SOAP::Data->name('GetRecurringPaymentsProfileDetailsRequest' =>
1949                                           \SOAP::Data->value(
1950                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1951                                            SOAP::Data->name('ProfileID' => $profileID)->type('xs:string'),
1952                                            ),
1953                                         )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1954                              );
1955
1956            my $method = SOAP::Data->name('GetRecurringPaymentsProfileDetailsReq')->attr({ xmlns => $xmlns });
1957            my $response = $service->call($header, $method => $request);
1958                   %result = %{$response->valueof('//GetRecurringPaymentsProfileDetailsResponse')};
1959
1960                  $::Scratch->{'rpdetails'} = ::uneval(%result);
1961
1962                  $::Scratch->{'rpcorrelationid'} = $result{'CorrelationID'};
1963                  $::Scratch->{'rpprofilereference'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'ProfileReference'};
1964                  $::Scratch->{'rpprofileid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileID'};
1965                  $::Scratch->{'rpdescription'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'Description'};
1966                  $::Scratch->{'rpprofilestatus'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileStatus'};
1967                  $::Scratch->{'rpprofilestatus'} =~ s/Profile//g;
1968                  $::Scratch->{'rpsubscribername'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'SubscriberName'};
1969                  $::Scratch->{'rpstartdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'BillingStartDate'};
1970                  $::Scratch->{'rpstartdate'} =~ s/T/ /;
1971                  $::Scratch->{'rpstartdate'} =~ s/Z//;
1972                  $::Scratch->{'rptaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TaxAmount'};
1973                  $::Scratch->{'rpshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'ShippingAmount'};
1974                  $::Scratch->{'rpamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'Amount'};
1975                  $::Scratch->{'rpgrossamount'} = sprintf '%.2f', ($::Scratch->{'rpamount'} + $::Scratch->{'rpshipping'} + $::Scratch->{'rptax'});
1976                 # $::Scratch->{'rpgrossamount'} = sprintf '%.2f', $rpgross;
1977                  $::Scratch->{'rpfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingFrequency'};
1978                  $::Scratch->{'rpperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingPeriod'};
1979                  $::Scratch->{'rptotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1980                  $::Scratch->{'rpnextbillingdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NextBillingDate'};
1981                  $::Scratch->{'rpnextbillingdate'} =~ s/T/ /g; # format for IC's 'convert-date'
1982                  $::Scratch->{'rpnextbillingdate'} =~ s/Z//g; 
1983                  $::Scratch->{'rpcyclesmade'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesCompleted'};
1984                  $::Scratch->{'rpcyclesfailed'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'FailedPaymentCount'};
1985                  $::Scratch->{'rpcyclesremaining'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesRemaining'};
1986                  $::Scratch->{'rparrears'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'OutstandingBalance'};
1987                  $::Scratch->{'rpmaxfailedpayments'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'MaxFailedPayments'};
1988
1989                  $::Scratch->{'rptrialamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'Amount'};
1990                  $::Scratch->{'rptrialtaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TaxAmount'};
1991                  $::Scratch->{'rptrialshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'ShippingAmount'};
1992                  $::Scratch->{'rptrialfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingFrequency'};
1993                  $::Scratch->{'rptrialperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingPeriod'};
1994                  $::Scratch->{'rptrialtotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1995                  my $rptrialgrossamount = $::Scratch->{'rptrialamount'} + $::Scratch->{'rptrialtaxamount'} + $::Scratch->{'rptrialshippingamount'};
1996                  $::Scratch->{'rptrialgrossamount'} = sprintf '%.2f', $rptrialgrossamount;
1997                  my $finalpaymentduedate = $result{'GetRecurringPaymentsProfileDetailsResponse'}{'FinalPaymentDueDate'};
1998                     $finalpaymentduedate =~ s/T/ /; # format for IC's convert-date routine
1999                  $::Scratch->{'rpfinalpaymentduedate'} = $finalpaymentduedate =~ s/Z//; 
2000                  $::Scratch->{'rpregularamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularAmountPaid'};
2001                  $::Scratch->{'rptrialamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialAmountPaid'};
2002                  my $rptotalpaid = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'AggregateAmount'};
2003
2004 # ### activation details not returned ...
2005                 my $db = dbref('transactions');
2006                 my $dbh = $db->dbh();
2007                 my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
2008                 my $sth = $dbh->prepare("SELECT $rpdeposit_field, rpdepositfailedaction FROM products WHERE description='$::Scratch->{rpdescription}'");
2009                    $sth->execute() or die $sth->errstr;
2010             my @d = $sth->fetchrow_array();
2011                    $::Scratch->{'rpdeposit'} = $d[0];
2012                    $::Scratch->{'rpdepositfailedaction'} = $d[1];
2013
2014
2015                 if ($update) {
2016                         $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$::Scratch->{rpprofilestatus}',status='PPsub-$::Scratch->{rpprofilestatus}',txtype='PPsub-$::Scratch->{rpprofilestatus}' WHERE rpprofileid='$::Scratch->{rpprofileid}'");
2017                         $sth->execute() or die $sth->errstr;
2018                         $::Session->{'rpupdate'} = '';
2019                 }
2020
2021         return($result{'Ack'});
2022 }
2023
2024 sub _ppxmlfilter {
2025 #
2026 # filter for valid XML
2027 #
2028       my $string = shift;
2029                 $string =~ s|&|&amp;|g unless $string =~ /&amp/i;;
2030                 $string =~ s|<|&lt;|g;
2031                 $string =~ s|>|&gt;|g;
2032                 $string =~ s|'|&apos;|g;
2033                 $string =~ s|"|&quot;|g;
2034         return $string;
2035
2036 }
2037
2038 sub _pplocfilter {
2039 #
2040 # filter to remove IC's Locale tags
2041 #
2042       my $string = shift;
2043           $string =~ s|\[L\]||g;
2044           $string =~ s|\[\/L\]||g;
2045       return $string;
2046
2047 }
2048
2049 package Vend::Payment::PaypalExpress;
2050
2051 use Vend::Payment::GatewayLog;
2052 use base qw/Vend::Payment::GatewayLog/;
2053
2054 sub log_it {
2055         my $self = shift;
2056
2057     my $request = $self->request;
2058     unless ($request) {
2059         ::logDebug('Nothing to write to %s: no request present', $self->table);
2060         return;
2061     }
2062
2063     unless ($self->response) {
2064
2065         if ($Vend::Payment::Global_Timeout) {
2066             my $msg = errmsg('No response. Global timeout triggered');
2067             ::logDebug($msg);
2068             $self->response({
2069                 Errors => {
2070                     ErrorCode => -2,
2071                     LongMessage => $Vend::Payment::Global_Timeout,
2072                 },
2073             });
2074         }
2075         else {
2076             my $msg = errmsg('No response. Reason unknown');
2077             ::logDebug($msg);
2078             $self->response({
2079                 Errors => {
2080                     ErrorCode => -3,
2081                     LongMessage => $msg,
2082                 },
2083             });
2084         }
2085     }
2086     my $response = $self->response;
2087
2088     my ($rc,$resp_msg);
2089     if ( $response->{Ack} eq 'Success' ) {
2090         $rc = 0;
2091         $resp_msg = $response->{Ack};
2092     }
2093     else {
2094         $rc = $response->{Errors}{ErrorCode};
2095         # Just in case
2096         $rc =~ s/[^-\d]+//g
2097             if defined $rc;
2098         $resp_msg = $response->{Errors}{LongMessage};
2099     }
2100
2101     $rc = -1
2102         unless length ($rc) && $rc =~ /\d/;
2103
2104     # Don't want unexpected response structures from different errors
2105     # to blow up the error log
2106     no strict 'refs';
2107
2108     my %fields = (
2109         trans_type => $response->{DoExpressCheckoutPaymentResponseDetails}{PaymentInfo}{TransactionType} || 'x',
2110         processor => 'paypalexpress',
2111         catalog => $Vend::Cfg->{CatalogName},
2112         result_code => $rc,
2113         response_msg => $resp_msg || '',
2114         request_id => $response->{DoExpressCheckoutPaymentResponseDetails}{PaymentInfo}{TransactionID} || '',
2115         order_number => $self->{order_number} || '',
2116         request_duration => $self->duration,
2117         request_date => $self->timestamp,
2118         email => $self->{email} || '',
2119         request => ::uneval($request) || '',
2120         response => ::uneval($response) || '',
2121         session_id => $::Session->{id} || '',
2122         request_source => $self->source,
2123         amount => $self->{amount} || '',
2124         host_ip => $::Session->{shost} || $::Session->{ohost} || '',
2125         username => $::Session->{username} || '',
2126         cart_md5 => '',
2127     );
2128
2129     if (@$Vend::Items) {
2130         my $dump = Data::Dumper
2131             -> new($Vend::Items)
2132             -> Indent(0)
2133             -> Terse(1)
2134             -> Deepcopy(1)
2135             -> Sortkeys(1)
2136         ;
2137         $fields{cart_md5} = Digest::MD5::md5_hex($dump->Dump);
2138     }
2139
2140     $self->write(\%fields);
2141 }
2142
2143 1;