r8213 - in /trunk/libwww-myspace-perl: Changes MANIFEST META.yml debian/changelog lib/WWW/Myspace.pm lib/WWW/Myspace/Comment.pm lib/WWW/Myspace/Message.pm lib/WWW/Myspace/MyBase.pm sample_scripts/ samples/ t/00-load.t t/01-login.t t/14-photos.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Oct 12 04:51:14 UTC 2007
Author: dmn
Date: Fri Oct 12 04:51:14 2007
New Revision: 8213
URL: http://svn.debian.org/wsvn/?sc=1&rev=8213
Log:
* New upstream release
Adapts to myspace changes
Bug-fixes
Added:
trunk/libwww-myspace-perl/samples/
- copied from r8212, branches/upstream/libwww-myspace-perl/current/samples/
Removed:
trunk/libwww-myspace-perl/sample_scripts/
Modified:
trunk/libwww-myspace-perl/Changes
trunk/libwww-myspace-perl/MANIFEST
trunk/libwww-myspace-perl/META.yml
trunk/libwww-myspace-perl/debian/changelog
trunk/libwww-myspace-perl/lib/WWW/Myspace.pm
trunk/libwww-myspace-perl/lib/WWW/Myspace/Comment.pm
trunk/libwww-myspace-perl/lib/WWW/Myspace/Message.pm
trunk/libwww-myspace-perl/lib/WWW/Myspace/MyBase.pm
trunk/libwww-myspace-perl/t/00-load.t
trunk/libwww-myspace-perl/t/01-login.t
trunk/libwww-myspace-perl/t/14-photos.t
Modified: trunk/libwww-myspace-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/Changes?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/Changes (original)
+++ trunk/libwww-myspace-perl/Changes Fri Oct 12 04:51:14 2007
@@ -1,4 +1,25 @@
Revision history for WWW::Myspace
+
+0.72 2007-10-10
+ - Fixed a bug that would cause get_birthdays to enter an endless loop.
+ - Fixed form name in get_birthdays due to change on myspace.
+ - get_photo_ids now errors properly if called when not logged in,
+ even if a friend_id is passed.
+ - Test 14-photos.t now skips both tests if not logged in.
+ - Added get_birthdays and get_basic_info sample scripts
+ - Added bail out to tests in case WWW::Myspace doesn't compile for some reason.
+ - Renamed sample_scripts -> samples for
+ http://cpants.perl.org/kwalitee/WWW-Myspace
+ - Added use warnings and use strict to Myspace.pm, Comment.pm, FriendRequest.pm,
+ Message.pm, MyBase, Promoter. (not sure how those got left out...?)
+ - Updated MANIFEST
+ - Added Catpcha Killer patch from rt#29773
+ - Fixed login method. Broken by change in "Home" link handling on myspace.
+ - Disabled friend_count test in 01-login.t.
+ - Updated post_comment verification REs; Fixes post_comment method.
+ - Fixed button target handling in send_message; Fixes send_message.
+ - Fixed post_bulletin broken by recent myspace change.
+ - Fixed find_friend URL lookup broken by myspace change.
0.71 2007-09-18
- MAINTENANCE RELEASE:
Modified: trunk/libwww-myspace-perl/MANIFEST
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/MANIFEST?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/MANIFEST (original)
+++ trunk/libwww-myspace-perl/MANIFEST Fri Oct 12 04:51:14 2007
@@ -36,35 +36,37 @@
scripts/approve_friends
scripts/comment_myspace
scripts/message_group
-sample_scripts/already_commented
-sample_scripts/approve_friends
-sample_scripts/browse
-sample_scripts/check_notifications
-sample_scripts/cleanup_inbox
-sample_scripts/cool_new_people
-sample_scripts/delete_friend
-sample_scripts/delete_message
-sample_scripts/friend_changes
-sample_scripts/get_friend_page
-sample_scripts/get_friends
-sample_scripts/get_inbox
-sample_scripts/get_login_form
-sample_scripts/get_real_name
-sample_scripts/search_music
-sample_scripts/send_all
-sample_scripts/send_message
-sample_scripts/send_event_invitations
-sample_scripts/send_group_invitations
-sample_scripts/send_message
-sample_scripts/test_message
-sample_scripts/todo
-sample_scripts/last_login
-sample_scripts/find_friend
-sample_scripts/friends_in_group
-sample_scripts/post_blog
-sample_scripts/post_comment
-sample_scripts/read_message
-sample_scripts/send_friend_request
-sample_scripts/set_random_photo
-sample_scripts/test_next_button
+samples/already_commented
+samples/approve_friends
+samples/browse
+samples/check_notifications
+samples/cleanup_inbox
+samples/cool_new_people
+samples/delete_friend
+samples/delete_message
+samples/friend_changes
+samples/get_birthdays
+samples/get_basic_info
+samples/get_friend_page
+samples/get_friends
+samples/get_inbox
+samples/get_login_form
+samples/get_real_name
+samples/search_music
+samples/send_all
+samples/send_message
+samples/send_event_invitations
+samples/send_group_invitations
+samples/send_message
+samples/test_message
+samples/todo
+samples/last_login
+samples/find_friend
+samples/friends_in_group
+samples/post_blog
+samples/post_comment
+samples/read_message
+samples/send_friend_request
+samples/set_random_photo
+samples/test_next_button
META.yml Module meta-data (added by MakeMaker)
Modified: trunk/libwww-myspace-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/META.yml?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/META.yml (original)
+++ trunk/libwww-myspace-perl/META.yml Fri Oct 12 04:51:14 2007
@@ -1,10 +1,11 @@
-# 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.71
-version_from: lib/WWW/Myspace.pm
-installdirs: site
-requires:
+--- #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:
Config::General: 0
Contextual::Return: 0
Crypt::SSLeay: 0.53
@@ -16,6 +17,8 @@
Time::ParseDate: 100.010301
WWW::Mechanize: 1.2
YAML: 0.39
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Grant Grueninger <grantg at cpan.org>
Modified: trunk/libwww-myspace-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/debian/changelog?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/debian/changelog (original)
+++ trunk/libwww-myspace-perl/debian/changelog Fri Oct 12 04:51:14 2007
@@ -1,3 +1,11 @@
+libwww-myspace-perl (0.72-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ Adapts to myspace changes
+ Bug-fixes
+
+ -- Damyan Ivanov <dmn at debian.org> Fri, 12 Oct 2007 07:50:46 +0300
+
libwww-myspace-perl (0.71-2) UNRELEASED; urgency=low
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
Modified: trunk/libwww-myspace-perl/lib/WWW/Myspace.pm
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/lib/WWW/Myspace.pm?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/lib/WWW/Myspace.pm (original)
+++ trunk/libwww-myspace-perl/lib/WWW/Myspace.pm Fri Oct 12 04:51:14 2007
@@ -1,7 +1,7 @@
######################################################################
# WWW::Myspace.pm
# Sccsid: %Z% %M% %I% Delta: %G%
-# $Id: Myspace.pm 478 2007-09-18 21:12:17Z grantg $
+# $Id: Myspace.pm 496 2007-10-11 08:17:05Z grantg $
######################################################################
# Copyright (c) 2005 Grant Grueninger, Commercial Systems Corp.
#
@@ -14,6 +14,9 @@
# Declare our package.
package WWW::Myspace;
use WWW::Myspace::MyBase -Base;
+use Data::Dumper;
+use warnings;
+use strict;
# *** If you're not familiar with Spiffy, read its docs. To save you
# confusion, one of its features is to add "my $self = shift;" to
@@ -39,11 +42,11 @@
=head1 VERSION
-Version 0.71
-
-=cut
-
-our $VERSION = '0.71';
+Version 0.72
+
+=cut
+
+our $VERSION = '0.72';
=head1 WARNING
@@ -200,8 +203,8 @@
comment_posted => qr/Your Comment has been posted/io,
not_logged_in => qr/You Must Be Logged-In to do That\!/io,
verify_message_sent => qr/Your Message Has Been Sent\!/o,
- comment_p1 => qr/ctl00\$Main\$postComment\$commentTextBox.*<\/form|$NOT_FRIEND_ERROR|($CAPTCHA)|($INVALID_ID)/smio,
- comment_p2 => qr/ctl00\$Main\$postComment\$Button1.*<\/form/smo,
+ comment_p1 => qr/ctl00\$(cp)?Main\$postComment\$commentTextBox.*<\/form|$NOT_FRIEND_ERROR|($CAPTCHA)|($INVALID_ID)/smio,
+ comment_p2 => qr/ctl00\$(cp)?Main\$postComment\$Button1.*<\/form/smo,
comment_approval_msg => qr/This user requires all comments to be approved before being posted/o,
not_friend => qr/$NOT_FRIEND_ERROR/smo,
bulletin_url => qr/fuseaction=bulletin\.edit/io,
@@ -585,19 +588,25 @@
# We probably have an ad or somesuch (started 1/7/2006)
# so explicitly request our Home.
- $self->follow_link(
- url_regex => qr/\.(cfm|aspx?)\?fuseaction=user/i,
-# re=> 'is_logged_in',
- );
-
+ # We can't click "home", because as of 10/10/07 Myspace sets the Home
+ # link using Javascript if you're logged in. Why do the work on the
+ # server when you can just add extra code and do it on the browser instead?
+ # In fact, why not just make all of Myspace run in the browser?
+ $self->follow_to( $HOME_PAGE, '' )
+ or warn "Couldn't go to user's home page";
+
+# ( $DEBUG ) && warn $self->current_page->content;
+
# Verify we're logged in
if ( $self->_apply_regex( regex => 'is_logged_in' ) ) {
$self->logged_in( 1 );
+ warn "Logged in\n" if ( $DEBUG );
} else {
$self->logged_in( 0 );
unless ( $self->error ) {
$self->error( "Login Failed. Couldn't verify load of home page." )
}
+ warn $self->current_page->decoded_content if $DEBUG;
return;
}
@@ -710,7 +719,7 @@
# Initialize basic account/login-specific settings after login
sub _init_account {
- # Get our friend ID from our profile page (which happens to
+ # Get our friend ID from our home page (which happens to
# be the page we go to after logging in).
$self->_get_friend_id( $self->current_page );
@@ -1989,17 +1998,18 @@
my %bd=(); my $page = 1;
do {
- my $page = $self->current_page->decoded_content;
-
- while ( $page =~ s/^.*?friendid=([0-9]+).*?birthday_icon\.gif.*?>\s*(.*?)\s*<//ismo ) {
+ my $page_source = $self->current_page->decoded_content;
+
+ while ( $page_source =~ s/^.*?friendid=([0-9]+).*?birthday_icon\.gif.*?>\s*(.*?)\s*<//ismo ) {
print "$1: $2\n" if ( $DEBUG );
$bd{"$1"}="$2";
}
# Click "Next"
- $page++;
+ $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=>'theForm',
+ form_name=>'aspnetForm',
fields_ref=>{ '__EVENTTARGET' => 'ctl00$cpMain$BirthdayList$PagerTop',
'__EVENTARGUMENT' => $page
},
@@ -2027,7 +2037,7 @@
Defaults to your friendID.
-Croaks if called when not logged in and no friend_id was passed.
+Croaks if called when not logged in.
=cut
@@ -2035,9 +2045,9 @@
my ( %options ) = @_;
- $self->_die_unless_logged_in( 'get_photo_ids' ) unless $options{'friend_id'};
-
- my $friend_id = $options{'friend_id'} ? $options{'friend_id'} : $self->my_friend_id;
+ $self->_die_unless_logged_in( 'get_photo_ids' );
+
+ my $friend_id = $options{'friend_id'} || $self->my_friend_id;
$self->get_profile( $friend_id ) or return;
@@ -2046,6 +2056,7 @@
# If there's a "View All Pictures" link, click it. Otherwise it means
# they only have one album (or myspace changed something again).
$self->follow_link( url_regex => qr/fuseaction\=user\.viewPicture/io );
+ $self->error(undef); # Ignore any error we got.
my $last_id = -1;
my @photo_ids = ();
@@ -2176,9 +2187,9 @@
$self->error( "Must provide an email address in find_friend") unless ( $email );
$self->_go_home or return;
-
- $self->follow_link( url_regex=> qr/fuseaction=find/io ) or return;
-
+
+ $self->follow_to( 'http://search.myspace.com/index.cfm?fuseaction=find', '' ) or return;
+
return unless $self->submit_form( {
form_no => 2,
fields_ref=>{
@@ -3552,7 +3563,7 @@
my $page = $self->current_page->decoded_content;
my @messages = ();
while ( $page =~
- s/.*?UserID=([^;]+);.*?(Unread|Read|Sent|Replied).*?messageID=([^&]+)&.*?>([^<]+)<//som ) {
+ s/.*?viewprofile&friendid=([0-9]+).*?(Unread|Read|Sent|Replied).*?messageID=([^&]+)&.*?>([^<]+)<//som ) {
last if ( $options{'stop_at'} && ( $options{'stop_at'} == $3 ) );
push @messages,
{ sender => $1, status => $2, message_id => $3, subject => $4 }
@@ -3964,7 +3975,8 @@
"$options{'subject'}",
'ctl00$ctl00$Main$Main$sendMessageControl$bodyTextBox' =>
"$options{'message'}",
- # '__EVENTTARGET' => '',
+ '__EVENTTARGET' => 'ctl00$ctl00$Main$Main$sendMessageControl$btnSend',
+ '__EVENTARGUMENT' => ''
},
no_click => 1,
@@ -3978,17 +3990,17 @@
# }
# );
# }
-
-
+
+
$page = $self->current_page->decoded_content;
$page =~ s/[ \t\n\r]+/ /g;
-
+
# Return the result
if (! $submitted ) {
$status = "FN";
} elsif ( $page =~ $CAPTCHAi ) {
$status = "FC"; # They keep changing which page this appears on.
- } elsif ( $page =~ $self->_regex('verify_message_sent') ) {
+ } elsif ( $self->_apply_regex( source => $page, regex => 'verify_message_sent') ) {
$status = "P";
} elsif ( $self->_apply_regex( source => $page, regex => 'exceed_usage' ) ) {
$status = "FE";
@@ -4820,7 +4832,7 @@
my $submitted = $self->submit_form( {
# page => $link->url,
# follow => 1,
- form_no => 3,
+ form_no => 2,
fields_ref => {
'ctl00$cpMain$Subject_Textbox' => $options{'subject'},
'ctl00$cpMain$Body_Textbox' => $options{'message'},
@@ -4841,8 +4853,8 @@
# the Post button, and a secret little bulletinForm form. The Post button
# calls javascript that sets the bulletinForm's action URL and posts it.
# Note that "bulletinForm" is identified by ID, not name, so we just specify
- # form#4 (5th form on the page). Sorry, did I mention one of those forms
- # is just a tag, embedded in another form? So it's form 3, not 4...
+ # form#3 (4th form on the page). Sorry, did I mention one of those forms
+ # is just a tag, embedded in another form? So it's form 2, not 3...
# warn "Submitting Confirmation screen";
# Get the action
$action = '';
@@ -4855,7 +4867,7 @@
return 1 if $options{'testing'};
$submitted = $self->submit_form( {
- form_no => 3,
+ form_no => 2,
action => $action,
no_click => 1,
} );
@@ -5811,8 +5823,8 @@
#---------------------------------------------------------------------
# _get_friend_id( $homepage )
# This internal method stores our friend ID. We get this from the
-# "View All of My Friends" link on the bottom of our profile page (the one
-# we see when we first log in)
+# "View Profile" link on our home page (the page we see when we
+# click the "Home" link in the top nav bar)
sub _get_friend_id {
@@ -6062,16 +6074,18 @@
return 1;
}
- # No, try to click home
- my $home_link = "";
- if ( $home_link = $self->mech->find_link(
- url_regex => qr/fuseaction=user/io
- )
- ) {
+# # No, try to click home
+# # Broken by myspace on 10/10/07 - Home page link set by Javascript.
+# my $home_link = "";
+#
+# if ( $home_link = $self->mech->find_link(
+# url_regex => qr/fuseaction=user([&;]|$|")/io
+# )
+# ) {
# warn "_go_home going to " . $home_link->url . "\n";
- $self->follow_to( $home_link->url ) or return;
- return 1;
- }
+# $self->follow_to( $home_link->url ) or return;
+# return 1;
+# }
# Still here? Load the page explicitly
$self->get_page( $HOME_PAGE ) or return undef;
@@ -6260,7 +6274,7 @@
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, file => [ $upload_filename ] ] );
+ captcha_url => $captcha_url, expire => ( $self->captcha_tries * 10 ), file => [ $upload_filename ] ] );
$captcha_id = "";
if ( $response->is_success ) {
print $response->decoded_content;
@@ -6300,7 +6314,12 @@
print "GOT CAPTCHA URL: $url\n";
my $file = catfile( $self->cache_dir, "captcha$$" );
print "SAVING INTO FILE: $file\n";
- my $res = $self->mech->get( $url, ':content_file' => $file );
+ for ( my $i = 0; $i < 5; $i++ ) {
+ my $res = $self->mech->get( $url, ':content_file' => $file );
+ last if ( -f $file );
+ print "FILE TROUBLE: ", Dumper( $file );
+ }
+ return "" if ( ! -f $file );
my $solution = $self->_use_captcha_killer( $url, $file );
unlink ( $file );
return $solution;
Modified: trunk/libwww-myspace-perl/lib/WWW/Myspace/Comment.pm
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/lib/WWW/Myspace/Comment.pm?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/lib/WWW/Myspace/Comment.pm (original)
+++ trunk/libwww-myspace-perl/lib/WWW/Myspace/Comment.pm Fri Oct 12 04:51:14 2007
@@ -1,10 +1,12 @@
-# $Id: Comment.pm 346 2007-06-06 03:39:09Z grantg $
+# $Id: Comment.pm 486 2007-09-22 20:05:58Z grantg $
package WWW::Myspace::Comment;
use Spiffy -Base;
use Carp;
use File::Spec::Functions;
+use warnings;
+use strict;
=head1 NAME
Modified: trunk/libwww-myspace-perl/lib/WWW/Myspace/Message.pm
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/lib/WWW/Myspace/Message.pm?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/lib/WWW/Myspace/Message.pm (original)
+++ trunk/libwww-myspace-perl/lib/WWW/Myspace/Message.pm Fri Oct 12 04:51:14 2007
@@ -1,4 +1,4 @@
-# $Id: Message.pm 346 2007-06-06 03:39:09Z grantg $
+# $Id: Message.pm 486 2007-09-22 20:05:58Z grantg $
package WWW::Myspace::Message;
@@ -6,6 +6,8 @@
use Carp;
use File::Spec::Functions;
use YAML;
+use warnings;
+use strict;
=head1 NAME
Modified: trunk/libwww-myspace-perl/lib/WWW/Myspace/MyBase.pm
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/lib/WWW/Myspace/MyBase.pm?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/lib/WWW/Myspace/MyBase.pm (original)
+++ trunk/libwww-myspace-perl/lib/WWW/Myspace/MyBase.pm Fri Oct 12 04:51:14 2007
@@ -7,6 +7,8 @@
use Params::Validate;
use Config::General;
use YAML qw'LoadFile DumpFile';
+use warnings;
+use strict;
=head1 NAME
Modified: trunk/libwww-myspace-perl/t/00-load.t
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/t/00-load.t?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/t/00-load.t (original)
+++ trunk/libwww-myspace-perl/t/00-load.t Fri Oct 12 04:51:14 2007
@@ -3,7 +3,7 @@
use Test::More tests => 5;
BEGIN {
- use_ok( 'WWW::Myspace' );
+ use_ok( 'WWW::Myspace' ) or print "bail out! WWW::Myspace not compiling\n";
use_ok( 'WWW::Myspace::Message' );
use_ok( 'WWW::Myspace::Comment' );
use_ok( 'WWW::Myspace::FriendChanges' );
Modified: trunk/libwww-myspace-perl/t/01-login.t
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/t/01-login.t?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/t/01-login.t (original)
+++ trunk/libwww-myspace-perl/t/01-login.t Fri Oct 12 04:51:14 2007
@@ -1,7 +1,7 @@
#!perl -T
use Data::Dumper;
-use Test::More tests => 24;
+use Test::More tests => 23;
#use Test::More 'no_plan';
use lib 't';
@@ -86,7 +86,7 @@
SKIP: {
- skip "Not logged in", 5 unless $CONFIG->{login};
+ skip "Not logged in", 4 unless $CONFIG->{login};
# Get someone else's friends (same list, different method).
my @other_friends =
@@ -106,7 +106,9 @@
@friends = sort @friends;
# The friends and other_friends lists should be identical.
# So first test the length
- is( @other_friends, @friends, 'Check friends_from_profile friend count');
+# Disabled 10/10/07: Deleted friends show up when viewing your own friends,
+# but not when viewing as an "outsider". So this breaks.
+# is( @other_friends, @friends, 'Check friends_from_profile friend count');
#diag( Dumper \@other_friends);
#diag( Dumper \@friends);
Modified: trunk/libwww-myspace-perl/t/14-photos.t
URL: http://svn.debian.org/wsvn/trunk/libwww-myspace-perl/t/14-photos.t?rev=8213&op=diff
==============================================================================
--- trunk/libwww-myspace-perl/t/14-photos.t (original)
+++ trunk/libwww-myspace-perl/t/14-photos.t Fri Oct 12 04:51:14 2007
@@ -9,32 +9,34 @@
my $myspace = $CONFIG->{acct1}->{myspace}; # For sanity
-# Get a list of photo IDs
-my @photo_ids = $myspace->get_photo_ids(
- friend_id => $CONFIG->{acct1}->{friend_id}
- ) or warn $myspace->error;
+SKIP: {
+ skip "Not logged in", 2 unless $CONFIG->{login};
-my ( %friend_ids ) = ();
-my $pass = 1;
-foreach my $id ( @photo_ids ) {
- if ( $friend_ids{ $id } ) {
- $pass=0;
- warn "Found duplicate photo ID $id\n";
- } else {
- $friend_ids{ $id }++;
- warn "Got photoID $id\n";
+ # Get a list of photo IDs
+ warn "Getting photos for $CONFIG->{acct1}->{friend_id}\n";
+ my @photo_ids = $myspace->get_photo_ids(
+ friend_id => $CONFIG->{acct1}->{friend_id}
+ ) or warn $myspace->error;
+
+ my ( %friend_ids ) = ();
+ my $pass = 1;
+ foreach my $id ( @photo_ids ) {
+ if ( $friend_ids{ $id } ) {
+ $pass=0;
+ warn "Found duplicate photo ID $id\n";
+ } else {
+ $friend_ids{ $id }++;
+ warn "Got photoID $id\n";
+ }
}
-}
+
+ # Can't really test 'cause the test account may not have any photos.
+ # ok( ( @photo_ids || ( @photo_ids == 0 ) ),
+ # 'get_photo_ids returned at least one photo' );
+
+ # Check for duplicates
+ ok( $pass, 'No duplicate IDs found' );
-# Can't really test 'cause the test account may not have any photos.
-# ok( ( @photo_ids || ( @photo_ids == 0 ) ),
-# 'get_photo_ids returned at least one photo' );
-
-# Check for duplicates
-ok( $pass, 'No duplicate IDs found' );
-
-SKIP: {
- skip "Not logged in", 1 unless $CONFIG->{login};
# Try to set the default photo.
skip "Need more than 1 photo", 1 unless ( @photo_ids > 1 );
More information about the Pkg-perl-cvs-commits
mailing list