add PSGI handler

[chaz/p5-CGI-Ex] / lib / CGI / Ex / App / PSGI.pm

diff --git a/lib/CGI/Ex/App/PSGI.pm b/lib/CGI/Ex/App/PSGI.pm
new file mode 100644 (file)
index 0000000..e5084d7
--- /dev/null
+++ b/lib/CGI/Ex/App/PSGI.pm
@@ -0,0 +1,58 @@
+package CGI::Ex::App::PSGI;
+
+use strict;
+use Plack::Util;
+use CGI::Ex;
+use CGI::PSGI;
+
+our $VERSION = '2.37';
+
+sub psgi_app {
+    my ($class, $app) = @_;
+
+    Plack::Util::load_class($app);
+    sub {
+        my $env = shift;
+        my $cgix = CGI::Ex->new(object => CGI::PSGI->new($env));
+        if ($env->{'psgi.streaming'}) {
+            sub {
+                local $CGI::Ex::CURRENT = $cgix;
+                local %ENV              = (%ENV, $class->cgi_environment($env));
+                local *STDIN            = $env->{'psgi.input'};
+                local *STDERR           = $env->{'psgi.errors'};
+
+                $cgix->{psgi_responder} = shift;
+                $app->new(
+                    cgix        => $cgix,
+                    script_name => $env->{SCRIPT_NAME},
+                    path_info   => $env->{PATH_INFO},
+                )->navigate->cgix->psgi_respond->close;
+            };
+        } else {
+            local $CGI::Ex::CURRENT = $cgix;
+            local %ENV              = (%ENV, $class->cgi_environment($env));
+            local *STDIN            = $env->{'psgi.input'};
+            local *STDERR           = $env->{'psgi.errors'};
+
+            $app->new(cgix => $cgix)->navigate->cgix->psgi_response;
+        }
+    };
+}
+
+### Convert a PSGI environment into a CGI environment.
+sub cgi_environment {
+    my ($class, $env) = @_;
+
+    my $environment = {
+        GATEWAY_INTERFACE   => 'CGI/1.1',
+        HTTPS               => $env->{'psgi.url_scheme'} eq 'https' ? 'ON' : 'OFF',
+        SERVER_SOFTWARE     => "CGI-Ex-App-PSGI/$VERSION",
+        REMOTE_ADDR         => '127.0.0.1',
+        REMOTE_HOST         => 'localhost',
+        map { $_ => $env->{$_} } grep { !/^psgix?\./ } keys %$env,
+    };
+
+    return wantarray ? %$environment : $environment;
+}
+
+1;