X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FController%2FWrapCGI.pm;h=92275f3ee6f9d7e43bd8600011c30a2457f38f05;hb=3149e3cb8f8202f259063b8b25c6a60cd5c9c57b;hp=0a2d748b1770eade4029c98d5340a3760061d5a9;hpb=17a050f8c51354fe1780496a70ca58dce8de9cb0;p=catagits%2FCatalyst-Controller-WrapCGI.git diff --git a/lib/Catalyst/Controller/WrapCGI.pm b/lib/Catalyst/Controller/WrapCGI.pm index 0a2d748..92275f3 100644 --- a/lib/Catalyst/Controller/WrapCGI.pm +++ b/lib/Catalyst/Controller/WrapCGI.pm @@ -1,14 +1,15 @@ package Catalyst::Controller::WrapCGI; +use 5.008_001; use Moose; use mro 'c3'; extends 'Catalyst::Controller'; +use Catalyst::Exception (); use HTTP::Request::AsCGI (); use HTTP::Request (); use URI (); -use Catalyst::Exception (); use URI::Escape; use HTTP::Request::Common; @@ -18,13 +19,9 @@ use namespace::clean -except => 'meta'; Catalyst::Controller::WrapCGI - Run CGIs in Catalyst -=head1 VERSION - -Version 0.0037 - =cut -our $VERSION = '0.0037'; +our $VERSION = '0.032'; =head1 SYNOPSIS @@ -66,6 +63,9 @@ with L 5.8 onward. If you just want to run CGIs from files, see L. +C will be set to C<< $c->user->obj->$username_field >> if +available, or to C<< $c->req->remote_user >> otherwise. + =head1 CONFIGURATION =head2 pass_env @@ -104,7 +104,7 @@ open my $REAL_STDOUT, ">>&=".fileno(*STDOUT); =head2 cgi_to_response -C<<$self->cgi_to_response($c, $coderef)>> +C<< $self->cgi_to_response($c, $coderef) >> Does the magic of running $coderef in a CGI environment, and populating the appropriate parts of your Catalyst context with the results. @@ -134,16 +134,17 @@ sub cgi_to_response { =head2 wrap_cgi -C<<$self->wrap_cgi($c, $coderef)>> +C<< $self->wrap_cgi($c, $coderef) >> -Runs $coderef in a CGI environment using L, returns an +Runs C<$coderef> in a CGI environment using L, returns an L. -The CGI environment is set up based on $c. +The CGI environment is set up based on C<$c>. The environment variables to pass on are taken from the configuration for your Controller, see L for an example. If you don't supply a list of -environment variables to pass, the whole of %ENV is used. +environment variables to pass, the whole of %ENV is used (with exceptions listed +in L. Used by L, which is probably what you want to use as well. @@ -192,8 +193,6 @@ sub wrap_cgi { } } - my $filtered_env = $self->_filtered_env(\%ENV); - $req->content($body_content); $req->content_length(length($body_content)); @@ -203,6 +202,8 @@ sub wrap_cgi { ? eval { $c->user->obj->$username_field } : ''); + $username ||= $c->req->remote_user if $c->req->can('remote_user'); + my $path_info = '/'.join '/' => map { utf8::is_utf8($_) ? uri_escape_utf8($_) : uri_escape($_) } @{ $c->req->args }; @@ -210,7 +211,6 @@ sub wrap_cgi { my $env = HTTP::Request::AsCGI->new( $req, ($username ? (REMOTE_USER => $username) : ()), - %$filtered_env, PATH_INFO => $path_info, # eww, this is likely broken: FILEPATH_INFO => '/'.$c->action.$path_info, @@ -225,6 +225,8 @@ sub wrap_cgi { my $saved_error; + local %ENV = %{ $self->_filtered_env(\%ENV) }; + $env->setup; eval { $call->() }; $saved_error = $@; @@ -232,9 +234,12 @@ sub wrap_cgi { select($old); - Catalyst::Exception->throw( - message => "CGI invocation failed: $saved_error" - ) if $saved_error; + if( $saved_error ) { + die $saved_error if ref $saved_error; + Catalyst::Exception->throw( + message => "CGI invocation failed: $saved_error" + ); + } } return $env->response; @@ -345,18 +350,6 @@ Original development sponsored by L L, L, L, L, L -=head1 AUTHORS - -Originally written by: - -Matt S. Trout, C<< >> - -Contributors: - -Rafael Kitover C<< >> - -Hans Dieter Pearcey C<< >> - =head1 BUGS Please report any bugs or feature requests to C =back +=head1 AUTHOR + +Matt S. Trout C<< >> + +=head1 CONTRIBUTORS + +Rafael Kitover C<< >> + +Hans Dieter Pearcey C<< >> + +Some code stolen from Tatsuhiko Miyagawa's L. + =head1 COPYRIGHT & LICENSE -Copyright (c) 2008 Matt S. Trout +Copyright (c) 2008-2009 L and +L. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.