Question

我正在尝试创建一个Web服务器，其请求被归结为隐藏在open2（）后面的一组解释器，基于cgi参数中指示的“device”。

麻烦的是，我希望它是多线程的，但是我用来试图跟踪与每个设备相关的事件队列的哈希不记得为每个请求创建的新设备：下面的服务器只打印这种事情：

Did not find default-device in (alreadyThere)...

Added default-device with Sun Oct 27 20:43:35 2013 to alreadyThere, default-device
Now... does (alreadyThere, default-device) persist for the next request?

这是脚本：

#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
use base qw(Net::Server::HTTP);

our $monkeys = shared_clone({ alreadyThere => { 'a' => 'b' } });

sub process_http_request {
    require CGI;
    my $cgi = CGI->new;
    my $device = $cgi->param('device') || 'default-device';

    print "HTTP/1.0 200 OK\r\nContent-type: text/html\r\n\r\n<pre>";
    unless (exists $monkeys->{$device}) {
        print "Did not find $device in (".join(", ", sort keys %$monkeys).")...\n";
        lock $monkeys;
        unless (exists $monkeys->{$device}) {
            my $t = localtime;
            $monkeys->{$device} = $t;
            print "\nAdded $device with ".$t." to ".join(", ", sort keys %$monkeys);
        } else {
            print "\nSurprise device... ".$device;
        }
    } else {
        print "\nFound device... ".$device;
    }

    print "\nNow... does (".join(", ", sort keys %$monkeys).") persist for the next request?</pre>";
}

__PACKAGE__->run(port => 8080);

这不是$ t位 - 以前是shared_clone（{id =＆gt; $ t}），但是如果我能看到为什么$ monkeys似乎永远不会更新，我就知道了。

Answer 1

不同的请求由不同的进程提供，而不是线程。

Net :: Server没有多线程“个性”^[1]，因此您将不得不使用不同的共享机制。

注意：

“在不久的将来，我们想添加一个'线程'个性”

Answer 2

在Ikegami的回答的基础上，我正在尝试使用这些额外的代码来伪造'线程'个性并取得一些成功（以及'open3'行为不端的一些问题）：

sub default_server_type { 'Single' }

sub loop {
  my $self = shift;
  while( $self->accept ){
    async {
        $self->run_client_connection;
    };
    last if $self->done;
  }
}

Answer 3

a）有没有理由使用Net :: Server :: HTTP而不是更高级别，更容易使用Plack？
b）我不得不解决与最近这个问题不同的问题，并决定使用基于事件的httpd与AnyEvent（或更高的抽象，Coro）。如果您需要直接替换代码，或者甚至需要基于AnyEvent的基于http Net::Server::Coro，Twiggy等等的httpds

，则需要Feersum。

为什么共享的perl哈希不与其他线程共享更新？

3 个答案: