view release on metacpan or  search on metacpan

examples/Static.pa  view on Meta::CPAN

#!/usr/bin/perl

##
# The Static Agent - an example agent that hosts other agents.
# Steve Purkis <spurkis@engsoc.carleton.ca>
# March 24, 1998.
##

package Agent::Static;
@ISA = qw( Agent );
use Agent;	# redundant
use Safe;


##
# Constructor:

sub new {
	my ($class, %args) = @_;
	my $self = {};
	foreach (keys(%args)) { $self->{"$_"} = $args{"$_"}; }
	bless $self, $class;
}


##
# agent_main - Main agent program.  Waits for incoming requests, and hosts
#	any agents it recieves.  One might conceivably do a double fork()
#	and run this in the background on UN*X machines.
##
sub agent_main {
	my ($self, @args) = @_;

	print "Starting Static agent.\n";

	# first, get a Transport address:
	my %args;
	$args{Medium} = $self->{Medium} || 'TCP';
	$args{Address} = $self->{Address} if $self->{Address};
	my $tcp = new Agent::Transport( %args ) or die
	   "Couldn't get a tcp transport address: $!!\n";
	print "Got tcp address: " . $tcp->address . "\n";

	print "Waiting for an agent...\n" if $self->{verbose};
	while (1) {
		my @msg = $self->getmsg($tcp) or next;
		$self->host_agent(@msg);
		print "Waiting for an agent...\n" if $self->{verbose};
	}
	print "Shuting down Static agent.\n";
}


##
# getmsg - internal.  Waits for a incoming message, & returns it.

sub getmsg {
	my ($self, $trans) = @_;		# all agents & subs are oo
	my $rmt = 'hi there!';
	my ($from, @incoming) = $trans->recv( Timeout => 120, From => \$rmt) or return;
	chomp $from;
	unless (@incoming) {
		warn "No data in message from $rmt!\n";
		return;
	}
	my ($d, $addr, $med) = split(/\s+/, $from);

	my @t = localtime(time);
	my $time = "$t[2]\:$t[1]\:$t[0] $t[5]\-$t[4]\-$t[3]";
	print "Message recv'd from '$from' ($rmt) at $time\n" if $self->{verbose};
	print "Body:\n", @incoming, "\n" if $self->{verbose} > 1;
	return @incoming;
}


##
# host_agent - internal.  Executes an agent in the standard fashion.

sub host_agent {
	my $self = shift;
	my $stored = join('', @_);
	my (%args, $agent, $str);