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|&nbsp;)+([0-9]+)\/([0-9]+)\/([0-9]+)\s*<br>/o ) {
+    if ( $page && $page->decoded_content =~ /Last Login:(\s|&nbsp;)+([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