# A generic person. A person typically is a connection to a remote
# user that types commands into the moo.

package Person;
use Container;
use strict;
use vars qw(@ISA);
use UNIVERSAL qw(isa);
use Verb;
use VerbCall;
use ThingList;
use Text;
use Error;
use Password;
@ISA=qw{Container};

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $this  = Container::new($class,
		# It's important every person have an undefined password
		# by default.
		password => "x",
		
		@_
	);

	$this->perms_w('location',0);
	
	bless ($this, $class);
	
	return $this;
}

# Outputs a collection of text to the user.
# Each seperate item is taken to be a new line.
sub tell {
	my $this=shift;

	foreach (@_) {
		# Need to print out any errors that filtered down to here.
		if (Error::iserror($_)) {
			&{$this->output_callback}($_->message."\r\n");
		}
		elsif ($_) {
			&{$this->output_callback}("$_\r\n");
		}
	}
}

# Takes a line of input from the remote user, parses it, and executes it.
#
# This parser is based loosly on the LambdaMOO parser, see the LambdaMOO
# programmer's manual.
sub parse {
	my $this=shift;
	my $line=shift;

	$this->lastactive(time());

	$line=~s/[\r\n]//g; # have to handle both types of line endings.

	# TODO: compound commands (with "then" and "and").

	# Users can type simple s/// commands as moo commands to repeat the
	# last command with a modification. This is a perl moo, after all ;-)
	# But no s///e commands!
	if ($line=~m!^s/(.*?)/(.*)/([ig]*)$!) {
		# Use private varibles so I can refer to them inside the
		# eval below.
		my $from=$1;
		my $to=$2;
		my $flags=$3;
		$line=$this->lastcommand;
		eval '$line=~s/$from/$to/'.$flags;
		$this->tell("($line)");
	}
	else {
		# Store command line for above code to work on later.
		$this->lastcommand($line);
	}

	# Check to see if they have any command aliases set up.
	if (ref($this->commandaliases) eq 'HASH') {
		my %aliases=%{$this->commandaliases};
		my $alias;
		foreach $alias (keys %aliases) {
			$line=~s/^$alias/$aliases{$alias}/;
		}
	}

	my @words=Text::SplitWords($line);

	my $verbcall=VerbCall->new();
	$verbcall->caller($this);
	$verbcall->words(@words);
	$verbcall->command($line);

	# Check to see if we have a question waiting.
	if (ref($this->question_callback)) {
		# Get rid of the question now. When we call it
		# below, it might want to set a new question.
		my $oldq=$this->question_callback;
		$this->question_callback(undef);
		# Ask the question if what the user said is something it can
		# handle. If so, it should either do it, or return us a 
		# new verbcall.
		my $ret=&{$oldq}($verbcall);
		if ($ret) {
			if (isa($ret,"VerbCall")) {
				$verbcall=$ret;
			}
			else {
				return $ret;
			}
		}
	}

	# Figure out which object is the direct object.
	# The question callback may have already done this.
	if (! $verbcall->direct_object) {
		my @objects=$this->find_nearby_object($verbcall->word('direct_object'));
		if ($#objects > 0) {
			# Use a question callback to figure out which object they 
			# meant. Note that this is a closure, so it can see @objects
			# and $verbcall, etc.
			$this->question_callback(sub {
				my $newverbcall=shift;
				if ($newverbcall->command =~ m/^(\d+)$/ &&
				    $newverbcall->command <= $#objects + 1) {
					$verbcall->direct_object($objects[$newverbcall->command - 1]);
					return $verbcall;
				}
				else {
					return undef;
				}	
			});
			my $n=1;
			return "Which \"".$verbcall->word('direct_object')."\" do you mean?",
				sort(map("\t".$n++.". ".$_->name, @objects));
		}
		else {
			$verbcall->direct_object(shift @objects);
		}
	}
	
	if ($verbcall->direct_object) {
		$this->it($verbcall->direct_object);
	}

	# Figure out which object is the indirect object.
	# The question callback may have already done this.
	if (! $verbcall->indirect_object) {
		my @objects=$this->find_nearby_object($verbcall->word('indirect_object'));
		if ($#objects > 0) {
			# Use a question callback to figure out which object they 
			# meant. Note that this is a closure, so it can see @objects
			# and $verbcall, etc.
			$this->question_callback(sub {
				my $newverbcall=shift;
				if ($newverbcall->command =~ m/^(\d+)$/ &&
				    $newverbcall->command <= $#objects + 1) {
				    	$verbcall->indirect_object($objects[$newverbcall->command - 1]);
					return $verbcall;
				}
				else {
					return undef;
				}
			});
			my $n=1;
			return "Which \"".$verbcall->word('indirect_object')."\" do you mean?",
				sort(map("\t".$n++.". ".$_->name, @objects));
		}
		else {
			$verbcall->indirect_object(@objects);
		}
	}

	# Now find the first object that defines the verb, and run it.
	my $thing;
	my @searchlist=($this);
	# Note that we look at the indirect object first for a reason - sometimes
	# the direct object is bogus if we have an indirect object too.
	push @searchlist, $verbcall->indirect_object if $verbcall->indirect_object;
	push @searchlist, $verbcall->direct_object if $verbcall->direct_object;
	if (isa($this->location,"Room")) {
		push @searchlist,@{$this->location->exits};
	}
	foreach $thing (@searchlist,$this->location) {
		if ($thing) {
			$verbcall->object($thing);
			my $sub=$thing->getverbsub($verbcall);
			if (defined $sub) {
				return $thing->$sub($verbcall);
			}
		}
	}

	return "I don't understand that.";
}

# This is passed a set of credentials - it inspects them and
# returns a value saying if the credentials are sufficient to
# login as this person.
sub login {
	my $this=shift;
	my $loginobject=shift;
	my @credentials=@_;

	my $wasactive=ActiveUser::getactive();
	ActiveUser::setactive($this);
	if (Password::check($credentials[2],$this->password)) {
		# If the person is currently active on a different connection,
		# do redirection.
		if ($this->connected) {
			$this->tell("** Redirecting connection to new port **");
			&{$this->close_callback};
		}
		
		# Now set up this person to output using the correct
		# function.
		$this->output_callback($loginobject->output_callback);
		$this->close_callback($loginobject->close_callback);
		
		# And now instruct the server to replace the old loginobject
		# with this person.
		# FIXME: sorta ugly.
		main::ChangeClientObject($loginobject, $this);

		$this->host($loginobject->host);
		
		# Finish up the redirection:
		if ($this->connected) {
			$this->tell("** Redirecting old connection to this port **");
		}
		else {
			$this->lastlogin(time());
			$this->connected(1);
			$this->tell("** Login ok **");
			# Go home.
			if ($this->location) {
				$this->location->contents_remove($this);
			}
			my $ret=$this->home->contents_add($this);
			$this->location->announce($this,$this->name." has connected.");
		}
		return 1;
	}
	ActiveUser::setactive($wasactive);
	return undef;
}

# On logout, just move the person out of the way.
sub logout {
	my $this=shift;
	$this->connected(undef);
	if (! $this->connected && $this->location) {
		$this->location->contents_remove($this);
		$this->location->announce($this,$this->name." has disconnected.");
		$this->location(undef);
	}
}

sub verb_logout {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	&{$this->close_callback};
	$this->logout;
}

# Pick up all objects in the room.
sub verb_get_all {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my @ret=();
	my $thing;
	my @objects=@{$this->location->contents};
	foreach $thing (@objects) {
		if ($this != $thing) {
			# Just call the get verb to do the work.
			$verbcall->direct_object($thing);
			push @ret,$thing->name.": ".$this->verb_get($verbcall);
		}
	}
	return @ret;
}

sub verb_get {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	if ($verbcall->indirect_object) {
		# This is the more complex case of taking something out of
		# something else.
		if (! isa($verbcall->indirect_object,"Container")) {
			return $verbcall->indirect_object->name." does not contain anything.";
		}
		
		# If a direct object is already listed, the moo may have
		# picked the wrong one, by looking at onjects outside the
		# container. On the other hand, our question callback may have 
		# just turned up the right one. So just make sure it's actually
		# in the container.
		if ($verbcall->direct_object && ! $verbcall->indirect_object->contents_test($verbcall->direct_object)) {
			$verbcall->direct_object(undef);
		}

		# FIXME: I think we may have a potential problem here. Assume
		# we have threads. We try to take foo from bar. Bar contains
		# 2 foo's. We ask which one. While the user is answering, some-
		# one else takes the 2 foo's from bar, and substitutes too more
		# foo's. The user answers, the code block above invalidates
		# their answer. They are prompted again, unexpectedly. Repeat.

		if (! $verbcall->direct_object) {
			my @objects=$verbcall->caller->find_object($verbcall->word('direct_object'), @{$verbcall->indirect_object->contents});
			if ($#objects > 0) {
				# Use a question callback to figure out which object they 
				# meant. Note that this is a closure, so it can see @objects
				# and $verbcall, etc.
				$this->question_callback(sub {
					my $newverbcall=shift;
					if ($newverbcall->command =~ m/^(\d+)$/ &&
					    $newverbcall->command <= $#objects + 1) {
						$verbcall->direct_object($objects[$newverbcall->command - 1]);
						return $verbcall;
					}
					else {
						return undef;
					}
				});
				my $n=1;
				return "Which \"".$verbcall->word('direct_object')."\" do you mean?",
					sort(map("\t".$n++.". ".$_->name, @objects));
			}
			else {
				$verbcall->direct_object(shift @objects);
			}
		}

		if (! $verbcall->direct_object) {
			return "There is no ".$verbcall->word('direct_object')." in ".$verbcall->indirect_object->name.".";
		}
		# Be sure to set $it now that we know what the d.o. is.
		$this->it($verbcall->direct_object);
	}
	
	if (! $verbcall->direct_object) {     
		if (lc($verbcall->word('direct_object')) eq 'all') {
			return $this->verb_get_all($verbcall);
		}
		return "Take what?";
	}
	
	# Test to see if they are already holding the object.
	if ($this->contents_test($verbcall->direct_object)) {
		return "You already have that!";
	}
	
	# Test to see if they are inside the object.
	if ($verbcall->direct_object == $this->location) {
		return "You're inside that!";
	}

	# Test for self pickups.
	if ($verbcall->direct_object == $this) {
		return "Pick yourself up by what? Your bootstraps?";
	}	

	# Test to make sure the object can be taken.
	if (! $verbcall->direct_object->perms_w('location')) {
		return Text::subst($verbcall->direct_object->take_fail_msg, {
				name => $verbcall->direct_object->name,
			});
	}

	if ($verbcall->indirect_object) {
		$verbcall->caller->location->announce($verbcall->caller,$verbcall->caller->name." removes ".$verbcall->direct_object->name." from ".$verbcall->indirect_object->name.".");
	}
	else {
		$verbcall->caller->location->announce($verbcall->caller,$verbcall->caller->name." picks up ".$verbcall->direct_object->name.".");
	}
	if ($verbcall->direct_object->location) {
		$verbcall->direct_object->location->contents_remove($verbcall->direct_object);
	}	
	$this->contents_add($verbcall->direct_object);

	return Text::subst($verbcall->direct_object->take_msg, {
			name => $verbcall->direct_object->name,
		});
}

# Drop all objects in your possession.
sub verb_drop_all {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my @ret=();
	my $thing;
	my @objects=@{$this->contents};
	foreach $thing (@objects) {
		next if !$thing;
		# Just call the drop verb to do the work.
		$verbcall->direct_object($thing);
		push @ret,$thing->name.": ".$this->verb_drop($verbcall);
	}
	return @ret;
}

sub verb_drop {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

        if (! $verbcall->direct_object) {
		if (lc($verbcall->word('direct_object')) eq 'all') {
			return $this->verb_drop_all($verbcall);
		}
		return "Drop what?";
	}

	# Test to make sure they are holding the object.
	if ($verbcall->direct_object->location != $this) {
		return "You arn't holding that.";
	}

	if ($verbcall->caller->location) {
		$verbcall->caller->location->announce($verbcall->caller,$verbcall->caller->name." drops ".$verbcall->direct_object->name.".");
	}	
	$this->contents_remove($verbcall->direct_object);
	$this->location->contents_add($verbcall->direct_object);

	return Text::subst($verbcall->direct_object->drop_msg, {
			name => $verbcall->direct_object->name,
		});
	return $_;
}

# This is the case of putting one object into another.
sub verb_put {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	# There are so many potential ways this verb can go wrong..
	if (! $verbcall->direct_object) {
		return "Put what?";
	}
	if (! $verbcall->indirect_object) {
		return "Put ".$verbcall->direct_object->name." where?";
	}
	if (! isa($verbcall->indirect_object,"Container")) {
		return $verbcall->indirect_object->name." cannot hold anything.";
	}
	if (isa($verbcall->direct_object,"Person") && ! isa($verbcall->indirect_object,"Room")) {
		return "You cannot put a person there.";
	}
	if ($verbcall->direct_object == $verbcall->indirect_object) {
		return "You can't put something inside itself!";
	}
	if ($verbcall->indirect_object == $this) {
		# This is a special case that's the same as getting something.
		$verbcall->indirect_object(undef);
		return $this->verb_get($verbcall);
	}
	if ($verbcall->direct_object == $this && !isa($verbcall->indirect_object,"Room")) {
		# I don't support this, just becuase it can go wrong in so
		# many ways. Ie, if you put your self in something you are 
		# holding.
		return "You can't put yourself there.";
	}
	if ($verbcall->direct_object == $this->location) {
		# This is just silly.
		return "You're inside that!";
	}
	$verbcall->caller->location->announce($verbcall->caller,$verbcall->caller->name." puts ".$verbcall->direct_object->name." in ".$verbcall->indirect_object->name.".");
	if ($verbcall->direct_object->location) {
		$verbcall->direct_object->location->contents_remove($verbcall->direct_object);
	}	
	$verbcall->indirect_object->contents_add($verbcall->direct_object);

	return Text::subst($verbcall->indirect_object->put_msg, {
			name => $verbcall->indirect_object->name,
			thing => $verbcall->direct_object->name,
		});
}

# A person's look shows what they are holding, and if they have been idle.
sub look {
	my $this=shift;

	# Let others know if we're connected, and/or idle.
	my $state;
	if ($this->connected) {
		my $idle=time() - $this->lastactive;
		if ($idle < 15) { # number may need tuning
			# TODO: use genders here.
			$state="This person is awake and looks alert.";
		}
		else {
			$state="This person has been staring off into space for ".Text::prettytime($idle);
		}
	}
	else {
		$state="This person is asleep";
	}
	
	return($this->name,$this->description,$state,$this->listobjects(ActiveUser::getactive));
}

sub verb_inventory {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	return($this->listobjects($verbcall->caller) || "You are empty-handed.");
}

# Set the person's password (if they give the correct old one).
sub verb_password {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	if (Password::check($verbcall->word('direct_object'),$this->password)) {
		$this->password(Password::encrypt($verbcall->word('preposition')));
		return "Password set.";
	}
	else {
		return "That's not your old password.";
	}
}

# Override the location method so that whenever a person moves somewhere,
# they are shown the new location.
sub location {
	my $this=shift;
	if (@_) {
		my $newloc=shift;
		if (Container::location($this) != $newloc) {
			Container::location($this,$newloc);
			if ($newloc) {
				$this->tell($newloc->look);
			}
		}
	}
	Container::location($this);
}

# Passed a string that represents an object that should be near to the person,
# returns the actual object the string refers to, (or undef if it can't find
# it). By nearby, I mean, the person has to be holding it, or it's in the room
# with them. Or, they can use #nnn or $xxx to refer to some other object.
#
# Understands the use of "it", "me" and "here" as special object specifiers.
# Also understands the use of $xxx generic object specifiers, if a 
# Generics object is in the moo.
sub find_nearby_object {
	my $this=shift;
	my $name=lc(shift);
	
	if ($name =~m/#(\d+)/) {
		# They have referred to an object by number.
		return ThingList::FindByNum($1);
	}
	elsif ($name=~m/^\$/) {
		# Ask the generics object (if any) to look this object up.
		my $generics=ThingList::FindByType('Generics');
		if ($generics) {
			my $ret=$generics->findgeneric($name);
			if (! Error::iserror($ret)) { return $ret }
		}
	}
	else {
		my @list=($this->location, @{$this->contents});
		if (isa($this->location,"Room")) {
			push @list,@{$this->location->exits};
		}
		if ($this->location) {
			push @list,@{$this->location->contents};
		}
		return $this->find_object($name,@list);
	}
}	

# Passed a string that represents an object, and a list of possible objects
# that might be it, returns the actual object(s) the string refers to.
#
# Understands the use of "it", "me" and "here" as special object specifiers.
# Also understands the use of $xxx generic object specifiers, if a 
# Generics object is in the moo.
sub find_object {
	my $this=shift;
	my $name=lc(shift);
	my @list=@_;

	return undef if length($name) == 0;

	my $object=undef;
	if ($name =~m/#(\d+)/) {
		# They have referred to an object by number.
		$object=ThingList::FindByNum($1);
	}
	elsif ($name=~m/^\$/) {
		# Ask the generics object (if any) to look this object up.
		my $generics=ThingList::FindByType('Generics');
		if ($generics) {
			$object=$generics->findgeneric($name);
		}	
	}
	if ($object) {
		# See if the object we found is actually in the list
		# of valid objects.
		my $thing;
		foreach $thing (@list) {
			if ($thing == $object) {
				return $object;
			}
		}
		return undef; # nope, it's not.
	}

	my @objects=();

	my $thing;
	foreach $thing (@list) {
		if ($thing &&
		    (($name eq 'it' && $thing == $this->it) ||
		     ($name eq 'me' && $thing == $this) ||
		     ($name eq 'here' && $thing == $this->location) ||
		     ($thing->isalias($name)))) {
			push @objects,$thing;
		}
	}
	if (@objects) {
		return @objects;
	}       	
	# Fallback to looking at substrings.
	foreach $thing (@list) {
		if ($thing) {
			if (lc(substr($thing->name,0,length($name))) eq $name) {
				push @objects,$thing;
			}
			else {
				if (ref($thing->aliases) eq 'ARRAY') {
					foreach (@{$thing->aliases}) {
						if (lc(substr($_,0,length($name))) eq $name) {
							push @objects,$thing;
							last;
						}
					}
				}	
			}
		}
	}
	return @objects;
}

# The restrictions on names of people are stricter than on normal objects,
# enforce that here.
sub is_invalid_name {
	my $this=shift;
	my $name=shift;
	if ($name=~m/\s/) {
		$name=~s/\s/_/g;
		return Error->new("Name cannot contain spaces; try \"$name\" instead.");
	}
	if (ThingList::FindByName($name,"Person") && ThingList::FindByName($name,"Person") != $this) {
		return Error->new("Sorry, the name \"$name\" is already in use by another person.");
	}

	return $this->SUPER::is_invalid_name($name);
}

# Override to inform others that the person has changed their name.
sub verb_rename {
	my $this=shift;
	my $verbcall=shift;

	my $oldname=$this->name;
	my @ret=Container::verb_rename($this,$verbcall);
	if (! Error::iserror($ret[0])) {
		$this->location->announce($this,"$oldname is now named \"".$this->name."\".");
	}
	return @ret;
}

sub verb_home {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	if ($this->location == $this->home) {
		return "You're already home!";
	}

	$this->tell("You click your heels three times.");
	$this->location->announce($this,$this->name." goes home.");
	$this->location->contents_remove($this);
	$this->home->contents_add($this);
	return "";
}

sub verb_sethome {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	$this->home($this->location);
	return $this->home->name." is your new home.";
}

sub verb_chown {
	my $this=shift;
	my $verbcall=shift;

	unless ($verbcall->direct_object && $verbcall->indirect_object) {
		return "You must specify an object and a new owner.";
	}

	if (isa($this,"Wizard") || $verbcall->direct_object->owner == $this) {
		$verbcall->direct_object->owner($verbcall->indirect_object);
		return $verbcall->direct_object->name." is now owned by ".$verbcall->indirect_object->name.".";
	}
	else {
		return "Permission denied."
	}
}

# List all the objects I own.
sub verb_audit {
	my $this=shift;
	my $verbcall=shift;

	my $toaudit=$verbcall->direct_object || $this;

	# Todo: sort by id.

	my $thing;
	my @list;
	my ($locname, $locnum);
	foreach $thing (ThingList::All) {
		if ($thing->owner eq $toaudit) {
			if ($thing->location) {
				$locname=$thing->location->name;
				$locnum="(#".$thing->location->id.")";
			}
			else {
				$locname="<nowhere>";
				$locnum="";
			}
			push @list, ["#".$thing->id, $thing->name, $locname, $locnum];
		}
	}
	
	if (@list) {
		return Text::tablemaker("Objects owned by ".$toaudit->name,
			["ID", "NAME", "LOCATION"],
			@list,
		);
	}
	else {
		return $toaudit->name." owns nothing.";
	}
}

# Who's logged on?
sub verb_who {
	my $this = shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my @wholist;
	push (@wholist,["NAME","ON FOR","","IDLE FOR","","ROOM"]);

	foreach(ThingList::FindByType("Person")) {
		if ($_ && $_->connected && ! Error::iserror($_->connected) && $_->location) {
			push(@wholist,[$_->name,@{[ Text::prettytime(time()-$_->lastlogin) ]},
				@{[ Text::prettytime(time()-$_->lastactive) ]},
				$_->location->name]);
		}
	}

	return Text::tablemaker("Who's on right now",@wholist);
}

# Like unix last.
sub verb_lastlog {
	my $this = shift;
	my (%peoplebytime, @lastloglist, $keyvalue);
	push (@lastloglist,["NAME","ON","LAST LOGIN","HOST"]);

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my @people = ThingList::FindByType("Person");
	foreach (@people) {
		if ($_->lastlogin && ! Error::iserror($_->lastlogin)) {
			$peoplebytime{$keyvalue++} = [$_,$_->lastlogin];
		}
	}
	@people = sort { $peoplebytime{$b}->[1] <=> $peoplebytime{$a}->[1] } keys %peoplebytime;
	
	foreach (@people) {
		my $foo = $peoplebytime{$_}->[0];
		push(@lastloglist,[$foo->name,$foo->connected ? "*" : "",
			$foo->lastlogin ? scalar gmtime($foo->lastlogin) : "<never logged in>",$foo->host]) if $foo->name;
	}		
	return Text::tablemaker("Last Log",@lastloglist);
}

sub verb_whisper {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my $thingtosay = $verbcall->word('direct_object');

	if ($verbcall->indirect_object) {
		if ($verbcall->indirect_object->connected) {
			$verbcall->indirect_object->tell($this->name.' whispers, "'. $thingtosay.'"');
			return $this->tell("You whisper \"$thingtosay\" to ".$verbcall->indirect_object->name.".");
		} else {
			return $this->tell("That person is not logged in.");
		}
	}	
	else {	
		return Error->new("No such person.");
	}
}

sub verb_delete {
	my $this = shift;
	my $verbcall = shift;
	my $del = $verbcall->direct_object || return "Delete what?";	
	my $name = $del->name;
	my $ret;

	# TODO: does this really belong here? Maybe it needs to go in sub remove.
	if (ActiveUser::getactive() != $del->owner &&
	    ! isa(ActiveUser::getactive(),"Wizard")) {
	    	return Error->new("You do not own ".$del->name);
	}

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	# calls an object-specific remove method to clean things up
	$ret = $del->remove;
	return $ret if (Error::iserror($ret));
	
	undef $del;

        return "Deleted $name";
}

# When people are removed, we make sure to log them out first.
sub remove {
	my $this = shift;
	
	my $close=$this->close_callback;
	
	if ($this->connected) {
		if (ref($close) eq 'CODE') {
			&{$close};
		}
		$this->logout;
	}
	
	return Container::remove($this);
}

sub verb_page {
	my $this=shift;
	my $verbcall=shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);
	
	if (! $verbcall->direct_object) {
		# Look up a person matching the direct object string.
		# They can be in any location.
		my $person;
		foreach $person (ThingList::FindByType('Person')) {
			if ($person->isalias($verbcall->word('direct_object'))) {
				$verbcall->direct_object($person);
				last;
			}
		}
		if (! $verbcall->direct_object) {
			return Error->new('"'.$verbcall->word('direct_object').'" is not the name of any user.');
		}
	}
	if (! $verbcall->direct_object->connected) {
		return Error->new($verbcall->direct_object->name." is not currently logged in.");
	}

	# We want to ignore the preposition if one was specified.
	my $text=$verbcall->word('indirect_object') || $verbcall->word('preposition');

	if ($text) {
		$verbcall->direct_object->tell($verbcall->caller->name." pages, \"$text\"");
	}
	else {
		$verbcall->direct_object->tell($verbcall->caller->name." pages you.");
	}
	return "Your message has been sent.";
}

sub verb_sayto {
	my $this=shift;
	my $verbcall=shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);

	# Need to strip out the command and direct object from the command
	# line and say the whole rest of it. The monster regexp is based on
	# the one in Text::SplitWords and needs to be kept in sync.
	my $message=$verbcall->command;
	($message)=$message=~m/(?:"(?:[^"\\]*(?:\\.[^"\\]*)*)"\s*|(?:[^\s]+)\s*){2}(.*)/;
	
	# Prepend who we're saying this to.
	if ($verbcall->direct_object) {
		$message="[to ".$verbcall->direct_object->name."]: $message";
	}
	else {
		$message="[".$verbcall->word('direct_object')."]: $message";
	}
	
	if ($verbcall->caller->location) {
		$verbcall->caller->location->announce(undef,$verbcall->caller->name." $message");
	}
	return undef;
}

sub verb_version {
	my $this=shift;
	my $verbcall=shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);
	
	return "This server is running Perlmoo version ".$Version::version.", on perl version $], under $^O.";
}	

sub verb_uptime {
	my $this=shift;
	my $verbcall=shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);
		
	return "This server has been up for ".Text::prettytime(time - $^T).".";
}

1