view release on metacpan or  search on metacpan

Agent.pm  view on Meta::CPAN

# Patchlevel: 00
# Steve Purkis <spurkis@engsoc.carleton.ca>
# December 15, 1998
##

package Agent;

use strict;
use UNIVERSAL;
use Class::Tom qw( cc repair );
use Data::Dumper;			# for argument passing
use Agent::Message;			# load message handling routines
use Agent::Transport;			# load the autoloader

use vars qw($VERSION $MAJORVERSION $MINORVERSION $MICROVERSION $thread $Debug);

$MAJORVERSION = '3';
$MINORVERSION = '20';
$MICROVERSION = '00';	# aka patchlevel

# I realize with this scheme it's possible to have conflicting version
# numbers, but CPAN doesn't like tuples.  Solution, MINOR < 100.  If it
# hits 100 it's prolly time for an increase in MAJOR anyway.
$VERSION = "$MAJORVERSION.$MINORVERSION$MICROVERSION";

BEGIN {
	# Check for Thread.pm...
	eval "use Thread qw( async );";
	if ($@) { $Agent::thread = 0; }
	else    { $Agent::thread = 1; }
}


sub new {
	my ($class, %args) = @_;

	my $self = {};
	my ($stored, $fh, $name, $code, $cpt, $tom, $method) =
	   delete @args{'Stored', 'File', 'Name', 'Code', 'Compartment'};

	# first get the code...
	if ($stored) {
		if (ref($stored) eq 'ARRAY') { $code = join('', @$stored); }
		else { $code = $stored; }
		$method = 'repair';
	} else {
		if ($fh) {
			unless ($fh->isa('IO::Handle')) {
				warn "File argument was not of IO::Handle!";
				return;
			}
			local $/ = undef;
			$code = <$fh>;
		} elsif ($name) {
			$code = _find_agent($name);
		} 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";