line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SOAP::Amazon::MerchantTransport; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
26523
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
38
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
58
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
SOAP::Amazon::MerchantTransport - An easy to connect to Amazon Merchant Services |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Version 0.02 |
13
|
|
|
|
|
|
|
$Id: MerchantTransport.pm,v 1.1 2006/01/30 17:58:42 nathan Exp $ |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=cut |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
6
|
use Carp qw(carp croak); |
|
1
|
|
|
|
|
17
|
|
|
1
|
|
|
|
|
71
|
|
20
|
1
|
|
|
1
|
|
462
|
use SOAP::Lite; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use MIME::Entity; |
22
|
|
|
|
|
|
|
use Data::Dumper; $Data::Dumper::Indent = 1; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
die "SOAP::Amazon::MerchantTransport requires SOAP::Lite 0.67 or higher.\n" |
25
|
|
|
|
|
|
|
unless $SOAP::Lite::VERSION >= 0.67; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 SYNOPSIS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
This module provides a simple way to access Amazon's Merchant Services via |
30
|
|
|
|
|
|
|
SOAP. It is based on L. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
use SOAP::Amazon::MerchantTransport; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $a = SOAP::Amazon::MerchantTransport->new( |
35
|
|
|
|
|
|
|
merchantname => 'Bill Shop', |
36
|
|
|
|
|
|
|
merchant => 'Q_M_FOOBAR_1234', |
37
|
|
|
|
|
|
|
username => 'joe@schmo.com.com', |
38
|
|
|
|
|
|
|
password => 'SDNDJNDNFJDJ', |
39
|
|
|
|
|
|
|
url => 'https://merchant-api-qa.amazon.com/foobar/' |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$som = $a->getAllPendingDocumentInfo($doctype); |
43
|
|
|
|
|
|
|
$som = $a->getDocument($documentID); |
44
|
|
|
|
|
|
|
$som = $a->postDocument($requesttype, $document); |
45
|
|
|
|
|
|
|
$som = $a->postDocumentDownloadAck(@documentIdentifiers) |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
All of these methods, by default return a L Object unless you |
48
|
|
|
|
|
|
|
specify a handler for the return values. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
NOTE: It is possible to write your own handlers to return a different object, |
51
|
|
|
|
|
|
|
but no such modules have been created at the time of this writing. Therefore |
52
|
|
|
|
|
|
|
the documentation will always refer to the return value of the get/post |
53
|
|
|
|
|
|
|
documents as being a L, but obviously if you specify a handler the |
54
|
|
|
|
|
|
|
return object will be different. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
If you want to debug, simply import SOAP::Lite with debugging options |
57
|
|
|
|
|
|
|
on into your script. This has the global effect of turning debugging on. e.g. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
use SOAP::Lite +trace => [qw( debug )]; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head2 Module Scope |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This module is to ease the submission of XML Feeds to Amazon. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
This module does not write your Amazon XML Feeds, it only simplifies the |
66
|
|
|
|
|
|
|
submission of those feeds. If you need help writing the Amazon XML Feeds for |
67
|
|
|
|
|
|
|
pricing, inventory, orders, etc. view the sample feeds in the Amazon |
68
|
|
|
|
|
|
|
Documentation. Contact your integration manager for access to these. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Also this module does not handle SOAP errors for you. It uses L |
71
|
|
|
|
|
|
|
to submit the XML requests and returns a L object, unless |
72
|
|
|
|
|
|
|
another handler is specified. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# -------- Globals -------- # |
77
|
|
|
|
|
|
|
our $gURI="http://www.amazon.com/merchants/merchant-interface/MerchantInterface"; |
78
|
|
|
|
|
|
|
our %gSOAPActionKeys = ( # STATIC - defined by Amazon WSDL |
79
|
|
|
|
|
|
|
getAllPendingDocumentInfo => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7KVtMd2FzcGNTZXJ2ZXIvQW16SVNBL01lcmNoYW50RG9jdW1lbnRJbmZvOw==", |
80
|
|
|
|
|
|
|
postDocument => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7TG9yZy9pZG9veC93YXNwL3R5cGVzL1JlcXVlc3RNZXNzYWdlQXR0YWNobWVudDspTHdhc3BjU2VydmVyL0FteklTQS9Eb2N1bWVudFN1Ym1pc3Npb25SZXNwb25zZTs=", |
81
|
|
|
|
|
|
|
getDocument => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7TG9yZy9pZG9veC93YXNwL3R5cGVzL1Jlc3BvbnNlTWVzc2FnZUF0dGFjaG1lbnQ7KUxqYXZhL2xhbmcvU3RyaW5nOw==", |
82
|
|
|
|
|
|
|
postDocumentDownloadAck => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7W0xqYXZhL2xhbmcvU3RyaW5nOylbTHdhc3BjU2VydmVyL0FteklTQS9Eb2N1bWVudERvd25sb2FkQWNrU3RhdHVzOw==", |
83
|
|
|
|
|
|
|
getDocumentProcessingStatus => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7SilMd2FzcGNTZXJ2ZXIvQW16SVNBL0RvY3VtZW50UHJvY2Vzc2luZ0luZm87", |
84
|
|
|
|
|
|
|
getLastNDocumentInfo => "KEx3YXNwY1NlcnZlci9BbXpJU0EvTWVyY2hhbnQ7TGphdmEvbGFuZy9TdHJpbmc7SSlbTHdhc3BjU2VydmVyL0FteklTQS9NZXJjaGFudERvY3VtZW50SW5mbzs=", |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
our %gMessageTypes = ( # STATIC |
88
|
|
|
|
|
|
|
product => "_POST_PRODUCT_DATA_", |
89
|
|
|
|
|
|
|
productRelationship => "_POST_PRODUCT_RELATIONSHIP_DATA_", |
90
|
|
|
|
|
|
|
productOverrides => "_POST_PRODUCT_OVERRIDES_DATA_", |
91
|
|
|
|
|
|
|
image => "_POST_PRODUCT_IMAGE_DATA_", |
92
|
|
|
|
|
|
|
productPricing => "_POST_PRODUCT_PRICING_DATA_", |
93
|
|
|
|
|
|
|
inventory => "_POST_INVENTORY_AVAILABILITY_DATA_", |
94
|
|
|
|
|
|
|
testOrders => "_POST_TEST_ORDERS_DATA_", |
95
|
|
|
|
|
|
|
orderAck => "_POST_ORDER_ACKNOWLEDGEMENT_DATA_", |
96
|
|
|
|
|
|
|
orderFulfillment => "_POST_ORDER_FULFILLMENT_DATA_", |
97
|
|
|
|
|
|
|
paymentAdjustment => "_POST_PAYMENT_ADJUSTMENT_DATA_", |
98
|
|
|
|
|
|
|
storeData => "_POST_STORE_DATA_", |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
_POST_PRODUCT_DATA_ => "_POST_PRODUCT_DATA_", |
101
|
|
|
|
|
|
|
_POST_PRODUCT_RELATIONSHIP_DATA_ => "_POST_PRODUCT_RELATIONSHIP_DATA_", |
102
|
|
|
|
|
|
|
_POST_PRODUCT_OVERRIDES_DATA_ => "_POST_PRODUCT_OVERRIDES_DATA_", |
103
|
|
|
|
|
|
|
_POST_PRODUCT_IMAGE_DATA_ => "_POST_PRODUCT_IMAGE_DATA_", |
104
|
|
|
|
|
|
|
_POST_PRODUCT_PRICING_DATA_ => "_POST_PRODUCT_PRICING_DATA_", |
105
|
|
|
|
|
|
|
_POST_INVENTORY_AVAILABILITY_DATA_=> "_POST_INVENTORY_AVAILABILITY_DATA_", |
106
|
|
|
|
|
|
|
_POST_TEST_ORDERS_DATA_ => "_POST_TEST_ORDERS_DATA_", |
107
|
|
|
|
|
|
|
_POST_ORDER_ACKNOWLEDGEMENT_DATA_ => "_POST_ORDER_ACKNOWLEDGEMENT_DATA_", |
108
|
|
|
|
|
|
|
_POST_ORDER_FULFILLMENT_DATA_ => "_POST_ORDER_FULFILLMENT_DATA_", |
109
|
|
|
|
|
|
|
_POST_PAYMENT_ADJUSTMENT_DATA_ => "_POST_PAYMENT_ADJUSTMENT_DATA_", |
110
|
|
|
|
|
|
|
_POST_STORE_DATA_ => "_POST_STORE_DATA_", |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
our %gPendingValid = ( # STATIC |
114
|
|
|
|
|
|
|
orders => "_GET_ORDERS_DATA_", |
115
|
|
|
|
|
|
|
payments => "_GET_PAYMENT_SETTLEMENT_DATA_", |
116
|
|
|
|
|
|
|
_GET_ORDERS_DATA_ => "_GET_ORDERS_DATA_", |
117
|
|
|
|
|
|
|
_GET_PAYMENT_SETTLEMENT_DATA_ => "_GET_PAYMENT_SETTLEMENT_DATA_", |
118
|
|
|
|
|
|
|
); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# ------ End Globals ------ # |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 CONSTRUCTOR AND STARTUP |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 $sub->new( ); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Creating a new MerchantTransport object is easy: |
127
|
|
|
|
|
|
|
my $a = SOAP::Amazon::MerchantTransport->new( |
128
|
|
|
|
|
|
|
merchantname => 'Bill Shop', |
129
|
|
|
|
|
|
|
merchant => 'Q_M_FOOBAR_1234', |
130
|
|
|
|
|
|
|
username => 'joe@schmo.com.com', |
131
|
|
|
|
|
|
|
password => 'SDNDJNDNFJDJ', |
132
|
|
|
|
|
|
|
url => 'https://merchant-api-qa.amazon.com/foobar/' |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
All of these parameters are required. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
If you want the response to be something other than an L object |
138
|
|
|
|
|
|
|
you can pass in the qualified name of the module you want to use as the |
139
|
|
|
|
|
|
|
return values. e.g. |
140
|
|
|
|
|
|
|
... |
141
|
|
|
|
|
|
|
handler => 'SOAP::Amazon::MSReturnVal', |
142
|
|
|
|
|
|
|
... |
143
|
|
|
|
|
|
|
This module is currently ficticious. See L |
144
|
|
|
|
|
|
|
for more information. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=cut |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub new |
149
|
|
|
|
|
|
|
{ |
150
|
|
|
|
|
|
|
my $class = shift; |
151
|
|
|
|
|
|
|
my %args = @_; |
152
|
|
|
|
|
|
|
my $self = bless {}, $class; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
for (qw/merchantname merchant username password url/) { |
155
|
|
|
|
|
|
|
$self->{$_} = $args{$_} or croak "Need to set $_ when calling 'new'"; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
for (qw/handler/) { |
158
|
|
|
|
|
|
|
$self->{$_} = $args{$_} if $args{$_}; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
$self |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 METHODS |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 $a->getAllPendingDocumentInfo( $doctype ) |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Given a type of document to retrieve, returns an array of TODO s. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Valid values for the $doctype are: C, or C. You can also |
173
|
|
|
|
|
|
|
pass the exact values Amazon calls for: C<_GET_ORDERS_DATA_> or |
174
|
|
|
|
|
|
|
C<_GET_PAYMENT_SETTLEMENT_DATA_>, but the first method is preferred. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=cut |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub getAllPendingDocumentInfo |
179
|
|
|
|
|
|
|
{ |
180
|
|
|
|
|
|
|
my $this = shift; |
181
|
|
|
|
|
|
|
my ($msgtype) = @_; |
182
|
|
|
|
|
|
|
croak "$msgtype is not a valid msgtype. Try 'orders' or 'payments'." |
183
|
|
|
|
|
|
|
unless defined $gPendingValid{$msgtype}; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $soap=$this->_getsoap |
186
|
|
|
|
|
|
|
->getAllPendingDocumentInfo( ams => $this, |
187
|
|
|
|
|
|
|
messagetype => $gPendingValid{$msgtype}); |
188
|
|
|
|
|
|
|
$this->returnsoap($soap) |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head2 $a->getDocumentProcessingStatus( $documentID ) |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Given the documentTransactionID (given to you by Amazon) returns a |
194
|
|
|
|
|
|
|
L containing the document. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=cut |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub getDocumentProcessingStatus { |
199
|
|
|
|
|
|
|
my $this = shift; |
200
|
|
|
|
|
|
|
my $docid = $_[0]; |
201
|
|
|
|
|
|
|
my $soap = $this->_getsoap |
202
|
|
|
|
|
|
|
->getDocumentProcessingStatus( ams => $this, docid => $docid ); |
203
|
|
|
|
|
|
|
$this->returnsoap($soap) |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 $a->getDocument( $documentID ) |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Given the DocumentID received from getAllPendingDocumentInfo returns the |
209
|
|
|
|
|
|
|
a L containing the return values. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub getDocument { |
214
|
|
|
|
|
|
|
my $this = shift; |
215
|
|
|
|
|
|
|
my ($docid) = @_; |
216
|
|
|
|
|
|
|
my $soap = $this->_getsoap |
217
|
|
|
|
|
|
|
->getDocument( ams => $this, docid => $docid ); |
218
|
|
|
|
|
|
|
$this->returnsoap($soap) |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 $a->postDocument( $requesttype, $localID, $content ) |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Given a request type string, local identifier, and an Amazon xml content |
224
|
|
|
|
|
|
|
string returns a L containing the return values. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Valid Request Types are: |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
product |
229
|
|
|
|
|
|
|
productRelationship |
230
|
|
|
|
|
|
|
productOverrides |
231
|
|
|
|
|
|
|
productImage |
232
|
|
|
|
|
|
|
productPricing |
233
|
|
|
|
|
|
|
inventoryAvailability |
234
|
|
|
|
|
|
|
testOrders |
235
|
|
|
|
|
|
|
orderAck |
236
|
|
|
|
|
|
|
orderFulfillment |
237
|
|
|
|
|
|
|
paymentAdjustment |
238
|
|
|
|
|
|
|
storeData |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
$localID is a local identifier. You could try L. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
$content is a string containing the XML you want to post to Amazon. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub postDocument { |
247
|
|
|
|
|
|
|
my $this = shift; |
248
|
|
|
|
|
|
|
my ($rt, $id, $con) = @_; |
249
|
|
|
|
|
|
|
croak "$rt is not a valid request type. See ".__FILE__." docs or Amazon API" |
250
|
|
|
|
|
|
|
unless defined $gMessageTypes{$rt}; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
my $ent = build MIME::Entity |
253
|
|
|
|
|
|
|
Type => "application/octetstream", |
254
|
|
|
|
|
|
|
Encoding => "binary", |
255
|
|
|
|
|
|
|
Disposition => "attachment", |
256
|
|
|
|
|
|
|
Id => "<".$id.">", |
257
|
|
|
|
|
|
|
Data => $con; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
my @parts = ($ent); |
260
|
|
|
|
|
|
|
#Carp::confess(Data::Dumper::Dumper(\@parts)); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
my $soap = $this->_getsoap |
263
|
|
|
|
|
|
|
->parts(\@parts) |
264
|
|
|
|
|
|
|
->serializer(AMSSerializer->new) |
265
|
|
|
|
|
|
|
->postDocument( ams => $this, |
266
|
|
|
|
|
|
|
messagetype => $gMessageTypes{$rt}, |
267
|
|
|
|
|
|
|
contentid => $id ); |
268
|
|
|
|
|
|
|
$this->returnsoap($soap) |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head2 $a->postDocumentDownloadAck( @documentIdentifiers ) |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
TODO |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=cut |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub postDocumentDownloadAck { |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head2 $a->merchantname( [$merchantname] ) |
281
|
|
|
|
|
|
|
=head2 $a->merchant( [$merchant] ) |
282
|
|
|
|
|
|
|
=head2 $a->username( [$username] ) |
283
|
|
|
|
|
|
|
=head2 $a->password( [$password] ) |
284
|
|
|
|
|
|
|
=head2 $a->url( [$url] ) |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
If no argument is given it returns the appropriate value. If there is an |
287
|
|
|
|
|
|
|
argument the value is set. |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
Examples: |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
$a->merchantname('Foo Bar Merch'); |
292
|
|
|
|
|
|
|
$a->merchant('Q_M_FOOBAR_1234'); |
293
|
|
|
|
|
|
|
$a->username('joe@schmo.com'); |
294
|
|
|
|
|
|
|
$a->password('raboof'); |
295
|
|
|
|
|
|
|
$a->url('https://merchant-api-qa.amazon.com/whatever/'); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
my $m = $a->merchant; # $m is now 'Q_M_FOOBAR_1234' |
298
|
|
|
|
|
|
|
etc... |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=cut |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub merchant { $_[1] ? shift->{merchant} = $_[1] : shift->{merchant} } |
303
|
|
|
|
|
|
|
sub username { $_[1] ? shift->{username} = $_[1] : shift->{username} } |
304
|
|
|
|
|
|
|
sub password { $_[1] ? shift->{password} = $_[1] : shift->{password} } |
305
|
|
|
|
|
|
|
sub url { $_[1] ? shift->{url} = $_[1] : shift->{url} } |
306
|
|
|
|
|
|
|
sub merchantname { $_[1] ? shift->{merchantname}=$_[1] : shift->{merchantname}} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head1 Writing Your Own Response Handler |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
TODO: this feauture is not yet complete. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=cut |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub returnsoap |
315
|
|
|
|
|
|
|
{ |
316
|
|
|
|
|
|
|
my $this = shift; |
317
|
|
|
|
|
|
|
# TODO this is where you would add the handler to return something |
318
|
|
|
|
|
|
|
# other than a SOAP::SOM |
319
|
|
|
|
|
|
|
$_[0] |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
############################################ |
323
|
|
|
|
|
|
|
# Private Methods |
324
|
|
|
|
|
|
|
############################################ |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub _getsoap |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
my $this = shift; |
329
|
|
|
|
|
|
|
(my $funcname = (caller(1))[3]) =~ s/.*::(\w+)$/$1/; |
330
|
|
|
|
|
|
|
my $soap = SOAP::Lite |
331
|
|
|
|
|
|
|
->on_action( sub { return "\"$gURI#$funcname#" . |
332
|
|
|
|
|
|
|
$gSOAPActionKeys{$funcname} . |
333
|
|
|
|
|
|
|
"\""; } ) |
334
|
|
|
|
|
|
|
->ns( $gURI ) |
335
|
|
|
|
|
|
|
->proxy( $this->proxy ) |
336
|
|
|
|
|
|
|
->serializer(AMSSerializer->new); |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
$soap |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub proxy |
342
|
|
|
|
|
|
|
{ |
343
|
|
|
|
|
|
|
my $this = shift; |
344
|
|
|
|
|
|
|
local $_ = $this->url; |
345
|
|
|
|
|
|
|
s/(?<=^https:\/\/)/\%s:\%s\@/ or die "$_ must use https:"; |
346
|
|
|
|
|
|
|
sprintf $_, map $this->url_encode($_), $this->username, $this->password |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub url_encode |
350
|
|
|
|
|
|
|
{ |
351
|
|
|
|
|
|
|
my $this = shift; |
352
|
|
|
|
|
|
|
local $_ = $_[0]; |
353
|
|
|
|
|
|
|
s/(\W)/sprintf'%%%02X',ord$1/eg; |
354
|
|
|
|
|
|
|
$_ |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
1; # End of SOAP::Amazon::MerchantTransport |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
############################################ |
359
|
|
|
|
|
|
|
# package AMSSerializer |
360
|
|
|
|
|
|
|
############################################ |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
BEGIN { |
363
|
|
|
|
|
|
|
package AMSSerializer; @AMSSerializer::ISA = 'SOAP::Serializer'; |
364
|
|
|
|
|
|
|
import SOAP::Data qw/name value/; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub envelope { |
367
|
|
|
|
|
|
|
my $this = shift; |
368
|
|
|
|
|
|
|
my ($morr, $func, %args) = @_; |
369
|
|
|
|
|
|
|
my ($ms, $mtype, $content, $conid, $docid, $howmany) = |
370
|
|
|
|
|
|
|
($args{ams}, $args{messagetype}, $args{content}, |
371
|
|
|
|
|
|
|
$args{contentid}, $args{docid}, $args{howmany}); |
372
|
|
|
|
|
|
|
my @data; |
373
|
|
|
|
|
|
|
my $docidtag; |
374
|
|
|
|
|
|
|
my $ans= $gURI; |
375
|
|
|
|
|
|
|
my $sns='http://systinet.com/xsd/SchemaTypes/'; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
if ($docid) { |
378
|
|
|
|
|
|
|
$docidtag = $func =~ /getDocumentProcessingStatus/ ? |
379
|
|
|
|
|
|
|
"documentTransactionIdentifier" : |
380
|
|
|
|
|
|
|
$func =~ /getDocument/ ? |
381
|
|
|
|
|
|
|
"documentIdentifier" : |
382
|
|
|
|
|
|
|
"documentIdentifier"; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
if ($docid) { |
386
|
|
|
|
|
|
|
for($func) { |
387
|
|
|
|
|
|
|
if (/getDocumentProcessingStatus/) { |
388
|
|
|
|
|
|
|
push @data, name(getDocumentProcessingStatus => $docid)->type("long"); |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
elsif (/getDocument/) { |
391
|
|
|
|
|
|
|
push @data, name(getDocument => $docid)->type("string"); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
push @data, name(messageType => $mtype) if $mtype; |
397
|
|
|
|
|
|
|
push @data, name(howMany => $howmany) if $howmany; |
398
|
|
|
|
|
|
|
push @data, name("doc")->uri($sns)->attr({href => "cid:$conid"}) if $conid; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
$this->SUPER::envelope(freeform => |
401
|
|
|
|
|
|
|
name(merchant => |
402
|
|
|
|
|
|
|
\SOAP::Data->value( # note the dereferencing |
403
|
|
|
|
|
|
|
name(merchantIdentifier=>$ms->merchant)->uri($ans), |
404
|
|
|
|
|
|
|
name(merchantName => $ms->merchantname)->uri($ans) |
405
|
|
|
|
|
|
|
) # end value |
406
|
|
|
|
|
|
|
)->uri($sns), # end merchant |
407
|
|
|
|
|
|
|
@data |
408
|
|
|
|
|
|
|
); # end SUPER::envelope |
409
|
|
|
|
|
|
|
} # end envelope |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
1; |
412
|
|
|
|
|
|
|
} # end BEGIN block |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
############################################ |
415
|
|
|
|
|
|
|
# end AMSSerializer |
416
|
|
|
|
|
|
|
############################################ |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head1 AUTHOR |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Nate Murray, C<< >> |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head1 KNOWN BUGS AND LIMITATIONS |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
There are no known bugs as of version 0.2, just a couple incomplete features. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
427
|
|
|
|
|
|
|
C, or through the web interface at |
428
|
|
|
|
|
|
|
L. |
429
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
430
|
|
|
|
|
|
|
your bug as I make changes. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head1 SUPPORT |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
perldoc SOAP::Amazon::MerchantTransport |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
You can also look for information at: |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=over 4 |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
L |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item * CPAN Ratings |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
L |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
L |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=item * Search CPAN |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
L |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=back |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Copyright 2006 Nate Murray, all rights reserved. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
465
|
|
|
|
|
|
|
under the same terms as Perl itself. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=cut |
468
|
|
|
|
|
|
|
|