FCGI-Engine

 view release on metacpan or  search on metacpan

lib/FCGI/Engine/PSGI.pm  view on Meta::CPAN

package FCGI::Engine::PSGI;
use Moose;

use Plack::Util;

our $VERSION   = '0.22';
our $AUTHORITY = 'cpan:STEVAN';

extends 'FCGI::Engine::Core';

has 'app' => (
    is       => 'ro',
    isa      => 'CodeRef',
    required => 1,
);

# NOTE:
# Most of this is taken from
# Plack::Handler::FCGI or at
# least heavily based on it.
# - SL

augment 'prepare_environment' => sub {
    my ($self, $env) = @_;
    return +{
        %$env,
        'psgi.version'      => [1,0],
        'psgi.url_scheme'   => ($env->{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
        'psgi.input'        => *STDIN,
        'psgi.errors'       => *STDERR, # FCGI.pm redirects STDERR in Accept() loop, so just print STDERR
                                        # print to the correct error handle based on keep_stderr
        'psgi.multithread'  => Plack::Util::FALSE,
        'psgi.multiprocess' => Plack::Util::TRUE,
        'psgi.run_once'     => Plack::Util::FALSE,
        'psgi.streaming'    => Plack::Util::TRUE,
        'psgi.nonblocking'  => Plack::Util::FALSE,
    };
};

sub handle_request {
    my ( $self, $env ) = @_;

    my $res = Plack::Util::run_app( $self->app, $env );

    if (ref $res eq 'ARRAY') {
        $self->_handle_response($res);
    }
    elsif (ref $res eq 'CODE') {
        $res->(sub {
            $self->_handle_response($_[0]);
        });
    }
    else {
        die "Bad response $res";
    }
}

sub _handle_response {
    my ($self, $res) = @_;

    *STDOUT->autoflush(1);

    my $hdrs;
    $hdrs = "Status: $res->[0]\015\012";

    my $headers = $res->[1];
    while (my ($k, $v) = splice @$headers, 0, 2) {
        $hdrs .= "$k: $v\015\012";
    }
    $hdrs .= "\015\012";

    print STDOUT $hdrs;

    my $cb = sub { print STDOUT $_[0] };
    my $body = $res->[2];
    if (defined $body) {
        Plack::Util::foreach($body, $cb);
    }
    else {
        return Plack::Util::inline_object
            write => $cb,
            close => sub { };
    }
}

__PACKAGE__->meta->make_immutable;

no Moose; 1;

__END__

=pod

=head1 NAME



( run in 1.383 second using v1.01-cache-2.11-cpan-140bd7fdf52 )