File Coverage

blib/lib/Plack/App/FCGIDispatcher.pm

Criterion	Covered	Total	%
statement	41	63	65.0
branch	7	20	35.0
condition	2	6	33.3
subroutine	8	8	100.0
pod	1	1	100.0
total	59	98	60.2

package Plack::App::FCGIDispatcher;
use strict;
use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(host port socket timeout);

use 5.008001;
use FCGI::Client;
use HTTP::Response;

our $VERSION = '0.10';

sub call {
    my $self = shift;
    my $env  = shift;

    my $fcgi_env = +{ %$env }; # shallow copy

    my $sock;
    if ($self->socket) {
        require IO::Socket::UNIX;
        $sock = IO::Socket::UNIX->new(
            Peer => $self->socket,
        );
    } elsif ($self->port) {
        require IO::Socket::INET;
        $sock = IO::Socket::INET->new(
            PeerAddr => $self->host || '127.0.0.1',
            PeerPort => $self->port,
        );
    } else {
        die "FCGI daemon host/port or socket is not specified";
    }

    $sock or die "Can't create socket to FCGI daemon: $!";

    my $conn = FCGI::Client::Connection->new(
        sock    => $sock,
        timeout => $self->timeout || 60,
    );
    my $input = delete $fcgi_env->{'psgi.input'};

    my $content_in = '';
    if (my $cl = $env->{CONTENT_LENGTH}) {
        while ($cl > 0) {
            my $read = $input->read($content_in, $cl, length $content_in);
            $cl -= $read;
        }
    }

    for my $key (keys %$fcgi_env) {
        delete $fcgi_env->{$key} if $key =~ /\./;
    }

    my($stdout, $stderr);
    eval {
        ($stdout, $stderr) = $conn->request($fcgi_env, $content_in);
    };
    if ($@) {
        $env->{'psgi.errors'}->print($@);
        return [ 502, ["Content-Type", "text/plain"], ["Bad FastCGI gateway"] ];
    }

    print STDERR $stderr if $stderr;

    unless ( $stdout =~ /^HTTP/ ) {
        $stdout = "HTTP/1.1 200 OK\015\012" . $stdout;
    }

    ($stdout =~ /^(.+?\015?\012\015?\012)(.*)$/s) or die "No header/body separator";
    my ($header_part, $content) = ($1, $2);

    my $res = HTTP::Response->parse($header_part);
    if ($res->content) {
        # we passed only headers but has body: Bad headers
        return [ 500, [ 'Content-Type' => 'text/plain' ], [ 'Bad HTTP headers returned' ] ];
    }

    my($status) = $res->remove_header('Status');
    $status ||= "200";
    $status =~ s/\s+.*$//; # remove ' OK' in '200 OK'

    my $headers = [
        map {
            my $k = $_;
            map { ( $k => $_ ) } $res->headers->header($_);
        } $res->headers->header_field_names
    ];

    return [ $status, $headers, [ $content ] ];
}

1;

__END__