From: Andrew Dunstan <andrew.dunstan@2ndquadrant.com>
Subject: Re: cleaning perl code
To: Alvaro Herrera <alvherre@2ndquadrant.com>
Cc: Noah Misch <noah@leadboat.com>,
 PostgreSQL-development <pgsql-hackers@postgresql.org>
References: <20200414204432.GA22922@alvherre.pgsql>
Autocrypt: addr=andrew.dunstan@2ndQuadrant.com; prefer-encrypt=mutual;
 keydata=
 mQENBE7KWFkBCAClridxur2AIc7eW2AR7izbfp3EnNefie2HbLF0izW5Ik5UjX2HBXBx4syI
 gY6b0ugohXrr274+baoAlvSbq6cAoQuEVrk5IZFzt20b1Xkx65FwGSEj526yiKLocqkJceSq
 Xr9xcA5SGY+FZv441chh5SU92v4q6z+6LPpoHOh97ptAVXZYNTtU0LevyvD5lja0TzbvJm6C
 eFXitJfnm1pLEr0DGJCR/iUOl/N62Kh4855zZC7NHIjQHPOvV5Stz/l5ilDhvGVk+xkXFPys
 SjZoUr1rXhYLpiyi5sR0X9FHXT0KnGuz1F5ERO7ZTLSSQ6fJwPj6gOk9K+vvoKvoeql5ABEB
 AAG0L0FuZHJldyBEdW5zdGFuIDxhbmRyZXcuZHVuc3RhbkAybmRRdWFkcmFudC5jb20+iQFY
 BBMBAgBCAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgBYhBOQ+WEYd/Hy/RGkVpZn6f8tZ
 /DuBAhkBBQJd1pSYBQkSzqMsAAoJEJn6f8tZ/DuBJmEIAIVFBIC3qGqh+YTPVTkfowwxpHz0
 tZSPjZ6GS/5y62kgoZrZOVXw+Rg2ceuMM3a+In/RRjTx4bembgYqRKgzXlDfiNBJeq5ioVuN
 H1faDKE2lm5a6QkRQ2JU6DKf60fqSJGP5LisCUr1V0wz6EnlO31ArrKtXCNB+yk0KDAS6o6I
 Ql4pkXpr+vq4iilwJmiJOqTBam0LmQE7ulYCCYU8Z6MkpiSl+dO7QSramcGyxauQRI3a7gcq
 dpo8Vrv3gFTQDeMYxk7cqZp08pIVH5XR0+LgBz4X84f59rA/VAKlC/r6CyEQk59rvDLxCMyP
 2buoj51Z25N3MVghRDGcsU6mT7e5AQ0ETspYWQEIANGc4zQULOxhbqO2dyD51YhqCNRmm9oK
 Waqf+wmW4tpDe/VVcxAnNizd4LWCHfzpb5cHAtGkOPePMfzWVf6nvdF7d3eglbtf59+zG7O7
 llV0xSSoFiieQBsrGvqDInXYX/4mRRXMtyhM353/tixC9RWLs1oofyYmCPPXXY7h9R7en3B8
 BoVrRFcdzlIY/NFNhFGW/9dkEiGjgna2Rk6e15kln4ZvFBWUg23p93w/pqXcxY6+k/8TEk+C
 4R+M6w7o2PLGOjdZ+kPiUcw5H85zf/yZJwQXzisXaNduwWB6Vads9YC9dj6kPR1c4VGRqAaY
 L++LAEOqrlvm2TvqQqZRtnEAEQEAAYkBJQQYAQIADwIbDAUCXdaUtAUJEs6jVQAKCRCZ+n/L
 Wfw7gQi5B/9sHbmRloZNCWWwZGm+O9iG/JGQxS0WWa4GaZqzqSTWOft2/gO0Bgag89r1djq4
 PFgSZtzHvKQpqYz/7HkPrWh1jpcS83i/uYY1uyHXUUtpdEmn4buNObEtD0YNaJkGdhASsECq
 6akw+u7WJYmAHs/SpR6ok6HqLw7JHDVc2h5dViLfTk0qrgDa7sq/LVMoJje5Ct/Ku3YaWAV6
 YSmzoPP5BmPVFqP11OMQkCqurIu9vTLXKFWX623vCmqRDHJ6e5GCDHbH8USU+4wJBfPymZkd
 cA7NGm/mmWeJiWBFIDyjzYxrjku8ty9TZJVsaRXnS+OFQzXz9Eu2wTpKdHij46uY
Message-ID: <86b0e20d-efc1-4169-aeb1-be49b3a375ab@2ndQuadrant.com>
Date: Wed, 15 Apr 2020 15:43:36 -0400
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101
 Thunderbird/68.6.0
MIME-Version: 1.0
In-Reply-To: <20200414204432.GA22922@alvherre.pgsql>
Content-Type: multipart/mixed;
 boundary="------------CBB30451E7C12FDB43F532C5"
Content-Language: en-US
Precedence: bulk

This is a multi-part message in MIME format.
--------------CBB30451E7C12FDB43F532C5
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 7bit


On 4/14/20 4:44 PM, Alvaro Herrera wrote:
> On 2020-Apr-14, Andrew Dunstan wrote:
>
>> One of the things that's a bit sad is that perlcritic doesn't generally
>> let you apply policies to a given set of files or files matching some
>> pattern. It would be nice, for instance, to be able to apply some
>> additional standards to strategic library files like PostgresNode.pm,
>> TestLib.pm and Catalog.pm. There are good reasons as suggested upthread
>> to apply higher standards to library files than to, say, a TAP test
>> script. The only easy way I can see to do that would be to have two
>> different perlcriticrc files and adjust pgperlcritic to make two runs.
>> If people think that's worth it I'll put a little work into it. If not,
>> I'll just leave things here.
> I think being more strict about it in strategic files (I'd say that's
> Catalog.pm plus src/test/perl/*.pm) might be a good idea.  Maybe give it
> a try and see what comes up.
>


OK, in fact those files are in reasonably good shape. I also took a pass
through the library files in src/tools/msvc, which had a few more issues.


Here's a patch that does the stricter testing for those library files,
and fixes them so we get a clean pass


This brings to an end my perl gardening project.


cheers


andrew


-- 
Andrew Dunstan                https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services


--------------CBB30451E7C12FDB43F532C5
Content-Type: text/x-patch; charset=UTF-8;
 name="pgperlcritic-libraries.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="pgperlcritic-libraries.patch"

diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index dd39a086ce..bd9eac0c80 100644
--- a/src/backend/catalog/Catalog.pm
+++ b/src/backend/catalog/Catalog.pm
@@ -67,7 +67,7 @@ sub ParseHeader
 		if (!$is_client_code)
 		{
 			# Strip C-style comments.
-			s;/\*(.|\n)*\*/;;g;
+			s;/\*(?:.|\n)*\*/;;g;
 			if (m;/\*;)
 			{
 
@@ -260,7 +260,9 @@ sub ParseData
 				# We're treating the input line as a piece of Perl, so we
 				# need to use string eval here. Tell perlcritic we know what
 				# we're doing.
-				eval '$hash_ref = ' . $_;   ## no critic (ProhibitStringyEval)
+				## no critic (ProhibitStringyEval)
+				## no critic (RequireCheckingReturnValueOfEval)
+				eval '$hash_ref = ' . $_;
 				if (!ref $hash_ref)
 				{
 					die "$input_file: error parsing line $.:\n$_\n";
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 1d5450758e..5249053ee2 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -385,7 +385,7 @@ sub set_replication_conf
 	$self->host eq $test_pghost
 	  or croak "set_replication_conf only works with the default host";
 
-	open my $hba, '>>', "$pgdata/pg_hba.conf";
+	open my $hba, '>>', "$pgdata/pg_hba.conf" || die;
 	print $hba "\n# Allow replication (set up by PostgresNode.pm)\n";
 	if ($TestLib::windows_os && !$TestLib::use_unix_sockets)
 	{
@@ -439,7 +439,7 @@ sub init
 	TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata,
 		@{ $params{auth_extra} });
 
-	open my $conf, '>>', "$pgdata/postgresql.conf";
+	open my $conf, '>>', "$pgdata/postgresql.conf" || die;
 	print $conf "\n# Added by PostgresNode.pm\n";
 	print $conf "fsync = off\n";
 	print $conf "restart_after_crash = off\n";
@@ -1254,7 +1254,7 @@ END
 		$node->clean_node if $exit_code == 0 && TestLib::all_tests_passing();
 	}
 
-	$? = $exit_code;
+	$? = $exit_code;  ## no critic (RequireLocalizedPunctuationVars)
 }
 
 =pod
@@ -1462,8 +1462,8 @@ sub psql
 	# https://metacpan.org/pod/release/ETHER/Try-Tiny-0.24/lib/Try/Tiny.pm
 	do
 	{
-		local $@;
-		eval {
+		local $@ = "";
+		eval { ## no critic (RequireCheckingReturnValueOfEval)
 			my @ipcrun_opts = (\@psql_params, '<', \$sql);
 			push @ipcrun_opts, '>',  $stdout if defined $stdout;
 			push @ipcrun_opts, '2>', $stderr if defined $stderr;
@@ -2074,8 +2074,8 @@ sub pg_recvlogical_upto
 
 	do
 	{
-		local $@;
-		eval {
+		local $@ = "";
+		eval { ## no critic (RequireCheckingReturnValueOfEval)
 			IPC::Run::run(\@cmd, ">", \$stdout, "2>", \$stderr, $timeout);
 			$ret = $?;
 		};
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 0e6c4819e4..fd3bbc1979 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -162,6 +162,8 @@ INIT
 	open my $testlog, '>', $test_logfile
 	  or die "could not open STDOUT to logfile \"$test_logfile\": $!";
 
+	# don't need to  check the result of these dup operations
+	## no critic (RequireCheckedOpen)
 	# Hijack STDOUT and STDERR to the log file
 	open(my $orig_stdout, '>&', \*STDOUT);
 	open(my $orig_stderr, '>&', \*STDERR);
@@ -409,7 +411,7 @@ Return the full contents of the specified file.
 sub slurp_file
 {
 	my ($filename) = @_;
-	local $/;
+	local $/ = undef;
 	my $contents;
 	if ($Config{osname} ne 'MSWin32')
 	{
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm
index e65ac6fc66..34797d97c3 100644
--- a/src/tools/msvc/Install.pm
+++ b/src/tools/msvc/Install.pm
@@ -12,9 +12,8 @@ use File::Basename;
 use File::Copy;
 use File::Find ();
 
-use Exporter;
-our (@ISA, @EXPORT_OK);
-@ISA       = qw(Exporter);
+use Exporter qw(import);
+our (@EXPORT_OK);
 @EXPORT_OK = qw(Install);
 
 my $insttype;
@@ -45,7 +44,7 @@ sub lcopy
 
 sub Install
 {
-	$| = 1;
+	STDOUT->autoflush(1);
 
 	my $target = shift;
 	$insttype = shift;
@@ -56,9 +55,8 @@ sub Install
 	our $config = shift;
 	unless ($config)
 	{
-
 		# suppress warning about harmless redeclaration of $config
-		no warnings 'misc';
+		no warnings 'misc'; ## no critic (ProhibitNoWarnings)
 		do "./config_default.pl";
 		do "./config.pl" if (-f "config.pl");
 	}
@@ -158,7 +156,7 @@ sub Install
 		File::Find::find(
 			{
 				wanted => sub {
-					/^(.*--.*\.sql|.*\.control)\z/s
+					/^(?:.*--.*\.sql|.*\.control)\z/s
 					  && push(@$pl_extension_files, $File::Find::name);
 
 					# Don't find files of in-tree temporary installations.
diff --git a/src/tools/msvc/MSBuildProject.pm b/src/tools/msvc/MSBuildProject.pm
index ebb169e201..aaa3d573ab 100644
--- a/src/tools/msvc/MSBuildProject.pm
+++ b/src/tools/msvc/MSBuildProject.pm
@@ -1,3 +1,6 @@
+
+## no critic (ProhibitMultiplePackages,ProhibitUnusedPrivateSubroutines)
+
 package MSBuildProject;
 
 #
@@ -11,7 +14,7 @@ use strict;
 use warnings;
 use base qw(Project);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic (ProhibitNoWarnings)
 
 sub _new
 {
@@ -145,8 +148,11 @@ EOF
 	{
 		confess "Bad format filename '$fileNameWithPath'\n"
 		  unless ($fileNameWithPath =~ m!^(.*)/([^/]+)\.(c|cpp|y|l|rc)$!);
+		# perlcritic is a bit stupid here
+		## no critic (ProhibitCaptureWithoutTest)
 		my $dir      = $1;
 		my $fileName = $2;
+		## use critic
 		if ($fileNameWithPath =~ /\.y$/ or $fileNameWithPath =~ /\.l$/)
 		{
 			push @grammarFiles, $fileNameWithPath;
@@ -415,7 +421,7 @@ use strict;
 use warnings;
 use base qw(MSBuildProject);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic (ProhibitNoWarnings)
 
 sub new
 {
@@ -440,7 +446,7 @@ use strict;
 use warnings;
 use base qw(MSBuildProject);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
@@ -465,7 +471,7 @@ use strict;
 use warnings;
 use base qw(MSBuildProject);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
@@ -490,7 +496,7 @@ use strict;
 use warnings;
 use base qw(MSBuildProject);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm
index 72a21dbd41..7f67c3582f 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -18,9 +18,8 @@ use Config;
 use VSObjectFactory;
 use List::Util qw(first);
 
-use Exporter;
-our (@ISA, @EXPORT_OK);
-@ISA       = qw(Exporter);
+use Exporter qw(import);
+our (@EXPORT_OK);
 @EXPORT_OK = qw(Mkvcbuild);
 
 my $solution;
@@ -106,9 +105,9 @@ sub mkvcbuild
 	  sprompt.c strerror.c tar.c thread.c
 	  win32env.c win32error.c win32security.c win32setlocale.c);
 
-	push(@pgportfiles, 'strtof.c') if ($vsVersion < '14.00');
+	push(@pgportfiles, 'strtof.c') if ($vsVersion < 14.00);
 
-	if ($vsVersion >= '9.00')
+	if ($vsVersion >= 9.00)
 	{
 		push(@pgportfiles, 'pg_crc32c_sse42_choose.c');
 		push(@pgportfiles, 'pg_crc32c_sse42.c');
@@ -212,7 +211,7 @@ sub mkvcbuild
 	$snowball->RelocateFiles(
 		'src/backend/snowball/libstemmer',
 		sub {
-			return shift !~ /(dict_snowball.c|win32ver.rc)$/;
+			return shift !~ /(?:dict_snowball.c|win32ver.rc)$/;
 		});
 	$snowball->AddIncludeDir('src/include/snowball');
 	$snowball->AddReference($postgres);
@@ -598,6 +597,7 @@ sub mkvcbuild
 			unlink $source_file;
 			open my $o, '>', $source_file
 			  || croak "Could not write to $source_file";
+			## no critic (ProhibitHardTabs)
 			print $o '
 	/* compare to plperl.h */
 	#define __inline__ __inline
@@ -627,6 +627,7 @@ sub mkvcbuild
 		}
 	}
 ';
+			## use critic
 			close $o;
 
 			# Build $source_file with a given #define, and return a true value
@@ -649,8 +650,7 @@ sub mkvcbuild
 
 					# Some builds exhibit runtime failure through Perl warning
 					# 'Can't spawn "conftest.exe"'; suppress that.
-					no warnings;
-
+					no warnings; ## no critic (ProhibitNoWarnings)
 					no strict 'subs'; ## no critic (ProhibitNoStrict)
 
 					# Disable error dialog boxes like we do in the postmaster.
diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm
index 20f79b382b..c2e82960aa 100644
--- a/src/tools/msvc/Project.pm
+++ b/src/tools/msvc/Project.pm
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 use File::Basename;
 
-sub _new
+sub _new  ## no critic (ProhibitUnusedPrivateSubroutines)
 {
 	my ($classname, $name, $type, $solution) = @_;
 	my $good_types = {
@@ -278,6 +278,8 @@ sub AddDir
 		my @pieces = split /\s+/, $match;
 		foreach my $fn (@pieces)
 		{
+			# Deliberately ignore errors from ReplaceFile about files not found
+			## no critic (RequireCheckingReturnValueOfEval)
 			if ($top eq "(top_srcdir)")
 			{
 				eval { $self->ReplaceFile($fn, $target) };
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index 545bdcef7b..d9550c3e9e 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -1,3 +1,6 @@
+
+## no critic (ProhibitMultiplePackages,ProhibitUnusedPrivateSubroutines)
+
 package Solution;
 
 #
@@ -10,7 +13,7 @@ use strict;
 use warnings;
 use VSObjectFactory;
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub _new
 {
@@ -157,20 +160,22 @@ sub GenerateFiles
 	  || confess("Could not open configure.in for reading\n");
 	while (<$c>)
 	{
-		if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[([^\]]*)\], \[([^\]]+)\]/)
+		if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[(?:[^\]]*)\], \[([^\]]+)\]/)
 		{
 			$ac_init_found = 1;
 
 			$package_name      = $1;
 			$package_version   = $2;
 			$package_bugreport = $3;
-			#$package_tarname   = $4;
-			$package_url       = $5;
+			#$package_tarname   = non-capturing-group;
+			$package_url       = $4;
 
 			if ($package_version !~ /^(\d+)(?:\.(\d+))?/)
 			{
 				confess "Bad format of version: $self->{strver}\n";
 			}
+			# perlcritic is a bit stupid here
+			## no critic (ProhibitCaptureWithoutTest)
 			$majorver = sprintf("%d", $1);
 			$minorver = sprintf("%d", $2 ? $2 : 0);
 		}
@@ -519,7 +524,7 @@ sub GenerateFiles
 		my ($digit1, $digit2, $digit3) = $self->GetOpenSSLVersion();
 
 		# More symbols are needed with OpenSSL 1.1.0 and above.
-		if ($digit1 >= '1' && $digit2 >= '1' && $digit3 >= '0')
+		if ($digit1 >= 1 && $digit2 >= 1 && $digit3 >= 0)
 		{
 			$define{HAVE_ASN1_STRING_GET0_DATA} = 1;
 			$define{HAVE_BIO_GET_DATA}          = 1;
@@ -931,7 +936,7 @@ sub AddProject
 		# changed their library names from:
 		# - libeay to libcrypto
 		# - ssleay to libssl
-		if ($digit1 >= '1' && $digit2 >= '1' && $digit3 >= '0')
+		if ($digit1 >= 1 && $digit2 >= 1 && $digit3 >= 0)
 		{
 			my $dbgsuffix;
 			my $libsslpath;
@@ -1166,7 +1171,7 @@ use strict;
 use warnings;
 use base qw(Solution);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
@@ -1194,7 +1199,7 @@ use strict;
 use warnings;
 use base qw(Solution);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
@@ -1222,7 +1227,7 @@ use strict;
 use warnings;
 use base qw(Solution);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
@@ -1250,7 +1255,7 @@ use strict;
 use warnings;
 use base qw(Solution);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub new
 {
diff --git a/src/tools/msvc/VSObjectFactory.pm b/src/tools/msvc/VSObjectFactory.pm
index e6983b241f..dd8cc4952e 100644
--- a/src/tools/msvc/VSObjectFactory.pm
+++ b/src/tools/msvc/VSObjectFactory.pm
@@ -1,3 +1,6 @@
+
+## no critic (ProhibitMultiplePackages)
+
 package VSObjectFactory;
 
 #
@@ -10,16 +13,15 @@ use Carp;
 use strict;
 use warnings;
 
-use Exporter;
+use Exporter qw(import);
 use Project;
 use Solution;
 use MSBuildProject;
 
-our (@ISA, @EXPORT);
-@ISA    = qw(Exporter);
+our (@EXPORT);
 @EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion);
 
-no warnings qw(redefine);    ## no critic
+no warnings qw(redefine);    ## no critic  (ProhibitNoWarnings)
 
 sub CreateSolution
 {
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index e230111b23..27b4af1892 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -22,3 +22,30 @@ verbose = %f: %m at line %l, column %c.  %e.  ([%p] Severity: %s)\n
 # insist on use of the warnings pragma
 [TestingAndDebugging::RequireUseWarnings]
 severity = 5
+
+
+# sev 4
+[-Modules::ProhibitAutomaticExportation]
+[-InputOutput::RequireBriefOpen]
+[-Subroutines::RequireArgUnpacking]
+[Variables::RequireLocalizedPunctuationVars]
+allow = %ENV %SIG
+[-Objects::ProhibitIndirectSyntax]
+[TestingAndDebugging::ProhibitProlongedStrictureOverride]
+statements = 10
+[-BuiltinFunctions::RequireBlockGrep]
+[TestingAndDebugging::ProhibitNoWarnings]
+allow = once
+
+# sev 3
+[-ErrorHandling::RequireCarping]
+[-RegularExpressions::RequireExtendedFormatting]
+[-Variables::ProhibitPackageVars]
+[-ControlStructures::ProhibitCascadingIfElse]
+[-Subroutines::ProhibitExcessComplexity]
+[-ValuesAndExpressions::ProhibitImplicitNewlines]
+[-Subroutines::ProhibitManyArgs]
+[-InputOutput::ProhibitBacktickOperators]
+[-BuiltinFunctions::ProhibitLvalueSubstr]
+[-ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[-RegularExpressions::ProhibitComplexRegexes]
diff --git a/src/tools/perlcheck/pgperlcritic b/src/tools/perlcheck/pgperlcritic
index 1c2f787580..08edd86427 100755
--- a/src/tools/perlcheck/pgperlcritic
+++ b/src/tools/perlcheck/pgperlcritic
@@ -14,7 +14,21 @@ PERLCRITIC=${PERLCRITIC:-perlcritic}
 
 . src/tools/perlcheck/find_perl_files
 
-find_perl_files | xargs $PERLCRITIC \
+flist=`mktemp`
+find_perl_files > $flist
+
+pattern='src/test/perl/|src/backend/catalog/Catalog.pm|src/tools/msvc/[^/]*.pm'
+
+# normal sev 5 critic
+egrep -v  "$pattern" < $flist | xargs $PERLCRITIC \
 	  --quiet \
 	  --program-extensions .pl \
 	  --profile=src/tools/perlcheck/perlcriticrc
+
+# more strict sev 3 critic for some library files
+egrep  "$pattern" < $flist | xargs $PERLCRITIC --severity 3 \
+	  --quiet \
+	  --program-extensions .pl \
+	  --profile=src/tools/perlcheck/perlcriticrc
+
+rm -f $flist

--------------CBB30451E7C12FDB43F532C5--