support psgix.harakiri (close pull #5)

lib/Starlet/Server.pm

@@ -128,6 +128,7 @@ sub accept_loop {
                     'psgi.nonblocking'  => Plack::Util::FALSE,
                     'psgix.input.buffered' => Plack::Util::TRUE,
                     'psgix.io'          => $conn,
+                    'psgix.harakiri'    => 1,
                 };
 
                 # no need to take care of pipelining since this module is a HTTP/1.0 server
@@ -136,8 +137,12 @@ sub accept_loop {
                     $may_keepalive = undef;
                 }
                 $is_keepalive = ($req_count != 1) ? 1 : 0;
-                $self->handle_connection($env, $conn, $app, $may_keepalive, $req_count != 1)
-                    or last;
+                my $use_keepalive = $self->handle_connection($env, $conn, $app, $may_keepalive, $req_count != 1);
+                if ($env->{'psgix.harakiri.commit'}) {
+                    $conn->close;
+                    return;
+                }
+                $use_keepalive or last;
                 # TODO add special cases for clients with broken keep-alive support, as well as disabling keep-alive for HTTP/1.0 proxies
             }
             $conn->close;

t/06harakiri.t

@@ -0,0 +1,42 @@
+use strict;
+use warnings;
+
+use HTTP::Request::Common;
+use Plack::Test;
+use Test::More;
+
+$Plack::Test::Impl = 'Server';
+$ENV{PLACK_SERVER} = 'Starlet';
+
+test_psgi
+    app => sub {
+        my $env = shift;
+        return [ 200, [ 'Content-Type' => 'text/plain' ], [$$] ];
+    },
+    client => sub {
+        my %seen_pid;
+        my $cb = shift;
+        for (1..23) {
+            my $res = $cb->(GET "/");
+            $seen_pid{$res->content}++;
+        }
+        cmp_ok(keys(%seen_pid), '<=', 10, 'In non-harakiri mode, pid is reused')
+    };
+
+test_psgi
+    app => sub {
+        my $env = shift;
+        $env->{'psgix.harakiri.commit'} = $env->{'psgix.harakiri'};
+        return [ 200, [ 'Content-Type' => 'text/plain' ], [$$] ];
+    },
+    client => sub {
+        my %seen_pid;
+        my $cb = shift;
+        for (1..23) {
+            my $res = $cb->(GET "/");
+            $seen_pid{$res->content}++;
+        }
+        is keys(%seen_pid), 23, 'In Harakiri mode, each pid only used once';
+    };
+
+done_testing;