From: Rafael Kitover Date: Wed, 7 Apr 2010 16:26:24 +0000 (+0000) Subject: added cgi_chain_root X-Git-Tag: 0.030~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Controller-WrapCGI.git;a=commitdiff_plain;h=1d40d9c3ce5fb228adaa52cdefecfa76929853c6;hp=1a48e9358fcf4ca948f323f9dc7a3ec5899ed335 added cgi_chain_root --- diff --git a/Changes b/Changes index f32f79e..65c51f6 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ Revision history for Catalyst-Controller-WrapCGI + - added cgi_chain_root option for CGIBin + 0.027 2010-02-19 04:34:50 - fix tests for Perl < 5.8.9 - fix for HTTP::Request::AsCGI 1.2 diff --git a/Makefile.PL b/Makefile.PL index 3a82a4e..7debb3c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -4,6 +4,9 @@ name 'Catalyst-Controller-WrapCGI'; all_from 'lib/Catalyst/Controller/WrapCGI.pm'; author 'Matt S. Trout '; +test_requires 'Catalyst::Plugin::Static::Simple'; +test_requires 'CGI'; + requires 'Catalyst' => '5.80015'; requires 'HTTP::Request::AsCGI' => '1.2'; requires 'CGI::Compile' => '0.07'; @@ -17,9 +20,6 @@ requires 'Task::Weaken'; requires 'LWP'; requires 'Moose'; -test_requires 'Catalyst::Plugin::Static::Simple'; -test_requires 'CGI'; - build_requires 'Test::More' => '0.92'; auto_provides; diff --git a/lib/Catalyst/Controller/CGIBin.pm b/lib/Catalyst/Controller/CGIBin.pm index 9cb89b7..52bb1a2 100644 --- a/lib/Catalyst/Controller/CGIBin.pm +++ b/lib/Catalyst/Controller/CGIBin.pm @@ -41,8 +41,9 @@ In your controller: In your .conf: - cgi_root_path cgi-bin - cgi_dir cgi-bin + cgi_root_path cgi-bin + cgi_dir cgi-bin + cgi_chain_root /optional/private/path/to/Chained/root username_field username # used for REMOTE_USER env var pass_env PERL5LIB @@ -69,6 +70,19 @@ module for other configuration information. The global URI path prefix for CGIs, defaults to C. +=head2 cgi_chain_root + +By default L actions are created for CGIs, +but if you specify this option, the actions will be created as +L end-points, chaining off the +specified private path. + +If this option is used, the L option is ignored. The root path +will be determined by your chain. + +The L of the action will be +the path to the CGI file. + =head2 cgi_dir Path from which to read CGI files. Can be relative to C<$MYAPP_HOME/root> or @@ -76,8 +90,9 @@ absolute. Defaults to C<$MYAPP_HOME/root/cgi-bin>. =cut -has cgi_root_path => (is => 'ro', isa => 'Str', default => 'cgi-bin'); -has cgi_dir => (is => 'ro', isa => 'Str', default => 'cgi-bin'); +has cgi_root_path => (is => 'ro', isa => 'Str', default => 'cgi-bin'); +has cgi_chain_root => (is => 'ro', isa => 'Str'); +has cgi_dir => (is => 'ro', isa => 'Str', default => 'cgi-bin'); sub register_actions { my ($self, $app) = @_; @@ -98,9 +113,16 @@ sub register_actions { my $path = join '/' => splitdir($cgi_path); my $action_name = $self->cgi_action($path); - my $public_path = $self->cgi_path($path); my $reverse = $namespace ? "$namespace/$action_name" : $action_name; - my $attrs = { Path => [ $public_path ] }; + + my $attrs = do { + if (my $chain_root = $self->cgi_chain_root) { + { Chained => [ $chain_root ], PathPart => [ $path ], Args => [] }; + } + else { + { Path => [ $self->cgi_path($path) ] }; + } + }; my ($cgi, $type); diff --git a/t/cgibin_root.t b/t/cgibin_chain_root.t similarity index 50% copy from t/cgibin_root.t copy to t/cgibin_chain_root.t index 876fbe7..cc0c784 100644 --- a/t/cgibin_root.t +++ b/t/cgibin_chain_root.t @@ -8,14 +8,14 @@ use lib "$Bin/lib"; use Test::More tests => 1; -use Catalyst::Test 'TestCGIBinRoot'; +use Catalyst::Test 'TestCGIBinChainRoot'; use HTTP::Request::Common; -# Test configurable path root and dir +# Test configurable path root and dir, and Chained root my $response = request POST '/cgi/path/test.pl', [ foo => 'bar', - bar => 'baz' + bar => 'baz', ]; -is($response->content, 'foo:bar bar:baz', 'POST to Perl CGI File'); +is($response->content, 'foo:bar bar:baz from_chain:from_chain', 'POST to Perl CGI File'); diff --git a/t/cgibin_root.t b/t/cgibin_root_path.t similarity index 100% rename from t/cgibin_root.t rename to t/cgibin_root_path.t diff --git a/t/lib/TestCGIBinChainRoot.pm b/t/lib/TestCGIBinChainRoot.pm new file mode 100644 index 0000000..fe50103 --- /dev/null +++ b/t/lib/TestCGIBinChainRoot.pm @@ -0,0 +1,15 @@ +package TestCGIBinChainRoot; + +use Catalyst::Runtime '5.70'; +use parent 'Catalyst'; + +__PACKAGE__->config({ + Controller::CGIHandler => { + cgi_chain_root => '/cgihandler/chain_root', + cgi_dir => 'cgi', + } +}); + +__PACKAGE__->setup(qw/Static::Simple/); + +1; diff --git a/t/lib/TestCGIBinChainRoot/Controller/CGIHandler.pm b/t/lib/TestCGIBinChainRoot/Controller/CGIHandler.pm new file mode 100644 index 0000000..4867e5f --- /dev/null +++ b/t/lib/TestCGIBinChainRoot/Controller/CGIHandler.pm @@ -0,0 +1,11 @@ +package TestCGIBinChainRoot::Controller::CGIHandler; + +use parent 'Catalyst::Controller::CGIBin'; + +sub chain_root : Chained('/') PathPart('cgi') CaptureArgs(0) { + my ($self, $c) = @_; + + $c->req->body_parameters->{from_chain} = 'from_chain'; +} + +1; diff --git a/t/lib/TestCGIBinChainRoot/root/cgi/path/test.pl b/t/lib/TestCGIBinChainRoot/root/cgi/path/test.pl new file mode 100755 index 0000000..3bff333 --- /dev/null +++ b/t/lib/TestCGIBinChainRoot/root/cgi/path/test.pl @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use CGI ':standard'; + +die '$ENV{MOD_PERL} must not be set' if $ENV{MOD_PERL}; + +print header; +print 'foo:',param('foo'),' bar:',param('bar') + ,' from_chain:',param('from_chain');