(OBSOLETED) This code is no longer maintenance

Backend.pm

# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

package Plack::Server::GatewayCGI::Backend;

use strict;
use warnings;

use parent qw( Plack::Server::AnyEvent );
use Plack::Util::Accessor qw[ livetime ];

sub new {
    my ( $class, @args ) = @_;

    return bless {
        host        => undef,
        port        => undef,
        no_delay    => 1,
        livetime    => 90,
        @args,
    }, $class;
}

sub run {
    my $self = shift;
    $self->register_service( @_ );

    my $exit = $self->{'exit_guard'} = AnyEvent->condvar;
       $exit->begin;

    my $livetime = $self->livetime || 90;

    my $w; $w = AE::timer $livetime, 0, sub {
        warn "${livetime} seconds has passed a live time. server is exit.";
        $exit->end;
        undef $w;
        exit 1;
    };

    $exit->recv;
}

1;

GatewayCGI.pm

# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

package Plack::Server::GatewayCGI;

use strict;
use warnings;

use Plack::Util::Accessor qw[ host port livetime ];
use Plack::Server::CGI;
use Plack::Request;
use IO::Socket::INET;
use AnyEvent;
use AnyEvent::HTTP;

sub new {
    my ( $class, @args ) = @_;
    return bless {
        host        => undef,
        port        => undef,
        livetime    => 90,
        @args,
    }, $class;
}

sub run {
    my ( $self, $app ) = @_;

    my $proxy = $self->proxy;
    my $cgi   = Plack::Server::CGI->new;

    if ( $self->live_server ) {
        $cgi->run($proxy);
    }
    else {
        if ( my $pid = fork() ) {
            $cgi->run($proxy);
        }
        elsif ( $pid == 0 ) {
            require Plack::Server::GatewayCGI::Backend;
            my $server = Plack::Server::GatewayCGI::Backend->new(
                host => $self->host || '127.0.0.1',
                port => $self->port,
                livetime => $self->livetime,
            );
            $server->run($app);
        }
        else {
            die "Cannot running backend server.";
        }
    }
    exit 1;
}

sub live_server {
    my ( $self ) = @_;

    my $sock = IO::Socket::INET->new(
        PeerAddr => $self->host || '127.0.0.1',
        PeerPort => $self->port,
        Proto    => 'tcp',
        Timeout  => 1,
    );

    if ( $sock ) {
        $sock->close;
        return 1;
    }
    
    return 0;
}

sub proxy {
    my ( $self ) = @_;

    my $host = $self->host || '127.0.0.1';
    my $port = $self->port || q{};
       $port = ":${port}" if ( $port ne q{} );
    my $url  = "http://${host}${port}";

    return sub {
        my $env = shift;
        my $req = Plack::Request->new($env);

        for ( qw( Connection Keep-Alive Proxy-Authenticate Proxy-Authorization
                             TE Trailers Transfer-Encoding Upgrade Proxy-Connection Public ) ) {
            $req->headers->remove_header($_);
        }

        $req->headers->scan(sub {
            my ( $key, $value ) = @_;
            if ( $key =~ m{^Client-} ) {
                $req->headers->remove_header($key);
            }
        });

        my $cv = AnyEvent->condvar;
        my $r; $r = http_request(
            $req->method => $url . $req->request_uri,
            timeout => 10,
            headers => $req->headers,
            body    => $req->raw_body,
            sub {
                my ( $body, $header ) = @_;
                $cv->send([ $header->{'Status'}, [ %{ $header } ], [ $body ] ]);
            },
        );

        my $res = $cv->recv;
        undef $r;

        return $res;
    };
}

1;