view release on metacpan or  search on metacpan

lib/Arriba/Connection/HTTP.pm  view on Meta::CPAN

package Arriba::Connection::HTTP;

use warnings;
use strict;

use Data::Dump qw(dump);
use HTTP::Status qw(status_message);
use IO::Socket qw(:crlf);
use Plack::Util;
use Socket qw(IPPROTO_TCP TCP_NODELAY);

use base 'Arriba::Connection';

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    if ($self->{client}->NS_proto eq 'TCP') {
        setsockopt($self->{client}, IPPROTO_TCP, TCP_NODELAY, 1)
            or die $!;
    }
    
    $self->{_inputbuf} = '';
    $self->{_current_req} = undef;
    $self->{_keepalive} = 1;

    return $self;
}

sub read_request {
    my $self = shift;

    my $req;

    if ($req = $self->{_current_req}) {
        # Partially processed request
        my $get_chunk = sub {
            if ($self->{_inputbuf}) {
                my $chunk = delete $self->{_inputbuf};
                return ($chunk, length $chunk);
            }
            my $read = sysread $self->{client}, my($chunk), $self->{chunk_size};
            return ($chunk, $read);
        };

        my $chunked = do {
            no warnings;
            lc delete $req->{env}->{HTTP_TRANSFER_ENCODING} eq 'chunked'
        };

        if ((my $cl = $req->{content_length}) >= 0) {
            $req->{body_stream} = Stream::Buffered->new($req->{content_length});
            while ($cl > 0) {
                my($chunk, $read) = $get_chunk->();

                if (!defined $read || $read == 0) {
                    die "Read error: $!\n";
                }

                $cl -= $read;
                $req->{body_stream}->print($chunk);
            }
        }
        elsif ($chunked) {
            $req->{body_stream} = Stream::Buffered->new;
            my $chunk_buffer = '';
            my $length;

            DECHUNK:
            while (1) {
                my($chunk, $read) = $get_chunk->();
                $chunk_buffer .= $chunk;

                while ($chunk_buffer =~ s/^(([0-9a-fA-F]+).*\015\012)// ) {
                    my $trailer = $1;
                    my $chunk_len = hex $2;