Websocket和Perl CGI

Question

我對CGI編程有點陌生，我嘗試制作一個在線聊天API，但遇到了不少麻煩：

我在網上尋找解決方案，發現Websocket用於客戶端（js），而HTTP :: Daemon用於perl，但是我不知道從哪里開始讓服務器偵聽來自瀏覽器的連接。

這是我的JavaScript代碼：

ws = new WebSocket('ws://www.crazygao.com:3000'); // test
ws.onopen = function() {
    alert('Connection is established!'); // test
};
ws.onclose = function() {
    alert('Connection is closed'); 
};
ws.onmessage = function(e) {
    var message = e.data;
    //alert('Got new message: ' + message);
};
ws.onerror = function(e) {
    //var message = e.data;
    alert('Error: ' + e);
};

這是我的Perl腳本測試代碼：

use HTTP::Daemon;
use HTTP::Status;

my $d = HTTP::Daemon->new(
    LocalAddr => 'www.crazygao.com',
    LocalPort => 3000
) || die; print "Please contact me at: <URL:", $d->url, ">\n";
while(my $c = $d->accept) {
    $c->send_response("1"); # test
    while (my $r = $c->get_request) {
        if ($r->method eq 'GET') {
            $c->send_response("...");
        }
    }
    $c->close;
    undef($c);
}

頁面加載后，連接立即關閉，並且在Chrome控制台窗口中看到以下錯誤：與'ws：//198.38.89.14：3000 /'的WebSocket連接失敗：連接建立錯誤：net :: ERR_CONNECTION_REFUSED

我手動運行perl腳本（使用對http://example.com/cgi-bin/xxx.cgi的簡單調用），然后刷新頁面時得到：WebSocket連接到'ws：//198.38.89.14：3000 /'失敗：WebSocket握手期間出錯：意外的響應代碼：200

我知道服務器正常時返回正常200，但是Websocket正在等待101代碼為“確定”。

我的問題是，如果是這樣，我該如何實現？

Answer 1

我知道這很老，我來到這里是因為我自己正在尋找答案。 我最終通過使用Net :: WebSocket :: Server自己找到了答案。

http://search.cpan.org/~topaz/Net-WebSocket-Server-0.003004/lib/Net/WebSocket/Server.pm了解有關如何使用該模塊和示例的更多詳細信息。

基本上，您將具有以下perl代碼以匹配您的javascript（從Net :: WebSocket :: Server的CPAN頁面復制和修改）：

use Net::WebSocket::Server;

my $origin = 'http://www.crazygao.com';

Net::WebSocket::Server->new(
    listen => 3000,
    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;