| Filename | /usr/share/perl5/CGI/Emulate/PSGI.pm |
| Statements | Executed 0 statements in 0s |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package CGI::Emulate::PSGI; | ||||
| 2 | use strict; | ||||
| 3 | use warnings; | ||||
| 4 | use CGI::Parse::PSGI; | ||||
| 5 | use POSIX 'SEEK_SET'; | ||||
| 6 | use IO::File (); | ||||
| 7 | use SelectSaver; | ||||
| 8 | use Carp qw(croak); | ||||
| 9 | use 5.008001; | ||||
| 10 | |||||
| 11 | our $VERSION = '0.20'; | ||||
| 12 | |||||
| 13 | sub handler { | ||||
| 14 | my ($class, $code, ) = @_; | ||||
| 15 | |||||
| 16 | return sub { | ||||
| 17 | my $env = shift; | ||||
| 18 | |||||
| 19 | my $stdout = IO::File->new_tmpfile; | ||||
| 20 | |||||
| 21 | { | ||||
| 22 | 5 | 39µs | local %ENV = (%ENV, $class->emulate_environment($env)); # spent 39µs making 5 calls to SelectSaver::DESTROY, avg 8µs/call | ||
| 23 | |||||
| 24 | local *STDIN = $env->{'psgi.input'}; | ||||
| 25 | local *STDOUT = $stdout; | ||||
| 26 | local *STDERR = $env->{'psgi.errors'}; | ||||
| 27 | |||||
| 28 | my $saver = SelectSaver->new("::STDOUT"); | ||||
| 29 | $code->(); | ||||
| 30 | } | ||||
| 31 | |||||
| 32 | 1 | 54µs | seek( $stdout, 0, SEEK_SET ) # spent 54µs making 1 call to Encode::utf8::encode_xs | ||
| 33 | or croak("Can't seek stdout handle: $!"); | ||||
| 34 | |||||
| 35 | return CGI::Parse::PSGI::parse_cgi_output($stdout); | ||||
| 36 | }; | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | sub emulate_environment { | ||||
| 40 | my($class, $env) = @_; | ||||
| 41 | |||||
| 42 | no warnings; | ||||
| 43 | my $environment = { | ||||
| 44 | GATEWAY_INTERFACE => 'CGI/1.1', | ||||
| 45 | HTTPS => ( ( $env->{'psgi.url_scheme'} eq 'https' ) ? 'ON' : 'OFF' ), | ||||
| 46 | SERVER_SOFTWARE => "CGI-Emulate-PSGI", | ||||
| 47 | REMOTE_ADDR => '127.0.0.1', | ||||
| 48 | REMOTE_HOST => 'localhost', | ||||
| 49 | REMOTE_PORT => int( rand(64000) + 1000 ), # not in RFC 3875 | ||||
| 50 | # REQUEST_URI => $uri->path_query, # not in RFC 3875 | ||||
| 51 | ( map { $_ => $env->{$_} } grep !/^psgix?\./, keys %$env ) | ||||
| 52 | }; | ||||
| 53 | |||||
| 54 | return wantarray ? %$environment : $environment; | ||||
| 55 | } | ||||
| 56 | |||||
| 57 | 1; | ||||
| 58 | __END__ | ||||
| 59 | |||||
| 60 | =head1 NAME | ||||
| 61 | |||||
| 62 | CGI::Emulate::PSGI - PSGI adapter for CGI | ||||
| 63 | |||||
| 64 | =head1 SYNOPSIS | ||||
| 65 | |||||
| 66 | my $app = CGI::Emulate::PSGI->handler(sub { | ||||
| 67 | # Existing CGI code | ||||
| 68 | }); | ||||
| 69 | |||||
| 70 | =head1 DESCRIPTION | ||||
| 71 | |||||
| 72 | This module allows an application designed for the CGI environment to | ||||
| 73 | run in a PSGI environment, and thus on any of the backends that PSGI | ||||
| 74 | supports. | ||||
| 75 | |||||
| 76 | It works by translating the environment provided by the PSGI | ||||
| 77 | specification to one expected by the CGI specification. Likewise, it | ||||
| 78 | captures output as it would be prepared for the CGI standard, and | ||||
| 79 | translates it to the format expected for the PSGI standard using | ||||
| 80 | L<CGI::Parse::PSGI> module. | ||||
| 81 | |||||
| 82 | =head1 CGI.pm | ||||
| 83 | |||||
| 84 | If your application uses L<CGI>, be sure to cleanup the global | ||||
| 85 | variables in the handler loop yourself, so: | ||||
| 86 | |||||
| 87 | my $app = CGI::Emulate::PSGI->handler(sub { | ||||
| 88 | use CGI; | ||||
| 89 | CGI::initialize_globals(); | ||||
| 90 | my $q = CGI->new; | ||||
| 91 | # ... | ||||
| 92 | }); | ||||
| 93 | |||||
| 94 | Otherwise previous request variables will be reused in the new | ||||
| 95 | requests. | ||||
| 96 | |||||
| 97 | Alternatively, you can install and use L<CGI::Compile> from CPAN and | ||||
| 98 | compiles your existing CGI scripts into a sub that is perfectly ready | ||||
| 99 | to be converted to PSGI application using this module. | ||||
| 100 | |||||
| 101 | my $sub = CGI::Compile->compile("/path/to/script.cgi"); | ||||
| 102 | my $app = CGI::Emulate::PSGI->handler($sub); | ||||
| 103 | |||||
| 104 | This will take care of assigning a unique namespace for each script | ||||
| 105 | etc. See L<CGI::Compile> for details. | ||||
| 106 | |||||
| 107 | You can also consider using L<CGI::PSGI> but that would require you to | ||||
| 108 | slightly change your code from: | ||||
| 109 | |||||
| 110 | my $q = CGI->new; | ||||
| 111 | # ... | ||||
| 112 | print $q->header, $output; | ||||
| 113 | |||||
| 114 | into: | ||||
| 115 | |||||
| 116 | use CGI::PSGI; | ||||
| 117 | |||||
| 118 | my $app = sub { | ||||
| 119 | my $env = shift; | ||||
| 120 | my $q = CGI::PSGI->new($env); | ||||
| 121 | # ... | ||||
| 122 | return [ $q->psgi_header, [ $output ] ]; | ||||
| 123 | }; | ||||
| 124 | |||||
| 125 | See L<CGI::PSGI> for details. | ||||
| 126 | |||||
| 127 | =head1 METHODS | ||||
| 128 | |||||
| 129 | =over 4 | ||||
| 130 | |||||
| 131 | =item handler | ||||
| 132 | |||||
| 133 | my $app = CGI::Emulate::PSGI->handler($code); | ||||
| 134 | |||||
| 135 | Creates a PSGI application code reference out of CGI code reference. | ||||
| 136 | |||||
| 137 | =item emulate_environment | ||||
| 138 | |||||
| 139 | my %env = CGI::Emulate::PSGI->emulate_environment($env); | ||||
| 140 | |||||
| 141 | Creates an environment hash out of PSGI environment hash. If your code | ||||
| 142 | or framework just needs an environment variable emulation, use this | ||||
| 143 | method like: | ||||
| 144 | |||||
| 145 | local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env)); | ||||
| 146 | # run your application | ||||
| 147 | |||||
| 148 | If you use C<handler> method to create a PSGI environment hash, this | ||||
| 149 | is automatically called in the created application. | ||||
| 150 | |||||
| 151 | =back | ||||
| 152 | |||||
| 153 | =head1 AUTHOR | ||||
| 154 | |||||
| 155 | Tokuhiro Matsuno <tokuhirom@cpan.org> | ||||
| 156 | |||||
| 157 | Tatsuhiko Miyagawa | ||||
| 158 | |||||
| 159 | =head1 COPYRIGHT AND LICENSE | ||||
| 160 | |||||
| 161 | Copyright (c) 2009-2010 by tokuhirom. | ||||
| 162 | |||||
| 163 | This program is free software; you can redistribute | ||||
| 164 | it and/or modify it under the same terms as Perl itself. | ||||
| 165 | |||||
| 166 | The full text of the license can be found in the | ||||
| 167 | LICENSE file included with this module. | ||||
| 168 | |||||
| 169 | =head1 SEE ALSO | ||||
| 170 | |||||
| 171 | L<PSGI> L<CGI::Compile> L<CGI::PSGI> L<Plack> L<CGI::Parse::PSGI> | ||||
| 172 | |||||
| 173 | =cut | ||||
| 174 |