File Coverage

blib/lib/FCGI/EV/Std.pm

Criterion	Covered	Total	%
statement	26	59	44.0
branch	0	16	0.0
condition	0	7	0.0
subroutine	9	13	69.2
pod	0	2	0.0
total	35	97	36.0

package FCGI::EV::Std;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;

our $VERSION = 'v2.0.1';

use Scalar::Util qw( weaken );

use if $INC{'CGI.pm'}, 'CGI::Stateless';


use constant HTTP_417_EXPECTATION_FAILED =>
    "Status: 417 Expectation Failed\r\n"
  . "Content-Type: text/html\r\n"
  . "\r\n"
  . '417 Expectation Failed'
  . 'Expectation Failed'
  . 'Request entity too large or incomplete.'
  ;

use constant MiB => 1*1024*1024;    ## no critic (Capitalization)

our $BLOCKING   = 1;
our $MAX_STDIN  = MiB;
our $MAIN       = \&main::main;
our $HUP        = undef;


sub new {
    my ($class, $server, $env) = @_;
    my $len = $env->{CONTENT_LENGTH} || 0;
    my $self = bless {
        server  => $server,
        env     => $env,
        stdin   => q{},
        allow   => $len <= $MAX_STDIN,
    }, $class;
    weaken($self->{server});
    return $self;
}

# No protection against reading STDIN larger than CONTENT_LENGTH - because
# FastCGI protocol FORBID this so web server shouldn't send so much data
# ( http://www.fastcgi.com/devkit/doc/fcgi-spec.html#S6.2 ).
#
# If huge files will be uploaded it MAY have sense to save STDIN to
# secure tempfile - but code which parse POST data from STDIN in CGI also
# shouldn't read all STDIN into memory, or this feature will not help.
sub stdin {
    my ($self, $stdin, $is_eof) = @_;
    if ($self->{allow}) {
        $self->{stdin} .= $stdin;
    }
    if ($is_eof) {
        if (length $self->{stdin} != ($self->{env}{CONTENT_LENGTH} || 0)) {
            $self->{server}->stdout(HTTP_417_EXPECTATION_FAILED, 1);
        }
        else {
            local *STDIN;
            open STDIN, '<', \$self->{stdin}        or die "open STDIN: $!\n";
            local %ENV = %{ $self->{env} };
            if ($INC{'CGI/Stateless.pm'}) {
                local $CGI::Q = CGI::Stateless->new();
                $self->_run();
            }
            else {
                $self->_run();
            }
        }
    }
    return;
}

sub _run {
    my ($self) = @_;
    if ($BLOCKING) {
        local *STDOUT;
        my $reply = q{};
        open STDOUT, '>', \$reply           or die "open STDOUT: $!\n";
        $MAIN->();
        $self->{server}->stdout($reply, 1);
    }
    else {
        $MAIN->($self->{server});
    }
    return;
}

sub DESTROY {
    my ($self) = @_;
    if (!$BLOCKING && $HUP) {
        $HUP->($self->{server});
    }
    return;
}


1; # Magic true value required at end of module
__END__