r9568 - in /trunk/libwww-myspace-perl: Changes META.yml debian/changelog lib/WWW/Myspace.pm samples/get_login_form t/05-message.t

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Sat Nov 17 22:18:22 UTC 2007


Author: gregoa-guest
Date: Sat Nov 17 22:18:22 2007
New Revision: 9568

URL: http://svn.debian.org/wsvn/?sc=1&rev=9568
Log:
New upstream release.

Modified:
    trunk/libwww-myspace-perl/Changes
    trunk/libwww-myspace-perl/META.yml
    trunk/libwww-myspace-perl/debian/changelog
    trunk/libwww-myspace-perl/lib/WWW/Myspace.pm
    trunk/libwww-myspace-perl/samples/get_login_form
    trunk/libwww-myspace-perl/t/05-message.t

Modified: trunk/libwww-myspace-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/Changes?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/Changes (original)
+++ trunk/libwww-myspace-perl/Changes Sat Nov 17 22:18:22 2007
@@ -1,4 +1,36 @@
 Revision history for WWW::Myspace
+
+0.73    2007-11-13
+        - Updated last_login regex to be more sturdy.
+        - Updated get_profile to use long form of URL when passed a friend_id.
+          This works around a myspace bug that causes a stream of "302 Found" errors
+          when accessing certain profiles.
+        - WARNING: POSSIBLE BACKWARD COMPATIBILITY BREAKAGE.
+          send_friend_request now returns "FU" (Failed, User's settings require
+          you to enter a CAPTCHA to add them as a friend).  This might break your scripts
+          if you're checking for "FC", as some CAPTCHAs will now be "FU" instead.
+          Be sure to check for FC and FU if you're looking for CAPTCHAs.
+          For the record, I picked the code as "Failed, User", but since they're requiring
+          you to enter an annoying captcha code, I think it sounds like they're really
+          saying "FU" anyway, don't you?
+        - Fixed bug in get_birthdays that would cause an error stating "Can't
+          'last' outside a loop block" if more than 5 pages were read.
+        - get_birthdays now safety-exists after 10 pages instead of 5 (this exit
+          is solely to prevent endless loops).
+        - Fixed get_comments, broken by myspace change.
+        - get_comments will now retrieve the logged-in user's comments if no friendID
+          is passed.
+        - send_friend_request now retries captcha 5 times if it guesses it incorrectly,
+          and will properly return "FC" or "FU" instead of "F" if it can't guess correctly.
+        - Added expire time and total attempts count ("attempt 1 of x") to captcha handling
+          output.
+        - get_comments now accepts a hash of options including the new "last_comment_time"
+          argument.
+        - get_comments now returns up to 100 pages (5000 comments) of comments instead of
+          50.
+        - Fixed read_message - body RE broken by myspace change.
+        - get_comments now returns comment_id also.
+        - get_comments accepts "last_comment" argument.
 
 0.72    2007-10-10
         - Fixed a bug that would cause get_birthdays to enter an endless loop.

Modified: trunk/libwww-myspace-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/META.yml?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/META.yml (original)
+++ trunk/libwww-myspace-perl/META.yml Sat Nov 17 22:18:22 2007
@@ -1,11 +1,10 @@
---- #YAML:1.0
-name:                WWW-Myspace
-version:             0.72
-abstract:            Access MySpace.com profile information from Perl
-license:             ~
-generated_by:        ExtUtils::MakeMaker version 6.36
-distribution_type:   module
-requires:     
+# 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.73
+version_from: lib/WWW/Myspace.pm
+installdirs:  site
+requires:
     Config::General:               0
     Contextual::Return:            0
     Crypt::SSLeay:                 0.53
@@ -17,8 +16,6 @@
     Time::ParseDate:               100.010301
     WWW::Mechanize:                1.2
     YAML:                          0.39
-meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.2.html
-    version: 1.2
-author:
-    - Grant Grueninger <grantg at cpan.org>
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30

Modified: trunk/libwww-myspace-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/debian/changelog?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/debian/changelog (original)
+++ trunk/libwww-myspace-perl/debian/changelog Sat Nov 17 22:18:22 2007
@@ -1,3 +1,9 @@
+libwww-myspace-perl (0.73-1) UNRELEASED; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at>  Sat, 17 Nov 2007 23:17:16 +0100
+
 libwww-myspace-perl (0.72-1) unstable; urgency=low
 
   [ gregor herrmann ]

Modified: trunk/libwww-myspace-perl/lib/WWW/Myspace.pm
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/lib/WWW/Myspace.pm?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/lib/WWW/Myspace.pm (original)
+++ trunk/libwww-myspace-perl/lib/WWW/Myspace.pm Sat Nov 17 22:18:22 2007
@@ -1,7 +1,7 @@
 ######################################################################
 # WWW::Myspace.pm
 # Sccsid:  %Z%  %M%  %I%  Delta: %G%
-# $Id: Myspace.pm 496 2007-10-11 08:17:05Z grantg $
+# $Id: Myspace.pm 519 2007-11-13 08:03:58Z grantg $
 ######################################################################
 # Copyright (c) 2005 Grant Grueninger, Commercial Systems Corp.
 #
@@ -42,11 +42,11 @@
 
 =head1 VERSION
 
-Version 0.72
-
-=cut
-
-our $VERSION = '0.72';
+Version 0.73
+
+=cut
+
+our $VERSION = '0.73';
 
 =head1 WARNING
 
@@ -217,6 +217,7 @@
     bulletin_posted => qr/Bulletin Has Been Posted/io,
     verify_get_profile => qr/fuseaction=invite\.addfriend/io,
     exceed_usage => qr/User has exceeded their daily use?age/io,
+    user_requires_captcha => qr/settings require that you solve a CAPTCHA/iosm,
     
 );
 
@@ -834,19 +835,71 @@
 =cut
 
 sub get_login_form {
-    
-    my $x = '<form action="http://login.myspace.com/index.cfm?'.
-        'fuseaction=login.process" method="post" name="theForm" '.
-        'id="theForm">' .
-        '<input type=hidden name="email" value="' . $self->account_name .
-        '">' .
-        '<input type=hidden name="password" value="' . $self->password . '">' .
-        '<input type=submit name="ctl00$Main$SplashDisplay$login$loginbutton" '.
-        'value="LOGIN">'.
-        '</form>';
-        
-    return $x;
-    
+
+    # This form is obsolete, but still sorta works. Take this out once the
+    # section below is working.
+     my $x = '<form action="http://login.myspace.com/index.cfm?'.
+         'fuseaction=login.process" method="post" name="theForm" '.
+         'id="theForm">' .
+         '<input type=hidden name="email" value="' . $self->account_name .
+         '">' .
+         '<input type=hidden name="password" value="' . $self->password . '">' .
+         '<input type=submit name="ctl00$Main$SplashDisplay$login$loginbutton" '.
+         'value="LOGIN">'.
+         '</form>';
+         
+     return $x;
+    
+
+    # Clear errors
+    $self->error(0);
+
+    # This used to be a lot easier...
+    # Now that Myspace (ab)uses ASP, we need to:
+    # - Create a fresh browser object
+    my $b = new WWW::Mechanize(quiet=>1, stack_depth=>1, onerror=>undef);
+
+    # - Get the login page
+    my $res = $b->get( "http://www.myspace.com/" );
+    unless ( $res ) {
+        $self->error("Couldn't load home page");
+        return
+    }
+    
+    # - Get the login form
+    my @forms = HTML::Form->parse( $res );
+    my $found_form = 0;
+    my $form = "";
+#   TODO: This is setting found_form, but then the eval below fails stating
+#   that the method "value" must be called on an object.
+#   Setting $form = $forms[1] prevents that error, but the "return $form->make_request->content"
+#   line just returns an escaped URL string, not a form.  Need to find out how to
+#   display a form as HTML output.
+#     foreach $form ( @forms ) {
+#         if ( $form->find_input( 'ctl00$Main$SplashDisplay$ctl00$Email_Textbox' ) ) {
+#             $found_form = 1;
+#             last;
+#         }
+#     }
+#     unless ( $found_form ) {
+#         $self->error( "Couldn't find login form on myspace home page.  ".
+#                       "Email field name may have changed." );
+#         return;
+#     }
+    $form = $forms[1];
+
+    # - Set the account/password inputs
+    # the "value" method will croak if the input isn't found, so we eval it to catch
+    # that.  This way we don't die if/when myspace changes the name of the input field.
+    eval {
+        $form->value( 'ctl00$Main$SplashDisplay$ctl00$Email_Textbox', $self->account_name );
+        $form->value( 'ctl00$Main$SplashDisplay$ctl00$Password_Textbox', $self->password );
+    };
+    if ( $@ ) { $self->error( $@ ); return } # Set error and return if eval had a problem
+
+    # - Return its content
+    return ( $form->make_request->content );
+
 }
 
 #---------------------------------------------------------------------
@@ -1537,7 +1590,8 @@
         $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\s+Login:(\s|&nbsp;)+([0-9]+\/[0-9]+\/[0-9]+)\s*<br\s?\/?>/smo ) {
         # Convert to Perl's time format.
                 
         my $time = parsedate( "$2", DATE_REQUIRED => 1); # From Time::ParseDate
@@ -1613,7 +1667,17 @@
 
     my $re = 'verify_get_profile';
     $re = undef if ( $no_validate );
-    return $self->get_page( "${BASE_URL}${friend_id}", $re );
+    # Myspace bug on 10/25/07: Calling certain profiles (occurred on a Chinese
+    # profile in the test/discovery case myspace.com/1300323889) using the
+    # myspace.com/friend_id format causes a circular redirect.
+    # So now we use the explicit profile request if
+    # we were given a friendID, or the short form if we were given a MySpace URL.
+    if ( $friend_id =~ /^[0-9]+$/o ) {
+        return $self->get_page( 'http://profile.myspace.com/index.cfm?fuseaction='.
+            'user.viewprofile&friendid='.$friend_id, $re );
+    } else {
+        return $self->get_page( "${BASE_URL}${friend_id}", $re );
+    }
 
 }
 
@@ -1788,22 +1852,46 @@
     return (%info);
 }
 
-=head2 get_comments( $friend_id )
+=head2 C<get_comments( friend_id => $friend_id, last_comment_time => time(), last_comment => comment_id )>
 
 Returns a list of hashrefs, like "get_inbox", of comments
 left for the profile indicated by $friend_id.
 
-get_comments returns a maximum of 50 pages of comments (about 2500).  This limit
+Returns the logged-in user's comments if no friend_id is specified.
+
+if last_comment_time is specified, returns comments left at the same time
+or more recently than the time specified.  last_comment_time is a UTC time
+value (i.e. what "time" returns).  This should work as expected if you
+convert your local time, as it is compared to the "time" return value (see
+below), which is also converted to UTC.  For example, "last_comment_time => time - 3600"
+will return all comments left within the last hour.
+"last_comment_time => time( 2007, 11, 01, 14, 00 )" will return comments left since
+2PM Nov 1, 2007 in your server's time zone.  (I might have the format to "time" wrong
+there, but hopefully you get the idea that comment times are given to your server in
+your server's local time and this module converts all those times to UTC for comparison).
+
+If last_comment_id is specified, get_comments will return all comments left AFTER
+the specified comment.  Note that the comment_id might not be a "real" unique
+ID, so this could break.
+
+get_comments returns a maximum of 100 pages of comments (about 5000).  This limit
 was added in version 0.66 to prevent the method from "running away" if myspace
-changes the code for which the method looks when gathering the comments.
+changes the code for which the method looks when gathering the comments.  It was
+updated from 50 to 100 pages in version 0.73.
 
  Each list element contains:
  { 
+   comment_id => $comment_id  # Myspace's unique ID for this comment (might change/break)
    sender => $friend_id, # friendID of the person who sent the comment
    date => $date_time,   # As formatted on MySpace
+   time => $datetime,    # time the comment was left in "time" format.
    comment => $string    # HTML of the comment.
  }
 
+Note: The comment_id is used in myspace's "delete" buttons - it might be a unique
+ID, or it could change in the future.  Try not to depend on it for long-term
+dependencies.  Short-term it might work.
+
 Comments are returned in the order in which they appear on myspace
 (currently most recent first).
 
@@ -1812,23 +1900,34 @@
 =cut
 
 sub get_comments {
-    my ( $friend_id ) = @_;
+
+    my ( $friend_id, %options, $last_comment_time, $last_comment );
+
+    # Parse the arguments properly
+    # Old format: get_comments( $friend_id );
+    # New format: get_comments( friend_id => $friend_id, last_comment_time => time() );
+    if ( @_ > 1 ) {
+        %options = @_;
+        $friend_id = ( $options{'friend_id'} || '' );
+        $last_comment_time = ( $options{'last_comment_time'} || '' );
+        $last_comment = ( $options{'last_comment'} || '' );
+    } else {
+        ( $friend_id ) = @_;
+        $last_comment_time = $last_comment = '';
+    }
+
+    $friend_id = $self->my_friend_id unless ( $friend_id );
     my @comments = ();
     my $url="http://comment.myspace.com/index.cfm?fuseaction=user.viewComments&friendID=".
             $friend_id;
-    my $eventtarget='ctl00$Main$PagedComments$pagingNavigation1$NextLinkButton';
-    my $eventvalidation;
+    my $eventtarget='ctl00$cpMain$PagedComments$pagerTop';
+    my $mspagerstate;
     my $viewstate;
     my $page="";
     my $commentcount;
         
     $self->_die_unless_logged_in( 'get_comments' );
 
-    # only get a maximum of 50 comment pages
-    # this should translate to 2500 comments
-    # and also serves as a safety measure in case 
-    # the method breaks again
-        
     ( $DEBUG ) && print "Getting $url\n";
     $page = $self->get_page( $url );
       
@@ -1845,23 +1944,35 @@
         $self->error("Could not find how many comments are on profile");
         return undef;
     }
-      
-    for (my $i=1;$i<=50;$i++) {
+
+    # only get a maximum of 100 comment pages
+    # this should translate to 5000 comments
+    # and also serves as a safety measure in case 
+    # the method breaks again
+    for (my $i=1;$i<=100;$i++) {
         $page=$self->{current_page};
 
-        push @comments, $self->_get_comments_from_page( $page->decoded_content );
-            
+        push @comments, $self->_get_comments_from_page(
+            page => $page->decoded_content,
+            last_comment_time => $last_comment_time,
+            last_comment => $last_comment
+        );
+
         #make sure we did not get an error
         return undef if ($self->error);
-    
+
+        # Stop if we got the last comment we're supposed to
+        last if ( $last_comment_time && ( $comments[-1]->{'time'} <= $last_comment_time ) );
+
+        # Stop if there's no next button
         last unless ( $self->_next_button( $page->decoded_content ) );
 
-        #get value of form field eventvalidation
-        if ($page->decoded_content =~ /id=\"__EVENTVALIDATION\" value=\"(.*?)\"/o){
-            $eventvalidation=$1;
+        #get value of form field msPagerState
+        if ($page->decoded_content =~ /id=\"___msPagerState\" value=\"(.*?)\"/o){
+            $mspagerstate=$1;
         }
         else {
-            $self->error("get_comments could not determine eventvalidation in form"); 
+            $self->error("get_comments could not determine msPagesState in form"); 
             return undef;
         }
         #get value of form field viewstate
@@ -1872,17 +1983,20 @@
             $self->error("get_comments could not determine viewstate in form");
             return undef; 
         }        
-        
+
+        # Get the next page
+        my $nextpage = $i+1;
+
         #create a form using these values
         my $htmlform=qq{<form name="aspnetForm" method="post" action="/index.cfm?fuseaction=user.viewComments&amp;friendID=$friend_id" id="aspnetForm">}.
                 qq{<input type="hidden" name="__EVENTTARGET" id="__EVENTTARGET" value="$eventtarget" />}.
-                qq{<input type="hidden" name="__EVENTARGUMENT" id="__EVENTARGUMENT" value="" />}.
+                qq{<input type="hidden" name="__EVENTARGUMENT" id="__EVENTARGUMENT" value="$nextpage" />}.
                 qq{<input type="hidden" name="__VIEWSTATE" id="__VIEWSTATE" value="$viewstate" />}.
-                qq{<input type="hidden" name="__EVENTVALIDATION" id="__EVENTVALIDATION" value="$eventvalidation" />}.
+                qq{<input type="hidden" name="___msPagerState" id="___msPagerState" value="$mspagerstate" />}.
                 qq{</form>};        
         my $form=HTML::Form->parse($htmlform,"http://comment.myspace.com/index.cfm");
         
-        ( $DEBUG ) && print "try to submit form to access comments page #",$i+1,"\n";
+        ( $DEBUG ) && print "Sumbitting form to access comments page #",$i+1,"\n";
 
         #submit it and hope for the best
         $self->submit_form({form => $form,no_click=> 1,follow=>0});
@@ -1910,7 +2024,8 @@
 sub _get_comments_from_page {
     # Take a page, return a list of comment data
 
-    my ( $page ) = @_;
+    my ( %opts ) = @_;
+    my $page = $opts{'page'};
     my @comments = ();
 
       # Get to the comments section to avoid mis-reads
@@ -1920,9 +2035,16 @@
     }
 
     # Read the comment data and push it into our array.
-    while ( $page =~ s/.*?UserID=([0-9]+).*?<h4>(.*?)<\/h4>\s*(.*?)\s*<\/textarea>//smo ) {
-        push @comments, { sender => $1, date => $2, comment => $3 };
-        #print "found 1:$1\nfound 2:$2\nfound 3:$3\n";
+    while ( $page =~ s/.*?"deleteList"\s+value="([0-9]+)".*?UserID=([0-9]+).*?<h4>(.*?)<\/h4>\s*(.*?)\s*<\/textarea>//smo ) {
+        unless ( $1 =~ /[0-9]+/o ) {
+            $self->error( "Invalid comment ID: $1" );
+            return;
+        }
+        last if ( $opts{'last_comment'} && ( $opts{'last_comment'} == $1 ) );
+        my $datetime = parsedate( $3 );
+        push @comments, { comment_id => $1, sender => $2, date => $3, comment => $4, 'time' => $datetime };
+        last if ( $opts{'last_comment_time'} && ( $datetime <= $opts{'last_comment_time'} ) );
+#        print "found 1:$1\nfound 2:$2\nfound 3:$3\ndatetime: ". parsedate( $2 )."\n\n";
     }
 
     return @comments;
@@ -2007,7 +2129,6 @@
     
         # Click "Next"
         $page++; ( $DEBUG ) && print "\n\nPage $page:\n";
-        last if ( $page > 5 );  # To prevent endless loop if below doesn't work.
         $self->submit_form( {
             form_name=>'aspnetForm',
             fields_ref=>{ '__EVENTTARGET' => 'ctl00$cpMain$BirthdayList$PagerTop',
@@ -2015,7 +2136,9 @@
                         },
             no_click => 1,
         } );
-    } while ( $self->_next_button );
+      # Loop until there's no next button or we've read 10 pages (to prevent
+      # endless loop if _next_button gets broken)
+    } while ( $self->_next_button && ( $page < 10 ) );
 
     return ( %bd );
 
@@ -3638,18 +3761,15 @@
     }
  
     # Body:
-#   $res->decoded_content =~ /<span class="blacktextnb10">.*^(.*)^                          <br><br><br>/sm;
-    # 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;
+    # Note: If there's a </div> tag within the message itself, we'll only
+    # get the message up to that point.
+    # The checking for the </p> tag differentiates the actual body from the
+    # "spamBody" hidden field, which contains ended stuff we don't want.
+    if ( 
+        $page =~ /Body:\s*<\/p>\s*<div .*?>\s*(.*?)\s+<\/div>/smo
+    ) {
+        $message{'body'} = $1;
+    }
     
     # Clean up newlines
     $message{'body'} =~ s/[\n\r]/\n/go;
@@ -3663,6 +3783,7 @@
 #    $message{'body'} =~ s/^[ \t]*<br \/>[ \t]*//mog;
     
     # And sometimes they put them elsewhere, so we'll convert those to newlines.
+    # (Note: Maybe this shouldn't be done, since the messages *are* HTML after all)
     $message{'body'} =~ s/<br \/>/\n/mog;
     
     return \%message;
@@ -4336,6 +4457,7 @@
         FB  =>  'Failed, this person does not accept friend requests from bands.',
         FA  =>  'Failed, this person requires an email address or last name to add them',
         FC  =>  'Failed, CAPTCHA response requested.',
+        FU  =>  'Failed, CAPTCHA response required by user.',
         FE  =>  'Failed, user has exceeded their daily usage.',
         P   =>  'Passed! Verification string received.',
         F   =>  'Failed, verification string not found on page after posting.',
@@ -4378,7 +4500,12 @@
         #elsif ( $page =~ /CAPTCHA/o ) {
         elsif ( $page =~ $CAPTCHAi ) {
             $captcha_result = $self->_handle_captcha( $1 );
-            $return_code = 'FC' unless ( $captcha_result );
+
+            # If didn't get a captcha result, return the appropriate failure code.
+            unless ( $captcha_result ) {
+                $return_code = 'FC';
+                $return_code = 'FU' if $self->_apply_regex( regex => 'user_requires_captcha' );
+            }
         }
         # Check for "already your friend"
         elsif ( $page =~ /already your friend/io ) {
@@ -4420,7 +4547,24 @@
 
         # Post the add request form
         if ( $captcha_result ) {
-            $res = $self->submit_form( '', 1, '', { 'CAPTCHAResponse' => $captcha_result } );
+            my $count = 0;
+            while ( $captcha_result && ( $page =~ $CAPTCHAi ) ) {
+                # Submit the form
+                $res = $self->submit_form( '', 1, '', { 'CAPTCHAResponse' => $captcha_result } );
+                # See if there's a captcha request on it (means we got it wrong)
+                $page = $self->current_page->decoded_content;
+                $page =~ s/[ \t\n\r]+/ /go;
+                # If so, guess again.
+                if ( $page =~ $CAPTCHAi ) { $captcha_result = $self->_handle_captcha( $1 ); }
+                # Only try 5 times, just in case something else is wrong. Stops infinite loop.
+                $count++; last if ( $count > 5 );
+            }
+            # If we've still got a CAPTCHA code, return the appropriate failure code.
+            if ( $page =~ $CAPTCHAi ) {
+                $return_code = 'FC';
+                $return_code = 'FU' if $self->_apply_regex( regex => 'user_requires_captcha' );
+            }
+
         } else {
              $res = $self->submit_form( { form_no => 1 } );
         }
@@ -6271,10 +6415,12 @@
     
     my $captcha_id = "";
     my $captcha_result = "";
+    my $expire = $self->captcha_tries * 10;
+    print "Expire set to $expire seconds\n";
     my $response = $ua->post( "http://www.captchakiller.com/api.php", 
             Content_Type => 'form-data', 
             Content => [ api_key => $api_key, method => "upload_captcha", 
-            captcha_url => $captcha_url, expire => ( $self->captcha_tries * 10 ), file => [ $upload_filename ] ] );
+            captcha_url => $captcha_url, expire => $expire, file => [ $upload_filename ] ] );
     $captcha_id = "";
     if ( $response->is_success ) {
         print $response->decoded_content;
@@ -6291,7 +6437,7 @@
     
     $captcha_result = "";
     for ( my $cnt = 1; $cnt < $self->captcha_tries; $cnt++ ) {
-        print "ATTEMPT $cnt\n";
+        print "ATTEMPT $cnt of " . $self->captcha_tries . "\n";
         my $response = $ua->post( "http://www.captchakiller.com/api.php", 
             Content => [ api_key => $api_key, method => "get_result", captcha_id => $captcha_id ] );
         if ( $response->is_success ) {

Modified: trunk/libwww-myspace-perl/samples/get_login_form
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/samples/get_login_form?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/samples/get_login_form (original)
+++ trunk/libwww-myspace-perl/samples/get_login_form Sat Nov 17 22:18:22 2007
@@ -3,6 +3,10 @@
 use WWW::Myspace;
 use CGI qw/:standard/;;
 my $myspace = new WWW::Myspace;
+
+my $login_form = $myspace->get_login_form;
+
+die $myspace->error if $myspace->error;
 
 # Display a login form
 print header,

Modified: trunk/libwww-myspace-perl/t/05-message.t
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/t/05-message.t?rev=9568&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/t/05-message.t (original)
+++ trunk/libwww-myspace-perl/t/05-message.t Sat Nov 17 22:18:22 2007
@@ -44,7 +44,7 @@
 	# Check contents
 	my $msgcnt = @{$inbox};
 	cmp_ok( $msgcnt, ">", 0, "Inbox has contents" );
-	warn "get_inbox may not be reading second page. Got $msgcnt messages."
+	diag "get_inbox may not be reading second page. Got $msgcnt messages."
 	    unless ( $msgcnt > 10 );
 	
 	like( $inbox->[0]->{message_id}, qr/^[0-9]+$/,




More information about the Pkg-perl-cvs-commits mailing list