# A method is a snip of perl code that defines a subroutine. It has an
# owner that is a Programmer. The method can be run inside the Programmer's
# safe.

package Method;
use Error;
use ActiveUser;
use strict;
use Programmer;
use vars qw($AUTOLOAD);
use UNIVERSAL qw(isa);

# You can pass in a hash with keys of owner, code, and sub to set the
# properties of the method.
sub new {
	my $proto=shift;
	my $class = ref($proto) || $proto;
	my $this = {};
	
	if (@_) {
		my %init=@_;
		foreach (keys %init) {
			$this->{$_}=$init{$_};
		}
	}
	$this->{timestamp}=time();

	bless($this, $class);
	return $this;
}

# Run the method with the passed parameters.
sub run {
	my $this=shift;
	my $name=shift;
	my $thing=$_[0];

	if (! isa($this->{owner}, "Programmer")) {
		return Error->new("Method owner is not a Programmer or doesn't exist.");
	}
	
	my @wasactive=ActiveUser::getactive();
	ActiveUser::setactive($this->{owner});

	# We need to run the method inside a subpackage of the safe -
	# determine that package name here. What we do is we use the
	# id number of the object that defines this method. *Not* necessarily
	# the object that has called it. If that object has a parent that
	# defines this method, we look there instead.
	#
	# TODO: well that's golden, except when we're being called
	# from inside ->super(). Then this gets it wrong. Fix.
	my $pkg="Thing".$thing->method_definer($name)->id;

	# FIXME: ugly hack, using this global. Have to do this so
	# the safe can see this function's parameters.
	$main::params=\@_;
	$main::method=$this->{'sub'};
	$this->{owner}->compartment->share_from('main',[qw{$params $method}]);

	my $code=$this->{code};

# FIXME: all this commented out stuff doesn't work because of some weird
# problem with defining subs insides safes. This means we can't do any method
# caching :-(
#
#	# Check to see if the method has been cached, so we don't eval large
#	# blocks of code each time a method is called..
#	my $fullpkg=$this->{owner}->compartment->root."::$pkg";
#	no strict 'refs';
#	if (${$fullpkg."::timestamp"} >= $this->{timestamp} &&
#	    UNIVERSAL::can($fullpkg,$this->{'sub'})) {
#		print "method $name in $fullpkg is cached\n";
#		$code=undef;
#	}
#	${$fullpkg."::timestamp"}=time();
#	use strict 'refs';
#
#	my @ret=$this->{owner}->compartment->reval("package $pkg;$code;".$this->{'sub'}.'(@$main::params)');

	my @ret=$this->{owner}->compartment->reval("package $pkg;".'@ARGV=@$main::params;'.$code);
	ActiveUser::setactive(@wasactive);
	return @ret,$@;
}

# Invalidate the cache when the code in a method changes.
sub code {
	my $this=shift;
	if (@_) {
		$this->{timestamp}=time();
		return $this->{code}=shift;
	}
	
	return $this->{code};
}

# Invalidate the cache when the owner of a method changes.
sub owner {
	my $this=shift;
	if (@_) {
		$this->{timestamp}=time();
		return $this->{owner}=shift;
	}
	
	return $this->{owner};
}

sub AUTOLOAD {
	my $this=shift;
	
	my $name = $AUTOLOAD;
	$name =~ s/.*://; # strip fully-qualified portion
	
	if (@_) {
		return $this->{$name} = shift;
	}
	else {
		return $this->{$name};
	}	
}

1;