0.0029
Allow more control over public paths to CGIBin actions.
+ Override exit() in CGIBin-wrapped Perl cgis to avoid terminating the
+ Catalyst process.
+ Set (temporarily) $0 to the filename of the Perl cgi being executed.
my $coderef = do {
no warnings;
+ # catch exit() and turn it into (effectively) a return
+ # we *must* eval STRING because the code needs to be compiled with the
+ # overridden CORE::GLOBAL::exit in view
+ #
+ # set $0 to the name of the cgi file in case it's used there
eval '
+ my $cgi_exited = "EXIT\n";
+ BEGIN { *CORE::GLOBAL::exit = sub (;$) {
+ die [ $cgi_exited, $_[0] || 0 ];
+ } }
package Catalyst::Controller::CGIBin::_CGIs_::'.$action_name.';
sub {'
. 'local *DATA;'
. q{open DATA, '<', \$data;}
+ . qq{local \$0 = "\Q$cgi\E";}
+ . q/my $rv = eval {/
. $code
+ . q/};/
+ . q{
+ return $rv unless $@;
+ die $@ if $@ and not (
+ ref($@) eq 'ARRAY' and
+ $@->[0] eq $cgi_exited
+ );
+ die "exited nonzero: $@->[1]" if $@->[1] != 0;
+ return $rv;
+ }
. '}';
};
use FindBin '$Bin';
use lib "$Bin/lib";
-use Test::More tests => 4;
+use Test::More tests => 6;
use Catalyst::Test 'TestCGIBin';
use HTTP::Request::Common;
is($response->content, 'foo:bar bar:baz', 'POST to Perl CGI File');
+$response = request POST '/my-bin/exit.pl', [
+ name => 'world',
+];
+
+is($response->content, 'hello world', 'POST to Perl CGI with exit()');
+
+$response = request POST '/my-bin/exit.pl', [
+ name => 'world',
+ exit => 17,
+];
+
+is($response->code, 500, 'POST to Perl CGI with nonzero exit()');
+
$response = request POST '/cgihandler/dongs', [
foo => 'bar',
bar => 'baz'
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI ':standard';
+
+print header;
+print "hello " . param('name');
+exit(param('exit') || 0);