From f8695e273bcb358b6ab0916d68706f7188331f56 Mon Sep 17 00:00:00 2001 From: mike Date: Sat, 9 Mar 2013 18:47:53 +0000 Subject: [PATCH 1/5] Refactored run method to return just $body for callback, updated relevant tests --- lib/CGI/Application.pm | 16 ++++++---------- t/lib/TestApp_PSGI_Callback.pm | 8 +++++++- t/psgi_streaming_callback.t | 1 - 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index c64e1f1..749fba8 100644 --- a/lib/CGI/Application.pm +++ b/lib/CGI/Application.pm @@ -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 { @@ -1116,10 +1110,12 @@ 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->psgi_header ]); + foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); diff --git a/t/lib/TestApp_PSGI_Callback.pm b/t/lib/TestApp_PSGI_Callback.pm index a5af140..ab034e6 100644 --- a/t/lib/TestApp_PSGI_Callback.pm +++ b/t/lib/TestApp_PSGI_Callback.pm @@ -28,12 +28,18 @@ 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 works fine + #my $writer = $respond->([ $self->query->psgi_header ]); # this doesn't work? + my $writer = $respond->([ $self->_send_psgi_headers ]); # this works, but uses an internal call - perhaps it should be made public? 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..c393382 100644 --- a/t/psgi_streaming_callback.t +++ b/t/psgi_streaming_callback.t @@ -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; From d3a8d0909b7f794b8cbaa0913cc3cac7faf08d88 Mon Sep 17 00:00:00 2001 From: mike Date: Sat, 9 Mar 2013 18:58:26 +0000 Subject: [PATCH 2/5] tabs > spaces --- t/lib/TestApp_PSGI_Callback.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/lib/TestApp_PSGI_Callback.pm b/t/lib/TestApp_PSGI_Callback.pm index ab034e6..a1f6dea 100644 --- a/t/lib/TestApp_PSGI_Callback.pm +++ b/t/lib/TestApp_PSGI_Callback.pm @@ -38,8 +38,8 @@ sub callback_subref { foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); - } - $writer->close; + } + $writer->close; }; } From d91acb68f1cab9301ab6d51c6f82fdec33bc3b74 Mon Sep 17 00:00:00 2001 From: mike Date: Sat, 9 Mar 2013 19:00:07 +0000 Subject: [PATCH 3/5] close writer (pod) --- lib/CGI/Application.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index 749fba8..f79f363 100644 --- a/lib/CGI/Application.pm +++ b/lib/CGI/Application.pm @@ -1119,7 +1119,8 @@ The PSGI Specification allows for returning a file handle or a subroutine refere foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); - } + } + $writer->close; }; } From 5c15da7b0fddddacfceb510dfb79af51baedca80 Mon Sep 17 00:00:00 2001 From: mike Date: Sat, 9 Mar 2013 19:01:53 +0000 Subject: [PATCH 4/5] pod: use _send_psgi_headers --- lib/CGI/Application.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index f79f363..3894eba 100644 --- a/lib/CGI/Application.pm +++ b/lib/CGI/Application.pm @@ -1114,7 +1114,7 @@ The PSGI Specification allows for returning a file handle or a subroutine refere return sub { my $respond = shift; - my $writer = $respond->([ $self->psgi_header ]); + my $writer = $respond->([ $self->_send_psgi_header ]); foreach my $i (1..10) { #sleep 1; From 60946720c1fd81e49b2d47617e26185a25b64225 Mon Sep 17 00:00:00 2001 From: mike Date: Tue, 26 Mar 2013 13:22:54 +0000 Subject: [PATCH 5/5] make send_psgi_headers method public, we we can use it in streaming callback --- lib/CGI/Application.pm | 15 ++++++++++++--- t/lib/TestApp_PSGI_Callback.pm | 5 ++--- t/psgi_streaming_callback.t | 2 +- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index 3894eba..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 @@ -658,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; @@ -1114,7 +1114,7 @@ The PSGI Specification allows for returning a file handle or a subroutine refere return sub { my $respond = shift; - my $writer = $respond->([ $self->_send_psgi_header ]); + my $writer = $respond->([ $self->send_psgi_headers ]); foreach my $i (1..10) { #sleep 1; @@ -2065,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 a1f6dea..9e4c617 100644 --- a/t/lib/TestApp_PSGI_Callback.pm +++ b/t/lib/TestApp_PSGI_Callback.pm @@ -32,9 +32,8 @@ sub callback_subref { return sub { my $respond = shift; - #my $writer = $respond->([200, ['Content-Type' => 'text/plain']]); # this works fine - #my $writer = $respond->([ $self->query->psgi_header ]); # this doesn't work? - my $writer = $respond->([ $self->_send_psgi_headers ]); # this works, but uses an internal call - perhaps it should be made public? + #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"); diff --git a/t/psgi_streaming_callback.t b/t/psgi_streaming_callback.t index c393382..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';