Perl 如何在散列中保存套接字并从另一个线程循环它们？

我正在一个多线程的TCP服务器上工作。在主线程中，我监听套接字并为新的传入连接创建一个新线程。我想将所有传入的连接保存在一个散列中，以便可以从另一个线程访问它们

从监视器线程中，我无法读取任何新添加的连接。在创建监视器线程时，似乎创建了一个新的客户端哈希

如何保存所有套接字的列表并从监视器线程循环它们

当前代码：

#!/usr/bin/perl
use strict;
use IO::Socket;
use threads;
use Thread::Queue;

# init
my $clients = {};
my $queue = Thread::Queue->new;

# thread that monitors
threads->create("monitor");

# create the listen socket
my $listenSocket = IO::Socket::INET->new(LocalPort  => 12345,
                                      Listen   => 10,
                                      Proto   => 'tcp',
                                      Reuse   => 1);

# make sure we are bound to the port
die "Cant't create a listening socket: $@" unless $listenSocket;

print "Server ready. Waiting for connections on 34567 ... \n";

# wait for connections at the accept call
while (my $connection = $listenSocket->accept) {
    # set client socket to non blocking
    my $nonblocking = 1;
    ioctl($connection, 0x8004667e, \\$nonblocking);

    # autoflush
    $connection->autoflush(1);

    # debug
    print "Accepted new connection\n";

    # add to list
    $clients->{time()} = $connection;

    # start new thread and listen on the socket
    threads->create("readData", $connection);
}

sub readData {
     # socket parameter
     my ($client) = @_;

     # read client
     while (<$client>) {
      # remove newline
      chomp $_;

  # add to queue
      $queue->enqueue($_);
     }

     close $client;
}

sub monitor {
    # endless loop
    while (1) {

        # loop while there is something in the queue
        while ($queue->pending) {

            # get data from a queue
            my $data = $queue->dequeue;

            # loop all sockets
            while ( my ($key, $value) = each(%$clients) ) {

               # send to socket
               print $value "$data\n";

            }
        }

        # wait 0,25 seconds
        select(undef, undef, undef, 0.25);
    }
}

close $listenSocket;

---

没有太多在Perl中使用线程的经验，但我认为您只想分享您的客户机列表：

use threads::shared; my $clients : shared = {}; 但这似乎与：

my $hash = {};
share($hash);

此外，该代码：

my $hash = { key1 => "value1" };
share($hash);

似乎清除了哈希表，但是

my $hash = {};
share($hash);
$hash->{key1} = "value1";

工作原理与我预期的一样。

您需要通过以下共享方式共享$clients：

这种老式语法是由于Perl原型中有一个文档记录的问题造成的。如果有，就用更好的

my $clients = shared_clone({});

相反

您还希望使用锁保护$clients，例如

最后，因为IO:：Socket:：INET实例是Perl typeglobs，所以您不能共享它们，所以将它们的套接字描述符从添加到$clients，然后在必要时使用打开套接字

open my $fh, ">&=", $sockdesc or warn ...

下面的程序将入站数据重复到其他连接的套接字：

#!/usr/bin/perl

use strict;
use IO::Socket;
use threads;
use threads::shared;
use Thread::Queue;

# init
my $clients = &share({});
my $clients_lock : shared;

my $queue = Thread::Queue->new;

# thread that monitors
threads->create("monitor");

# create the listen socket
my $port = 12345;
my $listenSocket = IO::Socket::INET->new(
  LocalPort  => $port,
  Listen     => 10,
  Proto      => 'tcp',
  Reuse      => 1
);

# make sure we are bound to the port
die "Can't create a listening socket: $@" unless $listenSocket;

print "Server ready. Waiting for connections on $port ... \n";

# wait for connections at the accept call
while (my $connection = $listenSocket->accept) {
  # set client socket to non blocking
  my $nonblocking = 1;
  ioctl($connection, 0x8004667e, \\$nonblocking);

  # autoflush
  $connection->autoflush(1);

  # debug
  print "Accepted new connection\n";

  # add to list
  {
    lock $clients_lock;
    $clients->{time()} = fileno $connection;
  }

  # start new thread and listen on the socket
  threads->create("readData", $connection);
}

sub readData {
  # socket parameter
  my ($client) = @_;

  # read client
  while (<$client>) {
    chomp;
    $queue->enqueue($_);
  }

  close $client;
}

sub monitor {
  # endless loop
  while (1) {
    # loop while there is something in the queue
    while ($queue->pending) {
      # get data from a queue
      my $data = $queue->dequeue;

      # loop all sockets
      {
        lock $clients_lock;
        while ( my ($key, $value) = each(%$clients) ) {
          # send to socket
          if (open my $fh, ">&=", $value) {
            print $fh "$data\n";
          }
          else {
            warn "$0: fdopen $value: $!";
          }
        }
      }
    }

    # wait 0,25 seconds
    select(undef, undef, undef, 0.25);
  }
}

close $listenSocket;

---

提示，可能对您有用，但可能没有：见过名为IO:：Multiplex的模块吗？这不起作用，第2行在test.pl第9行为共享标量提供了一个错误无效值。谢谢！现在的工作方式很有魅力：向上投票，感谢您提到fileno函数来将套接字连接转换为文件描述符。

my $clients_lock : shared;
{
  lock $clients_lock;
  $clients->{time()} = fileno $connection;
}

open my $fh, ">&=", $sockdesc or warn ...

#!/usr/bin/perl

use strict;
use IO::Socket;
use threads;
use threads::shared;
use Thread::Queue;

# init
my $clients = &share({});
my $clients_lock : shared;

my $queue = Thread::Queue->new;

# thread that monitors
threads->create("monitor");

# create the listen socket
my $port = 12345;
my $listenSocket = IO::Socket::INET->new(
  LocalPort  => $port,
  Listen     => 10,
  Proto      => 'tcp',
  Reuse      => 1
);

# make sure we are bound to the port
die "Can't create a listening socket: $@" unless $listenSocket;

print "Server ready. Waiting for connections on $port ... \n";

# wait for connections at the accept call
while (my $connection = $listenSocket->accept) {
  # set client socket to non blocking
  my $nonblocking = 1;
  ioctl($connection, 0x8004667e, \\$nonblocking);

  # autoflush
  $connection->autoflush(1);

  # debug
  print "Accepted new connection\n";

  # add to list
  {
    lock $clients_lock;
    $clients->{time()} = fileno $connection;
  }

  # start new thread and listen on the socket
  threads->create("readData", $connection);
}

sub readData {
  # socket parameter
  my ($client) = @_;

  # read client
  while (<$client>) {
    chomp;
    $queue->enqueue($_);
  }

  close $client;
}

sub monitor {
  # endless loop
  while (1) {
    # loop while there is something in the queue
    while ($queue->pending) {
      # get data from a queue
      my $data = $queue->dequeue;

      # loop all sockets
      {
        lock $clients_lock;
        while ( my ($key, $value) = each(%$clients) ) {
          # send to socket
          if (open my $fh, ">&=", $value) {
            print $fh "$data\n";
          }
          else {
            warn "$0: fdopen $value: $!";
          }
        }
      }
    }

    # wait 0,25 seconds
    select(undef, undef, undef, 0.25);
  }
}

close $listenSocket;