view release on metacpan or  search on metacpan

Agent.pm  view on Meta::CPAN

		} elsif ($code) {
			if (ref($stored) eq 'ARRAY') {
				$code = join('', @$code);
			}
		} else {
			my ($pkg, $fl, $ln) = caller();
			warn "$fl:$ln passed no valid arguments!";
			return;
		}
		unless (defined($code)) {
			warn "agent's source code could not be resolved!";
			return;
		}
		$method = 'cc';
	}

	# then make the Tom object.
	if ($method eq 'repair') {
		# use Tom's repair() to produce container:
		unless ($tom = repair($code, $cpt)) {	# Tom doesn't support this yet
			warn "Discarding a corrupted agent!" if $Debug;
			return ();
		}
	} elsif ($method eq 'cc') {
		# use Tom's cc() to get container.  Note that since we're
		# only interested in the first container returned, parens
		# are about $tom.  Agent does not support multi-class agent
		# definitions yet (sorry).
		unless (($tom) = cc($code, $cpt)) {	# Tom doesn't support this yet
			warn "Tom didn't return a container!" if $Debug;
			return;
		}
	}

	# now register it:
	if ($cpt) { $tom->register(Compartment => $cpt); }
	else      { $tom->register(); }
	if ($@) {
		warn "Unsafe agent trapped: $@\n";
		return;
	}

	# and extract the object:
	if ($cpt) {
		# use $self as a wrapper object...
		$self->{Compartment} = $cpt;

		# get the object into the safe compartment...
		$self->{AgentVar} = $tom->put_object($cpt);
		if ($@) {
			warn "Unsafe agent trapped: $@\n";
			return;
		}
		unless ($self->{AgentVar}) {
			$self->{AgentVar} = '$agent';
			my $agentclass = $tom->class;
			my $str =
			   "if ('$agentclass' && (\${$agentclass\:\:}{new})) {\n" .
			   "   \$agent = new $agentclass(" . %args . ");\n" .
			   "} else {\n" .
			   "   \$agent = {}; bless \$agent, $agentclass;\n" .
			   "}";

			$cpt->reval($str);
			print "AGENT: ", ${$cpt->varglob('agent')}, "\n";

			if ($@) {
				warn "Unsafe agent trapped: $@\n" if $Debug;
				return;
			}
		}
		# store the agent's class in the agent itself:
		${$cpt->varglob($self->{AgentVar})}->{Tom} = $tom;
		bless $self, $class;	# bless wrapper into Agent!
	} else {
		unless ($self = $tom->get_object) {
			no strict;
			# got no object, so create one:
			my $agentclass = $tom->class();
			if (($agentclass) && (${"$agentclass\:\:"}{new})) {
				$self = new $agentclass(%args);
			} else {
				print STDERR "$agentclass\:\:new() not found!\n" if $Debug;
				# we'll just bless $self into the agent's class:
				$self = {};
				bless $self, $agentclass;
			}
		}
		# store the agent's class in the agent itself:
		$self->{Tom} = $tom;
	}
	# this is not true for wrapped agents:
	print "agent's class is: " . ref($self) . "\n" if $Debug > 1;

	return $self;	# blessed into owning agent's class!
}


##
# Inherited methods safe for use by agent objects.
##

sub run {
	my ($self, %args) = @_;

	if (delete $args{Thread}) {
		if ($Agent::thread) {
			return async { _run($self, %args); };
		} else {
			print "Threads not available on this system!\n" if $Debug;
		}
	}
	_run($self, %args);
}

sub store {
	my $self = shift;

	# temporarily remove the Tom container:
	my $tom = delete( $self->{Tom} );

	# insert the agent & store it:
	$tom->insert( $self );
	my $stored = $tom->store();

	# restore the Tom container:
	$self->{Tom} = $tom;

	return $stored;
}

sub identity {
	my $self = shift;

	# temporarily remove the Tom container:
	my $tom = delete( $self->{Tom} );

	# insert the agent & store it:
	$tom->insert( $self );
	my $id = $tom->checksum();
		
	# restore the Tom container:
	$self->{Tom} = $tom;

 	return $id;
}


##
# Private subroutines
##

# searches @INC and '.' for "$name" and "$name.pa".
sub _find_agent {
	my ($name, @dirs) = @_;