#!/usr/bin/perl 
#
# MyScrape.pl
# Version 1.0
#
# MyScrape is a perl script to mine profile information from
# the social networking site Myspace.com. This script utilizes
# a MySQL backend to store the data, in conjunction with the
# DBDConnect perl module I began to develop to provide
# more friendly access to the Perl DBI.
#
# Usage :
# MyScrape.pl -i USERID
# Currently MyScrape requires the user to specify a
# Myspace profile ID number on the command line to
# mine. Future revisions will give options for recursive
# spidering of the entire Myspace network.
#
#
# By Sam Heller (sheller@marlboro.ed)
# This program is licensed under the same terms
# as perl itself.
#
# March 2006
#########################################

#Includes
use WWW::Mechanize;
use HTTP::Cookies;
use HTML::TokeParser;
use POSIX;
use Getopt::Std;
#DBDConnect.pm must be in the same directory
#as this script.
use DBDConnect;
getopt('i');
###############
# Variable Declaration    
###############

#For DBDConnect
my $driver = "mysql";
my $host = "alex.marlboro.edu";
my $port = 3306;
my $dbuser = "myspace";
my $dbpass = 'mysqlpass';
my $database = "";

#For WWW::Mechanize
my $user = 'jibjabjam@yahoo.com';
my $pass = 'badpass!';
my $UseragentAlias = "Windows Mozilla";
my $CurrentID = $opt_i; #chomp($opt_i); #14796603; #$opt_i;
print "Current ID - $CurrentID\n";
my $TimeoutRetry = 4;
my $ErrorRetry = 2;
my $AutoResume = 1;
my $DEBUG = 1;
my $url;


#Server Interaction Strings
my $BaseURL = 'http://myspace.com/index.cfm?fuseaction=';
my $LoginPage = join '', $BaseURL, 'splash'; 
my $GetProfile = join '', $BaseURL, 'user.viewprofile&friendID=';
my $GetFriends = join '', $BaseURL, 'user.viewfriends&friendID=';
my $GetFriendsPage = join '', $GetFriends, '&page=';

##############
# Object Initialization   
##############

# DBDConnect Object
my $db = dbase($driver, $host, $port, $dbuser, $dbpass, $database)
    or die "Failed to build DBDConnect Object : $!\n";
$db->db_connect("myspace")
    or die "Failed to connect to myspace database : $!\n";

# WWW::Mechanize Object
my $bot = MyspaceConnect($user, $pass);
bless $bot, 'WWW::Mechanize';
print "Initialization Successful\n" if $DEBUG;

print "***************STARTING LOGIN********************\n";
&Login();
print "***************STARTING CHECKID********************\n";
&CheckID();
print "***************STARTING GETPROFILE********************\n";
&GetProfile();
print "***************STARTING GETFRIENDS*******************\n";
&GetFriends();

#########
# Subroutines  
#########

# Build the Mechanize Bot
sub MyspaceConnect(){
    print "MyspaceConnect\n\tBuilding Mechanize Object\n" if $DEBUG;
    my $bot = WWW::Mechanize->new(autocheck => 1);
    $bot->agent_alias( $UseragentAlias );
    $bot->timeout(60);
    my $cookie = HTTP::Cookies->new( file => 'cookie.txt', autosave => 1);
    $bot->cookie_jar($cookie);
    print "\tObject Built\n" if $DEBUG;
    return $bot;
}



############
# Page Retrieval 
############

# Login to Myspace
sub Login(){
    print "Starting Login\n" if $DEBUG;
    &GetPage($LoginPage);
    $bot->form_name('theForm');
    $bot->field('email', $user); 
    $bot->field('password', $pass);
    $bot->click("Submit22");
    if ($bot->find_link( text_regex => qr/Skip this Advertisement/i)){
	$bot->follow_link( text_regex => qr/Skip this Advertisement/i);
	print "LOGIN Successful \n" if $DEBUG;
	}
}

# Get Friends List
sub GetFriends(){ 
    $url = join '', $GetFriends, $CurrentID;
    GetPage($url);
    FriendParse();
}

# Get Profile
sub GetProfile(){
    $url = join '', $GetProfile, $CurrentID;
    GetPage($url);
    ProfileParse();
}


# Get page and deal with errors
sub GetPage() {
    print "GetPage Started \n" if $DEBUG;
    ($url) = @_;
    eval { $bot->get($url) or die "within eval : $!\n"; };
    print "\t Retrieved $url\n";
    # Dealing with a read Timeout
    if ($@ =~ /read timeout/) {
        for ($x = 1; $x <= $TimeoutRetry; $x++){
	    print "Request Timed Out. Retrying $x of $TimeoutRetry";
	    eval {$bot->get($url); };
	    
	    # If theres another read timeout, do nothing
	     if ($@ =~ /read timeout/){}	
	    # If we get a different error, and autoresume is off
	    # get user input
	    elsif ($@ and $AutoResume == 0) {
	        print "\nGet failed : $@\nPress enter to retry or any other key to abort";
	        if (<STDIN> eq "\n") {}
	        else { $x = $TimeoutRetry + 1;}
	    }
	    # If AutoResume is on, then just decrement
	    # the try counter and let the for loop do its work
	    else {
	        print "\nGet failed : $@\nTrying Again";
	        $x--;
	    }
	}
    }
    # If we have an unknown error and
    # Autoresume is off, get user input
    elsif($@ and $AutoResume == 0){
	print "\nGet failed : $@\nPress enter to retry or any other key to abort";
	if (<STDIN> eq "\n") { &GetPage; }
	else { print  "aborting attempt to retrieve", $bot->uri(), "\n"; }
	}
    # If Autoresume is on, call &GetPage again
    elsif ($@ and $AutoResume == 1) {
	for ($x = 1; $x <= $ErrorRetry; $x++){	    
	    print "\nGet failed : $!\n";
	    eval {$bot->get($url);};
	    if ( !($@) ) { $x = $ErrorRetry + 1; }
	    }
	}
    print "GetPage Finished\n" if $DEBUG;
    return $bot;
    }
##########
#Data Parsing 
##########

#Parse Friends page
sub FriendParse(){    
	#Check how many friends they have
	my @Friends;
        $bot->form_name("PageForm");
	my $friendct = $bot->value("friendCount");
        my $pages = ceil($friendct / 40);
	# Sort the Friends
        for ($ct = 1; $ct <= $pages; $ct++){
	    $url = join '', $GetFriends, $CurrentID, '&page=', $ct;
	    &GetPage($url);
	    print "Got Page $ct of $pages at $url \n" if $DEBUG;
	    #Get all the links to user profiles on the page
	    foreach (($bot->find_all_links(url_regex => qr/user.viewprofile/i))){
		#Strip out unwanted Links
		if ($_->text() eq '[IMG]') { } #Image Links
	        elsif($_->text() eq '') {}       #Blank Links
		elsif($_->text() =~ /Back To .* Profile/i) {} #Self Referencing Link
		# Record the one you want
	        else{ 
		    $friendID = $_->url();
		    $friendID =~ s/http.*friendID=//gi;
		    push (@Friends, $friendID);
		}  
	    }  
	}
	#Pass @Friends to FriendWrite subroutine
	FriendWrite(@Friends);
    }
    
#Parse Profile Page
sub ProfileParse(){
    CheckID($CurrentID);
    my @stats;
    print "ProfileParse\(\)\n" if $DEBUG;
    #Pull page content out of the bot for parsing
    print "\t", $bot->uri(), "\n";
    my $profile_page = $bot->content();
    #Build HTML::TokeParser object
    my $parser = new HTML::TokeParser(\$profile_page);
 
    #Get Basic User Information
    my $result;
    print "\tBeginning Parse\n" if $DEBUG;
      while (my $tag = $parser->get_tag("meta"))
	{
	$result =  $tag->[3];
	if ($result =~ /.*meta name="description".*/g)
	    {
	    #Strip out the tags and split into the @stats array
	    $result =~  s/<meta.*Profile - //g;
	    $result =~ s/" \/>//g;
	    @stats = split (', ', $result);
	    #Get rid of the "Years Old" trailing text
	    $stats[1] =~ s/ years Old//gi;
	    #Check the sex, and store M or F 
	    if ($stats[2] eq "Male") { $stats[2] = 'M'; } 
	    if ($stats[2] eq "Female") {$stats[2] = 'F'; }
	    #Get rid of anything else we might have picked up
	    while ($#stats > 5) {pop(@stats);}
	   
	    foreach (@stats) { print "\t\t$_ \n"  if $DEBUG;}
	    
	    }	
       }
	
	#Build a new parser 
	undef $parser;
	$parser = new HTML::TokeParser(\$profile_page);
	print "\tStarting Second Parser\n" if $DEBUG;
	#Get basic demographic information
	my ($status, $religion, $zodiac, $education, $income);
        while (my $tag2 = $parser->get_tag("td"))
	    {
	    if ($tag2->[1]{id} eq "ProfileStatus:") {$status =  $parser->get_trimmed_text("/td");}
	    if($tag2->[1]{id} eq "ProfileReligion:") {$religion = $parser->get_trimmed_text("/td");}
	    if($tag2->[1]{id} eq "ProfileZodiac Sign:") {$zodiac = $parser->get_trimmed_text("/td");}
	    if($tag2->[1]{id} eq"ProfileEducation:") {$education = $parser->get_trimmed_text("/td"); }
	    if($tag2->[1]{id} eq"ProfileIncome:") { $income = $parser->get_trimmed_text("/td"); }
	}
	push (@stats, $status, $religion, $zodiac, $education, $income);
	#Pass @stats to the ProfileWrite subroutine
	foreach (@stats) { print "\t\t$_ \n"  if $DEBUG;}
	ProfileWrite(@stats);
    }

############
# Data Recording 
############
sub ProfileWrite(){
    my (@profile) = @_;
    print "ProfileWrite starting query \n" if $DEBUG;
    my $insert = sprintf("%d, \"%s\",  %d, \"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\", %d", $CurrentID, @profile);
    print "\tInsert String : $insert\n" if $DEBUG;
    my $QueryResult = $db->db_search("scraped", "ProfileID", "profileID = $CurrentID");
    print "\tOne\n";
    $QueryResult =~ s/\n.*//g;
    if ($QueryResult == 0) {
	$db->db_write("Profile", "$insert");
	print "\tTwo\n";
	$db->db_update("ProfileID", "scraped = 0 WHERE profileID = $CurrentID");
	print "\tThree\n";
	}
    }

# Record Friendships
sub FriendWrite(){
    print "FriendWrite Starting\n" if $DEBUG;
    my (@FriendList) = @_;
    CheckID(@FriendList);
    foreach (@FriendList){
	#Make sure this friendship isn't already recorded
	my $Query = "profile1 = $CurrentID AND profile2 = $_ OR profile1 = $_ AND profile2 = $CurrentID";
	my $QueryResult = $db->db_search( "*", "Friends", $Query);
	$QueryResult =~ s/\n.*//g;
	if ($QueryResult == "") {
	    $db->db_write("Friends", "$CurrentID, $_");
	    }
	} 
    }

#Add ID to System
sub CheckID(){
    print "CheckID starting\n" if $DEBUG;
    my (@IDList) = @_;
    if (@IDList != '') {
	my ($tmp) = @_;
	push (@IDList, $tmp);
    }
        foreach(@IDList) {
	    my $QueryResult = $db->db_search("*", "ProfileID", "profileID = $_");
	    $QueryResult =~ s/\n.*//g;
	    if($QueryResult == ""){
		my $input = join ' , ', $_,  0;
		$db->db_write("ProfileID", $input);
	    }
	}
	print "Throuch CheckID\n";
    }



