view release on metacpan or  search on metacpan

t/HTTPServer.pm  view on Meta::CPAN

}

sub add_trigger {
    my ($self, $name, $code) = @_;
    push @{$self->{triggers}->{$name}}, $code;
    return $self;
}

sub call_trigger {
    my ($self, $name, @args) = @_;
    for my $code (@{ $self->{triggers}->{$name} || +[] }) {
        $code->($self, @args);
    }
}

sub run {
    my ( $self, $app ) = @_;

    $app = $self->fill_content_length($app);

    local $SIG{PIPE} = "IGNORE";
    my $sock = IO::Socket::INET->new(
        Listen    => SOMAXCONN,
        Proto     => 'tcp',
        ReuseAddr => 1,
        LocalAddr => '127.0.0.1',
        LocalPort => $self->{port},
        Timeout   => 3,
    ) or die $!;
    $sock->autoflush(1);
    while ( my $csock = $sock->accept ) {
        $csock->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1 )
          or die "setsockopt(TCP_NODELAY) failed:$!";
        eval {
            $self->handle_connection($csock => $app);
        };
        print STDERR "# $@" if $@;
    }
}

sub make_header {
    my ($self, $code, $headers) = @_;
    my $msg = $STATUS_CODE{$code} || $code;
    my $ret = "$self->{protocol} $code $msg\015\012";
    for (my $i=0; $i<@$headers; $i+=2) {
        $ret .= $headers->[$i] . ': ' . $headers->[$i+1] . "\015\012";
    }
    return $ret;
}

sub handle_connection {
    my ($self, $csock, $app) = @_;

    $self->call_trigger( "BEFORE_HANDLE_CONNECTION", $csock );
    HANDLE_LOOP: while (1) {
        $self->call_trigger( "BEFORE_HANDLE_REQUEST", $csock );
        my %env;
        my $buf = '';
      PARSE_HTTP_REQUEST: while (1) {
            my $nread = sysread( $csock, $buf, $self->{bufsize}, length($buf) );
            $buf =~ s!^(\015\012)*!! if defined($buf); # for keep-alive
            if ( !defined $nread ) {
                die "cannot read HTTP request header: $!";
            }
            if ( $nread == 0 ) {
                # unexpected EOF while reading HTTP request header
                last HANDLE_LOOP;
            }
            my $ret = parse_http_request( $buf, \%env );
            if ( $ret == -2 ) {    # incomplete.
                next;
            }
            elsif ( $ret == -1 ) {    # request is broken
                die "broken HTTP header";
            }
            else {
                $buf = substr( $buf, $ret );
                last PARSE_HTTP_REQUEST;
            }
        }
        $self->call_trigger( "BEFORE_CALL_APP", $csock, \%env );
        my $res = $app->( \%env );
        $self->call_trigger( "AFTER_CALL_APP", $csock, \%env );
        my $res_header =
          $self->make_header( $res->[0], $res->[1] ) . "\015\012";
        $self->write_all( $csock, $res_header );
        for my $body (@{$res->[2]}) {
            $self->write_all( $csock, $body );
        }
        $self->call_trigger( "AFTER_HANDLE_REQUEST", $csock );
        last HANDLE_LOOP unless $csock->opened;
    }
    $self->call_trigger( "AFTER_HANDLE_CONNECTION", $csock );
}

sub fill_content_length {
    my ($self, $app) = @_;

    sub {
        my $env = shift;
        my $res = $app->($env);
        my $h = t::HTTPServer::Headers->new( $res->[1] );
        if (
            !t::HTTPServer::Util::status_with_no_entity_body( $res->[0] )
            && !$h->exists('Content-Length')
            && !$h->exists('Transfer-Encoding')
            && defined(
                my $content_length = t::HTTPServer::Util::content_length( $res->[2] )
            )
        ) {
            push @{$res->[1]}, 'Content-Length' => $content_length;
        }
        return $res;
    }
}

sub write_all {
    my ( $self, $csock, $buf ) = @_;
    my $off = 0;
    while ( my $len = length($buf) - $off ) {
        my $nwrite = $csock->syswrite( $buf, $len, $off )