Adjust TH to the newest PAGI::Tools

Author: bbrtj

cpanfile

@@ -3,7 +3,7 @@ on 'test' => sub {
 };
 
 requires 'perl' => '5.040';
-requires 'PAGI' => '0.001023';
+requires 'PAGI::Tools' => '0.002000';
 requires 'Gears' => '0.104';
 requires 'Mooish::Base' => '1.005';
 requires 'Future::AsyncAwait' => 0;

ex/full-app/lib/FullApp/Controller/API.pm

@@ -27,7 +27,7 @@ sub flatten_locations ($self, $level)
 	return @out;
 }
 
-async sub list_locations ($self, $ctx)
+sub list_locations ($self, $ctx)
 {
 	my @locations = map {
 		+{
@@ -39,6 +39,6 @@ async sub list_locations ($self, $ctx)
 		}
 	} $self->flatten_locations($self->router);
 
-	await $ctx->res->json(\@locations);
+	$ctx->res->json(\@locations);
 }
 

lib/Thunderhorse.pm

@@ -110,6 +110,9 @@ sub build_handler ($controller, $destination)
 			}
 		}
 
+		# this needs to be here, since we want to use $send from this context
+		await $ctx->try_send_res;
+
 		# if this is a bridge and bridge did not render, it means we are
 		# free to go deeper. Avoid first match, as it was handled already
 		# above
@@ -390,27 +393,27 @@ it is equally easy to do something else. Take the following destination example:
 
 	async sub send_custom ($self, $ctx)
 	{
-		await $ctx->res->text('Plaintext response');
+		$ctx->res->text('Plaintext response');
 		return 'this will not get rendered';
 	}
 
 This takes response (L<Thunderhorse::Response>) from context, and sends
 plaintext manually. This action I<consumes> the context, marking it as
-finished. In this case, return value of the destination is ignored. Note that
-the await call on C<< ->text >> method is mandatory.
+finished. In this case, return value of the destination is ignored.
+
 
 Another example:
 
 	sub send_custom2 ($self, $ctx)
 	{
-		$ctx->res->status(400)->content_type('text/plain');
-		return 'this is rendered as plaintext and status 400';
+		$ctx->res->content_type('text/plain');
+		return 'this is rendered as plaintext';
 	}
 
 This time, the return value of the destination is not ignored, since only
 setting response metadata does not cause the context to be consumed. Status and
 I<Content-Type> header will not be overridden, so the response will be sent as
-plaintext. In this case, there is no need to await anything.
+plaintext.
 
 While not very common, a destination can be unimplemented when C<to> is
 skipped. Unimplemented locations will be "stepped over" during request

lib/Thunderhorse/App.pm

@@ -207,7 +207,8 @@ async sub pagi ($self, $scope, $receive, $send)
 	# 404 is possible even if we had matches, as long as no handler consumed
 	# the context
 	if (!$ctx->is_consumed) {
-		await $self->render_error(undef, $ctx, 404);
+		$self->render_error(undef, $ctx, 404);
+		await $ctx->send_res;
 	}
 
 	return;
@@ -240,15 +241,12 @@ sub run ($self)
 async sub render_error ($self, $controller, $ctx, $code, $message = undef)
 {
 	$message = defined $message && !$self->is_production ? $message : status_message($code);
-	await $ctx->res->status($code)->text($message);
+	$ctx->new_res->status($code)->text($message);
 }
 
 async sub render_response ($self, $controller, $ctx, $result)
 {
-	await $ctx->res
-		->status_try(200)
-		->content_type_try('text/html')
-		->send($result);
+	$ctx->res->status_try(200)->html($result);
 }
 
 #########################

lib/Thunderhorse/Context.pm

@@ -5,6 +5,7 @@ use Mooish::Base -standard;
 
 use Devel::StrictMode;
 
+use Future::AsyncAwait;
 use Thunderhorse::Request;
 use Thunderhorse::Response;
 use Thunderhorse::WebSocket;
@@ -32,7 +33,8 @@ has field 'req' => (
 
 has field 'res' => (
 	(STRICT ? (isa => InstanceOf ['Thunderhorse::Response']) : ()),
-	default => sub ($self) { Thunderhorse::Response->new(context => $self) },
+	lazy => sub ($self) { Thunderhorse::Response->new(context => $self) },
+	clearer => -hidden,
 );
 
 # NOTE: websocket must be lazy, because it will die if scope is not websocket
@@ -105,11 +107,54 @@ sub consume ($self)
 sub is_consumed ($self)
 {
 	return $self->_consumed
-		|| $self->res->is_sent
+		|| $self->_res_sent
+		|| $self->res->is_ready
 		|| ($self->has_ws && $self->ws->is_closed)
 		|| ($self->has_sse && $self->sse->is_closed);
 }
 
+sub _res_sent ($self)
+{
+	return !!$self->scope->{'pagi.response.sent'};
+}
+
+sub new_res ($self)
+{
+	$self->_clear_res;
+	return $self->res;
+}
+
+sub _send_res ($self)
+{
+	# NOTE: PAGI scope key - avoid "true" for better portability
+	# NOTE: returns a promise
+	$self->scope->{'pagi.response.sent'} = 1;
+	return $self->res->respond($self->sender);
+}
+
+async sub send_res ($self)
+{
+	# NOTE: we check a general pagi key, but raise a thunderhorse exception -
+	# should it just die()?
+	Gears::X::Thunderhorse->raise('response was already sent')
+		if $self->_res_sent;
+
+	await $self->_send_res;
+
+	return;
+}
+
+async sub try_send_res ($self)
+{
+	return
+		if $self->_res_sent;
+
+	await $self->_send_res
+		if $self->res->is_ready;
+
+	return;
+}
+
 __END__
 
 =head1 NAME
@@ -124,7 +169,7 @@ Thunderhorse::Context - Request handling context
 		my $stashed_value = $ctx->stash->get('key');
 		my $session_value = $ctx->session->get('key');
 
-		await $ctx->res->text("Hello World");
+		$ctx->res->text("Hello World");
 	}
 
 =head1 DESCRIPTION

lib/Thunderhorse/Controller.pm

@@ -117,7 +117,7 @@ Thunderhorse::Controller - Base controller class for Thunderhorse
 
 	async sub show ($self, $ctx, $id)
 	{
-		await $ctx->res->text("User ID: $id");
+		$ctx->res->text("User ID: $id");
 	}
 
 =head1 DESCRIPTION

lib/Thunderhorse/Cookbook.pod

@@ -21,7 +21,7 @@ L<Thunderhorse::App/render_error>:
 			$html = $controller->template('error/error', {title => status_message($code)});
 		}
 
-		await $ctx->res->status($code)->html($html);
+		$ctx->res->status($code)->html($html);
 	}
 
 For example for error 404, code above will try to render C<error/404.tt>

lib/Thunderhorse/Response.pm

@@ -13,13 +13,17 @@ sub FOREIGNBUILDARGS ($class, %args)
 	Gears::X::Thunderhorse->raise('no context for response')
 		unless $args{context};
 
-	return $args{context}->pagi->@[0, 2];
+	return ($args{context}->pagi->[0]);
 }
 
 sub update ($self, $scope, $receive, $send)
 {
 	$self->{scope} = $scope;
-	$self->{send} = $send;
+}
+
+sub is_ready ($self)
+{
+	return $self->has_body_source || $self->has_status;
 }
 
 __END__
@@ -32,9 +36,9 @@ Thunderhorse::Response - Response wrapper for Thunderhorse
 
 	async sub show ($self, $ctx, $id)
 	{
-		await $ctx->res->text("Hello World");
-		await $ctx->res->json({data => 'value'});
-		await $ctx->res->redirect('/login');
+		$ctx->res->text("Hello World");
+		$ctx->res->json({data => 'value'});
+		$ctx->res->redirect('/login');
 	}
 
 =head1 DESCRIPTION

t/base.t

@@ -44,7 +44,7 @@ package BasicApp {
 		$router->add(
 			'/preset_headers/?ex_code' => {
 				to => sub ($self, $ctx, $code) {
-					$ctx->res->status(201)->content_type('application/xml');
+					$ctx->res->content_type('application/xml; charset=utf-8');
 					Gears::X::HTTP->raise($code, 'test')
 						if $code;
 
@@ -134,7 +134,7 @@ subtest 'should render text set by res->text' => sub {
 
 subtest 'should render without overriding set headers' => sub {
 	http $app, GET '/preset_headers';
-	http_status_is 201;
+	http_status_is 200;
 	http_header_is 'content-type', 'application/xml; charset=utf-8';
 	http_text_is 'this gets rendered as xml';
 };

t/facade.t

@@ -16,7 +16,8 @@ package FacadeApp::Controller::Test::Facade {
 	async sub send_something_later ($self)
 	{
 		await $self->app->loop->delay_future(after => 0.5);
-		await $self->res->text('Something');
+		$self->res->text('Something');
+		await $self->send_res;
 	}
 }