r9764 - in /branches/upstream/libwww-myspace-perl/current: Changes META.yml lib/WWW/Myspace.pm samples/get_inbox
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Sun Nov 25 19:26:33 UTC 2007
Author: dmn
Date: Sun Nov 25 19:26:32 2007
New Revision: 9764
URL: http://svn.debian.org/wsvn/?sc=1&rev=9764
Log:
[svn-upgrade] Integrating new upstream version, libwww-myspace-perl (0.74)
Modified:
branches/upstream/libwww-myspace-perl/current/Changes
branches/upstream/libwww-myspace-perl/current/META.yml
branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm
branches/upstream/libwww-myspace-perl/current/samples/get_inbox
Modified: branches/upstream/libwww-myspace-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/Changes?rev=9764&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/Changes (original)
+++ branches/upstream/libwww-myspace-perl/current/Changes Sun Nov 25 19:26:32 2007
@@ -1,4 +1,15 @@
Revision history for WWW::Myspace
+
+0.74 2007-11-20
+ - Implemented workaround submitted by William in RT issue#30762 - stops
+ get_inbox from hanging on Linux.
+ - Fixed regex used to get Subject line to fix an issue in which
+ a subject line containing an HTML tag would be cut short.
+ - Fixed bug in get_comments that would cause a stream of "uninitialized value"
+ errors.
+ - Fixed a bug in which get_comments would skip the rest of the comments on
+ the page when it reached "last_comment", but continue reading the rest of the
+ comment pages.
0.73 2007-11-13
- Updated last_login regex to be more sturdy.
Modified: branches/upstream/libwww-myspace-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/META.yml?rev=9764&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/META.yml (original)
+++ branches/upstream/libwww-myspace-perl/current/META.yml Sun Nov 25 19:26:32 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.73
+version: 0.74
version_from: lib/WWW/Myspace.pm
installdirs: site
requires:
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=9764&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm (original)
+++ branches/upstream/libwww-myspace-perl/current/lib/WWW/Myspace.pm Sun Nov 25 19:26:32 2007
@@ -1,7 +1,7 @@
######################################################################
# WWW::Myspace.pm
# Sccsid: %Z% %M% %I% Delta: %G%
-# $Id: Myspace.pm 519 2007-11-13 08:03:58Z grantg $
+# $Id: Myspace.pm 526 2007-11-21 03:20:22Z grantg $
######################################################################
# Copyright (c) 2005 Grant Grueninger, Commercial Systems Corp.
#
@@ -42,11 +42,11 @@
=head1 VERSION
-Version 0.73
-
-=cut
-
-our $VERSION = '0.73';
+Version 0.74
+
+=cut
+
+our $VERSION = '0.74';
=head1 WARNING
@@ -1962,7 +1962,7 @@
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 ) );
+ last if ( $self->{_done} );
# Stop if there's no next button
last unless ( $self->_next_button( $page->decoded_content ) );
@@ -2027,6 +2027,7 @@
my ( %opts ) = @_;
my $page = $opts{'page'};
my @comments = ();
+ $self->{_done} = 0;
# Get to the comments section to avoid mis-reads
if ( $page !~ m/Add Comment<\/a>/gs ) {
@@ -2036,15 +2037,20 @@
# Read the comment data and push it into our array.
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" );
+ my $c = { comment_id => $1, sender => $2, date => $3, comment => $4 };
+ unless ( $c->{'comment_id'} =~ /[0-9]+/o ) {
+ $self->error( "Invalid comment ID: $c->{'comment_id'}" );
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";
+
+ if ( $opts{'last_comment'} && ( $opts{'last_comment'} == $c->{'comment_id'} ) ) {
+ $self->{_done}=1; last;
+ }
+ $c->{'time'} = parsedate( $c->{'date'} ) if $c->{'date'};
+ if ( $opts{'last_comment_time'} && ( $c->{'time'} < $opts{'last_comment_time'} ) ) {
+ $self->{_done}=1; last;
+ }
+ push @comments, $c;
}
return @comments;
@@ -3680,20 +3686,58 @@
}
# Return a list of message data from the current page
+# Updated by WZorn to fix hanging problem on Mandriva and RetHat linux.
sub _get_messages_from_page {
my ( %options ) = @_;
my $page = $self->current_page->decoded_content;
my @messages = ();
- while ( $page =~
- s/.*?viewprofile&friendid=([0-9]+).*?(Unread|Read|Sent|Replied).*?messageID=([^&]+)&.*?>([^<]+)<//som ) {
+ my $state = 0; # State Values
+ # 0 - Beginning state, looking for beginning of message block
+ # 1 - In message block, looking for data
+ # Will return to state=0 when we get the last data (messageID and subject)
+ my $sender;
+ my $status;
+ my $msg_id;
+ my $subject;
+
+ open(my $fh, "<", \$page);
+ while ( <$fh> ) {
+ chomp;
last if ( $options{'stop_at'} && ( $options{'stop_at'} == $3 ) );
- push @messages,
- { sender => $1, status => $2, message_id => $3, subject => $4 }
- }
-
+ if(/<td class="messageListCell" align="center">/){
+ # Found beginning of Message block
+ $state = 1;
+ } elsif (/viewprofile&friendid=([0-9]+)/ && $state == 1){
+ $sender = $1;
+ } elsif (/(Unread|Read|Sent|Replied)/ && $state == 1){
+ $status = $1;
+ } elsif (/messageID=([^&]+)&.*?>(.+?)<\/a>/ && $state == 1){
+ $msg_id = $1;
+ $subject = $2;
+ $state = 0; #return to state=0 because we need to start looking for the beginning of the next message block
+
+ push @messages, { sender => $sender, status => $status, message_id=> $msg_id, subject => $subject };
+ if ($DEBUG) { print $sender,"|",$status,"|",$msg_id,"|",$subject,"\n"; }
+ }
+ }
return @messages;
}
+
+# sub _get_messages_from_page {
+#
+# my ( %options ) = @_;
+# my $page = $self->current_page->decoded_content;
+# my @messages = ();
+# while ( $page =~
+# s/.*?viewprofile&friendid=([0-9]+).*?(Unread|Read|Sent|Replied).*?messageID=([^&]+)&.*?>(.+?)<\/a>//som ) {
+# last if ( $options{'stop_at'} && ( $options{'stop_at'} == $3 ) );
+# push @messages,
+# { sender => $1, status => $2, message_id => $3, subject => $4 }
+# }
+#
+# return @messages;
+# }
=head2 inbox
@@ -6547,6 +6591,16 @@
last_login) will fail if your location causes dates to be displayed in a
manner other than month/day/year.
+=item -
+
+Your account must be set to the "classic" profile for the module to work
+when logged in.
+
+=item -
+
+If the method used to go to the next page in get_inbox doesn't work,
+get_inbox can enter an endless loop.
+
=back
=head1 TODO
@@ -6573,6 +6627,10 @@
Add Internationalization (i18n) support.
Centralize all regular expressions into _regex and _apply_regex methods.
+
+Have get_inbox check to see if it's paging properly - i.e. check to see if a
+message on the current page has the same message_id as a message on the
+previous page.
=head1 CONTRIBUTING
Modified: branches/upstream/libwww-myspace-perl/current/samples/get_inbox
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-myspace-perl/current/samples/get_inbox?rev=9764&op=diff
==============================================================================
--- branches/upstream/libwww-myspace-perl/current/samples/get_inbox (original)
+++ branches/upstream/libwww-myspace-perl/current/samples/get_inbox Sun Nov 25 19:26:32 2007
@@ -10,7 +10,7 @@
die $myspace->error if $myspace->error;
print "Getting inbox...\n";
-my $messages = $myspace->inbox;
+my $messages = $myspace->get_inbox('end_page' => 3);
foreach $message ( @{$messages} ) {
if ( ( ! $friend_id ) || ( $friend_id == $message->{sender} ) ) {
More information about the Pkg-perl-cvs-commits
mailing list