Perl multithreading - quit on first thread success - multithreading

Question

I'm by no means an expert in perl or multithreading but I'm convinced I'm "doing it wrong" and need some guidance as to how to alter it so that I don't get thread quit warnings.
As you can see, this program reads in argument 0, does a lookup to find each of the IP addresses associated with a host name, then tests each IP to see if ssh is running.
The purpose of this script is to spawn a tcp test for each host and return the first successful tcp connect.
Can anyone suggest a way of doing this that is more reliable and doesn't require a sleep?
use strict;
use warnings;
BEGIN {
use Config;
$Config{useithreads} or die('Recompile Perl with threads to run this program.');
}
use threads;
use IO::Socket::INET;
$| = 1;
unless($ARGV[0]){ die("error please use argument")}
my $timeoutval=3;
my $testHost=$ARGV[0];
my $dlquery=`dig $testHost | grep 'IN A'`;
my $SUCCESS=0;
sub testSSHhost {
my $fqdn = shift;
my $socket = new IO::Socket::INET (
PeerHost => $fqdn,
PeerPort => '22',
Proto => 'tcp',
Timeout => $timeoutval,
) or return "ERROR in Socket Creation : $!\n";
my $tcpData = <$socket>;
$socket->close();
if ($tcpData && $tcpData=~/SSH/){
print "$fqdn\n";
$SUCCESS=1;
exit(0);
}
return $fqdn;
}
my #threads;
for my $line (split(/\n/,$dlquery)){
my #linesplit=split(/ /,$line);
$linesplit[0]=~s/\.$//;
$linesplit[0]=~s/ *//g;
my $t = threads->new(\&testSSHhost, $linesplit[0]);
push(#threads,$t);
}
while (!$SUCCESS){sleep 0.3}
Really what i'm trying to avoid is the "A thread exited while 2 threads were running." error message
Or a "segmentation fault" message

Answer 1

Something like this (not tested!):
use Modern::Perl;
use threads;
use Thread::Queue;
use IO::Socket::INET;
$| = 1;
my $testHost = $ARGV[0];
my $dlquery = `dig $testHost | grep 'IN A'`;
my $config = { NUMBER_OF_THREADS => 5 }; #how many threads you gonna use?
my $queue = Thread::Queue->new;
my $queue_processed = Thread::Queue->new;
for my $line ( split( /\n/, $dlquery ) ) {
my ($ip) = split( / /, $line );
$ip =~ s/\.$//;
$ip =~ s/ *//g;
$queue->enqueue($ip);
}
foreach my $thread_id ( 1 .. $config->{NUMBER_OF_THREADS} ) {
$queue->enqueue(undef);
my $thread = threads->create( \&testSSHhost() )->detach();
}
while ( $queue->pending() ) {
my $result = $queue_processed->dequeue();
if ( $result->{status} ) {
say $result->{ip};
}
}
sub testSSHhost {
while ( my $fqdn = $queue->dequeue() ) {
my $status = 0;
my $socket = new IO::Socket::INET(
PeerHost => $fqdn,
PeerPort => 22,
Proto => 'tcp',
Timeout => 3,
) or return "ERROR in Socket Creation : $!\n";
my $tcpData = <$socket>;
$socket->close();
if ( $tcpData && $tcpData =~ /SSH/ ) {
$status = 1;
}
$queue_processed->enqueue( { ip => $fqdn, status => $status, } );
}
return 0;
}

Answer 2

You can achieve it with Qeues:
http://search.cpan.org/dist/Thread-Queue/lib/Thread/Queue.pm
Before spawning the threads, you create a queue, and then let the threads push the successful IP address in it. Then the parent process would block in dequeuing until something pops up.