#!perl -T
use strict;
use Data::Dumper;
use Test::More tests => 31;
#use Test::More 'no_plan';
use lib 't';
use TestConfig;
# This logs us in only if they have a local config file.
#login_myspace or die "Login Failed - can't run tests";
unless ( $CONFIG->{login} ) {
diag "Running tests without login. If you want to run the full test\n".
"suite (not required), see the README file that came with the\n".
"distribution.";
}
# Some setup
my $response;
my $attempts;
my @friends;
my $myspace;
my $myspace2;
# Offline tests -- no network access or login required
# Create an 'offline' WWW::Myspace object
$myspace = new WWW::Myspace( { auto_login => 0 } );
ok( ref $myspace, 'Create myspace object' );
my $get_login_forms_works = 1;
SKIP: {
# Test _get_login_forms on an offline copy of a login form, to make sure
# the method works even if we don't have network access
my $file = 't/login-forms/latest.html';
if ( ! open INPUT, "<$file" )
{
warn "Unable to open file '$file': $!";
skip 'Failed to open file required for test', 1;
}
undef $/;
my $form = ;
close INPUT;
$/ = "\n";
my @login_forms = $myspace->_get_login_forms( $form );
my $num_login_forms = @login_forms;
ok ( $num_login_forms == 1 ) or $get_login_forms_works = 0;
}
# Remove no-network-access marker file if it remains from a previous test run
unlink("no-network-access");
SKIP: {
# See if we can get the homepage
my $res = $myspace->get_page( 'http://www.myspace.com/' );
if ( $myspace->error ) {
# We failed to get the homepage
warn $myspace->error;
if ( $CONFIG->{login} ) {
# If login tests have been configured, then we have a serious
# problem -- either network access is not working, or Myspace's
# homepage wasn't responding
fail 'Get homepage';
diag "There was a problem accessing the homepage. Login tests\n".
" will still be run, but there is little chance of them\n".
" passing. This could be a network issue or a problem with\n".
" MySpace.\n";
} else
{
# Otherwise, it's likely that the testing machine just doesn't have
# network access. Therefore, skip any tests which would normally
# fail as a result of this. To do this, we create a 'marker' file
# named no-network-access.
diag "Network access doesn't appear to be working. Many tests\n".
" require network access so they must be skipped.\n";
open ( FILE, '>no-network-access' );
print FILE "This file indicates to WWW::Myspace's test suite\n".
" that network tests are not to be run. It can be\n".
" safely removed.\n";
close ( FILE );
}
} else
{
isa_ok ( $res, 'HTTP::Response', 'Get homepage' );
}
# Network tests.
# All tests below require network access.
skip 'Tests require network access', 29 if ( -f 'no-network-access' );
# Make sure we received the US Myspace page and not any other localization
my ( $localization ) = ( $res->decoded_content =~
/header\/([a-z]{2}\-[A-Z]{2})\/mslogo/i );
warn "Myspace seems to be serving pages to you in a language other than\n".
" en-US, and this may break functionality where a WWW::Myspace\n".
" object is used without logging into an account. At present,\n".
" Myspace uses IP-based geolocation and a workaround is not yet\n".
" implemented.\n" unless
is( lc ($localization), lc ('en-US'),
'Homepage (without login) should display en-US localization' );
SKIP: {
# Make sure _get_login_forms worked when we tested it previously,
# because we need it here
skip '_get_login_forms is possibly broken', 1
if ( !$get_login_forms_works );
skip "Didn't get homepage, needed for this test", 1
if ( !defined $res );
# Make sure we can find a login form on the homepage (which we've
# already downloaded)
my @login_forms = $myspace->_get_login_forms( $res->decoded_content );
my $num_login_forms = @login_forms;
if ( $num_login_forms == 1 ) {
pass( 'Found a single login form on homepage' );
} elsif ( $num_login_forms > 1 ) {
pass( 'Found multiple login forms on homepage' );
warn 'More than one login form found on homepage\n';
} else {
fail( 'Found no login forms on homepage' );
warn $myspace->error if $myspace->error;
}
}
# Test is_band
is( $myspace->is_band( 30204716 ), 1,
"is_band identifies band profile correctly" );
is( $myspace->is_band( $CONFIG->{'acct2'}->{'friend_id'} ), 0,
"is_band identifies 3rd party non-band profile correctly" );
#Test get_profile_type for individuals
#76959716
is( $myspace->get_profile_type( 123557), 1,
"get_profile_type identifies personal profile correctly" );
#Test get_profile_type for music
is( $myspace->get_profile_type( 3327112), 2,
"get_profile_type identifies music profile correctly" );
#Test get_profile_type for film
is( $myspace->get_profile_type( 198234322), 3,
"get_profile_type identifies film profile correctly" );
#Test get_profile_type for comedy
is( $myspace->get_profile_type( 45202648), 4,
"get_profile_type identifies comedy profile correctly" );
is( $myspace->friend_user_name( $CONFIG->{'acct2'}->{'friend_id'} ),
$CONFIG->{'acct2'}->{'user_name'}, 'Verify friend_user_name' );
# Test friend_id method
# 1. Check friend_id is returned when passed a link directly to the profile (eg. myspace.com/)
is ($myspace->friend_id("48439059"), 48439059, "Get correct friend_id when passsed myspace.com/");
# 2. check friend_id is returned by url
is ($myspace->friend_id("myspace.com/tomkerswill"), 7875748,
"Get correct friend_id when passed custom URL.");
# 3. check nothing is returned when passed just homepage
#is ( $myspace->friend_id(""), "","Get when URL doesn't correspond to a profile");
SKIP: {
skip "Tests require login", 16 unless $CONFIG->{login};
login_myspace or die "Failed to log into test acct1 - can't run tests";
$myspace = $CONFIG->{'acct1'}->{'myspace'};
isa_ok( $myspace, 'WWW::Myspace', 'Login to acct1' );
$myspace2 = $CONFIG->{'acct2'}->{'myspace'};
isa_ok( $myspace, 'WWW::Myspace', 'Login to acct2' );
ok( $myspace->logged_in, "Login successful for acct1" );
ok( $myspace2->logged_in, "Login successful for acct2" );
# The following URL should display a 'logged in' version of the homepage
$res = $myspace->get_page("http://www.myspace.com/");
# Make sure we received the US Myspace page and not any other
# localization
my ( $localization ) = ( $res->decoded_content =~
/header\/([a-z]{2}\-[A-Z]{2})\/mslogo/i );
warn "After logging into acct1, Myspace appears to serve pages to\n".
" in a language other than than en-US, and this may break\n".
" functionality where a WWW::Myspace object is used without\n".
" logging into an account. At present, this is configured in\n".
" the Account Settings page for the account and WWW::Myspace\n".
" can't currently override this automatically.\n" unless
is( lc ($localization), lc ('en-US'),
'Homepage (after login) should display en-US localization' );
cmp_ok( $myspace->my_friend_id, '==', $CONFIG->{'acct1'}->{'friend_id'},
'Verify friend ID' );
is( $myspace->account_name, $CONFIG->{'acct1'}->{'username'},
'Verify account_name' );
is( $myspace->user_name, $CONFIG->{'acct1'}->{'user_name'},
'Verify user_name' );
# This should return more than 0 friends. If the regexp breaks,
# this'll return something else, like undefined.
cmp_ok( $myspace->friend_count, '>', 0, 'Check friend_count' );
# Get friends
@friends = $myspace->get_friends;
ok( @friends, 'Retreived friend list' );
# if ( @friends != 2 ) {
# diag( 'Account has ' . @friends . ' friends' );
# }
# Check friends who emailed. We get messages from the other test account,
# so this should be greater than 0.
my @friends_who_emailed = $myspace->friends_who_emailed;
cmp_ok( @friends_who_emailed, '>=', 0, 'Retreive friends who emailed' );
# Get someone else's friends (same list, different method).
my @other_friends =
$myspace2->friends_from_profile( $CONFIG->{'acct1'}->{'friend_id'} );
# If we're on the list, our "other_friends" list will be missing us,
# so put us back in for testing.
foreach my $id ( @friends ) {
if ( $id == $CONFIG->{'acct2'}->{'friend_id'} ) {
push( @other_friends, $id );
# They have to be in numerical order to match.
@other_friends = sort( @other_friends );
last;
}
}
@friends = sort @friends;
# The friends and other_friends lists should be identical.
# So first test the length
# 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);
# Now check the elements
SKIP: {
skip "Friend count mismatch, won't test each element", 1 unless
( @other_friends == @friends );
my $friends_pass=1;
for ( my $i = 0; $i < @friends; $i++ ) {
unless ( $friends[$i] == $other_friends[$i] ) {
$friends_pass=0;
diag "Friend1: " . $friends[$i] . ", Friend2: " .
$other_friends[$i] . "\n";
}
}
if ( $friends_pass ) {
pass( 'Check friends_from_profile' )
} else {
fail( 'Check friends_from_profile' )
}
}
# Count the friends in the test group. If we can get more than
# 40 (first page) of friends we should be ok for the rest.?
my @friends_in_group = $myspace->friends_in_group( $CONFIG->{'test_group'} );
SKIP: {
skip "friend_in_group disabled until it can be fixed due to myspace change.", 1;
cmp_ok( @friends_in_group, '>', 41, 'Retreive friends in Perl Group' );
diag( "Counted " . @friends_in_group . " friends in group" );
}
# Post a comment
$response = $myspace->post_comment( $CONFIG->{'acct2'}->{'friend_id'},
"Um, great profile..." );
if ( ( $response =~ /^P/ ) || ( $response eq 'FC' ) ||
( $response eq "FF") ) { $response = 'P' }
warn $myspace->error . "\n" if $myspace->error;
is( $response, 'P', 'Post Comment' );
# Test is_band logged in
is( $myspace2->is_band, 0,
"is_band identifies logged-in non-band profile correctly" );
# Test get_birthdays
my @bd = ( $myspace->get_birthdays );
# We check for a friendID and a valid-looking month in the birthdate.
# In case the test account has no birthdays, we'll pass too.
ok( ( ! @bd ) || ( $bd[0] && ( $bd[1] =~ /Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec/ ) ),
"get_birthday returned a friendID and valid-looking birthday" ) or
warn "get_birthday got friendID " . $bd[0] . ", Bday: " . $bd[1] . " and ".
"returned " . @bd / 2 . " birthdays.\n";
} # Tests requiring login
# Test last_login
if ( $CONFIG->{login} ) {
cmp_ok ( $myspace->last_login( $CONFIG->{'acct2'}->{'friend_id'} ), ">",
time - 86400, "last_login date seems recent" );
} else {
ok ( $myspace->last_login( $CONFIG->{'acct2'}->{'friend_id'} ),
"last_login returns a value" );
}
warn $myspace->error if $myspace->error;
} # Tests requiring network access