Browse files

Enable HTTP pipelining for requests with body

  • Loading branch information...
1 parent f0ac5bd commit 1e3ada44d2c2b5dafc0f9d8a164814c952e4ba2a @pmakholm pmakholm committed Mar 16, 2012
Showing with 94 additions and 0 deletions.
  1. +6 −0 lib/Starman/Server.pm
  2. +88 −0 t/pipeline.t
View
6 lib/Starman/Server.pm
@@ -386,6 +386,11 @@ sub _prepare_env {
die "Read error: $!\n";
}
+ if ( $read > $cl ) {
+ $self->{client}->{inputbuf} .= substr $chunk, $cl;
+ $read = $cl;
+ }
+
$cl -= $read;
$buf->print($chunk);
}
@@ -419,6 +424,7 @@ sub _prepare_env {
last unless $read && $read > 0;
}
+ $self->{client}->{inputbuf} .= $chunk_buffer;
$env->{CONTENT_LENGTH} = $length;
$env->{'psgi.input'} = $buf->rewind;
View
88 t/pipeline.t
@@ -0,0 +1,88 @@
+use strict;
+
+use Test::More;
+use Scalar::Util qw(blessed);
+use Plack::Util;
+
+{
+ package Starman::Server;
+
+ # Override the sysread method enabling it to read a stream of packages
+ # from an arrayref instead of an file handle:
+ use subs qw(sysread alarm);
+
+ *Starman::Server::sysread = sub {
+ if (Scalar::Util::blessed($_[0]) && $_[0]->can("getline")) {
+ die "EWOULDBLOCK\n" unless $_[0]->can_read();
+
+ $_[1] = $_[0]->getline;
+ return length $_[1];
+ }
+
+ return CORE::sysread($_[0], $_[1], $_[2]);
+ };
+
+ *Starman::Server::alarm = sub { 1 };
+}
+
+use Starman::Server;
+
+# Override the _finalize_response to collect responses
+local *Starman::Server::_finalize_response = sub {
+ my ($self, $env, $res) = @_;
+
+ $self->{results} ||= [];
+ push @{ $self->{results} }, [$env, $res];
+};
+
+# Override IO::Select to pseudo support our connection type
+*IO::Select::real_new = *IO::Select::new;
+local *IO::Select::new = sub {
+ return $_[1] if (blessed($_[1]) && $_[1]->can("can_read"));
+
+ goto &IO::Select::real_new;
+};
+
+
+# The stream of requests
+my $requests = 7;
+my $stream = [
+ "GET /req1 HTTP/1.1\r\nHost: localhost\r\n\r\n",
+ "PUT /req2 HTTP/1.1\r\nHost: localhost\r\nContent-Length: 2\r\n\r\nOK",
+ "GET /req3 HTTP/1.1\r\nHost: localhost\r\n\r\n",
+ "PUT /req4 HTTP/1.1\r\nHost: localhost\r\nContent-Length: 2\r\n\r\nOKGET /req5 HTTP/1.1\r\nHost: localhost\r\n\r\n",
+ "PUT /req6 HTTP/1.1\r\nHost: localhost\r\nTransfer-Encoding: chunked\r\n\r\n2\r\nOK0\r\nGET /req7 HTTP/1.1\r\nHost: localhost\r\n\r\n",
+];
+
+my $server = bless {
+ server => {
+ client => Plack::Util::inline_object(
+ NS_proto => sub { "Fake" },
+ getline => sub { shift @{ $stream } },
+ can_read => sub { @{ $stream } },
+ connected => sub { 1 },
+ ),
+ },
+ client => {
+ keepalive => 1,
+ },
+ options => {
+ keepalive => 1,
+ },
+ app => sub {
+ return [ 200, [], [ "OK" ] ];
+ }
+}, "Starman::Server";
+
+$server->process_request();
+
+my %processed;
+for my $res ( @{ $server->{results} } ) {
+ $processed{ $res->[0]->{PATH_INFO} }++;
+}
+
+for (1 .. $requests) {
+ is( $processed{"/req$_"}, 1, "Request $_ processed once" );
+}
+
+done_testing;

0 comments on commit 1e3ada4

Please sign in to comment.