From a47d0eb25ebb206a203027088eabd8ffbdbd7dd0 Mon Sep 17 00:00:00 2001
From: Roger Pettett <rmp@psyphi.net>
Date: Wed, 18 Aug 2021 12:43:53 +0100
Subject: [PATCH] better HEAD support

---
 lib/ClearPress/controller.pm | 2 +-
 t/controller/30-controller.t | 7 +++++--
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/lib/ClearPress/controller.pm b/lib/ClearPress/controller.pm
index 1cd9327..ce612d8 100755
--- a/lib/ClearPress/controller.pm
+++ b/lib/ClearPress/controller.pm
@@ -171,7 +171,7 @@ sub process_request { ## no critic (Subroutines::ProhibitExcessComplexity)
 
   my ($aspect)      = $pi =~ m{;(\S+)}smx;
 
-  if(($action eq 'read' || $action eq 'head') && !$id && !$aspect) {
+  if(($action eq 'read') && !$id && !$aspect) {
     $aspect = 'list';
   }
 
diff --git a/t/controller/30-controller.t b/t/controller/30-controller.t
index ae870a5..7c42fb7 100644
--- a/t/controller/30-controller.t
+++ b/t/controller/30-controller.t
@@ -8,7 +8,7 @@ use Test::Trap;
 
 eval {
   require DBD::SQLite;
-  plan tests => 113;
+  plan tests => 116;
 } or do {
   plan skip_all => 'DBD::SQLite not installed';
 };
@@ -137,6 +137,9 @@ my $T = [
          ['HEAD', '/thing13/telemetry.json',            '', $json, 'head',   'thing13', 'head_telemetry_json', 0],
          ['HEAD', '/thing13/telemetry/1234',            '', $json, 'head',   'thing13', 'head_telemetry', '1234'],
          ['HEAD', '/thing13/telemetry',                 '', $json, 'head',   'thing13', 'head_telemetry', 0],
+         ['HEAD', '/thing.json',                        '', undef, 'head',   'thing',   'head_json', 0],
+         ['HEAD', '/thing.json',                             '', $json, 'head',   'thing',   'head_json', 0], # there's a bug in the test suite - this shouldn't need .json suffix when $json env is given
+         ['HEAD', '/thing',                             '', undef, 'head',   'thing',   'head', 0],
         ];
 
 {
@@ -177,7 +180,7 @@ sub request_test {
 		%{$t->[3]||{}},
 	       );
   my $ctrl    = $CTRL->new({util => $util});
-  my $headers = HTTP::Headers->new;
+  my $headers = HTTP::Headers->new();
   my $ref     = [];
   eval {
     $ref = [$ctrl->process_request($headers)];