如何让$ cgi-> gt状态在HTTP :: Server :: Simple下返回有意义的信息?

时间:2010-02-26 00:19:53

标签: perl cgi httpserver

首先,这是我正在使用的代码(你需要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。这是因为如果CGI::Simple为空或未定义,$0会查看$ENV{SCRIPT_NAME}。所以,我认为解决方案是写:

$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或独立应用程序的应用程序。

1 个答案:

答案 0 :(得分:4)

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

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

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

  • $ENV{SCRIPT_NAME}$0设置为错误值
  • 子类或猴子补丁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;