Revert "Embed Safe 2.07 into Vend::Safe to avoid various problems with recent version...
[interchange.git] / lib / Vend / Payment / PaypalExpress.pm
1 # Vend::Payment::PaypalExpress - Interchange Paypal Express Payments module
2 #
3 # Copyright (C) 2011 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: ContineOnFailure - 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 allowzeroamount]
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
392
393
394
395 =head1 Changelog
396 version 1.1.0 October 2011
397         - major update:
398         - enabled 'item details' in initial request, so the new-style Paypal checkout page shows
399           an itemised basket
400         - updated masspay to handle multiple recipients properly
401         - added refunds, either full or partial
402         - added 'getbalance', to get the balance of the calling account or any other account for
403           which the credentials are known. If account is multi-currency, then all balances and currencies
404           are displayed in a scratch value.
405         - added 'sendcredit', which sends funds to a specified credit card. You need to know the full
406           billing address and cv2 number, and need to get Paypal to enable this function on your account
407         - added repeat payments, ie recurring billing. Up to the Paypal limit of 10 billing agreements
408           may be set up in one request. Billing agreements may be set up with optional trial periods and
409           deposits, and may be setup with or without an accompanying standard purchase. 
410         - added function to manage repeat payments, ie suspend, reactivate, or cancel
411         - added function to modify repeat payments, ie to alter the billing/shipping address or name,
412           to alter the amount or period etc
413         - added function to get details of a repeat payments billing agreement, and display the results
414           in scratch space including date of next payment, amount paid to date, etc
415         - added function to bill any outstanding arrears in a billing agreement
416         - requires Date::Calc now
417
418 version 1.0.8 July 2010
419         - fixed bug in handling of multiple PP error messages
420
421 version 1.0.7 December 2009
422         - another variation in Canadian Province names has just come to light, whereby they sometimes send
423           the 2 letter code with periods, eg B.C. as well as BC. Thanks to Steve Graham for finding this
424         - patch to allow use of the [assign] tag in shipping
425         - patch to allow 'use_billing_override' to send billing addresses
426         - patch to display Long rather than Short PP error message to customers
427           Thanks to Josh Lavin for these last three
428         
429 version 1.0.6 September 2009
430         - added 'use strict' and fixed odd errors (and removed giropay vestiges that belong in next version)
431         - made itemdetails loop through basket properly
432         - added Fraud Management Filters return messages to optional charge parameters
433 version 1.0.5, June 2009
434         - fixed bug with Canadian provinces: PP were sending shortened versions of 2 province names, and also 
435           sometimes sending the 2 letter code (possibly from older a/cs) rather than the full name. Thanks to 
436           Steve Graham for finding this.
437 version 1.0.4, May 2009
438         - re-wrote documentation, including revised and simplified method of co-operating with other payment
439           systems in log_transaction. 
440
441 version 1.0.3, 1.02.2009
442         - fixed bug in handling of thousands separator
443
444 version 1.0.2, 22.01.2009 
445         - conversion of Canadian province names to 2 letter variant is now the default
446         - fixed bug with conversion of Canadian province names to 2 letter variant
447         - changed method of reading value of pprequest
448         - added failsafe logging to orders/paypal/ in case of order route failure
449         - fixed bug whereby PP returns billing name in a shipping address
450         - added note to docs re PP requiring cookie
451         - altered internal redirection code to better handle absence of cookies (thanks to Peter Ajamian for heads-up)
452         - altered docs to reflect the new sandbox (thanks to Josh Lavin for the heads-up on that)
453         - TODO: as the new API now includes a SOAP integration of recurring/subscription billing, need 
454                 to convert existing name=value pair IPN module and integrate into this module. Will add
455                 masspay, refund and other functions at the same time. 
456
457 version 1.0.1, 24.05.2008 
458         - added error message to IC session for when Paypal returns error message instead of token.
459         - added option to convert Canadian state/province names to an uppercased 2 letter variant, so
460             as to agree with Interchange's de facto requirement for this.
461 =back
462
463 =head1 AUTHORS
464
465 Lyn St George <info@zolotek.net>
466
467 =cut
468
469 BEGIN {
470         eval {
471                 package Vend::Payment;
472                 require SOAP::Lite or die __PACKAGE__ . " requires SOAP::Lite";
473 # without this next it defaults to Net::SSL which may crash
474                 require IO::Socket::SSL or die __PACKAGE__ . " requires IO::Socket::SSL";
475                 require Net::SSLeay;
476                 require LWP::UserAgent;
477                 require HTTP::Request;
478         require Date::Calc;
479                 use Date::Calc qw(Add_Delta_YMD Today Today_and_Now);
480                 use POSIX 'strftime';
481         };
482
483                 $Vend::Payment::Have_Net_SSLeay = 1 unless $@;
484
485         if ($@) {
486                 $msg = __PACKAGE__ . ' requires SOAP::Lite and IO::Socket::SSL ' . $@;
487                 ::logGlobal ($msg);
488                 die $msg;
489         }
490
491         ::logGlobal("%s v1.1.0m 20120121 payment module loaded",__PACKAGE__)
492                 unless $Vend::Quiet or ! $Global::VendRoot;
493 }
494
495 package Vend::Payment;
496 #use SOAP::Lite +trace; # ### debugging only ###
497 use strict;
498
499     my (%result, $header, $service, $version, $xmlns, $currency);
500
501 sub paypalexpress {
502     my ($token, $request, $method, $response, $in, $opt, $actual, $basket, $itemCode, $tax, $invoiceID);
503         my ($item, $itm, $basket, $setrpbillagreement, $rpprofile, $db, $dbh, $sth);
504
505         foreach my $x (@_) {
506                     $in = { 
507                                 pprequest => $x->{'pprequest'},
508                            }
509         }
510
511 #::logDebug("PP".__LINE__.": sandbox=$::Values->{ppsandbox} ". charge_param('sandbox'). "req=".charge_param('pprequest'));
512         my $pprequest   = charge_param('pprequest') || $::Values->{'pprequest'} || $in->{'pprequest'} || 'setrequest'; # 'setrequest' must be the default for standard Paypal. 
513         my $sandbox     = charge_param('sandbox') || $::Values->{'sandbox'} || $::Values->{'ppsandbox'} || ''; # 1 or true to use for testing
514            $sandbox     = '' unless $sandbox =~ /sandbox|1/;
515            $sandbox     = "sandbox." if $sandbox =~ /sandbox|1/;
516            $::Values->{'ppsandbox'} = $::Values->{'sandbox'} = '';
517            $::Scratch->{'mstatus'} = '';
518 #::logDebug("PP".__LINE__.": sandbox=$sandbox passwd=".charge_param('password')." sig=".charge_param('signature'));
519
520            $currency = $::Values->{'iso_currency_code'} || $::Values->{'currency_code'} || $::Scratch->{'iso_currency_code'}  || 
521                                    $Vend::Cfg->{'Locale'}{'iso_currency_code'} || charge_param('currency')  || $::Variable->{MV_PAYMENT_CURRENCY} || 'USD';
522            $::Scratch->{'iso_currency_code'} ||= $currency;
523
524 # Credentials, prefixed with lower-cased account name if using 'getbalance' for more than one account
525         my $account     = lc($pprequest) if $pprequest =~ /getbalance_/ || '';
526            $account     =~ s/getbalance_//;
527            $account     .= '_' if length $account;
528            $sandbox     = "sandbox." if $account =~ /sandbox/;
529     my ($username, $password, $signature);
530     if (length $sandbox && charge_param('sandbox_id')) {
531         $username   = charge_param('sandbox_id');
532         $password   = charge_param('sandbox_password');
533         $signature  = charge_param('sandbox_signature');
534     }
535     else {
536         $username    = charge_param($account . 'id');
537         $password    = charge_param($account . 'password');
538         $signature   = charge_param($account . 'signature');
539     }
540
541     unless ($username && $password && $signature) {
542          return (
543                         MStatus => 'failure-hard',
544                         MErrMsg => errmsg('Bad credentials'),
545                 );
546     }
547     
548         my $ppcheckreturn = $::Values->{'ppcheckreturn'} || 'ord/checkout';
549         my $checkouturl = $::Tag->area({ href => "$ppcheckreturn" });
550 #::logDebug("PP".__LINE__.": req=$pprequest; sandbox=$sandbox;");
551 #::logDebug("PP".__LINE__.": amt=" .Vend::Interpolate::total_cost() . "-" . charge_param('amount') ."-". $::Values->{'amount'});
552
553 #       my $amount =  charge_param('amount') || Vend::Interpolate::total_cost() || $::Values->{amount}; # required
554         my $amount =  charge_param('amount') || Vend::Interpolate::total_cost() || $::Values->{'amount'}; # required
555            $amount =~ s/^\D*//g;
556            $amount =~ s/\s*//g;
557            $amount =~ s/,//g;
558
559 # for a SET request
560         my $host               = charge_param('host') ||  'api-3t.paypal.com'; #  testing 3-token system is 'api-3t.sandbox.paypal.com'.
561            $host               = 'api-3t.sandbox.paypal.com' if length $sandbox;
562         my $ipnhost                        = 'www.paypal.com';
563            $ipnhost            = 'www.sandbox.paypal.com' if length $sandbox;
564         my $setordernumber     = charge_param('setordernumber') || '1'; # unset to revert to using a temp order number until order settled
565            $invoiceID          = $::Values->{'inv_no'} || $::Values->{'mv_transaction_id'} || $::Values->{'order_number'} || '' unless $setordernumber; # optional
566         my $ordercounter       = charge_param('order_counter') || 'etc/order.number';
567         my $returnURL          = charge_param('returnurl') or die "No return URL found\n"; # required
568         my $cancelURL          = charge_param('cancelurl') or die "No cancel URL found\n"; # required
569         my $notifyURL          = charge_param('notifyurl') || ''; # for IPN
570         my $maxAmount          = $::Values->{'maxamount'} || $amount * '2';  # optional
571            $maxAmount          = sprintf '%.2f', $maxAmount;
572         my $orderDescription   = '';
573         my $address            = '';
574         my $reqConfirmShipping = $::Values->{'reqconfirmshipping'} || charge_param('reqconfirmshipping') || ''; # you require that the customer's address must be "confirmed"
575         my $returnFMFdetails   = $::Values->{'returnfmfdetails'} || charge_param('returnfmfdetails') || '0'; # set '1' to return FraudManagementFilter details
576         my $noShipping         = $::Values->{'noshipping'} || charge_param('noshipping') || ''; # no shipping displayed on Paypal pages
577         my $addressOverride    = $::Values->{'addressoverride'} || charge_param('addressoverride') || ''; # if '1', Paypal displays address given in SET request, not the one on Paypal's file
578
579 # new style checkout 'co-branding' options
580         my $localeCode         = $::Values->{'localecode'} || $::Session->{'mv_locale'} || charge_param('localecode') || 'US';
581         my $pageStyle          = $::Values->{'pagestyle'} || charge_param('pagestyle') || ''; # set in Paypal account
582         my $headerImg          = $::Values->{'headerimg'} || charge_param('headerimg') || ''; # max 750x90, classic checkout, left-aligned, from your secure site
583         my $logoImg            = $::Values->{'logoimg'} || charge_param('logoimg') || ''; # max 190x60, 'new style checkout', centred in 'cart area', from your secure site
584         my $cartBorderColor    = $::Values->{'cartbordercolor'} || charge_param('cartbordercolor'); # hex code, without '#'
585         my $headerBorderColor  = $::Values->{'headerbordercolor'} || charge_param('headerbordercolor') || '';
586         my $headerBackColor    = $::Values->{'headerbackcolor'} || charge_param('headerbackcolor') || '';
587         my $payflowColor       = $::Values->{'payflowcolor'} || charge_param('payflowcolor') || '';
588
589         my $paymentAction      = $::Values->{'paymentaction'} || charge_param('paymentaction') || 'Sale'; # others: 'Order', 'Authorization'
590         my $buyerEmail         = $::Values->{'buyeremail'} || '';
591         my $custom             = $::Scratch->{'mv_currency'} || $::Scratch->{'mv_locale'}; 
592        $custom           ||= 'en_' . lc(substr($currency,0,1));
593 # these next taken from IC after customer has logged in, and used in '$addressOverride'
594         my $usebill  = $::Values->{'use_billing_override'} || charge_param('use_billing_override');
595         my $name     = $usebill ? "$::Values->{'b_fname'} $::Values->{'b_lname'}" || '' : "$::Values->{'fname'} $::Values->{'lname'}" || '';
596         my $address1 = $usebill ? $::Values->{'b_address1'} : $::Values->{address1};
597         my $address2 = $usebill ? $::Values->{'b_address2'} : $::Values->{address2};
598         my $city     = $usebill ? $::Values->{'b_city'} : $::Values->{city};
599         my $state    = $usebill ? $::Values->{'b_state'} : $::Values->{state};
600         my $zip      = $usebill ? $::Values->{'b_zip'} : $::Values->{zip};
601         my $country  = $usebill ? $::Values->{'b_country'} : $::Values->{country};
602            $country  = 'GB' if ($country eq 'UK'); # plonkers reject UK
603         my $phone    = $::Values->{'phone_day'} || $::Values->{'phone_night'};
604            
605 # for a Do request, and Set with item details
606         my $dsmode            = $::Variable->{'DSMODE'}; # for any custom shipping tags
607         my $itemTotal     = $::Values->{'itemtotal'} || Vend::Interpolate::subtotal() || '';
608            $itemTotal     = sprintf '%.2f', $itemTotal;
609         my $shipTotal     = $::Values->{'shiptotal'} || Vend::Interpolate::tag_shipping() || '' unless  $::Variable->{'DSMODE'};
610            $shipTotal     = $::Tag->$dsmode() if $::Variable->{'DSMODE'};
611            $shipTotal     = sprintf '%.2f', $shipTotal;
612         my $taxTotal      = $::Values->{'taxtotal'} || Vend::Interpolate::salestax() || '';
613            $taxTotal      = sprintf '%.2f', $taxTotal;
614         my $handlingTotal = $::Values->{'handlingtotal'} || Vend::Ship::tag_handling() || '';
615            $handlingTotal = sprintf '%.2f', $handlingTotal;
616
617         my $buttonSource        = $::Values->{'buttonsource'} || charge_param('buttonsource') || ''; # for third party source
618         my $paymentDetailsItem  = $::Values->{'paymentdetailsitem'} || charge_param('paymentdetailsitem') || ''; # set '1' to include item details
619         my $transactionID       = $::Values->{'transactionid'} || ''; # returned upon success, but not for recurring billing, only the correlationid
620         my $correlationID       = $::Values->{'correlationid'} || ''; # use for any dispute with Paypal
621         my $refundtransactionID = $::Values->{'refundtransactionid'} || ''; # log for reference
622         my $quantity            = $::Tag->nitems() || '1';
623
624         my $itemised_basket_off = delete $::Values->{'itemised_basket_off'} || charge_param('itemised_basket_off');
625
626 # if $paymentDetailsItem is set, then need to pass an item amount to keep Paypal happy
627         my $itemAmount   = $amount / $quantity;
628            $itemAmount   = sprintf '%.2f', $itemAmount;
629            $amount       = sprintf '%.2f', $amount;
630         my $receiverType = $::Values->{'receiverType'} || charge_param('receivertype') || 'EmailAddress'; # used in MassPay
631            $version      = '74.0';
632         my $order_id  = gen_order_id($opt);
633 #::logDebug("PP".__LINE__.": oid=$order_id; amount=$amount, itemamount=$itemAmount; tax=$taxTotal, ship=$shipTotal, hdl=$handlingTotal");
634
635 # new fields for v 1.1.0 and API v 74
636         my $softDescriptor    = $::Values->{'soft_descriptor'} || charge_param('soft_descriptor'); # appears on customer's card statement
637         my $allowNote         = $::Values->{'allow_note'} || charge_param('allow_note'); # allow customer to enter note at Paypal
638         my $brandName         = $::Values->{'brand_name'} || charge_param('brand_name'); # max 127 chars, over-rides the business name at Paypal
639         my $servicePhone      = $::Values->{'service_phone'} || charge_param('service_phone'); # displayed to customer
640         my $giftMessageEnable = $::Values->{'gift_message_enable'} || charge_param('gift_message_enable'); # 0 or 1
641         my $giftReceiptEnable = $::Values->{'gift_receipt_enable'} || charge_param('gift_receipt_enable'); # 0 or 1
642         my $giftWrapEnable    = $::Values->{'gift_wrap_enable'} || charge_param('gift_wrap_enable'); # 0 or 1
643         my $giftWrapName      = $::Values->{'gift_wrap_name'}; 
644         my $giftWrapAmount    = $::Values->{'gift_wrap_amount'};
645         my $buyerEmailOptin   = $::Values->{'buyer_email_optin'} || charge_param('buyer_email_optin');  # 0 or 1
646         my $surveyEnable      = $::Values->{'survey_enable'} || charge_param('survey_enable'); # 0 or 1
647         my $surveyQuestion    = $::Values->{'survey_question'} || charge_param('survey_question');
648         my $surveyChoice      = $::Values->{'survey_choice'} || charge_param('survey_choice');
649         my $allowPushFunding  = $::Values->{'allow_push_funding'} || charge_param('allow_push_funding'); # 0 or `
650         my $allowedPayMethod  = $::Values->{'allowed_payment_method'} || charge_param('allowed_payment_method'); #
651         my $landingPage       = $::Values->{'landing_page'} || charge_param('landing_page');
652         my $solutionType      = $::Values->{'solution_type'} || charge_param('solution_type');
653         my $totalType         = $::Values->{'total_type'} || charge_param('total_type') || 'EstimatedTotal'; # or 'Total' if is known accurately
654
655
656
657         # for Giropay
658         my $giropaySuccessURL = $::Values->{'giropay_success_url'} || charge_param('giropay_success_url');
659         my $giropayCancelURL  = $::Values->{'giropay_cancel_url'} || charge_param('giropay_cancel_url');
660         my $BanktxnPendingURL = $::Values->{'bnktxn_pending_url'} || charge_param('bnktxn_pending_url');
661         my $giropayaccepted   = $::Values->{'giropay_accepted'} || charge_param('giropay_accepted') || '1';
662         my $giropayurl        = "https://www." . $sandbox . "paypal.com/cgi-bin/webscr?cmd=_complete-express-checkout";
663
664 #-----------------------------------------------------------------------------------------------
665         # for operations through the payment terminal, eg 'masspay', 'refund' etc
666         my  $refundType    = $::Values->{'refundtype'} || 'Full'; # either 'Full' or 'Partial'
667         my  $memo          = $::Values->{'memo'} || '';
668         my  $orderid       = $::Values->{'mv_order_id'} || '';
669         my  $emailSubject  = $::Values->{'emailsubject'} || ''; # subject line of email
670         my  $receiverEmail = $::Values->{'receiveremail'} || ''; # address of refund recipient
671
672
673         $xmlns = 'urn:ebay:api:PayPalAPI';
674
675             $service = SOAP::Lite->proxy("https://$host/2.0/")->uri($xmlns);
676             # Ignore the paypal typecasting returned
677             *SOAP::Deserializer::typecast = sub {shift; return shift};
678
679 #-------------------------------------------------------------------------------------------------
680 ### Create the Security Header
681 #
682             $header = SOAP::Header->name("RequesterCredentials" =>
683                                         \SOAP::Header->value(
684                                                 SOAP::Data->name("Credentials" =>
685                                                         \SOAP::Data->value(
686                                                                 SOAP::Data->name("Username" => $username )->type("xs:string"),
687                                                                 SOAP::Data->name("Password" => $password )->type("xs:string"),
688                                                                 SOAP::Data->name("Signature" => $signature)->type("xs:string")
689                                                         )
690                                                 )
691                                                  ->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})
692                                         )
693                                 )
694                                  ->attr({xmlns=>$xmlns})->mustUnderstand("1");
695
696
697 #--------------------------------------------------------------------------------------------------
698 ### Create a SET request and method, and read response
699 #
700         my ($item,$itm,@pditems,@pdi,$pdi,$pdiamount,$itemtotal,$pdisubtotal,$cntr,$pditotalamount,$rpamount,$itemname);
701
702         if ($pprequest eq 'setrequest') {
703           if (charge_param('setordernumber') == '1') {
704                   $invoiceID = $::Values->{'inv_no'} || Vend::Interpolate::tag_counter( $ordercounter );
705                   $::Values->{'mv_order_number'} = $::Session->{'mv_order_number'} = $invoiceID;
706                   $::Scratch->{'ordernumberalreadyset'} = '1';
707           }
708
709 # start with required elements, add optional elements if they exist
710                    my @setreq = (
711                                        SOAP::Data->name("ReturnURL" => $returnURL)->type(""),
712                                        SOAP::Data->name("CancelURL" => $cancelURL)->type(""),
713                                                 );
714                 push @setreq,  SOAP::Data->name("ReqConfirmShipping" => $reqConfirmShipping)->type("xs:string") if $reqConfirmShipping;
715                 push @setreq,  SOAP::Data->name("NoShipping" => $noShipping)->type("xs:string") if $noShipping;
716                 push @setreq,  SOAP::Data->name("AddressOverride" => $addressOverride)->type("xs:string") if $addressOverride;
717                 push @setreq,  SOAP::Data->name("PageStyle" => $pageStyle)->type("xs:string") if $pageStyle;
718                 push @setreq,  SOAP::Data->name("BuyerEmail" => $buyerEmail)->type("xs:string") if $buyerEmail;
719                 push @setreq,  SOAP::Data->name("cpp-header-image" => $headerImg)->type("xs:string") if $headerImg;
720                 push @setreq,  SOAP::Data->name("cpp-logo-image" => $logoImg)->type("xs:string") if $logoImg;
721                 push @setreq,  SOAP::Data->name("cpp-header-border-color" => $headerBorderColor)->type("xs:string") if $headerBorderColor;
722                 push @setreq,  SOAP::Data->name("cpp-header-back-color" => $headerBackColor)->type("xs:string") if $headerBackColor;
723                 push @setreq,  SOAP::Data->name("cpp-payflow-color" => $payflowColor)->type("xs:string") if $payflowColor;
724                 push @setreq,  SOAP::Data->name("cpp-cart-border-color" => $cartBorderColor)->type("xs:string") if $cartBorderColor;
725                 push @setreq,  SOAP::Data->name("LandingPage" => $landingPage)->type("ebl:LandingPageType") if $landingPage;
726                 push @setreq,  SOAP::Data->name("SolutionType" => $solutionType)->type("ebl:SolutionTypeType") if $solutionType;
727                 push @setreq,  SOAP::Data->name("MaxAmount" => $maxAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $maxAmount;
728                 push @setreq,  SOAP::Data->name("CustomerServiceNumber" => $servicePhone)->type("xs:string") if $servicePhone;
729                 push @setreq,  SOAP::Data->name("GiftMessageEnable" => $giftMessageEnable)->type("xs:string") if $giftMessageEnable; # 0 or 1
730                 push @setreq,  SOAP::Data->name("GiftReceiptEnable" => $giftReceiptEnable)->type("xs:string") if $giftReceiptEnable; # 0 or 1
731                 push @setreq,  SOAP::Data->name("GiftWrapEnable" => $giftWrapEnable)->type("xs:string") if $giftWrapEnable; # 0 or 1
732                 push @setreq,  SOAP::Data->name("GiftWrapName" => $giftWrapName)->type("xs:string") if $giftWrapName; # 25 chars
733                 push @setreq,  SOAP::Data->name("GiftWrapAmount" => $giftWrapAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $giftWrapAmount;
734                 push @setreq,  SOAP::Data->name("BuyerEmailOptinEnable" => $buyerEmailOptin)->type("xs:string") if $buyerEmailOptin; # 0 or 1
735                 push @setreq,  SOAP::Data->name("SurveyEnable" => $surveyEnable)->type("xs:string") if $surveyEnable; # 0 or 1
736                 push @setreq,  SOAP::Data->name("SurveyQuestion" => $surveyQuestion)->type("xs:string") if $surveyQuestion; # max 50 chars
737                 push @setreq,  SOAP::Data->name("SurveyChoice" => $surveyChoice)->type("xs:string") if $surveyChoice; # max 15 chars
738                 push @setreq,  SOAP::Data->name("LocaleCode" => $localeCode)->type("xs:string") if $localeCode;
739                 push @setreq,  SOAP::Data->name("AllowNote" => $allowNote)->type("xs:string") if defined $allowNote; # 0 or 1
740 #               push @setreq,  SOAP::Data->name("TotalType" => $totalType)->type("") if $totalType; # ### crashes ... ###
741
742
743 #::logDebug("PP".__LINE__.": itemTotal=$itemTotal; taxTotal=$taxTotal");
744
745 # now loop through the basket and put every item into iterated PaymentDetailsItem blocks, and 
746 # recurring payments items into iterated BillingAgreeement blocks. Explicit arrays not needed.
747
748                   foreach  $item (@{$::Carts->{'main'}}) {
749                         my $rpamount_field = 'rpamount_' . lc($currency) || 'rpamount';
750                           $itm = {
751                                           sku => $item->{'code'},
752                                           quantity => $item->{'quantity'},
753                                           amount => Vend::Data::item_price($item),
754                                           description => Vend::Data::item_field($item, 'description'),
755                                           title => Vend::Data::item_field($item, 'title'),
756                                           rpamount => Vend::Data::item_field($item, 'rpamount'),
757                                           rpamount_field => Vend::Data::item_field($item, $rpamount_field),
758                                           };
759
760                         $itemname = $itm->{'title'} || $itm->{'description'};
761                         $pdiamount = $itm->{'amount'};
762                         $pdiamount = sprintf '%.02f', $pdiamount;
763                         $pdisubtotal = $pdiamount * $itm->{'quantity'};
764 #::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");
765
766                     $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
767           if ($rpamount) {
768 #::logDebug("PP".__LINE__.": cntr=$cntr;  rpamount=$rpamount"); 
769
770             $setrpbillagreement = (
771                                            SOAP::Data->name("BillingAgreementDetails" =>
772                                            \SOAP::Data->value(
773                                             SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),
774                                                 SOAP::Data->name("BillingAgreementDescription" => $itm->{'description'})->type(""),
775                                                       )
776                                                     )->type("ns:BillingAgreementDetailsType"),
777                                                 );
778
779                   if ($cntr > '9') {
780                         $::Session->{'errors'}{'Paypal'} = "Paypal will not accept more than ten subscriptions in one order - please remove some and purchase them in
781                         a second order";
782                         return();
783                   };
784           $cntr++;
785         
786         $::Scratch->{'allowzeroamount'} = '1'; # use in log_transaction
787         push @setreq, $setrpbillagreement;
788
789           } # if RecPay item in basket loop
790 #
791 # Finished with BillingAgreeements, now for PaymentDetailsItem in basket loop
792 # Separate block for each item: also include those which are RecPay items
793 #
794                           $pditotalamount += $pdisubtotal; # to overcome rounding errors in currency conversions
795 #::logDebug("PP".__LINE__.":amt=$amount; pditotalamount=$pditotalamount; pdiamount=$pdiamount");
796
797                        @pdi = SOAP::Data->name("Name" => $itemname)->type("");
798               push @pdi, SOAP::Data->name("Amount" => $pdiamount)->attr({"currencyID" => $currency})->type("");
799               push @pdi, SOAP::Data->name("Number" => $itm->{'sku'})->type("");
800               push @pdi, SOAP::Data->name("Description" => $itm->{'description'})->type("") if $itm->{'description'};
801               push @pdi, SOAP::Data->name("Quantity" => $itm->{'quantity'})->type("") if $itm->{'quantity'};
802               push @pdi, SOAP::Data->name("ItemWeight" => $itm->{'weight'})->type("") if $itm->{'weight'};
803               push @pdi, SOAP::Data->name("ItemWidth" => $itm->{'width'})->type("") if $itm->{'width'};
804               push @pdi, SOAP::Data->name("ItemLength" => $itm->{'length'})->type("") if $itm->{'length'};
805               push @pdi, SOAP::Data->name("ItemHeight" => $itm->{'height'})->type("") if $itm->{'height'};
806               push @pdi, SOAP::Data->name("ItemURL" => $itm->{'murl'})->type("") if $itm->{'url'};
807               push @pdi, SOAP::Data->name("ItemCategory" => $itm->{'category'})->type("") if $itm->{'category'}; # required as 'Digital' for digital goods, else optional as 'Physical'
808
809                  $pdi  = (
810                         SOAP::Data->name("PaymentDetailsItem" =>
811                         \SOAP::Data->value(
812                                           @pdi,
813                             )
814                           )->type("ebl:PaymentDetailsItemType"),
815                         );
816
817                   push @pditems, $pdi unless $itemised_basket_off == '1';
818                         $cntr++;
819           } # foreach item in basket
820
821 #
822 # Finished basket loop for each item, now for PaymentDetails
823 #
824 #::logDebug("PP".__LINE__.": vship=$::Values->{'shiptotal'}; tag=" .Vend::Interpolate::tag_shipping());
825 # calculate here so as to avoid rounding errors and rejection at Paypal
826         my $itemtotal     = $pditotalamount;
827            $itemtotal     = sprintf '%.2f', $itemtotal;
828         my $shiptotal     = $::Values->{'shiptotal'} || Vend::Interpolate::tag_shipping() || '' unless  $::Variable->{'DSMODE'};
829            $shiptotal     = $::Tag->$dsmode() if $::Variable->{'DSMODE'};
830            $shiptotal     = sprintf '%.2f', $shiptotal;
831         my $handlingtotal = $::Values->{'handlingtotal'} || Vend::Ship::tag_handling() || '';
832            $handlingtotal = sprintf '%.2f', $handlingtotal;
833         my $taxtotal      = $::Values->{'taxtotal'} || Vend::Interpolate::salestax() || '';
834            $taxtotal      = sprintf '%.2f', $taxtotal;
835 #::logDebug("PP".__LINE__.": tax=$::Values->{taxtotal}; ". Vend::Interpolate::salestax());
836            $amount = $itemtotal + $shiptotal + $taxtotal + $handlingtotal;
837
838            my $shiptoaddress = (
839                        SOAP::Data->name("ShipToAddress" =>
840                        \SOAP::Data->value(
841                         SOAP::Data->name("Name" => $name)->type(""),
842                         SOAP::Data->name("Street1" => $address1)->type(""),
843                         SOAP::Data->name("Street2" => $address2)->type(""),
844                         SOAP::Data->name("CityName" => $city)->type(""),
845                         SOAP::Data->name("StateOrProvince" => $state)->type(""),
846                         SOAP::Data->name("PostalCode" => $zip)->type(""),
847                         SOAP::Data->name("Country" => $country)->type(""),
848                         SOAP::Data->name("Phone" => $phone)->type(""),
849                             )
850                           )
851                         ) if length $address1;
852
853                 my @pd =  SOAP::Data->name("OrderTotal" => $amount)->attr({"currencyID" => $currency})->type('');
854                 push @pd, SOAP::Data->name("ItemTotal" => $itemtotal)->attr({"currencyID" => $currency})->type("") if $itemtotal;
855                 push @pd, SOAP::Data->name("TaxTotal" => $taxtotal)->attr({"currencyID" => $currency})->type("") if $taxtotal;
856                 push @pd, SOAP::Data->name("ShippingTotal" => $shiptotal)->attr({"currencyID" => $currency})->type("") if $shiptotal;
857                 push @pd, SOAP::Data->name("HandlingTotal" => $handlingtotal)->attr({"currencyID" => $currency})->type("") if $handlingtotal;
858                 push @pd, SOAP::Data->name("InvoiceID" => $invoiceID)->type("") if length $invoiceID;
859                 push @pd, SOAP::Data->name("NotifyURL" => $notifyURL)->type("") if $notifyURL;
860                 push @pd, SOAP::Data->name("Custom" => $custom)->type("") if $custom;
861 #               push @pd, SOAP::Data->name("TransactionID" => $order_id)->type(""); # ###
862                 push @pd, $shiptoaddress if length $addressOverride;
863                 push @pd, @pditems unless $itemised_basket_off == '1';
864
865         my $paymentDetails = (
866                         SOAP::Data->name("PaymentDetails" =>
867                         \SOAP::Data->value(
868                                         @pd,
869                                         )
870                                   )->type(""),
871                                 );
872
873           push @setreq, $paymentDetails;
874           push @setreq, SOAP::Data->name("BrandName" => $brandName)->type("") if ($brandName and !$setrpbillagreement);
875 #::logDebug("PP".__LINE__.": ppdiscnote=$::Values->{pp_discount_note}");
876                 my $note_to_buyer = $::Values->{'pp_note_to_buyer'};
877                    $note_to_buyer =~ s|\<.*\>||g;
878                    $note_to_buyer .= " *** Discounts and coupons will be shown and applied before final payment" if  $::Values->{'pp_discount_note'};
879                 my $note  = (
880                         SOAP::Data->name("NoteToBuyer" => $note_to_buyer)->type(""),
881                         );
882                 $::Values->{'pp_discount_note'} = '';
883
884           push @setreq, $note; # ### 
885
886                                                         
887         my ($bt,$rpdesc,$rpAgreementAmount,$rpStartDate);                                               
888
889 # rpStartDate > dateTime
890         my @maxrpamt;
891         my @setrpbill;
892         my $cntr = '0';
893
894 #print "PP".__LINE__.": setreq=".::uneval(@setreq);
895
896 # Destroy the token here at the start of a new request, rather than after a 'dorequest' has completed,
897 # as Paypal use it to reject duplicate payments resulting from clicking the final 'pay' button more
898 # than once.
899   
900    undef $result{'Token'};
901
902                 $request = SOAP::Data->name("SetExpressCheckoutRequest" =>
903                                 \SOAP::Data->value(
904                                  SOAP::Data->name("Version" => $version)->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
905                                  SOAP::Data->name("SetExpressCheckoutRequestDetails" =>
906                                  \SOAP::Data->value(@setreq
907                                        )
908                                      ) ->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
909                                )
910                              );
911
912             $method = SOAP::Data->name('SetExpressCheckoutReq')->attr({xmlns=>$xmlns});
913             $response = $service->call($header, $method => $request);
914             %result = %{$response->valueof('//SetExpressCheckoutResponse')};
915                 $::Scratch->{'token'} = $result{'Token'};
916  
917    if (!$result{'Token'}) {
918     if ($result{'Ack'} eq 'Failure') {
919                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
920                         for my $i (0 .. 3) {
921                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
922                                         }
923                          }
924     else {
925        my $accepted = uc($::Variable->{CREDIT_CARDS_ACCEPTED});
926        $::Session->{'errors'}{'PaypalExpress'} = errmsg("Paypal is currently unavailable - please use our secure payment system instead. We accept $accepted cards");
927              }
928            return $Tag->deliver({ location => $checkouturl }) 
929       }
930
931 #::logDebug("PP".__LINE__.": sandbox=$sandbox; host=$host");
932 # Now go off to Paypal
933   my $redirecturl = "https://www."."$sandbox"."paypal.com/cgi-bin/webscr?cmd=_express-checkout&token=$result{Token}";
934
935 return $Tag->deliver({ location => $redirecturl }); 
936
937    }
938
939
940 #--------------------------------------------------------------------------------------------------
941 ### Create a GET request and method, and read response
942 #
943  elsif ($pprequest eq 'getrequest') {
944             $request = SOAP::Data->name("GetExpressCheckoutDetailsRequest" =>
945                          \SOAP::Data->value(
946                           SOAP::Data->name("Version" => $version)->type("xs:string"),
947                          SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string")
948                          )
949                    ) ->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"});
950              $method = SOAP::Data->name('GetExpressCheckoutDetailsReq')->attr({xmlns => $xmlns});
951              $response = $service->call($header, $method => $request);
952                  %result = %{$response->valueof('//GetExpressCheckoutDetailsResponse')};
953 #::logDebug("PP".__LINE__.": Get Ack=$result{Ack}");
954
955 # populate the billing address rather than shipping address when the basket is being shipped to
956 # another address, eg it is a wish list.
957           if (($result{'Ack'} eq "Success") and ($::Values->{'pp_use_billing_address'} == 1)) {
958                 $::Values->{'b_phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'} || $::Values->{b_phone} || $::Values->{phone_day} || $::Values->{phone_night};
959                 $::Values->{'email'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
960                 $::Values->{'payerid'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
961                 $::Values->{'payerstatus'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
962                 $::Values->{'payerbusiness'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
963             $::Values->{'salutation'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
964             $::Values->{'b_fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
965             $::Values->{'mname'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
966             $::Values->{'b_lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
967             $::Values->{'suffix'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
968             $::Values->{'address_status'}   = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
969             $::Values->{'b_name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Name'};
970             $::Values->{'b_address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
971             $::Values->{'b_address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
972             $::Values->{'b_city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
973             $::Values->{'b_state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
974             $::Values->{'b_zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
975             $::Values->{'b_country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
976             $::Values->{'countryname'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
977                       }
978
979           elsif ($result{'Ack'} eq "Success") {
980             $::Values->{'phone_day'}      = $result{'GetExpressCheckoutDetailsResponseDetails'}{'ContactPhone'} || $::Values->{phone_day} || $::Values->{phone_night};
981                 $::Values->{'payerid'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerID'};
982                 $::Values->{'payerstatus'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerStatus'};
983                 $::Values->{'payerbusiness'}  = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerBusiness'};
984             $::Values->{'salutation'}     = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Salutation'};
985             $::Values->{'suffix'}         = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'Suffix'};
986             $::Values->{'address_status'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'AddressStatus'};
987           if ($addressOverride != '1') {
988                 $::Values->{'email'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Payer'};
989             $::Values->{'fname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'FirstName'};
990             $::Values->{'mname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'MiddleName'};
991             $::Values->{'lname'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'PayerName'}{'LastName'};
992             $::Values->{'name'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Name'};
993             $::Values->{'address1'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street1'};
994             $::Values->{'address2'}       = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Street2'};
995             $::Values->{'city'}           = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CityName'};
996             $::Values->{'state'}          = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'StateOrProvince'};
997             $::Values->{'zip'}            = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'PostalCode'};
998             $::Values->{'countryname'}    = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'CountryName'};
999                 $::Values->{'country'}        = $result{'GetExpressCheckoutDetailsResponseDetails'}{'PayerInfo'}{'Address'}{'Country'};
1000                       }
1001                    }
1002                    
1003                 $::Values->{'company'} = $::Values->{'b_company'} = $::Values->{'payerbusiness'};
1004                 $::Values->{'giropaytrue'} = $result{'GetExpressCheckoutDetailsResponseDetails'}{'RedirectRequired'};
1005
1006 #::logDebug("PP".__LINE__.": on=$::Values->{mv_order_number}");
1007                 $invoiceID = $::Session->{'mv_order_number'} = $::Values->{'mv_order_number'} = $result{'Custom'} unless ($::Values->{'mv_order_number'} || $invoiceID);
1008
1009 # If shipping address and name are chosen at Paypal to be different to the billing address/name, then {name} contains           
1010 # the shipping name but {fname} and {lname} still contain the billing names.
1011 ### In this case the returned 'name' may be a company name as it turns out, so what should we do?
1012     if ($::Values->{pp_use_billing_address}) {
1013        if (($::Values->{'b_fname'} !~ /$::Values->{'b_name'}/) and ($::Values->{'b_name'} =~ /\s/)) {
1014            $::Values->{'b_name'} =~ /(\S*)\s+(.*)/;
1015            $::Values->{'b_fname'} = $1;
1016            $::Values->{'b_lname'} = $2;
1017        }
1018     }
1019     else {
1020    if (($::Values->{'fname'} !~ /$::Values->{'name'}/) and ($::Values->{'name'} =~ /\s/)) {
1021        $::Values->{'name'} =~ /(\S*)\s+(.*)/;
1022        $::Values->{'fname'} = $1;
1023        $::Values->{'lname'} = $2;
1024        }
1025     }
1026                 
1027                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1028                         for my $i (0 .. 3) {
1029                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1030                         }
1031    
1032        $country = $::Values->{'country'} || $::Values->{'b_country'};
1033        $state = $::Values->{'state'} || $::Values->{'b_state'};
1034        $state =~ s/\.\s*//g; # yet another variation for Canadian Provinces includes periods, eg B.C. (waiting for B. C.)
1035
1036 # Remap Canadian provinces rather than lookup the db, as some Paypal names are incomplete wrt the official names. 
1037 # It seems that some PP accounts, possibly older ones, send the 2 letter abbreviation rather than the full name.
1038         if ($country eq 'CA') {         
1039                 $state = 'AB' if ($state =~ /Alberta|^AB$/i);
1040                 $state = 'BC' if ($state =~ /British Columbia|^BC$/i);
1041                 $state = 'MB' if ($state =~ /Manitoba|^MB$/i);
1042                 $state = 'NB' if ($state =~ /New Brunswick|^NB$/i);
1043                 $state = 'NL' if ($state =~ /Newfoundland|^NL$/i);
1044                 $state = 'NS' if ($state =~ /Nova Scotia|^NS$/i);
1045                 $state = 'NT' if ($state =~ /Northwest Terr|^NT$/i);
1046                 $state = 'NU' if ($state =~ /Nunavut|^NU/i);
1047                 $state = 'ON' if ($state =~ /Ontario|^ON$/i);
1048                 $state = 'PE' if ($state =~ /Prince Edward|^PE$/i);
1049                 $state = 'QC' if ($state =~ /Quebec|^QC$/i);
1050                 $state = 'SK' if ($state =~ /Saskatchewan|^SK$/i);
1051                 $state = 'YT' if ($state =~ /Yukon|^YT$/i);
1052         }
1053         
1054         $::Values->{'b_state'} = $state if ($::Values->{'pp_use_billing_address'} == 1);
1055         $::Values->{'state'} = $state;
1056   
1057   }
1058
1059 #------------------------------------------------------------------------------------------------
1060 ### Create a Do request and method, and read response. Not used for Giropay
1061 #
1062  elsif ($pprequest =~ /dorequest|modifyrp/) {
1063      #  $currency = 'EUR'; # set to currency different to that started with to force failure for testing
1064 #::logDebug("PP".__LINE__.":invID=$invoiceID; on=$::Values->{mv_order_number}; total=$amount, itemtotal=$itemTotal, shiptot=$shipTotal,handTot=$handlingTotal,taxtot=$taxTotal");
1065                         $invoiceID = ($::Values->{'mv_order_number'} || $::Values->{'order_number'}) unless $invoiceID;
1066
1067            my @pd  = (
1068                                      SOAP::Data->name("OrderTotal" => $amount )->attr({"currencyID" => $currency})->type(""),
1069                                      SOAP::Data->name("ItemTotal" => $itemTotal )->attr({"currencyID" => $currency})->type(""),
1070                                      SOAP::Data->name("ShippingTotal" => $shipTotal )->attr({"currencyID" => $currency})->type(""),
1071                                      SOAP::Data->name("HandlingTotal" => $handlingTotal )->attr({"currencyID" => $currency})->type(""),
1072                                      SOAP::Data->name("TaxTotal" => $taxTotal )->attr({"currencyID" => $currency})->type(""),
1073                                      SOAP::Data->name("InvoiceID" => $invoiceID )->type(""),
1074                      );
1075
1076         my @sta  = (
1077                     SOAP::Data->name("ShipToAddress" =>
1078                     \SOAP::Data->value(
1079                      SOAP::Data->name("Name" => $name)->type("xs:string"),
1080                      SOAP::Data->name("Street1" => $address1)->type("xs:string"),
1081                      SOAP::Data->name("Street2" => $address2)->type("xs:string"),
1082                      SOAP::Data->name("CityName" => $city)->type("xs:string"),
1083                      SOAP::Data->name("StateOrProvince" => $state)->type("xs:string"),
1084                      SOAP::Data->name("PostalCode" => $zip)->type("xs:string"),
1085                      SOAP::Data->name("Country" => $country)->type("xs:string")
1086                          )
1087                        )
1088                      );
1089
1090                   my ($item,$itm,@pdi,$pdiamount,$pditax);
1091 # ### FIXME what is the point of sending item details here???? 
1092                 if (($itemTotal > '0') and ($taxTotal > '0')) {
1093                   foreach  $item (@{$::Carts->{'main'}}) {
1094                           $itm = {
1095                                           number => $item->{'code'},
1096                                           quantity => $item->{'quantity'},
1097                                           description => Vend::Data::item_description($item),
1098                                           amount => Vend::Data::item_price($item),
1099                                           comment => Vend::Data::item_field($item, 'comment'),
1100                                           tax => exists $item->{'tax'} ? $item->{'tax'} : (Vend::Data::item_price($item)/$itemTotal * $taxTotal),
1101                                           rpAmount => Vend::Data::item_field($item, 'rpamount'),
1102                                           };
1103   
1104                           $pdiamount = sprintf '%.02f', $itm->{'amount'};
1105                           $pditax = sprintf '%.02f', $itm->{'tax'};
1106
1107                 my $pdi  = (
1108                         SOAP::Data->name("PaymentDetailsItem" =>
1109                         \SOAP::Data->value(
1110                          SOAP::Data->name("Name" => $itm->{'description'})->type("xs:string"),
1111                          SOAP::Data->name("Amount" => $pdiamount)->attr({"currencyID" => $currency})->type("xs:string"),
1112                          SOAP::Data->name("Number" => $itm->{'number'})->type("xs:string"),
1113                          SOAP::Data->name("Quantity" => $itm->{'quantity'})->type("xs:string"),
1114                          SOAP::Data->name("Tax" => $pditax)->type("xs:string")
1115                             )
1116                           )->type("ebl:PaymentDetailsItemType")
1117                         );
1118           push @pdi, $pdi unless $itm->{'rpAmount'} > '0';
1119           }
1120     }
1121 #----------------------------------
1122
1123         my ($shipAddress, $billAddress, $payerInfo, @schedule, $nonrp);
1124         my $cntr = '0';
1125         my $rpamount_field = 'rpamount_' . lc($currency) || 'rpamount';
1126         my $rptrialamount_field = 'rptrialamount_' . lc($currency) || 'rptrialamount';
1127         my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
1128
1129         foreach  $item (@{$::Carts->{'main'}}) {
1130             $itm = {
1131                                 rpamount_field => Vend::Data::item_field($item, $rpamount_field),
1132                                 rpamount => Vend::Data::item_field($item, 'rpamount'),
1133                         amount => Vend::Data::item_price($item),
1134                                 description => Vend::Data::item_field($item, 'description'),
1135                                 };
1136
1137
1138    $basket .= <<EOB;
1139    Item = $itm->{code}, "$itm->{rpDescription}"; Price = $itm->{price}; Qty = $itm->{quantity}; Subtotal = $itm->{subtotal} 
1140 EOB
1141
1142           my ($dorecurringbilling, $cntr);
1143           my $rpamount = $itm->{'rpamount_field'} || $itm->{'rpamount'};
1144                  $nonrp = '1' if (! $rpamount); # only run Do request if have standard purchase as well
1145           if ($rpamount) {
1146 #               $cntr++;
1147 print "PP".__LINE__.": cntr=$cntr; initamount=$itm->{initAmount}; rpAmount=$itm->{rpAmount}; trialAmount=$itm->{trialAmount}\n";        
1148             $dorecurringbilling = (
1149                                            SOAP::Data->name("BillingAgreementDetails" =>
1150                                            \SOAP::Data->value(
1151                                             SOAP::Data->name("BillingType" => 'RecurringPayments')->type(""),
1152                                                 SOAP::Data->name("BillingAgreementDescription" => $itm->{'description'})->type(""),
1153                                                       )
1154                                                     )->type("ns:BillingAgreementDetailsType"),
1155                                                 );
1156                 $cntr++;
1157                 push @pd, $dorecurringbilling;
1158           }
1159                                            
1160         };      
1161
1162                 push @pd, SOAP::Data->name("Custom" => $custom )->type("xs:string") if $custom;
1163                 push @pd, SOAP::Data->name("NotifyURL" => $notifyURL )->type("xs:string") if $notifyURL;
1164                 push @pd, @sta if $addressOverride  == '1';
1165                 push @pd, @pdi if $paymentDetailsItem == '1';# and ($itemTotal > '0'));
1166
1167         my $pd = (      SOAP::Data->name("PaymentDetails" =>
1168                                  \SOAP::Data->value( @pd
1169                                      ),
1170                                )->type(""),
1171                                 );
1172
1173         my @doreq = (    SOAP::Data->name("Token" => $::Scratch->{'token'})->type("xs:string"),
1174                                  SOAP::Data->name("PaymentAction" => $paymentAction)->type(""),
1175                                  SOAP::Data->name("PayerID" => $::Values->{'payerid'} )->type("xs:string"),
1176                                 );
1177 # ###           push @doreq, SOAP::Data->name("ReturnFMFDetails" => '1' )->type("xs:boolean") if $returnFMFdetails == '1'; # ### crashes
1178 # ###           push @doreq, SOAP::Data->name("GiftMessage" => $giftMessage)->type("xs:string") if $giftMessage;
1179                 push @doreq, SOAP::Data->name("GiftReceiptEnable" => $giftReceiptEnable)->type("xs:string") if $giftReceiptEnable; # true | false
1180                 push @doreq, SOAP::Data->name("GiftWrapName" => $giftWrapName)->type("xs:string") if $giftWrapName; # 25 chars
1181                 push @doreq, SOAP::Data->name("GiftWrapAmount" => $giftWrapAmount)->attr({"currencyID" => $currency})->type("ebl:BasicAmountType") if $giftWrapAmount;
1182                 push @doreq, SOAP::Data->name("ButtonSource" => $buttonSource )->type("xs:string") if $buttonSource;
1183                 push @doreq, SOAP::Data->name("SoftDescriptor" => $softDescriptor)->type('') if $softDescriptor;
1184
1185                 push @doreq, $pd;
1186
1187             $request = SOAP::Data->name("DoExpressCheckoutPaymentRequest" =>
1188                                \SOAP::Data->value(
1189                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type("xs:string"),
1190                                 SOAP::Data->name("DoExpressCheckoutPaymentRequestDetails" =>
1191                                 \SOAP::Data->value(
1192                                         @doreq,
1193                              ),
1194                            )->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"}),
1195                          ),
1196                    );
1197
1198         if (($nonrp == '1') and ($pprequest ne 'modifyrp')) {
1199                 undef $nonrp;
1200
1201             $method = SOAP::Data->name('DoExpressCheckoutPaymentReq')->attr({xmlns => $xmlns});
1202             $response = $service->call($header, $method => $request);
1203             %result = %{$response->valueof('//DoExpressCheckoutPaymentResponse')};
1204 #::logDebug("PP".__LINE__.": nonRP=$nonrp; Do Ack=$result{Ack}; ppreq=$pprequest");
1205          my ($rpAmount, $rpPeriod, $rpFrequency, $totalBillingCycles, $trialPeriod, $trialFrequency, $trialAmount, $trialTotalBillingCycles, @setrpprofile);
1206   
1207           if ($result{'Ack'} eq "Success") {
1208             $Session->{'payment_result'}{'Status'} = 'Success' unless (@setrpprofile);
1209             $result{'TransactionID'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionID'};
1210             $result{'PaymentStatus'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentStatus'};
1211             $result{'TransactionType'}     = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'TransactionType'};
1212             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1213             $result{'ParentTransactionID'} = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ParentTransactionID'};
1214             $result{'PaymentType'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentType'};
1215             $result{'PendingReason'}       = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PendingReason'};
1216             $result{'PaymentDate'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'PaymentDate'};
1217             $result{'ReasonCode'}          = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ReasonCode'};
1218             $result{'FeeAmount'}           = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'FeeAmount'};
1219             $result{'ExchangeRate'}        = $result{'DoExpressCheckoutPaymentResponseDetails'}{'PaymentInfo'}{'ExchangeRate'};
1220                 $result{'giropaytrue'}         = $result{'DoExpressCheckoutPaymentResponseDetails'}{'RedirectRequired'};
1221
1222                             }
1223           else  {
1224                           $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1225                           for my $i (0 .. 3) {
1226                                 $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1227                           }
1228           }
1229 #::logDebug("PP".__LINE__.": Doreq result=".::uneval(\%result));
1230
1231         }
1232
1233         my $cntr = '0';
1234
1235 #
1236 # Finished with DoRequest for normal purchase, now for RecurringPayments profiles
1237 # Need to run one complete request/response cycle per Profile
1238 #
1239         foreach  $item (@{$::Carts->{'main'}}) {
1240         my (@activation,@trialperiod,$rpprofile,$rprequest,@profiledetails,@scheduledetails,@end,$cardToken);
1241
1242             $itm = {
1243                                 rpDescription => Vend::Data::item_field($item, 'description'),
1244                                 rpAutoBillOutstandingAmount => Vend::Data::item_field($item, 'rpautobillarrears'),
1245                                 rpMaxFailedPayments => Vend::Data::item_field($item, 'rpmaxfailedpayments'),
1246                                 rpStartDate => Vend::Data::item_field($item, 'rpstartdate'),
1247                                 rpAmount_field => Vend::Data::item_field($item, $rpamount_field),
1248                                 rpAmount => Vend::Data::item_field($item, 'rpamount'),
1249                                 rpShippingAmount => Vend::Data::item_field($item, 'rpshippingamount'),
1250                                 rpTaxAmount => Vend::Data::item_field($item, 'rptaxamount'),
1251                                 rpPeriod => Vend::Data::item_field($item, 'rpperiod'),
1252                                 rpFrequency => Vend::Data::item_field($item, 'rpfrequency'),
1253                                 rpTotalCycles => Vend::Data::item_field($item, 'rptotalcycles'),
1254                                 trialPeriod => Vend::Data::item_field($item, 'rptrialperiod'),
1255                                 trialFrequency => Vend::Data::item_field($item, 'rptrialfrequency'),
1256                                 trialAmount => Vend::Data::item_field($item, $rptrialamount_field),
1257                                 trialShippingAmount => Vend::Data::item_field($item, 'rptrialshippingamount'),
1258                                 trialTaxAmount => Vend::Data::item_field($item, 'rptrialtaxamount'),
1259                                 trialTotalCycles => Vend::Data::item_field($item, 'rptrialtotalcycles'),
1260                                 initAmount => Vend::Data::item_field($item, $rpdeposit_field),
1261                                 initAmountFailedAction => Vend::Data::item_field($item, 'rpdepositfailedaction'),
1262                                 };
1263
1264         my $rpStartDate = $itm->{'rpStartDate'} || $Tag->time({ body => "%Y-%m-%d" });
1265            $rpStartDate .= "T00:00:00";
1266         my $rpPeriod = $::Values->{'rpperiod'} || $itm->{'rpPeriod'};
1267            $rpPeriod = ucfirst(lc($rpPeriod)); # 'type mismatch' error if case not right ...
1268            $rpPeriod = 'SemiMonth' if $rpPeriod =~ /semimonth/i;
1269         my $trialPeriod = $::Values->{'trialperiod'} || $itm->{'trialPeriod'};
1270            $trialPeriod = ucfirst(lc($trialPeriod)); 
1271            $trialPeriod = 'SemiMonth' if $trialPeriod =~ /semimonth/i;
1272         my $rpAmount = $::Values->{'repayamount'} || $itm->{'rpAmount_field'} || $itm->{'rpAmount'};
1273            $rpAmount = sprintf '%.2f', $rpAmount;
1274         my $initamountfailedaction = $::Values->{'initamountfailedaction'} || $itm->{'initAmountFailedAction'};
1275            $initamountfailedaction = 'ContinueOnFailure' if $initamountfailedaction =~ /continueonfailure/i;
1276            $initamountfailedaction = 'CancelOnFailure' if $initamountfailedaction =~ /cancelonfailure/i;
1277
1278 #-- now for the CreateRecurringPayments request ---------------------------------------
1279 #
1280         if ($rpAmount > '0') {
1281             $rpAmount = sprintf '%.02f', $rpAmount;
1282
1283         if ($cntr > '9') {
1284           $::Session->{'errors'}{'Paypal'} = "Paypal will not accept more than ten subscriptions in one order - please remove some and purchase them in
1285           a second order";
1286           return();
1287         };
1288                 $cntr++;
1289
1290                 my $rpref = $invoiceID . "-sub" . $cntr if charge_param('setordernumber');
1291 #::logDebug("PP".__LINE__.": invID=$invoiceID; profRef=$::Values->{'rpprofilereference'}; cnt=$cntr; shipAddress1=$itm->{'shipAddress1'};  rpFreq=$itm->{rpFrequency}; rpAmount=$itm->{rpAmount}; billP=$itm->{rpPeriod}; start=$rpStartDate"); 
1292                 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"
1293 # startdate either proper date format if taken from db or terminal, or may be period hence,
1294 # eg '1 week', '3 days', '2 months'. Eg, deposit (initAmount) now plus payments starting
1295 # in 1 month. 
1296                 if ($rpStartDate =~ /\d+ \w+/){
1297                   my ($adder, $period) = split/ /, $rpStartDate ;  
1298                           $adder *= '7' if $period =~ /week/i;
1299
1300                   my ($year,$month,$day) = Add_Delta_YMD(Today(),'0',"+$adder",'0') if $period =~ /month/i;
1301                          ($year,$month,$day) = Add_Delta_YMD(Today(),'0','0',"+$adder") if $period =~ /day/i;
1302                           $month = sprintf '%02d', $month;
1303                           $day = sprintf '%02d', $day;
1304                          $rpStartDate = "$year-$month-$day" . "T00:00:00Z"; 
1305                 }
1306                    $rpStartDate .= 'T00:00:00Z' if $rpStartDate !~ /T/;
1307
1308                 my $profileReference = $::Values->{'rpprofilereference'} || $rpref;
1309                    $::Values->{'rpprofilereference'} = '';
1310 #::logDebug("PP".__LINE__.": rcStart=$rpStartDate; profRef=$profileReference");
1311
1312
1313
1314                 $shipAddress = (   SOAP::Data->name('SubscriberShippingAddress' =>
1315                                                    \SOAP::Data->value(
1316                                                         SOAP::Data->name('Name' => "$::Values->{'fname'} $::Values->{'lname'}")->type(''),
1317                                                         SOAP::Data->name('Street1' => $::Values->{'address1'})->type(''),
1318                                                         SOAP::Data->name('Street2' => $::Values->{'address2'})->type(''),
1319                                                         SOAP::Data->name('CityName' => $::Values->{'city'})->type(''),
1320                                                         SOAP::Data->name('StateOrProvince' => $::Values->{'state'})->type(''),
1321                                                         SOAP::Data->name('PostalCode' => $::Values->{'zip'})->type(''),
1322                                                         SOAP::Data->name('Country' => $::Values->{'country'})->type(''),
1323                                                         ),
1324                                                    ),
1325                                                 ) if $::Values->{'address18'};
1326
1327           my $payment = (
1328                                                    SOAP::Data->name('PaymentPeriod' => 
1329                                                         \SOAP::Data->value(
1330                                                      SOAP::Data->name('BillingPeriod' => $rpPeriod)->type(''),
1331                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'rpfrequency'} || $itm->{'rpFrequency'})->type(''), 
1332                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'rptotalcycles'} || $itm->{'rpTotalCycles'})->type(''),
1333                                                          SOAP::Data->name('Amount' => $rpAmount)->attr({'currencyID' => $currency})->type(''),
1334                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'rpshippingamount'} || $itm->{'rpShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1335                                                          SOAP::Data->name('TaxAmount' => $::Values->{'rptaxamount'} || $itm->{'rpTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1336                                                          ),
1337                                                    ),
1338                                                 );
1339
1340           my $activation = (    
1341                                                         SOAP::Data->name('ActivationDetails' => 
1342                                                         \SOAP::Data->value(
1343                                                      SOAP::Data->name('InitialAmount' => $::Values->{'initamount'} || $itm->{'initAmount'})->attr({'currencyID' => $currency})->type(''),
1344                                                          SOAP::Data->name('FailedInitialAmountAction' => $initamountfailedaction)->type(''), 
1345                                                                 ),
1346                                                           ),
1347                                                 ) if ($::Values->{'initamount'} || $itm->{'initAmount'});
1348
1349           my $trial =   ( 
1350                                                         SOAP::Data->name('TrialPeriod' => 
1351                                                         \SOAP::Data->value(
1352                                                      SOAP::Data->name('BillingPeriod' => $trialPeriod)->type(''),
1353                                                          SOAP::Data->name('BillingFrequency' => $::Values->{'trialfrequency'} || $itm->{'trialFrequency'})->type(''), 
1354                                                          SOAP::Data->name('Amount' => $::Values->{'trialamount'} || $itm->{'trialAmount'})->attr({'currencyID' => $currency})->type(''),
1355                                                          SOAP::Data->name('ShippingAmount' => $::Values->{'trialshippingamount'} || $itm->{'trialShippingAmount'})->attr({'currencyID' => $currency})->type(''),
1356                                                          SOAP::Data->name('TaxAmount' => $::Values->{'trialtaxamount'} || $itm->{'trialTaxAmount'})->attr({'currencyID' => $currency})->type(''),
1357                                                          SOAP::Data->name('TotalBillingCycles' => $::Values->{'trialtotalcycles'} || $itm->{'trialTotalCycles'})->type(''),
1358                                                           ),
1359                                                         ),
1360                                                   ) if ($::Values->{'trialamount'} || $itm->{'trialAmount'});
1361
1362                 push @scheduledetails, $payment;
1363                 push @scheduledetails, $activation if length $activation;
1364                 push @scheduledetails, $trial if length $trial;
1365                 push @profiledetails, SOAP::Data->name("BillingStartDate" => $rpStartDate)->type("");
1366                 push @profiledetails, SOAP::Data->name("ProfileReference" => $profileReference)->type("");
1367                 push @profiledetails, $shipAddress if length $shipAddress;
1368                 
1369                 $rprequest = (  
1370                                           SOAP::Data->name("CreateRecurringPaymentsProfileRequest" =>
1371                                           \SOAP::Data->value(
1372                                            SOAP::Data->name("Version" => $version)->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" })->type(''),
1373                                            SOAP::Data->name("CreateRecurringPaymentsProfileRequestDetails" =>
1374                                            \SOAP::Data->value(
1375                                                 SOAP::Data->name("Token" => $::Scratch->{"token"})->type("xs:string"),
1376                                                 SOAP::Data->name("RecurringPaymentsProfileDetails" =>
1377                                                 \SOAP::Data->value(
1378                                                   @profiledetails,
1379                                                   ),
1380                                                 ),
1381                                                 SOAP::Data->name('ScheduleDetails' =>
1382                                                 \SOAP::Data->value(
1383                                                 SOAP::Data->name('Description' => $::Values->{'rpdescription'} || $itm->{'rpDescription'})->type(''),
1384                                                 @scheduledetails,
1385                                                 SOAP::Data->name('MaxFailedPayments' => $::Values->{'rpmaxfailedpayments'} || $itm->{'rpMaxFailedPayments'} || '1')->type(''),
1386                                                 SOAP::Data->name('AutoBillOutstandingAmount' => $::Values->{'rpautobillarrears'} || $itm->{'rpAutoBillOutstandingAmount'} || 'NoAutoBill')->type(''),
1387                                                   ),
1388                                                 ),
1389                                           ),
1390                                         )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1391                                   ),
1392                                 ),
1393                         );
1394
1395 #::logDebug("PP".__LINE__.": dorp=".::uneval($rprequest));
1396
1397 # send separate query to Paypal for each RP profile
1398                 $method = SOAP::Data->name('CreateRecurringPaymentsProfileReq')->attr({ xmlns => $xmlns });
1399             $response = $service->call($header, $method => $rprequest);
1400 no strict 'refs';
1401           my $error = $response->valueof('//faultstring');
1402 use strict;
1403             %result = %{$response->valueof('//CreateRecurringPaymentsProfileResponse')};
1404 #::logDebug("PP".__LINE__.": CreateRecPayresult=".::uneval(\%result));
1405
1406                  $::Session->{'errors'}{'PaypalExpress'} .= $error;
1407                  $::Session->{'errors'}{'PaypalExpress'} .= $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1408                         for my $i (0 .. 3) {
1409                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1410                         }
1411
1412           if ($result{'Ack'} eq "Success") {
1413                 $db = dbref('transactions');
1414                 $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1415             $::Session->{'payment_result'}{'Status'} = 'Success';
1416                 $::Scratch->{'charge_succeed'} = '1';
1417         $result{'order-id'} = $order_id || $opt->{'order_id'};
1418             $result{'CorrelationID'} = $result{'CreateRecurringPaymentsProfileResponse'}{'CorrelationID'};
1419
1420           my ($rpshowsubtotal, $rpshowshipping, $rpshowtax, $rpshowtotal);
1421
1422                         $result{'ProfileID'}     = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileID'};
1423                         $result{'ProfileStatus'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'ProfileStatus'};
1424                         $result{'TransactionID'} = $result{'CreateRecurringPaymentsProfileResponseDetails'}{'TransactionID'};
1425                         my $profilestatus = $result{'ProfileStatus'};
1426                            $profilestatus =~ s/Profile//;
1427
1428 # In log_transaction find ProfileID from ProfileReference, run 'getrpdetails' and put into orderline tbl
1429 # pages/query/order_detail has new col for Subs, link to popup which runs 'getrpdetails' and
1430 # displays info to customer from scratch values
1431
1432         my $sql = "INSERT transactions SET code='$profileReference',order_id='$result{ProfileID}',status='$profilestatus'";
1433
1434                                 $sth = $dbh->prepare($sql);
1435                                 $sth->execute() or die $sth->errstr;
1436 #::logDebug("PP".__LINE__.": Ack=$result{'Ack'}; result=".::uneval(\%result));
1437
1438                   } # if Ack eq success
1439
1440                 } # if item rpAmount
1441
1442           } # foreach item in cart 
1443
1444         }
1445
1446 #---------------------------------------------------------------------------------------
1447 # Manage RecurringPayments: to cancel, suspend or reactivate. Use 'modify' for other ops
1448 #
1449   elsif ($pprequest =~ /managerp/) {
1450  
1451         my ($x,$action) = split(/_/, $pprequest);
1452         my $status = 'Suspended' if $action eq 'suspend';
1453            $status = 'Cancelled' if $action eq 'cancel';
1454            $status = 'Active' if $action eq 'reactivate';
1455            $action = ucfirst(lc($action));
1456
1457                 my $request  = ( 
1458                                           SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequest' =>
1459                                           \SOAP::Data->value(
1460                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1461                                            SOAP::Data->name('ManageRecurringPaymentsProfileStatusRequestDetails' =>
1462                                            \SOAP::Data->value(
1463                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type('xs:string'),
1464                                                  SOAP::Data->name('Action' => $action)->type(''),
1465                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type('xs:string'),
1466                                                 ),
1467                                          )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1468                                   ),
1469                                 ),
1470                           );
1471
1472             $method = SOAP::Data->name('ManageRecurringPaymentsProfileStatusReq')->attr({xmlns=>$xmlns});
1473             $response = $service->call($header, $method => $request);
1474             %result = %{$response->valueof('//ManageRecurringPaymentsProfileStatusResponse')};
1475           
1476                 if ($result{'Ack'} eq 'Success') {
1477               $db  = dbref('transactions') or die errmsg("cannot open transactions table");
1478               $dbh = $db->dbh() or die errmsg("cannot get handle for tbl 'transactions'");
1479                   $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$status',txtype='PP:RecPay-$status',status='PP:RecPay-$status' WHERE rpprofileid='$::Values->{rpprofileid}'");
1480           $sth->execute() or die $sth->errstr;
1481                 }
1482 #::logDebug("PP".__LINE__.": action=$action; result=".::uneval(%result));
1483                 return(%result);
1484
1485   }
1486
1487 #--------------------------------------------------------------------------------------------
1488 # Get full RecurringPayments details and put into scratch space
1489 #
1490   elsif ($pprequest =~ /getrpdetails/) {
1491         my ($x,$update) = split /_/, $pprequest if $pprequest =~ /_/;
1492         $::Session->{'rpupdate'} = '1' if $update;
1493         getrpdetails();
1494         return();
1495   }
1496
1497 #-----------------------------------------------------------------------------------------
1498 #  RecurringPayments: bill arrears
1499 #
1500   elsif ($pprequest eq 'billrparrears') {
1501
1502                   my $request  = ( 
1503                                           SOAP::Data->name('BillOutstandingAmountRequest' =>
1504                                           \SOAP::Data->value(
1505                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1506                                            SOAP::Data->name('BillOutstandingAmountRequestDetails' =>
1507                                            \SOAP::Data->value(
1508                                                  SOAP::Data->name('ProfileID' => $::Values->{'rpprofileid'})->type(''),
1509                                                  SOAP::Data->name('Amount' => $amount)->attr({'currencyID' => $currency})->type(''),
1510                                                  SOAP::Data->name('Note' => $::Values->{'vtmessage'})->type(''),
1511                                                 ),
1512                                      )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1513                                   ),
1514                                 ),
1515                           );
1516
1517             $method = SOAP::Data->name('BillOutstandingAmountReq')->attr({ xmlns => $xmlns });
1518             $response = $service->call($header, $method => $request);
1519 no strict 'refs';
1520           my $error = $response->valueof('//faultstring');
1521 use strict;
1522             %result = %{$response->valueof('//BillOutstandingAmountResponse')};
1523 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1524
1525                 return(%result);
1526
1527   }
1528
1529 #-------------------------------------------------------------------------------------------------
1530 # REFUND transaction
1531 #
1532  elsif ($pprequest =~ /refund/) {
1533            my @refundreq = (
1534                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1535                     SOAP::Data->name("TransactionID" => $transactionID)->type("ebl:TransactionId"),
1536                     SOAP::Data->name("RefundType" => $refundType)->type(""),
1537                     SOAP::Data->name("Memo" => $memo)->type("xs:string"),
1538                      );
1539
1540           push @refundreq,  SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type("cc:BasicAmountType")
1541                                         if $pprequest eq 'refund_partial';
1542                   
1543      $request = SOAP::Data->name("RefundTransactionRequest" =>
1544                 \SOAP::Data->value( 
1545                                   @refundreq
1546                                   )
1547                                 )->type("ns:RefundTransactionRequestType");
1548
1549             $method = SOAP::Data->name('RefundTransactionReq')->attr({xmlns => $xmlns});
1550             $response = $service->call($header, $method => $request);
1551             %result = %{$response->valueof('//RefundTransactionResponse')};
1552                 
1553                 if ($result{'Ack'} eq "Success") {
1554                         $::Session->{'payment_result'}{'Terminal'} = 'success';
1555                 $::Session->{'payment_result'}{'RefundTransactionID'} = $result{'RefundTransactionResponse'}{'RefundTransctionID'};
1556 #::logDebug("PP".__LINE__.": Refund result=".::uneval(%result));
1557                         return %result;
1558                         }
1559                 }
1560
1561 #-------------------------------------------------------------------------------------------------
1562 # MASSPAY transaction
1563 #
1564  elsif ($pprequest eq 'masspay') {
1565         my ($receiver, $mpamount, $ref, $note, $mpi, @mp);
1566         my $emailsubject = $::Values->{'email_subject'} || 'Paypal payment';
1567     my $message = $::Values->{'vtmessage'};
1568 #::logDebug("PP".__LINE__.": req=$pprequest; list=$message");
1569
1570         if ($message) {
1571                 $message =~ s/\r//g;
1572         foreach my $line (split /\n/, $message) {
1573 #::logDebug("PP".__LINE__.": masspay line=$line");
1574                   ($receiver, $mpamount, $ref, $note) = split /","/, $line;
1575                   $receiver =~ s/^\"//;
1576                   $note =~ s/\"$// || ' ';
1577                   $mpamount = sprintf '%.02f', $mpamount;
1578                   $mpamount =~ s/^\D+//g;
1579
1580 #  need: receiver email/ID, amount, ref, note. Note can be empty but must be quoted
1581                 if ($receiver =~ /\@/) {
1582                 $receiverType = SOAP::Data->name("ReceiverEmail" => $receiver)->type("ebl:EmailAddressType");
1583                         }
1584                 else {
1585                 $receiverType = SOAP::Data->name("ReceiverID" => $receiver)->type("xs:string");
1586                 }
1587                  $mpi = (
1588                   SOAP::Data->name("MassPayItem" =>
1589                    \SOAP::Data->value(
1590                     $receiverType,
1591                     SOAP::Data->name("Amount" => $mpamount)->attr({ "currencyID" => $currency })->type("ebl:BasicAmountType"),
1592                     SOAP::Data->name("UniqueID" => $ref)->type("xs:string"),
1593                     SOAP::Data->name("Note" => $note)->type("xs:string")
1594                     )
1595                  ) ->type("ns:MassPayItemRequestType")
1596               );
1597                 push @mp, $mpi;
1598                         }
1599                   }
1600
1601         $request = SOAP::Data->name("MassPayRequest" =>
1602                            \SOAP::Data->value(
1603                 SOAP::Data->name("Version" => $version)->type("xs:string")->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1604                             SOAP::Data->name("EmailSubject" => $emailsubject)->type("xs:string"),
1605                 @mp
1606                    )
1607                  ) ->type("ns:MassPayRequestType");
1608
1609             $method = SOAP::Data->name('MassPayReq')->attr({ xmlns => $xmlns });
1610             $response = $service->call($header, $method => $request);
1611             %result = %{$response->valueof('//MassPayResponse')};
1612                 $::Session->{'payment_result'}{'Terminal'} = 'success' if $result{'Ack'} eq 'Success';
1613 #::logDebug("PP".__LINE__.":response=$result{Ack},cID=$result{CorrelationID}");
1614 # returns only Ack and CorrelationID on success
1615 #::logDebug("PP".__LINE__.": MassPay result=".::uneval(%result));
1616                 return %result;
1617
1618       }
1619
1620 #---------------------------------------------------------------------------
1621 # IPN
1622 #
1623   elsif ($pprequest =~ /ipn/) {
1624         my $page = ::http()->{'entity'};
1625         my $query = 'https://' . $ipnhost . '/cgi-bin/webscr?cmd=_notify-validate&' . $$page;
1626 #::logDebug("PP".__LINE__.": url=$query");      
1627
1628    my $ua = LWP::UserAgent->new;
1629    my $req = HTTP::Request->new('POST' => $query);
1630           $req->content_type('text/url-encoded');
1631           $req->content();
1632    my $res = $ua->request($req);
1633    my $respcode = $res->status_line;
1634
1635          if ($res->is_success) {
1636                   if ($res->content() eq 'VERIFIED') {
1637                           foreach my $line (split /\&/, $$page) {
1638                                 my ($key, $val) = (split /=/, $line);
1639                                 $result{$key} = $val;
1640 #::logDebug("PP".__LINE__.": IPN result=".::uneval(%result));
1641                                 return %result;
1642
1643                           }
1644                         }
1645                   }
1646           else {
1647           }
1648 #::logDebug("PP".__LINE__.": resp=$res->content()");    
1649
1650         return();
1651
1652   }
1653
1654 #-----------------------------------------------
1655 # Get balance of accounts
1656 #
1657   elsif ($pprequest =~ /getbalance/) {
1658           my ($req, $account) = split (/_/, $pprequest) if $pprequest =~ /_/;
1659                   $account ||= 'Balance';
1660                   
1661            my @balancereq = (
1662                     SOAP::Data->name("Version" => $version)->type("xs:string")->attr({xmlns => "urn:ebay:apis:eBLBaseComponents"}),
1663                     SOAP::Data->name("ReturnAllCurrencies" => '1')->type(""),
1664                      );
1665
1666                 $request = SOAP::Data->name("GetBalanceRequest" =>
1667                                         \SOAP::Data->value( 
1668                                          @balancereq
1669                                         )
1670                                   ) ->type("ns:GetBalanceRequestType");
1671
1672             $method = SOAP::Data->name('GetBalanceReq')->attr({xmlns => $xmlns});
1673             $response = $service->call($header, $method => $request);
1674             %result = %{$response->valueof('//GetBalanceResponse')};
1675
1676                   $::Session->{'errors'}{'PaypalExpress'} = $result{'Errors'}{'LongMessage'}  if ($result{'Errors'} !~ /ARRAY/);
1677                         for my $i (0 .. 3) {
1678                           $::Session->{'errors'}{'PaypalExpress'} .= " $result{'Errors'}[$i]{'LongMessage'}"  if ($result{'Errors'} =~ /ARRAY/);
1679                         }
1680 #::logDebug("PP".__LINE__.": GetBalance result=".::uneval(%result));
1681
1682                 $::Scratch->{'paypalbalance'} = "$account ";
1683                 for my $x ($response->dataof('//BalanceHoldings')) {
1684                         $::Scratch->{'paypalbalance'} .= " :: " . $x->{'_attr'}{'currencyID'} . $x->{'_value'}['0'];
1685
1686                 return;
1687
1688                 }
1689                 
1690   }
1691
1692 #---------------------------------------------------------------------------------------
1693 # DoReferenceTransaction, ie merchant-handled repeat of varying amounts at varying times
1694 #
1695   elsif ($pprequest =~ /dorepeat/) {
1696
1697   }
1698
1699 #--------------------------------------------------------------------------------------
1700 # DoNonReferencedCredit, ie send funds to specified credit card without reference to
1701 # a previous transaction
1702 #
1703   elsif ($pprequest =~ /sendcredit/) {
1704                   
1705                 my @payeraddress = (
1706                         SOAP::Data->name("Name" => $name)->type(""),
1707                         SOAP::Data->name("Street1" => $address1)->type(""),
1708                         SOAP::Data->name("Street2" => $address2)->type(""),
1709                         SOAP::Data->name("CityName" => $city)->type(""),
1710                         SOAP::Data->name("StateOrProvince" => $state)->type(""),
1711                         SOAP::Data->name("PostalCode" => $zip)->type(""),
1712                         SOAP::Data->name("Country" => $country)->type(""),
1713                        );
1714                 push @payeraddress, SOAP::Data->name("Phone" => $phone)->type("") if $phone;
1715 #::logDebug("PP".__LINE__.":payeraddress=".::uneval(@payeraddress));
1716
1717                 my @payername = (  
1718                         SOAP::Data->name("FirstName" => $::Values->{'b_fname'} || $::Values->{'fname'})->type(""),
1719                         SOAP::Data->name("LastName" => $::Values->{'b_lname'} || $::Values->{'lname'})->type(""),
1720                                           );
1721                 push @payername, SOAP::Data->name("MiddleName" => $::Values->{'middlename'})->type("") if $::Values->{'middlename'};
1722                 push @payername, SOAP::Data->name("Salutation" => $::Values->{'salutation'})->type("") if $::Values->{'salutation'};
1723                 push @payername, SOAP::Data->name("Suffix" => $::Values->{'suffix'})->type("") if $::Values->{'suffix'};
1724 #::logDebug("PP".__LINE__.":payername=".::uneval(@payername));
1725
1726                 my @cardowner = (  
1727                         SOAP::Data->name("PayerName" => 
1728                         \SOAP::Data->value(
1729                                                   @payername,
1730                                                   ),
1731                                                 ),
1732                         SOAP::Data->name("Address" => 
1733                         \SOAP::Data->value(
1734                                                   @payeraddress,
1735                                                   ),
1736                                                 ),
1737                                           );
1738                 push @cardowner, SOAP::Data->name("Payer" => $::Values->{'email'})->type("") if $::Values->{'email'};
1739                 push @cardowner, SOAP::Data->name("PayerID" => $::Values->{'payerid'})->type("") if $::Values->{'payerid'};
1740 #::logDebug("PP".__LINE__.":cardowner=".::uneval(@cardowner));
1741
1742                 my $pan = $::CGI->{'mv_credit_card_number'};
1743                    $pan =~ s/\D*//g;
1744                 my $mvccexpyear = $::Values->{'mv_credit_card_exp_year'};
1745                    $mvccexpyear = '20' . $mvccexpyear unless $mvccexpyear =~ /^20/;
1746                 my @creditcard = (
1747                         SOAP::Data->name("CreditCardType" => $::Values->{'mv_credit_card_type'})->type(""),
1748                         SOAP::Data->name("CreditCardNumber" => $pan)->type(""),
1749                         SOAP::Data->name("ExpMonth" => $::Values->{'mv_credit_card_exp_month'})->type(""),
1750                         SOAP::Data->name("ExpYear" => $mvccexpyear)->type(""),
1751                         SOAP::Data->name("CardOwner" => 
1752                         \SOAP::Data->value(
1753                                                   @cardowner,
1754                                                   ),
1755                                                 ),
1756                                           );
1757                 push @creditcard, SOAP::Data->name("CVV2" => $::CGI->{'mv_credit_card_cvv2'})->type("") if $::CGI->{'mv_credit_card_cvv2'};
1758                 push @creditcard, SOAP::Data->name("StartMonth" => $::Values->{'mv_credit_card_start_month'})->type("") if $::Values->{'mv_credit_card_start_month'};
1759                 push @creditcard, SOAP::Data->name("StartYear" => $::Values->{'mv_credit_card_start_year'})->type("") if $::Values->{'mv_credit_card_start_month'};
1760                 push @creditcard, SOAP::Data->name("IssueNumber" => $::Values->{'mv_credit_card_issue_number'})->type("") if $::Values->{'mv_credit_card_issue_number'};
1761 #::logDebug("PP".__LINE__.":creditcard=".::uneval(@creditcard)); 
1762
1763
1764            my @docreditreq = (
1765                     SOAP::Data->name("Amount" => $amount)->attr({"currencyID" => $currency})->type(""),
1766                     SOAP::Data->name("CreditCard" =>
1767                                 \SOAP::Data->value(
1768                                         @creditcard,
1769                                           ),
1770                                          ),
1771                                         );
1772                 push @docreditreq, SOAP::Data->name("Comment" => $::Values->{'vtmessage'})->type("") if $::Values->{'vtmessage'};
1773                 push @docreditreq, SOAP::Data->name("ReceiverEmail" => $::Values->{'email'})->type("") if $::Values->{'email'};
1774 #::logDebug("PP".__LINE__.":docreditreq=".::uneval(@docreditreq));
1775
1776      $request = SOAP::Data->name("DoNonReferencedCreditRequest" =>
1777                                \SOAP::Data->value(
1778                                 SOAP::Data->name("Version" => $version)->attr({xmlns=>"urn:ebay:apis:eBLBaseComponents"})->type(""),
1779                                         SOAP::Data->name("DoNonReferencedCreditRequestDetails" =>
1780                                         \SOAP::Data->value(
1781                                           @docreditreq
1782                                        ),
1783                                      )->attr({ xmlns => "urn:ebay:apis:eBLBaseComponents" }),
1784                                     ),
1785                   );
1786
1787             $method = SOAP::Data->name('DoNonReferencedCreditReq')->attr({xmlns => $xmlns});
1788             $response = $service->call($header, $method => $request);
1789             %result = %{$response->valueof('//DoNonReferencedCreditResponse')};
1790
1791 #::logDebug("PP".__LINE__.": result=".::uneval(%result));
1792                 return(%result);
1793
1794 }
1795   
1796 ##
1797 ##============================================================================================
1798 ## Interchange names are on the left, Paypal on the right
1799 ##
1800
1801  my %result_map;
1802  if ($pprequest =~ /dorequest|giropaylog/) {
1803     %result_map = ( qw/
1804                    order-id                     TransactionID
1805                    pop.order-id                 TransactionID
1806                    pop.timestamp                Timestamp
1807                    pop.auth-code                Ack
1808                    pop.status                   Ack
1809                    pop.txn-id                   TransactionID
1810                    pop.refund-txn-id    RefundTransactionID
1811                    pop.cln-id                   CorrelationID
1812         /
1813     );
1814
1815     for (keys %result_map) {
1816         $result{$_} = $result{$result_map{$_}}
1817            if defined $result{$result_map{$_}};
1818     }
1819   }
1820 #::logDebug("PP".__LINE__.": ack=$result{Ack}; ppreq=$pprequest");
1821   if (($result{'Ack'} eq 'Success') and ($pprequest =~ /dorequest|giropay/)) {
1822          $result{'MStatus'} = $result{'pop.status'} = 'success';
1823          $result{'order-id'} ||= $order_id || $opt->{'order_id'};
1824 #::logDebug("PP".__LINE__.": mstatus=$result{MStatus}"); 
1825            }
1826   elsif (!$result{'Ack'}) {
1827          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1828          $result{'order-id'} = '';
1829          $result{'TxType'} = 'NULL';
1830          $result{'StatusDetail'} = 'UNKNOWN status - check with Paypal';
1831            }
1832   elsif ($result{'Ack'} eq 'Failure') {
1833          $result{'MStatus'} = $result{'pop.status'} = 'failure';
1834          $result{'order-id'} = $result{'pop.order-id'} = '';
1835          $result{'MErrMsg'} = "code $result{'ErrorCode'}: $result{'LongMessage'}\n";
1836       }
1837
1838         $::Values->{'returnurl'} = '';
1839         $::Scratch->{'pprecurringbilling'} = '';
1840
1841 #::logDebug("PP".__LINE__." result:" .::uneval(\%result));
1842     return (%result);
1843
1844 }
1845
1846 #
1847 ##------------------------------------------------------------------------------------------------
1848 #
1849
1850 sub getrpdetails {
1851
1852         my $update = $::Session->{'rpupdate'} || '';
1853         my $profileID = shift || charge_param('rpprofileid') || $::Values->{'rpprofileid'};
1854         $::Values->{'rpprofileid'} = '';
1855         $::Scratch->{'rpprofileid'} = '';
1856         $::Session->{'rpupdate'} = '';
1857 #::logDebug("PP".__LINE__.": getRPdetails: profileID=$profileID");
1858         my $request  = ( 
1859                                           SOAP::Data->name('GetRecurringPaymentsProfileDetailsRequest' =>
1860                                           \SOAP::Data->value(
1861                                            SOAP::Data->name('Version' => $version)->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'})->type('xs:string'),
1862                                            SOAP::Data->name('ProfileID' => $profileID)->type('xs:string'),
1863                                            ),
1864                                         )->attr({xmlns => 'urn:ebay:apis:eBLBaseComponents'}),
1865                              );
1866
1867            my $method = SOAP::Data->name('GetRecurringPaymentsProfileDetailsReq')->attr({ xmlns => $xmlns });
1868            my $response = $service->call($header, $method => $request);
1869                   %result = %{$response->valueof('//GetRecurringPaymentsProfileDetailsResponse')};
1870
1871                  $::Scratch->{'rpdetails'} = ::uneval(%result);
1872
1873                  $::Scratch->{'rpcorrelationid'} = $result{'CorrelationID'};
1874                  $::Scratch->{'rpprofilereference'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'ProfileReference'};
1875                  $::Scratch->{'rpprofileid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileID'};
1876                  $::Scratch->{'rpdescription'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'Description'};
1877                  $::Scratch->{'rpprofilestatus'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'ProfileStatus'};
1878                  $::Scratch->{'rpprofilestatus'} =~ s/Profile//g;
1879                  $::Scratch->{'rpsubscribername'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'SubscriberName'};
1880                  $::Scratch->{'rpstartdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsProfileDetails'}{'BillingStartDate'};
1881                  $::Scratch->{'rpstartdate'} =~ s/T/ /;
1882                  $::Scratch->{'rpstartdate'} =~ s/Z//;
1883                  $::Scratch->{'rptaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TaxAmount'};
1884                  $::Scratch->{'rpshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'ShippingAmount'};
1885                  $::Scratch->{'rpamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'Amount'};
1886                  $::Scratch->{'rpgrossamount'} = sprintf '%.2f', ($::Scratch->{'rpamount'} + $::Scratch->{'rpshipping'} + $::Scratch->{'rptax'});
1887                 # $::Scratch->{'rpgrossamount'} = sprintf '%.2f', $rpgross;
1888                  $::Scratch->{'rpfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingFrequency'};
1889                  $::Scratch->{'rpperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'BillingPeriod'};
1890                  $::Scratch->{'rptotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1891                  $::Scratch->{'rpnextbillingdate'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NextBillingDate'};
1892                  $::Scratch->{'rpnextbillingdate'} =~ s/T/ /g; # format for IC's 'convert-date'
1893                  $::Scratch->{'rpnextbillingdate'} =~ s/Z//g; 
1894                  $::Scratch->{'rpcyclesmade'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesCompleted'};
1895                  $::Scratch->{'rpcyclesfailed'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'FailedPaymentCount'};
1896                  $::Scratch->{'rpcyclesremaining'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'NumberCyclesRemaining'};
1897                  $::Scratch->{'rparrears'} =  $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RecurringPaymentsSummary'}{'OutstandingBalance'};
1898                  $::Scratch->{'rpmaxfailedpayments'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'MaxFailedPayments'};
1899
1900                  $::Scratch->{'rptrialamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'Amount'};
1901                  $::Scratch->{'rptrialtaxamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TaxAmount'};
1902                  $::Scratch->{'rptrialshippingamount'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'ShippingAmount'};
1903                  $::Scratch->{'rptrialfrequency'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingFrequency'};
1904                  $::Scratch->{'rptrialperiod'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'BillingPeriod'};
1905                  $::Scratch->{'rptrialtotalcycles'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialRecurringPaymentsPeriod'}{'TotalBillingCycles'};
1906                  my $rptrialgrossamount = $::Scratch->{'rptrialamount'} + $::Scratch->{'rptrialtaxamount'} + $::Scratch->{'rptrialshippingamount'};
1907                  $::Scratch->{'rptrialgrossamount'} = sprintf '%.2f', $rptrialgrossamount;
1908                  my $finalpaymentduedate = $result{'GetRecurringPaymentsProfileDetailsResponse'}{'FinalPaymentDueDate'};
1909                     $finalpaymentduedate =~ s/T/ /; # format for IC's convert-date routine
1910                  $::Scratch->{'rpfinalpaymentduedate'} = $finalpaymentduedate =~ s/Z//; 
1911                  $::Scratch->{'rpregularamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'RegularAmountPaid'};
1912                  $::Scratch->{'rptrialamountpaid'} = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'TrialAmountPaid'};
1913                  my $rptotalpaid = $result{'GetRecurringPaymentsProfileDetailsResponseDetails'}{'AggregateAmount'};
1914
1915 # ### activation details not returned ...
1916                 my $db = dbref('transactions');
1917                 my $dbh = $db->dbh();
1918                 my $rpdeposit_field = 'rpdeposit_' . lc($currency) || 'rpdeposit';
1919                 my $sth = $dbh->prepare("SELECT $rpdeposit_field, rpdepositfailedaction FROM products WHERE description='$::Scratch->{rpdescription}'");
1920                    $sth->execute() or die $sth->errstr;
1921             my @d = $sth->fetchrow_array();
1922                    $::Scratch->{'rpdeposit'} = $d[0];
1923                    $::Scratch->{'rpdepositfailedaction'} = $d[1];
1924
1925
1926                 if ($update) {
1927                         $sth = $dbh->prepare("UPDATE transactions SET rpprofilestatus='$::Scratch->{rpprofilestatus}',status='PPsub-$::Scratch->{rpprofilestatus}',txtype='PPsub-$::Scratch->{rpprofilestatus}' WHERE rpprofileid='$::Scratch->{rpprofileid}'");
1928                         $sth->execute() or die $sth->errstr;
1929                         $::Session->{'rpupdate'} = '';
1930                 }
1931
1932         return($result{'Ack'});
1933 }
1934
1935 package Vend::Payment::PaypalExpress;
1936
1937 1;