Merge pull request #368 from Troglodyne-Internet-Widgets/more-policies

Enable six more critic policies

.perlcriticrc

@@ -64,7 +64,7 @@ strict = 1
 [ValuesAndExpressions::ConstantBeforeLt]
 [ValuesAndExpressions::ProhibitDuplicateHashKeys]
 # any access checks are necessarily a TOCTOU waiting to happen
-#[ValuesAndExpressions::ProhibitFiletest_f]
+[ValuesAndExpressions::ProhibitFiletest_f]
 [ValuesAndExpressions::ProhibitFiletest_rwxRWX]
 # Bikeshed
 [CognitiveComplexity::ProhibitExcessCognitiveComplexity]
@@ -78,7 +78,7 @@ formats = #!/usr/bin/env perl
 # Performance
 [logicLAB::ProhibitShellDispatch]
 [ProhibitPipeOpen]
-#[Performance::ProhibitRegexForSimpleSubstring]
+[Performance::ProhibitRegexForSimpleSubstring]
 [RegularExpressions::ProhibitRegexToStripAffix]
 [RegularExpressions::ProhibitRegexToChomp]
 [BuiltinFunctions::ProhibitChainingSameListSub]
@@ -98,7 +98,10 @@ formats = #!/usr/bin/env perl
 [ErrorHandling::RequireCheckedIndirectResults]
 exclude_functions = print
 [ProhibitUseLib]
-#[ProhibitUsageSubs]
+[ProhibitUsageSubs]
+# tCMS: help() is the interface of a data model and a datasource that links
+# the documentation of its query language, so it is not a usage message.
+sub_names = usage _usage print_usage usage_message
 [RequireQwForLiteralLists]
 [ProhibitNoWarningsRedefine]
 [RequireFatalWarnings]
@@ -128,7 +131,7 @@ allow = re Exporter
 # Perl::Critic::Distribution, as ProhibitUnusedDefinitions does, so the two
 # 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]
+[ProhibitMisplacedMethods]
 [ProhibitPrintSTDERR]
 [InputOutput::ProhibitRepeatedPrints]
 # Perl::Critic's own policies.  only = 1 loads nothing that is not named, so
@@ -214,11 +217,15 @@ stop_words_file = .pod_stopwords
 [Miscellanea::ProhibitUnrestrictedNoCritic]
 #[Miscellanea::ProhibitUselessNoCritic]
 [Modules::ProhibitAutomaticExportation]
-#[Modules::ProhibitConditionalUseStatements]
+[Modules::ProhibitConditionalUseStatements]
 [Modules::RequireBarewordIncludes]
 [Modules::RequireFilenameMatchesPackage]
 [Modules::RequireNoMatchVarsWithUseEnglish]
-#[NamingConventions::Capitalization]
+[NamingConventions::Capitalization]
+# tCMS: each renderer is named for the content type it renders, and each
+# script's package for the script.  The policy tests each part of a package
+# name on its own, so these are the parts.
+package_exemptions = main tcms login useradd blob css email html javascript json text
 [RegularExpressions::ProhibitCaptureWithoutTest]
 #[RegularExpressions::ProhibitComplexRegexes]
 [RegularExpressions::ProhibitEnumeratedClasses]

lib/Trog/Auth.pm

@@ -142,10 +142,10 @@ sub username2classname ($name) {
 
     # Users are always self-authored, you see
 
-    my $user_obj = List::Util::first { ( $_->{user} || '' ) eq $name } @userposts;
-    my $NNname   = $user_obj->{id} || '';
-    $NNname =~ tr/-/_/;
-    return "a_$NNname";
+    my $user_obj  = List::Util::first { ( $_->{user} || '' ) eq $name } @userposts;
+    my $classname = $user_obj->{id} || '';
+    $classname =~ tr/-/_/;
+    return "a_$classname";
 }
 
 =head2 acls4user(STRING username) = ARRAYREF

lib/Trog/Data.pm

@@ -62,8 +62,8 @@ sub model ($config) {
     return $model if -e $sqlite_db;
 
     my $posts = eval {
-        scalar grep { -f } Path::Tiny::path($flatfile_store)->children;
-    } or return $model;    ## no critic (ProhibitFiletest_f) -- counting names, nothing is opened
+        scalar grep { -f } Path::Tiny::path($flatfile_store)->children;    ## no critic (ProhibitFiletest_f) -- counting names, nothing is opened
+    } or return $model;
 
     WARN("general.data_model is SQLite, but $sqlite_db does not exist and $flatfile_store holds $posts post(s).  Serving them from FlatFile.  Run bin/migrate.pl to move them across.");
     return 'FlatFile';

lib/Trog/Routes/HTML.pm

@@ -1117,8 +1117,8 @@ sub get_datasources {
         my $dir = "$incdir/Trog/DataSource";
         next unless -d $dir;
         my @modules = eval {
-            grep { -f } Path::Tiny::path($dir)->children(qr/[.]pm\z/);
-        } or next;    ## no critic (ProhibitFiletest_f) -- building an allowlist of names
+            grep { -f } Path::Tiny::path($dir)->children(qr/[.]pm\z/);    ## no critic (ProhibitFiletest_f) -- building an allowlist of names
+        } or next;
         $found{ "Trog::DataSource::" . $_->basename('.pm') } = 1 foreach @modules;
     }
     return [ sort keys(%found) ];

lib/Trog/Themes.pm

@@ -208,8 +208,8 @@ sub forms_dir {
 my sub read_dir ( $dir, $ext ) {
     return [] unless -d $dir;
     my @files = eval {
-        grep { -f } Path::Tiny::path($dir)->children(qr/[.]\Q$ext\E\z/);
-    };    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
+        grep { -f } Path::Tiny::path($dir)->children(qr/[.]\Q$ext\E\z/);    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
+    };
     return [ map { $_->basename } @files ];
 }
 

t/Trog-Config.t

@@ -55,8 +55,8 @@ subtest 'a config written to home_cfg is the one that gets read back' => sub {
     $written->param( 'general.hostname',   'spec.example.com' );
     ok( $written->write($Trog::Config::home_cfg), 'wrote to home_cfg' );
 
-    ok( -f 'config/main.cfg', 'which landed under config/, not the instance root' );
-    ok( !-f 'main.cfg',       'and not loose in the root where nothing would read it' );
+    ok( -e 'config/main.cfg', 'which landed under config/, not the instance root' );
+    ok( !-e 'main.cfg',       'and not loose in the root where nothing would read it' );
 
     my $read = Trog::Config::get();
     is( $read->param('general.title'),    'Instance',         'get() picked up the written config' );

t/Trog-DataModule-schema.t

@@ -33,7 +33,7 @@ $thememock->redefine( 'template_dirs', sub { ("$tempdir") } );
 $thememock->redefine(
     'themed_file_in_dir',
     sub ( $path, $file, @ ) {
-        return -f "$formsdir/$file" ? "$formsdir/$file" : undef;
+        return -e "$formsdir/$file" ? "$formsdir/$file" : undef;
     }
 );
 

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

@@ -17,7 +17,7 @@ use IPC::Run3();
 use FindBin;
 
 my $suite = "$FindBin::Bin/Trog-Routes-HTML-series-lifecycle.t";
-ok( -f $suite, 'the lifecycle suite is there to run' ) or BAIL_OUT("Can't find $suite");
+ok( -e $suite, 'the lifecycle suite is there to run' ) or BAIL_OUT("Can't find $suite");
 
 # Captured rather than inherited: the child speaks TAP too, and two test streams
 # down one pipe is not a test result, it is a parse error.

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

@@ -59,7 +59,8 @@ state sub snapshot {
         {
             no_chdir => 1,
             wanted   => sub {
-                return unless -f $File::Find::name;
+                return unless -e $File::Find::name;
+                return if -d _;
                 my @st = stat(_);
                 $seen{$File::Find::name} = "$st[7]:$st[9]";
             },
@@ -80,7 +81,7 @@ state sub copy_tree {
                 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: $!" }
+                elsif ( -e $File::Find::name ) { File::Copy::copy( $File::Find::name, $dst ) or die "copy $File::Find::name: $!" }
             },
         },
         $from
@@ -393,8 +394,8 @@ sub find_post {
 subtest 'the sandbox is what we are actually running against' => sub {
     is( Cwd::getcwd(), Cwd::abs_path($ROOT), 'cwd is the sandbox' );
     ok( -d 'data/files',         'datastore dir exists' );
-    ok( -f 'config/default.cfg', 'config was seeded' );
-    ok( !-f 'config/main.cfg',   'and there is no main.cfg, so we fall through to the default' );
+    ok( -e 'config/default.cfg', 'config was seeded' );
+    ok( !-e 'config/main.cfg',   'and there is no main.cfg, so we fall through to the default' );
 
     my $conf = Trog::Config::get();
     is( $conf->param('general.data_model'), $MODEL, 'config resolves inside the sandbox' );
@@ -405,7 +406,7 @@ subtest 'the sandbox is what we are actually running against' => sub {
 };
 
 subtest 'registering the first admin bootstraps the install' => sub {
-    ok( !-f 'config/has_users', 'no users yet, so login() is in register mode' );
+    ok( !-e 'config/has_users', 'no users yet, so login() is in register mode' );
 
     my ( $code, undef, $err, $headers ) = render(
         anon(
@@ -424,7 +425,7 @@ subtest 'registering the first admin bootstraps the install' => sub {
     my %h = @{ $headers || [] };
     like( $h{'Set-Cookie'} // '', qr/^tcmslogin=[\da-f-]{36};/, 'a session cookie came back' );
 
-    ok( -f 'config/has_users', 'registration is now closed' );
+    ok( -e 'config/has_users', 'registration is now closed' );
     is_deeply( Trog::Auth::acls4user($ADMIN_USER), ['admin'], 'the new user is an admin' );
 
     reindex();
@@ -460,8 +461,8 @@ subtest 'the post wizard invents a new post type' => sub {
     );
     is( $code, 200, 'wizard save rendered' ) or diag($err);
 
-    ok( -f 'www/templates/html/components/forms/spec_widget.tx',   'the template was written' );
-    ok( -f 'www/templates/html/components/forms/spec_widget.json', 'the schema sidecar was written' );
+    ok( -e 'www/templates/html/components/forms/spec_widget.tx',   'the template was written' );
+    ok( -e 'www/templates/html/components/forms/spec_widget.json', 'the schema sidecar was written' );
 
     # The existing types are a dropdown now, not a list.
     like( $body, qr{<option[ ]value="spec_widget\.tx">}, 'and the new type is listed back to us' );
@@ -1160,7 +1161,7 @@ subtest 'file' => sub {
     ) or return;
 
     ok( !-e $src,                                     'the upload was moved out of its temp location, not copied' );
-    ok( -f "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
+    ok( -e "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
 
     my $body = series_page( 'file', 'specfile', $title, 1 ) or return;
 

t/bin-migrate.t

@@ -197,7 +197,7 @@ subtest 'the flat files are left alone' => sub {
     my @files = Path::Tiny::path('data/files')->children;
 
     is( scalar(@files), 5, 'every post still has its file' );
-    ok( -f 'data/posts.db', "and the flat file model's own index is untouched" );
+    ok( -e 'data/posts.db', "and the flat file model's own index is untouched" );
 
     # Which is what makes going back possible.
     my @still = $flat->get( limit => 0, acls => ['admin'] );