Perl多线程-在第一线程成功时退出

Question

我绝对不是perl或多线程方面的专家，但我确信我“做错了”，需要一些指导来修改它，这样我就不会收到线程退出警告。

如您所见，此程序读取参数0，执行查找以查找与主机名关联的每个IP地址，然后测试每个IP以查看ssh是否正在运行。

此脚本的目的是为每个主机生成一个tcp测试，并返回第一个成功的tcp连接。

有没有人能建议一种更可靠且不需要睡眠的方法？

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}

实际上，我试图避免的是"A线程退出，而2个线程正在运行“。错误消息或“分段故障”消息

Answer 1

如下所示(未测试！)：

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

你可以用Qeues来实现：http://search.cpan.org/dist/Thread-Queue/lib/Thread/Queue.pm

在派生线程之前，您创建一个队列，然后让线程将成功的IP地址推送到队列中。然后，父进程将阻止出队，直到有东西弹出。