view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

        - Provide 'gepok.socket', 'gepok.unix_socket' in $env.


0.12    2011-08-19  Released-By: SHARYANTO

        - No functional changes. Re-upload to CPAN with the correct account.


0.11    2011-08-18  Released-By: SHARYANTO

        - Some fixes to chunking response, keep-alive, etc.

        - Add attribute: timeout.

        - Provide 'gepok.client_protocol' in $env.


0.10    2011-08-16  Released-By: SHARYANTO

        - (internal) Minor refactoring on _finalize_response.

lib/Gepok.pm  view on Meta::CPAN

        }
    }
}

# taken from Starman, with modifications. turn PSGI response into actual HTTP
# response and send it to client.
sub _finalize_response {
    my($self, $env, $res, $sock) = @_;

    if ($env->{'psgix.harakiri.commit'}) {
        $self->{_client_keepalive} = 0;
        $self->{_client_harakiri}  = 1;
    }

    my $server_proto = $env->{SERVER_PROTOCOL};
    my $client_proto = $self->{_client_proto};
    my $status       = $res->[0];
    my $message      = status_message($status);
    $self->{_res_status} = $status;

    # generate HTTP status + response headers

lib/Gepok.pm  view on Meta::CPAN

            $self->product_name."/".$self->product_version;
    while (my ($k, $v) = splice @{$res->[1]}, 0, 2) {
        push @headers, "$k: $v";
        $headers{lc $k} = $v;
    }

    if (!$headers{date}) {
        push @headers, "Date: " . time2str(time());
    }

    my $keepalive;
    if ($env->{HTTP_CONNECTION}) {
        $keepalive = $env->{HTTP_CONNECTION} =~ /alive/i ? 1:0;
    }
    # default is keep-alive for HTTP/1.1, but close for HTTP/1.0
    $keepalive //= ($client_proto eq 'HTTP/1.1' ? 1:0);
    # normally HTTP::Daemon prints this, but we're not sending response using
    # HTTP::Daemon
    push @headers, "Connection: ".($keepalive ? "Keep-Alive" : "Close");

    my $chunked;
    my $cl = $headers{'content-length'};
    if ($client_proto eq 'HTTP/1.1') {
        if ($status =~ /^[123]/ && $status != 304 && (!defined($cl) || $cl)) {
            $chunked = 1;
        }
        if (my $te = $headers{'transfer-encoding'}) {
            $chunked = $te eq 'chunked';
        }
    } else {
        # "A server MUST NOT send transfer-codings to an HTTP/1.0 client."
        $chunked = 0;
    }
    push @headers, "Transfer-Encoding: chunked" if $chunked;
    $self->{_chunked} = $chunked;

    #warn "chunked=$chunked, keep-alive=$keepalive, client_proto=$client_proto";

    if ($client_proto le 'HTTP/1.0' && $keepalive && !defined($cl)) {
        # if HTTP/1.0 client requests keep-alive (like Wget), we need
        # Content-Length so client knows when response ends.

        # produce body first so we can calculate content-length
        $self->_finalize_body($env, $res, $sock, 1);
        push @headers, "Content-Length: ".$self->{_res_content_length};
        syswrite $sock, join($CRLF, @headers, '') . $CRLF; # print header
        syswrite $sock, $_ for @{$self->{_body}}; # print body
    } else {
        # print headers + body normally