File Coverage

blib/lib/Plack/App/PHPCGI.pm

Criterion	Covered	Total	%
statement	27	75	36.0
branch	0	16	0.0
condition	0	3	0.0
subroutine	9	13	69.2
pod	2	3	66.6
total	38	110	34.5

package Plack::App::PHPCGI;

use strict;
use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(script php_cgi _app);
use CGI::Emulate::PSGI;
use File::Which;
use File::Spec;
use Carp;
use POSIX ":sys_wait_h";

our $VERSION = '0.04';

sub wrap_php {
    my ($php_cgi, $script) = @_;
    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));
            local $ENV{REDIRECT_STATUS} = 1;
            local $ENV{SCRIPT_FILENAME} = $script;

            open( STDOUT, ">&=" . fileno($stdoutw) ) ## no critic
                or Carp::croak "Cannot dup STDOUT: $!";
            open( STDIN, "<&=" . fileno($stdinr) ) ## no critic
                or Carp::croak "Cannot dup STDIN: $!";

            exec($php_cgi,$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: $!");
        }
    };
    $app;
}

sub prepare_app {
    my $self = shift;
    my $script = $self->script
        or croak "'script' is not set";
    $script = File::Spec->rel2abs($script);

    my $php_cgi = $self->php_cgi;
    $php_cgi ||= which('php-cgi');
    croak "cannot find 'php-cgi' command" unless -x $php_cgi;

    $self->_app(wrap_php($php_cgi,$script));
}

sub call {
    my($self, $env) = @_;
    $self->_app->($env);
}


1;
__END__