Compare commits
16 commits
dd0ff8e2f4
...
2beee595e2
Author | SHA1 | Date | |
---|---|---|---|
|
2beee595e2 | ||
|
20967ab871 | ||
|
53355d9e4c | ||
|
336e401ac0 | ||
|
fd2d2e73f2 | ||
|
267e814e70 | ||
|
8b755e0e66 | ||
|
4a0e47a78a | ||
|
aef0d8762c | ||
|
5113ced7e3 | ||
|
dd503a3080 | ||
|
7aeeb15fcf | ||
|
9045d3d511 | ||
|
c5f62dbdb1 | ||
|
7198b854b9 | ||
|
5f4261beda |
8 changed files with 359 additions and 5 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -4,4 +4,5 @@ auth.txt
|
|||
blib
|
||||
perltidy.LOG
|
||||
pm_to_blib
|
||||
subscription-payment.html
|
||||
options-payment.html
|
||||
|
|
2
Changes
2
Changes
|
@ -9,6 +9,8 @@ Revision history for Perl module Business::PayPal::API
|
|||
- Extract out more payer details from XML.
|
||||
(PayerName, NameSuffix, PayerCountry).
|
||||
- Fix https://rt.cpan.org/Public/Bug/Display.html?id=67386
|
||||
- Options fields of GetTransactionDetails are now returned as a hash,
|
||||
containing the actual options data, rather than array of empty strings.
|
||||
|
||||
|
||||
0.70 2012-11-13
|
||||
|
|
12
Makefile.PL
Normal file
12
Makefile.PL
Normal file
|
@ -0,0 +1,12 @@
|
|||
use 5.008001;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'Business::PayPal::API',
|
||||
VERSION_FROM => 'lib/Business/PayPal/API.pm',
|
||||
PREREQ_PM => { SOAP::Lite => 0.67 },
|
||||
($] >= 5.005 ?
|
||||
(ABSTRACT_FROM => 'lib/Business/PayPal/API.pm',
|
||||
AUTHOR => 'Scott Wiersdorf <scott@perlcode.org>') : ()),
|
||||
);
|
178
lib/Business/PayPal/API/GetRecurringPaymentsProfileDetails.pm
Normal file
178
lib/Business/PayPal/API/GetRecurringPaymentsProfileDetails.pm
Normal file
|
@ -0,0 +1,178 @@
|
|||
# This file is part of Business:PayPal:API Module. License: Same as Perl. See its README for details.
|
||||
package Business::PayPal::API::GetRecurringPaymentsProfileDetails;
|
||||
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use SOAP::Lite 0.67;
|
||||
use Business::PayPal::API ();
|
||||
|
||||
our @ISA = qw(Business::PayPal::API);
|
||||
|
||||
|
||||
our @EXPORT_OK = qw(GetRecurringPaymentsProfileDetails); ## fake exporter
|
||||
|
||||
sub GetRecurringPaymentsProfileDetails {
|
||||
my $self = shift;
|
||||
my %args = @_;
|
||||
|
||||
my @trans =
|
||||
(
|
||||
$self->version_req,
|
||||
SOAP::Data->name( ProfileID => $args{ProfileID} )->type( 'xs:string' ),
|
||||
);
|
||||
|
||||
my $request = SOAP::Data->name
|
||||
( GetRecurringPaymentsProfileDetailsRequest => \SOAP::Data->value( @trans ) )
|
||||
->type("ns:GetRecurringPaymentsProfileDetailsRequestType");
|
||||
|
||||
my $som = $self->doCall( GetRecurringPaymentsProfileDetailsReq => $request )
|
||||
or return;
|
||||
|
||||
my $path = '/Envelope/Body/GetRecurringPaymentsProfileDetailsResponse';
|
||||
|
||||
my %response = ();
|
||||
unless( $self->getBasic($som, $path, \%response) ) {
|
||||
$self->getErrors($som, $path, \%response);
|
||||
return %response;
|
||||
}
|
||||
|
||||
$path .= '/GetRecurringPaymentsProfileDetailsResponseDetails';
|
||||
$self->getFields($som, $path, \%response,
|
||||
{ ProfileID => 'ProfileID',
|
||||
ProfileStatus => 'ProfileStatus',
|
||||
Description => 'Description',
|
||||
AggregateAmount => 'AggregateAmount',
|
||||
RegularAmountPaid => 'RegularAmountPaid',
|
||||
FinalPaymentDueDate => 'FinalPaymentDueDate',
|
||||
TrialAmountPaid => 'TrialAmountPaid',
|
||||
AggregateOptionalAmount => 'AggregateOptionalAmount',
|
||||
AutoBillOutstandingAmount => 'AutoBillOutstandingAmount',
|
||||
MaxFailedPayments => 'MaxFailedPayments',
|
||||
CountryName => 'SubscriberShippingAddress/CountryName',
|
||||
CityName => 'SubscriberShippingAddress/CityName',
|
||||
Street1 => 'SubscriberShippingAddress/Street1',
|
||||
Street2 => 'SubscriberShippingAddress/Street2',
|
||||
PostalCode => 'SubscriberShippingAddress/PostalCode',
|
||||
AddressID => 'SubscriberShippingAddress/AddressID',
|
||||
ExternalAddressID => 'SubscriberShippingAddress/ExternalAddressID',
|
||||
AddressOwner => 'SubscriberShippingAddress/AddressOwner',
|
||||
Phone => 'SubscriberShippingAddress/Phone',
|
||||
AddressStatus => 'SubscriberShippingAddress/AddressStatus',
|
||||
Name => 'SubscriberShippingAddress/Name',
|
||||
StateOrProvince => 'SubscriberShippingAddress/StateOrProvince',
|
||||
BillingStartDate => 'BillingStartDate',
|
||||
SubscriberName => 'SubscriberName',
|
||||
TaxAmount => 'CurrentRecurringPaymentsPeriod/TaxAmount',
|
||||
Amount => 'CurrentRecurringPaymentsPeriod/Amount',
|
||||
ShippingAmount => 'CurrentRecurringPaymentsPeriod/ShippingAmount',
|
||||
TotalBillingCycles => 'CurrentRecurringPaymentsPeriod/TotalBillingCycles',
|
||||
BillingPeriod => 'CurrentRecurringPaymentsPeriod/BillingPeriod',
|
||||
|
||||
|
||||
# 'LastPaymentAmount' => '10.00',
|
||||
# 'NextBillingDate' => '2014-01-17T10:00:00Z',
|
||||
# 'NumberCyclesRemaining' => '-2',
|
||||
# 'NumberCyclesCompleted' => '2',
|
||||
# 'LastPaymentDate' => '2013-12-17T10:59:31Z',
|
||||
# 'FailedPaymentCount' => '0',
|
||||
# 'OutstandingBalance' => '0.00'
|
||||
# }, 'RecurringPaymentsSummaryType' ),
|
||||
# '{urn:ebay:apis:eBLBaseComponents}RecurringPaymentsSummary',
|
||||
# bless( {
|
||||
# 'TaxAmount' => '0.00',
|
||||
# 'Amount' => '10.00',
|
||||
# 'ShippingAmount' => '0.00',
|
||||
# 'TotalBillingCycles' => '0',
|
||||
# 'BillingFrequency' => '1',
|
||||
# 'BillingPeriod' => 'Month'
|
||||
# }, 'BillingPeriodDetailsType' ),
|
||||
# '{urn:ebay:apis:eBLBaseComponents}RegularRecurringPaymentsPeriod',
|
||||
|
||||
}
|
||||
);
|
||||
|
||||
return %response;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Business::PayPal::API::GetRecurringPaymentsProfileDetails - PayPal GetRecurringPaymentsProfileDetails API
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Business::PayPal::API::GetRecurringPaymentsProfileDetails;
|
||||
my $pp = new Business::PayPal::API::GetRecurringPaymentsProfileDetails ( ... );
|
||||
|
||||
or
|
||||
|
||||
## see Business::PayPal::API documentation for parameters
|
||||
use Business::PayPal::API qw(GetRecurringPaymentsProfileDetails);
|
||||
my $pp = new Business::PayPal::API( ... );
|
||||
|
||||
my %response = $pp->GetRecurringPaymentsProfileDetails( ProfileID => $profileID, );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<Business::PayPal::API::GetRecurringPaymentsProfileDetails> implements PayPal's
|
||||
B<GetRecurringPaymentsProfileDetails> API using SOAP::Lite to make direct API calls to
|
||||
PayPal's SOAP API server. It also implements support for testing via
|
||||
PayPal's I<sandbox>. Please see L<Business::PayPal::API> for details
|
||||
on using the PayPal sandbox.
|
||||
|
||||
=head2 GetRecurringPaymentsProfileDetails
|
||||
|
||||
Implements PayPal's B<GetRecurringPaymentsProfileDetails> API call. Supported
|
||||
parameters include:
|
||||
|
||||
TransactionID
|
||||
|
||||
as described in the PayPal "Web Services API Reference" document.
|
||||
|
||||
Returns a hash containing the transaction details, including these fields:
|
||||
|
||||
|
||||
As described in the API document.
|
||||
|
||||
|
||||
Example:
|
||||
|
||||
my %resp = $pp->GetRecurringPaymentsProfileDetails( ProfileID => $trans_id );
|
||||
print "Payer: $resp{ProfileStatus}\n";
|
||||
|
||||
|
||||
=head2 ERROR HANDLING
|
||||
|
||||
See the B<ERROR HANDLING> section of B<Business::PayPal::API> for
|
||||
information on handling errors.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
None by default.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<https://developer.paypal.com/en_US/pdf/PP_APIReference.pdf>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Bradley M. Kuhn E<lt>bkuhn@ebb.orgE<gt>
|
||||
|
||||
adapted from work by:
|
||||
Scot Wiersdorf E<lt>scott@perlcode.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2006 by Scott Wiersdorf
|
||||
Copyright (C) 2013 by Bradley M. Kuhn
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.5 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
=cut
|
|
@ -127,12 +127,43 @@ sub GetTransactionDetails {
|
|||
Number => 'Number',
|
||||
Quantity => 'Quantity',
|
||||
Amount => 'Amount',
|
||||
Options => 'Options',
|
||||
}
|
||||
);
|
||||
|
||||
if ( scalar( @$paymentitems ) > 0 ) {
|
||||
# Options data must be extracted differently. Specifically, the
|
||||
# "interesting" parts of the Options data is not in the values inside
|
||||
# the $som structure (which means $som->valueof(), which
|
||||
# $self->getFieldsList() above calls underneath, won't extract the
|
||||
# useful data, because the values are empty.
|
||||
|
||||
# The convoluted loop below finds any Options values and matches them
|
||||
# up properly with the correct PaymentItem. Note that the loop is
|
||||
# written this way to account for the fact that there may be multiple
|
||||
# PaymentItems.
|
||||
|
||||
# Finally, I contemplated placing this loop below in getFieldsList()
|
||||
# with a special-case for Options, but I am not sure it belongs
|
||||
# there. Ultimately, I think this is unique to the
|
||||
# GetTransactionsDetails call in the API, and thus it's more
|
||||
# appropriately placed here.
|
||||
my $ii = 0;
|
||||
my @fulloptions;
|
||||
foreach my $rec ( $som->dataof($path . '/PaymentItemInfo/PaymentItem' ) ) {
|
||||
my %options;
|
||||
foreach my $subrec ($rec->value()) {
|
||||
foreach my $fieldrec ($$subrec->value()) {
|
||||
$options{$fieldrec->attr()->{name}} = $fieldrec->attr()->{value}
|
||||
if ($fieldrec->name() eq "Options");
|
||||
}
|
||||
}
|
||||
$paymentitems->[$ii]{Options} = \%options;
|
||||
push(@fulloptions, \%options);
|
||||
}
|
||||
# Now, we can save the payment items properly
|
||||
$response{PaymentItems} = $paymentitems;
|
||||
# And set the PII_Options properly too.
|
||||
$response{PII_Options} = \@fulloptions;
|
||||
}
|
||||
|
||||
return %response;
|
||||
|
@ -260,6 +291,7 @@ records:
|
|||
Number => '...',
|
||||
Quantity => '...',
|
||||
Amount => '...',
|
||||
Options => { 'key' => 'value', ... },
|
||||
},
|
||||
{ SalesTax => ..., etc.
|
||||
} ]
|
||||
|
@ -272,6 +304,9 @@ Example:
|
|||
for my $item ( @{ $resp{PaymentItems} } ) {
|
||||
print "Name: " . $item->{Name} . "\n";
|
||||
print "Amt: " . $item->{Amount} . "\n";
|
||||
for my $optionname (keys %$item->{Options}) {
|
||||
print "Option: $optionname is " . $item->{Options}{$optionname} . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
=head2 ERROR HANDLING
|
||||
|
@ -290,10 +325,12 @@ L<https://developer.paypal.com/en_US/pdf/PP_APIReference.pdf>
|
|||
=head1 AUTHOR
|
||||
|
||||
Scot Wiersdorf E<lt>scott@perlcode.orgE<gt>
|
||||
Bradley M. Kuhn E<lt>bkuhn@ebb.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2006 by Scott Wiersdorf
|
||||
Copyright (C) 2014, 2015 by Bradley M. Kuhn
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.8.5 or,
|
||||
|
|
|
@ -20,6 +20,7 @@ sub TransactionSearch {
|
|||
Payer => 'ebl:EmailAddressType',
|
||||
Receiver => 'ebl:EmailAddressType',
|
||||
ReceiptID => 'xs:string',
|
||||
ProfileID => 'xs:string',
|
||||
TransactionID => 'xs:string',
|
||||
InvoiceID => 'xs:string',
|
||||
PayerName => 'xs:string',
|
||||
|
|
|
@ -10,7 +10,7 @@ if ( !$ENV{WPP_TEST} || !-f $ENV{WPP_TEST} ) {
|
|||
'No WPP_TEST env var set. Please see README to run tests';
|
||||
}
|
||||
else {
|
||||
plan tests => 6;
|
||||
plan tests => 14;
|
||||
}
|
||||
|
||||
use_ok( 'Business::PayPal::API::TransactionSearch' );
|
||||
|
@ -75,10 +75,14 @@ foreach my $record (@{$resp}) {
|
|||
like($detail{PaymentItems}[0]{Name}, qr/Field\s+Options/i, 'Found field options test transaction');
|
||||
like($detail{PII_Name}, qr/Field\s+Options/i, 'Found field options test transaction');
|
||||
|
||||
foreach my $options ($detail{PaymentItems}[0]{Options}, $detail{PII_Options}) {
|
||||
ok((scalar(@$options) == 2 and $options->[0] eq '' and $options->[0] eq ''),
|
||||
"PaymentItems's Options has 2 elements with empty strings");
|
||||
foreach my $options ($detail{PaymentItems}[0]{Options}, $detail{PII_Options}[0]) {
|
||||
ok(scalar(keys %$options) == 2, "The PaymentItems Options has 2 elements");
|
||||
ok(defined $options->{firstOption}, "'firstOption' is present");
|
||||
ok($options->{firstOption} eq 'Yes', "'firstOption' is selected as 'Yes'");
|
||||
ok(defined $options->{size}, "'size' option is present");
|
||||
ok($options->{size} eq "Large", "'size' option is selected as 'Large'");
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# Mode: CPerl
|
||||
# indent-tabs-mode: nil
|
||||
|
|
119
t/SubscriptionPayments.t
Normal file
119
t/SubscriptionPayments.t
Normal file
|
@ -0,0 +1,119 @@
|
|||
# -*- mode: cperl -*-
|
||||
use strict;
|
||||
use warnings;
|
||||
use autodie qw(:all);
|
||||
|
||||
use Cwd;
|
||||
use List::AllUtils;
|
||||
use Test::More;
|
||||
|
||||
if ( !$ENV{WPP_TEST} || !-f $ENV{WPP_TEST} ) {
|
||||
plan skip_all =>
|
||||
'No WPP_TEST env var set. Please see README to run tests';
|
||||
}
|
||||
else {
|
||||
plan tests => 5;
|
||||
}
|
||||
|
||||
use_ok( 'Business::PayPal::API::TransactionSearch' );
|
||||
#########################
|
||||
|
||||
require 't/API.pl';
|
||||
|
||||
my %args = do_args();
|
||||
|
||||
=pod
|
||||
|
||||
The following four tests shows the methodology to use TransactionSearch to
|
||||
find transactions that are part of the same ProfileID. This method was
|
||||
discovered by trial-and-error. Specifically, it's somewhat odd that
|
||||
TransactionSearch is used with the parameter of 'ProfileID' with the value
|
||||
set to a specific TransactionID to find the ProfileID via the "Created"
|
||||
transaction. Then, in turn, that ProfileID can find the subscription payments
|
||||
related to the original transaction.
|
||||
|
||||
This works, and seems to be correct, albeit odd.
|
||||
|
||||
=cut
|
||||
|
||||
open SUBSCRIPTION_PAY_HTML, '>', 'subscription-payment.html';
|
||||
|
||||
print SUBSCRIPTION_PAY_HTML <<_SUBSCRIPTION_PAYMENT_DATA_
|
||||
<html>
|
||||
<body>
|
||||
<form action="https://www.sandbox.paypal.com/cgi-bin/webscr" method="post" target="_top">
|
||||
<input type="hidden" name="business" value="$args{SellerEmail}" />
|
||||
<input type="hidden" name="item_name" value="Monthly Payment" />
|
||||
<input type="hidden" name="cmd" value="_xclick-subscriptions">
|
||||
<input id="no_shipping" type="hidden" name="no_shipping" value="0" />
|
||||
<input type="hidden" name="lc" value="US">
|
||||
<input type="hidden" name="no_note" value="1">
|
||||
<input type="hidden" name="t3" value="M" />
|
||||
<input type="hidden" name="p3" value="1" />
|
||||
<input type="hidden" name="src" value="1" />
|
||||
<input type="hidden" name="srt" value="0" />
|
||||
<input id="no_shipping" type="hidden" name="no_shipping" value="0" />
|
||||
<input type="hidden" name="no_note" value="1">
|
||||
<input id="amount" type="text" name="a3" size="5" minimum="10" value="10" />
|
||||
<input type="image" border="0" name="submit" alt="Make test monthly payment now">
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
_SUBSCRIPTION_PAYMENT_DATA_
|
||||
;
|
||||
close SUBSCRIPTION_PAY_HTML;
|
||||
|
||||
my $cwd = getcwd;
|
||||
|
||||
print STDERR <<"_PROFILEID_";
|
||||
Please note the next series of tests will not succeeed unless there is at
|
||||
least one transaction that is part of a subscription payments in your business
|
||||
account.
|
||||
|
||||
if you haven't made one yet, you can visit:
|
||||
file:///$cwd/subscription-payment.html
|
||||
|
||||
and use the sandbox buyer account to make the payment.
|
||||
_PROFILEID_
|
||||
|
||||
my $start_date = '1998-01-01T01:45:10.00Z';
|
||||
|
||||
my $ts = Business::PayPal::API::TransactionSearch->new( %args );
|
||||
|
||||
my $resp = $ts->TransactionSearch( StartDate => $start_date );
|
||||
|
||||
ok( scalar @{$resp} > 0, 'Some transactions found' );
|
||||
|
||||
my ( $profileID, %possible_txn_ids );
|
||||
|
||||
foreach my $record ( @{$resp} ) {
|
||||
if ( $record->{Type} =~ /Recurring/ ) {
|
||||
if ( $record->{Status} =~ /Completed/ ) {
|
||||
$possible_txn_ids{ $record->{TransactionID} } = $record;
|
||||
}
|
||||
elsif ( $record->{Status} =~ /Created/ ) {
|
||||
$profileID = $record->{TransactionID};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
ok( defined $profileID,
|
||||
'Subscription Payment Creation Record and ProfileID Found' );
|
||||
ok( scalar keys %possible_txn_ids > 0,
|
||||
'Subscription Payment Transactions Found'
|
||||
);
|
||||
|
||||
my $date_search_res = $ts->TransactionSearch(
|
||||
ProfileID => $profileID,
|
||||
StartDate => $start_date,
|
||||
);
|
||||
|
||||
# One of these will need to be in the possibleTransactionID list (i.e., we're
|
||||
# assuming that at least one payment has occured in this repeating).
|
||||
|
||||
ok( List::AllUtils::any {
|
||||
defined $possible_txn_ids{ $_->{TransactionID} }
|
||||
}
|
||||
@{$date_search_res},
|
||||
'Found one payment transaction under the given Profile ID'
|
||||
);
|
Loading…
Reference in a new issue