Как я могу получить $ cgi-> state для возврата значимой информации по HTTP :: Server :: Simple? - PullRequest
4 голосов
/ 26 февраля 2010

Во-первых, вот код, который я использую (вам потребуется версия 0.42 HTTP :: Server :: Simple для его запуска):

#!/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 Сценарий реестра или как отдельное приложение.

1 Ответ

4 голосов
/ 26 февраля 2010

Код 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;
...