P::App::WrapCGI は、perl でかいた CGI しか実行できないので、ちゃんと exec してうごく一般的な CGI がうごくようにしてみる施策。

環境変数をセットアップして、双方向パイプで IPC しているだけです。

diff --git a/lib/Plack/App/WrapCGI.pm b/lib/Plack/App/WrapCGI.pm
index 7f0a7a7..0ce15d6 100644
--- a/lib/Plack/App/WrapCGI.pm
+++ b/lib/Plack/App/WrapCGI.pm
@@ -2,7 +2,7 @@ package Plack::App::WrapCGI;
 use strict;
 use warnings;
 use parent qw(Plack::Component);
-use Plack::Util::Accessor qw(script _app);
+use Plack::Util::Accessor qw(script execute _app);
 use CGI::Emulate::PSGI;
 use CGI::Compile;
 use Carp;
@@ -12,10 +12,62 @@ sub prepare_app {
     my $script = $self->script
         or croak "'script' is not set";
 
-    my $sub = CGI::Compile->compile($script);
-    my $app = CGI::Emulate::PSGI->handler($sub);
+    if ($self->execute) {
+        my $app = sub {
+            my $env = shift;
 
-    $self->_app($app);
+            pipe( my $stdoutr, my $stdoutw );
+            pipe( my $stdinr,  my $stdinw );
+
+
+            my $pid = fork();
+            Carp::croak("fork failed: $!") unless defined $pid;
+
+
+            if ($pid == 0) { # child
+                local $SIG{__DIE__} = sub {
+                    print STDERR @_;
+                    exit(1);
+                };
+
+                close $stdoutr;
+                close $stdinw;
+
+                local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env));
+
+                open( STDOUT, ">&=" . fileno($stdoutw) )
+                  or Carp::croak "Cannot dup STDOUT: $!";
+                open( STDIN, "<&=" . fileno($stdinr) )
+                  or Carp::croak "Cannot dup STDIN: $!";
+
+                exec($script) or Carp::croak("cannot exec: $!");
+
+                exit(2);
+            }
+
+            close $stdoutw;
+            close $stdinr;
+
+            syswrite($stdinw, do {
+                local $/;
+                my $fh = $env->{'psgi.input'};
+                <$fh>;
+            });
+
+            1 while waitpid( $pid, 0 ) <= 0;
+            if (POSIX::WIFEXITED($?)) {
+                return CGI::Parse::PSGI::parse_cgi_output($stdoutr);
+            } else {
+                Carp::croak("Error at execute CGI: $!");
+            }
+        };
+        $self->_app($app);
+    } else {
+        my $sub = CGI::Compile->compile($script);
+        my $app = CGI::Emulate::PSGI->handler($sub);
+
+        $self->_app($app);
+    }
 }
 
 sub call {
@@ -37,6 +89,9 @@ Plack::App::WrapCGI - Compiles a CGI script as PSGI application
 
   my $app = Plack::App::WrapCGI->new(script => "/path/to/script.pl")->to_app;
 
+  # if you want to execute as real CGI.
+  my $app = Plack::App::WrapCGI->new(script => "/path/to/script.rb", execute => 1)->to_app;
+
 =head1 DESCRIPTION
 
 Plack::App::WrapCGI compiles a CGI script into a PSGI application
diff --git a/t/Plack-Middleware/wrapcgi.t b/t/Plack-Middleware/wrapcgi.t
index 9e72592..edac680 100644
--- a/t/Plack-Middleware/wrapcgi.t
+++ b/t/Plack-Middleware/wrapcgi.t
@@ -4,6 +4,8 @@ use Test::Requires { 'CGI::Emulate::PSGI' => 0, 'CGI::Compile' => 0.03 };
 use Plack::Test;
 use HTTP::Request::Common;
 use Plack::App::WrapCGI;
+use IO::File;
+use File::Temp;
 
 my $app = Plack::App::WrapCGI->new(script => "t/Plack-Middleware/cgi-bin/hello.cgi")->to_app;
 
@@ -19,4 +21,33 @@ test_psgi app => $app, client => sub {
     is $res->content, "Hello bar counter=2";
 };
 
+{
+    my $tmp = File::Temp->new(CLEANUP => 1);
+    print $tmp <<"...";
+#!$^X
+use CGI;
+my \$q = CGI->new;
+print \$q->header, "Hello ", \$q->param('name'), " counter=", ++\$COUNTER;
+...
+    close $tmp;
+
+    chmod(oct("0700"), $tmp->filename) or die "Cannot chmod";
+
+    my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", 'execute' => 1)->to_app;
+    test_psgi app => $app_exec, client => sub {
+        my $cb = shift;
+
+        my $res = $cb->(GET "http://localhost/?name=foo");
+        is $res->code, 200;
+        is $res->content, "Hello foo counter=1";
+
+        $res = $cb->(POST "http://localhost/", ['name' => 'bar']);
+        is $res->code, 200;
+        is $res->content, "Hello bar counter=1";
+    };
+
+    undef $tmp;
+};
+
+
 done_testing;