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 )