diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index c64e1f1..5981524 100644 --- a/lib/CGI/Application.pm +++ b/lib/CGI/Application.pm @@ -199,7 +199,7 @@ sub run { my $return_value; if ($self->{__IS_PSGI}) { - my ($status, $headers) = $self->_send_psgi_headers(); + my ($status, $headers) = $self->send_psgi_headers(); if (ref($body) eq 'GLOB' || (Scalar::Util::blessed($body) && $body->can('getline'))) { # body a file handle - return it @@ -207,14 +207,8 @@ sub run { } elsif (ref($body) eq 'CODE') { - # body is a subref, or an explicit callback method is set - $return_value = sub { - my $respond = shift; - - my $writer = $respond->([ $status, $headers ]); - - &$body($writer); - }; + # body is a subref + $return_value = $body; } else { @@ -664,7 +658,7 @@ sub _send_headers { } # return a 2 element array modeling the first PSGI redirect values: status code and arrayref of header pairs -sub _send_psgi_headers { +sub send_psgi_headers { my $self = shift; my $q = $self->query; my $type = $self->header_type; @@ -1116,14 +1110,17 @@ The PSGI Specification allows for returning a file handle or a subroutine refere sub returning_a_subref { my $self = shift; - $self->header_props(-type => 'text/plain'); + return sub { - my $writer = shift; + my $respond = shift; + my $writer = $respond->([ $self->send_psgi_headers ]); + foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); - } + } + $writer->close; }; } @@ -2068,6 +2065,15 @@ B The prerun_mode() method may ONLY be called in the context of a cgiapp_prerun() method. Your application will die() if you call prerun_mode() elsewhere, such as in setup() or a run mode method. +=head3 send_psgi_headers() + + my ($http_status_code, $headers_aref) = $self->send_psgi_headers; + +This method generates PSGI headers based on header_type and header_props. It is +normally called automatically for you. However, you may call it directly if you +are using the coderef return value option, and writing your own callback to +generate the headers. + =head2 Dispatching Clean URIs to run modes Modern web frameworks dispense with cruft in URIs, providing in clean diff --git a/t/lib/TestApp_PSGI_Callback.pm b/t/lib/TestApp_PSGI_Callback.pm index a5af140..9e4c617 100644 --- a/t/lib/TestApp_PSGI_Callback.pm +++ b/t/lib/TestApp_PSGI_Callback.pm @@ -28,12 +28,17 @@ sub callback_subref { my $self = shift; $self->header_props(-type => 'text/plain'); + return sub { - my $writer = shift; + my $respond = shift; + + #my $writer = $respond->([200, ['Content-Type' => 'text/plain']]); # this method is fine + my $writer = $respond->([ $self->send_psgi_headers ]); # using cgi-app header props foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); - } + } + $writer->close; }; } diff --git a/t/psgi_streaming_callback.t b/t/psgi_streaming_callback.t index 6c10c8f..3c44ae6 100644 --- a/t/psgi_streaming_callback.t +++ b/t/psgi_streaming_callback.t @@ -5,7 +5,7 @@ use Test::Requires qw(Plack::Loader LWP::UserAgent); use Test::TCP; use TestApp_PSGI_Callback; -use CGI::Application::PSGI; +use CGI::PSGI; my $test_file = 't/test_file_to_stream.txt'; @@ -27,7 +27,6 @@ test_tcp( my $env = shift; return sub { my $respond = shift; - use Data::Dumper; my $w = $respond->([ 200, ['X-Foo' => 'bar', 'Content-Type' => 'text/plain'] ]); foreach my $i (1..5) { #sleep 1;