/usr/share/perl5/Plack/App/WrapCGI.pm is in libplack-perl 1.0033-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 | package Plack::App::WrapCGI;
use strict;
use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(script execute _app);
use File::Spec;
use CGI::Emulate::PSGI;
use CGI::Compile;
use Carp;
use POSIX ":sys_wait_h";
sub prepare_app {
my $self = shift;
my $script = $self->script
or croak "'script' is not set";
$script = File::Spec->rel2abs($script);
if ($self->execute) {
my $app = sub {
my $env = shift;
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: $!";
chdir(File::Basename::dirname($script));
exec($script) or Carp::croak("cannot exec: $!");
exit(2);
}
close $stdoutw;
close $stdinr;
syswrite($stdinw, do {
local $/;
my $fh = $env->{'psgi.input'};
<$fh>;
});
# close STDIN so child will stop waiting
close $stdinw;
my $res = '';
while (waitpid($pid, WNOHANG) <= 0) {
$res .= do { local $/; <$stdoutr> } || '';
}
$res .= do { local $/; <$stdoutr> } || '';
if (POSIX::WIFEXITED($?)) {
return CGI::Parse::PSGI::parse_cgi_output(\$res);
} else {
Carp::croak("Error at run_on_shell CGI: $!");
}
};
$self->_app($app);
} else {
my $sub = CGI::Compile->compile($script);
my $app = CGI::Emulate::PSGI->handler($sub);
$self->_app($app);
}
}
sub call {
my($self, $env) = @_;
$self->_app->($env);
}
1;
__END__
=head1 NAME
Plack::App::WrapCGI - Compiles a CGI script as PSGI application
=head1 SYNOPSIS
use Plack::App::WrapCGI;
my $app = Plack::App::WrapCGI->new(script => "/path/to/script.pl")->to_app;
# if you want to execute as a real CGI script
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
using L<CGI::Compile> and L<CGI::Emulate::PSGI>, and runs it with any
PSGI server as a PSGI application.
See also L<Plack::App::CGIBin> if you have a directory that contains a
lot of CGI scripts and serve them like Apache's mod_cgi.
=head1 METHODS
=over 4
=item new
my $app = Plack::App::WrapCGI->new(%args);
Creates a new PSGI application using the given script. I<%args> has two
parameters:
=over 8
=item script
The path to a CGI-style program. This is a required parameter.
=item execute
An optional parameter. When set to a true value, this app will run the script
with a CGI-style C<fork>/C<exec> model. Note that you may run programs written
in other languages with this approach.
=back
=back
=head1 AUTHOR
Tatsuhiko Miyagawa
=head1 SEE ALSO
L<Plack::App::CGIBin>
=cut
|