Also look in the next-highest directory when detecting VCS; add SVN
[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             %result = %{$response->valueof('//SetExpressCheckoutResponse')};
968                 $::Scratch->{'token'} = $result{'Token'};
969 #::logDebug("PP".__LINE__.": result= ".::uneval(%result)); # ### NOTE  
970    if (!$result{'Token'}) {
971     if ($result{'Ack'} eq 'Failure') {
972                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
973                         for my $i (0 .. 3) {
974                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
975                                         }
976                          }
977     else {
978        my $accepted = uc($::Variable->{CREDIT_CARDS_ACCEPTED});
979        $::Session->{'errors'}{'PaypalExpress'} = errmsg("Paypal is currently unavailable - please use our secure payment system instead. We accept $accepted cards");
980              }
981            return $Tag->deliver({ location => $checkouturl }) 
982       }
983
984 #::logDebug("PP".__LINE__.": sandbox=$sandbox; host=$host");
985 # Now go off to Paypal
986   my $redirecturl = "https://www."."$sandbox"."paypal.com/cgi-bin/webscr?cmd=_express-checkout&token=$result{Token}";
987
988 return $Tag->deliver({ location => $redirecturl }); 
989
990    }
991
992
993 #--------------------------------------------------------------------------------------------------
994 ### Create a GET request and method, and read response
995 #
996  elsif ($pprequest eq 'getrequest') {
997             $request = SOAP::Data->name("GetExpressCheckoutDetailsRequest" =>
998                          \SOAP::Data->value(
999                           SOAP::Data->name("Version" => $version)->type("xs:string"),
1000                          SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string")
1001                          )
1002                    ) ->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"});
1003              $method = SOAP::Data->name('GetExpressCheckoutDetailsReq')->attr({xmlns => $xmlns});
1004              $response = $service->call($header, $method => $request);
1005                  %result = %{$response->valueof('//GetExpressCheckoutDetailsResponse')};
1006 #::logDebug("PP".__LINE__.": Get Ack=$result{Ack}");
1007
1008 # populate the billing address rather than shipping address when the basket is being shipped to
1009 # another address, eg it is a wish list.
1010           if (($result{'Ack'} eq "Success") and ($::Values->{'pp_use_billing_address'} == 1)) {
1011                 $::Values->{'b_phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'};
1012                 $::Values->{'email'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
1013                 $::Values->{'payerid'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
1014                 $::Values->{'payerstatus'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
1015                 $::Values->{'payerbusiness'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
1016             $::Values->{'salutation'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
1017             $::Values->{'b_fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
1018             $::Values->{'mname'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
1019             $::Values->{'b_lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
1020             $::Values->{'suffix'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
1021             $::Values->{'address_status'}   = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
1022             $::Values->{'b_name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'PayerName'};
1023             $::Values->{'b_address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
1024             $::Values->{'b_address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
1025             $::Values->{'b_city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
1026             $::Values->{'b_state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
1027             $::Values->{'b_zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
1028             $::Values->{'b_country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1029             $::Values->{'countryname'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
1030                 $::Values->{'country'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1031                       }
1032
1033           elsif ($result{'Ack'} eq "Success") {
1034             $::Values->{'phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'} || $::Values->{phone_day} || $::Values->{phone_night};
1035                 $::Values->{'payerid'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
1036                 $::Values->{'payerstatus'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
1037                 $::Values->{'payerbusiness'}  = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
1038             $::Values->{'salutation'}     = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
1039             $::Values->{'suffix'}         = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
1040             $::Values->{'address_status'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
1041           if ($addressOverride != '1') {
1042                 $::Values->{'email'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
1043             $::Values->{'fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
1044             $::Values->{'mname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
1045             $::Values->{'lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
1046             $::Values->{'name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Name'};
1047             $::Values->{'address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
1048             $::Values->{'address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
1049             $::Values->{'city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
1050             $::Values->{'state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
1051             $::Values->{'zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
1052             $::Values->{'countryname'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
1053                 $::Values->{'country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1054                       }
1055                    }
1056                    
1057                 $::Values->{'gift_note'}   = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PaymentDetails'}{'NoteText'};
1058  
1059                    
1060                 $::Values->{'company'} = $::Values->{'b_company'} = $::Values->{'payerbusiness'};
1061                 $::Values->{'giropaytrue'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'RedirectRequired'};
1062
1063 #::logDebug("PP".__LINE__.": on=$::Values->{mv_order_number}");
1064                 $invoiceID = $::Session->{'mv_order_number'} = $::Values->{'mv_order_number'} = $result{'Custom'} unless ($::Values->{'mv_order_number'} || $invoiceID);
1065
1066 # If shipping address and name are chosen at Paypal to be different to the billing address/name, then {name} contains           
1067 # the shipping name but {fname} and {lname} still contain the billing names.
1068 ### In this case the returned 'name' may be a company name as it turns out, so what should we do?
1069    if (($::Values->{'fname'} !~ /$::Values->{'name'}/) and ($::Values->{'name'} =~ /\s/)) {
1070        $::Values->{'name'} =~ /(\S*)\s+(.*)/;
1071        $::Values->{'fname'} = $1;
1072        $::Values->{'lname'} = $2;
1073     }
1074                 
1075                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1076                         for my $i (0 .. 3) {
1077                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1078                         }
1079    
1080        $country = $::Values->{'country'} || $::Values->{'b_country'};
1081        $state = $::Values->{'state'} || $::Values->{'b_state'};
1082        $state =~ s/\.\s*//g; # yet another variation for Canadian Provinces includes periods, eg B.C. (waiting for B. C.)
1083
1084 # Remap Canadian provinces rather than lookup the db, as some Paypal names are incomplete wrt the official names. 
1085 # It seems that some PP accounts, possibly older ones, send the 2 letter abbreviation rather than the full name.
1086         if ($country eq 'CA') {         
1087                 $state = 'AB' if ($state =~ /Alberta|^AB$/i);
1088                 $state = 'BC' if ($state =~ /British Columbia|^BC$/i);
1089                 $state = 'MB' if ($state =~ /Manitoba|^MB$/i);
1090                 $state = 'NB' if ($state =~ /New Brunswick|^NB$/i);
1091                 $state = 'NL' if ($state =~ /Newfoundland|^NL$/i);
1092                 $state = 'NS' if ($state =~ /Nova Scotia|^NS$/i);
1093                 $state = 'NT' if ($state =~ /Northwest Terr|^NT$/i);
1094                 $state = 'NU' if ($state =~ /Nunavut|^NU/i);
1095                 $state = 'ON' if ($state =~ /Ontario|^ON$/i);
1096                 $state = 'PE' if ($state =~ /Prince Edward|^PE$/i);
1097                 $state = 'QC' if ($state =~ /Quebec|^QC$/i);
1098                 $state = 'SK' if ($state =~ /Saskatchewan|^SK$/i);
1099                 $state = 'YT' if ($state =~ /Yukon|^YT$/i);
1100         }
1101         
1102         $::Values->{'b_state'} = $state if ($::Values->{'pp_use_billing_address'} == 1);
1103         $::Values->{'state'} = $state;
1104   
1105   }
1106
1107 #------------------------------------------------------------------------------------------------
1108 ### Create a Do request and method, and read response. Not used for Giropay
1109 #
1110  elsif ($pprequest =~ /dorequest|modifyrp/) {
1111      #  $currency = 'EUR'; # set to currency different to that started with to force failure for testing
1112                         $invoiceID = ($::Values->{'mv_order_number'} || $::Values->{'order_number'}) unless $invoiceID;
1113                         
1114 # To further handle rounding errors with discounts, using values put in session during 'setrequest'
1115            my $orderTotal = $itemTotal + $shipTotal + $handlingTotal + $taxTotal;
1116
1117 ::logDebug("PP".__LINE__.":invID=$invoiceID; on=$::Values->{mv_order_number}; total=$amount, $orderTotal, itemtotal=$itemTotal, shiptot=$shipTotal,handTot=$handlingTotal,taxtot=$taxTotal");
1118
1119            my @pd  = (
1120                                      SOAP::Data->name("OrderTotal" => $orderTotal )->attr({"currencyID" => $currency})->type(""),
1121                                      SOAP::Data->name("ItemTotal" => $itemTotal )->attr({"currencyID" => $currency})->type(""),
1122                                      SOAP::Data->name("ShippingTotal" => $shipTotal )->attr({"currencyID" => $currency})->type(""),
1123                                      SOAP::Data->name("HandlingTotal" => $handlingTotal )->attr({"currencyID" => $currency})->type(""),
1124                                      SOAP::Data->name("TaxTotal" => $taxTotal )->attr({"currencyID" => $currency})->type(""),
1125                                      SOAP::Data->name("InvoiceID" => $invoiceID )->type(""),
1126                      );
1127
1128         my @sta  = (
1129                     SOAP::Data->name("ShipToAddress" =>
1130                     \SOAP::Data->value(
1131                      SOAP::Data->name("Name" => $name)->type("xs:string"),
1132                      SOAP::Data->name("Street1" => $address1)->type("xs:string"),
1133                      SOAP::Data->name("Street2" => $address2)->type("xs:string"),
1134                      SOAP::Data->name("CityName" => $city)->type("xs:string"),
1135                      SOAP::Data->name("StateOrProvince" => $state)->type("xs:string"),
1136                      SOAP::Data->name("PostalCode" => $zip)->type("xs:string"),
1137                      SOAP::Data->name("Country" => $country)->type("xs:string")
1138                          )
1139                        )
1140                      );
1141
1142                   my ($item,$itm,@pdi,$pdiamount,$pditax);
1143 # ### FIXME what is the point of sending item details here???? Because the API says must send here if sent in the 'set' request ...
1144                 if (($itemTotal > '0') and ($taxTotal > '0')) {
1145                   foreach  $item (@{$::Carts->{'main'}}) {
1146                           $itm = {
1147                                           number => $item->{'code'},
1148                                           quantity => $item->{'quantity'},
1149                                           description => Vend::Data::item_description($item),
1150                                           amount => Vend::Data::item_price($item),
1151                                           comment => Vend::Data::item_field($item, 'comment'),
1152                                           tax => (Vend::Data::item_price($item)/$itemTotal * $taxTotal),
1153                                           rpAmount => Vend::Data::item_field($item, 'rpamount'),
1154                                           };
1155   
1156                           $pdiamount = sprintf '%.02f', $itm->{'amount'};
1157                           $pditax = sprintf '%.02f', $itm->{'tax'};
1158                           
1159                         $itemname = $itm->{'title'} || $itm->{'description'};
1160                         $itemname = _ppxmlfilter( $itemname );
1161                         $itemname = substr($itemname,0,126);
1162
1163
1164                 my $pdi  = (
1165                         SOAP::Data->name("PaymentDetailsItem" =>
1166                         \SOAP::Data->value(
1167                          SOAP::Data->name("Name" => $itemname)->type("xs:string"),
1168                          SOAP::Data->name("Amount" => $pdiamount)->attr({"currencyID" => $currency})->type("xs:string"),
1169                          SOAP::Data->name("Number" => $itm->{'number'})->type("xs:string"),
1170                          SOAP::Data->name("Quantity" => $itm->{'quantity'})->type("xs:string"),
1171                          SOAP::Data->name("Tax" => $pditax)->type("xs:string")
1172                             )
1173                           )->type("ebl:PaymentDetailsItemType")
1174                         );
1175           push @pdi, $pdi unless $itm->{'rpAmount'} > '0';
1176           }
1177     }
1178 #----------------------------------
1179
1180         my ($shipAddress, $billAddress, $payerInfo, @schedule, $nonrp);
1181         my $cntr = '0';
1182         my $rpamount_field = 'rpamount_' . lc($currency) || 'rpamount';
1183         my $rptrialamount_field = 'rptrialamount_' . lc($currency) || 'rptrialamount';
1184         my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
1185
1186         foreach  $item (@{$::Carts->{'main'}}) {
1187             $itm = {
1188                                 rpamount_field => Vend::Data::item_field($item, $rpamount_field),
1189                                 rpamount => Vend::Data::item_field($item, 'rpamount'),
1190                         amount => Vend::Data::item_price($item),
1191                                 description => Vend::Data::item_field($item, 'description'),
1192                                 };
1193
1194
1195    $basket .= <<EOB;
1196    Item = $itm->{code}, "$itm->{rpDescription}"; Price = $itm->{price}; Qty = $itm->{quantity}; Subtotal = $itm->{subtotal} 
1197 EOB
1198
1199           my ($dorecurringbilling, $cntr);
1200           my $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
1201                  $nonrp = '1' if (! $rpamount); # only run Do request if have standard purchase as well
1202           if ($rpamount) {
1203 #               $cntr++;
1204 #::logDebug("PP".__LINE__.": cntr=$cntr; initamount=$itm->{initAmount}; rpAmount=$itm->{rpAmount}; trialAmount=$itm->{trialAmount}");   
1205             $dorecurringbilling = (
1206                                            SOAP::Data->name("BillingAgreementDetails" =>
1207                                            \SOAP::Data->value(
1208                                             SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),
1209                                                 SOAP::Data->name("BillingAgreementDescription" => $itm->{'description'})->type(""),
1210                                                       )
1211                                                     )->type("ns:BillingAgreementDetailsType"),
1212                                                 );
1213                 $cntr++;
1214                 push @pd, $dorecurringbilling;
1215           }
1216                                            
1217         };      
1218
1219                 push @pd, SOAP::Data->name("Custom" => $custom )->type("xs:string") if $custom;
1220                 push @pd, SOAP::Data->name("NotifyURL" => $notifyURL )->type("xs:string") if $notifyURL;
1221                 push @pd, SOAP::Data->name("NoteText" => delete $::Values->{'gift_note'})->type('') if $::Values->{'gift_note'};
1222                 push @pd, @sta if $addressOverride  == '1';
1223 # ###           push @pd, @pdi if $paymentDetailsItem == '1';# and ($itemTotal > '0')); 
1224 # ### NOTE problems with discounts and totals not adding up if PaymentDetailsItems are sent.
1225
1226         my $pd = (      SOAP::Data->name("PaymentDetails" =>
1227                                  \SOAP::Data->value( @pd
1228                                      ),
1229                                )->type(""),
1230                                 );
1231
1232         my @doreq = (    SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string"),
1233                          SOAP::Data->name("PaymentAction" => $paymentAction)->type(""),
1234                          SOAP::Data->name("PayerID" => $::Values->{'payerid'} )->type("xs:string"),
1235                         );
1236 # ###           push @doreq, SOAP::Data->name("ReturnFMFDetails" => '1' )->type("xs:boolean") if $returnFMFdetails == '1'; # ### crashes
1237 # ###           push @doreq, SOAP::Data->name("GiftMessage" => $giftMessage)->type("xs:string") if $giftMessage;
1238                 push @doreq, SOAP::Data->name("GiftReceiptEnable" => $giftReceiptEnable)->type("xs:string") if $giftReceiptEnable; # true | false
1239                 push @doreq, SOAP::Data->name("GiftWrapName" => $giftWrapName)->type("xs:string") if $giftWrapName; # 25 chars
1240                 push @doreq, SOAP::Data->name("GiftWrapAmount" => $giftWrapAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $giftWrapAmount;
1241                 push @doreq, SOAP::Data->name("ButtonSource" => $buttonSource )->type("xs:string") if $buttonSource;
1242                 push @doreq, SOAP::Data->name("SoftDescriptor" => $softDescriptor)->type('') if $softDescriptor;
1243                 push @doreq, SOAP::Data->name("SellerDetails" => $sellerDetails)->type('') if $sellerDetails;
1244
1245                 push @doreq, $pd;
1246
1247             $request = SOAP::Data->name("DoExpressCheckoutPaymentRequest" =>
1248                                \SOAP::Data->value(
1249                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type("xs:string"),
1250                                 SOAP::Data->name("DoExpressCheckoutPaymentRequestDetails" =>
1251                                 \SOAP::Data->value(
1252                                         @doreq,
1253                              ),
1254                            )->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"}),
1255                          ),
1256                    );
1257
1258         if (($nonrp == '1') and ($pprequest ne 'modifyrp')) {
1259                 undef $nonrp;
1260
1261         my $gwl =
1262             Vend::Payment::PaypalExpress
1263                 -> new({
1264                     order_number => $opt->{order_id},
1265                     email => $opt->{actual}{email},
1266                     amount => $amount,
1267                     Enabled => charge_param('gwl_enabled'),
1268                     LogTable => charge_param('gwl_table'),
1269                     Source => charge_param('gwl_source'),
1270                 })
1271         ;
1272             $method = SOAP::Data->name('DoExpressCheckoutPaymentReq')->attr({xmlns => $xmlns});
1273
1274         $gwl->request({ header => $header, request => $request, method => $method });
1275
1276         $gwl->start;
1277             $response = $service->call($header, $method => $request);
1278         $gwl->stop;
1279
1280             %result = %{$response->valueof('//DoExpressCheckoutPaymentResponse')};
1281         $gwl->response(\%result);
1282 #::logDebug("PP".__LINE__.": nonRP=$nonrp; Do Ack=$result{Ack}; ppreq=$pprequest");
1283          my ($rpAmount, $rpPeriod, $rpFrequency, $totalBillingCycles, $trialPeriod, $trialFrequency, $trialAmount, $trialTotalBillingCycles, @setrpprofile);
1284   
1285           if ($result{'Ack'} eq "Success") {
1286             $Session->{'payment_result'}{'Status'} = 'Success' unless (@setrpprofile);
1287             $result{'TransactionID'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionID'};
1288             $result{'PaymentStatus'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentStatus'};
1289             $result{'TransactionType'}     = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionType'};
1290             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1291             $result{'ParentTransactionID'} = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ParentTransactionID'};
1292             $result{'PaymentType'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentType'};
1293             $result{'PendingReason'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PendingReason'};
1294             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1295             $result{'ReasonCode'}          = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ReasonCode'};
1296             $result{'FeeAmount'}           = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'FeeAmount'};
1297             $result{'ExchangeRate'}        = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ExchangeRate'};
1298                 $result{'giropaytrue'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'RedirectRequired'};
1299 # 22.11.2012, v111b             
1300                 $result{'gift_note'}           = $result{'DoExpressCheckoutPaymentResponseDetails'}{'Note'};
1301
1302           }
1303           else  {
1304                           $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1305                           for my $i (0 .. 3) {
1306                               last unless $result{'Errors'};
1307                                 $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1308                           }
1309           }
1310 #::logDebug("PP".__LINE__.": Doreq result=".::uneval(\%result));
1311
1312         }
1313
1314         my $cntr = '0';
1315
1316 #
1317 # Finished with DoRequest for normal purchase, now for RecurringPayments profiles
1318 # Need to run one complete request/response cycle per Profile
1319 #
1320         foreach  $item (@{$::Carts->{'main'}}) {
1321         my (@activation,@trialperiod,$rpprofile,$rprequest,@profiledetails,@scheduledetails,@end,$cardToken);
1322
1323             $itm = {
1324                                 rpDescription => Vend::Data::item_field($item, 'description'),
1325                                 rpAutoBillOutstandingAmount => Vend::Data::item_field($item, 'rpautobillarrears'),
1326                                 rpMaxFailedPayments => Vend::Data::item_field($item, 'rpmaxfailedpayments'),
1327                                 rpStartDate => Vend::Data::item_field($item, 'rpstartdate'),
1328                                 rpAmount_field => Vend::Data::item_field($item, $rpamount_field),
1329                                 rpAmount => Vend::Data::item_field($item, 'rpamount'),
1330                                 rpShippingAmount => Vend::Data::item_field($item, 'rpshippingamount'),
1331                                 rpTaxAmount => Vend::Data::item_field($item, 'rptaxamount'),
1332                                 rpPeriod => Vend::Data::item_field($item, 'rpperiod'),
1333                                 rpFrequency => Vend::Data::item_field($item, 'rpfrequency'),
1334                                 rpTotalCycles => Vend::Data::item_field($item, 'rptotalcycles'),
1335                                 trialPeriod => Vend::Data::item_field($item, 'rptrialperiod'),
1336                                 trialFrequency => Vend::Data::item_field($item, 'rptrialfrequency'),
1337                                 trialAmount => Vend::Data::item_field($item, $rptrialamount_field),
1338                                 trialShippingAmount => Vend::Data::item_field($item, 'rptrialshippingamount'),
1339                                 trialTaxAmount => Vend::Data::item_field($item, 'rptrialtaxamount'),
1340                                 trialTotalCycles => Vend::Data::item_field($item, 'rptrialtotalcycles'),
1341                                 initAmount => Vend::Data::item_field($item, $rpdeposit_field),
1342                                 initAmountFailedAction => Vend::Data::item_field($item, 'rpdepositfailedaction'),
1343                                 };
1344
1345         my $rpStartDate = $itm->{'rpStartDate'} || $Tag->time({ body => "%Y-%m-%d" });
1346            $rpStartDate .= "T00:00:00";
1347         my $rpPeriod = $::Values->{'rpperiod'} || $itm->{'rpPeriod'};
1348            $rpPeriod = ucfirst(lc($rpPeriod)); # 'type mismatch' error if case not right ...
1349            $rpPeriod = 'SemiMonth' if $rpPeriod =~ /semimonth/i;
1350         my $trialPeriod = $::Values->{'trialperiod'} || $itm->{'trialPeriod'};
1351            $trialPeriod = ucfirst(lc($trialPeriod)); 
1352            $trialPeriod = 'SemiMonth' if $trialPeriod =~ /semimonth/i;
1353         my $rpAmount = $::Values->{'repayamount'} || $itm->{'rpAmount_field'} || $itm->{'rpAmount'};
1354            $rpAmount = sprintf '%.2f', $rpAmount;
1355         my $initamountfailedaction = $::Values->{'initamountfailedaction'} || $itm->{'initAmountFailedAction'};
1356            $initamountfailedaction = 'ContinueOnFailure' if $initamountfailedaction =~ /continueonfailure/i;
1357            $initamountfailedaction = 'CancelOnFailure' if $initamountfailedaction =~ /cancelonfailure/i;
1358
1359 #-- now for the CreateRecurringPayments request ---------------------------------------
1360 #
1361         if ($rpAmount > '0') {
1362             $rpAmount = sprintf '%.02f', $rpAmount;
1363
1364         if ($cntr > '9') {
1365           $::Session->{'errors'}{'Paypal'} = "Paypal will not accept more than ten subscriptions in one order - please remove some and purchase them in
1366           a second order";
1367           return();
1368         };
1369                 $cntr++;
1370
1371                 my $rpref = $invoiceID . "-sub" . $cntr if charge_param('setordernumber');
1372 #::logDebug("PP".__LINE__.": invID=$invoiceID; profRef=$::Values->{'rpprofilereference'}; cnt=$cntr; shipAddress1=$itm->{'shipAddress1'};  rpFreq=$itm->{rpFrequency}; rpAmount=$itm->{rpAmount}; billP=$itm->{rpPeriod}; start=$rpStartDate"); 
1373                 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"
1374 # startdate either proper date format if taken from db or terminal, or may be period hence,
1375 # eg '1 week', '3 days', '2 months'. Eg, deposit (initAmount) now plus payments starting
1376 # in 1 month. 
1377                 if ($rpStartDate =~ /\d+ \w+/){
1378                   my ($adder, $period) = split/ /, $rpStartDate ;  
1379                           $adder *= '7' if $period =~ /week/i;
1380
1381                   my ($year,$month,$day) = Add_Delta_YMD(Today(),'0',"+$adder",'0') if $period =~ /month/i;
1382                          ($year,$month,$day) = Add_Delta_YMD(Today(),'0','0',"+$adder") if $period =~ /day/i;
1383                           $month = sprintf '%02d', $month;
1384                           $day = sprintf '%02d', $day;
1385                          $rpStartDate = "$year-$month-$day" . "T00:00:00Z"; 
1386                 }
1387                    $rpStartDate .= 'T00:00:00Z' if $rpStartDate !~ /T/;
1388
1389                 my $profileReference = $::Values->{'rpprofilereference'} || $rpref;
1390                    $::Values->{'rpprofilereference'} = '';
1391 #::logDebug("PP".__LINE__.": rcStart=$rpStartDate; profRef=$profileReference");
1392
1393
1394
1395                 $shipAddress = (   SOAP::Data->name('SubscriberShippingAddress' =>
1396                                                    \SOAP::Data->value(
1397                                                         SOAP::Data->name('Name' => "$::Values->{'fname'} $::Values->{'lname'}")->type(''),
1398                                                         SOAP::Data->name('Street1' => $::Values->{'address1'})->type(''),
1399                                                         SOAP::Data->name('Street2' => $::Values->{'address2'})->type(''),
1400                                                         SOAP::Data->name('CityName' => $::Values->{'city'})->type(''),
1401                                                         SOAP::Data->name('StateOrProvince' => $::Values->{'state'})->type(''),
1402                                                         SOAP::Data->name('PostalCode' => $::Values->{'zip'})->type(''),
1403                                                         SOAP::Data->name('Country' => $::Values->{'country'})->type(''),
1404                                                         ),
1405                                                    ),
1406                                                 ) if $::Values->{'address1'};
1407
1408           my $payment = (
1409                                                    SOAP::Data->name('PaymentPeriod' => 
1410                                                         \SOAP::Data->value(
1411                                                      SOAP::Data->name('BillingPeriod' => $rpPeriod)->type(''),
1412                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'rpfrequency'} || $itm->{'rpFrequency'})->type(''), 
1413                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'rptotalcycles'} || $itm->{'rpTotalCycles'})->type(''),
1414                                                          SOAP::Data->name('Amount' => $rpAmount)->attr({'currencyID' => $currency})->type(''),
1415                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'rpshippingamount'} || $itm->{'rpShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1416                                                          SOAP::Data->name('TaxAmount' => $::Values->{'rptaxamount'} || $itm->{'rpTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1417                                                          ),
1418                                                    ),
1419                                                 );
1420
1421           my $activation = (    
1422                                                         SOAP::Data->name('ActivationDetails' => 
1423                                                         \SOAP::Data->value(
1424                                                      SOAP::Data->name('InitialAmount' => $::Values->{'initamount'} || $itm->{'initAmount'})->attr({'currencyID' => $currency})->type(''),
1425                                                          SOAP::Data->name('FailedInitialAmountAction' => $initamountfailedaction)->type(''), 
1426                                                                 ),
1427                                                           ),
1428                                                 ) if ($::Values->{'initamount'} || $itm->{'initAmount'});
1429
1430           my $trial =   ( 
1431                                                         SOAP::Data->name('TrialPeriod' => 
1432                                                         \SOAP::Data->value(
1433                                                      SOAP::Data->name('BillingPeriod' => $trialPeriod)->type(''),
1434                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'trialfrequency'} || $itm->{'trialFrequency'})->type(''), 
1435                                                          SOAP::Data->name('Amount' => $::Values->{'trialamount'} || $itm->{'trialAmount'})->attr({'currencyID' => $currency})->type(''),
1436                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'trialshippingamount'} || $itm->{'trialShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1437                                                          SOAP::Data->name('TaxAmount' => $::Values->{'trialtaxamount'} || $itm->{'trialTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1438                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'trialtotalcycles'} || $itm->{'trialTotalCycles'})->type(''),
1439                                                           ),
1440                                                         ),
1441                                                   ) if ($::Values->{'trialamount'} || $itm->{'trialAmount'});
1442
1443                 push @scheduledetails, $payment;
1444                 push @scheduledetails, $activation if length $activation;
1445                 push @scheduledetails, $trial if length $trial;
1446                 push @profiledetails, SOAP::Data->name("BillingStartDate" => $rpStartDate)->type("");
1447                 push @profiledetails, SOAP::Data->name("ProfileReference" => $profileReference)->type("");
1448                 push @profiledetails, $shipAddress if length $shipAddress;
1449                 
1450                 $rprequest = (  
1451                                           SOAP::Data->name("CreateRecurringPaymentsProfileRequest" =>
1452                                           \SOAP::Data->value(
1453                                            SOAP::Data->name("Version" => $version)->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" })->type(''),
1454                                            SOAP::Data->name("CreateRecurringPaymentsProfileRequestDetails" =>
1455                                            \SOAP::Data->value(
1456                                                 SOAP::Data->name("Token" => $::Scratch->{"token"})->type("xs:string"),
1457                                                 SOAP::Data->name("RecurringPaymentsProfileDetails" =>
1458                                                 \SOAP::Data->value(
1459                                                   @profiledetails,
1460                                                   ),
1461                                                 ),
1462                                                 SOAP::Data->name('ScheduleDetails' =>
1463                                                 \SOAP::Data->value(
1464                                                 SOAP::Data->name('Description' => $::Values->{'rpdescription'} || $itm->{'rpDescription'})->type(''),
1465                                                 @scheduledetails,
1466                                                 SOAP::Data->name('MaxFailedPayments' => $::Values->{'rpmaxfailedpayments'} || $itm->{'rpMaxFailedPayments'} || '1')->type(''),
1467                                                 SOAP::Data->name('AutoBillOutstandingAmount' => $::Values->{'rpautobillarrears'} || $itm->{'rpAutoBillOutstandingAmount'} || 'NoAutoBill')->type(''),
1468                                                   ),
1469                                                 ),
1470                                           ),
1471                                         )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1472                                   ),
1473                                 ),
1474                         );
1475
1476 #::logDebug("PP".__LINE__.": dorp=".::uneval($rprequest));
1477
1478 # send separate query to Paypal for each RP profile
1479                 $method = SOAP::Data->name('CreateRecurringPaymentsProfileReq')->attr({ xmlns => $xmlns });
1480             $response = $service->call($header, $method => $rprequest);
1481 no strict 'refs';
1482           my $error = $response->valueof('//faultstring');
1483 use strict;
1484             %result = %{$response->valueof('//CreateRecurringPaymentsProfileResponse')};
1485 #::logDebug("PP".__LINE__.": CreateRecPayresult=".::uneval(\%result));
1486
1487                  $::Session->{'errors'}{'PaypalExpress'} .= $error;
1488                  $::Session->{'errors'}{'PaypalExpress'} .= $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1489                         for my $i (0 .. 3) {
1490                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1491                         }
1492
1493           if ($result{'Ack'} eq "Success") {
1494                 $db = dbref('transactions');
1495                 $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1496             $::Session->{'payment_result'}{'Status'} = 'Success';
1497                 $::Scratch->{'charge_succeed'} = '1';
1498         $result{'order-id'} = $order_id || $opt->{'order_id'};
1499             $result{'CorrelationID'} = $result{'CreateRecurringPaymentsProfileResponse'}{'CorrelationID'};
1500
1501           my ($rpshowsubtotal, $rpshowshipping, $rpshowtax, $rpshowtotal);
1502
1503                         $result{'ProfileID'}     = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileID'};
1504                         $result{'ProfileStatus'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileStatus'};
1505                         $result{'TransactionID'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'TransactionID'};
1506                         my $profilestatus = $result{'ProfileStatus'};
1507                            $profilestatus =~ s/Profile//;
1508
1509 # In log_transaction find ProfileID from ProfileReference, run 'getrpdetails' and put into orderline tbl
1510 # pages/query/order_detail has new col for Subs, link to popup which runs 'getrpdetails' and
1511 # displays info to customer from scratch values
1512
1513         my $sql = "INSERT transactions SET code='$profileReference',order_id='$result{ProfileID}',status='$profilestatus'";
1514
1515                                 $sth = $dbh->prepare($sql);
1516                                 $sth->execute() or die $sth->errstr;
1517 #::logDebug("PP".__LINE__.": Ack=$result{'Ack'}; result=".::uneval(\%result));
1518
1519                   } # if Ack eq success
1520
1521                 } # if item rpAmount
1522
1523           } # foreach item in cart 
1524
1525         }
1526
1527 #---------------------------------------------------------------------------------------
1528 # Manage RecurringPayments: to cancel, suspend or reactivate. Use 'modify' for other ops
1529 #
1530   elsif ($pprequest =~ /managerp/) {
1531  
1532         my ($x,$action) = split(/_/, $pprequest);
1533         my $status = 'Suspended' if $action eq 'suspend';
1534            $status = 'Cancelled' if $action eq 'cancel';
1535            $status = 'Active' if $action eq 'reactivate';
1536            $action = ucfirst(lc($action));
1537
1538                 my $request  = ( 
1539                                           SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequest' =>
1540                                           \SOAP::Data->value(
1541                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1542                                            SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequestDetails' =>
1543                                            \SOAP::Data->value(
1544                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type('xs:string'),
1545                                                  SOAP::Data->name('Action' => $action)->type(''),
1546                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type('xs:string'),
1547                                                 ),
1548                                          )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1549                                   ),
1550                                 ),
1551                           );
1552
1553             $method = SOAP::Data->name('ManageRecurringPaymentsProfileStatusReq')->attr({xmlns=>$xmlns});
1554             $response = $service->call($header, $method => $request);
1555             %result = %{$response->valueof('//ManageRecurringPaymentsProfileStatusResponse')};
1556           
1557                 if ($result{'Ack'} eq 'Success') {
1558               $db  = dbref('transactions') or die errmsg("cannot open transactions table");
1559               $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1560                   $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$status',txtype='PP:RecPay-$status',status='PP:RecPay-$status' WHERE rpprofileid='$::Values->{rpprofileid}'");
1561           $sth->execute() or die $sth->errstr;
1562                 }
1563 #::logDebug("PP".__LINE__.": action=$action; result=".::uneval(%result));
1564                 return(%result);
1565
1566   }
1567
1568 #--------------------------------------------------------------------------------------------
1569 # Get full RecurringPayments details and put into scratch space
1570 #
1571   elsif ($pprequest =~ /getrpdetails/) {
1572         my ($x,$update) = split /_/, $pprequest if $pprequest =~ /_/;
1573         $::Session->{'rpupdate'} = '1' if $update;
1574         getrpdetails();
1575         return();
1576   }
1577
1578 #-----------------------------------------------------------------------------------------
1579 #  RecurringPayments: bill arrears
1580 #
1581   elsif ($pprequest eq 'billrparrears') {
1582
1583                   my $request  = ( 
1584                                           SOAP::Data->name('BillOutstandingAmountRequest' =>
1585                                           \SOAP::Data->value(
1586                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1587                                            SOAP::Data->name('BillOutstandingAmountRequestDetails' =>
1588                                            \SOAP::Data->value(
1589                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type(''),
1590                                                  SOAP::Data->name('Amount' => $amount)->attr({'currencyID' => $currency})->type(''),
1591                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type(''),
1592                                                 ),
1593                                      )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1594                                   ),
1595                                 ),
1596                           );
1597
1598             $method = SOAP::Data->name('BillOutstandingAmountReq')->attr({ xmlns => $xmlns });
1599             $response = $service->call($header, $method => $request);
1600 no strict 'refs';
1601           my $error = $response->valueof('//faultstring');
1602 use strict;
1603             %result = %{$response->valueof('//BillOutstandingAmountResponse')};
1604 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1605
1606                 return(%result);
1607
1608   }
1609
1610 #-------------------------------------------------------------------------------------------------
1611 # REFUND transaction
1612 #
1613  elsif ($pprequest =~ /refund/) {
1614            my @refundreq = (
1615                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1616                     SOAP::Data->name("TransactionID" => $transactionID)->type("ebl:TransactionId"),
1617                     SOAP::Data->name("RefundType" => $refundType)->type(""),
1618                     SOAP::Data->name("Memo" => $memo)->type("xs:string"),
1619                      );
1620
1621           push @refundreq,  SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type("cc:BasicAmountType")
1622                                         if $pprequest eq 'refund_partial';
1623                   
1624      $request = SOAP::Data->name("RefundTransactionRequest" =>
1625                 \SOAP::Data->value( 
1626                                   @refundreq
1627                                   )
1628                                 )->type("ns:RefundTransactionRequestType");
1629
1630             $method = SOAP::Data->name('RefundTransactionReq')->attr({xmlns => $xmlns});
1631             $response = $service->call($header, $method => $request);
1632             %result = %{$response->valueof('//RefundTransactionResponse')};
1633                 
1634                 if ($result{'Ack'} eq "Success") {
1635                         $::Session->{'payment_result'}{'Terminal'} = 'success';
1636                 $::Session->{'payment_result'}{'RefundTransactionID'} = $result{'RefundTransactionResponse'}{'RefundTransctionID'};
1637 #::logDebug("PP".__LINE__.": Refund result=".::uneval(%result));
1638                         return %result;
1639                         }
1640                 }
1641
1642 #-------------------------------------------------------------------------------------------------
1643 # MASSPAY transaction
1644 #
1645  elsif ($pprequest eq 'masspay') {
1646         my ($receiver, $mpamount, $ref, $note, $mpi, @mp);
1647         my $emailsubject = $::Values->{'email_subject'} || 'Paypal payment';
1648     my $message = $::Values->{'vtmessage'};
1649 #::logDebug("PP".__LINE__.": req=$pprequest; list=$message");
1650
1651         if ($message) {
1652                 $message =~ s/\r//g;
1653         foreach my $line (split /\n/, $message) {
1654 #::logDebug("PP".__LINE__.": masspay line=$line");
1655                   ($receiver, $mpamount, $ref, $note) = split /","/, $line;
1656                   $receiver =~ s/^\"//;
1657                   $note =~ s/\"$// || ' ';
1658                   $mpamount = sprintf '%.02f', $mpamount;
1659                   $mpamount =~ s/^\D+//g;
1660
1661 #  need: receiver email/ID, amount, ref, note. Note can be empty but must be quoted
1662                 if ($receiver =~ /\@/) {
1663                 $receiverType = SOAP::Data->name("ReceiverEmail" => $receiver)->type("ebl:EmailAddressType");
1664                         }
1665                 else {
1666                 $receiverType = SOAP::Data->name("ReceiverID" => $receiver)->type("xs:string");
1667                 }
1668                  $mpi = (
1669                   SOAP::Data->name("MassPayItem" =>
1670                    \SOAP::Data->value(
1671                     $receiverType,
1672                     SOAP::Data->name("Amount" => $mpamount)->attr({ "currencyID" => $currency })->type("ebl:BasicAmountType"),
1673                     SOAP::Data->name("UniqueID" => $ref)->type("xs:string"),
1674                     SOAP::Data->name("Note" => $note)->type("xs:string")
1675                     )
1676                  ) ->type("ns:MassPayItemRequestType")
1677               );
1678                 push @mp, $mpi;
1679                         }
1680                   }
1681
1682         $request = SOAP::Data->name("MassPayRequest" =>
1683                            \SOAP::Data->value(
1684                 SOAP::Data->name("Version" => $version)->type("xs:string")->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1685                             SOAP::Data->name("EmailSubject" => $emailsubject)->type("xs:string"),
1686                 @mp
1687                    )
1688                  ) ->type("ns:MassPayRequestType");
1689
1690             $method = SOAP::Data->name('MassPayReq')->attr({ xmlns => $xmlns });
1691             $response = $service->call($header, $method => $request);
1692             %result = %{$response->valueof('//MassPayResponse')};
1693                 $::Session->{'payment_result'}{'Terminal'} = 'success' if $result{'Ack'} eq 'Success';
1694 #::logDebug("PP".__LINE__.":response=$result{Ack},cID=$result{CorrelationID}");
1695 # returns only Ack and CorrelationID on success
1696 #::logDebug("PP".__LINE__.": MassPay result=".::uneval(%result));
1697                 return %result;
1698
1699       }
1700
1701 #---------------------------------------------------------------------------
1702 # IPN
1703 #
1704   elsif ($pprequest =~ /ipn/) {
1705         my $page = ::http()->{'entity'};
1706         my $query = 'https://' . $ipnhost . '/cgi-bin/webscr?cmd=_notify-validate&' . $$page;
1707 #::logDebug("PP".__LINE__.": url=$query");      
1708
1709    my $ua = LWP::UserAgent->new;
1710    my $req = HTTP::Request->new('POST' => $query);
1711           $req->content_type('text/url-encoded');
1712           $req->content();
1713    my $res = $ua->request($req);
1714    my $respcode = $res->status_line;
1715
1716          if ($res->is_success) {
1717                   if ($res->content() eq 'VERIFIED') {
1718                           foreach my $line (split /\&/, $$page) {
1719                                 my ($key, $val) = (split /=/, $line);
1720 #::logDebug("IPN: $key = $val");
1721                                 $result{$key} = $val;
1722 #::logDebug("PP".__LINE__.": IPN result=".::uneval(%result));
1723                                 return %result;
1724
1725                           }
1726                         }
1727                   }
1728           else {
1729           }
1730 #::logDebug("PP".__LINE__.": resp=$res->content()");    
1731
1732         return();
1733
1734   }
1735
1736 #-----------------------------------------------
1737 # Get balance of accounts
1738 #
1739   elsif ($pprequest =~ /getbalance/) {
1740           my ($req, $account) = split (/_/, $pprequest) if $pprequest =~ /_/;
1741                   $account ||= 'Balance';
1742                   
1743            my @balancereq = (
1744                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1745                     SOAP::Data->name("ReturnAllCurrencies" => '1')->type(""),
1746                      );
1747
1748                 $request = SOAP::Data->name("GetBalanceRequest" =>
1749                                         \SOAP::Data->value( 
1750                                          @balancereq
1751                                         )
1752                                   ) ->type("ns:GetBalanceRequestType");
1753
1754             $method = SOAP::Data->name('GetBalanceReq')->attr({xmlns => $xmlns});
1755             $response = $service->call($header, $method => $request);
1756             %result = %{$response->valueof('//GetBalanceResponse')};
1757
1758                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1759                         for my $i (0 .. 3) {
1760                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1761                         }
1762 #::logDebug("PP".__LINE__.": GetBalance result=".::uneval(%result));
1763
1764                 $::Scratch->{'paypalbalance'} = "$account ";
1765                 for my $x ($response->dataof('//BalanceHoldings')) {
1766                         $::Scratch->{'paypalbalance'} .= " :: " . $x->{'_attr'}{'currencyID'} . $x->{'_value'}['0'];
1767
1768                 return;
1769
1770                 }
1771                 
1772   }
1773
1774 #---------------------------------------------------------------------------------------
1775 # DoReferenceTransaction, ie merchant-handled repeat of varying amounts at varying times
1776 #
1777   elsif ($pprequest =~ /dorepeat/) {
1778
1779   }
1780
1781 #--------------------------------------------------------------------------------------
1782 # DoNonReferencedCredit, ie send funds to specified credit card without reference to
1783 # a previous transaction
1784 #
1785   elsif ($pprequest =~ /sendcredit/) {
1786                   
1787                 my @payeraddress = (
1788                         SOAP::Data->name("Name" => $name)->type(""),
1789                         SOAP::Data->name("Street1" => $address1)->type(""),
1790                         SOAP::Data->name("Street2" => $address2)->type(""),
1791                         SOAP::Data->name("CityName" => $city)->type(""),
1792                         SOAP::Data->name("StateOrProvince" => $state)->type(""),
1793                         SOAP::Data->name("PostalCode" => $zip)->type(""),
1794                         SOAP::Data->name("Country" => $country)->type(""),
1795                        );
1796                 push @payeraddress, SOAP::Data->name("Phone" => $phone)->type("") if $phone;
1797 #::logDebug("PP".__LINE__.":payeraddress=".::uneval(@payeraddress));
1798
1799                 my @payername = (  
1800                         SOAP::Data->name("FirstName" => $::Values->{'b_fname'} || $::Values->{'fname'})->type(""),
1801                         SOAP::Data->name("LastName" => $::Values->{'b_lname'} || $::Values->{'lname'})->type(""),
1802                                           );
1803                 push @payername, SOAP::Data->name("MiddleName" => $::Values->{'middlename'})->type("") if $::Values->{'middlename'};
1804                 push @payername, SOAP::Data->name("Salutation" => $::Values->{'salutation'})->type("") if $::Values->{'salutation'};
1805                 push @payername, SOAP::Data->name("Suffix" => $::Values->{'suffix'})->type("") if $::Values->{'suffix'};
1806 #::logDebug("PP".__LINE__.":payername=".::uneval(@payername));
1807
1808                 my @cardowner = (  
1809                         SOAP::Data->name("PayerName" => 
1810                         \SOAP::Data->value(
1811                                                   @payername,
1812                                                   ),
1813                                                 ),
1814                         SOAP::Data->name("Address" => 
1815                         \SOAP::Data->value(
1816                                                   @payeraddress,
1817                                                   ),
1818                                                 ),
1819                                           );
1820                 push @cardowner, SOAP::Data->name("Payer" => $::Values->{'email'})->type("") if $::Values->{'email'};
1821                 push @cardowner, SOAP::Data->name("PayerID" => $::Values->{'payerid'})->type("") if $::Values->{'payerid'};
1822 #::logDebug("PP".__LINE__.":cardowner=".::uneval(@cardowner));
1823
1824                 my $pan = $::CGI->{'mv_credit_card_number'};
1825                    $pan =~ s/\D*//g;
1826                 my $mvccexpyear = $::Values->{'mv_credit_card_exp_year'};
1827                    $mvccexpyear = '20' . $mvccexpyear unless $mvccexpyear =~ /^20/;
1828                 my @creditcard = (
1829                         SOAP::Data->name("CreditCardType" => $::Values->{'mv_credit_card_type'})->type(""),
1830                         SOAP::Data->name("CreditCardNumber" => $pan)->type(""),
1831                         SOAP::Data->name("ExpMonth" => $::Values->{'mv_credit_card_exp_month'})->type(""),
1832                         SOAP::Data->name("ExpYear" => $mvccexpyear)->type(""),
1833                         SOAP::Data->name("CardOwner" => 
1834                         \SOAP::Data->value(
1835                                                   @cardowner,
1836                                                   ),
1837                                                 ),
1838                                           );
1839                 push @creditcard, SOAP::Data->name("CVV2" => $::CGI->{'mv_credit_card_cvv2'})->type("") if $::CGI->{'mv_credit_card_cvv2'};
1840                 push @creditcard, SOAP::Data->name("StartMonth" => $::Values->{'mv_credit_card_start_month'})->type("") if $::Values->{'mv_credit_card_start_month'};
1841                 push @creditcard, SOAP::Data->name("StartYear" => $::Values->{'mv_credit_card_start_year'})->type("") if $::Values->{'mv_credit_card_start_month'};
1842                 push @creditcard, SOAP::Data->name("IssueNumber" => $::Values->{'mv_credit_card_issue_number'})->type("") if $::Values->{'mv_credit_card_issue_number'};
1843 #::logDebug("PP".__LINE__.":creditcard=".::uneval(@creditcard)); 
1844
1845
1846            my @docreditreq = (
1847                     SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type(""),
1848                     SOAP::Data->name("CreditCard" =>
1849                                 \SOAP::Data->value(
1850                                         @creditcard,
1851                                           ),
1852                                          ),
1853                                         );
1854                 push @docreditreq, SOAP::Data->name("Comment" => $::Values->{'vtmessage'})->type("") if $::Values->{'vtmessage'};
1855                 push @docreditreq, SOAP::Data->name("ReceiverEmail" => $::Values->{'email'})->type("") if $::Values->{'email'};
1856 #::logDebug("PP".__LINE__.":docreditreq=".::uneval(@docreditreq));
1857
1858      $request = SOAP::Data->name("DoNonReferencedCreditRequest" =>
1859                                \SOAP::Data->value(
1860                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type(""),
1861                                         SOAP::Data->name("DoNonReferencedCreditRequestDetails" =>
1862                                         \SOAP::Data->value(
1863                                           @docreditreq
1864                                        ),
1865                                      )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1866                                     ),
1867                   );
1868
1869             $method = SOAP::Data->name('DoNonReferencedCreditReq')->attr({xmlns => $xmlns});
1870             $response = $service->call($header, $method => $request);
1871             %result = %{$response->valueof('//DoNonReferencedCreditResponse')};
1872
1873 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1874                 return(%result);
1875
1876 }
1877   
1878 ##
1879 ##============================================================================================
1880 ## Interchange names are on the left, Paypal on the right
1881 ##
1882
1883  my %result_map;
1884  if ($pprequest =~ /dorequest|giropaylog/) {
1885     %result_map = ( qw/
1886                    order-id                     TransactionID
1887                    pop.order-id                 TransactionID
1888                    pop.timestamp                Timestamp
1889                    pop.auth-code                Ack
1890                    pop.status                   Ack
1891                    pop.txn-id                   TransactionID
1892                    pop.refund-txn-id    RefundTransactionID
1893                    pop.cln-id                   CorrelationID
1894         /
1895     );
1896
1897     for (keys %result_map) {
1898         $result{$_} = $result{$result_map{$_}}
1899            if defined $result{$result_map{$_}};
1900 ::logDebug('PP: '.__LINE__."result map: $result{$_}=$result{$result_map{$_}}");           
1901     }
1902   }
1903 ::logDebug("PP".__LINE__.": ack=$result{Ack}; ppreq=$pprequest");
1904   if (($result{'Ack'} eq 'Success') and ($pprequest =~ /dorequest|giropay/)) {
1905          $result{'MStatus'} = $result{'pop.status'} = 'success';
1906          $result{'order-id'} ||= $order_id || $opt->{'order_id'};
1907 ::logDebug("PP".__LINE__.": mstatus=$result{MStatus}"); 
1908            }
1909   elsif (!$result{'Ack'}) {
1910          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1911          $result{'order-id'} = '';
1912          $result{'TxType'} = 'NULL';
1913          $result{'StatusDetail'} = 'UNKNOWN status - check with Paypal';
1914            }
1915   elsif ($result{'Ack'} eq 'Failure') {
1916          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1917          $result{'order-id'} = $result{'pop.order-id'} = '';
1918          $result{'MErrMsg'} = "code $result{'ErrorCode'}: $result{'LongMessage'}\n";
1919       }
1920
1921         $::Values->{'returnurl'} = '';
1922         $::Scratch->{'pprecurringbilling'} = '';
1923
1924 ::logDebug("PP".__LINE__." result:" .::uneval(\%result));
1925     return (%result);
1926
1927 }
1928
1929 #
1930 ##------------------------------------------------------------------------------------------------
1931 #
1932
1933 sub getrpdetails {
1934
1935         my $update = $::Session->{'rpupdate'} || '';
1936         my $profileID = shift || charge_param('rpprofileid') || $::Values->{'rpprofileid'};
1937         $::Values->{'rpprofileid'} = '';
1938         $::Scratch->{'rpprofileid'} = '';
1939         $::Session->{'rpupdate'} = '';
1940 #::logDebug("PP".__LINE__.": getRPdetails: profileID=$profileID");
1941         my $request  = ( 
1942                                           SOAP::Data->name('GetRecurringPaymentsProfileDetailsRequest' =>
1943                                           \SOAP::Data->value(
1944                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1945                                            SOAP::Data->name('ProfileID' => $profileID)->type('xs:string'),
1946                                            ),
1947                                         )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1948                              );
1949
1950            my $method = SOAP::Data->name('GetRecurringPaymentsProfileDetailsReq')->attr({ xmlns => $xmlns });
1951            my $response = $service->call($header, $method => $request);
1952                   %result = %{$response->valueof('//GetRecurringPaymentsProfileDetailsResponse')};
1953
1954                  $::Scratch->{'rpdetails'} = ::uneval(%result);
1955
1956                  $::Scratch->{'rpcorrelationid'} = $result{'CorrelationID'};
1957                  $::Scratch->{'rpprofilereference'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'ProfileReference'};
1958                  $::Scratch->{'rpprofileid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileID'};
1959                  $::Scratch->{'rpdescription'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'Description'};
1960                  $::Scratch->{'rpprofilestatus'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileStatus'};
1961                  $::Scratch->{'rpprofilestatus'} =~ s/Profile//g;
1962                  $::Scratch->{'rpsubscribername'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'SubscriberName'};
1963                  $::Scratch->{'rpstartdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'BillingStartDate'};
1964                  $::Scratch->{'rpstartdate'} =~ s/T/ /;
1965                  $::Scratch->{'rpstartdate'} =~ s/Z//;
1966                  $::Scratch->{'rptaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TaxAmount'};
1967                  $::Scratch->{'rpshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'ShippingAmount'};
1968                  $::Scratch->{'rpamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'Amount'};
1969                  $::Scratch->{'rpgrossamount'} = sprintf '%.2f', ($::Scratch->{'rpamount'} + $::Scratch->{'rpshipping'} + $::Scratch->{'rptax'});
1970                 # $::Scratch->{'rpgrossamount'} = sprintf '%.2f', $rpgross;
1971                  $::Scratch->{'rpfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingFrequency'};
1972                  $::Scratch->{'rpperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingPeriod'};
1973                  $::Scratch->{'rptotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1974                  $::Scratch->{'rpnextbillingdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NextBillingDate'};
1975                  $::Scratch->{'rpnextbillingdate'} =~ s/T/ /g; # format for IC's 'convert-date'
1976                  $::Scratch->{'rpnextbillingdate'} =~ s/Z//g; 
1977                  $::Scratch->{'rpcyclesmade'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesCompleted'};
1978                  $::Scratch->{'rpcyclesfailed'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'FailedPaymentCount'};
1979                  $::Scratch->{'rpcyclesremaining'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesRemaining'};
1980                  $::Scratch->{'rparrears'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'OutstandingBalance'};
1981                  $::Scratch->{'rpmaxfailedpayments'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'MaxFailedPayments'};
1982
1983                  $::Scratch->{'rptrialamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'Amount'};
1984                  $::Scratch->{'rptrialtaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TaxAmount'};
1985                  $::Scratch->{'rptrialshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'ShippingAmount'};
1986                  $::Scratch->{'rptrialfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingFrequency'};
1987                  $::Scratch->{'rptrialperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingPeriod'};
1988                  $::Scratch->{'rptrialtotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1989                  my $rptrialgrossamount = $::Scratch->{'rptrialamount'} + $::Scratch->{'rptrialtaxamount'} + $::Scratch->{'rptrialshippingamount'};
1990                  $::Scratch->{'rptrialgrossamount'} = sprintf '%.2f', $rptrialgrossamount;
1991                  my $finalpaymentduedate = $result{'GetRecurringPaymentsProfileDetailsResponse'}{'FinalPaymentDueDate'};
1992                     $finalpaymentduedate =~ s/T/ /; # format for IC's convert-date routine
1993                  $::Scratch->{'rpfinalpaymentduedate'} = $finalpaymentduedate =~ s/Z//; 
1994                  $::Scratch->{'rpregularamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularAmountPaid'};
1995                  $::Scratch->{'rptrialamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialAmountPaid'};
1996                  my $rptotalpaid = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'AggregateAmount'};
1997
1998 # ### activation details not returned ...
1999                 my $db = dbref('transactions');
2000                 my $dbh = $db->dbh();
2001                 my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
2002                 my $sth = $dbh->prepare("SELECT $rpdeposit_field, rpdepositfailedaction FROM products WHERE description='$::Scratch->{rpdescription}'");
2003                    $sth->execute() or die $sth->errstr;
2004             my @d = $sth->fetchrow_array();
2005                    $::Scratch->{'rpdeposit'} = $d[0];
2006                    $::Scratch->{'rpdepositfailedaction'} = $d[1];
2007
2008
2009                 if ($update) {
2010                         $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$::Scratch->{rpprofilestatus}',status='PPsub-$::Scratch->{rpprofilestatus}',txtype='PPsub-$::Scratch->{rpprofilestatus}' WHERE rpprofileid='$::Scratch->{rpprofileid}'");
2011                         $sth->execute() or die $sth->errstr;
2012                         $::Session->{'rpupdate'} = '';
2013                 }
2014
2015         return($result{'Ack'});
2016 }
2017
2018 sub _ppxmlfilter {
2019 #
2020 # filter for valid XML
2021 #
2022       my $string = shift;
2023                 $string =~ s|&|&amp;|g unless $string =~ /&amp/i;;
2024                 $string =~ s|<|&lt;|g;
2025                 $string =~ s|>|&gt;|g;
2026                 $string =~ s|'|&apos;|g;
2027                 $string =~ s|"|&quot;|g;
2028         return $string;
2029
2030 }
2031
2032 sub _pplocfilter {
2033 #
2034 # filter to remove IC's Locale tags
2035 #
2036       my $string = shift;
2037           $string =~ s|\[L\]||g;
2038           $string =~ s|\[\/L\]||g;
2039       return $string;
2040
2041 }
2042
2043 package Vend::Payment::PaypalExpress;
2044
2045 use Vend::Payment::GatewayLog;
2046 use base qw/Vend::Payment::GatewayLog/;
2047
2048 sub log_it {
2049         my $self = shift;
2050
2051     my $request = $self->request;
2052     unless ($request) {
2053         ::logDebug('Nothing to write to %s: no request present', $self->table);
2054         return;
2055     }
2056
2057     unless ($self->response) {
2058
2059         if ($Vend::Payment::Global_Timeout) {
2060             my $msg = errmsg('No response. Global timeout triggered');
2061             ::logDebug($msg);
2062             $self->response({
2063                 Errors => {
2064                     ErrorCode => -2,
2065                     LongMessage => $Vend::Payment::Global_Timeout,
2066                 },
2067             });
2068         }
2069         else {
2070             my $msg = errmsg('No response. Reason unknown');
2071             ::logDebug($msg);
2072             $self->response({
2073                 Errors => {
2074                     ErrorCode => -3,
2075                     LongMessage => $msg,
2076                 },
2077             });
2078         }
2079     }
2080     my $response = $self->response;
2081
2082     my ($rc,$resp_msg);
2083     if ( $response->{Ack} eq 'Success' ) {
2084         $rc = 0;
2085         $resp_msg = $response->{Ack};
2086     }
2087     else {
2088         $rc = $response->{Errors}{ErrorCode};
2089         # Just in case
2090         $rc =~ s/[^-\d]+//g
2091             if defined $rc;
2092         $resp_msg = $response->{Errors}{LongMessage};
2093     }
2094
2095     $rc = -1
2096         unless length ($rc) && $rc =~ /\d/;
2097
2098     # Don't want unexpected response structures from different errors
2099     # to blow up the error log
2100     no strict 'refs';
2101
2102     my %fields = (
2103         trans_type => $response->{DoExpressCheckoutPaymentResponseDetails}{PaymentInfo}{TransactionType} || 'x',
2104         processor => 'paypalexpress',
2105         catalog => $Vend::Cfg->{CatalogName},
2106         result_code => $rc,
2107         response_msg => $resp_msg || '',
2108         request_id => $response->{DoExpressCheckoutPaymentResponseDetails}{PaymentInfo}{TransactionID} || '',
2109         order_number => $self->{order_number} || '',
2110         request_duration => $self->duration,
2111         request_date => $self->timestamp,
2112         email => $self->{email} || '',
2113         request => ::uneval($request) || '',
2114         response => ::uneval($response) || '',
2115         session_id => $::Session->{id},
2116         request_source => $self->source,
2117     );
2118
2119     $fields{order_md5} =
2120         Digest::MD5::md5_hex(
2121             $self->{email},
2122             $response->{DoExpressCheckoutPaymentResponseDetails}{PaymentInfo}{TransactionType},
2123             $::Scratch->{token},
2124             $self->{amount},
2125             $::Session->{id},
2126             map { ($_->{code}, $_->{quantity}) } @$Vend::Items
2127         )
2128     ;
2129
2130     $self->write(\%fields);
2131 }
2132
2133 1;