Warn rather than print to STDERR, and enable ten more policies

ProhibitPrintSTDERR: the scripts' messages are warn now, and each one
still ends in a newline, so it says what it said before and nothing
more.  That needed Carp::Always out of the way, because it puts a stack
trace on every warn.  Trog::Renderer loaded it, so every program that
loaded tCMS got it.  tPSGI loads it for the server itself, so the
server keeps its traces.  Trog::TOTP 1.007 loads it too, and 1.008 does
not, so Makefile.PL asks for 1.008.  t/bin-migrate.t already checks
that a usage error has no stack trace, and t/bin-tcms-useradd.t reads
the last line of what the script said.  Both fail until 1.008 is
installed.  The theme warning in Routes::HTML goes to the log with
WARN, where the rest of the application's warnings go.

- InputOutput::RequireBracedFileHandleWithPrint and
  ProhibitRepeatedPrints: runs of prints are one print or a heredoc,
  and DUMMY's print to its file has braces.
- BuiltinFunctions::ProhibitBooleanGrep: a grep tested for truth is
  List::Util::any, and a negated one is List::Util::none.
- BuiltinFunctions::ProhibitReverseSortBlock: a sort on one key that
  put $b first is reverse sort.  The two that sort descending by one
  key and ascending by the next keep $b first, with a no critic,
  because reverse cannot express that order.
- BuiltinFunctions::ProhibitStringySplit: split takes a pattern.
- ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions:
  each of the seven is an if with the condition inverted.
- ControlStructures::ProhibitYadaOperator: the six methods that
  Trog::DataModule leaves to its subclasses die and name the method.
- ErrorHandling::RequireCheckingReturnValueOfEval: each eval returns 1
  and says what happens when it does not.  The TagIndex test uses
  Test::Fatal's exception.
- InputOutput::RequireBriefOpen: Trog::Config reads its file with
  File::Slurper::read_lines.  The flatfile write lock, the provisioner's
  log and pipe, and FileHandler's streamed file are held on purpose, and
  say so.
- ValuesAndExpressions::ProhibitCommaSeparatedStatements: the sitemap
  route set four fields of $query in one statement joined by commas,
  and now uses four statements.  The rest were blocks that PPI misread,
  written so that it does not.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

.perlcriticrc

@@ -129,8 +129,8 @@ allow = re Exporter
 # share one parse.  A library whose subclasses live in other distributions
 # names in allow_subs each hook that only one of its own subclasses uses.
 #[ProhibitMisplacedMethods]
-#[ProhibitPrintSTDERR]
-#[InputOutput::ProhibitRepeatedPrints]
+[ProhibitPrintSTDERR]
+[InputOutput::ProhibitRepeatedPrints]
 # Perl::Critic's own policies.  only = 1 loads nothing that is not named, so
 # each of these has to be, and the ones that are absent are absent on purpose.
 #
@@ -161,13 +161,13 @@ allow = re Exporter
 # Documentation::RequirePodSections is out as well: the sections it asks for are
 # the ones Pod::Weaver writes at build, and weaver.ini names them AUTHORS and
 # COPYRIGHT AND LICENSE where the policy wants AUTHOR and LICENSE AND COPYRIGHT.
-#[BuiltinFunctions::ProhibitBooleanGrep]
+[BuiltinFunctions::ProhibitBooleanGrep]
 [BuiltinFunctions::ProhibitLvalueSubstr]
-#[BuiltinFunctions::ProhibitReverseSortBlock]
+[BuiltinFunctions::ProhibitReverseSortBlock]
 [BuiltinFunctions::ProhibitShiftRef]
 [BuiltinFunctions::ProhibitSleepViaSelect]
 [BuiltinFunctions::ProhibitStringyEval]
-#[BuiltinFunctions::ProhibitStringySplit]
+[BuiltinFunctions::ProhibitStringySplit]
 [BuiltinFunctions::ProhibitUniversalCan]
 [BuiltinFunctions::ProhibitUniversalIsa]
 [BuiltinFunctions::ProhibitVoidGrep]
@@ -188,23 +188,23 @@ allow = re Exporter
 # repeated that, and ran perltidy over the whole file on every check.
 [CodeLayout::RequireTrailingCommas]
 [ControlStructures::ProhibitLabelsWithSpecialBlockNames]
-#[ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
+[ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
 [ControlStructures::ProhibitUnreachableCode]
 [ControlStructures::ProhibitUntilBlocks]
-#[ControlStructures::ProhibitYadaOperator]
+[ControlStructures::ProhibitYadaOperator]
 #[Documentation::PodSpelling]
 #spell_command = aspell --lang=en_US list
 #stop_words_file = .pod_stopwords
 [Documentation::RequirePackageMatchesPodName]
-#[ErrorHandling::RequireCheckingReturnValueOfEval]
+[ErrorHandling::RequireCheckingReturnValueOfEval]
 [InputOutput::ProhibitExplicitStdin]
 [InputOutput::ProhibitInteractiveTest]
 [InputOutput::ProhibitJoinedReadline]
 [InputOutput::ProhibitOneArgSelect]
 [InputOutput::ProhibitReadlineInForLoop]
 [InputOutput::ProhibitTwoArgOpen]
-#[InputOutput::RequireBracedFileHandleWithPrint]
-#[InputOutput::RequireBriefOpen]
+[InputOutput::RequireBracedFileHandleWithPrint]
+[InputOutput::RequireBriefOpen]
 [InputOutput::RequireCheckedOpen]
 #[InputOutput::RequireCheckedSyscalls]
 #exclude_functions = print
@@ -241,7 +241,7 @@ allow = re Exporter
 terminal_funcs = POSIX::_exit
 [TestingAndDebugging::ProhibitProlongedStrictureOverride]
 [TestingAndDebugging::RequireTestLabels]
-#[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
 [ValuesAndExpressions::ProhibitComplexVersion]
 [ValuesAndExpressions::ProhibitEscapedCharacters]
 [ValuesAndExpressions::ProhibitLongChainsOfMethodCalls]

Makefile.PL

@@ -86,7 +86,7 @@ WriteMakefile(
         },
     },
     PREREQ_PM => {
-        'Trog::TOTP'                          => '1.007',
+        'Trog::TOTP'                          => '1.008',
         'Trog::SQLite'                        => '0.004',
         'CGI::Cookie'                         => '0',
         'Capture::Tiny'                       => '0',

bin/favicon_mongler.pl

@@ -86,7 +86,7 @@ my $scratch = File::Temp->newdir();
 # Render each size from the vector source rather than downscaling one big
 # raster -- at 16 and 32 pixels the difference is the whole ballgame.
 my %rendered;
-foreach my $size ( sort { $b <=> $a } uniq( @png_sizes, @ico_sizes ) ) {
+foreach my $size ( reverse sort { $a <=> $b } uniq( @png_sizes, @ico_sizes ) ) {
     my $keep = grep { $_ == $size } @png_sizes;
     my $out  = $keep ? "$dir/favicon-$size.png" : "$scratch/favicon-$size.png";
 

bin/migrate.pl

@@ -63,10 +63,9 @@ STDERR->autoflush(1);
 
 my $usage = "Usage: bin/migrate.pl [--dry-run] [--batch N] [--quiet]\n";
 
-# Printed and exited rather than died: Carp::Always is in the dependency chain,
-# and a usage message wearing a stack trace reads like a crash.
+# Warned and exited rather than died, so that a usage error exits 2.
 sub usage_error (@complaint) {
-    print STDERR @complaint, $usage;
+    warn @complaint, $usage;
     exit 2;
 }
 
@@ -95,7 +94,7 @@ my $to     = Trog::Data::SQLite->new($config);
 my $started = [ Time::HiRes::gettimeofday() ];
 my @posts   = $from->get( raw => 1, limit => 0 );
 if ( !@posts ) {
-    print STDERR "No posts found in data/files -- is this a tCMS root, and is it on the FlatFile model?\n";
+    warn "No posts found in data/files -- is this a tCMS root, and is it on the FlatFile model?\n";
     exit 2;
 }
 
@@ -132,7 +131,7 @@ sub flush_batch () {
         # the batch down with it.  Go back over them one at a time: a migration
         # wants everything that can land to land, and a list naming exactly what
         # could not -- not five hundred posts rejected on account of one.
-        say STDERR "A batch of " . scalar(@batch) . " failed ($error); retrying it one post at a time.";
+        warn "A batch of " . scalar(@batch) . " failed ($error); retrying it one post at a time.\n";
 
         foreach my $post (@batch) {
             local $@;
@@ -144,7 +143,7 @@ sub flush_batch () {
                 my $why = $@;
                 $why =~ s/\n.*//s;
                 $failed++;
-                say STDERR "  could not write $post->{id} version " . ( $post->{version} // 0 ) . ": $why";
+                warn "  could not write $post->{id} version " . ( $post->{version} // 0 ) . ": $why\n";
             };
         }
     };
@@ -155,7 +154,7 @@ sub flush_batch () {
 
 foreach my $post (@posts) {
     if ( !$post->{id} ) {
-        say STDERR "Skipping a post with no id, which is not something this can carry over";
+        warn "Skipping a post with no id, which is not something this can carry over\n";
         $failed++;
         next;
     }
@@ -188,7 +187,7 @@ say_unless_quiet( sprintf( "Carried over %d post version(s), skipped %d already
 say_unless_quiet( sprintf( "data/files holds %d post version(s); data/posts.sqlite now holds %d.", $expected, $have ) );
 
 if ( $failed || $have < $expected ) {
-    say STDERR sprintf( "%d post version(s) did not make it across.  Fix what the errors above name and re-run; what landed will be skipped.", $failed || ( $expected - $have ) );
+    warn sprintf( "%d post version(s) did not make it across.  Fix what the errors above name and re-run; what landed will be skipped.\n", $failed || ( $expected - $have ) );
     exit 1;
 }
 

bin/tcms-useradd

@@ -129,7 +129,7 @@ sub main {
     pod2usage( -exitval => 0, -verbose => 1 ) if $options{help};
 
     unless ( $options{user} ) {
-        print STDERR "--user is required.\n";
+        warn "--user is required.\n";
         return 2;
     }
 
@@ -139,7 +139,7 @@ sub main {
         $options{password} = read_password("New password for '$options{user}': ");
 
         unless ( $options{password} ) {
-            print STDERR "No password provided.\n";
+            warn "No password provided.\n";
             return 2;
         }
 
@@ -148,7 +148,7 @@ sub main {
         # and there is nothing to confirm against.
         my $again = read_password("Confirm: ");
         if ( defined $again && $options{password} ne $again ) {
-            print STDERR "Passwords did not match.\n";
+            warn "Passwords did not match.\n";
             return 2;
         }
     }
@@ -173,8 +173,7 @@ sub main {
 
     if ($is_new) {
         unless ( $options{password} && $options{display_name} && $options{contact_email} ) {
-            print STDERR "User '$options{user}' does not exist yet.\n";
-            print STDERR "Creating one needs --password, --display_name and --contact_email.\n";
+            warn "User '$options{user}' does not exist yet.\nCreating one needs --password, --display_name and --contact_email.\n";
             return 2;
         }
     }
@@ -197,14 +196,13 @@ sub main {
 
     local $@;
     eval { Trog::Auth::useradd( $options{user}, $merged{display_name}, $options{password}, $options{acl}, $merged{contact_email} ); 1 } or do {
-        print STDERR "Could not add user '$options{user}': $@";
+        warn "Could not add user '$options{user}': $@";
         return 1;
     };
 
     eval { $data->add( \%merged ); 1 } or do {
         my @errors = ref $@ eq 'ARRAY' ? @{$@} : ($@);
-        print STDERR "Saved the credentials for '$options{user}', but their profile post was rejected:\n";
-        print STDERR join( "\n", @errors ), "\n";
+        warn "Saved the credentials for '$options{user}', but their profile post was rejected:\n" . join( "\n", @errors ) . "\n";
         return 1;
     };
 

bin/tcms-vault-key

@@ -71,18 +71,21 @@ GetOptions(
 ) or exit 2;
 
 if ( $help || !$file ) {
-    print "Usage: bin/tcms-vault-key --file\n\n";
-    print "Writes $Trog::Vault::key_file, for a tCMS nothing is handing a vault key to:\n";
-    print "running tPSGI by hand while developing, or a machine with no systemd.\n";
-    print "On a production host tPSGI's bin/build_service does this properly, and better;\n";
-    print "see perldoc bin/tcms-vault-key.\n";
+    print <<"USAGE";
+Usage: bin/tcms-vault-key --file
+
+Writes $Trog::Vault::key_file, for a tCMS nothing is handing a vault key to:
+running tPSGI by hand while developing, or a machine with no systemd.
+On a production host tPSGI's bin/build_service does this properly, and better;
+see perldoc bin/tcms-vault-key.
+USAGE
     exit( $help ? 0 : 2 );
 }
 
-# Printed and exited rather than died: Carp::Always is in the dependency chain,
-# and refusing to clobber a key is not a crash.
+# Warned and exited rather than died, so that it exits 2: refusing to clobber a
+# key is not a crash.
 if ( -e $Trog::Vault::key_file ) {    # Refusing to overwrite the one thing that cannot be regenerated
-    print STDERR "There is already a key at $Trog::Vault::key_file.  Move it out of the way if you really mean to replace it, and read what that costs first: perldoc bin/tcms-vault-key\n";
+    warn "There is already a key at $Trog::Vault::key_file.  Move it out of the way if you really mean to replace it, and read what that costs first: perldoc bin/tcms-vault-key\n";
     exit 2;
 }
 
@@ -91,6 +94,8 @@ print {$fh} Crypt::Misc::encode_b64( Crypt::PRNG::random_bytes(32) ) . "\n";
 close($fh);
 chmod( oct('600'), $Trog::Vault::key_file ) or die "Could not chmod $Trog::Vault::key_file: $!\n";
 
-print "Wrote $Trog::Vault::key_file.  Restart tCMS to pick it up.\n";
-print "Fine for development.  On a production host, let tPSGI's bin/build_service hand one\n";
-print "over instead, so the key is not sitting next to the database it protects.\n";
+print <<"SAID";
+Wrote $Trog::Vault::key_file.  Restart tCMS to pick it up.
+Fine for development.  On a production host, let tPSGI's bin/build_service hand one
+over instead, so the key is not sitting next to the database it protects.
+SAID

bin/tcmslogin

@@ -96,7 +96,7 @@ sub main {
     pod2usage( -exitval => 0, -verbose => 1 ) if $options{help};
 
     unless ( $options{user} ) {
-        print STDERR "--user is required.\n";
+        warn "--user is required.\n";
         return 2;
     }
 
@@ -106,7 +106,7 @@ sub main {
     $options{password} = read_password("Password for '$options{user}': ")
       unless $options{password};
     unless ( $options{password} ) {
-        print STDERR "No password provided.\n";
+        warn "No password provided.\n";
         return 2;
     }
 
@@ -114,9 +114,11 @@ sub main {
     # the same '' for an unknown user, a bad password and a bad TOTP code.
     my $session = Trog::Auth::mksession( $options{user}, $options{password}, $options{token}, 'tcmslogin' );
     unless ($session) {
-        print STDERR "Login failed for '$options{user}'.\n";
-        print STDERR "Check the password, and pass --token if this user has 2FA enabled.\n";
-        print STDERR "Use bin/tcms-useradd --user $options{user} --password ... to reset it.\n";
+        warn <<"SAID";
+Login failed for '$options{user}'.
+Check the password, and pass --token if this user has 2FA enabled.
+Use bin/tcms-useradd --user $options{user} --password ... to reset it.
+SAID
         return 1;
     }
 

bin/totp

@@ -39,6 +39,4 @@ die "Must provide a user"                   unless $user;
 die "Must Set domain in configuration file" unless $domain;
 
 my ( $uri, undef, undef, undef, $totp ) = Trog::Auth::totp( $user, $domain );
-print "TOTP URI: $uri\n";
-print "Secret: " . $totp->base32secret() . "\n";
-print "Current Auth code: " . $totp->expected_totp_code(time) . "\n";
+print "TOTP URI: $uri\n" . "Secret: " . $totp->base32secret() . "\n" . "Current Auth code: " . $totp->expected_totp_code(time) . "\n";

lib/TCMS.pm

@@ -220,7 +220,7 @@ routing table knows nothing about.
 
 sub needs_enrolment ( $user, $dispatcher ) {
     return 0 unless $user;
-    return 0 unless $dispatcher && $dispatcher->{auth} && !$dispatcher->{totp_exempt};
+    return 0 if !$dispatcher || !$dispatcher->{auth} || $dispatcher->{totp_exempt};
     return Trog::Auth::has_totp($user) ? 0 : 1;
 }
 

lib/Trog/Auth.pm

@@ -601,8 +601,8 @@ sub log_event ( $event_type, $username, $ip_addr = '', $session_id = undef ) {
             "INSERT INTO audit_log (event_time, username, session_id, ip_addr, event_type) VALUES (?,?,?,?,?)",
             undef, time(), $username, $session_id, $ip_addr, $event_type
         );
-    };
-    WARN("audit_log insert failed: $@") if $@;
+        1;
+    } or WARN("audit_log insert failed: $@");
     return;
 }
 

lib/Trog/Component/PostFooter.pm

@@ -4,6 +4,8 @@ use 5.040;
 use re '/aasx';
 use warnings FATAL => 'all';
 
+use List::Util();
+
 use Trog::Component ();
 use Trog::Themes;
 
@@ -33,7 +35,7 @@ sub render (%args) {
     my $name = delete $args{name};
     return '' unless $name;
 
-    die "No such footer '$name'\n" unless grep { $_ eq $name } @{ available() };
+    die "No such footer '$name'\n" unless List::Util::any { $_ eq $name } @{ available() };
 
     $args{theme_dir} //= Trog::Themes::td();
     return Trog::Component::render_template( "footers/$name", \%args );

lib/Trog/Component/PostHeader.pm

@@ -4,6 +4,8 @@ use 5.040;
 use re '/aasx';
 use warnings FATAL => 'all';
 
+use List::Util();
+
 use Trog::Component ();
 use Trog::Themes;
 
@@ -33,7 +35,7 @@ sub render (%args) {
     my $name = delete $args{name};
     return '' unless $name;
 
-    die "No such header '$name'\n" unless grep { $_ eq $name } @{ available() };
+    die "No such header '$name'\n" unless List::Util::any { $_ eq $name } @{ available() };
 
     $args{theme_dir} //= Trog::Themes::td();
     return Trog::Component::render_template( "headers/$name", \%args );

lib/Trog/Config.pm

@@ -7,6 +7,7 @@ use warnings FATAL => 'all';
 use FindBin::libs;
 
 use Config::Simple;
+use File::Slurper();
 
 =head1 Trog::Config
 
@@ -77,11 +78,8 @@ name for them, so neither do we.
 =cut
 
 sub schema ( $file = $default ) {
-    open( my $fh, '<', $file ) or die "Could not read $file: $!";
-
     my ( @sections, $section, @comments );
-    while ( my $line = readline($fh) ) {
-        chomp $line;
+    foreach my $line ( File::Slurper::read_lines($file) ) {
         $line =~ s/^\s+//;
         $line =~ s/\s+$//;
         next unless $line;
@@ -113,7 +111,6 @@ sub schema ( $file = $default ) {
         );
         @comments = ();
     }
-    close($fh);
 
     return \@sections;
 }

lib/Trog/Data/DUMMY.pm

@@ -42,7 +42,7 @@ sub read {
     $posts = JSON::MaybeXS::decode_json($slurped);
 
     # Sort everything by date DESC
-    @$posts = sort { $b->{created} <=> $a->{created} } @$posts;
+    @$posts = reverse sort { $a->{created} <=> $b->{created} } @$posts;
 
     return $posts;
 }
@@ -62,7 +62,7 @@ sub write ( $self, $data, $overwrite = 0 ) {
         push( @$orig, @$data );
     }
     open( my $fh, '>', $datastore ) or confess;
-    print $fh JSON::MaybeXS::encode_json($orig);
+    print {$fh} JSON::MaybeXS::encode_json($orig);
     close $fh;
     return 1;
 }

lib/Trog/Data/FlatFile.pm

@@ -39,8 +39,8 @@ our %posts_by_tag;
 
 my sub _index {
     confess "Can't find datastore in $datastore !" unless -d $datastore;
-    my @index  = map  { "$_" } grep { -f } Path::Tiny::path($datastore)->children;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
-    my @sorted = sort { $b cmp $a } @index;
+    my @index  = map { "$_" } grep { -f } Path::Tiny::path($datastore)->children;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
+    my @sorted = reverse sort @index;
     return @sorted;
 }
 
@@ -160,7 +160,7 @@ sub write ( $self, $data ) {
         # N+1, so one save vanishes: at three workers by 25 saves, about 30 of
         # 75 revisions survived.  With it, all 75.  It has to be taken on a
         # path that never gets renamed, hence a lockfile rather than the post.
-        open( my $lock, '>>', "$spool/.write.lock" ) or confess "Could not open $spool/.write.lock: $!";
+        open( my $lock, '>>', "$spool/.write.lock" ) or confess "Could not open $spool/.write.lock: $!";    ## no critic (InputOutput::RequireBriefOpen) -- held until the write lands
         flock( $lock, LOCK_EX )                      or confess "Could not lock $spool/.write.lock: $!";
 
         my $slurped = eval { File::Slurper::read_binary($file) };

lib/Trog/DataModule.pm

@@ -85,13 +85,13 @@ Every tag known to the datastore, for building tag pickers.
 
 =cut
 
-#It is required that subclasses implement this
-sub lang  { ... }
-sub help  { ... }
-sub read  { ... }
-sub write { ... }
-sub count { ... }
-sub tags  { ... }
+# Each subclass implements these.
+sub lang  { die "Trog::DataModule subclasses must implement lang()\n" }
+sub help  { die "Trog::DataModule subclasses must implement help()\n" }
+sub read  { die "Trog::DataModule subclasses must implement read()\n" }
+sub write { die "Trog::DataModule subclasses must implement write()\n" }
+sub count { die "Trog::DataModule subclasses must implement count()\n" }
+sub tags  { die "Trog::DataModule subclasses must implement tags()\n" }
 
 =head1 METHODS
 
@@ -192,7 +192,7 @@ my sub filter_param ( $query, $param, @filtered ) {
 # Visibility and acls are both stored as tags, so a caller sees a post when it
 # holds one of them.  admin sees everything.
 my sub filter_acls ( $query, @filtered ) {
-    return @filtered if grep { $_ eq 'admin' } @{ $query->{acls} };
+    return @filtered if List::Util::any { $_ eq 'admin' } @{ $query->{acls} };
     return grep {
         my $tags = $_->{tags};
         grep {
@@ -250,10 +250,11 @@ sub filter ( $, $query, @filtered ) {
     # Filter posts *matching* the passed exclude_tag(s), if any
     @filtered = grep {
         my $tags = $_->{tags};
-        !grep {
+        List::Util::none {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{exclude_tags} }
-        } @$tags
+        }
+        @$tags
     } @filtered if @{ $query->{exclude_tags} };
 
     @filtered = filter_acls( $query, @filtered );
@@ -315,7 +316,7 @@ sub dedup_versions ( $version = -1, @posts ) {
     my @uniqids = List::Util::uniq( map { $_->{id} } @posts );
     my %posts_deduped;
     for my $id (@uniqids) {
-        my @ofid        = sort { $b->{version} <=> $a->{version} } grep { $_->{id} eq $id } @posts;
+        my @ofid        = reverse sort { $a->{version} <=> $b->{version} } grep { $_->{id} eq $id } @posts;
         my $version_max = List::Util::max( map { $_->{version} } @ofid );
         $posts_deduped{$id} = $ofid[0];
         $posts_deduped{$id}{version_max} = $version_max;
@@ -980,7 +981,7 @@ sub process ($post) {
     $post->{acls} //= [];
     @{ $post->{tags} } = grep {
         my $subj = $_;
-        !grep { $_ eq $subj } qw{public private unlisted}
+        List::Util::none { $_ eq $subj } qw{public private unlisted}
     } @{ $post->{tags} };
     push( @{ $post->{tags} }, grep { defined } @{ $post->{acls} } ) if $is_private_post;
     delete $post->{acls};
@@ -1007,7 +1008,7 @@ sub process ($post) {
     $post->{is_video}   = 1 if $post->{content_type} =~ m/^video\//;
     $post->{is_audio}   = 1 if $post->{content_type} =~ m/^audio\//;
     $post->{is_image}   = 1 if $post->{content_type} =~ m/^image\//;
-    $post->{is_profile} = 1 if grep { $_ eq 'about' } @{ $post->{tags} };
+    $post->{is_profile} = 1 if List::Util::any { $_ eq 'about' } @{ $post->{tags} };
 
     return $post;
 }

lib/Trog/DataSource.pm

@@ -138,7 +138,7 @@ or a nested structure is passed over rather than matched against its address.
 =cut
 
 sub searchable_match ( $like, @values ) {
-    return 0 unless ( $like // q{} ) ne q{};
+    return 0 if ( $like // q{} ) eq q{};
 
     foreach my $value (@values) {
         next     if !defined $value || ref $value;
@@ -164,7 +164,7 @@ the same created, so what this really does for that page is sort it by name.
 =cut
 
 sub order ( $, @posts ) {
-    my @sorted = sort { ( $b->{created} // 0 ) <=> ( $a->{created} // 0 ) || ( $a->{title} // '' ) cmp ( $b->{title} // '' ) || ( $a->{id} // '' ) cmp ( $b->{id} // '' ) } @posts;
+    my @sorted = sort { ( $b->{created} // 0 ) <=> ( $a->{created} // 0 ) || ( $a->{title} // '' ) cmp ( $b->{title} // '' ) || ( $a->{id} // '' ) cmp ( $b->{id} // '' ) } @posts;    ## no critic (BuiltinFunctions::ProhibitReverseSortBlock) -- descending by the first key and ascending by the rest, which reverse cannot say
     return @sorted;
 }
 
@@ -228,7 +228,7 @@ sub for_type ( $form = '' ) {
 
     my $meta   = Trog::DataModule::type_meta_for($form);
     my $source = $meta->{'x-tcms-datasource'};
-    return undef unless $source && !ref $source;
+    return undef if !$source || ref $source;
 
     if ( $source !~ m/^Trog::DataSource::\w+$/ ) {
         WARN("Post type '$form' names a datasource '$source' which isn't one");

lib/Trog/DataSource/DirIndex.pm

@@ -196,7 +196,7 @@ my sub post_for ( $name, $dir, $series ) {
     # Escaped per segment: a filename may legally hold a space, a question mark
     # or a hash, and none of those survive being dropped into an href as they
     # are.  Per segment rather than wholesale, or the separators go too.
-    my $href = '/' . join( '/', map { URI::Escape::uri_escape($_) } split( '/', $path ) );
+    my $href = '/' . join( '/', map { URI::Escape::uri_escape($_) } split( m{/}, $path ) );
 
     my $post = {
 
@@ -325,7 +325,7 @@ whatever happened to be touched least recently.
 =cut
 
 sub order ( $, @posts ) {
-    my @sorted = sort { ( $b->{is_dir} // 0 ) <=> ( $a->{is_dir} // 0 ) || lc( $a->{name} // '' ) cmp lc( $b->{name} // '' ) || ( $a->{name} // '' ) cmp ( $b->{name} // '' ) } @posts;
+    my @sorted = sort { ( $b->{is_dir} // 0 ) <=> ( $a->{is_dir} // 0 ) || lc( $a->{name} // '' ) cmp lc( $b->{name} // '' ) || ( $a->{name} // '' ) cmp ( $b->{name} // '' ) } @posts;    ## no critic (BuiltinFunctions::ProhibitReverseSortBlock) -- descending by the first key and ascending by the rest, which reverse cannot say
     return @sorted;
 }
 

lib/Trog/DataSource/ProvisionedVirt.pm

@@ -176,7 +176,7 @@ my sub config {
     my %config = ( recipes => ( $ENV{TROG_PROVISIONER_CONFIG} // $provisioner_config ) . "/$recipe_dir" );
 
     my $dir = $conf->param('provisioner.trog_provisioner');
-    return \%config unless $dir && !ref $dir;
+    return \%config if !$dir || ref $dir;
 
     # Resolved, and checked to be there.  A path in a config file which does not
     # exist is a typo, and finding that out here beats finding it out halfway
@@ -262,7 +262,7 @@ sub status ($domain) {
     return undef unless defined $raw;
 
     my %status;
-    foreach my $line ( split( "\n", $raw ) ) {
+    foreach my $line ( split( /\n/, $raw ) ) {
         my ( $key, $value ) = $line =~ m/^(\w+)=(\N*)$/;
         $status{$key} = $value if defined $key;
     }
@@ -580,7 +580,7 @@ sub spawn ( $domain, $credentials, $dir, $command, $user ) {
 
     # From here on we are nobody's child and nothing reads our exit status, so
     # the log is the only way to say anything.
-    open( my $fh, '>>', $log ) or POSIX::_exit(1);
+    open( my $fh, '>>', $log ) or POSIX::_exit(1);    ## no critic (InputOutput::RequireBriefOpen) -- the child's STDOUT and STDERR from here on
     $fh->autoflush(1);
 
     my $started = time();
@@ -609,7 +609,7 @@ sub spawn ( $domain, $credentials, $dir, $command, $user ) {
     # piped open with a list never involves a shell, so the guest name is an
     # argument and cannot be read as a command.  The single argument form of
     # this would be the bug.
-    my $ok = open( my $stdin, '|-', @$command );    ## no critic (ProhibitPipeOpen) -- list form, so no shell
+    my $ok = open( my $stdin, '|-', @$command );    ## no critic (ProhibitPipeOpen, InputOutput::RequireBriefOpen) -- list form, so no shell; closed once the credentials are sent
     if ( !$ok ) {
         print {$fh} "could not run $command->[0]: $!\n";
         POSIX::_exit(1);
@@ -617,8 +617,7 @@ sub spawn ( $domain, $credentials, $dir, $command, $user ) {
 
     # What the provisioner would otherwise have nobody to ask for.  Closed
     # afterwards, so the read on the far side ends rather than waiting on us.
-    print {$stdin} "$_: $credentials->{$_}\n" foreach sort keys %$credentials;
-    print {$stdin} "\n";
+    print {$stdin} join( '', map { "$_: $credentials->{$_}\n" } sort keys %$credentials ) . "\n";
     close($stdin);
 
     if ($?) {

lib/Trog/FileHandler.pm

@@ -30,7 +30,7 @@ my sub range ( $fullpath, $fh, $ranges, $sz, %headers ) {
         INFO("GET 416 31 $fullpath");
         return [ 416, [%headers], ["Requested range not satisfiable"] ] if $range->[0] > $sz || $range->[0] < 0 || $range->[1] < 0 || $range->[0] > $range->[1];
     }
-    $headers{'Content-Length'} = List::Util::sum( map { my $arr = $_; $arr->[1] + 1, -$arr->[0] } @$ranges );
+    $headers{'Content-Length'} = List::Util::sum( map { $_->[1] + 1 - $_->[0] } @$ranges );
 
     #XXX Add the entity header lengths to the value - should hash-ify this to DRY
     if ($is_multipart) {
@@ -97,7 +97,7 @@ sub serve ( $fullpath, $path, $start, $streaming, $ranges, $last_fetch = 0, $def
     push( @headers, "Last-Modified" => $now_string );
     push( @headers, 'Vary'          => 'Accept-Encoding' );
 
-    if ( open( my $fh, '<', $path ) ) {
+    if ( open( my $fh, '<', $path ) ) {    ## no critic (InputOutput::RequireBriefOpen) -- streamed to the client, which closes it
         return range( $fullpath, $fh, $ranges, $sz, @headers ) if @$ranges && $streaming;
 
         # Transfer-encoding: chunked

lib/Trog/Log/Syslog.pm

@@ -81,7 +81,7 @@ sub log_message ( $self, %p ) {
         $self->{syslog}->set_severity($severity);
         $self->{syslog}->send( $message, time );
         1;
-    };
+    } or return;
     return;
 }
 

lib/Trog/Renderer.pm

@@ -4,8 +4,6 @@ use 5.040;
 use re '/aasx';
 use warnings FATAL => 'all';
 
-use Carp::Always;
-
 use Trog::Vars;
 use Trog::Log qw{:all};
 

lib/Trog/Routes/HTML.pm

@@ -499,7 +499,7 @@ my sub build_social_meta ( $query, $title ) {
     $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags;
     $meta_tags .= $extra_tags                                if $extra_tags;
 
-    print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $theme_dir && !$meta_tags;
+    WARN("Theme misconfigured, social media tags will not be included: $@") if $theme_dir && !$meta_tags;
     return ( $default_tags, $meta_desc, $meta_tags );
 }
 
@@ -836,7 +836,7 @@ Renders the configuration page, or redirects you back to the login page.
 
 sub config ( $query = {} ) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
 
@@ -1153,7 +1153,7 @@ editable, not whatever turned up in the request.
 
 sub config_save ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $conf = Trog::Config::get();
     config_apply( $conf, $query );
@@ -1208,7 +1208,7 @@ Clone a theme by copying a directory.
 
 sub themeclone ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my ( $theme, $newtheme ) = ( $query->{theme}, $query->{newtheme} );
 
@@ -1232,7 +1232,7 @@ Saves posts submitted via the /post pages
 
 sub post_save ($qq) {
     return $qq->{tpsgi}->see_also('/login') unless $qq->{user};
-    return $qq->{tpsgi}->forbidden($qq)     unless grep { $_ eq 'admin' } @{ $qq->{user_acls} };
+    return $qq->{tpsgi}->forbidden($qq)     unless List::Util::any { $_ eq 'admin' } @{ $qq->{user_acls} };
 
     my $query = clone($qq);
 
@@ -1295,7 +1295,7 @@ Saves / updates new users.
 
 sub profile ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     # Find the user's post and edit it
     state $data;
@@ -1358,7 +1358,7 @@ deletes posts.
 
 sub post_delete ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     state $data;
     $data //= Trog::Data->new( Trog::Config::get() );
@@ -1373,7 +1373,7 @@ sub post_delete ($query) {
 my sub enrich_callback ( $post, $query ) {
     my $meta = Trog::DataModule::type_meta_for( $post->{form} );
     my $sub  = $meta->{'x-tcms-post-type'}{enrich};
-    return unless $sub && !ref $sub;
+    return if !$sub || ref $sub;
 
     my ($modname) = $sub =~ m/^([\w:]+)::\w+$/;
     if ( !$modname ) {
@@ -1462,7 +1462,7 @@ sub series ($query) {
     $query->{route} =~ s|^/secure||;
 
     #we are either viewed one of two ways, /post/$id or /$aclname
-    my ( undef, $aclname, $id ) = split( '/', $query->{route} );
+    my ( undef, $aclname, $id ) = split( m{/}, $query->{route} );
     $query->{aclname} = $aclname if !$id;
     $query->{id}      = $id      if $id;
 
@@ -1590,7 +1590,7 @@ sub users ($query) {
     $query->{route} =~ s|^/secure||;
 
     # Capture the username
-    my ( undef, undef, $display_name ) = split( '/', $query->{route} );
+    my ( undef, undef, $display_name ) = split( m{/}, $query->{route} );
     $display_name = URI::Escape::uri_unescape($display_name);
 
     my $username = Trog::Auth::display2username($display_name);
@@ -1703,7 +1703,7 @@ sub posts ( $query, $direct = 0 ) {
     # rip away /secure if present
     $query->{route} =~ s|^/secure||;
 
-    my ( undef, undef, $id ) = split( '/', $query->{route} );
+    my ( undef, undef, $id ) = split( m{/}, $query->{route} );
 
     my $tags = Trog::Utils::coerce_array( $query->{tag} );
     $query->{id} = $id if $id && !$query->{in_series};
@@ -1799,7 +1799,7 @@ sub posts ( $query, $direct = 0 ) {
     foreach my $post (@posts) {
         @{ $post->{tags} } = grep {
             my $tag = $_;
-            !grep { $tag eq $_ } @visibuddies
+            List::Util::none { $tag eq $_ } @visibuddies
         } @{ $post->{tags} };
     }
 
@@ -2086,7 +2086,7 @@ this.
 sub viewer_acls ( $query, $direct = 0 ) {
     my @acls = ( @{ $query->{user_acls} // [] }, 'public' );
     push( @acls, 'unlisted' ) if $direct;
-    push( @acls, 'private' )  if grep { $_ eq 'admin' } @acls;
+    push( @acls, 'private' )  if List::Util::any { $_ eq 'admin' } @acls;
     return List::Util::uniq(@acls);
 }
 
@@ -2272,12 +2272,12 @@ sub sitemap ($query) {
     @to_map = sort @to_map unless $is_index;
     my $styles = ['sitemap.css'];
 
-    $query->{title}    = "$query->{domain} : Sitemap";
-    $query->{template} = 'sitemap.tx',
-      $query->{to_map}     = \@to_map,
-      $query->{is_index}   = $is_index,
-      $query->{route_type} = $route_type,
-      $query->{etag}       = $etag;
+    $query->{title}      = "$query->{domain} : Sitemap";
+    $query->{template}   = 'sitemap.tx';
+    $query->{to_map}     = \@to_map;
+    $query->{is_index}   = $is_index;
+    $query->{route_type} = $route_type;
+    $query->{etag}       = $etag;
 
     return Trog::Routes::HTML::index( $query, undef, $styles );
 }
@@ -2292,7 +2292,7 @@ Basically a thin wrapper around Pod::Html.
 
 sub manual ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     require Pod::Html;
     require Capture::Tiny;
@@ -2358,7 +2358,7 @@ compute here.
 
 sub metrics ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
 
@@ -2392,7 +2392,7 @@ session id on a page.
 
 sub sessions ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $limit  = int( $query->{limit} // 100 );
     my $events = Trog::Auth::audit_log(
@@ -2450,7 +2450,7 @@ our @wizard_mandatory = qw{inc_title_input inc_visibility inc_acls};
 
 our @wizard_optional_includes = grep {
     my $include = $_;
-    !grep { $include eq $_ } @wizard_mandatory
+    List::Util::none { $include eq $_ } @wizard_mandatory
 } @wizard_include_order;
 
 # The checkboxes which are not editor includes: the wrapper div, and the two
@@ -2502,7 +2502,7 @@ captures in parallel instead of us taking them one after another.
 
 sub guest_screenshot ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $hypervisor = guest_hypervisor( $query, $query->{hypervisor} );
     return $query->{tpsgi}->notfound($query) unless $hypervisor;
@@ -2532,7 +2532,7 @@ Trog::DataSource::Virt::act.
 
 sub guest_act ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $to = $query->{to} || '/';
 
@@ -2570,7 +2570,7 @@ for whichever of those they kept last time.
 
 sub guest_reprovision ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $to = $query->{to} || '/';
 
@@ -2613,7 +2613,7 @@ reasonable place for a hostname, an IP plan or a package list to turn up.
 
 sub guest_reprovision_log ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     require Trog::DataSource::ProvisionedVirt;
 
@@ -2650,7 +2650,7 @@ everything after a rejected submission.
 
 sub post_wizard ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
 
@@ -2846,7 +2846,7 @@ type's own fields survive validation at save time.
 
 sub post_wizard_save ($query) {
     return $query->{tpsgi}->see_also('/login') unless $query->{user};
-    return $query->{tpsgi}->forbidden($query)  unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    return $query->{tpsgi}->forbidden($query)  unless List::Util::any { $_ eq 'admin' } @{ $query->{user_acls} };
 
     # Anchored capture rather than a substitution, so anything containing a '/'
     # or a '..' simply fails to match instead of being silently scrubbed into
@@ -2875,7 +2875,7 @@ sub post_wizard_save ($query) {
     # Whitelisted against what is actually on disk: this name goes into a
     # sidecar and is require()d later, so a regex is not enough.
     my $datasource = wizard_scalar( $query->{datasource} );
-    if ( $datasource && !grep { $_ eq $datasource } @{ get_datasources() } ) {
+    if ( $datasource && List::Util::none { $_ eq $datasource } @{ get_datasources() } ) {
         return wizard_fail( $query, "'$datasource' is not a datasource I can find." );
     }
 
@@ -2997,7 +2997,7 @@ my sub wizard_display_of ($form) {
     # Kolon at all -- see wizard_template.  So only the first line with
     # anything on it is asked, and a type which opens with its own markup or its
     # own directive is one that ticked the box off.
-    foreach my $line ( split( "\n", $template ) ) {
+    foreach my $line ( split( /\n/, $template ) ) {
         next                if $line =~ m/^\s*$/;
         next                if $line =~ m/^\s*<!--/;
         $shown{wrapper} = 1 if $line =~ m/^\s*<div\s+class="post\b/;
@@ -3100,11 +3100,11 @@ my sub wizard_display_from_template ($form) {
     my $template = eval { File::Slurper::read_text($path) };
     return '' unless defined $template;
 
-    my @lines = split( "\n", $template );
+    my @lines = split( /\n/, $template );
 
     # CORE::index because this package has an index() of its own -- the route
     # that renders every page.
-    return '' unless @lines && CORE::index( $lines[0], 'Generated by the tCMS Post Type Wizard' ) != -1;
+    return '' if !@lines || CORE::index( $lines[0], 'Generated by the tCMS Post Type Wizard' ) == -1;
 
     my ( @display, $inside );
     foreach my $line (@lines) {
@@ -3281,7 +3281,7 @@ sub wizard_fields ($query) {
 
         # Never let a custom field shadow a core post attribute.
         next if exists $Trog::DataModule::post_schema{properties}{$fname};
-        next if grep { $fname eq $_ } @wizard_reserved;
+        next if List::Util::any { $fname eq $_ } @wizard_reserved;
 
         my $type = wizard_scalar( $types->[$index] );
         $type = 'text' unless $wizard_field_types{$type};

lib/Trog/SQLite/TagIndex.pm

@@ -127,7 +127,7 @@ sub build_index ( $data_obj, $posts = [] ) {
     }
 
     # Slap in the tags, plus the aclname in the event this is a series
-    my @tags = uniq map { @{ $_->{tags} }, $_->{aclname} } @$posts;
+    my @tags = uniq map { ( @{ $_->{tags} }, $_->{aclname} ) } @$posts;
     Trog::SQLite::bulk_insert( $dbh, 'tag', ['name'], 'IGNORE', @tags );
 
     #TODO restrict query to only the specific tags we care about

lib/Trog/Vault.pm

@@ -214,7 +214,7 @@ Remember one thing for one user, replacing whatever was there under that name.
 sub set ( $user, $name, $secret ) {
     return ( 0, 'this installation has no vault key, so there is nowhere to keep it' ) unless has_key();
     return ( 0, 'a secret needs a name' )                                              unless safe_name($name);
-    return ( 0, 'nothing to store' )                                                   unless ( $secret // q{} ) ne q{};
+    return ( 0, 'nothing to store' ) if ( $secret // q{} ) eq q{};
 
     my $salt = Crypt::PRNG::random_bytes(32);
     my ( $key, $iv ) = derive($salt);

t/Trog-Auth-totp-mandatory.t

@@ -44,8 +44,8 @@ BEGIN {
 
     # Otherwise login() reads the instance as a fresh install and registers
     # whoever knocks first as the admin, which is a different test.
-    open( $fh, '>', "$ROOT/config/has_users" ) or die $!;
-    close $fh;
+    open( my $flag, '>', "$ROOT/config/has_users" ) or die $!;
+    close $flag;
 
     chdir($ROOT) or die "could not chdir to the sandbox: $!";
 }

t/Trog-Data-SQLite.t

@@ -103,8 +103,8 @@ push( @corpus, post( id => 'p-public', title => 'The Quick Brown Fox (revised)',
 foreach my $p (@corpus) {
 
     # Separate copies: FlatFile's index build decorates what it is handed.
-    $sqlite->write( [ { %$p, tags => [ @{ $p->{tags} } ] } ] );
-    $flat->write( [ { %$p, tags => [ @{ $p->{tags} } ] } ] );
+    $sqlite->write( [ +{ %$p, tags => [ @{ $p->{tags} } ] } ] );
+    $flat->write( [ +{ %$p, tags => [ @{ $p->{tags} } ] } ] );
 }
 
 # FlatFile snapshots the tag list at load time and filters queries against it in
@@ -507,8 +507,8 @@ subtest 'aliases' => sub {
         callback   => 'Trog::Routes::HTML::posts',
         aliases    => [qw{/one /two /three}],
     );
-    $sqlite->write( [ { %$aliased, tags => [ @{ $aliased->{tags} } ] } ] );
-    $flat->write( [ { %$aliased, tags => [ @{ $aliased->{tags} } ] } ] );
+    $sqlite->write( [ +{ %$aliased, tags => [ @{ $aliased->{tags} } ] } ] );
+    $flat->write( [ +{ %$aliased, tags => [ @{ $aliased->{tags} } ] } ] );
 
     my %want = map { $_ => '/posts/p-aliased' } qw{/one /two /three};
     foreach my $case ( [ flatfile => $flat ], [ sqlite => $sqlite ] ) {

t/Trog-DataSource-ProvisionedVirt.t

@@ -71,8 +71,7 @@ my $config_mock;
 sub write_config {
     my (%section) = @_;
     open( my $fh, '>', "$ROOT/config/default.cfg" ) or die $!;
-    print {$fh} "[general]\n    data_model=FlatFile\n[provisioner]\n";
-    print {$fh} "    $_=$section{$_}\n" foreach sort keys %section;
+    print {$fh} "[general]\n    data_model=FlatFile\n[provisioner]\n" . join( '', map { "    $_=$section{$_}\n" } sort keys %section );
     close $fh;
 
     require Config::Simple;

t/Trog-Routes-HTML-post-wizard-browser.t

@@ -92,9 +92,9 @@ my $browser = $handle->launch( headless => 1, type => $TYPE );
 my $page    = $browser->newPage();
 
 END {
-    eval { $page->close() }    if $page;
-    eval { $browser->close() } if $browser;
-    eval { $handle->quit() }   if $handle;
+    eval { $page->close();    1 } or diag("could not close the page: $@")          if $page;
+    eval { $browser->close(); 1 } or diag("could not close the browser: $@")       if $browser;
+    eval { $handle->quit();   1 } or diag("could not stop the browser driver: $@") if $handle;
 }
 
 sub field_names {

t/Trog-Routes-HTML-series-lifecycle.t

@@ -149,7 +149,7 @@ END {
 
         # SQLite handles are file-lexical in Trog::SQLite and unreachable from
         # here; DBI disconnects at global destruction, after these are gone.
-        eval { File::Path::remove_tree($ROOT) };
+        eval { File::Path::remove_tree($ROOT); 1 } or diag("could not remove $ROOT: $@");
     }
 }
 

t/Trog-SQLite-TagIndex.t

@@ -4,10 +4,11 @@ use re '/aasx';
 use warnings FATAL => 'all';
 
 use Test::More;
-use Cwd        ();
-use File::Copy ();
-use File::Path ();
-use File::Temp ();
+use Test::Fatal qw{exception};
+use Cwd         ();
+use File::Copy  ();
+use File::Path  ();
+use File::Temp  ();
 use FindBin;
 
 use FindBin::libs;
@@ -95,8 +96,9 @@ subtest 'rebuild is one transaction' => sub {
     my $before = index_rows();
 
     my $broken = Broken::Data->new( post() );
-    ok( !eval { Trog::SQLite::TagIndex::rebuild($broken); 1 }, 'a rebuild that fails part way dies' );
-    like( $@, qr/fell[ ]over/, 'with the error that stopped it' );
+    my $err    = exception { Trog::SQLite::TagIndex::rebuild($broken) };
+    ok( $err, 'a rebuild that fails part way dies' );
+    like( $err, qr/fell[ ]over/, 'with the error that stopped it' );
     is_deeply( index_rows(), $before, 'and leaves the index as it was' );
 };