File Coverage

blib/lib/Plack/Handler/FCGI/EV.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package Plack::Handler::FCGI::EV;

use strict;
use warnings;
use 5.008_001;
our $VERSION = '0.01';

use Socket;
use Fcntl;
use Plack::Util;
use EV;
use FCGI::EV;
use AnyEvent;

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

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

    my $listen = $self->{listen}[0]
        or die "FCGI daemon host/port or socket is not specified\n";

    my $sock;
    if ($listen =~ /:\d+$/) {
        my($host, $port) = split /:/, $listen, 2;
        require IO::Socket::INET;
        $sock = IO::Socket::INET->new(
            LocalAddr => $host || '0.0.0.0',
            LocalPort => $port,
            ReuseAddr => 1,
            Proto     => 'tcp',
            Listen    => 10,
            Blocking  => 0,
        );
    } else {
        require IO::Socket::UNIX;
        socket $sock, AF_UNIX, SOCK_STREAM, 0;
        unlink $listen;
        my $umask = umask 0;
        bind $sock, sockaddr_un($listen);
        umask $umask;
        listen $sock, SOMAXCONN;
        fcntl $sock, F_SETFL, O_NONBLOCK;
        bless $sock, 'IO::Socket::UNIX';
    }

    $sock or die "Couldn't launch FCGI daemon on $listen";
    warn "Running FCGI daemon on $listen\n";

    # HACK: we return an object and pass it to handler_class. Because it works, and is cleaner
    my $handler = Plack::Handler::FCGI::EV::Handler->factory($app);

    my $w = EV::io $sock, EV::READ, sub {
        my $client = $sock->accept or die "No socket";
        $client->blocking(0);
        FCGI::EV->new( $client, $handler );
    };

    $self->{_sock} = $sock;
    $self->{_guard} = $w;

    return $self;
}

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

    # Could use EV::run, but this is prone to a crash due to:
    # syswrite() on closed filehandle GEN1653 at .../lib/site_perl/5.12.3/IO/Stream/EV.pm line 160.
    # At least AnyEvent will catch these errors

    # EV::run;

    AE::cv->recv;
}

package Plack::Handler::FCGI::EV::Handler;

use strict;
use Plack::Util;

use Carp ();
use URI::Escape;

sub factory {
    my($class, $app) = @_;
    bless { app => $app }, $class;
}

# HACK: This is called from FCGI::EV - but it's actually an instance
# method since we pass our own object to 'handler_class'.
sub new {
    my $factory = shift;
    my ($server, $env) = @_;

    my $app = $factory->{app};

    $env = {
        SCRIPT_NAME       => '',
        'psgi.version'    => [ 1, 0 ],
        'psgi.errors'     => *STDERR,
        'psgi.url_scheme' => 'http',
        'psgi.nonblocking'  => 1,
        'psgi.streaming'    => 1,
        'psgi.multithread'  => 0,
        'psgi.multiprocess' => 1,
        'psgi.run_once'     => 0,
        'psgix.input.buffered' => 1,
        %$env,
    };

    my $request_uri = $env->{REQUEST_URI};
    my ( $file, $query_string ) = ( $request_uri =~ /([^?]*)(?:\?(.*))?/s );    # split at ?
    $env->{PATH_INFO} = URI::Escape::uri_unescape $file;
    $env->{QUERY_STRING} = $query_string || '';
    $env->{SERVER_NAME} =~ s/:\d+$//;
    # warn Dumper $env;

    my $self = {
        stdin => '',
        server => $server,
        env => $env,
        app => $app,
    };
    bless $self, ref $factory;
}

# not support Async Input yet
sub stdin {
    my ($self, $stdin, $is_eof) = @_;
    $self->{stdin} .= $stdin;
    if ($is_eof) {
        open my $input, "<", \$self->{stdin};
        $self->{env}->{'psgi.input'} = $input;
        $self->run_app;
    }
}

sub run_app {
    my $self = shift;
    my $res  = Plack::Util::run_app $self->{app}, $self->{env};

    if (ref $res eq 'ARRAY') {
        $self->handle_response($res);
    } elsif (ref $res eq 'CODE') {
        $res->(sub { $self->handle_response($_[0]) });
    } else {
        Carp::croak("Unknown response: $res");
    }
}

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

    my $hdrs = "Status: $res->[0]\r\n";
    Plack::Util::header_iter $res->[1], sub {
        $hdrs .= "$_[0]: $_[1]\r\n";
    };
    $hdrs .= "\r\n";
    $self->{server}->stdout($hdrs);

    if (defined $res->[2]) {
        my $cb = sub { $self->{server}->stdout( $_[0] ) };
        Plack::Util::foreach( $res->[2], $cb );
        $self->{server}->stdout( "", 1 );
    } else {
        return Plack::Util::inline_object
            write => sub { $self->{server}->stdout($_[0]) },
            close => sub { $self->{server}->stdout("", 1) };
    }
}

package Plack::Handler::FCGI::EV;

1;

__END__

=encoding utf-8

=for stopwords

=head1 NAME

Plack::Handler::FCGI::EV - PSGI handler for FCGI::EV

=head1 SYNOPSIS

  > plackup -s FCGI::EV --listen :8080 myapp.psgi

=head1 DESCRIPTION

Plack::Handler::FCGI::EV is an asynchronous PSGI handler using
L<FCGI::EV> as its backend.

=head1 AUTHORS

mala

Tatsuhiko Miyagawa E<lt>[e-mail]<gt>

=head1 COPYRIGHT

Copyright 2011- Tatsuhiko Miyagawa

=head1 LICENSE

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

=head1 SEE ALSO

=cut