line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package WWW::Search::Ebay; |
3
|
|
|
|
|
|
|
|
4
|
5
|
|
|
5
|
|
600124
|
use strict; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
115
|
|
5
|
5
|
|
|
5
|
|
22
|
use warnings; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
253
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = 2.273; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
WWW::Search::Ebay - backend for searching www.ebay.com |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use WWW::Search; |
16
|
|
|
|
|
|
|
my $oSearch = new WWW::Search('Ebay'); |
17
|
|
|
|
|
|
|
my $sQuery = WWW::Search::escape_query("C-10 carded Yakface"); |
18
|
|
|
|
|
|
|
$oSearch->native_query($sQuery); |
19
|
|
|
|
|
|
|
while (my $oResult = $oSearch->next_result()) |
20
|
|
|
|
|
|
|
{ print $oResult->url, "\n"; } |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 DESCRIPTION |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
This class is a Ebay specialization of L. |
25
|
|
|
|
|
|
|
It handles making and interpreting Ebay searches |
26
|
|
|
|
|
|
|
F. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This class exports no public interface; all interaction should |
29
|
|
|
|
|
|
|
be done through L objects. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 NOTES |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
The search is done against CURRENT running AUCTIONS only. |
34
|
|
|
|
|
|
|
(NOT completed auctions, NOT eBay Stores items, NOT Buy-It-Now only items.) |
35
|
|
|
|
|
|
|
(If you want to search completed auctions, use the L module.) |
36
|
|
|
|
|
|
|
(If you want to search eBay Stores, use the L module.) |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
The query is applied to TITLES only. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
This module can return only the first 200 results matching your query. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
In the resulting L objects, the description() |
43
|
|
|
|
|
|
|
field consists of a human-readable combination (joined with |
44
|
|
|
|
|
|
|
semicolon-space) of the Item Number; number of bids; and high bid |
45
|
|
|
|
|
|
|
amount (or starting bid amount). |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
In the resulting L objects, the end_date() field |
48
|
|
|
|
|
|
|
contains a human-readable DTG of when the auction is scheduled to end |
49
|
|
|
|
|
|
|
(in the form "YYYY-MM-DD HH:MM TZ"). If environment variable TZ is |
50
|
|
|
|
|
|
|
set, the time will be converted to that timezone; otherwise the time |
51
|
|
|
|
|
|
|
will be left in ebay.com's default timezone (US/Pacific). |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
In the resulting L objects, the bid_count() field |
54
|
|
|
|
|
|
|
contains the number of bids as an integer. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
In the resulting L objects, the bid_amount() |
57
|
|
|
|
|
|
|
field is a string containing the high bid or starting bid as a |
58
|
|
|
|
|
|
|
human-readable monetary value in seller-native units, e.g. "$14.95" or |
59
|
|
|
|
|
|
|
"GBP 6.00". |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
In the resulting L objects, the sold() field will |
62
|
|
|
|
|
|
|
be non-zero if the item has already sold. (Only if you're using |
63
|
|
|
|
|
|
|
WWW::Search::Ebay::Completed) |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
After a successful search, your search object will contain an element |
66
|
|
|
|
|
|
|
named 'categories' which will be a reference to an array of hashes |
67
|
|
|
|
|
|
|
containing names and IDs of categories and nested subcategories, and |
68
|
|
|
|
|
|
|
the count of items matching your query in each category and |
69
|
|
|
|
|
|
|
subcategory. (Special thanks to Nick Lokkju for this code!) For |
70
|
|
|
|
|
|
|
example: |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
$oSearch->{categories} = [ |
73
|
|
|
|
|
|
|
{ |
74
|
|
|
|
|
|
|
'ID' => '1', |
75
|
|
|
|
|
|
|
'Count' => 19, |
76
|
|
|
|
|
|
|
'Name' => 'Collectibles', |
77
|
|
|
|
|
|
|
'Subcategory' => [ |
78
|
|
|
|
|
|
|
{ |
79
|
|
|
|
|
|
|
'ID' => '13877', |
80
|
|
|
|
|
|
|
'Count' => 11, |
81
|
|
|
|
|
|
|
'Name' => 'Historical Memorabilia' |
82
|
|
|
|
|
|
|
}, |
83
|
|
|
|
|
|
|
{ |
84
|
|
|
|
|
|
|
'ID' => '11450', |
85
|
|
|
|
|
|
|
'Count' => 1, |
86
|
|
|
|
|
|
|
'Name' => 'Clothing, Shoes & Accessories' |
87
|
|
|
|
|
|
|
}, |
88
|
|
|
|
|
|
|
] |
89
|
|
|
|
|
|
|
}, |
90
|
|
|
|
|
|
|
{ |
91
|
|
|
|
|
|
|
'ID' => '281', |
92
|
|
|
|
|
|
|
'Count' => 1, |
93
|
|
|
|
|
|
|
'Name' => 'Jewelry & Watches', |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
]; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
If your query string happens to be an eBay item number, |
98
|
|
|
|
|
|
|
(i.e. if ebay.com redirects the query to an auction page), |
99
|
|
|
|
|
|
|
you will get back one WWW::Search::Result without bid or price information. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 OPTIONS |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=over |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=item Limit search by price range |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Contributed by Brian Wilson: |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
$oSearch->native_query($sQuery, { |
110
|
|
|
|
|
|
|
_mPrRngCbx=>'1', _udlo=>$minPrice, _udhi=>$maxPrice, |
111
|
|
|
|
|
|
|
} ); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=back |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 PUBLIC METHODS OF NOTE |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=over |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
5
|
|
|
5
|
|
18
|
use base 'WWW::Search'; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
356
|
|
122
|
|
|
|
|
|
|
|
123
|
5
|
|
|
5
|
|
17
|
use constant DEBUG_DATES => 0; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
223
|
|
124
|
5
|
|
|
5
|
|
19
|
use constant DEBUG_COLUMNS => 0; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
177
|
|
125
|
|
|
|
|
|
|
|
126
|
5
|
|
|
5
|
|
17
|
use Carp (); |
|
5
|
|
|
|
|
3
|
|
|
5
|
|
|
|
|
64
|
|
127
|
5
|
|
|
5
|
|
17
|
use CGI; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
38
|
|
128
|
5
|
|
|
5
|
|
702
|
use Data::Dumper; # for debugging only |
|
5
|
|
|
|
|
4857
|
|
|
5
|
|
|
|
|
194
|
|
129
|
5
|
|
|
5
|
|
351
|
use Date::Manip; |
|
5
|
|
|
|
|
91514
|
|
|
5
|
|
|
|
|
586
|
|
130
|
|
|
|
|
|
|
# Date_Init("setdate=now,America/Los_Angeles"); |
131
|
5
|
|
|
5
|
|
42
|
use HTML::TreeBuilder; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
46
|
|
132
|
5
|
|
|
5
|
|
2010
|
use LWP::Simple; |
|
5
|
|
|
|
|
27971
|
|
|
5
|
|
|
|
|
27
|
|
133
|
5
|
|
|
5
|
|
1336
|
use WWW::Search qw( generic_option strip_tags ); |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
269
|
|
134
|
|
|
|
|
|
|
# We need the version that has the sold() method: |
135
|
5
|
|
|
5
|
|
2029
|
use WWW::SearchResult 2.072; |
|
5
|
|
|
|
|
6641
|
|
|
5
|
|
|
|
|
113
|
|
136
|
5
|
|
|
5
|
|
1971
|
use WWW::Search::Result; |
|
5
|
|
|
|
|
791
|
|
|
5
|
|
|
|
|
18905
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
our $MAINTAINER = 'Martin Thurn '; |
139
|
|
|
|
|
|
|
my $cgi = new CGI; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub _native_setup_search |
142
|
|
|
|
|
|
|
{ |
143
|
13
|
|
|
13
|
|
21049
|
my ($self, $native_query, $rhOptsArg) = @_; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# Set some private variables: |
146
|
13
|
|
100
|
|
|
83
|
$self->{_debug} ||= $rhOptsArg->{'search_debug'}; |
147
|
13
|
100
|
|
|
|
37
|
$self->{_debug} = 2 if ($rhOptsArg->{'search_parse_debug'}); |
148
|
13
|
|
100
|
|
|
54
|
$self->{_debug} ||= 0; |
149
|
|
|
|
|
|
|
|
150
|
13
|
|
|
|
|
13
|
my $DEFAULT_HITS_PER_PAGE = 200; |
151
|
13
|
|
|
|
|
22
|
$self->{'_hits_per_page'} = $DEFAULT_HITS_PER_PAGE; |
152
|
|
|
|
|
|
|
|
153
|
13
|
|
|
|
|
54
|
$self->user_agent('non-robot'); |
154
|
13
|
|
|
|
|
4876
|
$self->agent_name('Mozilla/5.0 (compatible; Mozilla/4.0; MSIE 6.0; Windows NT 5.1; Q312461)'); |
155
|
|
|
|
|
|
|
|
156
|
13
|
|
|
|
|
71
|
$self->{'_next_to_retrieve'} = 0; |
157
|
13
|
|
|
|
|
26
|
$self->{'_num_hits'} = 0; |
158
|
|
|
|
|
|
|
# As of 2013-03-01 (probably much before that, but first time I |
159
|
|
|
|
|
|
|
# looked at it in quite a while): To use our basic experience |
160
|
|
|
|
|
|
|
# which does not require JavaScript,
|
161
|
|
|
|
|
|
|
# href="http://www.ebay.com/sch/i.html?LH_Auction=1&_nkw=trinidad+tobago+flag&_armrs=1&_from=&_ipg=50&_jsoff=1">click |
162
|
|
|
|
|
|
|
# here.
|
163
|
13
|
|
100
|
|
|
48
|
$self->{search_host} ||= 'http://www.ebay.com'; # as of 2013-03-01 |
164
|
13
|
|
50
|
|
|
31
|
$self->{search_host} ||= 'http://search.ebay.com'; |
165
|
13
|
|
100
|
|
|
46
|
$self->{search_path} ||= '/sch/i.html'; # as of 2013-03-01 |
166
|
13
|
|
50
|
|
|
62
|
$self->{search_path} ||= '/ws/search/SaleSearch'; |
167
|
13
|
100
|
|
|
|
31
|
if (!defined($self->{_options})) |
168
|
|
|
|
|
|
|
{ |
169
|
|
|
|
|
|
|
# http://shop.ebay.com/items/_W0QQLHQ5fBINZ1?_nkw=trinidad+flag&_sacat=0&_fromfsb=&_trksid=m270.l1313&_odkw=burkina+faso+flag&_osacat=0 |
170
|
|
|
|
|
|
|
$self->{_options} = { |
171
|
|
|
|
|
|
|
satitle => $native_query, |
172
|
|
|
|
|
|
|
# Search AUCTIONS ONLY: |
173
|
|
|
|
|
|
|
sasaleclass => 1, |
174
|
|
|
|
|
|
|
# Display item number explicitly: |
175
|
|
|
|
|
|
|
socolumnlayout => 2, |
176
|
|
|
|
|
|
|
# Do not convert everything to US$: |
177
|
|
|
|
|
|
|
socurrencydisplay => 1, |
178
|
|
|
|
|
|
|
sorecordsperpage => $self->{_hits_per_page}, |
179
|
|
|
|
|
|
|
_ipg => $self->{_hits_per_page}, |
180
|
|
|
|
|
|
|
# Display absolute times, NOT relative times: |
181
|
11
|
|
|
|
|
131
|
sotimedisplay => 0, |
182
|
|
|
|
|
|
|
# Use the default columns, NOT anything the |
183
|
|
|
|
|
|
|
# user may have customized (which would come |
184
|
|
|
|
|
|
|
# through via cookies): |
185
|
|
|
|
|
|
|
socustoverride => 1, |
186
|
|
|
|
|
|
|
# Output basic HTML, not JavaScript: |
187
|
|
|
|
|
|
|
_armrs => 1, |
188
|
|
|
|
|
|
|
}; |
189
|
|
|
|
|
|
|
$self->{_options} = { |
190
|
|
|
|
|
|
|
_nkw => $native_query, |
191
|
|
|
|
|
|
|
_armrs => 1, |
192
|
|
|
|
|
|
|
# Turn off JavaScript: |
193
|
|
|
|
|
|
|
_jsoff => 1, |
194
|
|
|
|
|
|
|
# Search AUCTIONS ONLY: |
195
|
|
|
|
|
|
|
LH_Auction => 1, |
196
|
|
|
|
|
|
|
_ipg => $self->{_hits_per_page}, |
197
|
|
|
|
|
|
|
# Which page are we on: |
198
|
|
|
|
|
|
|
# _from => 2, |
199
|
|
|
|
|
|
|
# |
200
|
11
|
|
|
|
|
40
|
}; |
201
|
|
|
|
|
|
|
} # if |
202
|
13
|
50
|
|
|
|
46
|
if (defined($rhOptsArg)) |
203
|
|
|
|
|
|
|
{ |
204
|
|
|
|
|
|
|
# Copy in new options. |
205
|
13
|
|
|
|
|
30
|
foreach my $key (keys %$rhOptsArg) |
206
|
|
|
|
|
|
|
{ |
207
|
|
|
|
|
|
|
# print STDERR " DDD inspecting option $key..."; |
208
|
18
|
100
|
|
|
|
41
|
if (WWW::Search::generic_option($key)) |
209
|
|
|
|
|
|
|
{ |
210
|
|
|
|
|
|
|
# print STDERR "promote & delete\n"; |
211
|
15
|
100
|
|
|
|
111
|
$self->{$key} = $rhOptsArg->{$key} if defined($rhOptsArg->{$key}); |
212
|
15
|
|
|
|
|
45
|
delete $rhOptsArg->{$key}; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
else |
215
|
|
|
|
|
|
|
{ |
216
|
|
|
|
|
|
|
# print STDERR "copy\n"; |
217
|
3
|
100
|
|
|
|
16
|
$self->{_options}->{$key} = $rhOptsArg->{$key} if defined($rhOptsArg->{$key}); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} # foreach |
220
|
|
|
|
|
|
|
} # if |
221
|
|
|
|
|
|
|
# Clear the list of results per category: |
222
|
13
|
|
|
|
|
23
|
$self->{categories} = []; |
223
|
|
|
|
|
|
|
# Finally, figure out the url. |
224
|
13
|
|
|
|
|
81
|
$self->{_next_url} = $self->{'search_host'} . $self->{'search_path'} .'?'. $self->hash_to_cgi_string($self->{_options}); |
225
|
|
|
|
|
|
|
} # _native_setup_search |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item user_agent_delay |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Introduce a few-seconds delay to avoid overwhelming the server. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub user_agent_delay |
235
|
|
|
|
|
|
|
{ |
236
|
11
|
|
|
11
|
1
|
37
|
my $self = shift; |
237
|
|
|
|
|
|
|
# return; |
238
|
11
|
|
|
|
|
190
|
my $iSecs = int(3 + rand(3)); |
239
|
11
|
100
|
|
|
|
36
|
print STDERR " DDD sleeping $iSecs seconds...\n" if (0 < $self->{_debug}); |
240
|
11
|
|
|
|
|
46001363
|
sleep($iSecs); |
241
|
|
|
|
|
|
|
} # user_agent_delay |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item need_to_delay |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Controls whether we do the delay or not. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub need_to_delay |
251
|
|
|
|
|
|
|
{ |
252
|
11
|
|
|
11
|
1
|
892
|
1; |
253
|
|
|
|
|
|
|
} # need_to_delay |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item preprocess_results_page |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Grabs the eBay Official Time so that when we parse the DTG from the |
259
|
|
|
|
|
|
|
HTML, we can convert / return exactly what eBay means for each one. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub preprocess_results_page |
264
|
|
|
|
|
|
|
{ |
265
|
11
|
|
|
11
|
1
|
12776665
|
my $self = shift; |
266
|
11
|
|
|
|
|
24
|
my $sPage = shift; |
267
|
11
|
50
|
|
|
|
58
|
if (25 < $self->{_debug}) |
268
|
|
|
|
|
|
|
{ |
269
|
|
|
|
|
|
|
# print STDERR Dumper($self->{response}); |
270
|
|
|
|
|
|
|
# For debugging: |
271
|
0
|
|
|
|
|
0
|
print STDERR $sPage; |
272
|
0
|
|
|
|
|
0
|
exit 88; |
273
|
|
|
|
|
|
|
} # if |
274
|
11
|
|
50
|
|
|
43
|
my $sTitle = $self->{response}->header('title') || ''; |
275
|
11
|
|
|
|
|
377
|
my $qrTitle = $self->_title_pattern; |
276
|
11
|
50
|
|
|
|
81
|
if ($sTitle =~ m!$qrTitle!) |
277
|
|
|
|
|
|
|
{ |
278
|
|
|
|
|
|
|
# print STDERR " DDD got a Title: ==$sTitle==\n"; |
279
|
|
|
|
|
|
|
# This search returned a single auction item page. We do not need |
280
|
|
|
|
|
|
|
# to fetch eBay official time. |
281
|
|
|
|
|
|
|
} # if |
282
|
|
|
|
|
|
|
else |
283
|
|
|
|
|
|
|
{ |
284
|
|
|
|
|
|
|
# Use the UserAgent object in $self to fetch the official ebay.com time: |
285
|
11
|
|
|
|
|
26
|
$self->{_ebay_official_time} = 'now'; |
286
|
|
|
|
|
|
|
# my $sPageDate = get('http://cgi1.ebay.com/aw-cgi/eBayISAPI.dll?TimeShow') || ''; |
287
|
11
|
|
50
|
|
|
57
|
my $sPageDate = $self->http_request(GET => 'http://viv.ebay.com/ws/eBayISAPI.dll?EbayTime')->content || ''; |
288
|
11
|
50
|
|
|
|
10872311
|
if ($sPageDate eq '') |
289
|
|
|
|
|
|
|
{ |
290
|
0
|
|
|
|
|
0
|
die " EEE could not fetch official eBay time"; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
else |
293
|
|
|
|
|
|
|
{ |
294
|
11
|
|
|
|
|
150
|
my $tree = HTML::TreeBuilder->new; |
295
|
11
|
|
|
|
|
2722
|
$tree->utf8_mode('true'); |
296
|
11
|
|
|
|
|
191
|
$tree->parse($sPageDate); |
297
|
11
|
|
|
|
|
312589
|
$tree->eof; |
298
|
11
|
|
|
|
|
13627
|
my $s = $tree->as_text; |
299
|
|
|
|
|
|
|
# print STDERR " DDD official time =====$s=====\n"; |
300
|
11
|
50
|
|
|
|
8702
|
if ($s =~ m!The official eBay Time is now:(.+?(P[SD]T))\s*Pacific\s!i) |
301
|
|
|
|
|
|
|
{ |
302
|
11
|
|
|
|
|
66
|
my ($sDateRaw, $sTZ) = ($1, $2); |
303
|
11
|
|
|
|
|
12
|
DEBUG_DATES && print STDERR " DDD official time raw ==$sDateRaw==\n"; |
304
|
|
|
|
|
|
|
# Apparently, ParseDate() automatically converts to local timezone: |
305
|
11
|
|
|
|
|
83
|
my $date = ParseDate($sDateRaw); |
306
|
11
|
|
|
|
|
617183
|
DEBUG_DATES && print STDERR " DDD official time cooked ==$date==\n"; |
307
|
11
|
|
|
|
|
2648
|
$self->{_ebay_official_time} = $date; |
308
|
|
|
|
|
|
|
} # if |
309
|
|
|
|
|
|
|
} # else |
310
|
|
|
|
|
|
|
} # else |
311
|
11
|
|
|
|
|
215
|
return $sPage; |
312
|
|
|
|
|
|
|
# Ebay used to send malformed HTML: |
313
|
|
|
|
|
|
|
# my $iSubs = 0 + ($sPage =~ s! | !!gi);
314
|
|
|
|
|
|
|
# print STDERR " DDD deleted $iSubs extraneous tags\n" if 1 < $self->{_debug}; |
315
|
|
|
|
|
|
|
} # preprocess_results_page |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub _cleanup_url |
318
|
|
|
|
|
|
|
{ |
319
|
543
|
|
|
543
|
|
397
|
my $self = shift; |
320
|
543
|
|
50
|
|
|
859
|
my $sURL = shift() || ''; |
321
|
|
|
|
|
|
|
# Make sure we don't return two different URLs for the same item: |
322
|
543
|
|
|
|
|
608
|
$sURL =~ s!&rd=\d+!!; |
323
|
543
|
|
|
|
|
431
|
$sURL =~ s!&category=\d+!!; |
324
|
543
|
|
|
|
|
490
|
$sURL =~ s!&ssPageName=[A-Z0-9]+!!; |
325
|
543
|
|
|
|
|
1041
|
return $sURL; |
326
|
|
|
|
|
|
|
} # _cleanup_url |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub _format_date |
329
|
|
|
|
|
|
|
{ |
330
|
496
|
|
|
496
|
|
305712
|
my $self = shift; |
331
|
496
|
|
|
|
|
938
|
return UnixDate(shift, '%Y-%m-%d %H:%M %Z'); |
332
|
|
|
|
|
|
|
} # _format_date |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub _bidcount_as_text |
335
|
|
|
|
|
|
|
{ |
336
|
543
|
|
|
543
|
|
363
|
my $self = shift; |
337
|
543
|
|
|
|
|
377
|
my $hit = shift; |
338
|
543
|
|
50
|
|
|
869
|
my $iBids = $hit->bid_count || 'no'; |
339
|
543
|
|
|
|
|
3483
|
my $s = "$iBids bid"; |
340
|
543
|
50
|
|
|
|
826
|
$s .= 's' if ($iBids ne '1'); |
341
|
543
|
|
|
|
|
813
|
$s .= '; '; |
342
|
|
|
|
|
|
|
} # _bidcount_as_text |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub _bidamount_as_text |
345
|
|
|
|
|
|
|
{ |
346
|
543
|
|
|
543
|
|
401
|
my $self = shift; |
347
|
543
|
|
|
|
|
355
|
my $hit = shift; |
348
|
543
|
|
50
|
|
|
805
|
my $iPrice = $hit->bid_amount || 'unknown'; |
349
|
543
|
|
|
|
|
2809
|
my $sDesc = ''; |
350
|
543
|
50
|
|
|
|
731
|
$sDesc .= $hit->bid_count ? 'current' : 'starting'; |
351
|
543
|
|
|
|
|
3198
|
$sDesc .= " bid $iPrice"; |
352
|
|
|
|
|
|
|
} # _bidamount_as_text |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub _create_description |
355
|
|
|
|
|
|
|
{ |
356
|
543
|
|
|
543
|
|
393
|
my $self = shift; |
357
|
543
|
|
|
|
|
387
|
my $hit = shift; |
358
|
543
|
|
50
|
|
|
1012
|
my $iItem = $hit->item_number || 'unknown'; |
359
|
543
|
|
50
|
|
|
4561
|
my $sWhen = shift() || 'current'; |
360
|
|
|
|
|
|
|
# print STDERR " DDD _c_d($iItem, $iBids, $iPrice, $sWhen)\n"; |
361
|
543
|
|
|
|
|
921
|
my $sDesc = "Item \043$iItem; ". $self->_bidcount_as_text($hit); |
362
|
543
|
|
|
|
|
682
|
$sDesc .= $self->_bidamount_as_text($hit); |
363
|
543
|
|
|
|
|
666
|
return $sDesc; |
364
|
|
|
|
|
|
|
} # _create_description |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub _parse_category |
367
|
|
|
|
|
|
|
{ |
368
|
543
|
|
|
543
|
|
439
|
my $self = shift; |
369
|
543
|
|
|
|
|
431
|
my $oTD = shift; |
370
|
543
|
50
|
|
|
|
801
|
return -1 if ! ref $oTD; |
371
|
543
|
|
|
|
|
960
|
my $oA = $oTD->look_down(_tag => 'a'); |
372
|
543
|
50
|
|
|
|
16597
|
return -1 if ! ref $oA; |
373
|
0
|
0
|
|
|
|
0
|
if (DEBUG_COLUMNS || (1 < $self->{_debug})) |
374
|
|
|
|
|
|
|
{ |
375
|
0
|
|
|
|
|
0
|
my $s = $oA->as_HTML; |
376
|
0
|
|
|
|
|
0
|
print STDERR " DDD TDcategory's A ===$s===\n"; |
377
|
|
|
|
|
|
|
} # if |
378
|
0
|
|
0
|
|
|
0
|
my $sURL = $oA->attr('href') || q{}; |
379
|
0
|
0
|
|
|
|
0
|
if ($sURL =~ m/sibeleafcat=(\d+)/) |
380
|
|
|
|
|
|
|
{ |
381
|
0
|
|
|
|
|
0
|
return $1; |
382
|
|
|
|
|
|
|
} # if |
383
|
0
|
|
|
|
|
0
|
return -1; |
384
|
|
|
|
|
|
|
} # _parse_category |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub _parse_price |
387
|
|
|
|
|
|
|
{ |
388
|
544
|
|
|
544
|
|
450
|
my $self = shift; |
389
|
544
|
|
|
|
|
407
|
my $oTDprice = shift; |
390
|
544
|
|
|
|
|
412
|
my $hit = shift; |
391
|
544
|
50
|
|
|
|
815
|
return 0 unless (ref $oTDprice); |
392
|
544
|
|
|
|
|
867
|
my $s = $oTDprice->as_HTML; |
393
|
544
|
100
|
|
|
|
84694
|
if (DEBUG_COLUMNS || (1 < $self->{_debug})) |
394
|
|
|
|
|
|
|
{ |
395
|
91
|
|
|
|
|
246
|
print STDERR " DDD try TDprice ===$s===\n"; |
396
|
|
|
|
|
|
|
} # if |
397
|
544
|
50
|
|
|
|
1230
|
if ($oTDprice->attr('class') =~ m'\bebcBid\b') |
398
|
|
|
|
|
|
|
{ |
399
|
|
|
|
|
|
|
# If we see this, we must have been searching for Stores items |
400
|
|
|
|
|
|
|
# but we ran off the bottom of the Stores item list and ran |
401
|
|
|
|
|
|
|
# into the list of "other" items. |
402
|
0
|
|
|
|
|
0
|
return 1; |
403
|
|
|
|
|
|
|
# We could probably return 0 to abandon the rest of the page, but |
404
|
|
|
|
|
|
|
# maybe just maybe we hit this because of a parsing glitch which |
405
|
|
|
|
|
|
|
# might correct itself on the next TD. |
406
|
|
|
|
|
|
|
} # if |
407
|
544
|
50
|
|
|
|
3972
|
if ($oTDprice->attr('class') !~ m'\b(ebcPr|prices|prc)\b') |
408
|
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
|
# If we see this, we probably were searching for Store items |
410
|
|
|
|
|
|
|
# but we ran off the bottom of the Store item list and ran |
411
|
|
|
|
|
|
|
# into the list of Auction items. |
412
|
0
|
|
|
|
|
0
|
return 0; |
413
|
|
|
|
|
|
|
# There is a separate backend for searching Auction items! |
414
|
|
|
|
|
|
|
} # if |
415
|
544
|
50
|
33
|
|
|
4565
|
if ( |
416
|
|
|
|
|
|
|
$oTDprice->look_down(_tag => 'span', |
417
|
|
|
|
|
|
|
class => 'ebSold') |
418
|
|
|
|
|
|
|
|| |
419
|
|
|
|
|
|
|
$oTDprice->look_down(_tag => 'span', |
420
|
|
|
|
|
|
|
class => 'bold bidsold') |
421
|
|
|
|
|
|
|
) |
422
|
|
|
|
|
|
|
{ |
423
|
|
|
|
|
|
|
# This item sold, even if it had no bids (i.e. Buy-It-Now) |
424
|
0
|
|
|
|
|
0
|
$hit->sold(1); |
425
|
|
|
|
|
|
|
} # if |
426
|
544
|
50
|
|
|
|
38949
|
if (my $oChild = $oTDprice->look_down(_tag => 'div', |
427
|
|
|
|
|
|
|
itemprop => 'price')) |
428
|
|
|
|
|
|
|
{ |
429
|
|
|
|
|
|
|
# As of 2013-03, we need to separate out the price and the bid: |
430
|
0
|
|
|
|
|
0
|
$oTDprice = $oChild; |
431
|
|
|
|
|
|
|
} # if |
432
|
544
|
|
|
|
|
16511
|
my $iPrice = $oTDprice->as_text; |
433
|
544
|
100
|
|
|
|
9882
|
print STDERR " DDD raw iPrice ===$iPrice===\n" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
434
|
544
|
|
|
|
|
780
|
$iPrice =~ s!£!GBP!; |
435
|
544
|
|
|
|
|
415
|
$iPrice =~ s!\s*Trending.+!!; |
436
|
544
|
|
|
|
|
522
|
$iPrice =~ s!\s*Was.+!!; |
437
|
|
|
|
|
|
|
# Convert nbsp to regular space: |
438
|
544
|
|
|
|
|
427
|
$iPrice =~ s!\240!\040!g; |
439
|
|
|
|
|
|
|
# I don't know why there are sometimes weird characters in there: |
440
|
544
|
|
|
|
|
369
|
$iPrice =~ s!Â!!g; |
441
|
544
|
|
|
|
|
382
|
$iPrice =~ s!Â!!g; |
442
|
544
|
|
|
|
|
794
|
my $currency = $self->_currency_pattern; |
443
|
544
|
|
|
|
|
661
|
my $W = $self->whitespace_pattern; |
444
|
544
|
|
|
|
|
3347
|
$iPrice =~ s!($currency)$W*($currency)!$1 (Buy-It-Now for $2)!; |
445
|
544
|
50
|
|
|
|
819
|
if ($iPrice =~ s/FREE\s+SHIPPING//i) |
446
|
|
|
|
|
|
|
{ |
447
|
0
|
|
|
|
|
0
|
$hit->shipping('free'); |
448
|
|
|
|
|
|
|
} # if |
449
|
544
|
|
|
|
|
1146
|
$hit->bid_amount($iPrice); |
450
|
544
|
|
|
|
|
4424
|
return 1; |
451
|
|
|
|
|
|
|
} # _parse_price |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub _parse_bids |
454
|
|
|
|
|
|
|
{ |
455
|
544
|
|
|
544
|
|
476
|
my $self = shift; |
456
|
544
|
|
|
|
|
388
|
my $oTDbids = shift; |
457
|
544
|
|
|
|
|
374
|
my $hit = shift; |
458
|
544
|
|
|
|
|
399
|
my $iBids = 0; |
459
|
544
|
50
|
|
|
|
763
|
if (ref $oTDbids) |
460
|
|
|
|
|
|
|
{ |
461
|
544
|
50
|
|
|
|
1041
|
if (my $oChild = $oTDbids->look_down(_tag => 'div', |
462
|
|
|
|
|
|
|
class => 'bids')) |
463
|
|
|
|
|
|
|
{ |
464
|
|
|
|
|
|
|
# As of 2013-03, we need to separate out the price and the bid: |
465
|
0
|
|
|
|
|
0
|
$oTDbids = $oChild; |
466
|
|
|
|
|
|
|
} # if |
467
|
544
|
|
|
|
|
19000
|
my $s = $oTDbids->as_HTML; |
468
|
544
|
100
|
|
|
|
79261
|
if (DEBUG_COLUMNS || (1 < $self->{_debug})) |
469
|
|
|
|
|
|
|
{ |
470
|
91
|
|
|
|
|
260
|
print STDERR " DDD TDbids ===$s===\n"; |
471
|
|
|
|
|
|
|
} # if |
472
|
544
|
50
|
|
|
|
1181
|
if ($oTDbids->attr('class') !~ m'\b(ebcBid|bids)\b') |
473
|
|
|
|
|
|
|
{ |
474
|
|
|
|
|
|
|
# If we see this, we probably were searching for Store items |
475
|
|
|
|
|
|
|
# but we ran off the bottom of the Store item list and ran |
476
|
|
|
|
|
|
|
# into the list of Auction items. |
477
|
544
|
|
|
|
|
4212
|
return 0; |
478
|
|
|
|
|
|
|
# There is a separate backend for searching Auction items! |
479
|
|
|
|
|
|
|
} # if |
480
|
0
|
0
|
|
|
|
0
|
$iBids = 1 if ($oTDbids->as_text =~ m/SOLD/i); |
481
|
0
|
0
|
|
|
|
0
|
$iBids = $1 if ($oTDbids->as_text =~ m/(\d+)/); |
482
|
0
|
|
|
|
|
0
|
my $W = $self->whitespace_pattern; |
483
|
0
|
0
|
0
|
|
|
0
|
if ( |
484
|
|
|
|
|
|
|
# Bid listed as hyphen means no bids: |
485
|
|
|
|
|
|
|
($iBids =~ m!\A$W*-$W*\Z!) |
486
|
|
|
|
|
|
|
|| |
487
|
|
|
|
|
|
|
# Bid listed as whitespace means no bids: |
488
|
|
|
|
|
|
|
($iBids =~ m!\A$W*\Z!) |
489
|
|
|
|
|
|
|
) |
490
|
|
|
|
|
|
|
{ |
491
|
0
|
|
|
|
|
0
|
$iBids = 0; |
492
|
|
|
|
|
|
|
} # if |
493
|
|
|
|
|
|
|
} # if |
494
|
0
|
0
|
|
|
|
0
|
if ($iBids =~ m/NO/i) |
495
|
|
|
|
|
|
|
{ |
496
|
0
|
|
|
|
|
0
|
$iBids = 0; |
497
|
|
|
|
|
|
|
} # if |
498
|
0
|
|
0
|
|
|
0
|
$iBids ||= 0; |
499
|
|
|
|
|
|
|
# print STDERR " DDD setting bid_count to =$iBids=\n"; |
500
|
0
|
|
|
|
|
0
|
$hit->bid_count($iBids); |
501
|
0
|
|
|
|
|
0
|
return 1; |
502
|
|
|
|
|
|
|
} # _parse_bids |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub _parse_shipping |
505
|
|
|
|
|
|
|
{ |
506
|
11
|
|
|
11
|
|
15
|
my $self = shift; |
507
|
11
|
|
|
|
|
8
|
my $oTD = shift; |
508
|
11
|
|
|
|
|
12
|
my $hit = shift; |
509
|
11
|
50
|
|
|
|
22
|
if ($oTD->attr('class') =~ m'\bebcCty\b') |
510
|
|
|
|
|
|
|
{ |
511
|
|
|
|
|
|
|
# If we see this, we probably were searching for UK auctions |
512
|
|
|
|
|
|
|
# but we ran off the bottom of the UK item list and ran |
513
|
|
|
|
|
|
|
# into the list of international items. |
514
|
0
|
|
|
|
|
0
|
return 0; |
515
|
|
|
|
|
|
|
} # if |
516
|
11
|
50
|
|
|
|
98
|
if (my $oChild = $oTD->look_down(_tag => 'span', |
517
|
|
|
|
|
|
|
class => 'ship')) |
518
|
|
|
|
|
|
|
{ |
519
|
|
|
|
|
|
|
# As of 2013-03, we need to separate out the price and the |
520
|
|
|
|
|
|
|
# shipping for some flavors of eBay: |
521
|
11
|
|
|
|
|
441
|
$oTD = $oChild; |
522
|
|
|
|
|
|
|
} # if |
523
|
11
|
|
|
|
|
28
|
my $iPrice = $oTD->as_text; |
524
|
|
|
|
|
|
|
# I don't know why there are sometimes weird characters in there: |
525
|
11
|
|
|
|
|
291
|
$iPrice =~ s!Â!!g; |
526
|
11
|
|
|
|
|
13
|
$iPrice =~ s!Â!!g; |
527
|
11
|
50
|
|
|
|
24
|
print STDERR " DDD raw shipping ===$iPrice===\n" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
528
|
11
|
50
|
|
|
|
33
|
if ($iPrice =~ m/UNKNOWN/i) |
529
|
|
|
|
|
|
|
{ |
530
|
|
|
|
|
|
|
# No shipping info provided: |
531
|
0
|
|
|
|
|
0
|
return 1; |
532
|
|
|
|
|
|
|
} # if |
533
|
11
|
50
|
|
|
|
37
|
if ($iPrice =~ m/FREE/i) |
534
|
|
|
|
|
|
|
{ |
535
|
11
|
|
|
|
|
18
|
$iPrice = 0.00; |
536
|
|
|
|
|
|
|
} # if |
537
|
11
|
50
|
|
|
|
31
|
return 0 if ($iPrice !~ m/\d/); |
538
|
11
|
|
|
|
|
16
|
$iPrice =~ s!£!GBP!; |
539
|
11
|
|
|
|
|
35
|
$hit->shipping($iPrice); |
540
|
11
|
|
|
|
|
117
|
return 1; |
541
|
|
|
|
|
|
|
} # _parse_shipping |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub _parse_skip |
544
|
|
|
|
|
|
|
{ |
545
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
546
|
0
|
|
|
|
|
0
|
my $oTD = shift; |
547
|
0
|
|
|
|
|
0
|
my $hit = shift; |
548
|
0
|
|
|
|
|
0
|
return 1; |
549
|
|
|
|
|
|
|
} # _parse_skip |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub _parse_enddate |
552
|
|
|
|
|
|
|
{ |
553
|
496
|
|
|
496
|
|
380
|
my $self = shift; |
554
|
496
|
|
|
|
|
375
|
my $oTDdate = shift; |
555
|
496
|
|
|
|
|
343
|
my $hit = shift; |
556
|
496
|
|
|
|
|
434
|
my $sDate = 'unknown'; |
557
|
496
|
|
|
|
|
331
|
my ($s, $sDateTemp); |
558
|
496
|
50
|
|
|
|
690
|
if (ref $oTDdate) |
559
|
|
|
|
|
|
|
{ |
560
|
496
|
|
|
|
|
776
|
$sDateTemp = $oTDdate->as_text; |
561
|
496
|
|
|
|
|
11227
|
$s = $oTDdate->as_HTML; |
562
|
|
|
|
|
|
|
} # if |
563
|
|
|
|
|
|
|
else |
564
|
|
|
|
|
|
|
{ |
565
|
0
|
|
|
|
|
0
|
$sDateTemp = $s = $oTDdate; |
566
|
|
|
|
|
|
|
} |
567
|
496
|
100
|
|
|
|
118645
|
print STDERR " DDD TDdate ===$s===\n" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
568
|
|
|
|
|
|
|
# New version as of 2013-03: |
569
|
496
|
50
|
|
|
|
3365
|
if ($s =~ m/\bTIMEMS="(\d+)"/i) |
570
|
|
|
|
|
|
|
{ |
571
|
496
|
|
|
|
|
904
|
$sDate = $1; |
572
|
496
|
|
|
|
|
1999
|
$sDate = $self->_format_date(ParseDate(q{epoch }. int($sDate/1000))); |
573
|
496
|
100
|
|
|
|
183128
|
print STDERR " DDD sDate =$sDate=\n" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
574
|
496
|
|
|
|
|
1426
|
$hit->end_date($sDate); |
575
|
|
|
|
|
|
|
# For backward-compatibility: |
576
|
496
|
|
|
|
|
3576
|
$hit->change_date($sDate); |
577
|
496
|
|
|
|
|
3013
|
return 1; |
578
|
|
|
|
|
|
|
} |
579
|
0
|
0
|
|
|
|
0
|
if (ref($oTDdate)) |
580
|
|
|
|
|
|
|
{ |
581
|
0
|
|
0
|
|
|
0
|
my $sClass = $oTDdate->attr('class') || q{}; |
582
|
0
|
0
|
|
|
|
0
|
if ($sClass !~ m/\b(col3|ebcTim|ti?me)\b/) |
583
|
|
|
|
|
|
|
{ |
584
|
|
|
|
|
|
|
# If we see this, we probably were searching for Buy-It-Now items |
585
|
|
|
|
|
|
|
# but we ran off the bottom of the item list and ran into the list |
586
|
|
|
|
|
|
|
# of Store items. |
587
|
0
|
|
|
|
|
0
|
return 0; |
588
|
|
|
|
|
|
|
# There is a separate backend for searching Store items! |
589
|
|
|
|
|
|
|
} # if |
590
|
|
|
|
|
|
|
} # if |
591
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD raw sDateTemp ===$sDateTemp===\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
592
|
0
|
0
|
|
|
|
0
|
if ($sDateTemp =~ m/---/) |
593
|
|
|
|
|
|
|
{ |
594
|
|
|
|
|
|
|
# If we see this, we probably were searching for Buy-It-Now items |
595
|
|
|
|
|
|
|
# but we ran off the bottom of the item list and ran into the list |
596
|
|
|
|
|
|
|
# of Store items. |
597
|
0
|
|
|
|
|
0
|
return 0; |
598
|
|
|
|
|
|
|
# There is a separate backend for searching Store items! |
599
|
|
|
|
|
|
|
} # if |
600
|
|
|
|
|
|
|
# I don't know why there are sometimes weird characters in there: |
601
|
0
|
|
|
|
|
0
|
$sDateTemp =~ s!Â!!g; |
602
|
0
|
|
|
|
|
0
|
$sDateTemp =~ s!Â!!g; |
603
|
0
|
|
|
|
|
0
|
$sDateTemp =~ s!
|
604
|
|
|
|
|
|
|
# Convert nbsp to regular space: |
605
|
0
|
|
|
|
|
0
|
$sDateTemp =~ s!\240!\040!g; |
606
|
0
|
|
|
|
|
0
|
$sDateTemp =~ s!Time\s+left:!!g; |
607
|
0
|
|
|
|
|
0
|
$sDateTemp = $self->_process_date_abbrevs($sDateTemp); |
608
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD cooked sDateTemp ===$sDateTemp===\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
609
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD official time =====$self->{_ebay_official_time}=====\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
610
|
0
|
|
|
|
|
0
|
my $date = DateCalc($self->{_ebay_official_time}, " + $sDateTemp"); |
611
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD date ===$date===\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
612
|
0
|
|
|
|
|
0
|
$sDate = $self->_format_date($date); |
613
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD sDate ===$sDate===\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
614
|
0
|
|
|
|
|
0
|
$hit->end_date($sDate); |
615
|
|
|
|
|
|
|
# For backward-compatibility: |
616
|
0
|
|
|
|
|
0
|
$hit->change_date($sDate); |
617
|
0
|
|
|
|
|
0
|
return 1; |
618
|
|
|
|
|
|
|
} # _parse_enddate |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
=item result_as_HTML |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
Given a WWW::SearchResult object representing an auction, formats it |
624
|
|
|
|
|
|
|
human-readably with HTML. |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
An optional second argument is the date format, |
627
|
|
|
|
|
|
|
a string as specified for Date::Manip::UnixDate. |
628
|
|
|
|
|
|
|
Default is '%Y-%m-%d %H:%M:%S' |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
my $sHTML = $oSearch->result_as_HTML($oSearchResult, '%H:%M %b %E'); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=cut |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
sub result_as_HTML |
635
|
|
|
|
|
|
|
{ |
636
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
637
|
0
|
0
|
|
|
|
0
|
my $oSR = shift or return ''; |
638
|
0
|
|
0
|
|
|
0
|
my $sDateFormat = shift || q'%Y-%m-%d %H:%M:%S'; |
639
|
0
|
|
0
|
|
|
0
|
my $dateEnd = ParseDate($oSR->end_date) || q{}; |
640
|
0
|
|
|
|
|
0
|
my $iItemNum = $oSR->item_number; |
641
|
0
|
0
|
|
|
|
0
|
my $sSold = $oSR->sold |
642
|
|
|
|
|
|
|
? $cgi->font({color=>'green'}, 'sold') .q{; } |
643
|
|
|
|
|
|
|
: $cgi->font({color=>'red'}, 'not sold') .q{; }; |
644
|
0
|
|
|
|
|
0
|
my $sBids = $self->_bidcount_as_text($oSR); |
645
|
0
|
|
|
|
|
0
|
my $sPrice = $self->_bidamount_as_text($oSR); |
646
|
0
|
|
|
|
|
0
|
my $sEndedColor = 'green'; |
647
|
0
|
|
|
|
|
0
|
my $sEndedWord = 'ends'; |
648
|
0
|
|
|
|
|
0
|
my $dateNow = ParseDate('now'); |
649
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD compare end_date ==$dateEnd==\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
650
|
0
|
0
|
|
|
|
0
|
print STDERR " DDD compare date_now ==$dateNow==\n" if (DEBUG_DATES || (1 < $self->{_debug})); |
651
|
0
|
0
|
|
|
|
0
|
if (Date_Cmp($dateEnd, $dateNow) < 0) |
652
|
|
|
|
|
|
|
{ |
653
|
0
|
|
|
|
|
0
|
$sEndedColor = 'red'; |
654
|
0
|
|
|
|
|
0
|
$sEndedWord = 'ended'; |
655
|
|
|
|
|
|
|
} # if |
656
|
0
|
|
|
|
|
0
|
my $sEnded = $cgi->font({ color => $sEndedColor }, |
657
|
|
|
|
|
|
|
UnixDate($dateEnd, |
658
|
|
|
|
|
|
|
qq"$sEndedWord $sDateFormat")); |
659
|
0
|
|
|
|
|
0
|
my $s = $cgi->b( |
660
|
|
|
|
|
|
|
$cgi->a({href => $oSR->url}, $oSR->title), |
661
|
|
|
|
|
|
|
$cgi->br, |
662
|
|
|
|
|
|
|
qq{$sEnded; $sSold$sBids$sPrice}, |
663
|
|
|
|
|
|
|
); |
664
|
0
|
|
|
|
|
0
|
$s .= $cgi->br; |
665
|
0
|
|
|
|
|
0
|
$s .= $cgi->font({size => -1}, |
666
|
|
|
|
|
|
|
$cgi->a({href => qq{http://cgi.ebay.com/ws/eBayISAPI.dll?MakeTrack&item=$iItemNum}}, 'watch this item in MyEbay'), |
667
|
|
|
|
|
|
|
); |
668
|
|
|
|
|
|
|
# Format the entire thing as Helvetica: |
669
|
0
|
|
|
|
|
0
|
$s = $cgi->font({face => 'Arial, Helvetica'}, $s); |
670
|
0
|
|
|
|
|
0
|
return $s; |
671
|
|
|
|
|
|
|
} # result_as_HTML |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=back |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=head1 METHODS TO BE OVERRIDDEN IN SUBCLASSING |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
You only need to read about these if you are subclassing this module |
679
|
|
|
|
|
|
|
(i.e. making a backend for another flavor of eBay search). |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=over |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=cut |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=item _get_result_count_elements |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Given an HTML::TreeBuilder object, |
689
|
|
|
|
|
|
|
return a list of HTML::Element objects therein |
690
|
|
|
|
|
|
|
which could possibly contain the approximate result count verbiage. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=cut |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
sub _get_result_count_elements |
695
|
|
|
|
|
|
|
{ |
696
|
11
|
|
|
11
|
|
26
|
my $self = shift; |
697
|
11
|
|
|
|
|
15
|
my $tree = shift; |
698
|
11
|
|
|
|
|
17
|
my @ao; |
699
|
11
|
|
|
|
|
51
|
push @ao, $tree->look_down( # as of 2015-06 |
700
|
|
|
|
|
|
|
'_tag' => 'span', |
701
|
|
|
|
|
|
|
class => 'listingscnt' |
702
|
|
|
|
|
|
|
); |
703
|
11
|
|
|
|
|
107956
|
push @ao, $tree->look_down( |
704
|
|
|
|
|
|
|
'_tag' => 'div', |
705
|
|
|
|
|
|
|
class => 'fpcc' |
706
|
|
|
|
|
|
|
); |
707
|
11
|
|
|
|
|
110871
|
push @ao, $tree->look_down( |
708
|
|
|
|
|
|
|
'_tag' => 'div', |
709
|
|
|
|
|
|
|
class => 'fpc' |
710
|
|
|
|
|
|
|
); |
711
|
11
|
|
|
|
|
109729
|
push @ao, $tree->look_down( |
712
|
|
|
|
|
|
|
# For basic search, as of 2013-03: |
713
|
|
|
|
|
|
|
'_tag' => 'div', |
714
|
|
|
|
|
|
|
class => 'clt' |
715
|
|
|
|
|
|
|
); |
716
|
11
|
|
|
|
|
112751
|
push @ao, $tree->look_down( |
717
|
|
|
|
|
|
|
'_tag' => 'div', |
718
|
|
|
|
|
|
|
class => 'count' |
719
|
|
|
|
|
|
|
); |
720
|
11
|
|
|
|
|
118874
|
push @ao, $tree->look_down( |
721
|
|
|
|
|
|
|
'_tag' => 'div', |
722
|
|
|
|
|
|
|
class => 'pageCaptionDiv' |
723
|
|
|
|
|
|
|
); |
724
|
11
|
|
|
|
|
109111
|
push @ao, $tree->look_down( # for BySellerID as of 2010-07 |
725
|
|
|
|
|
|
|
'_tag' => 'div', |
726
|
|
|
|
|
|
|
id => 'rsc' |
727
|
|
|
|
|
|
|
); |
728
|
11
|
|
|
|
|
105942
|
return @ao; |
729
|
|
|
|
|
|
|
} # _get_result_count_elements |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=item _get_itemtitle_tds |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Given an HTML::TreeBuilder object, |
735
|
|
|
|
|
|
|
return a list of HTML::Element objects therein |
736
|
|
|
|
|
|
|
representing | elements |
737
|
|
|
|
|
|
|
which could possibly contain the HTML for result title and hotlink. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=cut |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub _get_itemtitle_tds |
742
|
|
|
|
|
|
|
{ |
743
|
5
|
|
|
5
|
|
9
|
my $self = shift; |
744
|
5
|
|
|
|
|
11
|
my $tree = shift; |
745
|
5
|
|
|
|
|
21
|
my @ao = $tree->look_down(_tag => 'td', |
746
|
|
|
|
|
|
|
class => 'details', |
747
|
|
|
|
|
|
|
); |
748
|
5
|
|
|
|
|
76152
|
push @ao, $tree->look_down(_tag => 'td', |
749
|
|
|
|
|
|
|
class => 'ebcTtl', |
750
|
|
|
|
|
|
|
); |
751
|
5
|
|
|
|
|
75408
|
push @ao, $tree->look_down(_tag => 'td', |
752
|
|
|
|
|
|
|
class => 'dtl', # This is for eBay auctions as of 2010-07 |
753
|
|
|
|
|
|
|
); |
754
|
|
|
|
|
|
|
# This is for BuyItNow (thanks to Brian Wilson): |
755
|
5
|
|
|
|
|
75462
|
push @ao, $tree->look_down(_tag => 'td', |
756
|
|
|
|
|
|
|
class => 'details ttl', |
757
|
|
|
|
|
|
|
); |
758
|
5
|
|
|
|
|
76120
|
my $oDiv = $tree->look_down(_tag => 'div', |
759
|
|
|
|
|
|
|
id => 'ResultSetItems', |
760
|
|
|
|
|
|
|
); |
761
|
5
|
50
|
|
|
|
16823
|
if (ref $oDiv) |
762
|
|
|
|
|
|
|
{ |
763
|
5
|
|
|
|
|
78
|
push @ao, $oDiv->look_down(_tag => 'td', |
764
|
|
|
|
|
|
|
class => 'dtl dtlsp', |
765
|
|
|
|
|
|
|
); |
766
|
5
|
|
|
|
|
57995
|
push @ao, $oDiv->look_down(_tag => 'h3', |
767
|
|
|
|
|
|
|
class => 'lvtitle', |
768
|
|
|
|
|
|
|
); |
769
|
|
|
|
|
|
|
} # if |
770
|
5
|
|
|
|
|
60385
|
return @ao; |
771
|
|
|
|
|
|
|
} # _get_itemtitle_tds |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
sub _parse_tree |
775
|
|
|
|
|
|
|
{ |
776
|
11
|
|
|
11
|
|
3998198
|
my $self = shift; |
777
|
11
|
|
|
|
|
30
|
my $tree = shift; |
778
|
11
|
100
|
|
|
|
62
|
print STDERR " FFF Ebay::_parse_tree\n" if (1 < $self->{_debug}); |
779
|
11
|
|
50
|
|
|
95
|
my $sTitle = $self->{response}->header('title') || ''; |
780
|
11
|
|
|
|
|
665
|
my $qrTitle = $self->_title_pattern; |
781
|
|
|
|
|
|
|
# print STDERR " DDD trying to match ==$sTitle== against ==$qrTitle==\n"; |
782
|
11
|
50
|
|
|
|
97
|
if ($sTitle =~ m!$qrTitle!) |
783
|
|
|
|
|
|
|
{ |
784
|
0
|
|
|
|
|
0
|
my ($sTitle, $iItem, $sDateRaw) = ($1, $2, $3); |
785
|
0
|
|
|
|
|
0
|
my $sDateCooked = $self->_format_date($sDateRaw); |
786
|
0
|
|
|
|
|
0
|
my $hit = new WWW::Search::Result; |
787
|
0
|
|
|
|
|
0
|
$hit->item_number($iItem); |
788
|
0
|
|
|
|
|
0
|
$hit->end_date($sDateCooked); |
789
|
|
|
|
|
|
|
# For backward-compatibility: |
790
|
0
|
|
|
|
|
0
|
$hit->change_date($sDateCooked); |
791
|
0
|
|
|
|
|
0
|
$hit->title($sTitle); |
792
|
0
|
|
|
|
|
0
|
$hit->add_url($self->{response}->request->uri); |
793
|
0
|
|
|
|
|
0
|
$hit->description($self->_create_description($hit)); |
794
|
|
|
|
|
|
|
# print Dumper($hit); |
795
|
0
|
|
|
|
|
0
|
push(@{$self->{cache}}, $hit); |
|
0
|
|
|
|
|
0
|
|
796
|
0
|
|
|
|
|
0
|
$self->{'_num_hits'}++; |
797
|
0
|
|
|
|
|
0
|
$self->approximate_result_count(1); |
798
|
0
|
|
|
|
|
0
|
return 1; |
799
|
|
|
|
|
|
|
} # if |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
# First, see if: there were zero results and eBay automatically did |
802
|
|
|
|
|
|
|
# a spell-check and searched for other words (or searched for a |
803
|
|
|
|
|
|
|
# subset of query terms): |
804
|
11
|
|
|
|
|
91
|
my $oDIV = $tree->look_down( |
805
|
|
|
|
|
|
|
_tag => 'div', |
806
|
|
|
|
|
|
|
class => 'messages', |
807
|
|
|
|
|
|
|
); |
808
|
11
|
50
|
|
|
|
113015
|
if (ref $oDIV) |
809
|
|
|
|
|
|
|
{ |
810
|
0
|
|
|
|
|
0
|
my $sText = $oDIV->as_text; |
811
|
0
|
0
|
0
|
|
|
0
|
if ( |
|
|
|
0
|
|
|
|
|
812
|
|
|
|
|
|
|
($sText =~ m/0 results found for /) |
813
|
|
|
|
|
|
|
&& |
814
|
|
|
|
|
|
|
( |
815
|
|
|
|
|
|
|
($sText =~ m/ so we searched for /) |
816
|
|
|
|
|
|
|
|| |
817
|
|
|
|
|
|
|
($sText =~ m/ so we removed keywords /) |
818
|
|
|
|
|
|
|
) |
819
|
|
|
|
|
|
|
) |
820
|
|
|
|
|
|
|
{ |
821
|
0
|
|
|
|
|
0
|
$self->approximate_result_count(0); |
822
|
0
|
|
|
|
|
0
|
return 0; |
823
|
|
|
|
|
|
|
} # if |
824
|
|
|
|
|
|
|
} # if |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# See if our query was completely replaced by a similar-spelling query: |
827
|
11
|
|
|
|
|
70
|
my $oLI = $tree->look_down(_tag => 'li', |
828
|
|
|
|
|
|
|
class => 'ebInf', |
829
|
|
|
|
|
|
|
); |
830
|
11
|
50
|
|
|
|
113021
|
if (ref $oLI) |
831
|
|
|
|
|
|
|
{ |
832
|
0
|
0
|
|
|
|
0
|
if ($oLI->as_text =~ m! keyword has been replaced !) |
833
|
|
|
|
|
|
|
{ |
834
|
0
|
|
|
|
|
0
|
$self->approximate_result_count(0); |
835
|
0
|
|
|
|
|
0
|
return 0; |
836
|
|
|
|
|
|
|
} # if |
837
|
|
|
|
|
|
|
} # if |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# See if our category-only query was replaced by a global query: |
840
|
11
|
|
|
|
|
61
|
my $oP = $tree->look_down(_tag => 'p', |
841
|
|
|
|
|
|
|
class => 'sm-md', |
842
|
|
|
|
|
|
|
); |
843
|
11
|
50
|
|
|
|
100448
|
if (ref $oP) |
844
|
|
|
|
|
|
|
{ |
845
|
0
|
|
|
|
|
0
|
my $s = $oP->as_text; |
846
|
0
|
0
|
0
|
|
|
0
|
if (($s =~ m/0 results found in the/) && ($s =~ m/so we searched in all categories/)) |
847
|
|
|
|
|
|
|
{ |
848
|
0
|
|
|
|
|
0
|
return 0; |
849
|
|
|
|
|
|
|
} # if |
850
|
|
|
|
|
|
|
} # if |
851
|
|
|
|
|
|
|
|
852
|
11
|
|
|
|
|
23
|
my $iHits = 0; |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# The hit count is in one of these tags: |
855
|
11
|
|
|
|
|
88
|
my @aoResultCountTagset = $self->_get_result_count_elements($tree); |
856
|
11
|
100
|
|
|
|
70
|
if (scalar(@aoResultCountTagset) < 1) |
857
|
|
|
|
|
|
|
{ |
858
|
1
|
|
|
|
|
47
|
warn " EEE no result_count_elements matched the HTML\n"; |
859
|
|
|
|
|
|
|
} # if |
860
|
|
|
|
|
|
|
FONT: |
861
|
11
|
|
|
|
|
28
|
foreach my $oFONT (@aoResultCountTagset) |
862
|
|
|
|
|
|
|
{ |
863
|
10
|
|
|
|
|
89
|
my $qr = $self->_result_count_pattern; |
864
|
|
|
|
|
|
|
print STDERR (" DDD result_count try ==", |
865
|
10
|
100
|
|
|
|
56
|
$oFONT->as_text, "== against qr=$qr=\n") if (1 < $self->{_debug}); |
866
|
10
|
50
|
|
|
|
82
|
if ($oFONT->as_text =~ m!$qr!) |
867
|
|
|
|
|
|
|
{ |
868
|
10
|
|
|
|
|
460
|
my $sCount = $1; |
869
|
10
|
100
|
|
|
|
40
|
print STDERR " DDD matched ($sCount)\n" if (1 < $self->{_debug}); |
870
|
|
|
|
|
|
|
# Make sure it's an integer: |
871
|
10
|
|
|
|
|
40
|
$sCount =~ s!,!!g; |
872
|
10
|
|
|
|
|
117
|
$self->approximate_result_count(0 + $sCount); |
873
|
10
|
|
|
|
|
136
|
last FONT; |
874
|
|
|
|
|
|
|
} # if |
875
|
|
|
|
|
|
|
} # foreach |
876
|
|
|
|
|
|
|
|
877
|
11
|
100
|
|
|
|
53
|
if ($self->approximate_result_count() < 1) |
878
|
|
|
|
|
|
|
{ |
879
|
6
|
|
|
|
|
101
|
return $iHits; |
880
|
|
|
|
|
|
|
} # if |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
# Recursively parse the stats telling how many items were found in |
883
|
|
|
|
|
|
|
# each category: |
884
|
5
|
|
|
|
|
70
|
my $oUL = $tree->look_down(_tag => 'ul', |
885
|
|
|
|
|
|
|
class => 'categories'); |
886
|
5
|
|
50
|
|
|
79405
|
$self->{categories} ||= []; |
887
|
5
|
50
|
|
|
|
24
|
$self->_parse_category_list($oUL, $self->{categories}) if ref($oUL); |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# First, delete all the results that came from spelling variations: |
890
|
5
|
|
|
|
|
27
|
my $oDiv = $tree->look_down(_tag => 'div', |
891
|
|
|
|
|
|
|
id => 'expSplChk', |
892
|
|
|
|
|
|
|
); |
893
|
5
|
50
|
|
|
|
81708
|
if (ref $oDiv) |
894
|
|
|
|
|
|
|
{ |
895
|
|
|
|
|
|
|
# print STDERR " DDD found a spell-check ===", $oDiv->as_text, "===\n"; |
896
|
0
|
|
|
|
|
0
|
$oDiv->detach; |
897
|
0
|
|
|
|
|
0
|
$oDiv->delete; |
898
|
|
|
|
|
|
|
} # if |
899
|
|
|
|
|
|
|
# The list of matching items is in a table. The first column of the |
900
|
|
|
|
|
|
|
# table is nothing but icons; the second column is the good stuff. |
901
|
5
|
|
|
|
|
45
|
my @aoTD = $self->_get_itemtitle_tds($tree); |
902
|
5
|
50
|
|
|
|
35
|
unless (@aoTD) |
903
|
|
|
|
|
|
|
{ |
904
|
0
|
0
|
|
|
|
0
|
print STDERR " EEE did not find table of results\n" if $self->{_debug}; |
905
|
|
|
|
|
|
|
# use File::Slurp; |
906
|
|
|
|
|
|
|
# write_file('no-results.html', $self->{response}->content); |
907
|
|
|
|
|
|
|
} # unless |
908
|
5
|
|
|
|
|
32
|
my $qrItemNum = qr{(\d{11,13})}; |
909
|
|
|
|
|
|
|
TD: |
910
|
5
|
|
|
|
|
12
|
foreach my $oTDtitle (@aoTD) |
911
|
|
|
|
|
|
|
{ |
912
|
|
|
|
|
|
|
# Sanity check: |
913
|
543
|
50
|
|
|
|
11931
|
next TD unless ref $oTDtitle; |
914
|
543
|
|
|
|
|
942
|
my $sTDtitle = $oTDtitle->as_HTML; |
915
|
543
|
100
|
|
|
|
110906
|
print STDERR " DDD try TDtitle ===$sTDtitle===\n" if (1 < $self->{_debug}); |
916
|
|
|
|
|
|
|
# First A tag contains the url & title: |
917
|
543
|
|
|
|
|
1395
|
my $oA = $oTDtitle->look_down('_tag', 'a'); |
918
|
543
|
50
|
|
|
|
15403
|
next TD unless ref $oA; |
919
|
|
|
|
|
|
|
# This is needed for Ebay::UK to make sure we're looking at the right TD: |
920
|
543
|
|
50
|
|
|
918
|
my $sTitle = $oA->as_text || ''; |
921
|
543
|
50
|
|
|
|
8213
|
next TD if ($sTitle eq ''); |
922
|
543
|
100
|
|
|
|
977
|
print STDERR " DDD sTitle ===$sTitle===\n" if (1 < $self->{_debug}); |
923
|
543
|
|
|
|
|
1167
|
my $oURI = URI->new($oA->attr('href')); |
924
|
|
|
|
|
|
|
# next TD unless ($oURI =~ m!ViewItem!); |
925
|
543
|
50
|
|
|
|
27772
|
next TD if ($oURI !~ m!$qrItemNum!); |
926
|
543
|
|
|
|
|
3586
|
my $iItemNum = $1; |
927
|
543
|
100
|
|
|
|
1164
|
print STDERR " DDD iItemNum ===$iItemNum===\n" if (1 < $self->{_debug}); |
928
|
543
|
|
|
|
|
658
|
my $iCategory = -1; |
929
|
543
|
50
|
|
|
|
759
|
$iCategory = $1 if ($oURI =~ m!QQcategoryZ(\d+)QQ!); |
930
|
543
|
50
|
|
|
|
2452
|
if ($oURI->as_string =~ m!QQitemZ(\d+)QQ!) |
931
|
|
|
|
|
|
|
{ |
932
|
|
|
|
|
|
|
# Convert new eBay links to old reliable ones: |
933
|
|
|
|
|
|
|
# $oURI->path(''); |
934
|
0
|
|
|
|
|
0
|
$oURI->path('/ws/eBayISAPI.dll'); |
935
|
0
|
|
|
|
|
0
|
$oURI->query("ViewItem&item=$1"); |
936
|
|
|
|
|
|
|
} # if |
937
|
543
|
|
|
|
|
2005
|
my $sURL = $oURI->as_string; |
938
|
543
|
|
|
|
|
1872
|
my $hit = new WWW::Search::Result; |
939
|
543
|
|
|
|
|
2759
|
$hit->add_url($self->_cleanup_url($sURL)); |
940
|
543
|
|
|
|
|
3158
|
$hit->title($sTitle); |
941
|
543
|
|
|
|
|
3480
|
$hit->item_number($iItemNum); |
942
|
|
|
|
|
|
|
# This is just to prevent undef warnings later on: |
943
|
543
|
|
|
|
|
2694
|
$hit->bid_count(0); |
944
|
|
|
|
|
|
|
# The rest of the info about this item is in sister elements |
945
|
|
|
|
|
|
|
# to the right: |
946
|
543
|
|
|
|
|
2983
|
my @aoSibs = $oTDtitle->parent->look_down(_tag => q{li}); |
947
|
|
|
|
|
|
|
# The parent itself is an tag: |
948
|
543
|
|
|
|
|
73676
|
shift @aoSibs; |
949
|
543
|
100
|
|
|
|
1626
|
warn " DDD before loop, there are ", scalar(@aoSibs), " sibling TDs\n" if (1 < $self->{_debug}); |
950
|
|
|
|
|
|
|
SIBLING_TD: |
951
|
543
|
|
|
|
|
1205
|
while (my $oTDsib = shift @aoSibs) |
952
|
|
|
|
|
|
|
{ |
953
|
2860
|
50
|
|
|
|
4146
|
next unless ref($oTDsib); |
954
|
2860
|
|
100
|
|
|
5272
|
my $sColumn = $oTDsib->attr('class') || q{}; |
955
|
2860
|
|
|
|
|
21004
|
my $s = $oTDsib->as_HTML; |
956
|
2860
|
100
|
|
|
|
463591
|
if ($sColumn eq q{}) |
957
|
|
|
|
|
|
|
{ |
958
|
722
|
100
|
|
|
|
2595
|
warn " WWW auction info sibling has no class ==$s==" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
959
|
|
|
|
|
|
|
} # if |
960
|
2860
|
100
|
|
|
|
6374
|
print STDERR " DDD looking at TD'$sColumn' ===$s===\n" if (DEBUG_COLUMNS || (1 < $self->{_debug})); |
961
|
2860
|
100
|
|
|
|
6462
|
if ($sColumn =~ m'price') |
962
|
|
|
|
|
|
|
{ |
963
|
544
|
50
|
|
|
|
910
|
next TD unless $self->_parse_price($oTDsib, $hit); |
964
|
|
|
|
|
|
|
} # if |
965
|
2860
|
100
|
66
|
|
|
9620
|
if (($sColumn =~ m'bids') || ($sColumn =~ m'format')) |
966
|
|
|
|
|
|
|
{ |
967
|
|
|
|
|
|
|
# It is not a fatal error if there are no bids (i.e. buy-it-now) |
968
|
544
|
|
|
|
|
895
|
$self->_parse_bids($oTDsib, $hit); |
969
|
|
|
|
|
|
|
} |
970
|
2860
|
100
|
|
|
|
4058
|
if ($sColumn =~ m'shipping') |
971
|
|
|
|
|
|
|
{ |
972
|
11
|
50
|
|
|
|
29
|
next TD if ! $self->_parse_shipping($oTDsib, $hit); |
973
|
|
|
|
|
|
|
} |
974
|
2860
|
50
|
|
|
|
3821
|
if ($sColumn =~ m'end') |
975
|
|
|
|
|
|
|
{ |
976
|
0
|
0
|
|
|
|
0
|
next TD if ! $self->_parse_enddate($oTDsib, $hit); |
977
|
|
|
|
|
|
|
} |
978
|
2860
|
100
|
|
|
|
3937
|
if ($sColumn =~ 'time') |
979
|
|
|
|
|
|
|
{ |
980
|
496
|
50
|
|
|
|
873
|
next TD if ! $self->_parse_enddate($oTDsib, $hit); |
981
|
|
|
|
|
|
|
} |
982
|
2860
|
50
|
|
|
|
4241
|
if ($sColumn =~ m'country') |
983
|
|
|
|
|
|
|
{ |
984
|
|
|
|
|
|
|
# This listing is from a country other than the base site |
985
|
|
|
|
|
|
|
# we're searching against. Throw it out: |
986
|
0
|
|
|
|
|
0
|
next TD; |
987
|
|
|
|
|
|
|
} |
988
|
2860
|
100
|
|
|
|
7022
|
if ($sColumn =~ m'extras') |
989
|
|
|
|
|
|
|
{ |
990
|
543
|
50
|
|
|
|
725
|
if ($iCategory < 0) |
991
|
|
|
|
|
|
|
{ |
992
|
|
|
|
|
|
|
# We haven't found this item's category. Look for it here: |
993
|
543
|
|
|
|
|
872
|
$iCategory = $self->_parse_category($oTDsib); |
994
|
|
|
|
|
|
|
} # if |
995
|
|
|
|
|
|
|
} # if 'extras' |
996
|
|
|
|
|
|
|
# Any other class="" value will cause the to be ignored. |
997
|
|
|
|
|
|
|
} # while |
998
|
543
|
|
|
|
|
796
|
my $sDesc = $self->_create_description($hit); |
999
|
543
|
|
|
|
|
866
|
$hit->description($sDesc); |
1000
|
543
|
|
|
|
|
3379
|
$hit->category($iCategory); |
1001
|
|
|
|
|
|
|
# Clean up / sanity check hit info: |
1002
|
543
|
|
|
|
|
2283
|
my ($enddate, $iBids); |
1003
|
543
|
50
|
66
|
|
|
810
|
if ( |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1004
|
|
|
|
|
|
|
defined($enddate = $hit->end_date) |
1005
|
|
|
|
|
|
|
&& |
1006
|
|
|
|
|
|
|
defined($iBids = $hit->bid_count) |
1007
|
|
|
|
|
|
|
&& |
1008
|
|
|
|
|
|
|
(0 < $iBids) # Item got any bids |
1009
|
|
|
|
|
|
|
&& |
1010
|
|
|
|
|
|
|
(Date_Cmp($enddate, 'now') < 0) # Item is ended |
1011
|
|
|
|
|
|
|
) |
1012
|
|
|
|
|
|
|
{ |
1013
|
|
|
|
|
|
|
# Item must have been sold!?! |
1014
|
0
|
|
|
|
|
0
|
$hit->sold(1); |
1015
|
|
|
|
|
|
|
} # if |
1016
|
543
|
100
|
|
|
|
6860
|
print STDERR " DDD add hit to cache\n" if (1 < $self->{_debug}); |
1017
|
543
|
|
|
|
|
632
|
push(@{$self->{cache}}, $hit); |
|
543
|
|
|
|
|
836
|
|
1018
|
543
|
|
|
|
|
492
|
$self->{'_num_hits'}++; |
1019
|
543
|
|
|
|
|
358
|
$iHits++; |
1020
|
|
|
|
|
|
|
|
1021
|
543
|
100
|
|
|
|
1114
|
if ($self->approximate_result_count() <= $iHits) |
1022
|
|
|
|
|
|
|
{ |
1023
|
|
|
|
|
|
|
# We've already scraped all the hits that eBay said there were. |
1024
|
|
|
|
|
|
|
# Stop scraping, so that we don't return hits that are not an |
1025
|
|
|
|
|
|
|
# exact match to the query but are just "related": |
1026
|
2
|
|
|
|
|
26
|
last TD; |
1027
|
|
|
|
|
|
|
} # if |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
# Delete this HTML element so that future searches go faster? |
1030
|
541
|
|
|
|
|
4600
|
$oTDtitle->detach; |
1031
|
541
|
|
|
|
|
7401
|
$oTDtitle->delete; |
1032
|
|
|
|
|
|
|
} # foreach TD |
1033
|
|
|
|
|
|
|
|
1034
|
5
|
|
|
|
|
75
|
undef $self->{_next_url}; |
1035
|
5
|
|
|
|
|
5
|
if (0) |
1036
|
|
|
|
|
|
|
{ |
1037
|
|
|
|
|
|
|
# AS OF 2008-11 THE NEXT LINK CAN NOT BE FOLLOWED FROM PERL CODE |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
# Look for a NEXT link: |
1040
|
|
|
|
|
|
|
my @aoA = $tree->look_down('_tag' => 'a'); |
1041
|
|
|
|
|
|
|
TRY_NEXT: |
1042
|
|
|
|
|
|
|
foreach my $oA (0, reverse @aoA) |
1043
|
|
|
|
|
|
|
{ |
1044
|
|
|
|
|
|
|
next TRY_NEXT unless ref $oA; |
1045
|
|
|
|
|
|
|
print STDERR " DDD try NEXT A ===", $oA->as_HTML, "===\n" if (1 < $self->{_debug}); |
1046
|
|
|
|
|
|
|
my $href = $oA->attr('href'); |
1047
|
|
|
|
|
|
|
next TRY_NEXT unless $href; |
1048
|
|
|
|
|
|
|
# Looking backwards from the bottom of the page, if we get all the |
1049
|
|
|
|
|
|
|
# way to the item list, there must be no next button: |
1050
|
|
|
|
|
|
|
last TRY_NEXT if ($href =~ m!ViewItem!); |
1051
|
|
|
|
|
|
|
if ($oA->as_text eq $self->_next_text) |
1052
|
|
|
|
|
|
|
{ |
1053
|
|
|
|
|
|
|
print STDERR " DDD got NEXT A ===", $oA->as_HTML, "===\n" if 1 < $self->{_debug}; |
1054
|
|
|
|
|
|
|
my $sClass = $oA->attr('class') || ''; |
1055
|
|
|
|
|
|
|
if ($sClass =~ m/disabled/i) |
1056
|
|
|
|
|
|
|
{ |
1057
|
|
|
|
|
|
|
last TRY_NEXT; |
1058
|
|
|
|
|
|
|
} # if |
1059
|
|
|
|
|
|
|
$self->{_next_url} = $self->absurl($self->{_prev_url}, $href); |
1060
|
|
|
|
|
|
|
last TRY_NEXT; |
1061
|
|
|
|
|
|
|
} # if |
1062
|
|
|
|
|
|
|
} # foreach |
1063
|
|
|
|
|
|
|
} # if 0 |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
# All done with this page. |
1066
|
5
|
|
|
|
|
36
|
$tree->delete; |
1067
|
5
|
|
|
|
|
93875
|
return $iHits; |
1068
|
|
|
|
|
|
|
} # _parse_tree |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=item _parse_category_list |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
Parses the Category list from the left side of the results page. |
1074
|
|
|
|
|
|
|
So far, |
1075
|
|
|
|
|
|
|
this method can handle every type of eBay search currently implemented. |
1076
|
|
|
|
|
|
|
If you find that it doesn't suit your needs, |
1077
|
|
|
|
|
|
|
please contact the author because it's probably just a tiny tweak that's needed. |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=cut |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
sub _parse_category_list |
1082
|
|
|
|
|
|
|
{ |
1083
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1084
|
0
|
|
|
|
|
0
|
my $oTree = shift; |
1085
|
0
|
|
|
|
|
0
|
my $ra = shift; |
1086
|
0
|
|
|
|
|
0
|
my $oUL = $oTree->look_down(_tag => 'ul'); |
1087
|
0
|
|
|
|
|
0
|
my @aoLI = $oUL->look_down(_tag => 'li'); |
1088
|
|
|
|
|
|
|
CATLIST_LI: |
1089
|
0
|
|
|
|
|
0
|
foreach my $oLI (@aoLI) |
1090
|
|
|
|
|
|
|
{ |
1091
|
0
|
|
|
|
|
0
|
my %hash; |
1092
|
0
|
0
|
|
|
|
0
|
next CATLIST_LI unless ref($oLI); |
1093
|
0
|
0
|
|
|
|
0
|
if ($oLI->parent->same_as($oUL)) |
1094
|
|
|
|
|
|
|
{ |
1095
|
0
|
|
|
|
|
0
|
my $oA = $oLI->look_down(_tag => 'a'); |
1096
|
0
|
0
|
|
|
|
0
|
next CATLIST_LI unless ref($oA); |
1097
|
0
|
|
|
|
|
0
|
my $oSPAN = $oLI->look_down(_tag => 'span'); |
1098
|
0
|
0
|
|
|
|
0
|
next CATLIST_LI unless ref($oSPAN); |
1099
|
0
|
|
|
|
|
0
|
$hash{'Name'} = $oA->as_text; |
1100
|
0
|
|
|
|
|
0
|
$hash{'ID'} = $oA->{'href'}; |
1101
|
0
|
|
|
|
|
0
|
$hash{'ID'} =~ /sacatZ([0-9]+)/; |
1102
|
0
|
|
|
|
|
0
|
$hash{'ID'} = $1; |
1103
|
0
|
|
|
|
|
0
|
my $i = $oSPAN->as_text; |
1104
|
0
|
|
|
|
|
0
|
$i =~ tr/0-9//cd; |
1105
|
0
|
|
|
|
|
0
|
$hash{'Count'} = $i; |
1106
|
0
|
|
|
|
|
0
|
push @{$ra}, \%hash; |
|
0
|
|
|
|
|
0
|
|
1107
|
|
|
|
|
|
|
} # if |
1108
|
0
|
|
|
|
|
0
|
my @aoUL = $oLI->look_down(_tag => 'ul'); |
1109
|
|
|
|
|
|
|
CATLIST_UL: |
1110
|
0
|
|
|
|
|
0
|
foreach my $oUL (@aoUL) |
1111
|
|
|
|
|
|
|
{ |
1112
|
0
|
0
|
|
|
|
0
|
next CATLIST_UL unless ref($oUL); |
1113
|
0
|
0
|
|
|
|
0
|
if($oUL->parent()->same_as($oLI)) |
1114
|
|
|
|
|
|
|
{ |
1115
|
0
|
|
|
|
|
0
|
$hash{'Subcategory'} = (); |
1116
|
0
|
|
|
|
|
0
|
$self->_parse_category_list($oLI, \@{$hash{'Subcategory'}}); |
|
0
|
|
|
|
|
0
|
|
1117
|
|
|
|
|
|
|
} # if |
1118
|
|
|
|
|
|
|
} # foreach CATLIST_UL |
1119
|
|
|
|
|
|
|
} # foreach CATLIST_LI |
1120
|
|
|
|
|
|
|
} # _parse_category_list |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item _process_date_abbrevs |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
Given a date string, |
1126
|
|
|
|
|
|
|
converts common abbreviations to their full words |
1127
|
|
|
|
|
|
|
(so that the string can be unambiguously parsed by Date::Manip). |
1128
|
|
|
|
|
|
|
For example, |
1129
|
|
|
|
|
|
|
in the default English, 'd' becomes 'days'. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=cut |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
sub _process_date_abbrevs |
1134
|
|
|
|
|
|
|
{ |
1135
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1136
|
0
|
|
|
|
|
0
|
my $s = shift; |
1137
|
0
|
|
|
|
|
0
|
$s =~ s!d! days!; |
1138
|
0
|
|
|
|
|
0
|
$s =~ s!h! hours!; |
1139
|
0
|
|
|
|
|
0
|
$s =~ s!m! minutes!; |
1140
|
0
|
|
|
|
|
0
|
return $s; |
1141
|
|
|
|
|
|
|
} # _process_date_abbrevs |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item _next_text |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
The text of the "Next" button, localized for a specific type of eBay backend. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=cut |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
sub _next_text |
1151
|
|
|
|
|
|
|
{ |
1152
|
0
|
|
|
0
|
|
0
|
return 'Next'; |
1153
|
|
|
|
|
|
|
} # _next_text |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item whitespace_pattern |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
Return a qr// pattern to match whitespace your webpage's language. |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=cut |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
sub whitespace_pattern |
1163
|
|
|
|
|
|
|
{ |
1164
|
|
|
|
|
|
|
# A pattern to match HTML whitespace: |
1165
|
1089
|
|
|
1089
|
1
|
1877
|
return qr{[\ \t\r\n\240]}; |
1166
|
|
|
|
|
|
|
} # whitespace_pattern |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=item _currency_pattern |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
Return a qr// pattern to match mentions of money in your webpage's language. |
1171
|
|
|
|
|
|
|
Include the digits in the pattern. |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
=cut |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
sub _currency_pattern |
1176
|
|
|
|
|
|
|
{ |
1177
|
545
|
|
|
545
|
|
3536
|
my $self = shift; |
1178
|
|
|
|
|
|
|
# A pattern to match all possible currencies found in USA eBay |
1179
|
|
|
|
|
|
|
# listings: |
1180
|
545
|
|
|
|
|
639
|
my $W = $self->whitespace_pattern; |
1181
|
545
|
|
|
|
|
2537
|
return qr/(?:\$|C|EUR|GBP)$W*[0-9.,]+/; |
1182
|
|
|
|
|
|
|
} # _currency_pattern |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=item _title_pattern |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
Return a qr// pattern to match the webpage title in your webpage's language. |
1188
|
|
|
|
|
|
|
Add grouping parenthesis so that |
1189
|
|
|
|
|
|
|
$1 becomes the auction title, |
1190
|
|
|
|
|
|
|
$2 becomes the eBay item number, and |
1191
|
|
|
|
|
|
|
$3 becomes the end date. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=cut |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
sub _title_pattern |
1196
|
|
|
|
|
|
|
{ |
1197
|
22
|
|
|
22
|
|
143
|
return qr{\A(.+?)\s+-\s+EBAY\s+\(ITEM\s+(\d+)\s+END\s+TIME\s+([^)]+)\)\Z}i; # |
1198
|
|
|
|
|
|
|
} # _title_pattern |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=item _result_count_pattern |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
Return a qr// pattern to match the result count in your webpage's language. |
1204
|
|
|
|
|
|
|
Include parentheses so that $1 becomes the number (with commas is OK). |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
=cut |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
sub _result_count_pattern |
1209
|
|
|
|
|
|
|
{ |
1210
|
10
|
|
|
10
|
|
68
|
return qr'([0-9,]+)\s+(active\s+)?(listing|item|matche?|result)s?(\s+found)?'; |
1211
|
|
|
|
|
|
|
} # _result_count_pattern |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
1; |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
__END__ |