view release on metacpan or  search on metacpan

examples/port-probe-multi.pl  view on Meta::CPAN

# Real work
eval {
	ae_recv {
		tcp_connect $_->[0], $_->[1], ae_goal("$_->[0]:$_->[1]") for @probe;
	} $timeout;
};
die $@ if $@ and $@ !~ /^Timeout/;

my @offline = sort keys %{ AE::AdHoc->goals };
my (@alive, @reject);

my $results = AE::AdHoc->results;
foreach (keys %$results) {
	# tcp_connect will not feed any args if connect failed
	ref $results->{$_}->[0]
		? push @alive, $_
		: push @reject, $_;
};

print "Connected: @alive\n" if @alive;
print "Rejected: @reject\n" if @reject;
print "Timed out: @offline\n" if @offline;
# /Real work

sub usage {
	print <<"USAGE";
Probe tcp connection to several hosts at once
Usage: $0 [ options ] host:port host:port ...
Options may include:
	--timeout <seconds> - may be fractional as well

examples/port-probe.pl  view on Meta::CPAN

	"timeout=s" => \$timeout,
	"help" => \&usage,
) or usage();

my @probe = map {
	/^(.*):(\d+)$/ or die "Expecting host:port. See $0 --help\n"; [$1, $2, $_];
} @ARGV;
usage() unless @probe;

# Real work
my $alive = ae_recv {
	tcp_connect $_->[0], $_->[1], ae_send("$_->[0]:$_->[1]") for @probe;
} $timeout;
print "Connect to $alive succeeded!\n";
# /Real work

sub usage {
	print <<"USAGE";
Probe tcp connection to several hosts at once
Usage: $0 [ options ] host:port host:port ...
Options may include:
	--timeout <seconds> - may be fractional as well
	--help - this message
USAGE

t/10-basic.t  view on Meta::CPAN

# check that later-on callback generates a warning
{
	my @warn;
	local $SIG{__WARN__} = sub { push @warn, @_ };
	throws_ok {
		ae_recv { ; } 0.2;
	} qr(Timeout), "Rotten timer didn't spoil later tests:";
	is (scalar @warn, 1, " - 1 warning issued");
	like ($warn[0], qr(Leftover), " - It was about 'Leftover': $warn[0]");
	ok (ref $timer, " - Rotten timer still alive at this point (but harmless): $timer");

};