r6950 - in /branches/upstream/libwww-myspace-perl/current: Changes META.yml Makefile.PL lib/WWW/Myspace.pm sample_scripts/last_login t/19-find_friend.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Sun Aug 19 19:11:50 UTC 2007
Author: dmn
Date: Sun Aug 19 19:11:50 2007
New Revision: 6950
URL: http://svn.debian.org/wsvn/?sc=1&rev=6950
Log:
[svn-upgrade] Integrating new upstream version, libwww-myspace-perl (0.70)
Modified:
branches/upstream/libwww-myspace-perl/current/Changes
branches/upstream/libwww-myspace-perl/current/META.yml
branches/upstream/libwww-myspace-perl/current/Makefile.PL
branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm
branches/upstream/libwww-myspace-perl/current/sample_scripts/last_login
branches/upstream/libwww-myspace-perl/current/t/19-find_friend.t
Modified: branches/upstream/libwww-myspace-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/Changes?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/Changes (original)
+++ branches/upstream/libwww-myspace-perl/current/Changes Sun Aug 19 19:11:50 2007
@@ -1,6 +1,18 @@
Revision history for WWW::Myspace
-0.69 2007-07-07
+0.70 2007-08-16
+ - Updated captcha handling to stop trying when "FAILURE" is returned by
+ captchakiller.com.
+ - Fixed 0.69 release date.
+ - Added "o" to end of REs in captcha handling routine for efficiency.
+ - Fixed name of login button due to myspace change 8/15/07.
+ - Fixed 19-find_friend.t "skip" warning message.
+ - Updated read_message to work with changed myspace code.
+ - Updated last_login sample script to report error on failure.
+ - Updated last_login method to use Time::ParseDate to better handle
+ UK dates.
+
+0.69 2007-08-14
- Added get_real_name sample script
- Updated Known Issues in Myspace.pm docs to mention that location
must be United States or other location that uses English with
@@ -24,7 +36,8 @@
matching friendIDs.
- Added find_friend sample script in sample_scripts
- Added 19-find_friend.t test.
- - updated get_friends to correctly handle profiles wit no friends at all (not even Tom)
+ - updated get_friends to correctly handle profiles with no friends
+ at all (not even Tom)
- find_friend now returns friends as a list even if there is only one.
- added get_profile_type to for an easy check on type of profile
- added tests for get_profile_type in t/01-login.t
Modified: branches/upstream/libwww-myspace-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/META.yml?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/META.yml (original)
+++ branches/upstream/libwww-myspace-perl/current/META.yml Sun Aug 19 19:11:50 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: WWW-Myspace
-version: 0.69
+version: 0.70
version_from: lib/WWW/Myspace.pm
installdirs: site
requires:
@@ -13,7 +13,7 @@
Params::Validate: 0
Spiffy: 0.24
Test::More: 0
- Time::Local: 0
+ Time::ParseDate: 100.010301
WWW::Mechanize: 1.2
YAML: 0.39
Modified: branches/upstream/libwww-myspace-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/Makefile.PL?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/Makefile.PL (original)
+++ branches/upstream/libwww-myspace-perl/current/Makefile.PL Sun Aug 19 19:11:50 2007
@@ -23,10 +23,11 @@
'Contextual::Return' => 0, # For send_friend_request method
'Locale::SubCountry' => 1.38, # FriendAdder.pm, cool_new_people
'WWW::Mechanize' => 1.20, # Myspace.pm
- 'Time::Local' => 0, # Myspace.pm - last_login method
+# 'Time::Local' => 0, # Myspace.pm - last_login method
'Crypt::SSLeay' => 0.53, # WWW::Mechanize, for SSL access to myspace.com
'Config::General' => 0, # MyBase.pm
'Params::Validate' => 0, # MyBase.pm
+ 'Time::ParseDate' => 100.010301, # Myspace.pm - last_login method.
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'WWW-Myspace-*' },
Modified: branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm (original)
+++ branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm Sun Aug 19 19:11:50 2007
@@ -1,7 +1,7 @@
######################################################################
# WWW::Myspace.pm
# Sccsid: %Z% %M% %I% Delta: %G%
-# $Id: Myspace.pm 463 2007-08-14 18:41:07Z grantg $
+# $Id: Myspace.pm 471 2007-08-16 23:16:34Z grantg $
######################################################################
# Copyright (c) 2005 Grant Grueninger, Commercial Systems Corp.
#
@@ -30,7 +30,8 @@
#use Locale::SubCountry; # moved to cool_new_people to stop warnings
use WWW::Mechanize;
use File::Spec::Functions;
-use Time::Local;
+#use Time::Local;
+use Time::ParseDate;
=head1 NAME
@@ -38,11 +39,11 @@
=head1 VERSION
-Version 0.69
-
-=cut
-
-our $VERSION = '0.69';
+Version 0.70
+
+=cut
+
+our $VERSION = '0.70';
=head1 WARNING
@@ -645,7 +646,7 @@
email => $self->account_name,
password => $self->password
},
- button => 'ctl00$Main$SplashDisplay$ctl01$loginbutton'
+ button => 'ctl00$Main$SplashDisplay$ctl00$loginbutton'
} );
}
@@ -1476,7 +1477,11 @@
=head2 last_login( [friend_id] )
Returns the last login date from the specified profile in Perl "time"
-format.
+format. As of WWW::Myspace 0.70, uses the Time::ParseDate module's
+"parsedate" method to parse the date according to your system's locale
+settings. This was done to allow for UK-style dates, which myspace seems
+to display based either on your profile settings, if you're logged in, or
+based on your IP address if not logged in.
If no friend_id is specified, this method scans the current page
so you can do:
@@ -1503,11 +1508,13 @@
$page = $self->current_page;
}
- if ( $page && $page->decoded_content =~ /Last Login:(\s| )+([0-9]+)\/([0-9]+)\/([0-9]+)\s*<br>/o ) {
+ if ( $page && $page->decoded_content =~ /Last Login:(\s| )+([0-9]+\/[0-9]+\/[0-9]+)\s*<br>/o ) {
# Convert to Perl's time format.
- my $time = "";
- eval { $time = timelocal( 0, 0, 0, $3, $2 - 1, $4 ); };
- $self->error( $@ . "\nDate found was $2/$3/$4" ); # Need to report to the caller if we got an error.
+
+ my $time = parsedate( "$2", DATE_REQUIRED => 1); # From Time::ParseDate
+ $self->error( "Unable to parse date: $1" ) unless $time;
+# eval { $time = timelocal( 0, 0, 0, $3, $2 - 1, $4 ); }; # From Time::Local
+# $self->error( $@ . "\nDate found was $2/$3/$4" ); # Need to report to the caller if we got an error.
# Return it.
return $time;
} else {
@@ -3543,7 +3550,7 @@
# Now we have to yank data out of a messy page.
my $page = $res->decoded_content;
- $page =~ s/[ \t\n\r]+/ /go; # Strip whitespace
+ $page =~ s/[ \t\n\r]+/ /go; # Turn multiple whitespace into single space
# From:
$page =~ /From:.*?friendID=([0-9]+)[^0-9]/io;
@@ -3556,13 +3563,22 @@
$message{'date'} = $1;
# Subject:
- if ( $page =~ />Subject:<.*?<td>([^ <][^<]+)<\/td>/o ) {
+ if ( $page =~ /<th.*?>\s*Subject:\s*<.*?<td>\s*(.*?)\s*<\/td>/smo ) {
$message{'subject'} = $1;
}
# Body:
# $res->decoded_content =~ /<span class="blacktextnb10">.*^(.*)^ <br><br><br>/sm;
- $res->decoded_content =~ /<th>Body:.*?<td>(.*)\s+<br \/><br \/><br \/>/smo;
+ # TODO: Message body works like this:
+ # <th>Body:</th><td>This is a great message<br /><br /><br /></td>
+ # In real life, there's a lot of random whitespace in there.
+ # Myspace adds three br tags after the message.
+ # This RE looks for those tags followed by the </td>. We do this because
+ # it's always possible someone will include an HTML table in the message.
+ # What we really need to do is find the matching closing tag for the body's <td>
+ # tag, but I'm not really sure how to easily do that, so I did this as a
+ # workaround.
+ $page =~ /<th>\s*Body:\s*<\/th>\s*<td>\s*(.*)\s+<br \/>\s*<br \/>\s*<br \/>\s*<\/td>/smo;
$message{'body'} = $1;
# Clean up newlines
@@ -3573,7 +3589,8 @@
$message{'body'} =~ s/\s*$//so; # After
# And they have these BR tags at the beginning of each line...
- $message{'body'} =~ s/^[ \t]*<br \/>[ \t]*//mog;
+ # Not any more - 8/16/07
+# $message{'body'} =~ s/^[ \t]*<br \/>[ \t]*//mog;
# And sometimes they put them elsewhere, so we'll convert those to newlines.
$message{'body'} =~ s/<br \/>/\n/mog;
@@ -6232,7 +6249,7 @@
$captcha_id = "";
if ( $response->is_success ) {
print $response->decoded_content;
- if ( $response->decoded_content =~ /SUCCESS: captcha_id=([\w\-]+)/ ) {
+ if ( $response->decoded_content =~ /SUCCESS: captcha_id=([\w\-]+)/o ) {
$captcha_id = $1;
print "GOT CAPTCHA ID: $captcha_id\n";
} else {
@@ -6250,9 +6267,9 @@
Content => [ api_key => $api_key, method => "get_result", captcha_id => $captcha_id ] );
if ( $response->is_success ) {
print $response->decoded_content;
- next if ( $response->decoded_content =~ /^WAIT/ );
- last if ( $response->decoded_content =~ /^ERROR/ );
- if ( $response->decoded_content =~ /^SUCCESS: captcha_result=\"(.*)\"$/ ) {
+ next if ( $response->decoded_content =~ /^WAIT/o );
+ last if ( $response->decoded_content =~ /^(ERROR|FAILURE)/o );
+ if ( $response->decoded_content =~ /^SUCCESS: captcha_result=\"(.*)\"$/o ) {
$captcha_result = $1;
last;
}
Modified: branches/upstream/libwww-myspace-perl/current/sample_scripts/last_login
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/sample_scripts/last_login?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/sample_scripts/last_login (original)
+++ branches/upstream/libwww-myspace-perl/current/sample_scripts/last_login Sun Aug 19 19:11:50 2007
@@ -13,10 +13,11 @@
my $myspace = new WWW::Myspace( auto_login => 0 );
#unless ( $myspace->logged_in ) { die "Login failed\n" }
-print "Last Login in \"time\" format: " . $myspace->last_login( @ARGV ) . "\n";
+my $time = $myspace->last_login( @ARGV ) or die $myspace->error;
+print "Last Login in \"time\" format: " . $time . "\n";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) =
- localtime( $myspace->last_login );
+ localtime( $time);
print "Last Login: " . ( $mon + 1 ) . "/" . $mday . "/" .
( $year + 1900 ) . "\n";
Modified: branches/upstream/libwww-myspace-perl/current/t/19-find_friend.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/t/19-find_friend.t?rev=6950&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/t/19-find_friend.t (original)
+++ branches/upstream/libwww-myspace-perl/current/t/19-find_friend.t Sun Aug 19 19:11:50 2007
@@ -15,7 +15,7 @@
SKIP: {
my $email = $CONFIG->{acct1}->{username};
- skip "find_friend_email not set in config" unless $email;
+ skip "find_friend_email not set in config", 1 unless $email;
my ( $friend_id ) = $myspace->find_friend( $email );
More information about the Pkg-perl-cvs-commits
mailing list