File Coverage

blib/lib/Net/Async/FastCGI/PSGI.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	12	16	75.0
condition	1	2	50.0
subroutine	7	7	100.0
pod	2	2	100.0
total	66	71	92.9

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2010-2013 -- [e-mail]

package Net::Async::FastCGI::PSGI;

use strict;
use warnings;

use Carp;

use base qw( Net::Async::FastCGI );

our $VERSION = '0.25';

my $CRLF = "\x0d\x0a";

=head1 NAME

C - use C applications with C

=head1 SYNOPSIS

 use Net::Async::FastCGI::PSGI;
 use IO::Async::Loop;

 my $loop = IO::Async::Loop->new;

 my $fcgi = Net::Async::FastCGI::PSGI->new(
    port => 12345,
    app => sub {
       my $env = shift;

       return [
          200,
          [ "Content-Type" => "text/plain" ],
          [ "Hello, world!" ],
       ];
    },
 );

 $loop->add( $fcgi );

 $loop->run;

=head1 DESCRIPTION

This subclass of L allows a FastCGI responder to use a
L application to respond to requests. It acts as a gateway between the
FastCGI connection from the webserver, and the C application. Aside from
the use of C instead of the C event, this class behaves
similarly to C.

=cut

=head1 PARAMETERS

The following named parameters may be passed to C or C:

=over 8

=item app => CODE

Reference to the actual C application to use for responding to requests

=back

=cut

sub configure
{
   my $self = shift;
   my %args = @_;

   if( exists $args{app} ) {
      $self->{app} = delete $args{app};
   }

   $self->SUPER::configure( %args );
}

=head1 PSGI ENVIRONMENT

The following extra keys are supplied to the environment of the C app:

=over 8

=item C

The C object serving the request

=item C

The L object representing this particular
request

=item C

The L object that the C object is
a member of.

=back

=cut

sub on_request
{
   my $self = shift;
   my ( $req ) = @_;

   # Much of this code stolen fro^W^Winspired by Plack::Handler::Net::FastCGI

   my %env = (
      %{ $req->params },
      'psgi.version'      => [1,0],
      'psgi.url_scheme'   => ($req->param("HTTPS")||"off") =~ m/^(?:on|1)/i ? "https" : "http",
      'psgi.input'        => $req->stdin,
      'psgi.errors'       => $req->stderr,
      'psgi.multithread'  => 0,
      'psgi.multiprocess' => 0,
      'psgi.run_once'     => 0,
      'psgi.nonblocking'  => 1,
      'psgi.streaming'    => 1,

      # Extensions
      'net.async.fastcgi'     => $self,
      'net.async.fastcgi.req' => $req,
      'io.async.loop'         => $self->get_loop,
   );

   my $resp = $self->{app}->( \%env );

   my $responder = sub {
      my ( $status, $headers, $body ) = @{ +shift };

      $req->print_stdout( "Status: $status$CRLF" );
      while( my ( $header, $value ) = splice @$headers, 0, 2 ) {
         $req->print_stdout( "$header: $value$CRLF" );
      }
      $req->print_stdout( $CRLF );

      if( !defined $body ) {
         croak "Responder given no body in void context" unless defined wantarray;

         return $req->stdout_with_close;
      }

      if( ref $body eq "ARRAY" ) {
         $req->print_stdout( $_ ) for @$body;
         $req->finish( 0 );
      }
      else {
         $req->stream_stdout_then_finish(
            sub {
               local $/ = \8192;
               my $buffer = $body->getline;
               defined $buffer and return $buffer;

               $body->close;
               return undef;
            },
            0
         );
      }
   };

   if( ref $resp eq "ARRAY" ) {
      $responder->( $resp );
   }
   elsif( ref $resp eq "CODE" ) {
      $resp->( $responder );
   }
}

=head1 SEE ALSO

=over 4

=item *

L - Perl Web Server Gateway Interface Specification

=item *

L - FastCGI handler for Plack using L

=back

=head1 AUTHOR

Paul Evans

=cut

0x55AA;