#!perl -w
#----------------------------------------------------------#
# FriendsterQuery.pl                                       #
# Placed in public domain by JnZ, 2003.                    #
#----------------------------------------------------------#
use POSIX; 
use MLDBM qw/DB_File/;
    


#----------------------------------------------------------#
($cmd, $param) = @ARGV;
$|             = 1;

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

if ($cmd eq 'profile') {
  if ($param eq 'all') {
    foreach $id (sort keys %profile_cache) {
      next if ($id eq 'self_id');
      my $profile     = $profile_cache{$id};
      my $friend_list = $friend_list_cache{$id};
      &print_profile($profile, $friend_list);
    }
  } else {
    my $id = ($param eq 'self') ? $profile_cache{'self_id'} : $param;
    if (exists $profile_cache{$id}) {
      my $profile     = $profile_cache{$id};
      my $friend_list = $friend_list_cache{$id};
      &print_profile($profile, $friend_list);
    } else {
      print "No such id $id$/";
    }
  }
} elsif ($cmd eq 'friend') {
  my $id = ($param eq 'self') ? $profile_cache{'self_id'} : $param;
  if (exists $friend_list_cache{$id}) {
    my $profile     = $profile_cache{$id};
    my $friend_list = $friend_list_cache{$id};
    &print_friend_list($profile, $friend_list);
  } else {
    print "No such id $id$/";
  }
} elsif ($cmd eq 'delete') {
  my $id = ($param eq 'self') ? $profile_cache{'self_id'} : $param;
  if ((exists $profile_cache{$id}) || (exists $friend_list_cache{$id})) {
    delete $profile_cache{$id}     if (exists $profile_cache{$id}    );
    delete $friend_list_cache{$id} if (exists $friend_list_cache{$id});
    print "Deleted profile and friend list for id $id$/";
  } else {
    print "No such id $id$/";
  }
}

untie %friend_list_cache;
untie %profile_cache;



#----------------------------------------------------------#
sub print_friend_list {
  my ($profile, $friend_list) = @_;
  my $id                      = $profile->{'id'};
  print "[ $id ]$/";
  foreach $friend (@{$friend_list}) {
    printf "  %-10s = %s$/", $friend->{'id'}, $friend->{'name'};
  }
}

#----------------------------------------------------------#
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$/";
}