perl - 如何让 $cgi->state 在 HTTP::Server::Simple 下返回有意义的信息？

Question

首先，这是我正在使用的代码(您需要 HTTP::Server::Simple 的 0.42 版本才能运行它):

#!/usr/bin/perl
package My::HTTP::Server;

use strict; use warnings;
use parent 'HTTP::Server::Simple::CGI';

sub handle_request {
    my $server = shift;
    my ($cgi) = @_;

    print $cgi->header('text/plain'), $cgi->state, "\n";
}

package main;
use strict; use warnings;

my $server = My::HTTP::Server->new;

$server->cgi_class('CGI::Simple');
$server->cgi_init(sub {
    require CGI::Simple;
    CGI::Simple->import(qw(-nph));
});

$server->port(8888);
$server->run;

当我启动服务器并浏览到 http://localhost:8888/here/is/something?a=1 时，我得到输出 http://localhost:8888E :\Home\Src\Test\HTTP-Server-Simple\hts.pl/here/is/something?a=1。这是因为如果 $ENV{SCRIPT_NAME} 为空或未定义，CGI::Simple 会查看 $0。所以，我认为解决方案是这样写:

$server->cgi_init(sub {
    $ENV{SCRIPT_NAME} = '/';
    require CGI::Simple;
    CGI::Simple->import(qw(-nph));
});

现在，我得到的输出是http://localhost:8888//here/is/something?a=1。请注意额外的 /。

这样可以吗，或者有更好的方法来处理这个问题吗？

我正在尝试编写一个可以部署为 mod_perl Registry Script 的应用程序或独立的应用程序。

Answer 1

CGI::Simple 用于获取脚本名称的代码是:

sub script_name    { $ENV{'SCRIPT_NAME'} || $0 || '' }

基于此，我看到了几个选择:

• 将 $ENV{SCRIPT_NAME} 和 $0 设置为 false 值
• 子类或猴子补丁CGI::易于覆盖script_name

与全局打交道让我感到紧张。更改 $0 可能是无害的。可能吧。

偏执意味着我会覆盖 script_name 以尽量减少更改的影响。

猴子修补是如此简单，它很诱人:

{ no warnings 'redefine'; sub CGI::Simple::script_name {''} }

但是适当的子类并不太难，并且它确实可以最大程度地减少影响(但是您的应用程序中可能有多个 CGI::Simple 对象吗？):

package CGI::Simple::NoScriptName;

use base 'CGI::Simple';

sub script_name {''};

1;