Merge pull request #361 from Troglodyne-Internet-Widgets/mechanical-policies

Enable fatal warnings, qw lists, final returns, and two more policies

.perlcriticrc

@@ -51,7 +51,7 @@ strict = 1
 [BuiltinFunctions::ProhibitDeleteOnArrays]
 [Subroutines::ProhibitAmbiguousFunctionCalls]
 [ValuesAndExpressions::ProhibitSingleArgArraySlice]
-#[ValuesAndExpressions::ProhibitDefinedBeforeLength]
+[ValuesAndExpressions::ProhibitDefinedBeforeLength]
 [Variables::ProhibitUselessVarClearing]
 #[Subroutines::ProhibitTailRecursion]
 [Bangs::ProhibitUselessRegexModifiers]
@@ -97,11 +97,11 @@ formats = #!/usr/bin/env perl
 # looks at the result.  The same functions as RequireCheckedSyscalls below.
 [ErrorHandling::RequireCheckedIndirectResults]
 exclude_functions = print
-#[ProhibitUseLib]
+[ProhibitUseLib]
 #[ProhibitUsageSubs]
-#[RequireQwForLiteralLists]
+[RequireQwForLiteralLists]
 #[ProhibitNoWarningsRedefine]
-#[RequireFatalWarnings]
+[RequireFatalWarnings]
 #[ProhibitUnusedImports]
 # Modules imported for a side effect rather than for a symbol, which the policy
 # cannot see.  `re` is here because every file says `use re '/aa'`.  Add your
@@ -234,7 +234,9 @@ exclude_functions = print
 [Subroutines::ProhibitSubroutinePrototypes]
 #[Subroutines::ProtectPrivateSubs]
 #[Subroutines::RequireArgUnpacking]
-#[Subroutines::RequireFinalReturn]
+[Subroutines::RequireFinalReturn]
+# tCMS: a sub that forks ends its child with POSIX::_exit, which never returns.
+terminal_funcs = POSIX::_exit
 [TestingAndDebugging::ProhibitProlongedStrictureOverride]
 [TestingAndDebugging::RequireTestLabels]
 #[ValuesAndExpressions::ProhibitCommaSeparatedStatements]

Makefile.PL

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use ExtUtils::MakeMaker;
 

bin/build_index.pl

@@ -2,8 +2,9 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
-use lib 'lib';
+use FindBin::libs;
 use Trog::Data;
 use Trog::Config;
 use Trog::SQLite::TagIndex;

bin/favicon_mongler.pl

@@ -2,6 +2,7 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Cwd            ();
 use File::Basename ();

bin/migrate.pl

@@ -2,9 +2,10 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Getopt::Long qw{GetOptions};
 use Time::HiRes  ();

bin/tcms-hostname

@@ -2,6 +2,7 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 

bin/tcms-useradd

@@ -4,6 +4,7 @@ package tcms::useradd;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 use Getopt::Long;
@@ -145,11 +146,11 @@ sub main {
 
     # --password with no value means "ask me", as opposed to leaving the option
     # out entirely, which means "leave the password alone".
-    if ( defined $options{password} && !length $options{password} ) {
+    if ( defined $options{password} && !$options{password} ) {
         my $interactive = -t STDIN;
         $options{password} = _read_password("New password for '$options{user}': ");
 
-        unless ( defined $options{password} && length $options{password} ) {
+        unless ( $options{password} ) {
             print STDERR "No password provided.\n";
             return 2;
         }

bin/tcms-vault-key

@@ -2,6 +2,7 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 

bin/tcmslogin

@@ -4,6 +4,7 @@ package tcms::login;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 use Getopt::Long;
@@ -115,8 +116,8 @@ sub main {
 
     # Omitted entirely or passed with no value both mean "ask me".
     $options{password} = _read_password("Password for '$options{user}': ")
-      unless defined $options{password} && length $options{password};
-    unless ( defined $options{password} && length $options{password} ) {
+      unless $options{password};
+    unless ( $options{password} ) {
         print STDERR "No password provided.\n";
         return 2;
     }

bin/totp

@@ -2,6 +2,7 @@
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 

lib/TCMS.pm

@@ -2,6 +2,7 @@ package TCMS;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Carp         qw{confess};
 use Clone        qw{clone};
@@ -20,8 +21,6 @@ use URI();
 use Ref::Util qw{is_coderef is_hashref is_arrayref};
 
 #Grab our custom routes
-use FindBin;
-use lib "$FindBin::Bin/../lib";
 use FindBin::libs;
 
 use Trog::Routes::HTML;

lib/Theme.pm

@@ -2,6 +2,7 @@ package Theme;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 =head1 Theme
 

lib/Trog/Auth.pm

@@ -2,6 +2,7 @@ package Trog::Auth;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 
@@ -377,14 +378,14 @@ our $argon2_tag     = 32;
 our $argon2_saltlen = 16;
 
 sub check_password ( $user, $pass ) {
-    return 0 unless defined $pass && length($pass);
+    return 0 unless $pass;
 
     my $dbh  = _dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT hash, salt FROM user WHERE name = ?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
 
     my ( $hash, $salt ) = ( $rows->[0]{hash}, $rows->[0]{salt} );
-    return 0 unless defined $hash && length($hash);
+    return 0 unless $hash;
 
     if ( index( $hash, '$argon2' ) == 0 ) {
         return 0 unless eval { argon2id_verify( $hash, $pass ) };

lib/Trog/Component.pm

@@ -2,6 +2,7 @@ package Trog::Component;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Text::Xslate ();
 
@@ -137,7 +138,7 @@ sub render_template ( $template, $data = {} ) {
 sub _load ($name) {
     state %loaded;
 
-    die "Component name must be given\n"   unless defined $name && length $name;
+    die "Component name must be given\n"   unless $name;
     die "Invalid component name '$name'\n" unless $name =~ m/^[A-Za-z][A-Za-z0-9_]*$/;
 
     my $module = "Trog::Component::$name";

lib/Trog/Component/CategoryBar.pm

@@ -2,6 +2,7 @@ package Trog::Component::CategoryBar;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/EmojiPicker.pm

@@ -2,6 +2,7 @@ package Trog::Component::EmojiPicker;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use File::Slurper ();
 use JSON::MaybeXS;

lib/Trog/Component/FootBar.pm

@@ -2,6 +2,7 @@ package Trog::Component::FootBar;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/Footer.pm

@@ -2,6 +2,7 @@ package Trog::Component::Footer;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/Header.pm

@@ -2,6 +2,7 @@ package Trog::Component::Header;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 use Trog::Themes;

lib/Trog/Component/HtmlTitle.pm

@@ -2,6 +2,7 @@ package Trog::Component::HtmlTitle;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/LeftBar.pm

@@ -2,6 +2,7 @@ package Trog::Component::LeftBar;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/MidTitle.pm

@@ -2,6 +2,7 @@ package Trog::Component::MidTitle;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/PostFooter.pm

@@ -2,6 +2,7 @@ package Trog::Component::PostFooter;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 use Trog::Themes;
@@ -30,7 +31,7 @@ wants something else should be handed it at the call site in posts.tx.
 
 sub render (%args) {
     my $name = delete $args{name};
-    return '' unless defined $name && length $name;
+    return '' unless $name;
 
     die "No such footer '$name'\n" unless grep { $_ eq $name } @{ available() };
 

lib/Trog/Component/PostHeader.pm

@@ -2,6 +2,7 @@ package Trog::Component::PostHeader;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 use Trog::Themes;
@@ -30,7 +31,7 @@ wants something else should be handed it at the call site in posts.tx.
 
 sub render (%args) {
     my $name = delete $args{name};
-    return '' unless defined $name && length $name;
+    return '' unless $name;
 
     die "No such header '$name'\n" unless grep { $_ eq $name } @{ available() };
 

lib/Trog/Component/RightBar.pm

@@ -2,6 +2,7 @@ package Trog::Component::RightBar;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Component/TopBar.pm

@@ -2,6 +2,7 @@ package Trog::Component::TopBar;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Component ();
 

lib/Trog/Config.pm

@@ -2,6 +2,7 @@ package Trog::Config;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 
@@ -83,7 +84,7 @@ sub schema ( $file = $default ) {
         chomp $line;
         $line =~ s/^\s+//;
         $line =~ s/\s+$//;
-        next unless length $line;
+        next unless $line;
 
         if ( $line =~ m/^\[(\N+)\]$/ ) {
             $section = { section => $1, fields => [] };

lib/Trog/Data.pm

@@ -2,6 +2,7 @@ package Trog::Data;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::Log qw{:all};
 

lib/Trog/Data/DUMMY.pm

@@ -2,6 +2,7 @@ package Trog::Data::DUMMY;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Carp qw{confess};
 use Errno();
@@ -19,8 +20,8 @@ Do not use this as a production data model.  It is *not* safe to race conditions
 =cut
 
 our $datastore = 'data/DUMMY.json';
-sub lang { 'Perl Regex in Quotemeta' }
-sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
+sub lang { return 'Perl Regex in Quotemeta' }
+sub help { return 'https://perldoc.perl.org/functions/quotemeta.html' }
 
 our $posts;
 
@@ -64,6 +65,7 @@ sub write ( $self, $data, $overwrite = 0 ) {
     open( my $fh, '>', $datastore ) or confess;
     print $fh JSON::MaybeXS::encode_json($orig);
     close $fh;
+    return 1;
 }
 
 sub delete ( $self, @posts ) {

lib/Trog/Data/FlatFile.pm

@@ -2,6 +2,7 @@ package Trog::Data::FlatFile;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Carp           qw{confess};
 use Fcntl          qw{LOCK_EX};
@@ -14,15 +15,14 @@ use File::Copy;
 use Path::Tiny();
 use Capture::Tiny qw{capture_merged};
 
-use lib 'lib';
 use Trog::Log qw{:all};
 use Trog::SQLite::TagIndex;
 
 use parent qw{Trog::DataModule};
 
 our $datastore = 'data/files';
-sub lang { 'Perl Regex in Quotemeta' }
-sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
+sub lang { return 'Perl Regex in Quotemeta' }
+sub help { return 'https://perldoc.perl.org/functions/quotemeta.html' }
 
 =head1 Trog::Data::FlatFile
 
@@ -149,7 +149,7 @@ sub write ( $self, $data ) {
         # is a directory, rename() onto it fails, and the error names File::
         # Slurper rather than the post that had no id.  add() will not produce
         # one, but nothing else guarantees a caller went through add().
-        confess "Cannot write a post with no id" unless length( $post->{id} // '' );
+        confess "Cannot write a post with no id" unless $post->{id};
 
         my $file = "$datastore/$post->{id}";
 
@@ -166,7 +166,7 @@ sub write ( $self, $data ) {
         flock( $lock, LOCK_EX )                      or confess "Could not lock $spool/.write.lock: $!";
 
         my $slurped = eval { File::Slurper::read_binary($file) };
-        my $update  = length( $slurped // '' ) ? [ ( @{ $parser->decode($slurped) }, $post ) ] : [$post];
+        my $update  = $slurped ? [ ( @{ $parser->decode($slurped) }, $post ) ] : [$post];
 
         # The rename is what stops a torn read.  Every reader here takes no
         # lock, so writing in place lets one catch a half-written file: a few
@@ -181,6 +181,7 @@ sub write ( $self, $data ) {
 
         Trog::SQLite::TagIndex::add_post( $post, $self );
     }
+    return 1;
 }
 
 sub count ($self) {

lib/Trog/Data/SQLite.pm

@@ -2,12 +2,12 @@ package Trog::Data::SQLite;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Carp qw{confess};
 use JSON::MaybeXS;
 use List::Util qw{any};
 
-use lib 'lib';
 use Trog::Log qw{:all};
 use Trog::SQLite;
 
@@ -18,8 +18,8 @@ our $dbname = 'data/posts.sqlite';
 
 our $parser = JSON::MaybeXS->new( utf8 => 1 );
 
-sub lang { 'SQLite FTS5 substring match' }
-sub help { 'https://sqlite.org/fts5.html' }
+sub lang { return 'SQLite FTS5 substring match' }
+sub help { return 'https://sqlite.org/fts5.html' }
 
 =head1 Trog::Data::SQLite
 
@@ -242,7 +242,7 @@ sub _where ($query) {
         push( @bind,  $query->{author} );
     }
 
-    if ( length( $query->{like} // '' ) ) {
+    if ( ( $query->{like} // q{} ) ne q{} ) {
         my ( $clause, @like_bind ) = _like_clause( $query->{like} );
         push( @where, $clause );
         push( @bind,  @like_bind );

lib/Trog/DataModule.pm

@@ -2,6 +2,7 @@ package Trog::DataModule;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 
@@ -940,8 +941,8 @@ sub _process ($post) {
     #Filter adding the same acl twice, and anything that isn't a tag at all --
     # an undef here is what every query below compares against, and it warns
     # its way through the lot before matching nothing.
-    @{ $post->{tags} }    = List::Util::uniq( grep { defined && length } @{ $post->{tags} } );
-    @{ $post->{aliases} } = List::Util::uniq( grep { defined && length } @{ $post->{aliases} } );
+    @{ $post->{tags} }    = List::Util::uniq( grep { $_ } @{ $post->{tags} } );
+    @{ $post->{aliases} } = List::Util::uniq( grep { $_ } @{ $post->{aliases} } );
 
     # Handle multimedia content types
     $post->{content_type}       = Trog::Utils::mime_type("www/$post->{href}")       if $post->{href};

lib/Trog/DataSource.pm

@@ -2,6 +2,7 @@ package Trog::DataSource;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::DataModule ();
 use Trog::Log        qw{:all};
@@ -101,7 +102,7 @@ rather than by hoping this one covers it.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( length( $query->{like} // '' ) ) {
+    if ( ( $query->{like} // q{} ) ne q{} ) {
         my $like = $query->{like};
         @posts = grep { searchable_match( $like, $_->{title}, $_->{data} ) } @posts;
     }
@@ -112,11 +113,11 @@ sub filter ( $query, @posts ) {
     # this arrives straight off a query string.
     if ( $query->{older} ) {
         ( my $older = $query->{older} ) =~ s/[^0-9]//g;
-        @posts = grep { ( $_->{created} // 0 ) < $older } @posts if length $older;
+        @posts = grep { ( $_->{created} // 0 ) < $older } @posts if $older;
     }
     if ( $query->{newer} ) {
         ( my $newer = $query->{newer} ) =~ s/[^0-9]//g;
-        @posts = grep { ( $_->{created} // 0 ) > $newer } @posts if length $newer;
+        @posts = grep { ( $_->{created} // 0 ) > $newer } @posts if $newer;
     }
 
     return @posts;
@@ -137,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 length( $like // '' );
+    return 0 unless ( $like // q{} ) ne q{};
 
     foreach my $value (@values) {
         next     if !defined $value || ref $value;
@@ -175,7 +176,7 @@ to the datastore, and a datasource page is not being served out of the datastore
 
 =cut
 
-sub lang { 'Case insensitive substring' }
+sub lang { return 'Case insensitive substring' }
 
 =head2 help() = STRING
 
@@ -183,7 +184,7 @@ Where to read about it.
 
 =cut
 
-sub help { 'https://en.wikipedia.org/wiki/Substring' }
+sub help { return 'https://en.wikipedia.org/wiki/Substring' }
 
 =head2 cacheable($source) = BOOL
 
@@ -222,7 +223,7 @@ an arbitrary module.  Returns the module name without loading it; see load().
 =cut
 
 sub for_type ( $form = '' ) {
-    return undef unless length( $form // '' );
+    return undef unless $form;
 
     my $meta   = Trog::DataModule::type_meta_for($form);
     my $source = $meta->{'x-tcms-datasource'};

lib/Trog/DataSource/DirIndex.pm

@@ -2,6 +2,7 @@ package Trog::DataSource::DirIndex;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Cwd            ();
 use Digest::SHA    qw{sha256_hex};
@@ -145,7 +146,7 @@ sub posts ( $series, $query ) {
 # and the path relative to the tCMS root, since the first is what we read and
 # the second is what we log and watch.
 sub _resolve ($directory) {
-    return undef unless defined $directory && length $directory;
+    return undef unless $directory;
 
     # Before abs_path, which would happily resolve one for us.
     if ( $directory =~ m{(?:^|/)\.\.(?:/|$)} ) {
@@ -188,7 +189,7 @@ sub _resolve ($directory) {
     my $relative = $absolute;
     $relative =~ s{^\Q$base\E/?}{};
 
-    return { absolute => $absolute, relative => length($relative) ? "$root/$relative" : $root };
+    return { absolute => $absolute, relative => $relative ne q{} ? "$root/$relative" : $root };
 }
 
 # Path containment, done on the resolved paths rather than on the strings the
@@ -302,7 +303,7 @@ under it.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( length( $query->{like} // '' ) ) {
+    if ( ( $query->{like} // q{} ) ne q{} ) {
         my $like = $query->{like};
         @posts = grep { Trog::DataSource::searchable_match( $like, $_->{name}, $_->{path}, $_->{extension} ) } @posts;
     }
@@ -335,8 +336,8 @@ Where to read about it.
 
 =cut
 
-sub lang { 'Case insensitive substring of a file name, path or extension' }
-sub help { 'https://en.wikipedia.org/wiki/Substring' }
+sub lang { return 'Case insensitive substring of a file name, path or extension' }
+sub help { return 'https://en.wikipedia.org/wiki/Substring' }
 
 =head2 _watch($query, $directory)
 

lib/Trog/DataSource/ProvisionedVirt.pm

@@ -2,6 +2,7 @@ package Trog::DataSource::ProvisionedVirt;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::DataSource::Virt};
 
@@ -282,7 +283,7 @@ sub _config {
 
 # A guest name reaches the filesystem here, so it is a hostname or it is nothing.
 sub _safe_domain ($domain) {
-    return undef unless defined $domain && length($domain) && length($domain) < 254;
+    return undef if !$domain || length $domain >= 254;
     return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
 
     my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
@@ -472,9 +473,9 @@ sub _credentials (%args) {
     # typed ones are worth filing away, and only they can be: a value fetched
     # from the vault is already in it.
     my %typed;
-    $typed{sudo} = $args{sudo} if length( $args{sudo} // '' );
+    $typed{sudo} = $args{sudo} if $args{sudo};
 
-    if ( length( $args{totp} // '' ) ) {
+    if ( $args{totp} ) {
         return ( undef, 'a code identifies somebody, and nobody is logged in' ) unless $user;
 
         # Asked before the code is spent, and the reason is that a code is
@@ -491,11 +492,11 @@ sub _credentials (%args) {
         return ( undef, $why ) unless $ok;
 
         my $stored = Trog::Vault::get( $user, $secret_name );
-        return ( undef, "the stored provisioning passphrase for $user could not be read" ) unless defined $stored && length($stored);
+        return ( undef, "the stored provisioning passphrase for $user could not be read" ) unless $stored;
         $credentials{keepass} = $stored;
     }
     else {
-        return ( undef, 'a passphrase is required, as the provisioner asks for one' ) unless length( $args{passphrase} // '' );
+        return ( undef, 'a passphrase is required, as the provisioner asks for one' ) unless $args{passphrase};
         $credentials{keepass} = $args{passphrase};
         $typed{keepass}       = $args{passphrase};
     }
@@ -504,7 +505,7 @@ sub _credentials (%args) {
     # reason to -- and no sudo password at all is the ordinary answer, for a
     # hypervisor whose login has passwordless sudo.
     my $sudo = $typed{sudo} // ( $user ? Trog::Vault::get( $user, $sudo_name ) : undef );
-    $credentials{sudo} = $sudo if defined $sudo && length($sudo);
+    $credentials{sudo} = $sudo if $sudo;
 
     _remember( $user, \%typed ) if $args{remember} && $user && %typed;
 

lib/Trog/DataSource/Virt.pm

@@ -2,6 +2,7 @@ package Trog::DataSource::Virt;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use File::Path();
 use Sys::Hostname::FQDN();
@@ -99,7 +100,7 @@ sub _connect ( $uri, $cache = {} ) {
 
 # libvirt's numeric domain states, in the order the constants define them.
 my @states = (
-    'no state',      'running',  'blocked', 'paused',
+    'no state', qw{running blocked paused},
     'shutting down', 'shut off', 'crashed', 'suspended',
 );
 
@@ -209,7 +210,7 @@ Trog::DataSource::filter.
 sub filter ( $query, @posts ) {
     $query //= {};
 
-    if ( length( $query->{like} // '' ) ) {
+    if ( ( $query->{like} // q{} ) ne q{} ) {
         my $like = $query->{like};
         @posts = grep {
             Trog::DataSource::searchable_match(
@@ -233,8 +234,8 @@ Where to read about it.
 
 =cut
 
-sub lang { 'Case insensitive substring of a guest name, state or hypervisor' }
-sub help { 'https://en.wikipedia.org/wiki/Substring' }
+sub lang { return 'Case insensitive substring of a guest name, state or hypervisor' }
+sub help { return 'https://en.wikipedia.org/wiki/Substring' }
 
 sub _post_for ( $domain, $hypervisor, $series, $form ) {
     my $name = $domain->get_name();

lib/Trog/Email.pm

@@ -2,6 +2,7 @@ package Trog::Email;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Email::MIME;
 use Email::Sender::Simple;

lib/Trog/Enrich/Invoice.pm

@@ -2,6 +2,7 @@ package Trog::Enrich::Invoice;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use List::Util();
 

lib/Trog/FileHandler.pm

@@ -2,6 +2,7 @@ package Trog::FileHandler;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use POSIX qw{strftime};
 use IO::Compress::Gzip;

lib/Trog/Log.pm

@@ -2,6 +2,7 @@ package Trog::Log;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use POSIX qw{strftime};
 use Module::Runtime();
@@ -158,7 +159,7 @@ request's messages under the request itself.
 sub uuid {
     my $requestid = shift;
     $rq = $requestid if $requestid;
-    $requestid //= return $rq;
+    return $requestid // $rq;
 }
 
 sub _log {

lib/Trog/Log/DBI.pm

@@ -2,6 +2,7 @@ package Trog::Log::DBI;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Log::Dispatch::DBI};
 
@@ -89,7 +90,7 @@ sub log_message {
         ( $date, $uuid, $ip, $user, $message ) = $msg =~ m!^([\w|\-|:]+)[ ]\[\w+\]:[ ]RequestId[ ]([\w|\-]+)[ ]From[ ]([\w|\.|:]+)[ ]\|(\w+)\|[ ](\N+)!;
 
         # If we can't figure out its request, ignore the message
-        if ( length $uuid ) {
+        if ($uuid) {
             $buffer{$uuid} //= [];
             push( @{ $buffer{$uuid} }, $message );
         }

lib/Trog/Log/Metrics.pm

@@ -2,6 +2,7 @@ package Trog::Log::Metrics;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Trog::SQLite;
 use Trog::Log;

lib/Trog/Log/Syslog.pm

@@ -2,6 +2,7 @@ package Trog::Log::Syslog;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Log::Dispatch::Output};
 

lib/Trog/Renderer.pm

@@ -2,6 +2,7 @@ package Trog::Renderer;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Carp::Always;
 

lib/Trog/Renderer/Base.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::Base;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Encode qw{encode_utf8};
 use IO::Compress::Gzip;

lib/Trog/Renderer/blob.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::blob;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 =head1 Trog::Renderer::blob
 

lib/Trog/Renderer/css.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::css;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::Renderer::Base};
 
@@ -15,7 +16,7 @@ Render CSS, and minify the output.
 
 sub render (%options) {
     $options{post_processor} = \&_minify;
-    Trog::Renderer::Base::render(%options);
+    return Trog::Renderer::Base::render(%options);
 }
 
 sub _minify {

lib/Trog/Renderer/email.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::email;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::Renderer::Base};
 

lib/Trog/Renderer/html.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::html;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::Renderer::Base};
 

lib/Trog/Renderer/javascript.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::javascript;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::Renderer::Base};
 
@@ -15,7 +16,7 @@ Render JS, and minify the output.
 
 sub render (%options) {
     $options{post_processor} = \&_minify;
-    Trog::Renderer::Base::render(%options);
+    return Trog::Renderer::Base::render(%options);
 }
 
 sub _minify {

lib/Trog/Renderer/json.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::json;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use JSON::MaybeXS;
 

lib/Trog/Renderer/text.pm

@@ -2,6 +2,7 @@ package Trog::Renderer::text;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use parent qw{Trog::Renderer::Base};
 
@@ -16,7 +17,7 @@ Render plain text.  Can be used for email as well.
 =cut
 
 sub render (%options) {
-    Trog::Renderer::Base::render(%options);
+    return Trog::Renderer::Base::render(%options);
 }
 
 1;

lib/Trog/Routes/HTML.pm

@@ -2,6 +2,7 @@ package Trog::Routes::HTML;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 no warnings qw{once};
 
@@ -313,7 +314,8 @@ if ($theme_dir) {
 
     my $theme_mod = "$theme_dir/routes.pm";
     if ( -f $theme_mod ) {    ## no critic (ProhibitFiletest_f) -- theme routes, else the default theme
-        use lib '.';
+                              # get_dir() is relative to the tCMS root, which require only searches from '.'.
+        local @INC = ( '.', @INC );
         require $theme_mod;
         @routes{ keys(%Theme::routes) } = values(%Theme::routes);
         $themed = 1;
@@ -590,7 +592,7 @@ One time setup page; should only display to the first user to visit the site whi
 
 sub setup ($query) {
     File::Touch::touch("config/setup");
-    Trog::Renderer->render(
+    return Trog::Renderer->render(
         template => 'notconfigured.tx',
         data     => {
             title       => 'tCMS Requires Setup to Continue...',
@@ -790,6 +792,7 @@ sub _setup_initial_db ( $dat, $user, $display_name, $contact_email ) {
             aliases       => [],
         },
     );
+    return 1;
 }
 
 =head2 logout
@@ -880,7 +883,7 @@ sub _config_sections {
                     map {
                         {
                             value    => $_,
-                            label    => length($_)   ? $_ : 'default',
+                            label    => $_           ? $_ : 'default',
                             selected => $_ eq $value ? 1  : 0,
                         }
                     } @{ $choices->() }
@@ -1977,7 +1980,7 @@ sub _paginate_offset ( $query, $limit, @posts ) {
     # shows the last page rather than an empty one, which is what a stale
     # bookmark deserves.
     ( my $wanted = $query->{page} // '' ) =~ s/[^0-9]//g;
-    my $page = length($wanted) ? int($wanted) : 1;
+    my $page = $wanted ? int($wanted) : 1;
     $page = 1            if $page < 1;
     $page = $pages_total if $page > $pages_total;
 
@@ -2273,6 +2276,7 @@ sub _post2rss ( $rss, $url, $post ) {
         pubDate     => DateTime->from_epoch( epoch => $post->{created} ),    #TODO format like Thu, 23 Aug 1999 07:00:00 GMT
         author      => $post->{user},                                        #TODO translate to "email (user)" format
     );
+    return 1;
 }
 
 =head2 manual
@@ -2890,7 +2894,7 @@ sub _wizard_types ($forms) {
         my %includes = map { $_ => 1 } @{ Trog::DataModule::includes_for($form) };
 
         my $display = $type->{display};
-        $display = _wizard_display_from_template($form) unless length( $display // '' );
+        $display = _wizard_display_from_template($form) unless $display;
 
         # The wrapper div and the two blocks which belong to a type's display
         # half rather than to its editor.  Same reading as the includes, and for
@@ -3246,7 +3250,7 @@ sub _wizard_sidecar ( $name, $fields, $includes, $body_form, $datasource = '', $
         my $property = { %{ $wizard_field_types{ $field->{type} } } };
         $property->{'x-tcms-input'}       = $field->{type};
         $property->{'x-tcms-label'}       = $field->{label};
-        $property->{'x-tcms-placeholder'} = $field->{placeholder} if length $field->{placeholder};
+        $property->{'x-tcms-placeholder'} = $field->{placeholder} if ( $field->{placeholder} // q{} ) ne q{};
 
         # Only written when it is true: a field is public unless it says so,
         # and a sidecar full of x-tcms-private:false reads like the opposite.

lib/Trog/Routes/JSON.pm

@@ -2,6 +2,7 @@ package Trog::Routes::JSON;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Clone qw{clone};
 use JSON::MaybeXS();

lib/Trog/Routes/TXT.pm

@@ -2,6 +2,7 @@ package Trog::Routes::JSON;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Clone qw{clone};
 use JSON::MaybeXS();

lib/Trog/SQLite/TagIndex.pm

@@ -2,6 +2,7 @@ package Trog::SQLite::TagIndex;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use URI::Escape;
 use List::Util qw{uniq};
@@ -137,6 +138,7 @@ sub build_index ( $data_obj, $posts = [] ) {
             map { ( $subj->{post_id}, $subj->{created}, $t->{$_} ) } @{ $subj->{tags} }
         } @$posts
     );
+    return 1;
 }
 
 sub _id_for_uuid ( $dbh, @uuids ) {
@@ -180,6 +182,7 @@ sub build_routes ( $data_obj, $posts = [] ) {
         my $route = $post->{local_href};
         Trog::SQLite::bulk_insert( $dbh, 'post_aliases', [qw{route_id alias}], 'IGNORE', map { ( $routes_actual{$route}{id}, $_ ) } @{ $post->{aliases} } );
     }
+    return 1;
 }
 
 # Ensure the db schema is OK, and give us a handle

lib/Trog/Themes.pm

@@ -2,6 +2,7 @@ package Trog::Themes;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use FindBin::libs;
 
@@ -31,11 +32,14 @@ sub routes {
     my $rdir = get_dir();
     return () unless -f "$rdir/routes.pm";    ## no critic (ProhibitFiletest_f) -- theme ships routes, or it does not
 
+    # get_dir() is relative to the tCMS root, which require only searches from '.'.
+    local @INC = ( '.', @INC );
     local $@;
     eval { require "$rdir/routes.pm"; 1; } or do {
         die "Could not load Theme routing package: $@";
     };
 
+    no warnings 'once';
     return %Theme::routes;
 }
 

lib/Trog/Utils.pm

@@ -2,6 +2,7 @@ package Trog::Utils;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use UUID;
 use HTTP::Tiny::UNIX();

lib/Trog/Vars.pm

@@ -2,6 +2,7 @@ package Trog::Vars;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 =head1 Trog::Vars
 

lib/Trog/Vault.pm

@@ -2,6 +2,7 @@ package Trog::Vault;
 
 use 5.040;
 use re '/aasx';
+use warnings FATAL => 'all';
 
 use Crypt::AuthEnc::GCM  ();
 use Crypt::KeyDerivation ();
@@ -115,7 +116,7 @@ our $looked_further = 0;
 
 sub _from_env {
     my $raw = delete $ENV{TPSGI_VAULT_KEY};
-    return undef unless defined $raw && length($raw);
+    return undef unless $raw;
     return _decode( $raw, 'TPSGI_VAULT_KEY' );
 }
 
@@ -203,7 +204,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 defined $secret && length($secret);
+    return ( 0, 'nothing to store' )                                                   unless ( $secret // q{} ) ne q{};
 
     my $salt = Crypt::PRNG::random_bytes(32);
     my ( $key, $iv ) = _derive($salt);
@@ -355,7 +356,7 @@ sub forget ( $user, $name ) {
 # A name is a label in a form and a key in a table, and it is half of what binds
 # a row to its owner, so it is a short plain thing or it is nothing.
 sub _safe_name ($name) {
-    return 0 unless defined $name && length($name) && length($name) <= 64;
+    return 0 if !$name || length $name > 64;
     return $name =~ m/^[A-Za-z0-9][A-Za-z0-9._-]*$/ ? 1 : 0;
 }
 

t/Trog-Auth-libravatar.t

@@ -1,12 +1,12 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 # Stub modules absent from the test environment before loading Trog::Auth
 BEGIN {

t/Trog-Auth-totp-mandatory.t

@@ -6,10 +6,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};

t/Trog-Component-page.t

@@ -1,13 +1,13 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
 use Test::Fatal      qw{exception};
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 # The components render real templates through the real renderer, which resolves
 # them relative to the tCMS root.  Xslate also computes its cache dir from $HOME
@@ -86,7 +86,7 @@ subtest 'PostHeader and PostFooter validate the name' => sub {
 
     # The name comes out of post data, and before this it went straight into a
     # path with nothing checking it.
-    foreach my $bad ( '../../etc/passwd', 'headers/../../../etc/passwd', 'nope.tx', 'about_header' ) {
+    foreach my $bad (qw{../../etc/passwd headers/../../../etc/passwd nope.tx about_header}) {
         like(
             exception { Trog::Component::component( 'PostHeader', { name => $bad } ) },
             qr/No[ ]such[ ]header/,

t/Trog-Component.t

@@ -1,12 +1,12 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::Fatal qw{exception};
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Text::Xslate ();
 
@@ -43,7 +43,7 @@ our @ARGS_SEEN;
     sub render { return Trog::Component::component('TestRecurse') }
 
     package Trog::Component::TestNoRender;
-    sub nope { 1 }
+    sub nope { return 1 }
 }
 
 subtest 'name validation' => sub {

t/Trog-Config.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Cwd();
@@ -9,7 +9,7 @@ use File::Temp();
 use Path::Tiny();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 # $Trog::Config::default is read exactly once below, which is enough for perl
 # to suspect a typo.

t/Trog-Data-FlatFile-read.t

@@ -1,13 +1,13 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::Fatal qw{exception};
 use File::Path  ();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 my ( $ROOT, $OLDCWD );
 

t/Trog-Data-SQLite.t

@@ -7,10 +7,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};
@@ -74,6 +74,8 @@ sub post {
         created    => $t++,
         version    => 0,
         form       => 'blog.tx',
+        method     => 'GET',
+        callback   => 'Trog::Routes::HTML::posts',
         %o,
 
         # _process() pushes visibility into tags, so the corpus does too.
@@ -263,6 +265,7 @@ subtest 'the like filter goes through FTS5' => sub {
         [ 'Secret Plans' => ['p-private'] ],    # title as well as body
         [ 'foxes'        => ['p-slides'] ],     # data stored as an array
         [ 'nonesuch'     => [] ],
+        [ '0'            => [] ],               # a term, not an absent one
     );
 
     foreach my $case (@cases) {
@@ -487,7 +490,7 @@ subtest 'indexing a custom field' => sub {
 
     # The name reaches SQLite as an identifier and a JSON path, neither of which
     # can be bound as a parameter, so it is checked here and not merely upstream.
-    foreach my $hostile ( 'cook_time; DROP TABLE posts', "cook'time", 'Cook_Time', '1st_course', 'a' x 40, '', 'post_data' ) {
+    foreach my $hostile ( 'cook_time; DROP TABLE posts', "cook'time", 'Cook_Time', '1st_course', ( 'a' x 40 ), '', 'post_data' ) {
         is( exception { $sqlite->index_fields($hostile) }, undef, "'$hostile' is refused rather than run" );
     }
     ok( $indexes->()->{posts_created},             'and the table is still there afterwards' );

t/Trog-Data.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule;
@@ -9,7 +9,7 @@ use File::Temp     ();
 use Path::Tiny     ();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use_ok('Trog::Data') or BAIL_OUT("Can't find SUT");
 

t/Trog-DataModule-schema.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
@@ -13,7 +13,7 @@ use FindBin;
 use feature qw{signatures};
 no warnings qw{experimental::signatures};
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 require_ok('Trog::DataModule') or BAIL_OUT("Can't find SUT");
 require_ok('Trog::Routes::HTML');
@@ -395,11 +395,11 @@ subtest '_wizard_fields zips the parallel arrays' => sub {
     # the row after it -- this is the whole reason param_required is a select.
     my $fields = Trog::Routes::HTML::_wizard_fields(
         {
-            param_name        => [ 'Servings', '',     'cook_time', 'id',   'servings' ],
-            param_type        => [ 'number',   'text', 'textarea',  'text', 'text' ],
-            param_label       => [ 'Servings', '',     'Cook Time', 'ID',   'Dupe' ],
-            param_placeholder => [ '4',        '',     '45 min',    '',     '' ],
-            param_required    => [ 1,          0,      0,           0,      0 ],
+            param_name        => [ 'Servings', '', qw{cook_time id servings} ],
+            param_type        => [qw{number text textarea text text}],
+            param_label       => [ 'Servings', '', 'Cook Time', 'ID', 'Dupe' ],
+            param_placeholder => [ '4',        '', '45 min',    '',   '' ],
+            param_required    => [ 1,          0,  0,           0,    0 ],
         }
     );
 

t/Trog-DataSource-DirIndex.t

@@ -6,10 +6,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};

t/Trog-DataSource-ProvisionedVirt.t

@@ -6,10 +6,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};
@@ -430,14 +430,14 @@ subtest 'the state a reprovision leaves behind' => sub {
 
     # Nothing waits on the process which does the work, so this file is the
     # whole of what it can say for itself.
-    $write->( 'state=ok', 'started=100', 'finished=200', 'exit=0', 'user=admin' );
+    $write->(qw{state=ok started=100 finished=200 exit=0 user=admin});
     my $got = Trog::DataSource::ProvisionedVirt::status('guest.example.com');
     is( $got->{state},    'ok',    'a finished run reads back as finished' );
     is( $got->{exit},     '0',     'with what it exited' );
     is( $got->{user},     'admin', 'and who asked for it' );
     is( $got->{finished}, '200',   'and when it stopped' );
 
-    $write->( 'state=failed', 'exit=3', 'failed=/x/bin/provision' );
+    $write->(qw{state=failed exit=3 failed=/x/bin/provision});
     is( Trog::DataSource::ProvisionedVirt::status('guest.example.com')->{state}, 'failed', 'a failed one reads back failed' );
 
     # A live pid means it really is going on.  Ours is alive by definition.

t/Trog-DataSource-Virt.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
@@ -9,7 +9,7 @@ use Path::Tiny();
 use JSON::MaybeXS();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 # Nothing in this file may ever reach a real hypervisor.  Every libvirt object
 # here is a fake that records what was asked of it, which is the only safe way
@@ -27,16 +27,16 @@ our @CALLS;
 
     package FakeDomain;
     sub new             { my ( $c, %a ) = @_; return bless {%a}, $c }
-    sub get_name        { $_[0]{name} }
-    sub get_uuid_string { $_[0]{uuid} }
-    sub is_active       { $_[0]{active} }
-    sub get_info        { { state => $_[0]{state}, memory => 1024, nrVirtCpu => 2 } }
+    sub get_name        { return $_[0]{name} }
+    sub get_uuid_string { return $_[0]{uuid} }
+    sub is_active       { return $_[0]{active} }
+    sub get_info        { return { state => $_[0]{state}, memory => 1024, nrVirtCpu => 2 } }
 
     # The operations we must never actually perform: record and return.
-    sub create          { push @main::CALLS, [ 'create',          $_[0]{name} ]; 1 }
-    sub shutdown        { push @main::CALLS, [ 'shutdown',        $_[0]{name} ]; 1 }
-    sub destroy         { push @main::CALLS, [ 'destroy',         $_[0]{name} ]; 1 }
-    sub create_snapshot { push @main::CALLS, [ 'create_snapshot', $_[0]{name} ]; 1 }
+    sub create          { push @main::CALLS, [ 'create',          $_[0]{name} ]; return 1 }
+    sub shutdown        { push @main::CALLS, [ 'shutdown',        $_[0]{name} ]; return 1 }
+    sub destroy         { push @main::CALLS, [ 'destroy',         $_[0]{name} ]; return 1 }
+    sub create_snapshot { push @main::CALLS, [ 'create_snapshot', $_[0]{name} ]; return 1 }
 
     # Reading a console is not a mutation, so this one really runs.
     sub screenshot { return 'image/png' }
@@ -45,16 +45,16 @@ our @CALLS;
 {
 
     package FakeStream;
-    sub new      { bless {}, shift }
+    sub new      { return bless {}, shift }
     sub recv_all { my ( $self, $cb ) = @_; $cb->( $self, 'fake-png-bytes' ); return 1 }
-    sub finish   { 1 }
+    sub finish   { return 1 }
 }
 
 {
 
     package FakeConn;
-    sub new        { bless {}, shift }
-    sub new_stream { FakeStream->new() }
+    sub new        { return bless {}, shift }
+    sub new_stream { return FakeStream->new() }
 
     sub list_all_domains {
         return (
@@ -163,7 +163,7 @@ subtest 'act() drives the right libvirt call, and only on request' => sub {
 
     foreach my $action ( sort keys %expected ) {
         @CALLS = ();
-        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, 'test:///default', 'alpha', 'specadmin' );
+        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, qw{test:///default alpha specadmin} );
         ok( $ok, "$action succeeded" ) or diag($message);
         is_deeply( \@CALLS, [ [ $expected{$action}, 'alpha' ] ], "$action called $expected{$action} on the named guest, once" );
     }
@@ -172,22 +172,22 @@ subtest 'act() drives the right libvirt call, and only on request' => sub {
 subtest 'act() refuses what it should' => sub {
     @CALLS = ();
 
-    my ( $ok, $message ) = Trog::DataSource::Virt::act( 'rm-rf', 'test:///default', 'alpha', 'specadmin' );
+    my ( $ok, $message ) = Trog::DataSource::Virt::act(qw{rm-rf test:///default alpha specadmin});
     ok( !$ok, 'an action we do not define is refused' );
     like( $message, qr/not[ ]something[ ]we[ ]do/, 'and says so' );
 
-    ( $ok, $message ) = Trog::DataSource::Virt::act( 'destroy', 'test:///default', '../../etc/passwd', 'specadmin' );
+    ( $ok, $message ) = Trog::DataSource::Virt::act(qw{destroy test:///default ../../etc/passwd specadmin});
     ok( !$ok, 'a guest name that is a path is refused' );
     like( $message, qr/bad[ ]guest[ ]name/, 'before any connection is made' );
 
-    ( $ok, $message ) = Trog::DataSource::Virt::act( 'destroy', 'test:///default', 'nosuchguest', 'specadmin' );
+    ( $ok, $message ) = Trog::DataSource::Virt::act(qw{destroy test:///default nosuchguest specadmin});
     ok( !$ok, 'a guest that is not there is refused' );
     like( $message, qr/no[ ]guest[ ]called/, 'rather than acting on some other one' );
 
     is_deeply( \@CALLS, [], 'and none of those touched a guest' );
 
     $connect_fails = 1;
-    ( $ok, $message ) = Trog::DataSource::Virt::act( 'poweroff', 'test:///default', 'alpha', 'specadmin' );
+    ( $ok, $message ) = Trog::DataSource::Virt::act(qw{poweroff test:///default alpha specadmin});
     $connect_fails = 0;
     ok( !$ok, 'an unreachable hypervisor is refused' );
     like( $message, qr/could[ ]not[ ]reach/, 'and reported' );
@@ -203,7 +203,7 @@ subtest 'act() will not take the server down with it' => sub {
 
     foreach my $action (qw{poweroff destroy}) {
         @CALLS = ();
-        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, 'test:///default', 'alpha', 'specadmin' );
+        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, qw{test:///default alpha specadmin} );
         ok( !$ok, "$action on the guest we are running in is refused" );
         like( $message, qr/is[ ]this[ ]server/, 'saying why' );
         is_deeply( \@CALLS, [], "and the $action never reached libvirt" );
@@ -213,14 +213,14 @@ subtest 'act() will not take the server down with it' => sub {
     # less useful than one that can.
     foreach my $action (qw{snapshot poweron}) {
         @CALLS = ();
-        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, 'test:///default', 'alpha', 'specadmin' );
+        my ( $ok, $message ) = Trog::DataSource::Virt::act( $action, qw{test:///default alpha specadmin} );
         ok( $ok, "$action is still allowed on it" ) or diag($message);
         is( scalar @CALLS, 1, 'and reached libvirt' );
     }
 
     # Its neighbours are ordinary guests.
     @CALLS = ();
-    my ($ok) = Trog::DataSource::Virt::act( 'destroy', 'test:///default', 'beta', 'specadmin' );
+    my ($ok) = Trog::DataSource::Virt::act(qw{destroy test:///default beta specadmin});
     ok( $ok, 'another guest on the same hypervisor is unaffected' );
     is_deeply( \@CALLS, [ [ 'destroy', 'beta' ] ], 'and is destroyed as asked' );
 };
@@ -247,6 +247,7 @@ subtest 'the guest cache is scoped per hypervisor' => sub {
     # Two hypervisors, each with a guest called 'alpha' -- which is the normal
     # state of affairs, not a corner case.
     my $root = Path::Tiny->tempdir();
+    no warnings 'once';
     local $Trog::DataSource::Virt::screenshot_dir = "$root";
 
     my @paths;
@@ -280,7 +281,7 @@ subtest 'the datasource hook only loads what it should' => sub {
 
     # The namespace restriction is the point: a sidecar is a file on disk, and
     # it must not be able to make us require an arbitrary module.
-    foreach my $bad ( 'Trog::Routes::HTML', 'File::Path', '../../etc/passwd', 'Trog::DataSource::Virt::act' ) {
+    foreach my $bad (qw{Trog::Routes::HTML File::Path ../../etc/passwd Trog::DataSource::Virt::act}) {
         $declared = $bad;
         is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, "'$bad' is refused as a datasource" );
     }
@@ -306,6 +307,7 @@ subtest 'the guest routes avoid the router\'s own query keys' => sub {
     # the screenshot and action routes at a guest named after the web host.
     my @reserved = qw{domain route method scheme port user acls to};
 
+    no warnings 'once';
     my $captures = $Trog::Routes::HTML::routes{'/guest/screenshot/(.*)/(.*)'}{captures};
     foreach my $capture (@$captures) {
         ok( !( grep { $_ eq $capture } @reserved ), "the screenshot route's '$capture' capture is not a router key" );

t/Trog-DataSource.t

@@ -7,10 +7,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::Fatal qw{exception};
@@ -99,7 +99,7 @@ subtest 'searchable_match' => sub {
     ok( Trog::DataSource::searchable_match( 'ell', 'hello' ),       'a substring matches' );
     ok( Trog::DataSource::searchable_match( 'ELL', 'hello' ),       'case insensitively' );
     ok( Trog::DataSource::searchable_match( 'x', 'a', undef, 'x' ), 'across several values' );
-    ok( !Trog::DataSource::searchable_match( 'zz', 'a', 'b' ),      'and misses when it should' );
+    ok( !Trog::DataSource::searchable_match(qw{zz a b}),            'and misses when it should' );
 
     ok( !Trog::DataSource::searchable_match( '',    'anything' ), 'an empty search matches nothing' );
     ok( !Trog::DataSource::searchable_match( undef, 'anything' ), 'and neither does no search' );
@@ -248,8 +248,8 @@ BEGIN {
         push @FILTERED, $q->{like};
         return grep { $_->{title} eq 'beta' } @p;
     }
-    sub lang { 'Picky search' }
-    sub help { 'https://example.com/picky' }
+    sub lang { return 'Picky search' }
+    sub help { return 'https://example.com/picky' }
 
     # One whose filter blows up.
     package Trog::DataSource::TestBroken;

t/Trog-Log-DBI.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::Fatal   qw{exception};
@@ -8,7 +8,7 @@ use Capture::Tiny qw{capture_stderr};
 use File::Temp    qw{tempdir};
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Trog::SQLite;
 

t/Trog-Log-Syslog.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::NoWarnings;
@@ -11,7 +11,7 @@ use Socket qw{SOCK_DGRAM};
 use Log::Dispatch;
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 require_ok('Trog::Log::Syslog') or BAIL_OUT("Can't find SUT");
 

t/Trog-Routes-HTML-config.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Cwd();
@@ -9,7 +9,7 @@ use File::Temp();
 use Path::Tiny();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 # The config editor is built out of config/default.cfg rather than a hardcoded
 # list of fields, so what it can edit is whatever that file describes.  These

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

@@ -27,10 +27,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 
@@ -148,7 +148,7 @@ foreach my $form ( sort keys(%EXPECT) ) {
         # empty one behind to type the next field into, and a type with no
         # custom fields at all gets that row and nothing else.
         is_deeply(
-            [ sort grep { length } @{ field_names() } ],
+            [ sort grep { $_ } @{ field_names() } ],
             [ sort @{ $expect->{fields} } ],
             'and only the fields somebody typed in are offered as custom ones'
         );

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

@@ -10,7 +10,7 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use File::Temp ();

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

@@ -10,13 +10,13 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 # FindBin MUST come first.  $FindBin::Bin is derived from $0, which prove hands
 # us relatively, and it is computed once.  chdir before this loads and every
 # module's `use FindBin::libs` resolves against the sandbox instead of the repo.
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Cwd           ();
@@ -76,7 +76,7 @@ sub _copy_tree {
             no_chdir => 1,
             wanted   => sub {
                 my $rel = substr( $File::Find::name, length($from) );
-                return unless length $rel;
+                return unless $rel;
                 my $dst = "$to$rel";
                 if    ( -d $File::Find::name ) { File::Path::make_path($dst) }
                 elsif ( -f $File::Find::name ) { File::Copy::copy( $File::Find::name, $dst ) or die "copy $File::Find::name: $!" }
@@ -189,14 +189,14 @@ require Trog::Routes::JSON;
         }, $class;
     }
 
-    sub INFO  { 1 }
-    sub DEBUG { 1 }
-    sub WARN  { 1 }
-    sub ERROR { 1 }
-    sub CRIT  { 1 }
-    sub ALERT { 1 }
-    sub EMERG { 1 }
-    sub FATAL { 1 }
+    sub INFO  { return 1 }
+    sub DEBUG { return 1 }
+    sub WARN  { return 1 }
+    sub ERROR { return 1 }
+    sub CRIT  { return 1 }
+    sub ALERT { return 1 }
+    sub EMERG { return 1 }
+    sub FATAL { return 1 }
 
     sub see_also           { return [ 303, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
     sub redirect           { return [ 302, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
@@ -581,7 +581,7 @@ subtest 'a datasource-backed series searches and paginates' => sub {
     is( $code, 200, 'the datasource-backed type was created' ) or diag($err);
 
     _reindex();
-    my $series = _make_series( 'spec_guests', 'specguests', 'spec_guests.tx', 'Spec Guests Series', no_topbar => 1 ) or return;
+    my $series = _make_series( qw{spec_guests specguests spec_guests.tx}, 'Spec Guests Series', no_topbar => 1 ) or return;
 
     # Twelve guests, every one stamped with the same created -- which is what
     # libvirt guests really are, and precisely what the cursor paginator cannot
@@ -672,7 +672,7 @@ subtest 'an ordinary series survives a page number in its URL' => sub {
     # its own page.  Latent until the datasource paginator started emitting page
     # numbers, and it was never about datasources.
     _reindex();
-    _make_series( 'spec_paged', 'specpaged', 'blog.tx', 'Spec Paged Series', no_topbar => 1 ) or return;
+    _make_series( qw{spec_paged specpaged blog.tx}, 'Spec Paged Series', no_topbar => 1 ) or return;
 
     foreach my $n ( 1, 2 ) {
         _save_post(
@@ -729,7 +729,7 @@ subtest 'a directory index series' => sub {
 
     _reindex();
     my $series = _make_series(
-        'spec_files', 'specfiles', 'spec_files.tx', 'Spec Files Series',
+        qw{spec_files specfiles spec_files.tx}, 'Spec Files Series',
         no_topbar => 1,
         directory => 'assets/spec_downloads',
     ) or return;
@@ -864,15 +864,15 @@ subtest 'a field can be declared indexed' => sub {
             # The middle row is the one that matters: its box is clear, and the
             # wizard zips these arrays together positionally, so if a clear box
             # ever submitted nothing the flag would land on the wrong field.
-            param_name          => [ 'cook_time', 'garnish', 'serves' ],
-            param_type          => [ 'text',      'text',    'number' ],
+            param_name          => [qw{cook_time garnish serves}],
+            param_type          => [qw{text text number}],
             param_label         => [ 'Cook Time', 'Garnish', 'Serves' ],
             param_placeholder   => [ '',          '',        '' ],
             param_required      => [ 0,           0,         0 ],
             param_private       => [ 0,           0,         0 ],
             param_indexed       => [ 1,           0,         1 ],
-            param_relation_form => [ 'blog.tx',   'blog.tx', 'blog.tx' ],
-            param_relation_mode => [ 'one',       'one',     'one' ],
+            param_relation_form => [qw{blog.tx blog.tx blog.tx}],
+            param_relation_mode => [qw{one one one}],
             display             => q{<div class="ct"><: $post.cook_time :></div>},
         ),
         \&Trog::Routes::HTML::post_wizard_save,
@@ -905,7 +905,7 @@ subtest 'a field can be declared indexed' => sub {
 
     # A post of the type still saves and reads back the same as any other.
     _reindex();
-    _make_series( 'spec_indexed', 'specindexed', 'spec_indexed.tx', 'Spec Indexed Series', no_topbar => 1 ) or return;
+    _make_series( qw{spec_indexed specindexed spec_indexed.tx}, 'Spec Indexed Series', no_topbar => 1 ) or return;
     my $child = _save_post(
         'spec_indexed child',
         form       => 'spec_indexed.tx',
@@ -954,7 +954,7 @@ subtest 'a field can be declared editors-only' => sub {
 
     _reindex();
 
-    _make_series( 'spec_secretive', 'specsecretive', 'spec_secretive.tx', 'Spec Secretive Series', no_topbar => 1 ) or return;
+    _make_series( qw{spec_secretive specsecretive spec_secretive.tx}, 'Spec Secretive Series', no_topbar => 1 ) or return;
     my $child = _save_post(
         'spec_secretive child',
         form       => 'spec_secretive.tx',
@@ -1054,7 +1054,7 @@ our ( $PAYEE, $PAYOR );
 
 subtest 'entities' => sub {
     my $title = 'Spec Entities Series';
-    _make_series( 'entities', 'specentities', 'entities.tx', $title ) or return;
+    _make_series( qw{entities specentities entities.tx}, $title ) or return;
 
     $PAYEE = _save_post(
         'entities payee child',
@@ -1094,7 +1094,7 @@ subtest 'entities' => sub {
 
 subtest 'blog' => sub {
     my $title = 'Spec Blog Series';
-    _make_series( 'blog', 'specblog', 'blog.tx', $title ) or return;
+    _make_series( qw{blog specblog blog.tx}, $title ) or return;
 
     my $child = _save_post(
         'blog child',
@@ -1117,7 +1117,7 @@ subtest 'blog' => sub {
 
 subtest 'microblog' => sub {
     my $title = 'Spec Microblog Series';
-    _make_series( 'microblog', 'specmicroblog', 'microblog.tx', $title ) or return;
+    _make_series( qw{microblog specmicroblog microblog.tx}, $title ) or return;
 
     my $child = _save_post(
         'microblog child',
@@ -1139,7 +1139,7 @@ subtest 'microblog' => sub {
 
 subtest 'file' => sub {
     my $title = 'Spec File Series';
-    _make_series( 'file', 'specfile', 'file.tx', $title ) or return;
+    _make_series( qw{file specfile file.tx}, $title ) or return;
 
     # _handle_upload MOVES the file, so it has to be created fresh here.
     my $src = "$ROOT/upload-src/spec-upload.txt";
@@ -1179,7 +1179,7 @@ subtest 'file' => sub {
 
 subtest 'presentation' => sub {
     my $title = 'Spec Presentation Series';
-    _make_series( 'presentation', 'specpresentation', 'presentation.tx', $title ) or return;
+    _make_series( qw{presentation specpresentation presentation.tx}, $title ) or return;
 
     my $child = _save_post(
         'presentation child',
@@ -1203,7 +1203,7 @@ subtest 'presentation' => sub {
 
 subtest 'invoice' => sub {
     my $title = 'Spec Invoice Series';
-    _make_series( 'invoice', 'specinvoice', 'invoice.tx', $title ) or return;
+    _make_series( qw{invoice specinvoice invoice.tx}, $title ) or return;
 
     my %invoice = (
         form          => 'invoice.tx',
@@ -1265,7 +1265,7 @@ subtest 'a private post is not served to a visitor who asks for it by id' => sub
 
 subtest 'spec_widget (the wizard-built type)' => sub {
     my $title = 'Spec Widget Series';
-    _make_series( 'spec_widget', 'specwidget', 'spec_widget.tx', $title ) or return;
+    _make_series( qw{spec_widget specwidget spec_widget.tx}, $title ) or return;
 
     my $child = _save_post(
         'spec_widget child',
@@ -1364,7 +1364,7 @@ subtest 'a wizard-built type can depend on another type' => sub {
     _reindex();
 
     # Now exercise it end to end.
-    _make_series( 'spec_target', 'spectarget', 'spec_target.tx', 'Spec Target Series', no_topbar => 1 ) or return;
+    _make_series( qw{spec_target spectarget spec_target.tx}, 'Spec Target Series', no_topbar => 1 ) or return;
     my $target = _save_post(
         'spec_target child',
         form       => 'spec_target.tx',
@@ -1375,7 +1375,7 @@ subtest 'a wizard-built type can depend on another type' => sub {
         to         => '/spectarget',
     ) or return;
 
-    _make_series( 'spec_relator', 'specrelator', 'spec_relator.tx', 'Spec Relator Series', no_topbar => 1 ) or return;
+    _make_series( qw{spec_relator specrelator spec_relator.tx}, 'Spec Relator Series', no_topbar => 1 ) or return;
     my $relator = _save_post(
         'spec_relator child',
         form       => 'spec_relator.tx',

t/Trog-SQLite-TagIndex.t

@@ -1,6 +1,6 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Cwd        ();
@@ -9,7 +9,7 @@ use File::Path ();
 use File::Temp ();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use_ok('Trog::SQLite::TagIndex') or BAIL_OUT("Can't find SUT");
 

t/Trog-Themes-themed-templates.t

@@ -1,13 +1,13 @@
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
 use Path::Tiny();
 use FindBin;
 
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 require_ok('Trog::Themes') or BAIL_OUT("Can't find SUT");
 
@@ -77,19 +77,39 @@ subtest 'themed_file_in_dir prefers the theme, falls back to stock' => sub {
     $themedir = "$root/www/themes/spec";
 
     is(
-        Trog::Themes::themed_file_in_dir( 'forms', 'blog.json', 'text/html', 1 ),
+        Trog::Themes::themed_file_in_dir( qw{forms blog.json text/html}, 1 ),
         "$theme/blog.json", "the theme's copy wins"
     );
     is(
-        Trog::Themes::themed_file_in_dir( 'forms', 'series.json', 'text/html', 1 ),
+        Trog::Themes::themed_file_in_dir( qw{forms series.json text/html}, 1 ),
         "$stock/series.json", "one the theme lacks falls back"
     );
     is(
-        Trog::Themes::themed_file_in_dir( 'forms', 'nope.json', 'text/html', 1 ),
+        Trog::Themes::themed_file_in_dir( qw{forms nope.json text/html}, 1 ),
         undef, "and one nobody has is undef, not a path that doesn't exist"
     );
 };
 
+subtest 'routes: a theme ships routes.pm under a dir relative to the tCMS root' => sub {
+    my $site = Path::Tiny->tempdir();
+    $site->child('www/themes/routed')->mkpath;
+    $site->child('www/themes/routed/routes.pm')->spew_utf8(<<'PM');
+package Theme;
+our %routes = ( '/spec-themed' => { method => 'GET' } );
+1;
+PM
+
+    my $was = Path::Tiny->cwd;
+    chdir $site or die "chdir $site: $!";
+    $themedir = 'www/themes/routed';
+    my %routes = eval { Trog::Themes::routes() };
+    my $err    = $@;
+    chdir $was or die "chdir $was: $!";
+
+    is( $err, '', 'it loads' );
+    is_deeply( [ keys %routes ], ['/spec-themed'], 'and the routes are the ones it declared' );
+};
+
 subtest 'an empty or missing dir is not fatal' => sub {
     $themedir = "$root/www/themes/spec";
     is_deeply( Trog::Themes::themed_templates_in_dir( 'nosuchdir', 'text/html', 1 ), [], "just an empty list" );

t/Trog-Vault.t

@@ -6,10 +6,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};
@@ -77,6 +77,10 @@ subtest 'what a secret looks like on disk' => sub {
     is( $row->{key_id},         Trog::Vault::key_id(), 'naming the key it was sealed under' );
 
     is( Trog::Vault::get( 'bob', 'keepass' ), 'correct horse battery staple', 'and it comes back out' );
+
+    ( $ok, $why ) = Trog::Vault::set(qw{bob pin 0});
+    is( $ok,                              1,   'a secret of "0" is a secret, not nothing' ) or diag($why);
+    is( Trog::Vault::get( 'bob', 'pin' ), '0', 'and comes back out' );
 };
 
 subtest 'a fresh salt every write' => sub {
@@ -369,6 +373,7 @@ subtest 'the page a user manages them from' => sub {
         *FakeTPSGI::forbidden = sub { return [ 403, [], ['no'] ] };
     }
 
+    no warnings 'once';
     my $route = $Trog::Routes::HTML::routes{'/secrets'};
     ok( $route,                 'the page is a route' );
     ok( $route->{auth},         'behind a login' );

t/bin-migrate.t

@@ -7,10 +7,10 @@
 
 use 5.040;
 use re '/aasx';
-use warnings;
+use warnings FATAL => 'all';
 
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use FindBin::libs;
 
 use Test::More;
 use Test::MockModule qw{strict};