start adding support for streaming responses

2 files changed, 49 insertions, 0 deletions

diff --git a/lib/Web/Response.pm b/lib/Web/Response.pm
index c276724..6516021 100644
--- a/lib/Web/Response.pm
+++ b/lib/Web/Response.pm
@@ -63,6 +63,12 @@ has content => (
     default => sub { [] },
 );
 
+has streaming_response => (
+    is        => 'rw',
+    isa       => 'CodeRef',
+    predicate => 'has_streaming_response',
+);
+
 has cookies => (
     is      => 'rw',
     isa     => 'HashRef[Str|HashRef[Str]]',
@@ -93,6 +99,11 @@ sub BUILDARGS {
                 : ()),
         };
     }
+    elsif (@_ == 1 && ref($_[0]) eq 'CODE') {
+        return {
+            streaming_response => $_[0],
+        };
+    }
     else {
         return $class->SUPER::BUILDARGS(@_);
     }
@@ -109,6 +120,9 @@ sub redirect {
 sub finalize {
     my $self = shift;
 
+    return $self->_finalize_streaming
+        if $self->has_streaming_response;
+
     $self->_finalize_cookies;
 
     my $res = [
@@ -140,6 +154,15 @@ sub finalize {
     });
 }
 
+sub _finalize_streaming {
+    my $self = shift;
+
+    # XXX cookies?
+    # XXX encoding?
+
+    return $self->streaming_response;
+}
+
 sub _encode {
     my $self = shift;
     my ($content) = @_;
diff --git a/t/response-streaming.t b/t/response-streaming.t
new file mode 100644
index 0000000..fdf54e6
--- /dev/null
+++ b/t/response-streaming.t
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Web::Response;
+
+{
+    my $res = Web::Response->new(sub {
+        my $responder = shift;
+        $responder->([200, [], ["Hello world"]]);
+    });
+    my $psgi_res = $res->finalize;
+    ok(ref($psgi_res) eq 'CODE', "got a coderef");
+
+    my $complete_response;
+    my $responder = sub { $complete_response = $_[0] };
+    $psgi_res->($responder);
+    is_deeply(
+        $complete_response,
+        [ 200, [], ["Hello world"] ],
+        "got the right response"
+    );
+}
+
+done_testing;