如何在Perl中向已连接的Websocket客户端发送定期消息

Question

这个问题类似于Python的这个问题： WebSocket Server sending messages periodically in python 在Perl中创建WebSocket的示例使用了一个小型消息发送服务： http://search.cpan.org/~topaz/Net-WebSocket-Server-0.001003/lib/Net/WebSocket/Server.pm 代码如下：

use Net::WebSocket::Server;

my $origin = 'http://example.com';

Net::WebSocket::Server->new(
    listen => 8080,
    on_connect => sub {
        my ($serv, $conn) = @_;
        $conn->on(
            handshake => sub {
                my ($conn, $handshake) = @_;
                $conn->disconnect() unless $handshake->req->origin eq $origin;
            },
            utf8 => sub {
                my ($conn, $msg) = @_;
                $_->send_utf8($msg) for $conn->server->connections;
            },
            binary => sub {
                my ($conn, $msg) = @_;
                $_->send_binary($msg) for $conn->server->connections;
            },
        );
    },
)->start;

这个示例是事件驱动的，仅基于客户端发送的信息向客户端发送消息。如果我想要定期向所有连接的客户端发送消息，有什么好的方法可以做到这一点呢？我可以创建一个在套接字服务器内触发的定期事件吗，或者有一种方式可以创建Perl客户端连接到服务器并发送消息，然后服务器进行广播吗？

- Vijay Boyapati

Answer 1

升级至Net::WebSocket::Server v0.3.0，它通过“tick_period”参数和“tick”事件内置此功能。请参见下面的示例：

use Net::WebSocket::Server;

my $ws = Net::WebSocket::Server->new(
    listen => 8080,
    tick_period => 1,
    on_tick => sub {
        my ($serv) = @_;
        $_->send_utf8(time) for $serv->connections;
    },
)->start;

- Topaz

---

这太完美了，正是我所需要的。谢谢Topaz！ - Vijay Boyapati

Answer 2

我找到了一个简单的解决方法，尽管我不确定它是最好的解决方案。WebSocket服务器可以触发的事件之一是on_pong。此外，在创建WebSocket服务器时，如果设置了silence_max，它会定期向所有客户端发送ping请求，并等待pong响应。然后，可以使用此pong来向所有客户端触发消息。代码如下：

my $server = Net::WebSocket::Server->new(
    listen => 2222,
    silence_max => 5, # Send a ping to cause a client pong ever 5 seconds
    on_connect => sub {
    my ($serv, $conn) = @_;
    $conn->on(
        handshake => sub {
            my ($conn, $handshake) = @_;
            print $handshake->req->origin."\n";
            $conn->disconnect() unless $handshake->req->origin eq $origin;
        },
        utf8 => sub {
            my ($conn, $msg) = @_;
            my $num_connections = scalar $conn->server->connections;
            foreach my $connection ($conn->server->connections) {
                if ($conn != $connection) {
                    $connection->send_utf8("$num_connections connected: ".$msg);
                }
            }
        },
        pong => sub {
            foreach my $connection ($conn->server->connections) {
                $connection->send_utf8("Broadcast message!!");
            }
        },

            );
    },
    );

- Vijay Boyapati