view release on metacpan or  search on metacpan

lib/Monoceros/Server.pm  view on Meta::CPAN

            my $next_conn;
            while ( $next_conn || $self->{stop_accept} || $proc_req_count < $max_reqs_per_child ) {
                last if ( $self->{term_received}
                       && !$next_conn );
                my $conn;
                if ( $next_conn && $next_conn->{buf} ) { #read ahead or pipeline
                    $conn = $next_conn;
                    $next_conn = undef;
                }
                else {
                    my @rfh = @{$self->{fhlist}};
                    my $rfd = $self->{fhbits};
                    if ( $next_conn ) {
                        push @rfh, $next_conn->{fh};
                        vec($rfd, fileno $next_conn->{fh}, 1) = 1;
                    }
                    my @can_read;
                    if ( select($rfd, undef, undef, 1) > 0 ) {
                        for ( my $i = 0; $i <= $#rfh; $i++ ) {
                            my $try_read_fd = fileno $rfh[$i];
                            if ( !defined $rfd || vec($rfd, $try_read_fd, 1) ) {
                                if ( $next_conn && fileno $next_conn->{fh} == $try_read_fd ) {
                                    $conn = $next_conn;
                                    last;
                                }
                                push @can_read, $self->{fhlist}[$i];
                            }
                        }
                    }
                    #accept or recv
                    if ( !$conn )  {
                        $conn = $self->accept_or_recv( @can_read );
                    }
                    # exists new conn && exists next_conn && next_conn is not ready => keep
                    if ( $conn && $next_conn && $conn != $next_conn ) {
                        $self->keep_it($next_conn);
                    }
                    # try to re-read next_conn
                    if ( !$conn && $next_conn ) {
                        @rfh = ();
                        next;
                    }
                    #clear next_conn
                    @rfh = ();
                    $next_conn = undef;
                }
                next unless $conn;

                my $env = {
                    SERVER_PORT => $self->{port} || 0,
                    SERVER_NAME => $self->{host} || 0,
                    SCRIPT_NAME => '',
                    REMOTE_ADDR => $conn->{peeraddr},
                    REMOTE_PORT => $conn->{peerport} || 0,
                    'psgi.version'      => [ 1, 1 ],
                    'psgi.errors'       => *STDERR,
                    'psgi.url_scheme'   => 'http',
                    'psgi.run_once'     => Plack::Util::FALSE,
                    'psgi.multithread'  => Plack::Util::FALSE,
                    'psgi.multiprocess' => Plack::Util::TRUE,
                    'psgi.streaming'    => Plack::Util::TRUE,
                    'psgi.nonblocking'  => Plack::Util::FALSE,
                    'psgix.input.buffered' => Plack::Util::TRUE,
                    'psgix.io'          => $conn->{fh},
                    'psgix.harakiri'    => 1,
                    'X_MONOCEROS_WORKER_STATS' => $self->{stats_filename},
                };
                $env->{'X_REMOTE_PID'} = $$ if $ENV{HARNESS_ACTIVE};
                $self->{_is_deferred_accept} = 1; # ready to read
                my $prebuf;
                if ( exists $conn->{buf} ) {
                    $prebuf = delete $conn->{buf};
                }
                else {
                    #pre-read
                    my $ret = sysread($conn->{fh}, $prebuf, MAX_REQUEST_SIZE);
                    if ( ! defined $ret && ($! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR) ) {
                        $self->keep_it($conn);
                        next;
                    }
                    elsif ( defined $ret && $ret == 0) {
                        #closed?
                        $self->cmd_to_mgr('clos', $conn->{peername}, $conn->{reqs})
                            if !$conn->{direct};
                        next;
                    }
                }
                # stop keepalive if SIG{TERM} or SIG{USR1}. but go-on if pipline req
                my $may_keepalive = 1;
                $may_keepalive = 0 if ($self->{term_received} || $self->{stop_accept});
                $may_keepalive = 0 if $self->{disable_keepalive};
                my $is_keepalive = 1; # to use "keepalive_timeout" in handle_connection,
                                      # treat every connection as keepalive
                my ($keepalive,$pipelined_buf) = $self->handle_connection($env, $conn->{fh}, $app,
                                                         $may_keepalive, $is_keepalive, $prebuf,
                                                         $conn->{reqs});
                # harakiri
                if ($env->{'psgix.harakiri.commit'}) {
                    $proc_req_count = $max_reqs_per_child + 1;
                }

                ++$proc_req_count;
                $conn->{reqs}++;
                if ( !$keepalive ) {
                    #close
                    $self->cmd_to_mgr('clos', $conn->{peername}, $conn->{reqs})
                        if !$conn->{direct};
                    next;
                }

                # pipeline
                if ( defined $pipelined_buf && length $pipelined_buf ) {
                    $next_conn = $conn;
                    $next_conn->{buf} = $pipelined_buf;
                    next;
                }

                # read ahead
                if ( $conn->{reqs} < $max_readahead_reqs &&  $proc_req_count <= $max_reqs_per_child ) {
                    $next_conn = $conn;
                    next;