[Catalyst-commits] r9876 - in trunk/Catalyst-Controller-WrapCGI: .
lib/Catalyst/Controller t t/lib/TestApp/Controller
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Mon Apr 27 03:07:15 GMT 2009
Author: caelum
Date: 2009-04-27 04:07:15 +0100 (Mon, 27 Apr 2009)
New Revision: 9876
Modified:
trunk/Catalyst-Controller-WrapCGI/Changes
trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm
trunk/Catalyst-Controller-WrapCGI/t/lib/TestApp/Controller/Root.pm
trunk/Catalyst-Controller-WrapCGI/t/wrap-cgi.t
Log:
C::C::WrapCGI - add PATH_INFO support
Modified: trunk/Catalyst-Controller-WrapCGI/Changes
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/Changes 2009-04-27 03:01:41 UTC (rev 9875)
+++ trunk/Catalyst-Controller-WrapCGI/Changes 2009-04-27 03:07:15 UTC (rev 9876)
@@ -1,5 +1,8 @@
Revision history for Catalyst-Controller-WrapCGI
+ - configurable cgi_dir
+ - support for PATH_INFO
+
0.0029 2009-04-26 20:54:28
- Allow more control over public paths to CGIBin actions. (confound)
- Override exit() in CGIBin-wrapped Perl cgis to avoid terminating the
Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm 2009-04-27 03:01:41 UTC (rev 9875)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm 2009-04-27 03:07:15 UTC (rev 9876)
@@ -22,11 +22,11 @@
=head1 VERSION
-Version 0.007
+Version 0.008
=cut
-our $VERSION = '0.007';
+our $VERSION = '0.008';
=head1 SYNOPSIS
@@ -287,10 +287,12 @@
L<Catalyst::Controller::WrapCGI>, L<CatalystX::GlobalContext>,
L<Catalyst::Controller>, L<CGI>, L<Catalyst>
-=head1 AUTHOR
+=head1 AUTHORS
Rafael Kitover, C<< <rkitover at cpan.org> >>
+Hans Dieter Pearcey, C<< <hdp at cpan.org> >>
+
=head1 BUGS
Please report any bugs or feature requests to C<bug-catalyst-controller-wrapcgi at
Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm 2009-04-27 03:01:41 UTC (rev 9875)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm 2009-04-27 03:07:15 UTC (rev 9876)
@@ -5,9 +5,9 @@
extends 'Catalyst::Controller';
-use HTTP::Request::AsCGI;
-use HTTP::Request;
-use URI;
+use HTTP::Request::AsCGI ();
+use HTTP::Request ();
+use URI ();
use Catalyst::Exception ();
=head1 NAME
@@ -16,11 +16,11 @@
=head1 VERSION
-Version 0.0029
+Version 0.0030
=cut
-our $VERSION = '0.0029';
+our $VERSION = '0.0030';
=head1 SYNOPSIS
@@ -102,6 +102,7 @@
sub cgi_to_response {
my ($self, $c, $script) = @_;
+
my $res = $self->wrap_cgi($c, $script);
# if the CGI doesn't set the response code but sets location they were
@@ -133,42 +134,6 @@
=cut
-sub _filtered_env {
- my ($self, $env) = @_;
- my @ok;
-
- my $pass_env = $self->{CGI}{pass_env};
- $pass_env = [] if not defined $pass_env;
- $pass_env = [ $pass_env ] unless ref $pass_env;
-
- my $kill_env = $self->{CGI}{kill_env};
- $kill_env = [ 'MOD_PERL' ] unless defined $kill_env;
- $kill_env = [ $kill_env ] unless ref $kill_env;
-
- if (@$pass_env) {
- for (@$pass_env) {
- if (m!^/(.*)/\z!) {
- my $re = qr/$1/;
- push @ok, grep /$re/, keys %$env;
- } else {
- push @ok, $_;
- }
- }
- } else {
- @ok = keys %$env;
- }
-
- for my $k (@$kill_env) {
- if ($k =~ m!^/(.*)/\z!) {
- my $re = qr/$1/;
- @ok = grep { ! /$re/ } @ok;
- } else {
- @ok = grep { $_ ne $k } @ok;
- }
- }
- return { map {; $_ => $env->{$_} } @ok };
-}
-
sub wrap_cgi {
my ($self, $c, $call) = @_;
my $req = HTTP::Request->new(
@@ -201,10 +166,14 @@
my $username = (($c->can('user_exists') && $c->user_exists)
? eval { $c->user->obj->$username_field }
: '');
+
+ my $path_info = '/'.join '/' => @{ $c->req->args };
+
my $env = HTTP::Request::AsCGI->new(
$req,
($username ? (REMOTE_USER => $username) : ()),
%$filtered_env,
+ PATH_INFO => $path_info
);
{
@@ -230,6 +199,43 @@
return $env->response;
}
+sub _filtered_env {
+ my ($self, $env) = @_;
+ my @ok;
+
+ my $pass_env = $self->{CGI}{pass_env};
+ $pass_env = [] if not defined $pass_env;
+ $pass_env = [ $pass_env ] unless ref $pass_env;
+
+ my $kill_env = $self->{CGI}{kill_env};
+ $kill_env = [ 'MOD_PERL' ] unless defined $kill_env;
+ $kill_env = [ $kill_env ] unless ref $kill_env;
+
+ if (@$pass_env) {
+ for (@$pass_env) {
+ if (m!^/(.*)/\z!) {
+ my $re = qr/$1/;
+ push @ok, grep /$re/, keys %$env;
+ } else {
+ push @ok, $_;
+ }
+ }
+ } else {
+ @ok = keys %$env;
+ }
+
+ for my $k (@$kill_env) {
+ if ($k =~ m!^/(.*)/\z!) {
+ my $re = qr/$1/;
+ @ok = grep { ! /$re/ } @ok;
+ } else {
+ @ok = grep { $_ ne $k } @ok;
+ }
+ }
+ return { map {; $_ => $env->{$_} } @ok };
+}
+
+
=head1 ACKNOWLEDGEMENTS
Original development sponsored by L<http://www.altinity.com/>
@@ -239,10 +245,18 @@
L<Catalyst::Controller::CGIBin>, L<CatalystX::GlobalContext>,
L<Catalyst::Controller>, L<CGI>, L<Catalyst>
-=head1 AUTHOR
+=head1 AUTHORS
+Originally written by:
+
Matt S. Trout, C<< <mst at shadowcat.co.uk> >>
+Contributors:
+
+Rafael Kitover C<< <rkitover at cpan.org> >>
+
+Hans Dieter Pearcey C<< <hdp at cpan.org> >>
+
=head1 BUGS
Please report any bugs or feature requests to C<bug-catalyst-controller-wrapcgi
Modified: trunk/Catalyst-Controller-WrapCGI/t/lib/TestApp/Controller/Root.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/lib/TestApp/Controller/Root.pm 2009-04-27 03:01:41 UTC (rev 9875)
+++ trunk/Catalyst-Controller-WrapCGI/t/lib/TestApp/Controller/Root.pm 2009-04-27 03:07:15 UTC (rev 9876)
@@ -16,4 +16,14 @@
$self->cgi_to_response($c, $cgi);
}
+sub test_path_info : Path('/cgi-bin/test_pathinfo.cgi') {
+ my ($self, $c) = @_;
+
+ $self->cgi_to_response($c, sub {
+ my $cgi = CGI->new;
+ print $cgi->header;
+ print $ENV{PATH_INFO}
+ });
+}
+
1;
Modified: trunk/Catalyst-Controller-WrapCGI/t/wrap-cgi.t
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/wrap-cgi.t 2009-04-27 03:01:41 UTC (rev 9875)
+++ trunk/Catalyst-Controller-WrapCGI/t/wrap-cgi.t 2009-04-27 03:07:15 UTC (rev 9876)
@@ -6,7 +6,7 @@
use FindBin '$Bin';
use lib "$Bin/lib";
-use Test::More tests => 1;
+use Test::More tests => 2;
use Catalyst::Test 'TestApp';
use HTTP::Request::Common;
@@ -17,3 +17,7 @@
];
is($response->content, 'foo:bar bar:baz', 'POST to CGI');
+
+$response = request '/cgi-bin/test_pathinfo.cgi/path/info';
+
+is($response->content, '/path/info', 'PATH_INFO is correct');
More information about the Catalyst-commits
mailing list