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

Question

Firstly, here is the code I'm using (you will 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 look at 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 . This is because CGI::Simple looks at $0 if $ENV{SCRIPT_NAME} empty or undefined. So, I thought the solution would be this:

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

Now I get the output http://localhost:8888//here/is/something?a=1 . Pay attention to additional / .

Is this normal or is there a better way to handle this?

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

Answer 1

CGI::Simple code is used to get the script name:

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

Based on this, I see several options:

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

Messing with global makes me nervous. Changing $0 is harmless. Maybe.

Paranoia means that I would override script_name to minimize the impact of my changes.

The monkey patch is so simple, it is seductive:

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

But the correct subclass is not too complicated, and it minimizes the impact (but you probably have several CGI :: Simple objects in your application?):

 package CGI::Simple::NoScriptName; use base 'CGI::Simple'; sub script_name {''}; 1;