How can I get $cgi->state to return meaningful information under HTTP::Server::Simple?

Question

First, here is the code I am using (you'll need version 0.42 of HTTP::Server::Simple to run it):

#!/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;

When I start the server and browse to http://localhost:8888/here/is/something?a=1, I get the output http://localhost:8888E:\Home\Src\Test\HTTP-Server-Simple\hts.pl/here/is/something?a=1. That is because CGI::Simple looks at $0 if $ENV{SCRIPT_NAME} is empty or undefined. So, I thought the solution would be to write:

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

Now, the output I get is http://localhost:8888//here/is/something?a=1. Note the extra /.

Is that OK or is there a better way of dealing with this?

I am trying to write an application which can be deployed as a mod_perl Registry Script or a standalone application.

Answer 1

The code CGI::Simple uses to get the script name is:

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

Based on this, I see a couple of choices:

• set $ENV{SCRIPT_NAME} and $0 to a false value
• subclass or monkey-patch CGI::Simple to override script_name

Messing with a global makes me nervous. Changing $0 is probably harmless. Probably.

Paranoia means I'd override script_name to minimize the impact of my changes.

Monkey patching is so easy, it's seductive:

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

But a proper subclass isn't too hard, and it does minimize impact (but are you likely to have multiple CGI::Simple objects in your app?):

package CGI::Simple::NoScriptName;

use base 'CGI::Simple';

sub script_name {''};

1;