[cgiapp] CAD::Server strangeness
Bradley C Bailey
cgiapp at brad.memoryleak.org
Sat Sep 13 18:20:42 EDT 2008
> 2) I think that "someone" (I think that Mark Stosberg holds the keys
> to CAD::Server at the moment, I'd be happy to take them back)
> should make some changes to ::Server.
>
> - change new() so that it stashes a copy of $p{class} into
> $self->{_class} and no longer saves
> $p{class}->dispatch_args.
>
> - delete the entire ::Server::dispatch_args method.
>
> - change handle_request() so that instead of
>
> CGI::Application::Dispatch->dispatch(%{$self->{dispatch_args}})
>
> it just does
>
> $self->{_class}->dispatch();
>
> and let's the CGI::Application::Dispatch {,sub}class do the
> right thing.
>
> - add some tests to the package. Any tests would be a start.
>
> 3) I think that CGI::Application::Dispatch::dispatch is being too
> clever/helpful/broken in how it handles dispatch_args. In
> particular, if someone calls dispatch with a hash that contains an
> args_to_new hash which in turn contains a TMPL_PATH array ref, then
> dispatch() ends up duplicating that array's values.
>
> Number 2) above is the quickest fix to the problem. Mark?
>
> Number 1) will be necessary once number 2) is in place and is already
> necessary if you want to run under fastcgi.
>
> Number 3) seems to be a problem that no one has had yet but it's
> lurking.
For what it's worth, about 6 months ago I was playing with CAD::Server
and started fixing a bunch of the things you mentioned. I have attached
a patch if anyone wishes to finish where I left off.
I can not recall, but I think I originally tried CA::Server, but could
not get it to work which is why I then started using CAD::Server. My
personal opinion would be to just update CA::Server to work with or
without CA::Dispatch.
Hopefully one of these days I will find time to start working on my
cgiapp projects again.
Regards,
Bradley C Bailey
-------------- next part --------------
diff -ruN CGI-Application-Dispatch-Server-0.52.orig/lib/CGI/Application/Dispatch/Server.pm CGI-Application-Dispatch-Server-0.52/lib/CGI/Application/Dispatch/Server.pm
--- CGI-Application-Dispatch-Server-0.52.orig/lib/CGI/Application/Dispatch/Server.pm 2007-07-07 06:49:22.000000000 -0600
+++ CGI-Application-Dispatch-Server-0.52/lib/CGI/Application/Dispatch/Server.pm 2008-03-13 18:58:39.000000000 -0600
@@ -11,52 +11,70 @@
use HTTP::Status;
use IO::Capture::Stdout;
use CGI::Application::Dispatch;
-use Params::Validate ':all';
-our $VERSION = '0.52';
+our $VERSION = '0.53_01';
-use base qw(
- HTTP::Server::Simple::CGI
- HTTP::Server::Simple::Static
- );
+use base qw(HTTP::Server::Simple::CGI);
+use HTTP::Server::Simple::Static;
# HTTP::Server::Simple methods
sub new {
- my $class = shift;
- my %p = validate(@_, {
- port => { default => '8080',},
- class => { default => 'CGI::Application::Dispatch' },
- root_dir => { default => '.' }
- });
+ my $class = shift;
+ my %p = @_;
+ my $self = $class->SUPER::new($p{port} || '8080');
+ $self->root_dir($p{root_dir}) if (exists $p{root_dir});
+ $self->dispatch_class($p{class}) if (exists $p{class});
+
+ return $self;
+}
+
+# accessors
+
+sub root_dir
+{
+ my ($self, $dir) = @_;
+
+ if (defined $dir) {
# Reality check, is "root_dir really a directory?
- unless (-d $p{root_dir}) {
- croak "root_dir does not appear to a directory. The path provided was: $p{root_dir} ";
- }
+ croak "The specified root_dir ($dir) does not appear to be a directory."
+ unless (-d $dir);
+
+ $self->{root_dir} = $dir;
+ }
- my $self = $class->SUPER::new($p{port});
+ return $self->{root_dir} || '.';
+}
- $self->{root_dir} = $p{root_dir};
+sub dispatch_class {
+ my ($self, $class) = @_;
+ if (defined $class) {
# XXX add reality check that the class has dispatch_args method first?
- eval "require $p{class}" || croak $@;
+ eval "require $class" || croak $@;
+ $self->{dispatch_class} = $class;
+ }
- $self->{dispatch_args} = $p{class}->dispatch_args;
- return $self;
+ return $self->{dispatch_class} || 'CGI::Application::Dispatch';
}
-# accessors
-
sub dispatch_args {
my ($self, $new_args) = @_;
+
if (defined $new_args) {
(reftype($new_args) && reftype($new_args) eq 'HASH') ||
confess "The new_args must be a HASH ref, not $new_args";
+
+ # grab the current dispatch_args from the dispatch_class
+ $self->{dispatch_args} = $self->dispatch_class->dispatch_args
+ if (!defined $self->{dispatch_args});
+
# merge the new args into the defaults.
@{$self->{dispatch_args}}{keys %$new_args} = values %$new_args;
}
- return $self->{dispatch_args} ;
+
+ return $self->{dispatch_args};
}
sub handle_request {
@@ -64,12 +82,12 @@
# If the the request doesn't map to a static file that exists,
# try our dispatch table.
- unless ( $self->serve_static($cgi, $self->{root_dir}) ) {
+ unless ( $self->serve_static($cgi, $self->root_dir) ) {
# warn "$ENV{REQUEST_URI}\n";
# warn "\t$_ => " . param( $_ ) . "\n" for param();
my $capture = IO::Capture::Stdout->new;
$capture->start;
- CGI::Application::Dispatch->dispatch(%{$self->{dispatch_args}});
+ $self->dispatch_class->dispatch(%{$self->{dispatch_args}});
$capture->stop;
my $stdout = join "\x0d\x0a", $capture->read;
my $response = $self->_build_response( $stdout );
@@ -174,20 +192,63 @@
root_dir => './alphasite', # optional, defaults to "."
);
-Initialize the server. If you've subclassed CGI::Application::Dispatch to provide your own
-C<dispatch_args()>, let us know that here.
+Initialize the server. The options to the constructor are described below.
-If you are also serving some static content, define "root_dir" with the root directory
-of this content.
+=over 4
-=head1 Other Methods You Probably Don't Need to Know About
+=item class
+
+If you are using a subclass of
+L<CGI::Application::Dispatch|CGI::Application::Dispatch> specify that here.
+This will default to C<CGI::Application::Dispatch>.
+
+=item port
+
+Specify the port to listen on. By default it will listen on 8080.
+
+=item root_dir
+
+If you are serving any static content, specify the directory here. By default
+it will check for static content in the current directory (C<.>).
+
+=back
+
+Since the returned object is a subclass of L<HTTP::Server::Simple::CGI>, any
+methods supported by it will also be supported.
+
+=head2 root_dir()
+
+ $server->root_dir("/path/to/content");
+ my $dir = $server->root_dir;
+
+Get or set the value of the root directory. This directory is used for serving
+static content. The default value is the current directory (C<.>).
+
+This method verifies that the parameter is indeed a directory and will throw
+an error if it is not.
+
+=head2 dispatch_class()
+
+ $server->dispatch_class('My::Custom::Dispatch');
+ my $class = $server->dispatch_class;
+
+Get or set the current dispatch class to use. This is initially set to the
+value of the C<class> parameter when creating a new object. You will not
+likely ever need to call it directly. The default value is
+C<CGI::Application::Dispatch>.
+
+When setting the class, specify a the class name as a string. The class is
+automatically loaded when set and it will throw an error if there were any
+errors during the loading.
=head2 dispatch_args()
$server->dispatch_args(\%override_args);
-This accepts a hashref of arguments and merges it into
-L<CGI::Application::Dispatch|CGI::Application::Dispatch>'s dispatch() arguments.
+This accepts a hashref of arguments and merges it into the C<dispatch_args>
+of the C<dispatch_class>. This first time this is called the C<dispatch_args>
+are retrieved from the C<dispatch_class> and the specified values merged into
+it.
Be aware that this is a shallow merge, so a top level key name in the new hash
will completely replace one in the old hash with the same name.
@@ -195,6 +256,8 @@
It is recommended that you put your dispatch args in a separate class instead, as mentioned
in the L<DESCRIPTION>.
+=head1 Other Methods You Probably Don't Need to Know About
+
=head2 handle_request()
$self->handle_request($cgi);
@@ -222,6 +285,7 @@
George Hartzell E<lt>hartzell at alerce.comE<gt>
Mark Stosberg
+Bradley C Bailey
=head1 COPYRIGHT AND LICENSE
diff -ruN CGI-Application-Dispatch-Server-0.52.orig/Makefile.PL CGI-Application-Dispatch-Server-0.52/Makefile.PL
--- CGI-Application-Dispatch-Server-0.52.orig/Makefile.PL 2007-07-07 06:49:22.000000000 -0600
+++ CGI-Application-Dispatch-Server-0.52/Makefile.PL 2008-03-04 17:25:23.000000000 -0700
@@ -15,7 +15,6 @@
'Test::More' => '0.47',
'HTTP::Server::Simple' => '0.18',
'CGI::Application' => '0',
- 'Params::Validate' => 0,
'CGI::Application::Dispatch' => '0',
'HTTP::Server::Simple::CGI' => 0,
'HTTP::Request' => '0',
diff -ruN CGI-Application-Dispatch-Server-0.52.orig/t/01-basic.t CGI-Application-Dispatch-Server-0.52/t/01-basic.t
--- CGI-Application-Dispatch-Server-0.52.orig/t/01-basic.t 1969-12-31 17:00:00.000000000 -0700
+++ CGI-Application-Dispatch-Server-0.52/t/01-basic.t 2008-03-04 17:35:25.000000000 -0700
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+use Test::More 'no_plan';
+use File::Basename;
+use strict;
+
+BEGIN { use_ok('CGI::Application::Dispatch::Server'); }
+
+my $server = bless { }, 'CGI::Application::Dispatch::Server';
+
+# Default values
+is($server->root_dir, '.', "default root_dir");
+is($server->dispatch_class, 'CGI::Application::Dispatch', "default class");
+is($server->dispatch_args, undef, "default dispatch_args is undef");
+
+# Setting root directory
+eval { $server->root_dir("/path/to/invalid") };
+like($@, qr/does not appear to be a directory/, "invalid root_dir error");
+ok($server->root_dir(dirname(__FILE__)), "setting root_dir"); # XXX
+is($server->root_dir, dirname(__FILE__), " got back correct value");
+
+# Merging in dispatch_args
+my $dispatch_args = CGI::Application::Dispatch->dispatch_args;
+ok($server->dispatch_args({ }), "setting dispatch args");
+is_deeply($server->dispatch_args, $dispatch_args, " nothing changed");
+ok($server->dispatch_args({ default => 'testing' }), "merging test arg");
+is($server->dispatch_args->{default}, 'testing', " value merged");
More information about the cgiapp
mailing list