#!perl -w
#----------------------------------------------------------#
# FriendsterMapper.pl                                      #
# Placed in public domain by JnZ, 2003.                    #
#----------------------------------------------------------#
use HTTP::Cookies;
use HTTP::Request::Common;
use LWP::UserAgent;
use POSIX; 
use MLDBM qw/DB_File/;
    


#----------------------------------------------------------#
($userid, $password, $update) = @ARGV;
$update                       = $update ? $update : '';
$update_profile               = ($update eq 'all') || ($update eq 'profile');
$update_friend_list           = ($update eq 'all') || ($update eq 'friend' );
$num_tries                    = 5;
$max_dist                     = 3;
$base_url                     = 'http://www.friendster.com';
$log_in_url                   = "$base_url/login";
$log_in_userid_field          = 'email';
$log_in_password_field        = 'password';
$log_out_url                  = "$base_url/logout";
$profile_url                  = "$base_url/user.jsp";
$friend_list_url              = "$base_url/friends.jsp";



#----------------------------------------------------------#
&init();
tie(%profile_cache    , 'MLDBM', 'FriendsterProfile'   , O_CREAT | O_RDWR, 0640);
tie(%friend_list_cache, 'MLDBM', 'FriendsterFriendList', O_CREAT | O_RDWR, 0640);

if (exists $profile_cache{'self_id'}) {
  $self_id = $profile_cache{'self_id'};
} else {
  $self_id                  = &get_self_id();
  $profile_cache{'self_id'} = $self_id;
  &flush_cache();
}

@queue = ($self_id);
%dist  = ($self_id => 0);
while ($id = shift @queue) {
  my ($i, $n, $dist)          = ($session_count + 1, scalar(@queue), $dist{$id});
  my ($profile, @friend_list) = ();
  print (('-' x 40) . $/);
  print "[$i] [$dist] [$n] [$id] BEGIN$/";
  $profile = &get_profile($id);
  if ($profile) {
    while ((!$profile->{'name'}) || ($profile->{'name'} eq 'Login')) {
      my $old         = $update_profile;
      $update_profile = 1;
      $profile        = &get_profile($id);
      $update_profile = $old;
      if (!$profile) {
        print "Requeueing [$id]... ";
        push @queue, $id;
        print "OK$/";
        last;
      }
    }
  } else {
    print "Requeueing [$id]... ";
    push @queue, $id;
    print "OK$/";
  }
  if ($profile) {
    @friend_list = &get_friend_list($id);
    while (!scalar(@friend_list)) {
      my $old             = $update_friend_list;
      $update_friend_list = 1;
      @friend_list        = &get_friend_list($id);
      $update_friend_list = $old;
    }
    foreach $friend_id (sort map {$_->{'id'}} @friend_list) {
      next if (exists $dist{$friend_id});
      my $friend_dist = $dist + 1;
      next if ($friend_dist > $max_dist);
      push @queue, $friend_id;
      $dist{$friend_id} = $friend_dist;
    }
  }
  if ($profile) {
    &print_profile($profile, \@friend_list);
  }
  print "[$i] [$dist] [$n] [$id] END$/";
  if ($profile) {
    ++$session_count;
  }
}

untie %friend_list_cache;
untie %profile_cache;
&deinit();

print "END...";
sleep 5;



#----------------------------------------------------------#
sub init {
  $|             = 1;
  $is_logged_in  = 0;
  $session_count = 0;
  $agent         = new LWP::UserAgent();
  $cookie_jar    = new HTTP::Cookies();
  $SIG{'INT'}    = \&exit_nicely;
  $SIG{'KILL'}   = \&exit_nicely;
  $SIG{'QUIT'}   = \&exit_nicely;
  $SIG{'TERM'}   = \&exit_nicely;
  close(STDERR);
  open(STDERR, ">&STDOUT");
  $agent->env_proxy(); 
  $agent->agent("Mozilla/5.0");
  $agent->cookie_jar($cookie_jar);
  &log_in();
  &exit_nicely() unless ($is_logged_in);
}



#----------------------------------------------------------#
sub deinit {
  &log_out();
}



#----------------------------------------------------------#
sub exit_nicely {
  untie %friend_list_cache;
  untie %profile_cache;
  &deinit();
  exit;
}



#----------------------------------------------------------#
sub flush_cache {
  untie %friend_list_cache;
  untie %profile_cache;
  tie(%profile_cache    , 'MLDBM', 'FriendsterProfile'   , O_CREAT | O_RDWR, 0640);
  tie(%friend_list_cache, 'MLDBM', 'FriendsterFriendList', O_CREAT | O_RDWR, 0640);
}



#----------------------------------------------------------#
sub print_profile {
  my ($profile, $friend_list) = @_;
  my $id                      = $profile->{'id'        };
  my $name                    = $profile->{'name'      };
  my $gender                  = $profile->{'gender'    };
  my $status                  = $profile->{'status'    };
  my $age                     = $profile->{'age'       };
  my $occupation              = $profile->{'occupation'};
  my $friend_count            = scalar(@{$friend_list});
  print "[ $id ]$/";
  print "  Name       = $name$/";
  print "  Gender     = $gender$/";
  print "  Status     = $status$/";
  print "  Age        = $age$/";
  print "  Occupation = $occupation$/";
  print "  Friends    = $friend_count$/";
}



#----------------------------------------------------------#
sub cmp_profile {
  my ($p1, $p2) = @_;
  return (
  ($p1->{'name'} eq $p2->{'name'})
      && ($p1->{'gender'    } eq $p2->{'gender'    })
      && ($p1->{'status'    } eq $p2->{'status'    })
      && ($p1->{'age'       } eq $p2->{'age'       })
      && ($p1->{'occupation'} eq $p2->{'occupation'})
  );
}



#----------------------------------------------------------#
sub get_url {
  my ($url)                = @_;
  my ($request, $response) = (GET($url));
  foreach (1 .. $num_tries) {
    $response = $agent->request($request);
    last if ($response->is_success());
    print '.';
  }
  return $response;
}



#----------------------------------------------------------#
sub log_in {
  return if ($is_logged_in);
  print "Logging in... ";
  my $request = POST($log_in_url, [
      $log_in_userid_field   => $userid,
      $log_in_password_field => $password
  ]);
  my $response = $agent->request($request);
  if ($response->code() == 302) {
    $is_logged_in = 1;
    print 'OK';
  } else {
    print $response->status_line();
  }
  print $/;
}



#----------------------------------------------------------#
sub log_out {
  return if (!$is_logged_in);
  print "Logging out... ";
  my $request = GET($log_out_url);
  $cookie_jar->add_cookie_header($request);
  my $response = $agent->request($request);
  $cookie_jar->extract_cookies($response);
  if ($response->is_success()) {
    $is_logged_in = 0;
    print 'OK';
  } else {
    print $response->status_line();
  }
  print $/;
}



#----------------------------------------------------------#
sub get_profile {
  my ($id)    = @_;
  my %profile = ();
  if (($id) && (exists $profile_cache{$id}) && (!$update_profile)) {
    print 'Getting cached profile for ' . ($id ? "id=$id" : "self") . '... ';
    print 'OK';
    %profile = %{$profile_cache{$id}};
  } else {
    print 'Getting fresh profile for ' . ($id ? "id=$id" : "self") . '... ';
    my $response = &get_url($profile_url . ($id ? '?id=' . $id : ''));
    if ($response->is_success()) {
      print 'OK';
      my ($content) = $response->content();
      if ($content =~ m#<title>\s+Error - (.*)\s+</title>#s) {
        print "$1$/";
        return undef;
      }
      ($profile{'id'}) = ($id ? $id : '');
      foreach $item (qw/name gender status age occupation/) {
        $profile{$item} = &get_profile_item($content, $item);
      }
    } else {
      print $response->status_line();
      &exit_nicely;
    }

    if ($id) {
      $profile_cache{$id} = {%profile};
      &flush_cache;
    }
  }
  print $/;
  return \%profile;
}



#----------------------------------------------------------#
sub get_profile_item {
  my ($content, $item, $value) = @_;
  if ($item eq 'name') {
    ($value) = (
      $content =~ m#<title>\s+Friendster - (.*)\s+</title>#s
    );
  } else {
    ($value) = (
      $content =~ m#\u$item:[^\r\n]+[\r\n]+[^\r\n]+[\r\n]+([^\r\n]*)[\r\n]*</td>#s
    );
  }
  $value = defined($value) ? $value : '';
  return $value;
}



#----------------------------------------------------------#
sub get_friend_list {
  my ($id)              = @_;
  my (@friend_list)     = ();
  my ($page, $num_page) = (0, 1);
  if (($id) && (exists $friend_list_cache{$id}) && (!$update_friend_list)) {
    print 'Getting cached friend list for ' . ($id ? "id=$id" : "self") . '... ';
    print 'OK';
    @friend_list = @{$friend_list_cache{$id}};
  } else {
    print 'Getting fresh friend list for ' . ($id ? "id=$id" : "self") . '... ';
    do {
      print (($page + 1) . '/' . $num_page . '... ');
      my $url      = $friend_list_url . '?start=' . ($page * 40) . ($id ? '&id=' . $id : '');
      my $response = &get_url($url);
      if ($response->is_success()) {
        my ($content) = $response->content();
        if ($page == 0) {
          my ($name, $size) = (
            $content =~ m#<b>([^\r\n]*)'s Friends:</b>[\r\n]+&nbsp;\((\d+)\)&nbsp;#s
          );
          $size     = 0 if (!defined($size));
          $num_page = &ceil($size / 40.0);
        }
        while ($content =~ m#<a class=friend href="/user\.jsp\?id=(\d+)"[\r\n]+>([^\r\n]+)</a>#gs) {
          my ($friend_id, $friend_name) = ($1, $2);
          push @friend_list, {'id' => $friend_id, 'name' => $friend_name};
        }
      } else {
        print $response->status_line() . $/;
        &exit_nicely;
      }
      ++$page;
    } while ($page < $num_page);
    print 'OK';

    @friend_list = sort { $a->{'id'} <=> $b->{'id'} } @friend_list;
    if ($id) {
      $friend_list_cache{$id} = [@friend_list];
      &flush_cache;
    }
  }
  print $/;
  return @friend_list;
}



#----------------------------------------------------------#
sub get_self_id {
  my $profile            = &get_profile();
  my @friend_list        = &get_friend_list();
  my @friend_friend_list = ();
  my %id                 = ();
  foreach $friend (@friend_list) {
    push @friend_friend_list, &get_friend_list($friend->{'id'});
  }
  @friend_friend_list = sort { $a->{'id'} cmp $b->{'id'} } @friend_friend_list;
  foreach $friend_friend (@friend_friend_list) {
    my $id = $friend_friend->{'id'};
    if (exists $id{$id}) {
      ++$id{$id};
    } else {
      next if ($friend_friend->{'name'} ne $profile->{'name'});
      my $friend_friend_profile = &get_profile($id);
      if (&cmp_profile($profile, $friend_friend_profile)) {
        $id{$id} = 0 unless exists ($id{$id});
        ++$id{$id};
      }
    }
  }
  my $id = (sort grep { $id{$_} == scalar(@friend_list) } keys %id)[0];
  return $id;
}