Вам необходимо отправить $clients
через share
из threads::shared
:
my $clients = &share({});
Старомодный синтаксис произошел из-за задокументированной проблемы с прототипами Perl. Если у вас хотя бы Perl 5.8.9 , используйте более приятный
my $clients = shared_clone({});
вместо.
Вы также хотите защитить $clients
с помощью замка, например, ,
my $clients_lock : shared;
{
lock $clients_lock;
$clients->{time()} = fileno $connection;
}
Наконец, поскольку IO::Socket::INET
экземпляры являются типоглобами Perl, вы не можете делиться ими, поэтому вместо этого добавьте их дескрипторы сокетов (от fileno
) к $clients
и затем fdopen
сокет при необходимости с
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;