# A person who can *gasp* execute perl code in the moo! (In a Safe.)

package Programmer;
use strict;
use vars qw(@ISA);
use Builder;
use Safe;
use Verb;
use Error;
use VerbCall;
use Method;
use UNIVERSAL qw(isa);
@ISA=qw{Builder};

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	# Set up a protected space for running perl commands in.
	my $compartment=Safe->new;
	$compartment->permit_only(qw{:default entereval rand});
	$compartment->share_from('UNIVERSAL',['can']);
	
	my $this  = Builder::new($class,
		compartment => $compartment,
	
		@_
	);
	
	bless ($this, $class);
	return $this;
}

# Immediatly run code in the moo.
sub verb_eval {
	my $this=shift;
	my $verbcall=shift;

	my $text=$verbcall->command;
	$text=~s/^\s*\w+\s+//; # remove command.
	$text=~s/[\r\n]//g; # have to handle both types of line endings.

	# FIXME: ugly hack, using these globals.
	$Programmer::me=$this;
	$Programmer::location=$this->location;
	$this->compartment->share(qw{$location $me});

	undef *_; # paranoia, this gets into the safe otherwise.
	return $this->compartment->reval($text), $@;
}

# Add a verb to an object.
sub verb_teach {
	my $this=shift;
	my $verbcall=shift;
	
	if (! $verbcall->direct_object) {
		return Error->new("Teach what?");
	}
	
	my $command = $verbcall->word('indirect_object');
	if (! $command) {
		return Error->new("Must specify a command to teach it.");
	}
	
	my @words=$verbcall->words;
	
	my $ret=$verbcall->direct_object->addverb(Verb->new(
		'sub' => "verb_${command}_safe",
		command => $command,
		direct_object => $words[4],
		preposition => $words[5],
		indirect_object => $words[6],
	));

	if (Error::iserror($ret)) {
		return $ret;
	}
	else {
		return $verbcall->direct_object->name." can now $command.";
	}
}

# Add code for a verb to an object.
sub verb_verbcode {
	my $this=shift;
	my $verbcall=shift;
	
	return $this->verb_code($verbcall,1);
}

# Add code for a method to an object.
sub verb_code {
	my $this=shift;
	my $verbcall=shift;
	my $isverb=shift; # pass something true here if you want it to be forced to be a verb.

	if (! $verbcall->direct_object) {
		return Error->new("Must specify an object.");
	}
	
	my $command=$verbcall->word('preposition');
	if (!$command) {
		return Error->new("Must specify a command.");
	}
	
	my $code=$verbcall->word('indirect_object');
	# Null code is ok, I guess.

	my $methods=$verbcall->direct_object->methods;
	my %methods;
	if (ref($methods) eq 'HASH') {
		%methods=%{$methods};
	}
	$methods{"verb_".$command."_safe"} = Method->new(
		owner => $this,
		'sub' => ($isverb ? "verb" : "")."verb_${command}_safe",
		code => "$code",
	);
	my $ret=$verbcall->direct_object->methods(\%methods);
	if (Error::iserror($ret)) {
		return $ret;
	}
	else {
		return "Code added.";
	}
}

# Remove a method from an object.
sub verb_codedel {
	my $this=shift;
	my $verbcall=shift;
	my $isverb=shift; # pass something true here if you want it to be forced to be a verb.

	if (! $verbcall->direct_object) {
		return Error->new("Must specify an object.");
	}

	my $command=$verbcall->word('preposition');
	if (!$command) {
		return Error->new("Must specify a method.");
	}
	
	my $methods=$verbcall->direct_object->methods;
	my %methods;
	if (ref($methods) eq 'HASH') {
		%methods=%{$methods};
	}
	if (delete $methods{($isverb ? "verb_" : "").$verbcall->word('preposition')} eq undef) {
		return Error->new("That object does not define a method named \"".$verbcall->word('preposition')."\".");
	}
	my $ret=$verbcall->direct_object->methods(\%methods);
	if (Error::iserror($ret)) {
		return $ret;
	}
	else {
		return "Method deleted.";
	}
}

# Remove a verb (method definition and prototype) from an object.
sub verb_verbdel {
	my $this=shift;
	my $verbcall=shift;
	
	if (! $verbcall->direct_object) {
		return Error->new("Must specify an object.");
	}

	my $command=$verbcall->word('preposition');
	if (!$command) {
		return Error->new("Must specify a verb.");
	}
	
	my $ret=$verbcall->direct_object->removeverb($verbcall->word('preposition'));
	if (!$ret) {
		return Error->new("Unable to remove verb definition.");
	}

	my $ret=$this->verb_codedel($verbcall,1);
	if (Error::iserror($ret)) {
		return "Deleting verb defintion: success.",
		       "Deleting verb code: ".$ret->message;
	}
	else {
		return "Deleting verb defintion: success.",
		       "Deleting verb code: success.";
	}
}

1