better HEAD support

rmp · Aug 18, 2021 · a47d0eb · a47d0eb
1 parent c716e0e
commit a47d0eb
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 3 deletions.
diff --git 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
@@ -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)];