Index: t/htdocs/images/index.html
===================================================================
--- t/htdocs/images/index.html (.../trunk) (revision 0)
+++ t/htdocs/images/index.html (.../branches/static-content) (revision 18)
@@ -0,0 +1,9 @@
+
+
+ 1000 Words!
+
+
+Bar
+Bar
+
+
Index: t/htdocs/static/index.html
===================================================================
--- t/htdocs/static/index.html (.../trunk) (revision 0)
+++ t/htdocs/static/index.html (.../branches/static-content) (revision 18)
@@ -0,0 +1,9 @@
+
+
+ White Noise!
+
+
+Foo
+Foo
+
+
Index: t/006_docroot_as_entry_point.t
===================================================================
--- t/006_docroot_as_entry_point.t (.../trunk) (revision 0)
+++ t/006_docroot_as_entry_point.t (.../branches/static-content) (revision 18)
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use CGI::Application::Server;
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+$server->entry_points({
+ '/static' => 't/htdocs',
+ '/images' => 't/htdocs',
+});
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get_ok($url_root . '/static/index.html', '...got /static/index.html');
+$mech->title_is('White Noise!', '... got the right page title w/ static page');
+
+$mech->get_ok($url_root . '/images/index.html', '...got /images/index.html');
+$mech->title_is('1000 Words!', '... got the right page title w/ images page');
+
Index: lib/CGI/Application/Server.pm
===================================================================
--- lib/CGI/Application/Server.pm (.../trunk) (revision 18)
+++ lib/CGI/Application/Server.pm (.../branches/static-content) (revision 18)
@@ -77,29 +77,38 @@
warn "$ENV{REQUEST_URI} ($target)\n";
warn "\t$_ => " . param( $_ ) . "\n" for param();
- 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')) {
- $stdout = $target->dispatch;
+ if (-d $target && -x $target) {
+ return $self->serve_static($cgi, $target);
+ }
+ elsif ($target->isa('CGI::Application::Dispatch')) {
+ return $self->serve_response($target->dispatch);
} elsif ($target->isa('CGI::Application')) {
if (!defined blessed $target) {
- $stdout = $target->new->run;
+ return $self->serve_response($target->new->run);
} else {
- $stdout = $target->run;
+ return $self->serve_response($target->run);
}
- } else {
- confess "Target must be a CGI::Application or CGI::Application::Dispatch subclass\n";
+ }
+ else {
+ confess "Target must be a CGI::Application or CGI::Application::Dispatch subclass or the name of a directory that exists and is readable.\n";
}
-
- my $response = $self->_build_response( $stdout );
- print $response->as_string;
} else {
return $self->serve_static($cgi, $self->document_root);
}
}
+sub serve_response {
+ my ( $self, $stdout ) = @_;
+
+ my $response = $self->_build_response( $stdout );
+ print $response->as_string();
+
+ return 1; # Like ...Simple::Static::serve_static does
+}
+
# Shamelessly stolen from HTTP::Request::AsCGI by chansen
sub _build_response {
my ( $self, $stdout ) = @_;
@@ -177,6 +186,7 @@
'/admin' => 'MyCGIApp::Admin',
'/account' => 'MyCGIApp::Account::Dispatch',
'/users' => $object,
+ '/static' => '/usr/local/htdocs',
});
$server->run();
@@ -207,7 +217,8 @@
This accepts a HASH reference in C<$entry_points>, which maps server entry
points (uri) to L or L class
-names or objects. See the L above for examples.
+names or objects or to directories from which static content will be served
+by HTTP::Server::Simple::Static. See the L above for examples.
=item B