The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Plack::App::FCGIDispatcher;
use strict;
use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(host port socket);

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

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

    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);
    my $input = delete $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 %$env) {
        delete $env->{$key} if $key =~ /\./;
    }

    my ($stdout, $stderr) = $conn->request(
        $env,
        $content_in,
    );
    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__

=head1 NAME

Plack::App::FCGIDispatcher - Dispatch requests to FCGI servers

=head1 SYNOPSIS

  # app.psgi
  use Plack::App::FCGIDispatcher;
  my $app = Plack::App::FCGIDispatcher->new({
      port => 8080, # FastCGI daemon port
  })->to_app;

=head1 DESCRIPTION

Plack::App::FCGIDispatcher is a PSGI application to dispatch requests
to external FastCGI servers listening on TCP or UNIX sockets.

Since external FastCGI servers can be written in any language such as
Ruby or PHP, this could be useful to route requests to Rails
applications for instance from your Plack-based web server, or apply
one of Plack middleware to PHP applications.

See also L<Plack::App::Proxy> which uses HTTP instead of FastCGI and
has more configuration options.

=head1 CONFIGURATION

=over 4

=item host, port

  my $app = Plack::App::FCGIDispatcher->new({
      host => '127.0.0.1', port => 8080,
  })->to_app;

Specifies host and port where FastCGI daemon is listening. host defaults to C<127.0.0.1>.

=item socket

  my $app = Plack::App::FCGIDispatcher->new({
      socket => "/tmp/fcgi.sock",
  })->to_app;

Specifies UNIX socket path where FastCGI daemon is listening.

=back

=head1 AUTHOR

Tokuhiro Matsuno

Tatsuhiko Miyagawa

=head1 SEE ALSO

L<FCGI::Client>

=cut