我在这个标题为Perl HTTP server的SO Q＆amp; A上找到了以下Perl代码。具体来说是this answer。这是我修改过的代码：
#!/usr/bin/perl
use strict;
use warnings;
use CGI qw/ :standard /;
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Response;
use HTTP::Status;
use POSIX qw/ WNOHANG /;
use constant HOSTNAME => qx{hostname};
my %O = (
'listen-host' => '127.0.0.1',
'listen-port' => 8080,
'listen-clients' => 30,
'listen-max-req-per-child' => 100,
);
my $d = HTTP::Daemon->new(
LocalAddr => $O{'listen-host'},
LocalPort => $O{'listen-port'},
Reuse => 1,
) or die "Can't start http listener at $O{'listen-host'}:$O{'listen-port'}";
print "Started HTTP listener at " . $d->url . "\n";
my %chld;
if ($O{'listen-clients'}) {
$SIG{CHLD} = sub {
# checkout finished children
while ((my $kid = waitpid(-1, WNOHANG)) > 0) {
delete $chld{$kid};
}
};
}
while (1) {
if ($O{'listen-clients'}) {
# prefork all at once
for (scalar(keys %chld) .. $O{'listen-clients'} - 1 ) {
my $pid = fork;
if (!defined $pid) { # error
die "Can't fork for http child $_: $!";
}
if ($pid) { # parent
$chld{$pid} = 1;
}
else { # child
$_ = 'DEFAULT' for @SIG{qw/ INT TERM CHLD /};
http_child($d);
exit;
}
}
sleep 1;
}
else {
http_child($d);
}
}
sub http_child {
my $d = shift;
my $i;
my $css = <<CSS;
form { display: inline; }
CSS
while (++$i < $O{'listen-max-req-per-child'}) {
my $c = $d->accept or last;
my $r = $c->get_request(1) or last;
$c->autoflush(1);
print sprintf("[%s] %s %s\n", $c->peerhost, $r->method, $r->uri->as_string);
my %FORM = $r->uri->query_form();
if ($r->uri->path eq '/') {
_http_response($c, { content_type => 'text/html' },
start_html(
-title => HOSTNAME,
-encoding => 'utf-8',
-style => { -code => $css },
),
p('Here are all input parameters:'),
pre(Data::Dumper->Dump([\%FORM],['FORM'])),
(map { p(a({ href => $_->[0] }, $_->[1])) }
['/', 'Home'],
['/ping', 'Ping the simple text/plain content'],
['/error', 'Sample error page'],
['/other', 'Sample not found page'],
),
end_html(),
)
}
elsif ($r->uri->path eq '/ping') {
_http_response($c, { content_type => 'text/plain' }, 1);
}
elsif ($r->uri->path eq '/error') {a
my $error = 'AAAAAAAAA! My server error!';
_http_error($c, RC_INTERNAL_SERVER_ERROR, $error);
die $error;
}
elsif ($r->method eq 'POST' and $r->uri->path eq '/formdata') {
#_http_response($c, { content_type => 'text/plain' }, 1);
print "--> begin form data <--\n";
_http_response($c, { content_type => 'text/html' },
start_html(
-title => HOSTNAME,
-encoding => 'utf-8',
-style => { -code => $css },
),
p('Here are all the input parameters:'),
pre(Data::Dumper->Dump([\%FORM],['FORM'])),
end_html(),
);
print Data::Dumper->Dump([$r], [qw(r)]);
print "--> end form data <--\n";
}
else {
_http_error($c, RC_NOT_FOUND);
}
$c->close();
undef $c;
}
}
sub _http_error {
my ($c, $code, $msg) = @_;
$c->send_error($code, $msg);
}
sub _http_response {
my $c = shift;
my $options = shift;
$c->send_response(
HTTP::Response->new(
RC_OK,
undef,
[
'Content-Type' => $options->{content_type},
'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0',
'Pragma' => 'no-cache',
'Expires' => 'Thu, 01 Dec 1994 16:00:00 GMT',
],
join("\n", @_),
)
);
}
我正在使用此curl命令连接到服务器。
$ curl -X POST -H "Content-Type: multipart/form-data; \
boundary=----------------------------4ebf00fbcf09" \
--data-binary @test.txt \
http://localhost:8080/formdata?arg1=blah1\&arg2=blah2
与此测试文件一起使用。
$ cat test.txt
This is some test text in a file.
运行时返回以下内容：
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>greeneggs.bubba.net
</title>
<style type="text/css">
<!--/* <![CDATA[ */
form { display: inline; }
/* ]]> */-->
</style>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
</head>
<body>
<p>Here are all the input parameters:</p>
<pre>$FORM = {
'arg2' => 'blah2',
'arg1' => 'blah1'
};
</pre>
</body>
</html>
如何处理服务器端多数据表单中的数据？我认为可以通过请求（$r）访问数据，但是当我使用Data :: Dumper进行分析时，我看不到任何类似于数据的内容。
通过curl命令连接到http服务器后输出：
[127.0.0.1] POST /formdata?arg1=blah1&arg2=blah2
--> begin form data <--
$r = bless( {
'_protocol' => 'HTTP/1.1',
'_content' => '',
'_uri' => bless( do{\(my $o = '/formdata?arg1=blah1&arg2=blah2')}, 'URI::http' ),
'_headers' => bless( {
'user-agent' => 'curl/7.29.0',
'content-type' => 'multipart/form-data; boundary=----------------------------4ebf00fbcf09',
'accept' => '*/*',
'content-length' => '34',
'host' => 'localhost:8080'
}, 'HTTP::Headers' ),
'_method' => 'POST'
}, 'HTTP::Request' );
--> end form data <--
我错过了什么？
答案 0 :(得分：3)
$ c-＆gt; get_request（$ headers_only）
get_request（）方法通常不会返回，直到从客户端收到整个请求。如果请求是上传大文件，那么这可能不是您想要的（并且使用分块传输编码HTTP甚至可以支持无限请求消息 - 例如上传实时音频）。如果您传递一个TRUE值作为$ headers_only参数，那么get_request（）将在解析请求标头后立即返回，并且您负责读取其余的请求内容。如果你打算在同一个连接上再次调用$ c-＆gt; get_request，你最好读取正确的字节数。
尝试更改（上面的httpsserver.pl内），
my $r = $c->get_request(1) or last;
到
my $r = $c->get_request() or last;