From 7040f7e9b14617774924458e557584a5c9ec6b2e Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Fri, 5 Dec 2014 16:47:02 +0100 Subject: add default CGI::Emulate::PSGI --- CGI/Emulate/PSGI.pm | 173 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 173 insertions(+) create mode 100644 CGI/Emulate/PSGI.pm diff --git a/CGI/Emulate/PSGI.pm b/CGI/Emulate/PSGI.pm new file mode 100644 index 0000000..335d6c0 --- /dev/null +++ b/CGI/Emulate/PSGI.pm @@ -0,0 +1,173 @@ +package CGI::Emulate::PSGI; +use strict; +use warnings; +use CGI::Parse::PSGI; +use POSIX 'SEEK_SET'; +use IO::File (); +use SelectSaver; +use Carp qw(croak); +use 5.008001; + +our $VERSION = '0.20'; + +sub handler { + my ($class, $code, ) = @_; + + return sub { + my $env = shift; + + my $stdout = IO::File->new_tmpfile; + + { + local %ENV = (%ENV, $class->emulate_environment($env)); + + local *STDIN = $env->{'psgi.input'}; + local *STDOUT = $stdout; + local *STDERR = $env->{'psgi.errors'}; + + my $saver = SelectSaver->new("::STDOUT"); + $code->(); + } + + seek( $stdout, 0, SEEK_SET ) + or croak("Can't seek stdout handle: $!"); + + return CGI::Parse::PSGI::parse_cgi_output($stdout); + }; +} + +sub emulate_environment { + my($class, $env) = @_; + + no warnings; + my $environment = { + GATEWAY_INTERFACE => 'CGI/1.1', + HTTPS => ( ( $env->{'psgi.url_scheme'} eq 'https' ) ? 'ON' : 'OFF' ), + SERVER_SOFTWARE => "CGI-Emulate-PSGI", + REMOTE_ADDR => '127.0.0.1', + REMOTE_HOST => 'localhost', + REMOTE_PORT => int( rand(64000) + 1000 ), # not in RFC 3875 + # REQUEST_URI => $uri->path_query, # not in RFC 3875 + ( map { $_ => $env->{$_} } grep !/^psgix?\./, keys %$env ) + }; + + return wantarray ? %$environment : $environment; +} + +1; +__END__ + +=head1 NAME + +CGI::Emulate::PSGI - PSGI adapter for CGI + +=head1 SYNOPSIS + + my $app = CGI::Emulate::PSGI->handler(sub { + # Existing CGI code + }); + +=head1 DESCRIPTION + +This module allows an application designed for the CGI environment to +run in a PSGI environment, and thus on any of the backends that PSGI +supports. + +It works by translating the environment provided by the PSGI +specification to one expected by the CGI specification. Likewise, it +captures output as it would be prepared for the CGI standard, and +translates it to the format expected for the PSGI standard using +L module. + +=head1 CGI.pm + +If your application uses L, be sure to cleanup the global +variables in the handler loop yourself, so: + + my $app = CGI::Emulate::PSGI->handler(sub { + use CGI; + CGI::initialize_globals(); + my $q = CGI->new; + # ... + }); + +Otherwise previous request variables will be reused in the new +requests. + +Alternatively, you can install and use L from CPAN and +compiles your existing CGI scripts into a sub that is perfectly ready +to be converted to PSGI application using this module. + + my $sub = CGI::Compile->compile("/path/to/script.cgi"); + my $app = CGI::Emulate::PSGI->handler($sub); + +This will take care of assigning a unique namespace for each script +etc. See L for details. + +You can also consider using L but that would require you to +slightly change your code from: + + my $q = CGI->new; + # ... + print $q->header, $output; + +into: + + use CGI::PSGI; + + my $app = sub { + my $env = shift; + my $q = CGI::PSGI->new($env); + # ... + return [ $q->psgi_header, [ $output ] ]; + }; + +See L for details. + +=head1 METHODS + +=over 4 + +=item handler + + my $app = CGI::Emulate::PSGI->handler($code); + +Creates a PSGI application code reference out of CGI code reference. + +=item emulate_environment + + my %env = CGI::Emulate::PSGI->emulate_environment($env); + +Creates an environment hash out of PSGI environment hash. If your code +or framework just needs an environment variable emulation, use this +method like: + + local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); + # run your application + +If you use C method to create a PSGI environment hash, this +is automatically called in the created application. + +=back + +=head1 AUTHOR + +Tokuhiro Matsuno + +Tatsuhiko Miyagawa + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2009-2010 by tokuhirom. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +The full text of the license can be found in the +LICENSE file included with this module. + +=head1 SEE ALSO + +L L L L L + +=cut -- cgit v1.2.3-1-g7c22