Fix for issue #23

lib/Starman/Server.pm

@@ -442,7 +442,8 @@ sub _finalize_response {
     my(@headers, %headers);
     push @headers, "$protocol $status $message";
 
-    # Switch on Transfer-Encoding: chunked if we don't know Content-Length.
+    # Switch on Transfer-Encoding: chunked if we don't know Content-Length
+    # and Transfer-Encoding: chunked is not already in effect.
     my $chunked;
     my $headers = $res->[1];
     for (my $i = 0; $i < @$headers; $i += 2) {
@@ -456,15 +457,12 @@ sub _finalize_response {
     if ( $protocol eq 'HTTP/1.1' ) {
         if ( !exists $headers{'content-length'} ) {
             if ( $status !~ /^1\d\d|[23]04$/ ) {
-                DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n";
-                push @headers, 'Transfer-Encoding: chunked';
-                $chunked = 1;
-            }
-        }
-        elsif ( my $te = $headers{'transfer-encoding'} ) {
-            if ( $te eq 'chunked' ) {
-                DEBUG && warn "[$$] Chunked transfer-encoding set for response\n";
-                $chunked = 1;
+                my $te = $headers{'transfer-encoding'};
+                if ( !$te || $te ne 'chunked' ) {
+                    DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n";
+                    push @headers, 'Transfer-Encoding: chunked';
+                    $chunked = 1;
+                }
             }
         }
     } else {

t/chunked_res.t

@@ -0,0 +1,54 @@
+use strict;
+use Plack::Test;
+use HTTP::Request;
+use Test::More;
+use IO::Socket qw(:crlf);
+
+$Plack::Test::Impl = "Server";
+$ENV{PLACK_SERVER} = 'Starman';
+
+my @app = (
+    sub {
+        my $env = shift;
+        return sub {
+            my $response = shift;
+            my $writer = $response->([ 200, [ 'Content-Type', 'text/plain' ]]);
+            $writer->write("This is the data in the first chunk${CRLF}");
+            $writer->write("and this is the second one${CRLF}");
+            $writer->write("con");
+            $writer->write("sequence");
+            $writer->close;
+        }
+    },
+    sub {
+        my $env = shift;
+        return sub {
+            my $response = shift;
+            my $writer = $response->([
+                200, [ 'Content-Type', 'text/plain', 'Transfer-Encoding', 'chunked' ]
+            ]);
+            $writer->write("25${CRLF}This is the data in the first chunk${CRLF}${CRLF}");
+            $writer->write("1C${CRLF}and this is the second one${CRLF}${CRLF}");
+            $writer->write("3${CRLF}con${CRLF}");
+            $writer->write("8${CRLF}sequence${CRLF}");
+            $writer->write("0${CRLF}${CRLF}");
+            $writer->close;
+        }
+    },
+);
+
+for my $app (@app) {
+    test_psgi $app, sub {
+        my $cb = shift;
+
+        my $req = HTTP::Request->new(GET => "http://localhost/");
+        my $res = $cb->($req);
+
+        is $res->content,
+            "This is the data in the first chunk\r\n" .
+            "and this is the second one\r\n" .
+            "consequence";
+    };
+}
+
+done_testing;