line
stmt
bran
cond
sub
pod
time
code
1
2
=head1 COPYRIGHT
3
4
Copyright (C) 2002-present Martin Thurn
5
All Rights Reserved
6
7
=head1 NAME
8
9
WWW::Ebay::Session - log in to eBay and access account information
10
11
=head1 SYNOPSIS
12
13
use WWW::Ebay::Session;
14
my $oSession = new WWW::Ebay::Session('ebay-userid', 'ebay-password');
15
16
=head1 DESCRIPTION
17
18
Allows you to programatically log in as a particular user and fetch
19
webpages from the eBay auction website (www.ebay.com).
20
21
=head1 AUTHOR
22
23
Martin 'Kingpin' Thurn, C, L.
24
25
=head1 METHODS
26
27
=over
28
29
=cut
30
31
package WWW::Ebay::Session;
32
33
3
3
5762
use strict;
3
5
3
79
34
3
3
10
use warnings;
3
5
3
96
35
36
require 5.006;
37
38
3
3
10
use Data::Dumper; # for debugging only
3
3
3
122
39
3
3
350
use Date::Manip;
3
95182
3
969
40
3
3
430
use File::Spec::Functions;
3
505
3
249
41
3
3
1626
use HTML::Form;
3
17611
3
92
42
3
3
1356
use HTML::TreeBuilder;
3
21058
3
27
43
3
3
645
use HTTP::Cookies;
3
7772
3
92
44
3
3
1667
use HTTP::Request::Common qw( GET POST );
3
13071
3
187
45
3
3
370
use LWP::Simple;
3
16690
3
20
46
3
3
897
use LWP::UserAgent;
3
4
3
50
47
3
3
1123
use WWW::Ebay::Listing;
3
5
3
83
48
3
3
536
use WWW::Search;
3
28837
3
130
49
# We need the version whose _parse_enddate() takes a string as arg2:
50
3
3
492
use WWW::Search::Ebay 2.181;
3
6505
3
104
51
# We need the version that has the shipping() method:
52
3
3
12
use WWW::SearchResult 2.070;
3
32
3
53
53
54
3
3
9
use constant DEBUG_EMAIL => 0;
3
5
3
133
55
3
3
9
use constant DEBUG_FETCH => 0;
3
4
3
101
56
3
3
9
use constant DEBUG_FUNC => 0;
3
2
3
101
57
3
3
9
use constant DEBUG_SELLING => 0;
3
4
3
106
58
3
3
9
use constant DEBUG_SOLD => 0;
3
3
3
91
59
3
3
14
use constant DEBUG_UNSOLD => 0;
3
3
3
90
60
3
3
8
use constant DEBUG_WATCH => 0;
3
2
3
107
61
3
3
8
use constant DEBUG_READ_LOCAL_FILES => 0;
3
5
3
13271
62
63
our
64
$VERSION = 1.65;
65
66
sub _debug
67
{
68
# return unless $iDEBUGGING;
69
0
0
print STDERR @_;
70
} # _debug
71
72
=item new
73
74
Creates a new object of this type.
75
76
=cut
77
78
sub new
79
{
80
0
0
1
my $class = shift;
81
# This is NOT a clone method:
82
0
0
return undef if ref $class;
83
0
my ($sUserID, $sPassword) = @_;
84
0
my $self = {
85
# Create cookie jar and UserAgent not now, but only when
86
# needed:
87
'_cookie_jar' => undef,
88
'_user_agent' => undef,
89
'_error' => '',
90
'_pass' => $sPassword,
91
'_user' => $sUserID,
92
'_response' => undef,
93
'_selling_page' => '',
94
'raoSold' => undef,
95
'raoSelling' => undef,
96
'raoWatching' => undef,
97
};
98
0
bless ($self, $class);
99
0
return $self;
100
} # new
101
102
103
=item response
104
105
Returns the HTTP::Response object that resulted from the most recent page fetched.
106
107
=cut
108
109
sub response
110
{
111
0
0
1
my $self = shift;
112
0
0
if (@_)
113
{
114
0
$self->{_response} = shift;
115
} # if
116
0
return $self->{_response};
117
} # response
118
119
=item signin
120
121
This method can be called if you only need the encrypted password.
122
123
=cut
124
125
my %hssPasswords;
126
127
sub signin
128
{
129
0
0
1
my $self = shift;
130
0
0
my $sUserID = $self->{_user} || '';
131
0
0
my $sPassword = $self->{_pass} || '';
132
0
DEBUG_FUNC && print STDERR " DDD Ebay::Session::signin($sUserID)\n";
133
0
print STDERR " DDD signin($sUserID,$sPassword)\n" if DEBUG_FETCH;
134
0
0
if (! exists($hssPasswords{$sUserID}))
135
{
136
# Get the sign-in page and parse it:
137
0
print STDERR " DDD fetching ebay sign-in page...\n" if DEBUG_FETCH;
138
# my $sPage = $self->fetch_any_ebay_page('http://cgi.ebay.com/aw-cgi/eBayISAPI.dll?SignIn', 'signin', 'ignore-refresh');
139
0
my $sPage = $self->fetch_any_ebay_page('http://signin.ebay.com/ws/eBayISAPI.dll?SignIn&ssPageName=h:h:sin:US', 'signin', 'ignore-refresh');
140
# http://signin.ebay.com/ws/eBayISAPI.dll?SignIn&ssPageName=h:h:sin:US&ru=http%3A//my.ebay.com/ws/ebayISAPI.dll%3FMyeBay%26CurrentPage%3DMyeBayAllSelling
141
# NEW: No encrypted password sent, only cookies. See if the
142
# sign-in succeeded:
143
0
0
$hssPasswords{$sUserID} = ($sPage =~ m!If you are seeing this page,!i) ? 1 : 'FAILED';
144
# OLD: Grab a copy of the encrypted password:
145
# $hssPasswords{$sUserID} = ($sPage =~ m!(&|;)pass=(.+?)&!) ? $2 : 'FAILED';
146
} # if
147
0
return $hssPasswords{$sUserID};
148
} # signin
149
150
151
=item fetch_any_ebay_page
152
153
=cut
154
155
sub fetch_any_ebay_page
156
{
157
0
0
1
my $self = shift;
158
# Required arg1 == HTTP::Request object, or URL as string:
159
0
my $oReq = shift;
160
# Optional arg2 == name of this page (for debugging msgs):
161
0
0
my $sName = shift() || '';
162
# Optional arg3 == whether to ignore meta-refresh tags (default is
163
# to follow redirects):
164
0
0
my $iIgnoreRefresh = shift() || 0;
165
0
DEBUG_FUNC && print STDERR " DDD Ebay::Session::fetch_any($sName)\n";
166
0
my $fname = "Pages/$sName.html";
167
0
my $sPage = '';
168
0
if (DEBUG_READ_LOCAL_FILES && ($sName ne '') && -f $fname)
169
{
170
unless (open DBG, "<$fname")
171
{
172
print STDERR " --- DEBUG_READ_LOCAL_FILES is on, but can not open $fname for read: $!\n";
173
return '';
174
} # unless
175
local $/ = undef; # slurp entire file
176
$sPage = ;
177
close DBG;
178
return $sPage;
179
} # if
180
0
print STDERR " DDD in fetch_any_ebay_page, oReq is $oReq\n" if DEBUG_FETCH;
181
0
my $ref = ref $oReq;
182
0
0
0
unless ((defined $ref) && ($ref =~ m!HTTP::!))
183
{
184
# Argument is not a Request object; assume it's a string URL, or a
185
# URI object:
186
0
$oReq = new HTTP::Request(GET => $oReq);
187
} # unless
188
0
my $sURL = $oReq->uri;
189
0
REQUEST_READY:
190
$self->cookie_jar->add_cookie_header($oReq);
191
0
my $sReq = $oReq->as_string;
192
0
0
if ($sName ne '')
193
{
194
0
print STDERR " DDD the HTTP::Request for $sName is $sReq" if DEBUG_FETCH;
195
} # if
196
0
$self->response($self->user_agent->request($oReq));
197
0
my $sRes = $self->response->as_string;
198
0
DEBUG_FETCH && print STDERR " DDD the HTTP::Response for $sName is ==========$sRes==========";
199
0
my $sURLprev = '';
200
OBJECT_MOVED:
201
0
while ($self->response->code == 302)
202
{
203
0
print STDERR " DDD server says: Object Moved\n" if DEBUG_FETCH;
204
0
$sReq .= "\n";
205
0
$sURLprev = $sURL;
206
0
$sURL = $self->response->header('Location');
207
0
$oReq = GET $sURL;
208
0
$oReq->referer($sURLprev);
209
0
$self->cookie_jar->add_cookie_header($oReq);
210
0
print STDERR " DDD the new HTTP::Request for $sName is ", $oReq->as_string if DEBUG_FETCH;
211
0
$sReq .= $oReq->as_string;
212
0
$self->response($self->user_agent->request($oReq));
213
} # while
214
META_REFRESH:
215
0
0
while (! $iIgnoreRefresh && ($self->response->content =~ m!!i))
216
{
217
0
$sURLprev = $sURL;
218
0
$sURL = $1;
219
0
$sURL =~ s!&!&!g;
220
0
print STDERR " DDD server says: Meta-Refresh to $sURL\n" if DEBUG_FETCH;
221
0
$oReq = GET $sURL;
222
0
$oReq->referer($sURLprev);
223
0
$self->cookie_jar->add_cookie_header($oReq);
224
0
print STDERR " DDD the new HTTP::Request for $sName is ", $oReq->as_string if DEBUG_FETCH;
225
0
$sReq .= "\n";
226
0
$sReq .= $oReq->as_string;
227
0
$self->response($self->user_agent->request($oReq));
228
} # while
229
0
$sRes = $self->response->headers_as_string;
230
0
0
if (! $self->response->is_success)
231
{
232
0
my $fname1 = "Pages/$sName-fail.html";
233
0
0
0
if (($sName ne '') && (open ERR, ">$fname1"))
234
{
235
0
print STDERR " --- eBay $sName failed: can not get page: ", $self->response->status_line, "\n" if DEBUG_FETCH;
236
0
print ERR "\n\n";
237
0
print ERR "\n\n";
238
0
print ERR $self->response->content;
239
0
close ERR;
240
0
print STDERR " --- what we did get back was saved in $fname1\n" if DEBUG_FETCH;
241
} # if
242
0
return '';
243
} # unless
244
0
$sPage = $self->response->content;
245
0
0
0
if ($sPage =~ m!"SignInForm"!)
0
246
{
247
# We need to sign-in before we get to see the requested page:
248
0
my $fname1 = "Pages/$sName-signin.html";
249
0
if (DEBUG_FETCH && ($sName ne '') && (open PAGE, '>', $fname1))
250
{
251
print PAGE "\n\n";
252
print PAGE "\n\n";
253
print PAGE $sPage;
254
close PAGE;
255
print STDERR " DDD eBay GET $sName saved in $fname1\n" if DEBUG_FETCH;
256
} # if
257
0
print STDERR " DDD parsing ebay sign-in page...\n" if DEBUG_FETCH;
258
# Parse the
259
0
my @aoForm = HTML::Form->parse($sPage, $self->response->base);
260
# As of August 2014, the sign-in form is the first one on the page:
261
0
my $oForm = $aoForm[0];
262
0
0
unless (ref $oForm)
263
{
264
0
print STDERR " EEE eBay sign-in page contained no
265
0
return undef;
266
} # unless
267
0
print STDERR " DDD got a FORM...\n" if DEBUG_FETCH;
268
# Insert the user's values:
269
0
$oForm->value('userid', $self->{_user});
270
0
$oForm->value('pass', $self->{_pass});
271
# Request a cookie to reduce bandwidth:
272
0
$oForm->value('keepMeSignInOption', 1);
273
# Submit the form and get our cookie:
274
0
$oReq = $oForm->click;
275
0
$oReq->referer($sURLprev);
276
0
$sURLprev = $sURL;
277
0
print STDERR " DDD CLICK is ", Dumper($oReq) if DEBUG_FETCH;
278
0
print STDERR " DDD submitting password to ebay...\n" if DEBUG_FETCH;
279
0
goto REQUEST_READY;
280
} # if we got a sign-in page
281
elsif (($sPage =~ m!"AdultLogin"!)
282
||
283
($sPage =~ m!Terms of Use: Mature Audiences Category!)
284
)
285
{
286
0
my $fname1 = "Pages/$sName-adultlogin.html";
287
0
if (DEBUG_FETCH && ($sName ne '') && (open PAGE, '>', $fname1))
288
{
289
print PAGE "\n\n";
290
print PAGE "\n\n";
291
print PAGE $sPage;
292
close PAGE;
293
print STDERR " DDD eBay GET $sName saved in $fname1\n" if DEBUG_FETCH;
294
} # if
295
# We need to accept the "Mature" disclaimer before we get to see
296
# the requested page. Parse the
297
0
my @aoForm = HTML::Form->parse($sPage, $self->response->base);
298
# The adult-consent form is the last one on the page:
299
0
my $oForm = $aoForm[-1];
300
0
0
unless (ref $oForm)
301
{
302
0
print STDERR " --- eBay adult-consent page's
303
0
return undef;
304
} # unless
305
0
print STDERR " DDD got a FORM...\n" if DEBUG_FETCH;
306
# Submit the form and get our cookie:
307
0
$oReq = $oForm->click;
308
0
$oReq->referer($sURLprev);
309
0
$sURLprev = $sURL;
310
0
print STDERR " DDD giving adult-consent to ebay...\n" if DEBUG_FETCH;
311
0
print STDERR " DDD CLICK is ", Dumper($oReq) if DEBUG_FETCH;
312
0
goto REQUEST_READY;
313
}
314
else
315
{
316
# No special action required, we got the requested page:
317
0
my $sRes = $self->response->headers_as_string;
318
0
if (DEBUG_FETCH && ($sName ne '') && (open PAGE, '>', $fname))
319
{
320
print PAGE "\n\n";
321
print PAGE "\n\n";
322
print PAGE $sPage;
323
close PAGE;
324
print STDERR " DDD eBay GET $sName saved in $fname\n" if DEBUG_FETCH;
325
} # if
326
} # else
327
0
return $sPage;
328
} # fetch_any_ebay_page
329
330
331
=item any_error
332
333
Returns non-zero if there are any error messages in the object.
334
335
=cut
336
337
sub any_error
338
{
339
0
0
1
shift->error ne ''
340
} # any_error
341
342
sub _add_error
343
{
344
0
0
local $" = "";
345
0
shift->{'_error'} .= "@_";
346
} # _add_error
347
348
=item error
349
350
Returns a string, the most recent error message(s).
351
352
=cut
353
354
sub error
355
{
356
0
0
0
1
shift->{'_error'} || '';
357
} # error
358
359
=item clear_errors
360
361
Removes all error messages from the object.
362
363
=cut
364
365
sub clear_errors
366
{
367
0
0
1
shift->{'_error'} = '';
368
} # clear_errors
369
370
371
sub _epoch_of_date
372
{
373
0
0
return UnixDate(&ParseDate(shift), '%s');
374
} # _epoch_of_date
375
376
=item selling_page
377
378
Returns the HTML of the "My Selling" page for this user.
379
380
=cut
381
382
sub selling_page
383
{
384
0
0
1
my $self = shift;
385
0
0
if ($self->{_selling_page} ne '')
386
{
387
0
DEBUG_SELLING && print STDERR " DDD short-circuited _selling_page\n";
388
0
return $self->{_selling_page};
389
} # if
390
0
my $sUserID = $self->{_user};
391
0
my $sPasswordEncrypted = $self->signin();
392
0
print STDERR " DDD sPasswordEncrypted is ===$sPasswordEncrypted===\n" if DEBUG_FETCH;
393
# my $sURL = qq{http://cgi6.ebay.com/aw-cgi/eBayISAPI.dll?MfcISAPICommand=MyeBayItemsSelling&userid=$sUserID&pass=$sPasswordEncrypted&dayssince=30};
394
0
my $sURL = qq{http://cgi6.ebay.com/aw-cgi/ebayISAPI.dll?MyeBayItemsSelling&userid=$sUserID&pass=$sPasswordEncrypted&first=N&sellerSort=3&bidderSort=3&watchSort=3&dayssince=30};
395
0
$sURL = qq{http://my.ebay.com/ws/ebayISAPI.dll?MyeBay&userid=$sUserID&pass=$sPasswordEncrypted&first=N&sellerSort=3&bidderSort=3&watchSort=3&dayssince=30};
396
0
my $sPage = $self->fetch_any_ebay_page($sURL, 'selling');
397
0
$self->{_selling_page} = $sPage;
398
0
return $sPage;
399
} # selling_page
400
401
402
=item watchlist_auctions
403
404
Returns a list of WWW::Ebay::Listing objects.
405
406
Note that any time/dates returned will be U.S. Pacific time zone.
407
408
=cut
409
410
sub watchlist_auctions
411
{
412
0
0
1
my $self = shift;
413
0
0
return @{$self->{raoWatching}} if $self->{raoWatching};
0
414
0
0
my $sFname = shift() || '';
415
0
my $sPage = $self->selling_page;
416
0
0
0
if (($sFname ne '') && (open PAGE, '>', $sFname))
417
{
418
0
print PAGE $sPage;
419
0
0
close PAGE or warn;
420
} # if
421
0
_debug " DDD start parsing webpage...\n" if DEBUG_WATCH;
422
# Date_Init('TZ=US/Pacific');
423
# Our return value, a list of WWW::Search::Result objects:
424
0
my @aoWSR;
425
426
0
0
my $oTree = $self->{_selling_tree} || HTML::TreeBuilder->new_from_content($sPage);
427
0
0
unless (ref $oTree)
428
{
429
0
_debug " --- can not parse the response from ebay\n";
430
0
return ();
431
} # unless
432
0
$self->{_selling_tree} = $oTree;
433
0
my @aoTDtitle = $oTree->look_down(_tag => 'td',
434
class => 'c_Title',
435
colspan => 5,
436
);
437
TITLE_TD_TAG:
438
0
foreach my $oTDtitle (@aoTDtitle)
439
{
440
0
0
next TITLE_TD_TAG unless ref $oTDtitle;
441
0
_debug " DDD got a TDtitle...\n" if DEBUG_WATCH;
442
0
my $oA = $oTDtitle->look_down(_tag => 'a');
443
0
0
next TITLE_TD_TAG unless ref $oA;
444
0
_debug " DDD has an A...\n" if DEBUG_WATCH;
445
0
my $sURL = $oA->attr('href');
446
0
0
my $sTitle = $oA->as_text || next TITLE_TD_TAG;
447
0
_debug " DDD has a title...\n" if DEBUG_WATCH;
448
# Get the parent row:
449
0
my $oTRparent = $oTDtitle->look_up(_tag => 'tr');
450
0
0
next TITLE_TD_TAG unless ref $oTRparent;
451
0
_debug " DDD has a parent TR...\n" if DEBUG_WATCH;
452
# Get the next row:
453
0
my $oTRaunt = $oTRparent->right;
454
0
0
next TITLE_TD_TAG unless ref $oTRaunt;
455
0
_debug " DDD has an aunt TR...\n" if DEBUG_WATCH;
456
# Create a new result item:
457
0
my $oWSR = new WWW::Search::Result;
458
0
$oWSR->add_url($sURL);
459
0
$oWSR->title($sTitle);
460
0
push @aoWSR, $oWSR;
461
# Get the cells of that row:
462
0
my @aoTD = $oTRaunt->look_down(_tag => 'td');
463
COUSIN_TD_TAG:
464
0
foreach my $oTD (@aoTD)
465
{
466
0
0
next COUSIN_TD_TAG unless ref $oTD;
467
0
my $sClass = $oTD->attr('class');
468
0
_debug " DDD has a $sClass TD...\n" if DEBUG_WATCH;
469
0
0
if ($sClass =~ m!price!i)
470
{
471
0
$oWSR->bid_amount($oTD->as_text);
472
0
_debug " DDD has a price TD...\n" if DEBUG_WATCH;
473
} # if CurrentPrice
474
0
0
if ($sClass =~ m!shipping!i)
0
0
0
0
0
0
475
{
476
0
$oWSR->shipping($oTD->as_text);
477
0
_debug " DDD has a shipping TD...\n" if DEBUG_WATCH;
478
} # if CurrentPrice
479
elsif ($sClass =~ m!bids!i)
480
{
481
0
my $s = $oTD->as_text;
482
0
0
$s = 0 if ($s eq '--');
483
0
$oWSR->bid_count(0 + $s);
484
0
_debug " DDD has a bids TD...\n" if DEBUG_WATCH;
485
} # if Bids
486
elsif ($sClass =~ m!bidder!i)
487
{
488
0
$oWSR->bidder($oTD->as_text);
489
0
_debug " DDD has a bidder TD...\n" if DEBUG_WATCH;
490
} # if Bids
491
elsif ($sClass =~ m!seller!i)
492
{
493
0
$oWSR->seller($oTD->as_text);
494
0
_debug " DDD has a seller TD...\n" if DEBUG_WATCH;
495
} # if Bids
496
elsif ($sClass =~ m!watchers!i)
497
{
498
0
$oWSR->watcher_count(0 + $oTD->as_text);
499
0
_debug " DDD has a watchers TD...\n" if DEBUG_WATCH;
500
} # if Watchers
501
elsif ($sClass =~ m!questions!i)
502
{
503
0
$oWSR->question_count(0 + $oTD->as_text);
504
0
_debug " DDD has a questions TD...\n" if DEBUG_WATCH;
505
} # if Questions
506
elsif ($sClass =~ m!timeleft!i)
507
{
508
0
0
my $oWSE = new WWW::Search('Ebay') or next COUSIN_TD_TAG;
509
0
$oWSE->_parse_enddate($oTD->as_text, $oWSR);
510
0
_debug " DDD has an enddate TD...\n" if DEBUG_WATCH;
511
}
512
} # foreach COUSIN_TD_TAG
513
} # foreach TITLE_TD_TAG
514
0
$self->{raoWatching} = \@aoWSR;
515
0
return @aoWSR;
516
} # watchlist_auctions
517
518
519
=item selling_auctions
520
521
Returns a list of WWW::Ebay::Listing objects representing the auctions
522
currently active.
523
524
Note that any time/dates returned will be U.S. Pacific time zone.
525
526
=cut
527
528
sub selling_auctions
529
{
530
0
0
1
my $self = shift;
531
0
0
return @{$self->{raoSelling}} if $self->{raoSelling};
0
532
0
0
my $sFname = shift() || '';
533
0
my $sPage = $self->selling_page;
534
0
0
0
if (($sFname ne '') && (open PAGE, '>', $sFname))
535
{
536
0
print PAGE $sPage;
537
0
0
close PAGE or warn;
538
} # if
539
0
_debug " DDD start parsing webpage...\n" if DEBUG_SELLING;
540
# Date_Init('TZ=US/Pacific');
541
# Our return value, a list of WWW::Ebay::Listing objects:
542
0
my @aoWEL;
543
544
0
0
my $oTree = $self->{_selling_tree} || HTML::TreeBuilder->new_from_content($sPage);
545
0
0
unless (ref $oTree)
546
{
547
0
_debug " --- can not parse the response from ebay\n";
548
0
return ();
549
} # unless
550
0
$self->{_selling_tree} = $oTree;
551
PARSE_SELLING_SECTION:
552
0
while (1)
553
{
554
# This is a fake (infinite) loop which allows us to use 'last'
555
# rather than 'goto'.
556
0
my $iCount = 0;
557
my $oAselling = $oTree->look_down('_tag' => 'span',
558
class => 'B',
559
0
0
sub { $_[0]->as_text eq q(Items I'm Selling) },
560
0
);
561
0
0
if (ref $oAselling)
562
{
563
0
DEBUG_SELLING && _debug(" DDD found for SELLING section: ", $oAselling->as_HTML, "\n");
564
0
$oAselling = $oAselling->look_up(_tag => 'td');
565
0
0
last PARSE_SELLING_SECTION if ! ref($oAselling);
566
0
DEBUG_SELLING && _debug(" DDD parent is ==", $oAselling->as_HTML, "==\n");
567
0
my $s = $oAselling->as_text;
568
0
$s =~ m!\s+\(\s*(\d+)\s+ITEM!i;
569
0
0
$iCount = $1 || 0;
570
0
print STDERR " DDD there should be $iCount SELLING auctions\n" if DEBUG_SELLING;
571
} # if
572
else
573
{
574
0
$self->_add_error("Did not find for SELLING section. ");
575
}
576
0
0
if ($iCount <= 0)
577
{
578
0
last PARSE_SELLING_SECTION;
579
} # if
580
0
my $oTable = $oTree->look_down(_tag => 'table',
581
id => 'Selling',
582
);
583
0
0
if (! ref $oTable)
584
{
585
0
$self->_add_error("Did not find for SELLING section. ");
586
0
last PARSE_SELLING_SECTION;
587
} # if
588
0
my @asColumns = qw( spacer price bids bidder watchers questions time_left );
589
0
DEBUG_SELLING && _debug(" DDD selling is ==", $oTable->as_HTML, "==\n");
590
0
my @aoTR = $oTable->look_down('_tag' => 'tr');
591
# Throw out the header row:
592
0
shift @aoTR;
593
TR:
594
0
while (my $oTR = shift @aoTR)
595
{
596
0
my ($oTD, $s);
597
0
0
next unless ref $oTR;
598
# Got a row containing an auction. Actually they are pairs of
599
# rows; one row has the auction title, the next row has all the
600
# details.
601
0
DEBUG_SELLING && _debug(" DDD containing selling auction title ==", $oTR->as_HTML, "==\n");
602
my $oA = $oTR->look_down('_tag' => 'a',
603
sub
604
{
605
0
0
0
defined($_[0]->attr('href'))
606
&&
607
$_[0]->attr('href') =~ m!ViewItem!
608
},
609
0
);
610
0
0
next TR unless ref $oA;
611
# Make sure this is really an auction title/link:
612
0
0
next TR unless defined($oA->attr('href'));
613
0
my $sURL = $oA->attr('href');
614
0
0
next TR unless ($sURL =~ m!ViewItem!);
615
0
0
next TR unless ($sURL =~ m!item=(\d+)!);
616
0
my $iItem = $1;
617
# OK, we've got an auction.
618
0
my $oWEL = new WWW::Ebay::Listing;
619
0
my $sTitle = $oA->as_text;
620
0
$sTitle =~ s![\s\t\r\n]+\Z!!;
621
0
$oWEL->title($sTitle);
622
0
$oWEL->id($iItem);
623
0
$oWEL->status->listed('yes');
624
0
print STDERR " DDD title ==$sTitle==\n" if DEBUG_SELLING;
625
# Go to the next row, where we should find the auction details:
626
0
$oTR = $oTR->right; # shift @aoTR;
627
0
0
if (! ref($oTR))
628
{
629
0
$self->_add_error("Did not find slave for ITEM. ");
630
0
next TR;
631
} # if
632
0
DEBUG_SELLING && _debug(" DDD containing selling auction details ==", $oTR->as_HTML, "==\n");
633
0
my @aoTD = $oTR->look_down('_tag' => 'td');
634
SELLING_COLUMN:
635
0
foreach my $sCol (@asColumns)
636
{
637
0
$oTD = shift @aoTD;
638
0
0
if (! ref($oTD))
639
{
640
0
$self->_add_error("Did not find for $sCol column. ");
641
0
next TR;
642
} # if
643
0
0
if ($sCol eq 'price')
0
0
0
0
0
644
{
645
0
$s = $oTD->as_text;
646
# Keep just the numeric portion:
647
0
$s =~ tr!.0123456789!!dc;
648
0
0
if ($s !~ m!\d!)
649
{
650
0
$self->_add_error("ITEM's current bid '$s' is not a number. ");
651
0
next TR;
652
} # if
653
# Convert dollars to cents:
654
0
$oWEL->bidmax(int(eval($s) * 100));
655
}
656
elsif ($sCol eq 'bids')
657
{
658
# Column 3 = Number of Bids
659
0
$s = $oTD->as_text;
660
0
0
$s = 0 if $s =~ m!n/a!;
661
0
$oWEL->bidcount($s);
662
}
663
elsif ($sCol eq 'bidder')
664
{
665
# Column 4 = current bidder
666
}
667
elsif ($sCol eq 'watchers')
668
{
669
# Column 5 = number of watchers
670
}
671
elsif ($sCol eq 'questions')
672
{
673
# Column 6 = number of questions
674
}
675
elsif ($sCol eq 'time_left')
676
{
677
# Column 7 = Time Left
678
0
my $sDateRaw = my $sDate = $oTD->as_text;
679
0
$sDate =~ s!d! days!;
680
0
$sDate =~ s!h! hours!;
681
0
$sDate =~ s!m! minutes!;
682
0
my $date = DateCalc('now', " + $sDate");
683
0
my $sDateEnd = _epoch_of_date($date);
684
0
$oWEL->dateend($sDateEnd);
685
0
print STDERR " DDD end date: raw ==$sDateRaw== cooked ==$sDate== date==$date==\n" if DEBUG_SELLING;
686
}
687
} # foreach SELLING_COLUMN
688
0
push @aoWEL, $oWEL;
689
} # while $oTR
690
0
last PARSE_SELLING_SECTION;
691
} # end of fake while(1) loop for PARSE_SELLING_SECTION
692
0
$self->{raoSelling} = \@aoWEL;
693
0
return @aoWEL;
694
} # selling_auctions
695
696
697
=item sold_auctions
698
699
Returns a list of WWW::Ebay::Listing objects representing the auctions
700
that have ended and received bids.
701
702
Note that any time/dates returned will be U.S. Pacific time zone.
703
704
=cut
705
706
sub sold_auctions
707
{
708
0
0
1
my $self = shift;
709
0
0
return @{$self->{raoSold}} if $self->{raoSold};
0
710
0
0
my $sFname = shift() || '';
711
0
my $sPage = $self->selling_page;
712
0
0
0
if (($sFname ne '') && (open PAGE, '>', $sFname))
713
{
714
0
print PAGE $sPage;
715
0
0
close PAGE or warn;
716
} # if
717
0
_debug " DDD start parsing webpage...\n" if DEBUG_SOLD;
718
# Date_Init('TZ=US/Pacific');
719
# Our return value, a list of WWW::Ebay::Listing objects:
720
0
my $oTree;
721
0
0
if (ref $self->{_selling_tree})
722
{
723
0
$oTree = $self->{_selling_tree};
724
0
DEBUG_SOLD && print STDERR " DDD short-circuited _selling_tree\n";
725
}
726
else
727
{
728
0
$oTree = HTML::TreeBuilder->new_from_content($sPage);
729
0
0
unless (ref $oTree)
730
{
731
0
_debug " --- can not parse the response from ebay\n";
732
0
return ();
733
} # unless
734
0
$self->{_selling_tree} = $oTree;
735
}
736
0
my @aoWEL;
737
PARSE_SOLD_SECTION:
738
0
while (1)
739
{
740
0
my $iCount = 0;
741
my $oA = $oTree->look_down('_tag' => 'span',
742
class => 'B',
743
0
0
sub { $_[0]->as_text eq q(Items I've Sold) },
744
0
);
745
0
0
if (ref $oA)
746
{
747
0
DEBUG_SOLD && _debug(" DDD found for SOLD section: ", $oA->as_HTML, "\n");
748
0
$oA = $oA->parent;
749
0
my $s = $oA->as_text;
750
0
$iCount = -1;
751
0
0
if ($s =~ m!\(\s*(\d+)\s+ITEM!i)
752
{
753
0
$iCount = $1;
754
0
DEBUG_SOLD && _debug(" DDD there should be $iCount sold auctions\n");
755
} # if
756
} # if
757
else
758
{
759
0
$self->_add_error("Did not find for SOLD section. ");
760
0
last PARSE_SOLD_SECTION;
761
}
762
0
0
last PARSE_SOLD_SECTION if ($iCount < 0);
763
0
my $oTable = $oTree->look_down(_tag => 'table',
764
id => 'Sold',
765
);
766
0
0
if (! ref $oTable)
767
{
768
0
$self->_add_error("Did not find for SOLD section. ");
769
0
last PARSE_SOLD_SECTION;
770
} # if
771
# print STDERR " DDD sold is ==", $oTable->as_HTML, "==\n" if DEBUG_SOLD;
772
0
my @aoTR = $oTable->look_down(_tag => 'tr',
773
bgcolor => '#f4f4f4',
774
);
775
SOLD_TR:
776
0
while (my $oTR = shift @aoTR)
777
{
778
0
my ($oTD, $s);
779
0
0
next SOLD_TR unless ref $oTR;
780
# Got a row containing an auction. Actually they are groups of
781
# rows; one row has the buyer's ID, the next rows have all the
782
# auctions that person won.
783
0
_debug(" DDD containing seller ==", $oTR->as_HTML, "==\n") if (2 < DEBUG_SOLD);
784
0
my @aoTD = $oTR->look_down(_tag => 'td');
785
# Column 1 = checkbox:
786
0
$oTD = shift @aoTD;
787
# Column 2 = winner:
788
0
$oTD = shift @aoTD;
789
0
my $oA = $oTD->look_down('_tag' => 'strong');
790
0
0
next SOLD_TR unless ref $oA;
791
0
my $sWinnerID = $oA->as_text;
792
# In case this person won one auction, all the details are in
793
# this row:
794
795
0
my $oWEL = new WWW::Ebay::Listing;
796
0
$oWEL->winnerid($sWinnerID);
797
# We know this auction has ended because this is the "sold"
798
# section of the page:
799
0
$oWEL->status->listed('yes');
800
0
$oWEL->status->ended('yes');
801
# Next column = quantity:
802
0
$oTD = shift @aoTD;
803
0
DEBUG_SOLD && _debug(" DDD quantity ==", $oTD->as_HTML, "==\n");
804
# next Column = Bid Price
805
0
$oTD = shift @aoTD;
806
0
0
if (! ref($oTD))
807
{
808
0
$self->_add_error("Did not find for SOLD ITEM end price. ");
809
0
next SOLD_TR;
810
} # if
811
0
DEBUG_SOLD && _debug(" DDD containing EndPrice ==", $oTD->as_HTML, "==\n");
812
0
$s = $oTD->as_text;
813
0
print STDERR " DDD raw End Price is ==$s==\n" if DEBUG_SOLD;
814
0
$s =~ tr!.0123456789!!dc;
815
# Convert dollars to cents:
816
0
my $iBidCents = int((0.005 + $s) * 100);
817
0
print STDERR " DDD Bid Cents is ==$iBidCents==\n" if DEBUG_SOLD;
818
0
$oWEL->bidmax($iBidCents);
819
# next Column = Total Price with shipping. If the buyer has not
820
# done checkout (and the seller has not sent an invoice), this
821
# will be '--'.
822
0
$oTD = shift @aoTD;
823
0
DEBUG_SOLD && _debug(" DDD of total price ==", $oTD->as_HTML, "==\n");
824
0
0
$s = $oTD->as_text || '';
825
0
print STDERR " DDD raw Total Price is ==$s==\n" if DEBUG_SOLD;
826
0
0
if ($s eq '--')
827
{
828
0
$oWEL->shipping('unknown');
829
}
830
else
831
{
832
0
$s =~ tr!.0123456789!!dc;
833
0
0
if ($s !~ m!\d!)
834
{
835
0
$self->_add_error("sold item's total price is not a number. ");
836
0
next SOLD_TR;
837
} # if
838
# Convert dollars to cents:
839
0
my $iTotalCents = int((0.005 + $s) * 100);
840
0
print STDERR " DDD Total Cents is ==$iTotalCents==\n" if DEBUG_SOLD;
841
0
my $iShippingCents = $iTotalCents - $iBidCents;
842
0
$oWEL->shipping($iShippingCents);
843
} # else
844
# Go to the next row:
845
0
$oTR = $oTR->left;
846
0
0
if (! ref $oTR)
847
{
848
0
next SOLD_TR;
849
} # if
850
0
DEBUG_SOLD && _debug(" DDD of next row ==", $oTR->as_HTML, "==\n");
851
0
$oA = $oTR->look_down(_tag => 'a');
852
0
0
next SOLD_TR unless ref $oA;
853
0
DEBUG_SOLD && _debug(" DDD of title ==", $oA->as_HTML, "==\n");
854
0
my $sTitle = $oA->as_text;
855
0
$sTitle =~ s![\s\t\r\n]+\Z!!;
856
0
$oWEL->title($sTitle);
857
0
my $sURL = $oA->attr('href');
858
0
0
next SOLD_TR unless ($sURL =~ m!ViewItem!);
859
0
0
next SOLD_TR unless ($sURL =~ m!item=(\d+)!);
860
0
my $iItem = $1;
861
0
$oWEL->id($iItem);
862
0
push @aoWEL, $oWEL;
863
} # while
864
0
last PARSE_SOLD_SECTION;
865
} # end of fake while(1) loop for PARSE_SOLD_SECTION
866
0
$self->{raoSold} = \@aoWEL;
867
0
return @aoWEL;
868
} # sold_auctions
869
870
871
=item unsold_auctions
872
873
Returns a list of WWW::Ebay::Listing objects representing the auctions
874
that have ended but received no bids.
875
876
Note that any time/dates returned will be U.S. Pacific time zone.
877
878
=cut
879
880
sub unsold_auctions
881
{
882
0
0
1
my $self = shift;
883
0
0
return @{$self->{raoUnsold}} if $self->{raoUnsold};
0
884
0
0
my $sFname = shift() || '';
885
0
my $sPage = $self->selling_page;
886
0
0
0
if (($sFname ne '') && (open PAGE, '>', $sFname))
887
{
888
0
print PAGE $sPage;
889
0
0
close PAGE or warn;
890
} # if
891
0
_debug " DDD start parsing webpage...\n" if DEBUG_UNSOLD;
892
# Date_Init('TZ=US/Pacific');
893
# Our return value, a list of WWW::Ebay::Listing objects:
894
0
my @aoWEL;
895
896
0
0
my $oTree = $self->{_selling_tree} || HTML::TreeBuilder->new_from_content($sPage);
897
0
0
unless (ref $oTree)
898
{
899
0
_debug " --- can not parse the response from ebay\n";
900
0
return ();
901
} # unless
902
0
$self->{_selling_tree} = $oTree;
903
PARSE_UNSOLD_SECTION:
904
0
while (1)
905
{
906
# This is a fake (infinite) loop which allows us to use 'last'
907
# rather than 'goto'.
908
0
my $iCount = 0;
909
0
my $oAunsold = $oTree->look_down('_tag' => 'a',
910
'name' => 'unsold',
911
);
912
0
0
if (ref $oAunsold)
913
{
914
0
print STDERR " DDD found for UNSOLD section: ", $oAunsold->as_HTML, "\n" if DEBUG_UNSOLD;
915
0
my $s = $oAunsold->as_text;
916
0
$s =~ m!\(\s*(\d+)\s+Items?!;
917
0
0
$iCount = $1 || 0;
918
0
print STDERR " DDD there should be $iCount UNSOLD auctions\n" if DEBUG_UNSOLD;
919
} # if
920
0
0
if ($iCount <= 0)
921
{
922
0
last PARSE_UNSOLD_SECTION;
923
} # if
924
0
my $oTable = $oAunsold->look_up('_tag' => 'table');
925
0
0
if (! ref $oTable)
926
{
927
0
$self->_add_error("Did not find master for UNSOLD section. ");
928
0
last PARSE_UNSOLD_SECTION;
929
} # if
930
0
print STDERR " DDD ancestor is ==", $oTable->as_HTML, "==\n" if DEBUG_UNSOLD;
931
# The heart of the matter is in the n-th table over from this one:
932
0
my $iTable = 2;
933
do
934
0
{
935
0
$oTable = $oTable->right;
936
0
0
if (ref $oTable)
937
{
938
0
0
$iTable-- if ($oTable->tag eq 'table');
939
} # if
940
else
941
{
942
# bail!
943
0
$oTable = 0;
944
}
945
} until ($iTable < 1);
946
0
0
if (! ref $oTable)
947
{
948
0
$self->_add_error("Did not find slave for UNSOLD section. ");
949
0
last PARSE_UNSOLD_SECTION;
950
} # if
951
0
print STDERR " DDD n-th TABLE sibling of ancestor is ==", $oTable->as_HTML, "==\n" if DEBUG_UNSOLD;
952
0
my @aoTR = $oTable->look_down('_tag' => 'tr');
953
TR:
954
0
while (my $oTR = shift @aoTR)
955
{
956
0
my ($oTD, $s);
957
0
0
next unless ref $oTR;
958
# Got a row containing an auction. Actually they are pairs of
959
# rows; one row has the auction title, the next row has all the
960
# details.
961
0
print STDERR " DDD containing unsold auction title ==", $oTR->as_HTML, "==\n" if DEBUG_UNSOLD;
962
0
my $oA = $oTR->look_down('_tag' => 'a');
963
0
0
next TR unless ref $oA;
964
# Make sure this is really an auction title/link:
965
0
0
next TR unless defined($oA->attr('href'));
966
0
0
next TR unless ($oA->attr('href') =~ m!ViewItem!);
967
# OK, we've got an auction.
968
0
my $oWEL = new WWW::Ebay::Listing;
969
0
my $sTitle = $oA->as_text;
970
0
$sTitle =~ s![\s\t\r\n]+\Z!!;
971
0
$oWEL->title($sTitle);
972
0
print STDERR " DDD title ==$sTitle==\n" if DEBUG_UNSOLD;
973
0
$oTD = $oA->look_up('_tag' => 'td');
974
0
0
next TR unless ref $oTD;
975
0
$oTD = $oTD->left;
976
0
0
next TR unless ref $oTD;
977
0
print STDERR " DDD containing Item# ==", $oTD->as_HTML, "==\n" if DEBUG_UNSOLD;
978
0
$s = $oTD->as_text;
979
# Delete all but numbers:
980
0
$s =~ tr!0123456789!!dc;
981
0
$oWEL->id($s);
982
0
$oWEL->status->listed('yes');
983
0
$oWEL->status->ended('yes');
984
0
push @aoWEL, $oWEL;
985
} # while $oTR
986
0
last PARSE_UNSOLD_SECTION;
987
} # end of fake while(1) loop for PARSE_UNSOLD_SECTION
988
0
$self->{raoUnsold} = \@aoWEL;
989
0
return @aoWEL;
990
} # unsold_auctions
991
992
# =item get_user_email
993
994
# Takes two arguments: the eBay userid of the person whose email you seek;
995
# and an auction ID in which you and that person were involved together.
996
997
# Returns that user's email address.
998
# If an error occurs, prints an error message to STDOUT and returns empty string.
999
1000
# =cut
1001
1002
# eBay does not allow users to obtain other user's email. We have to
1003
# use ebay's interface to send an email message to another user.
1004
1005
sub _get_user_email_OLD
1006
{
1007
0
0
my $self = shift;
1008
0
my ($sUserID, $iAuctionID) = @_;
1009
0
DEBUG_EMAIL && _debug(" DDD get_user_email($sUserID,$iAuctionID)\n");
1010
1011
#
1012
0
my $sURL = 'http://contact.ebay.com/ws1/eBayISAPI.dll?MfcISAPICommand=ReturnUserEmail&requested=__USER__&frm=284&iid=__AUCTION__&de=off&redirect=0';
1013
0
$sURL =~ s!__USER__!$sUserID!e;
0
1014
0
$sURL =~ s!__AUCTION__!$iAuctionID!e;
0
1015
0
DEBUG_EMAIL && _debug(" DDD url ==$sURL==\n");
1016
0
my $sPage = $self->fetch_any_ebay_page($sURL, 'contact');
1017
0
0
if ($sPage =~ m!\shref="mailto:(.+?)"!)
1018
{
1019
0
return $1;
1020
} # if
1021
0
DEBUG_EMAIL && _debug(" --- parse error: can not parse user-email page\n");
1022
0
return '';
1023
} # _get_user_email_OLD
1024
1025
1026
=item cookie_jar
1027
1028
=cut
1029
1030
sub cookie_jar
1031
{
1032
0
0
1
my $self = shift;
1033
0
0
my $arg = shift() || 0;
1034
0
DEBUG_FUNC && _debug(" DDD Ebay::Session::c_jar($arg)\n");
1035
0
0
if ($arg)
1036
{
1037
# If argument is given, replace current jar:
1038
0
$self->{_cookie_jar} = $arg;
1039
} # if
1040
# If jar is still not defined, create one:
1041
0
0
$self->{_cookie_jar} ||= new HTTP::Cookies;
1042
# Return the jar:
1043
0
$self->{_cookie_jar};
1044
} # cookie_jar
1045
1046
1047
=item user_agent
1048
1049
Returns a user_agent suitable for requesting Ebay webpages.
1050
If you need special processing on your network, you can override this method.
1051
You need to set the cookie_jar to $self->cookie_jar.
1052
1053
=cut
1054
1055
sub user_agent
1056
{
1057
0
0
1
my $self = shift;
1058
0
DEBUG_FUNC && _debug(" DDD Ebay::Session::user_agent()\n");
1059
0
0
if (! ref $self->{_user_agent})
1060
{
1061
0
my $ua = WWW::Search::_load_env_useragent();
1062
0
0
if (! ref $ua)
1063
{
1064
# print STDERR " XXX WWW::Search::_load_env_useragent() failed\n";
1065
0
$ua = new LWP::UserAgent;
1066
0
$ua->env_proxy('yes');
1067
} # if
1068
0
$ua->cookie_jar($self->cookie_jar);
1069
# print STDERR " III ua is $ua\n";
1070
0
$self->{_user_agent} = $ua;
1071
} # if
1072
0
$self->{_user_agent};
1073
} # user_agent
1074
1075
=back
1076
1077
=cut
1078
1079
sub _send_email_form
1080
{
1081
return <
1082
1149
1154
ENDEMAILFORM
1155
0
0
} # _send_email_form
1156
1157
1;
1158
1159
__END__
