Javascript Websocket和Perl CGI

我对CGI编程有点陌生，我试图制作一个在线聊天API，但遇到不少麻烦：

我在网上寻找解决方案，找到了用于客户端（js）的Websocket和用于perl的HTTP:：Daemon，但我不知道从哪里开始让服务器侦听来自浏览器的连接

以下是我的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);
}

使用HTTP:：Daemon；
使用HTTP：：Status；
my$d=HTTP:：Daemon->new(
LocalAddr=>“www.franchygao.com”，
本地端口=>3000
)| |死；打印“请通过以下地址与我联系：\n”；
而（我的$c=$d->接受）{
$c->send_response（“1”）#测试
while（my$r=$c->get\u请求）{
如果（$r->method eq'GET'）{
$c->send_response（“…”）；
}
}
$c->close；
基金（c美元）；
}

当页面加载时，连接立即关闭，在Chrome控制台窗口中，我看到以下错误： 到“ws://198.38.89.14:3000/”的WebSocket连接失败：连接建立中出错：net:：ERR_connection_拒绝

我手动运行perl脚本（使用简单的调用），然后在刷新页面时得到： 到“ws://198.38.89.14:3000/”的WebSocket连接失败：WebSocket握手期间出错：意外响应代码：200

我知道服务器正常情况下在OK时返回200，但是Websocket正在等待101代码作为“OK”

---

我的问题是，如果是这样，我如何才能做到这一点

我知道这很古老，我来到这里是因为我自己在寻找答案。我最终通过使用Net:：WebSocket:：Server自己找到了答案

有关如何使用模块和示例的更多详细信息

基本上，您将拥有与javascript匹配的perl代码（从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;