CGI::Application::Server doesn't seem to handle CGI::Application's
mode_param(path_info => n) capability correctly. Here's a test that
illustrates the problem and a possible solution that worked for me.
(not tested with C::A::Dispatch.)
-- Jaldhar
| Subject: | mode_param_from_path_info.patch |
diff -ruN CGI-Application-Server-0.04.orig/lib/CGI/Application/Server.pm CGI-Application-Server-0.04/lib/CGI/Application/Server.pm
--- CGI-Application-Server-0.04.orig/lib/CGI/Application/Server.pm 2007-10-23 12:53:58.000000000 -0400
+++ CGI-Application-Server-0.04/lib/CGI/Application/Server.pm 2007-11-21 00:54:15.000000000 -0500
@@ -79,8 +79,8 @@
my $stdout;
local $ENV{CGI_APP_RETURN_ONLY} = 1;
+ (local $ENV{PATH_INFO} = $ENV{PATH_INFO}) =~ s/\A\Q$path//;
if ($target->isa('CGI::Application::Dispatch')) {
- (local $ENV{PATH_INFO} = $ENV{PATH_INFO}) =~ s/\A\Q$path//;
$stdout = $target->dispatch;
} else {
$stdout = $target->new->run;
diff -ruN CGI-Application-Server-0.04.orig/MANIFEST CGI-Application-Server-0.04/MANIFEST
--- CGI-Application-Server-0.04.orig/MANIFEST 2007-10-23 12:53:58.000000000 -0400
+++ CGI-Application-Server-0.04/MANIFEST 2007-11-21 00:50:51.000000000 -0500
@@ -9,6 +9,7 @@
t/001_basic.t
t/002_valid_entry_points.t
t/003_dispatch.t
+t/005_mode_param_from_path_info.t
t/htdocs/index.html
t/htdocs/test.css
t/htdocs/test.js
diff -ruN CGI-Application-Server-0.04.orig/t/005_mode_param_from_path_info.t CGI-Application-Server-0.04/t/005_mode_param_from_path_info.t
--- CGI-Application-Server-0.04.orig/t/005_mode_param_from_path_info.t 1969-12-31 19:00:00.000000000 -0500
+++ CGI-Application-Server-0.04/t/005_mode_param_from_path_info.t 2007-11-21 00:49:43.000000000 -0500
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use CGI::Application::Server;
+
+{
+ package TestApp;
+ use base 'CGI::Application';
+
+ sub setup {
+ my ($self) = @_;
+
+ $self->mode_param(path_info => 1);
+ $self->run_modes([qw/ foo bar /]);
+ }
+
+ sub foo {
+ my ($self) = @_;
+
+ return '<HTML><HEAD><TITLE>Hello world!</TITLE></HEAD>'
+ . '<BODY><H1>Hello world!</H1><HR></BODY></HTML>';
+ }
+
+ sub bar {
+ my ($self) = @_;
+
+ return '<HTML><HEAD><TITLE>Goodbye world!</TITLE></HEAD>'
+ . '<BODY><H1>Goodbye world!</H1><HR></BODY></HTML>';
+ }
+
+}
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+$server->entry_points({
+ '/index.cgi' => 'TestApp',
+});
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get_ok($url_root . '/index.cgi/foo', '...got run mode foo');
+$mech->title_is('Hello world!', '... got the right page title for foo');
+
+$mech->get_ok($url_root . '/index.cgi/bar', '...got run mode bar');
+$mech->title_is('Goodbye world!', '... got the right page title for bar');
+