/usr/share/perl5/CGI/Emulate/PSGI.pm is in libcgi-emulate-psgi-perl 0.23-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | 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.23';
sub handler {
my ($class, $code, ) = @_;
return sub {
my $env = shift;
my $stdout = IO::File->new_tmpfile;
{
my $saver = SelectSaver->new("::STDOUT");
{
local %ENV = (%ENV, $class->emulate_environment($env));
local *STDIN = $env->{'psgi.input'};
local *STDOUT = $stdout;
local *STDERR = $env->{'psgi.errors'};
$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?\./ && $_ ne "HTTP_PROXY" } 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<CGI::Parse::PSGI> module.
=head1 CGI.pm
If your application uses L<CGI>, 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<CGI::Compile> 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<CGI::Compile> for details.
You can also consider using L<CGI::PSGI> 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<CGI::PSGI> 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<handler> method to create a PSGI environment hash, this
is automatically called in the created application.
=back
=head1 AUTHOR
Tokuhiro Matsuno <tokuhirom@cpan.org>
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<PSGI> L<CGI::Compile> L<CGI::PSGI> L<Plack> L<CGI::Parse::PSGI>
=cut
|