| Subject: | [PATCH] reinitialize $query between runs when entry point is an object |
Back in December, I discovered a problem with CGI::Application::Server
when the entry point is an object. It seems the query object does not
get reinitialized between runs. The practical upshot is that for
instance, the params you passed the first time you access the server
will remain in effect until you restart the server. Needless to say
this is the wrong behavior!
After bringing this up on the cgiapp list, (see here:
http://www.erlbaum.net/pipermail/cgiapp/2008q4/000954.html ) it was
decided that a proper fix required changes in CGI::Application as well
as this module. Mark made the necessary change in CGI::Application 4.21
so now here is a patch for CGI::Application::Server. It includes tests
as well.
| Subject: | cgi-application-server.diff |
diff -ruN CGI-Application-Server-0.060.orig/Build.PL CGI-Application-Server-0.060/Build.PL
--- CGI-Application-Server-0.060.orig/Build.PL 2008-11-02 22:07:12.000000000 -0500
+++ CGI-Application-Server-0.060/Build.PL 2009-01-06 18:10:15.000000000 -0500
@@ -10,7 +10,7 @@
'Carp' => '0.01',
'HTTP::Request' => '0',
'HTTP::Status' => '0',
- 'CGI::Application' => '0',
+ 'CGI::Application' => '4.21',
'HTTP::Server::Simple' => '0.18',
'HTTP::Server::Simple::Static' => '0.02',
},
diff -ruN CGI-Application-Server-0.060.orig/lib/CGI/Application/Server.pm CGI-Application-Server-0.060/lib/CGI/Application/Server.pm
--- CGI-Application-Server-0.060.orig/lib/CGI/Application/Server.pm 2008-11-02 22:07:12.000000000 -0500
+++ CGI-Application-Server-0.060/lib/CGI/Application/Server.pm 2009-01-06 16:50:46.000000000 -0500
@@ -92,6 +92,7 @@
if (!defined blessed $target) {
return $self->_serve_response($target->new->run);
} else {
+ $target->query($cgi);
return $self->_serve_response($target->run);
}
}
diff -ruN CGI-Application-Server-0.060.orig/MANIFEST CGI-Application-Server-0.060/MANIFEST
--- CGI-Application-Server-0.060.orig/MANIFEST 2008-11-02 22:07:12.000000000 -0500
+++ CGI-Application-Server-0.060/MANIFEST 2009-01-06 18:06:30.000000000 -0500
@@ -11,11 +11,13 @@
t/003_dispatch.t
t/004_object_as_entry_point.t
t/005_mode_param_from_path_info.t
+t/006_replacequeryobject.t
t/htdocs/index.html
t/htdocs/test.css
t/htdocs/test.js
t/lib/AppWithParams.pm
t/lib/MyCGIApp.pm
t/lib/MyCGIApp/Dispatch.pm
+t/lib/ReplaceQueryObject.pm
t/pod.t
t/pod_coverage.t
diff -ruN CGI-Application-Server-0.060.orig/t/006_replacequeryobject.t CGI-Application-Server-0.060/t/006_replacequeryobject.t
--- CGI-Application-Server-0.060.orig/t/006_replacequeryobject.t 1969-12-31 19:00:00.000000000 -0500
+++ CGI-Application-Server-0.060/t/006_replacequeryobject.t 2009-01-06 17:59:30.000000000 -0500
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use CGI::Application::Server;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use lib 't/lib';
+use ReplaceQueryObject;
+
+my $app = ReplaceQueryObject->new();
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+
+$server->entry_points({
+ '/one.cgi' => $app,
+ '/two.cgi' => 'ReplaceQueryObject',
+});
+
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get($url_root . '/one.cgi?text=foo');
+$mech->title_is('foo', '... got foo with CGI::Application object');
+
+$mech->get($url_root . '/one.cgi?text=bar');
+$mech->title_is('bar', '... got bar with CGI::Application object');
+
+$mech->get($url_root . '/two.cgi?text=foo');
+$mech->title_is('foo', '... got foo with CGI::Application class');
+
+$mech->get($url_root . '/two.cgi?text=bar');
+$mech->title_is('bar', '... got bar with CGI::Application class');
+
diff -ruN CGI-Application-Server-0.060.orig/t/lib/ReplaceQueryObject.pm CGI-Application-Server-0.060/t/lib/ReplaceQueryObject.pm
--- CGI-Application-Server-0.060.orig/t/lib/ReplaceQueryObject.pm 1969-12-31 19:00:00.000000000 -0500
+++ CGI-Application-Server-0.060/t/lib/ReplaceQueryObject.pm 2009-01-06 17:44:03.000000000 -0500
@@ -0,0 +1,21 @@
+package ReplaceQueryObject;
+use base 'CGI::Application';
+use warnings;
+use strict;
+
+sub setup {
+ my ($self) = @_;
+ $self->run_modes([qw/ start /]);
+}
+
+sub start {
+ my ($self) = @_;
+ my $q = $self->query;
+ return join "\n",
+ $q->start_html($q->param('text')) .
+ $q->end_html
+ ;
+}
+
+1;
+