line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::eBay; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
24275
|
use warnings; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
38
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
471
|
use XML::Simple; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use XML::Dumper; |
8
|
|
|
|
|
|
|
use Data::Dumper; |
9
|
|
|
|
|
|
|
use LWP::UserAgent; |
10
|
|
|
|
|
|
|
use HTTP::Request::Common; |
11
|
|
|
|
|
|
|
use HTTP::Status qw(status_message); |
12
|
|
|
|
|
|
|
use HTTP::Date qw(time2str str2time); |
13
|
|
|
|
|
|
|
use utf8; |
14
|
|
|
|
|
|
|
use Carp qw( croak ); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use vars qw( $_ua ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# find out if compression can be supported |
19
|
|
|
|
|
|
|
our $HAS_ZLIB; |
20
|
|
|
|
|
|
|
BEGIN { $HAS_ZLIB = eval 'use Compress::Zlib (); 1;' } |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Net::eBay - Perl Interface to XML based eBay API. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 VERSION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Version 0.61 |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '0.61'; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 SYNOPSIS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
This module helps user to easily execute queries against eBay's XML API. |
37
|
|
|
|
|
|
|
Copyright Igor Chudov, ichudov@algebra.com. |
38
|
|
|
|
|
|
|
Released under GNU Public License v. 2 |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
################################################## |
41
|
|
|
|
|
|
|
# For support, docs, info, email to author go to # |
42
|
|
|
|
|
|
|
# # |
43
|
|
|
|
|
|
|
# http://www.net-ebay.org/ # |
44
|
|
|
|
|
|
|
################################################## |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Also check out Object::eBay perl module for higher level abstraction |
47
|
|
|
|
|
|
|
built on top of Net::eBay. Object::eBay is a work of another |
48
|
|
|
|
|
|
|
individual, not Igor Chudov. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Also check out several ebay-*.pl scripts that ship with this |
51
|
|
|
|
|
|
|
distribution, they should be installed in your scripts directory. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head2 Getting Official Time |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
use Net::eBay; |
56
|
|
|
|
|
|
|
my $eBay = new Net::eBay; # look up ebay.ini in $ENV{EBAY_INI_FILE}, "./ebay.ini", "~/.ebay.ini" |
57
|
|
|
|
|
|
|
my $result = $eBay->submitRequest( "GeteBayOfficialTime", {} ); |
58
|
|
|
|
|
|
|
print "eBay Official Time = $result->{EBayTime}.\n"; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head2 Automated bidding |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
eBay does not allow bidding via eBay API. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 Listing Item for sale |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
use Net::eBay; |
67
|
|
|
|
|
|
|
use Data::Dumper; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# another way of creating Net::eBay object. |
70
|
|
|
|
|
|
|
my $ebay = new Net::eBay( { |
71
|
|
|
|
|
|
|
SiteLevel => 'prod', |
72
|
|
|
|
|
|
|
DeveloperKey => '...', |
73
|
|
|
|
|
|
|
ApplicationKey => '...', |
74
|
|
|
|
|
|
|
CertificateKey => '...', |
75
|
|
|
|
|
|
|
Token => '...', |
76
|
|
|
|
|
|
|
} ); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
my $result = $ebay->submitRequest( "AddItem", |
79
|
|
|
|
|
|
|
{ |
80
|
|
|
|
|
|
|
DetailLevel => "0", |
81
|
|
|
|
|
|
|
ErrorLevel => "1", |
82
|
|
|
|
|
|
|
SiteId = > "0", |
83
|
|
|
|
|
|
|
Verb => " AddItem", |
84
|
|
|
|
|
|
|
Category => "14111", |
85
|
|
|
|
|
|
|
CheckoutDetailsSpecified => "0", |
86
|
|
|
|
|
|
|
Country => "us", |
87
|
|
|
|
|
|
|
Currency => "1", |
88
|
|
|
|
|
|
|
Description => "For sale is like new thingamabob.Shipping is responsibility of the buyer.", |
89
|
|
|
|
|
|
|
Duration => "7", |
90
|
|
|
|
|
|
|
Location => "Anytown, USA, 43215", |
91
|
|
|
|
|
|
|
Gallery => 1, |
92
|
|
|
|
|
|
|
GalleryURL => 'http://igor.chudov.com/images/mark_mattson.jpg', |
93
|
|
|
|
|
|
|
MinimumBid => "0.99", |
94
|
|
|
|
|
|
|
BuyItNowPrice => 19.99, |
95
|
|
|
|
|
|
|
PayPalAccepted => "1", |
96
|
|
|
|
|
|
|
PayPalEmailAddress => "ichudov\@example.com", |
97
|
|
|
|
|
|
|
Quantity => "1", |
98
|
|
|
|
|
|
|
Region => "60", |
99
|
|
|
|
|
|
|
Title => "Igor's Item with Gallery xaxa", |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
print "Result: " . Dumper( $result ) . "\n"; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Result of submitRequest is a perl hash obtained from the response XML using XML::Simple, something like this: |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Result: $VAR1 = { |
108
|
|
|
|
|
|
|
'Item' => { |
109
|
|
|
|
|
|
|
'Id' => '4503546598', |
110
|
|
|
|
|
|
|
'Fees' => { |
111
|
|
|
|
|
|
|
'FeaturedGalleryFee' => '0.00', |
112
|
|
|
|
|
|
|
'InternationalInsertionFee' => '0.00', |
113
|
|
|
|
|
|
|
'CurrencyId' => '1', |
114
|
|
|
|
|
|
|
'GalleryFee' => '0.25', |
115
|
|
|
|
|
|
|
'AuctionLengthFee' => '0.00', |
116
|
|
|
|
|
|
|
'ProPackBundleFee' => '0.00', |
117
|
|
|
|
|
|
|
'BorderFee' => '0.00', |
118
|
|
|
|
|
|
|
'FeaturedFee' => '0.00', |
119
|
|
|
|
|
|
|
'SchedulingFee' => '0.00', |
120
|
|
|
|
|
|
|
'HighLightFee' => '0.00', |
121
|
|
|
|
|
|
|
'FixedPriceDurationFee' => '0.00', |
122
|
|
|
|
|
|
|
'PhotoDisplayFee' => '0.00', |
123
|
|
|
|
|
|
|
'ListingFee' => '0.55', |
124
|
|
|
|
|
|
|
'BuyItNowFee' => '0.00', |
125
|
|
|
|
|
|
|
'PhotoFee' => '0.00', |
126
|
|
|
|
|
|
|
'GiftIconFee' => '0.00', |
127
|
|
|
|
|
|
|
'SubtitleFee' => '0.00', |
128
|
|
|
|
|
|
|
'InsertionFee' => '0.30', |
129
|
|
|
|
|
|
|
'ListingDesignerFee' => '0.00', |
130
|
|
|
|
|
|
|
'BoldFee' => '0.00', |
131
|
|
|
|
|
|
|
'ReserveFee' => '0.00', |
132
|
|
|
|
|
|
|
'CategoryFeaturedFee' => '0.00' |
133
|
|
|
|
|
|
|
}, |
134
|
|
|
|
|
|
|
'StartTime' => '2005-08-30 04:50:47', |
135
|
|
|
|
|
|
|
'EndTime' => '2005-09-06 04:50:47' |
136
|
|
|
|
|
|
|
}, |
137
|
|
|
|
|
|
|
'EBayTime' => '2005-08-30 04:50:47' |
138
|
|
|
|
|
|
|
}; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
See an alternative example of submitting an item using New Schema, in script |
141
|
|
|
|
|
|
|
ebay-add-item.pl. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
If an error in parsing XML occurs, result will be simply the string |
144
|
|
|
|
|
|
|
that is the text representation of the answer. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 EXPORT |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
new -- creates eBay API. Requires supplying of credentials: |
149
|
|
|
|
|
|
|
DeveloperKey, ApplicationKey, CertificateKey, Token. Net::eBay will |
150
|
|
|
|
|
|
|
not be created until these keys and the token are supplied. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Get them by registering at http://developer.ebay.com and self |
153
|
|
|
|
|
|
|
certifying. Celf certifying is a trivial process of solemnly swearing |
154
|
|
|
|
|
|
|
that you are ready to use their API. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
The SiteLevel parameter is also mandatory and can be either 'prod' or |
157
|
|
|
|
|
|
|
'dev'. prod means to use their production site (being charged real |
158
|
|
|
|
|
|
|
money for listings, etc), and dev means to use eBay sandbox |
159
|
|
|
|
|
|
|
http://sandbox.ebay.com/. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Parameters can be supplied in two ways: |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
1) As a hash table |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
2) As a filename (only argument). If filename and hash are missing, Net::eBay |
166
|
|
|
|
|
|
|
makes an effort to fine a ebay.ini file by looking for: $ENV{EBAY_INI_FILE}, ./ebay.ini, |
167
|
|
|
|
|
|
|
~/.ebay.ini . That's the default constructor. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
See SAMPLE.ebay.ini in this distribution. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 Defaults and XML API Versions |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
This module, by default, is using the "Legacy XML API" that is set to |
174
|
|
|
|
|
|
|
expire in the summer of 2006. That default will change as the legacy |
175
|
|
|
|
|
|
|
API actually expires. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
XML API Schema is set by calling setDefaults( { ... } ) |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
See its documentation below. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head1 ebay.ini FILE |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
ebay.ini is a file that lists ebay access keys and whether this is for |
184
|
|
|
|
|
|
|
accessing eBay production site or its developers' sandbox. Example of |
185
|
|
|
|
|
|
|
the file (see SAMPLE.ebay.ini): |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# dev or prod |
188
|
|
|
|
|
|
|
SiteLevel=prod |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# your developer key |
191
|
|
|
|
|
|
|
DeveloperKey=KLJHAKLJHLKJHLKJH |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# your application key |
194
|
|
|
|
|
|
|
ApplicationKey=LJKGHKLJGKJHG |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# your certificate key |
197
|
|
|
|
|
|
|
CertificateKey=SUYTYWTKWTYIUYTWIUTY |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# your token (a very BIG string) |
200
|
|
|
|
|
|
|
Token=JKHGHJGJHGKJHGKJHGkluhsdihdsriuhfwe87yr8wehIEWH9O78YWERF90HF9UHJESIPHJFV94Y4089734Y |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=for html This module was seen times. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head1 FUNCTIONS |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 new |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=cut |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub new { |
211
|
|
|
|
|
|
|
my ($type, $hash) = @_; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
unless( $hash ) { |
214
|
|
|
|
|
|
|
if( defined $ENV{EBAY_INI_FILE} && -f $ENV{EBAY_INI_FILE} ) { |
215
|
|
|
|
|
|
|
$hash = $ENV{EBAY_INI_FILE}; |
216
|
|
|
|
|
|
|
} elsif( defined $ENV{HOME} && -f "$ENV{HOME}/.ebay.ini" ) { |
217
|
|
|
|
|
|
|
$hash = "$ENV{HOME}/.ebay.ini"; |
218
|
|
|
|
|
|
|
} elsif( -f "ebay.ini" ) { |
219
|
|
|
|
|
|
|
$hash = "ebay.ini"; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
unless( $hash ) { |
224
|
|
|
|
|
|
|
warn "Error creating Net::eBay: no hash with keys and no ini file in: \$ENV{EBAY_INI_FILE}, ~/.ebay.ini, ./ebay.ini. eBay requires these keys. See perldoc Net::eBay on the keys file.\n"; |
225
|
|
|
|
|
|
|
return undef; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
unless(ref $hash) { |
229
|
|
|
|
|
|
|
# this is a filename |
230
|
|
|
|
|
|
|
open( F, $hash ) || croak "Cannot open Net::eBay resource file $hash"; |
231
|
|
|
|
|
|
|
my $h = {}; |
232
|
|
|
|
|
|
|
while( my $l = ) { |
233
|
|
|
|
|
|
|
next if $l =~ /^\s*$/; |
234
|
|
|
|
|
|
|
next if $l =~ /\s*\#/; |
235
|
|
|
|
|
|
|
next unless $l =~ /^\s*(\w+)\s*\=\s*(.*)/; |
236
|
|
|
|
|
|
|
$h->{$1} = $2; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
close( F ); |
239
|
|
|
|
|
|
|
$hash = $h; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
bless $hash, $type; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
$hash->{debug} = undef unless $hash->{debug}; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$hash->{siteid} = 0 unless $hash->{siteid}; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
$hash->{defaults} = { |
249
|
|
|
|
|
|
|
API => 2, |
250
|
|
|
|
|
|
|
compatibility => 655, |
251
|
|
|
|
|
|
|
timeout => 50, |
252
|
|
|
|
|
|
|
retries => 2, |
253
|
|
|
|
|
|
|
}; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
if ( ! $hash->{url} ) { |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
return undef unless verifyAndPrint( |
258
|
|
|
|
|
|
|
defined $hash->{SiteLevel} && $hash->{SiteLevel}, |
259
|
|
|
|
|
|
|
"SiteLevel must be defined" |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
if( $hash->{SiteLevel} eq 'prod' ) { |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
$hash->{url} = 'https://api.ebay.com/ws/api.dll'; |
265
|
|
|
|
|
|
|
$hash->{public_url} = 'http://cgi.ebay.com/ws/eBayISAPI.dll'; |
266
|
|
|
|
|
|
|
$hash->{finding_url} = 'http://svcs.ebay.com/services/search/FindingService/v1'; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
} elsif( $hash->{SiteLevel} eq 'dev' ) { |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
$hash->{url} = 'https://api.sandbox.ebay.com/ws/api.dll'; |
271
|
|
|
|
|
|
|
$hash->{public_url} = 'http://cgi.sandbox.ebay.com/ws/eBayISAPI.dll'; |
272
|
|
|
|
|
|
|
$hash->{finding_url} = undef; # incomplete work @@@@ |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
} else { |
275
|
|
|
|
|
|
|
return unless verifyAndPrint( 0, "Parameter SiteLevel is not defined or is wrong: '$hash->{SiteLevel}'" ); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$hash->{siteid} = 0 unless $hash->{siteid}; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
return undef unless verifyAndPrint( $hash->{DeveloperKey}, "'DeveloperKey' field must be defined with eBay Developer key"); |
282
|
|
|
|
|
|
|
return undef unless verifyAndPrint( $hash->{ApplicationKey}, "'ApplicationKey' field must be defined with eBay application key"); |
283
|
|
|
|
|
|
|
return undef unless verifyAndPrint( $hash->{CertificateKey}, "'CertificateKey' field must be defined with eBay certificate key"); |
284
|
|
|
|
|
|
|
return undef unless verifyAndPrint( $hash->{Token}, "'Token' field must be defined with eBay token"); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
$hash->{SessionCertificate} = "$hash->{DeveloperKey};$hash->{ApplicationKey};$hash->{CertificateKey}"; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
return $hash; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head2 setDefaults |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Sets application defaults, most importantly the XML API version to be used. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
Takes a hash argument. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
The following defaults can be set: |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
* API -- sets eBay API version. Only two values are supported: '1' means |
301
|
|
|
|
|
|
|
Legacy API set to expire in the summer of 2006, '2' means the API that |
302
|
|
|
|
|
|
|
supersedes it. All other values are illegal. |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
* debug -- if debug is set to true, prints a lot of debugging information, XML sent and received etc. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
* siteid -- sets site id |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
* compatibility -- "compatibility level" with eBay. Set to a sensible default. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
* timeout -- sets default query timeout, default is 50 seconds |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
* retries -- sets the number of times a failed request should be retried. Defaults to 2 according to L This only retries requests where eBay is to blame for the failure. Faulty API requests are not retried. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
Example: |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$eBay->setDefaults( { API => 2 } ); # use new eBay API |
317
|
|
|
|
|
|
|
$eBay->setDefaults( { API => 2, debug => 1 } ); # use new eBay API and also debug all calls |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=cut |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub setDefaults { |
322
|
|
|
|
|
|
|
my ($this, $defaults) = @_; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
if( defined $defaults->{API} ) { |
325
|
|
|
|
|
|
|
my $api = $defaults->{API}; |
326
|
|
|
|
|
|
|
if( $api != 1 && $api != 2 ) { |
327
|
|
|
|
|
|
|
croak "Incorrect value of API ($api) is supplied in the hash. Use API => 1 or API => 2."; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
my $old = $this->{defaults}->{API}; |
330
|
|
|
|
|
|
|
$this->{defaults}->{API} = $api; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$this->{debug} = $defaults->{debug} if defined $defaults->{debug}; |
335
|
|
|
|
|
|
|
$this->{siteid} = $defaults->{siteid} if defined $defaults->{siteid}; |
336
|
|
|
|
|
|
|
$this->{defaults}->{compatibility} = $defaults->{compatibility} if defined $defaults->{compatibility}; |
337
|
|
|
|
|
|
|
$this->{defaults}->{timeout} = $defaults->{timeout} if defined $defaults->{timeout}; |
338
|
|
|
|
|
|
|
$this->{defaults}->{retries} = $defaults->{retries} |
339
|
|
|
|
|
|
|
if defined $defaults->{retries}; |
340
|
|
|
|
|
|
|
#print STDERR "Compatibility set to |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
# |
343
|
|
|
|
|
|
|
# I would not call this well done, but this is a statr for now. |
344
|
|
|
|
|
|
|
# |
345
|
|
|
|
|
|
|
$this->{FindingSiteID} = 'EBAY-US' if $this->{siteid} == 0; |
346
|
|
|
|
|
|
|
$this->{FindingSiteID} = 'EBAY-MOTOR' if $this->{siteid} == 100; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head2 submitRequest |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Sends a request to eBay. Takes a name of the API call and a hash of arguments. |
353
|
|
|
|
|
|
|
The arguments can be hashes of hashes and are properly translated into nested |
354
|
|
|
|
|
|
|
XML structures. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
Example: |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
TopLevel => { |
359
|
|
|
|
|
|
|
Item1 => 'hello', |
360
|
|
|
|
|
|
|
Item2 => 'world' |
361
|
|
|
|
|
|
|
Item3 => ['foo', 'bar'] |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
it would be translated to |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
hello |
368
|
|
|
|
|
|
|
world |
369
|
|
|
|
|
|
|
foo |
370
|
|
|
|
|
|
|
bar |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
If an argument has XML attributes and should be formatted like this: |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
abcd |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
(note "currencyID") |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
your argument should be |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
TestAttribute => { _attributes => { currencyID => 'USD' }, _value => 'abcd' ), |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
Depending on the default API set by setDefaults (see above), XML |
384
|
|
|
|
|
|
|
produced will be compatible with the eBay API version selected by the |
385
|
|
|
|
|
|
|
user. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=cut |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub submitRequestGetText { |
390
|
|
|
|
|
|
|
my ($this, $name, $request) = @_; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
my $req = HTTP::Request->new( POST => $this->{url} ); |
393
|
|
|
|
|
|
|
if(defined $this->{defaults}->{siteid} ) { |
394
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-SITEID', $this->{defaults}->{siteid} ); |
395
|
|
|
|
|
|
|
} else { |
396
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-SITEID', $this->{siteid} ); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-DEV-NAME', $this->{DeveloperKey} ); |
399
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-DETAIL-LEVEL', '2' ); |
400
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-CERT-NAME', $this->{CertificateKey} ); |
401
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-APP-NAME', $this->{ApplicationKey} ); |
402
|
|
|
|
|
|
|
$req->header( 'Content-Type', 'text/xml' ); |
403
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-SESSION-CERTIFICATE', $this->{SessionCertificate} ); |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# request compressed responses (if we can handle them) |
406
|
|
|
|
|
|
|
$req->header( 'Accept-Encoding', 'gzip' ) if $HAS_ZLIB; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
my $xml = ""; |
409
|
|
|
|
|
|
|
if( $this->{defaults}->{API} == 1 ) { |
410
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-COMPATIBILITY-LEVEL', $this->{defaults}->{compatibility} ); |
411
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-CALL-NAME', $name ); |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
$request->{Verb} = $name unless $request->{Verb}; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
$xml = " |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
" . $this->{Token} . "\n"; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
$xml .= hash2xml( 2, $request ); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
$xml .= "\n\n"; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
} elsif( $this->{defaults}->{API} == 2 ) { |
424
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-COMPATIBILITY-LEVEL', $this->{defaults}->{compatibility} ); |
425
|
|
|
|
|
|
|
$req->header( 'X-EBAY-API-CALL_NAME', $name ); |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
$xml = " |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
<$name"."Request xmlns=\"urn:ebay:apis:eBLBaseComponents\"> |
430
|
|
|
|
|
|
|
\n"; |
431
|
|
|
|
|
|
|
#if request credentials exist, use the username/password |
432
|
|
|
|
|
|
|
if(defined $request->{RequesterCredentials}) { |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
#if username or password is not defined, we can't use request credentials |
435
|
|
|
|
|
|
|
if(not defined $request->{RequesterCredentials}{Username} or |
436
|
|
|
|
|
|
|
not defined $request->{RequesterCredentials}{Password}) { |
437
|
|
|
|
|
|
|
croak "Username or Password missing when using RequesterCredentials\n"; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
#add to the request header |
441
|
|
|
|
|
|
|
$xml .= " $request->{RequesterCredentials}{Username}\n" . |
442
|
|
|
|
|
|
|
" $request->{RequesterCredentials}{Password}\n"; |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
#delete from our request beceause we don't actually want to include a request credentials |
445
|
|
|
|
|
|
|
#node within our api call |
446
|
|
|
|
|
|
|
delete $request->{RequesterCredentials}; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
} else { |
449
|
|
|
|
|
|
|
$xml .= " $this->{Token}\n"; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
$xml .= " |
453
|
|
|
|
|
|
|
" . hash2xml( 2, $request ) . " |
454
|
|
|
|
|
|
|
$name"."Request> |
455
|
|
|
|
|
|
|
"; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
} else { |
458
|
|
|
|
|
|
|
croak "Strange, the default API '$this->{defaults}->{API}' is unrecognized. BUG.\n"; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
$req->content( $xml ); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
if( $this->{debug} ) { |
464
|
|
|
|
|
|
|
warn "XML:\n$xml\n"; |
465
|
|
|
|
|
|
|
warn "Request: " . $req->as_string; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
my $timeout = $this->{defaults}->{timeout} || 50; |
469
|
|
|
|
|
|
|
$_ua->timeout( $timeout ); |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
my $retries = 0; |
472
|
|
|
|
|
|
|
my $res; |
473
|
|
|
|
|
|
|
TRY: { |
474
|
|
|
|
|
|
|
$res = $_ua->request($req); |
475
|
|
|
|
|
|
|
return undef unless $res; |
476
|
|
|
|
|
|
|
if ( $res->is_error && $retries < $this->{defaults}{retries} ) { |
477
|
|
|
|
|
|
|
$retries++; |
478
|
|
|
|
|
|
|
redo TRY; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
if ( $res->is_error() ) { |
483
|
|
|
|
|
|
|
my $error_msg = $res->status_line(); |
484
|
|
|
|
|
|
|
warn "Net::eBay: error making request $name ($error_msg).\n"; |
485
|
|
|
|
|
|
|
return undef; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
if( $this->{debug} ) { |
489
|
|
|
|
|
|
|
warn "Content (debug of Net::eBay): " . $res->content . "\n"; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
return $res->decoded_content; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
sub submitRequest { |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
my ($this) = @_; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my $content = submitRequestGetText( @_ ); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
$this->{last_result_xml} = $content; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
$@ = ""; |
504
|
|
|
|
|
|
|
my $result = undef; |
505
|
|
|
|
|
|
|
eval { |
506
|
|
|
|
|
|
|
$result = XMLin( $content ); |
507
|
|
|
|
|
|
|
#print "perl result=$result.\n"; |
508
|
|
|
|
|
|
|
}; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
$this->{_last_text} = $content; |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
return $result if $result; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
warn "Error parsing XML ($@). REF(content) = " . ref( $content ) . " CONTENT=$content\n"; |
515
|
|
|
|
|
|
|
return $content; |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub submitPaginatedRequest { |
519
|
|
|
|
|
|
|
my ($this, $name, $request, $arrayname, $perpage, $maxpages) = @_; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
$arrayname = 'Item' unless $arrayname; |
522
|
|
|
|
|
|
|
$perpage = 20 unless $perpage; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
$request->{Pagination}->{EntriesPerPage} = $perpage; |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
my $result = $this->submitRequest( $name, $request ); |
527
|
|
|
|
|
|
|
{ |
528
|
|
|
|
|
|
|
# Arrayify |
529
|
|
|
|
|
|
|
my $a = $result->{$arrayname . "Array"}->{$arrayname}; |
530
|
|
|
|
|
|
|
$a = [$a] unless ref $a eq 'ARRAY'; |
531
|
|
|
|
|
|
|
$result->{$arrayname . "Array"}->{$arrayname} = $a; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
my $pagination = $result->{PaginationResult} |
535
|
|
|
|
|
|
|
|| $result->{ActiveList}->{PaginationResult}; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
#print STDERR Dumper( $result ); |
538
|
|
|
|
|
|
|
#print STDERR Dumper( $pagination ); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
if ( $pagination ) { |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
print STDERR "eBay.pm: Pagination is on!\n" |
543
|
|
|
|
|
|
|
if $ENV{DEBUG_EBAY_PAGINATION}; |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
my $npages = $pagination->{TotalNumberOfPages}; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
$npages = $maxpages if $maxpages && $npages > $maxpages; |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
for ( my $i = 2; $i <= $npages; $i++ ) { |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
print STDERR "Pagination: Getting page $i/$npages...\n" |
552
|
|
|
|
|
|
|
if $ENV{DEBUG_EBAY_PAGINATION}; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
if ( $result->{ActiveList} ) { |
555
|
|
|
|
|
|
|
$request->{ActiveList}->{Pagination}->{EntriesPerPage} = $perpage; |
556
|
|
|
|
|
|
|
$request->{ActiveList}->{Pagination}->{PageNumber} = $i; |
557
|
|
|
|
|
|
|
} else { |
558
|
|
|
|
|
|
|
$request->{Pagination}->{PageNumber} = $i; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
my $r = $this->submitRequest( $name, $request ); |
562
|
|
|
|
|
|
|
my $a = $r->{$arrayname . "Array"}->{$arrayname} |
563
|
|
|
|
|
|
|
|| $r->{ActiveList}->{$arrayname . "Array"}->{$arrayname}; |
564
|
|
|
|
|
|
|
$a = [$a] unless ref $a eq 'ARRAY'; |
565
|
|
|
|
|
|
|
#print STDERR "Array in page $i is " . Dumper( $a ); |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
if ( $result->{ActiveList} ) { |
568
|
|
|
|
|
|
|
push @{$result->{ActiveList}->{$arrayname . "Array"}->{$arrayname}}, @$a; |
569
|
|
|
|
|
|
|
} else { |
570
|
|
|
|
|
|
|
push @{$result->{$arrayname . "Array"}->{$arrayname}}, @$a; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
delete $request->{Pagination}; |
576
|
|
|
|
|
|
|
return $result; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub submitFindingRequestGetText { |
580
|
|
|
|
|
|
|
my ($this, $name, $request) = @_; |
581
|
|
|
|
|
|
|
my $req = HTTP::Request->new( POST => $this->{finding_url} ); |
582
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-SERVICE-VERSION', '1.0.0' ); |
583
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-SERVICE-NAME', 'FindingService' ); |
584
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-GLOBAL-ID', $this->{FindingSiteID} ); |
585
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-SECURITY-APPNAME', $this->{ApplicationKey} ); |
586
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-RESPONSE-DATA-FORMAT', 'XML' ); |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
$req->header( 'X-EBAY-SOA-OPERATION-NAME', $name ); |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
my $xml = ""; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
$xml .= "<$name xmlns=\"http://www.ebay.com/marketplace/search/v1/services\">\n"; |
593
|
|
|
|
|
|
|
$xml .= hash2xml( 2, $request ) . "\n"; |
594
|
|
|
|
|
|
|
$xml .= "$name>\n"; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
$req->content( $xml ); |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
#print STDERR $req->as_string; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
my $timeout = $this->{defaults}->{timeout} || 50; |
601
|
|
|
|
|
|
|
$_ua->timeout( $timeout ); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
my $retries = 0; |
604
|
|
|
|
|
|
|
my $res; |
605
|
|
|
|
|
|
|
TRY: { |
606
|
|
|
|
|
|
|
$res = $_ua->request($req); |
607
|
|
|
|
|
|
|
return undef unless $res; |
608
|
|
|
|
|
|
|
if ( $res->is_error && $retries < $this->{defaults}{retries} ) { |
609
|
|
|
|
|
|
|
$retries++; |
610
|
|
|
|
|
|
|
redo TRY; |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
if ( $res->is_error() ) { |
615
|
|
|
|
|
|
|
my $error_msg = $res->status_line(); |
616
|
|
|
|
|
|
|
warn "Net::eBay: error making request $name ($error_msg).\n"; |
617
|
|
|
|
|
|
|
return undef; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
if( $this->{debug} ) { |
621
|
|
|
|
|
|
|
warn "Content (debug of Net::eBay): " . $res->content . "\n"; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
return $res->decoded_content; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub submitFindingRequest { |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
my ($this) = @_; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
my $content = submitFindingRequestGetText( @_ ); |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
$this->{last_result_xml} = $content; |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
$@ = ""; |
637
|
|
|
|
|
|
|
my $result = undef; |
638
|
|
|
|
|
|
|
eval { |
639
|
|
|
|
|
|
|
$result = XMLin( $content ); |
640
|
|
|
|
|
|
|
#print "perl result=$result.\n"; |
641
|
|
|
|
|
|
|
}; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
$this->{_last_text} = $content; |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
return $result if $result; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
warn "Error parsing XML ($@). REF(content) = " . ref( $content ) . " CONTENT=$content\n"; |
648
|
|
|
|
|
|
|
return $content; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub submitPaginatedFindingRequest { |
653
|
|
|
|
|
|
|
my ($this, $name, $request, $arrayname, $perpage, $maxpages) = @_; |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
$arrayname = 'item' unless $arrayname; |
656
|
|
|
|
|
|
|
$perpage = 100 unless $perpage; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
$request->{paginationInput}->{entriesPerPage} = $perpage; |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
my $result = $this->submitFindingRequest( $name, $request ); |
661
|
|
|
|
|
|
|
{ |
662
|
|
|
|
|
|
|
# Arrayify |
663
|
|
|
|
|
|
|
my $a = $result->{searchResult}->{$arrayname}; |
664
|
|
|
|
|
|
|
$a = [$a] unless ref $a eq 'ARRAY'; |
665
|
|
|
|
|
|
|
$result->{searchResult}->{$arrayname} = $a; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
my $pagination = $result->{paginationOutput}; |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
#print STDERR Dumper( $result ); |
671
|
|
|
|
|
|
|
#print STDERR Dumper( $pagination ); |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
if ( $pagination ) { |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
print STDERR "eBay.pm: Pagination is on!\n" |
676
|
|
|
|
|
|
|
if $ENV{DEBUG_EBAY_PAGINATION}; |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
my $npages = $pagination->{totalPages}; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
$npages = $maxpages if $maxpages && $npages > $maxpages; |
681
|
|
|
|
|
|
|
$npages = 100 if $npages > 100; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
for ( my $i = 2; $i <= $npages; $i++ ) { |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
print STDERR "Pagination: Getting page $i/$npages...\n" |
686
|
|
|
|
|
|
|
if $ENV{DEBUG_EBAY_PAGINATION}; |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
$request->{paginationInput}->{pageNumber} = $i; |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
my $r = $this->submitFindingRequest( $name, $request ); |
691
|
|
|
|
|
|
|
my $a = $r->{searchResult}->{$arrayname}; |
692
|
|
|
|
|
|
|
$a = [$a] unless ref $a eq 'ARRAY'; |
693
|
|
|
|
|
|
|
#print STDERR "Array in page $i is " . Dumper( $a ); |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
push @{$result->{searchResult}->{$arrayname}}, @$a; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
delete $request->{Pagination}; |
700
|
|
|
|
|
|
|
return $result; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
=head2 officialTime |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
Returns eBay official time |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=head2 UTF8 |
708
|
|
|
|
|
|
|
Internal ONLY function |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=head2 hash2xml |
711
|
|
|
|
|
|
|
Internal ONLY function |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=head2 submitRequestGetText |
714
|
|
|
|
|
|
|
Internal ONLY function |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=head2 verifyAndPrint |
717
|
|
|
|
|
|
|
Internal ONLY function |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=cut |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
sub officialTime { |
723
|
|
|
|
|
|
|
my ($this) = @_; |
724
|
|
|
|
|
|
|
my $result = $this->submitRequest( "GeteBayOfficialTime", {} ); |
725
|
|
|
|
|
|
|
if( $result ) { |
726
|
|
|
|
|
|
|
return $result->{EBayTime} if( $this->{defaults}->{API} == 1 ); |
727
|
|
|
|
|
|
|
return $result->{Timestamp} if( $this->{defaults}->{API} == 2 ); |
728
|
|
|
|
|
|
|
croak "Strange, unknown API level '$this->{defaults}->{API}'. bug\n"; |
729
|
|
|
|
|
|
|
} else { |
730
|
|
|
|
|
|
|
warn "Could not get official time.\n"; |
731
|
|
|
|
|
|
|
return undef; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 AUTHOR |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
Igor Chudov, C<< >> |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=head1 BUGS |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
742
|
|
|
|
|
|
|
C, or through the web interface at |
743
|
|
|
|
|
|
|
L. |
744
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
745
|
|
|
|
|
|
|
your bug as I make changes. |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Copyright 2005 Igor Chudov, all rights reserved. |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
754
|
|
|
|
|
|
|
under the same terms as Perl itself. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=cut |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
sub verifyAndPrint { |
759
|
|
|
|
|
|
|
my ($cond, $text) = @_; |
760
|
|
|
|
|
|
|
warn "Error in Net::eBay: $text.\n" unless $cond; |
761
|
|
|
|
|
|
|
return $cond; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
sub UTF8 { |
765
|
|
|
|
|
|
|
my $x = shift @_; |
766
|
|
|
|
|
|
|
return $x unless defined $x; |
767
|
|
|
|
|
|
|
utf8::upgrade($x); |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
return $x; |
770
|
|
|
|
|
|
|
#return "[!CDATA[$x]]"; |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
sub hash2xml { |
774
|
|
|
|
|
|
|
my ($depth, $request, $optionalKey) = @_; |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
my $r = ref $request; |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
unless( ref $request ) { |
779
|
|
|
|
|
|
|
my $data = $request; |
780
|
|
|
|
|
|
|
#$data =~ s/\\<\;/g; |
781
|
|
|
|
|
|
|
#$data =~ s/\>/\>\;/g; |
782
|
|
|
|
|
|
|
return UTF8( $data ); |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
my $xml; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
if( $r =~ /HASH/ ) { |
788
|
|
|
|
|
|
|
if( defined $request->{_value} && defined $request->{_attributes} ) { |
789
|
|
|
|
|
|
|
$xml = "<$optionalKey "; |
790
|
|
|
|
|
|
|
foreach my $a ( sort keys %{$request->{_attributes}} ) { |
791
|
|
|
|
|
|
|
#print STDERR "a=$a.\n"; |
792
|
|
|
|
|
|
|
$xml .= "$a=\"$request->{_attributes}->{$a}\" "; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
$xml .= ">"; |
795
|
|
|
|
|
|
|
$xml .= hash2xml( $depth+2, $request->{_value}, $request->{_tagName} ); |
796
|
|
|
|
|
|
|
$xml .= "$optionalKey>"; |
797
|
|
|
|
|
|
|
} else { |
798
|
|
|
|
|
|
|
$xml = "\n"; |
799
|
|
|
|
|
|
|
my $d = " " x $depth; |
800
|
|
|
|
|
|
|
foreach my $key (sort keys %$request) { |
801
|
|
|
|
|
|
|
my $r = $request->{$key}; |
802
|
|
|
|
|
|
|
if( (ref( $r ) =~ /HASH/) |
803
|
|
|
|
|
|
|
&& defined $r->{_value} |
804
|
|
|
|
|
|
|
&& defined $r->{_attributes} ) { |
805
|
|
|
|
|
|
|
$xml .= "$d " . hash2xml( $depth+2, $r, $key ) . "\n"; |
806
|
|
|
|
|
|
|
} elsif( ref( $request->{$key} ) =~ /^ARRAY/ ) { |
807
|
|
|
|
|
|
|
$xml .= hash2xml( $depth, $request->{$key}, $key ); |
808
|
|
|
|
|
|
|
} else { |
809
|
|
|
|
|
|
|
my $data = hash2xml( $depth+2, $request->{$key}, $key ); |
810
|
|
|
|
|
|
|
$xml .= "$d <$key>$data$key>\n"; |
811
|
|
|
|
|
|
|
#print STDERR $xml; |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
$xml .= "$d"; |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
} elsif( $r =~ /ARRAY/ ) { |
817
|
|
|
|
|
|
|
foreach my $item ( @$request ) { |
818
|
|
|
|
|
|
|
$xml .= hash2xml( $depth+2, { $optionalKey => $item }, $optionalKey ); |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
return $xml; |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
$_ua = LWP::UserAgent->new( agent => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)" ); |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
1; # End of Net::eBay |