Adjust TH to the newest PAGI::Tools (take 2)

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

@@ -208,6 +208,7 @@ async sub pagi ($self, $scope, $receive, $send)
 	# the context
 	if (!$ctx->is_consumed) {
 		await $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->empty_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;
@@ -30,9 +31,15 @@ has field 'req' => (
 	default => sub ($self) { Thunderhorse::Request->new(context => $self) },
 );
 
+has field 'connection' => (
+	(STRICT ? (isa => HasMethods ['response_started']) : ()),
+	lazy => sub ($self) { $self->scope->{'pagi.connection'} },
+);
+
 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 +112,41 @@ sub consume ($self)
 sub is_consumed ($self)
 {
 	return $self->_consumed
-		|| $self->res->is_sent
+		|| $self->connection->response_started
+		|| $self->res->is_ready
 		|| ($self->has_ws && $self->ws->is_closed)
 		|| ($self->has_sse && $self->sse->is_closed);
 }
 
+sub empty_res ($self)
+{
+	$self->_clear_res;
+	return $self->res;
+}
+
+async sub send_res ($self)
+{
+	# NOTE: we check a general pagi constraint, but raise a thunderhorse exception -
+	# should it just die()?
+	Gears::X::Thunderhorse->raise('response was already sent')
+		if $self->connection->response_started;
+
+	await $self->res->respond($self->sender);
+
+	return;
+}
+
+async sub try_send_res ($self)
+{
+	return
+		if $self->connection->response_started;
+
+	await $self->res->respond($self->sender)
+		if $self->res->is_ready;
+
+	return;
+}
+
 __END__
 
 =head1 NAME
@@ -124,7 +161,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,30 @@ 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 _requires_body ($self, $status)
+{
+	# HTTP protocol hardcodes - these statuses can have empty bodies
+	return $status < 200
+		|| $status == 204
+		|| ($status >= 300 && $status < 400);
+}
+
+sub is_ready ($self)
+{
+	return true if $self->has_body_source;
+
+	return $self->_requires_body($self->status)
+		if $self->has_status;
+
+	return false;
 }
 
 __END__
@@ -32,9 +49,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/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;
 	}
 }
 

t/hooks-methods.t

@@ -54,20 +54,20 @@ package HooksApp {
 	{
 		$self->set_render_error_called($self->render_error_called + 1);
 		$message //= "app error: $code";
-		await $ctx->res->status($code)->text($message);
+		$ctx->res->status($code)->text($message);
 	}
 
 	async sub render_response ($self, $controller, $ctx, $result)
 	{
 		$self->set_render_response_called($self->render_response_called + 1);
-		await $ctx->res->text($result);
+		$ctx->res->text($result);
 	}
 
 	async sub on_error ($self, $controller, $ctx, $error)
 	{
 		$self->set_on_error_called($self->on_error_called + 1);
 		die $error unless $error isa 'Gears::X::HTTP';
-		await +($controller // $self->controller)->render_error($ctx, $error->code, "app caught: " . $error->code);
+		await + ($controller // $self->controller)->render_error($ctx, $error->code, "app caught: " . $error->code);
 	}
 
 	async sub on_startup ($self, $state)
@@ -140,21 +140,21 @@ package HooksApp::Controller::CustomHooks {
 	async sub render_response ($self, $ctx, $result)
 	{
 		$self->set_render_response_called($self->render_response_called + 1);
-		await $ctx->res->text($result);
+		$ctx->res->text($result);
 	}
 
 	async sub render_error ($self, $ctx, $code, $message = undef)
 	{
 		$self->set_render_error_called($self->render_error_called + 1);
 		$message //= "custom error: $code";
-		await $ctx->res->status($code)->text($message);
+		$ctx->res->status($code)->text($message);
 	}
 
 	async sub on_error ($self, $ctx, $error)
 	{
 		$self->set_on_error_called($self->on_error_called + 1);
 		die $error unless $error isa 'Gears::X::HTTP';
-		await $self->render_error($ctx, $error->code, "custom caught: " . $error->code);
+		$self->render_error($ctx, $error->code, "custom caught: " . $error->code);
 	}
 }