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 os-autoinst#30.

.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,20 +15,21 @@ if (
   )
 {
 
-#<<<  do not let perltidy touch this
+#<<<  do not let perltidy nor perlcritic touch this
+## no critic (TestingAndDebugging::ProhibitNoStrict)
 # This is not our code, and formatting should stay the same for
 # better comparison with new versions of B::Deparse
 # <---- PATCH
 package B::Deparse;
 no warnings 'redefine';
 no strict 'refs';
 
-*{"B::Deparse::walk_lineseq"} = sub {
+*{'B::Deparse::walk_lineseq'} = sub {
 
     my ($self, $op, $kids, $callback) = @_;
     my @kids = @$kids;
     for (my $i = 0; $i < @kids; $i++) {
-	my $expr = "";
+	my $expr = '';
 	if (is_state $kids[$i]) {
         # Patch for:
         # Use of uninitialized value $expr in concatenation (.) or string at /usr/lib/perl5/5.26.1/B/Deparse.pm line 1794.
@@ -40,7 +41,7 @@ no strict 'refs';
 	}
 	if (is_for_loop($kids[$i])) {
 	    $callback->($expr . $self->for_loop($kids[$i], 0),
-		$i += $kids[$i]->sibling->name eq "unstack" ? 2 : 1);
+		$i += $kids[$i]->sibling->name eq 'unstack' ? 2 : 1);
 	    next;
 	}
 	my $expr2 = $self->deparse($kids[$i], (@kids != 1)/2) // ''; # prevent undef $expr2
@@ -60,7 +61,5 @@ 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";
 }
-
-1;
-
-
+## 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,61 @@
+# 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 $stmnts_ref = $doc->find($self->_generate_is_use_strict());
+
+    # Bail if there's none.
+    return unless $stmnts_ref;
+
+    # Bail out if there's only one. TestingAndDebugging::RequireUseStrict will report
+    # that there's no use strict/warnings.
+    return if scalar @{$stmnts_ref} == 1;
+
+    # If the 'use strict' or 'use warnings' statement is present as well as a
+    # module already providing that behavior, -> it violates.
+
+    my @viols;
+
+    for my $stmnt (@{$stmnts_ref}) {
+        # skip pragmas
+        next if $stmnt->pragma();
+        # Report the equivalent module.
+        push @viols, $self->violation($policy_title, sprintf($policy_explanation, $stmnt), $stmnt);
+    }
+    return @viols;
+}
+
+1;
+

tools/perlcritic

@@ -0,0 +1,24 @@
+#!/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 = ();
+    foreach my $path (@extra_paths) {
+        push @paths, "$Bin/../$path";
+        push @paths, "$Bin/../external/os-autoinst-common/$path";
+    }
+
+    # 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,16 +12,16 @@ use Getopt::Long;
 use FindBin qw($Bin);
 
 GetOptions(
-    "help|h" => \my $help,
-    "specfile=s" => \my $specfile,
-    "dockerfile=s" => \my $dockerfile,
+    'help|h' => \my $help,
+    'specfile=s' => \my $specfile,
+    'dockerfile=s' => \my $dockerfile,
 );
 
 usage(0) if $help;
 usage(1) unless $specfile;
 
 my $scriptname = path(__FILE__)->to_rel("$Bin/..");
-my $yamlfile = "dependencies.yaml";
+my $yamlfile = 'dependencies.yaml';
 my $file = "$Bin/../$yamlfile";
 my $cpanfile = "$Bin/../cpanfile";
 

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;
 }