[Catalyst-commits] r9846 - in trunk/Catalyst-Controller-WrapCGI: . lib/Catalyst/Controller t t/lib/TestCGIBin/root/cgi-bin

[hdp at dev.catalyst.perl.org]

Author: hdp
Date: 2009-04-26 01:37:09 +0100 (Sun, 26 Apr 2009)
New Revision: 9846

Added:
   trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit.pl
Modified:
   trunk/Catalyst-Controller-WrapCGI/Changes
   trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
   trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
Log:
override exit() for Perl cgis in cgi-bin
set $0 when executing a Perl cgi

Modified: trunk/Catalyst-Controller-WrapCGI/Changes
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/Changes	2009-04-26 00:36:57 UTC (rev 9845)
+++ trunk/Catalyst-Controller-WrapCGI/Changes	2009-04-26 00:37:09 UTC (rev 9846)
@@ -28,3 +28,6 @@
 
 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.

Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm	2009-04-26 00:36:57 UTC (rev 9845)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm	2009-04-26 00:37:09 UTC (rev 9846)
@@ -218,12 +218,33 @@
 
     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;
+                }
          . '}';
     };
 

Modified: trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/cgibin.t	2009-04-26 00:36:57 UTC (rev 9845)
+++ trunk/Catalyst-Controller-WrapCGI/t/cgibin.t	2009-04-26 00:37:09 UTC (rev 9846)
@@ -6,7 +6,7 @@
 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;
@@ -21,6 +21,19 @@
 
 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'

Added: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit.pl
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit.pl	                        (rev 0)
+++ trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit.pl	2009-04-26 00:37:09 UTC (rev 9846)
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI ':standard';
+
+print header;
+print "hello " . param('name');
+exit(param('exit') || 0);