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