From 378d39ae1a2cf3f6568e410a7844c2fa6dd12526 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Fri, 28 Sep 2012 23:37:03 -0500 Subject: start adding support for streaming responses --- lib/Web/Response.pm | 23 +++++++++++++++++++++++ t/response-streaming.t | 26 ++++++++++++++++++++++++++ 2 files changed, 49 insertions(+) create mode 100644 t/response-streaming.t 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; -- cgit v1.2.3