Unify Perl Critic

- Introducing `tools/perlcritic` an improved wrapper over
  perl's `perlcritic`.

  It automatically appends this project's policies that are
  defined under the `openqa` theme.

- Adds a complementary GitHub Action to run `tools/perlcritic`
  automatically on Pull Requests & Master.

- Fixed `perlcritics` complaints.

Branched off #30.

Co-authored-by: Oliver Kurz <okurz@suse.de>
Co-authored-by: Martchus <martchus@gmx.net>

.github/workflows/perl-critic.yml

@@ -0,0 +1,17 @@
+---
+name: 'Perl critic'
+
+on:
+  pull_request:
+  push:
+    branches:
+      - 'master'
+
+ perl-critic-checks:
+    runs-on: ubuntu-latest
+    name: "Perlcritic"
+    container:
+      image: perldocker/perl-tester
+    steps:
+      - uses: actions/checkout@v4
+      - run: ./tools/perlcritic --quiet .

.perlcriticrc

@@ -0,0 +1,49 @@
+theme = community + openqa
+severity = 4
+include = strict ValuesAndExpressions::ProhibitInterpolationOfLiterals
+
+verbose = ::warning file=%f,line=%l,col=%c,title=%m - severity %s::[%p] %e\n
+
+# == Perlcritic Policies
+# -- Test::Most brings in strict & warnings
+[TestingAndDebugging::RequireUseStrict]
+equivalent_modules = Test::Most
+
+[TestingAndDebugging::RequireUseWarnings]
+equivalent_modules = Test::Most
+
+# -- Avoid double quotes unless there's interpolation or a single quote.
+[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+allow_if_string_contains_single_quote = 1
+severity = 3
+
+# -- Prohibit deep nesting
+[ControlStructures::ProhibitDeepNests]
+severity = 4
+add_themes = community
+max_nests = 4
+
+# == Community Policies
+# -- Test::Most brings in strict & warnings
+[Freenode::StrictWarnings]
+extra_importers = Test::Most
+
+# -- Test::Most brings in strict & warnings
+[Community::StrictWarnings]
+extra_importers = Test::Most
+
+[Community::DiscouragedModules]
+severity = 3
+
+# Test modules have no package declaration
+[Community::PackageMatchesFilename]
+severity = 1
+
+# == Custom Policies
+# -- Useless quotes on hashes
+[HashKeyQuotes]
+severity = 5
+
+# -- Superfluous use strict/warning.
+[RedundantStrictWarning]
+equivalent_modules = Test::Most

lib/OpenQA/Test/PatchDeparse.pm

@@ -15,7 +15,8 @@ if (
   )
 {
 
-#<<<  do not let perltidy touch this
+#<<<  do not let perltidy nor perlcritic touch this
+## no critic (TestingAndDebugging::ProhibitNoStrict ValuesAndExpressions::ProhibitInterpolationOfLiterals)
 # This is not our code, and formatting should stay the same for
 # better comparison with new versions of B::Deparse
 # <---- PATCH
@@ -60,7 +61,7 @@ elsif ($B::Deparse::VERSION) {
     diag
       "Using B::Deparse v$B::Deparse::VERSION. If you see 'uninitialized' warnings, update patch in t/lib/OpenQA/Test/PatchDeparse.pm";
 }
-
+## use critic
 1;
 
 

lib/perlcritic/Perl/Critic/Policy/ArgumentInUseStrictWarnings.pm

@@ -0,0 +1,42 @@
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+package Perl::Critic::Policy::ArgumentInUseStrictWarnings;
+
+use strict;
+use warnings;
+use experimental 'signatures';
+use base 'Perl::Critic::Policy';
+
+use Perl::Critic::Utils qw( :severities :classification :ppi );
+
+our $VERSION = '0.0.1';
+
+sub default_severity { return $SEVERITY_HIGH }
+sub default_themes { return qw(openqa) }
+sub applies_to { return qw(PPI::Statement::Include) }
+
+my $desc = q{use strict/warnings with arguments};
+my $expl = q{Remove argument from: %s.};
+
+# check that use use strict and warnings don't have arguments.
+sub violates ($self, $elem, $document) {
+    # skip if it's not a use
+    return unless $elem->type() eq 'use';
+    # skip if it's not a pragma
+    return unless my $pragma = $elem->pragma();
+    # skip if it's not warnings or strict
+    return unless ($pragma eq 'warnings' || $pragma eq 'strict');
+
+    my @args = $elem->arguments();
+    # skip if it doesn't have arguments
+    return if scalar(@args) == 0;
+
+    # allow promoting warnings to FATAL
+    return if scalar(grep { $_->content eq 'FATAL' } @args);
+
+    # Report the problem.
+    return $self->violation($desc, sprintf($expl, $elem), $elem);
+}
+
+1;

lib/perlcritic/Perl/Critic/Policy/HashKeyQuotes.pm

@@ -0,0 +1,34 @@
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+package Perl::Critic::Policy::HashKeyQuotes;
+
+use strict;
+use warnings;
+use experimental 'signatures';
+use base 'Perl::Critic::Policy';
+
+use Perl::Critic::Utils qw( :severities :classification :ppi );
+
+our $VERSION = '0.0.1';
+
+sub default_severity { return $SEVERITY_HIGH }
+sub default_themes { return qw(openqa) }
+sub applies_to { return qw(PPI::Token::Quote::Single PPI::Token::Quote::Double) }
+
+# check that hashes are not overly using quotes
+# (os-autoinst coding style)
+sub violates ($self, $elem, $document) {
+    #we only want the check hash keys
+    return if !is_hash_key($elem);
+
+    my $c = $elem->content;
+    # special characters
+    return if $c =~ m/[- \/<>.=_:\\\$\|]/;
+
+    my $desc = q{Hash key with quotes};
+    my $expl = q{Avoid useless quotes};
+    return $self->violation($desc, $expl, $elem);
+}
+
+1;

lib/perlcritic/Perl/Critic/Policy/RedundantStrictWarning.pm

@@ -0,0 +1,56 @@
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+package Perl::Critic::Policy::RedundantStrictWarning;
+
+use strict;
+use warnings;
+use version 0.77;
+use experimental 'signatures';
+
+use base 'Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict';
+use Perl::Critic::Utils qw{ $EMPTY };
+use Perl::Critic::Utils::Constants qw{ :equivalent_modules };
+
+our $VERSION = '0.0.1';
+my $policy_title = q{Superfluoux use of strict/warning};
+my $policy_explanation = q{%s is equivalent to 'use strict; use warnings;'};
+
+sub default_themes { return qw(openqa) }
+
+sub supported_parameters {
+    return (
+        {
+            name => 'equivalent_modules',
+            description =>
+              q<The additional modules to treat as equivalent to "strict" or "warnings".>,
+            default_string => $EMPTY,
+            behavior => 'string list',
+            list_always_present_values => ['warnings', 'strict', @STRICT_EQUIVALENT_MODULES],
+        },
+    );
+}
+
+# check that use strict/warnings is not present when equivalent modules are.
+sub violates ($self, $, $doc) {
+    # Find all equivalents of use strict/warnings.
+    my $use_stmts = $doc->find($self->_generate_is_use_strict());
+
+    # Bail if there's none.
+    return unless $use_stmts;
+
+    # Bail out if there's only one. TestingAndDebugging::RequireUseStrict will report
+    # that there's no use strict/warnings.
+    return if scalar @{$use_stmts} == 1;
+
+    # If the 'use strict' or 'use warnings' statement is present as well as a
+    # module already providing that behavior, -> it violates.
+    return map { $self->_make_violation($_) } grep { !$_->pragma() } @{$use_stmts};
+}
+
+sub _make_violation ($self, $statement) {
+    return $self->violation($policy_title, sprintf($policy_explanation, $statement), $statement);
+}
+
+1;
+

tools/perlcritic

@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+#
+# perlcritic with auto-injection of custom perlcritic rules.
+use strict;
+use warnings;
+use experimental 'signatures';
+use FindBin '$Bin';
+
+sub extra_include_paths (@extra_paths) {
+    my @paths = map { ("$Bin/../$_", "$Bin/../external/os-autoinst-common/$_") } @extra_paths;
+
+    # Remove non existing paths
+    return grep { -e $_ } @paths;
+}
+
+$ENV{PERL5LIB} = join(':', (extra_include_paths('lib/perlcritic'), $ENV{PERL5LIB} // ''));
+
+exec 'perlcritic', @ARGV;

tools/update-deps

@@ -12,10 +12,10 @@ use Getopt::Long;
 use FindBin qw($Bin);
 
 GetOptions(
-    "help|h" => \my $help,
-    "cpanfile" => \my $cpanfile,
-    "specfile=s" => \my $specfile,
-    "dockerfile=s" => \my $dockerfile,
+    'help|h' => \my $help,
+    cpanfile => \my $cpanfile,
+    'specfile=s' => \my $specfile,
+    'dockerfile=s' => \my $dockerfile,
 );
 
 usage(0) if $help;
@@ -24,7 +24,7 @@ usage(1) unless ($cpanfile || $specfile || $dockerfile);
 my $proj_root = "$Bin/..";
 
 my $scriptname = path(__FILE__)->to_rel($proj_root);
-my $dependencies_yaml_location = "dependencies.yaml";
+my $dependencies_yaml_location = 'dependencies.yaml';
 my $file = "$proj_root/$dependencies_yaml_location";
 my $cpanfile_location = "$proj_root/cpanfile";
 
@@ -84,7 +84,7 @@ EOM
 }
 
 sub update_spec {
-    my $spec = path($specfile)->slurp if $specfile;
+    my $spec = path($specfile)->slurp;
 
     for my $target (@$spectargets) {
         my $name = $target . '_requires';

xt/01-make-update-deps.t

@@ -7,7 +7,7 @@ use Test::Warnings;
 use FindBin '$Bin';
 
 if (not -e "$Bin/../.git") {
-    pass("Skipping all tests, not in a git repository");
+    pass('Skipping all tests, not in a git repository');
     done_testing;
     exit;
 }