| Subject: | Patch to allow objects as entry points |
Here is a patch to allow previously created CGI::Application objects
to be used as entry points. It has not been tested with ::Dispatch
but otherwise works for me.
-- Jaldhar
| Subject: | object_as_entry_point.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-20 02:46:15.000000000 -0500
@@ -82,8 +82,17 @@
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;
+ }
+ elsif ($target->isa('CGI::Application')) {
+ if (!defined reftype $target) {
+ $stdout = $target->new->run;
+ }
+ else {
+ $stdout = $target->run;
+ }
+ }
+ else {
+ confess "Target must be a CGI::Application subclass\n";
}
my $response = $self->_build_response( $stdout );
@@ -162,11 +171,15 @@
use CGI::Application::Server;
my $server = CGI::Application::Server->new();
+
+ my $object = MyOtherCGIApp->new(PARAMS => { foo => 1, bar => 2 });
+
$server->document_root('./htdocs');
$server->entry_points({
'/index.cgi' => 'MyCGIApp',
'/admin' => 'MyCGIApp::Admin',
'/account' => 'MyCGIApp::Account::Dispatch',
+ '/users' => $object,
});
$server->run();
@@ -197,7 +210,7 @@
This accepts a HASH reference in C<$entry_points>, which maps server entry
points (uri) to L<CGI::Application> or L<CGI::Application::Dispatch> class
-names. See the L<SYNOPSIS> above for an example.
+names or objects. See the L<SYNOPSIS> above for examples.
=item B<is_valid_entry_point ($uri)>
diff -ruN CGI-Application-Server-0.04.orig/t/004_object_as_entry_point.t CGI-Application-Server-0.04/t/004_object_as_entry_point.t
--- CGI-Application-Server-0.04.orig/t/004_object_as_entry_point.t 1969-12-31 19:00:00.000000000 -0500
+++ CGI-Application-Server-0.04/t/004_object_as_entry_point.t 2007-11-20 02:30:23.000000000 -0500
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use CGI::Application::Server;
+use lib 't/lib';
+use AppWithParams;
+
+my $app1 = AppWithParams->new(PARAMS => {
+ message => 'Hello world!',
+});
+
+my $app2 = AppWithParams->new(PARAMS => {
+ message => 'Goodbye world!',
+});
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+$server->entry_points({
+ '/foo/index.cgi' => $app1,
+ '/bar/index.cgi' => $app2,
+});
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get_ok($url_root . '/foo/index.cgi', '...got app1');
+$mech->title_is('Hello world!', '... got the right page title for app1');
+
+$mech->get_ok($url_root . '/bar/index.cgi', '...got app1');
+$mech->title_is('Goodbye world!', '... got the right page title for app2');
+
diff -ruN CGI-Application-Server-0.04.orig/t/lib/AppWithParams.pm CGI-Application-Server-0.04/t/lib/AppWithParams.pm
--- CGI-Application-Server-0.04.orig/t/lib/AppWithParams.pm 1969-12-31 19:00:00.000000000 -0500
+++ CGI-Application-Server-0.04/t/lib/AppWithParams.pm 2007-11-20 02:32:28.000000000 -0500
@@ -0,0 +1,26 @@
+package AppWithParams;
+
+use base 'CGI::Application';
+
+use CGI::Application::Plugin::Redirect;
+
+sub setup {
+ my $self = shift;
+ $self->start_mode('mode1');
+ $self->mode_param('rm');
+ $self->run_modes(
+ 'mode1' => 'a_run_mode',
+ );
+}
+
+sub a_run_mode {
+ my ($self) = @_;
+
+ return '<HTML><TITLE>'
+ . $self->param('message')
+ . '</TITLE><BODY><H1>'
+ . $self->param('message')
+ . "</H1><HR></BODY></HTML>";
+}
+
+1;