Agent

 view release on metacpan or  search on metacpan

Agent/Transport/TCP.pm  view on Meta::CPAN

#!/usr/bin/perl

##
# TCP[/IP] transport subclass for Agent Perl.
# Steve Purkis <spurkis@engsoc.carleton.ca>
# June 18, 1998
##

package Agent::Transport::TCP;
use vars qw( $Debug );

use IO::Socket;

@ISA = qw( Agent::Transport );

##
# Non-OO Stuff
##

sub send {
	my (%args) = @_;
	my $addr;

	$addr = valid_address($args{Address});

	unless ($addr = $args{Address}) {
		warn "No valid transport address defined: $args{Address}!";
		return;
	}
	my @msg = @{$args{Message}};

	# open a new socket & send the data
	my $con = new IO::Socket::INET(
		Proto => 'tcp',
		Timeout => 1,
                PeerAddr => $addr,
                Reuse => 1
	) or return ();	# use IO::Socket's $!

	for( @msg ) { $con->send( $_ ) or return (); }

	# preserve connection?
	${$args{KeepAlive}}  = $con if (ref $args{KeepAlive} eq 'SCALAR');

	$con->close();
	undef $con;	# paranoia
	1;
}

sub valid_address {
	$_ = shift;
	$_ =~ /(^(\d{1,3}\.){3}\d{1,3})|(^(\w+\.)*\w+)\:\d+$/;
	return $_;
}

##
# OO Stuff
##

sub new {
	my ($class, %args) = @_;
	my $self = {};
	my ($addr, $port);

	# set defaults:
	unless ($args{Address}) {
		$args{Address} = '127.0.0.1:24368';
		$args{Cycle} = 1;
	}

	unless (valid_address($args{Address})) {
		warn "Invalid transport address: $args{Address}!";
		return;
	}
	# split so we can cycle port # if need be...
	($addr, $port) = split(/:/, $args{Address});

	# open a new server socket:
	while (1) {
		last if $self->{Server} = new IO::Socket::INET(
			Proto => 'tcp',
			Listen => 1,
			LocalAddr => $addr . ':' . $port,
			Reuse => 1
		);
		print "Couldn't get connection: $!\n" if ($Debug && $!);
		return unless $args{'Cycle'};	# cycle for a free port?
		$port++;
	}

	$self->{Server}->autoflush();
	bless $self, $class;
}

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

	my $remote = $self->accept(%args) or return ();

	return $remote->getlines();
}

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

	$self->{Server}->timeout($args{Timeout}) if $args{Timeout};



( run in 1.282 second using v1.01-cache-2.11-cpan-d80b1682f3f )