On 4/11/20 12:30 AM, Noah Misch wrote:
> On Thu, Apr 09, 2020 at 11:44:11AM -0400, Andrew Dunstan wrote:
>> 39 Always unpack @_ first
> Requiring a "my @args = @_" does not improve this code:
>
> sub CreateSolution
> {
> ...
> if ($visualStudioVersion eq '12.00')
> {
> return new VS2013Solution(@_);
> }
>
>> 30 Code before warnings are enabled
> Sounds good. We already require "use strict" before code. Requiring "use
> warnings" in the exact same place does not impose much burden.
>
>> 12 Subroutine "new" called using indirect syntax
> No, thanks. "new VS2013Solution(@_)" and "VS2013Solution->new(@_)" are both
> fine; enforcing the latter is an ongoing waste of effort.
>
>> 9 Multiple "package" declarations
> This is good advice if you're writing for CPAN, but it would make PostgreSQL
> code worse by having us split affiliated code across multiple files.
>
>> 9 Expression form of "grep"
> No, thanks. I'd be happier with the opposite, requiring grep(/x/, $arg)
> instead of grep { /x/ } $arg. Neither is worth enforcing.
>
>> 7 Symbols are exported by default
> This is good advice if you're writing for CPAN. For us, it just adds typing.
>
>> 5 Warnings disabled
>> 4 Magic variable "$/" should be assigned as "local"
>> 4 Comma used to separate statements
>> 2 Readline inside "for" loop
>> 2 Pragma "constant" used
>> 2 Mixed high and low-precedence booleans
>> 2 Don't turn off strict for large blocks of code
>> 1 Magic variable "@a" should be assigned as "local"
>> 1 Magic variable "$|" should be assigned as "local"
>> 1 Magic variable "$\" should be assigned as "local"
>> 1 Magic variable "$?" should be assigned as "local"
>> 1 Magic variable "$," should be assigned as "local"
>> 1 Magic variable "$"" should be assigned as "local"
>> 1 Expression form of "map"
> I looked less closely at the rest, but none give me a favorable impression.
I don't have a problem with some of this. OTOH, it's nice to know what
we're ignoring and what we're not.
What I have prepared is first a patch that lowers the severity level to
3 but implements policy exceptions so that nothing is broken. Then 3
patches. One fixes the missing warnings pragma and removes shebang -w
switches, so we are quite consistent about how we do this. I gather we
are agreed about that one. The next one fixes those magic variable
error. That includes using some more idiomatic perl, and in one case
just renaming a couple of variables that are fairly opaque anyway. The
last one fixes the mixture of high and low precedence boolean operators,
the inefficient <FOO> inside a foreach loop, and the use of commas to
separate statements, and relaxes the policy about large blocks with 'no
strict'.
Since I have written them they are attached, for posterity if nothing
else. :-)
>
>
> In summary, among those warnings, I see non-negative value in "Code before
> warnings are enabled" only. While we're changing this, I propose removing
> Subroutines::RequireFinalReturn. Implicit return values were not a material
> source of PostgreSQL bugs, yet we've allowed this to litter our code:
>
That doesn't mean it won't be a source of problems in future, I've
actually been bitten by this in the past.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index da34124595..25b18e84c5 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -590,7 +590,7 @@ EOM
# Special hack to generate OID symbols for pg_type entries
# that lack one.
- if ($catname eq 'pg_type' and !exists $bki_values{oid_symbol})
+ if ($catname eq 'pg_type' && !exists $bki_values{oid_symbol})
{
my $symbol = form_pg_type_symbol($bki_values{typname});
$bki_values{oid_symbol} = $symbol
diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl
index 68d1f517b7..6b27fbf1be 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -44,12 +44,12 @@ line: while (my $S = <$gram>)
my $s;
# Make sure any braces are split
- $s = '{', $S =~ s/$s/ { /g;
- $s = '}', $S =~ s/$s/ } /g;
+ $s = '{'; $S =~ s/$s/ { /g;
+ $s = '}'; $S =~ s/$s/ } /g;
# Any comments are split
- $s = '[/][*]', $S =~ s#$s# /* #g;
- $s = '[*][/]', $S =~ s#$s# */ #g;
+ $s = '[/][*]'; $S =~ s#$s# /* #g;
+ $s = '[*][/]'; $S =~ s#$s# */ #g;
if (!($kcat))
{
diff --git a/src/common/unicode/generate-unicode_combining_table.pl b/src/common/unicode/generate-unicode_combining_table.pl
index e468a5f8c9..c984a903ee 100644
--- a/src/common/unicode/generate-unicode_combining_table.pl
+++ b/src/common/unicode/generate-unicode_combining_table.pl
@@ -18,7 +18,7 @@ print "/* generated by src/common/unicode/generate-unicode_combining_table.pl, d
print "static const struct mbinterval combining[] = {\n";
-foreach my $line (<ARGV>)
+while (my $line = <ARGV>)
{
chomp $line;
my @fields = split ';', $line;
diff --git a/src/common/unicode/generate-unicode_normprops_table.pl b/src/common/unicode/generate-unicode_normprops_table.pl
index c07a04a58a..ec4e8ea72a 100644
--- a/src/common/unicode/generate-unicode_normprops_table.pl
+++ b/src/common/unicode/generate-unicode_normprops_table.pl
@@ -26,7 +26,7 @@ typedef struct
} pg_unicode_normprops;
EOS
-foreach my $line (<ARGV>)
+while (my $line = <ARGV>)
{
chomp $line;
$line =~ s/\s*#.*$//;
diff --git a/src/include/catalog/reformat_dat_file.pl b/src/include/catalog/reformat_dat_file.pl
index 1cadbfd9f4..8bb4d0ab63 100755
--- a/src/include/catalog/reformat_dat_file.pl
+++ b/src/include/catalog/reformat_dat_file.pl
@@ -187,7 +187,7 @@ sub strip_default_values
# It's okay if we have no oid value, since it will be assigned
# automatically before bootstrap.
die "strip_default_values: $catname.$attname undefined\n"
- if !defined $row->{$attname} and $attname ne 'oid';
+ if !defined $row->{$attname} && $attname ne 'oid';
if (defined $column->{default}
and ($row->{$attname} eq $column->{default}))
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 4130da460a..286d6ef122 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -31,21 +31,21 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[Variables::RequireLocalizedPunctuationVars]
allow = %ENV %SIG
+# default is 3 statements for a block with 'no strict'. Allow some more.
+[TestingAndDebugging::ProhibitProlongedStrictureOverride]
+statements = 8
+
# severity 4 policies currently violated
[-BuiltinFunctions::RequireBlockGrep]
[-BuiltinFunctions::RequireBlockMap]
-[-InputOutput::ProhibitReadlineInForLoop]
[-InputOutput::RequireBriefOpen]
[-Modules::ProhibitAutomaticExportation]
[-Modules::ProhibitMultiplePackages]
[-Objects::ProhibitIndirectSyntax]
[-Subroutines::RequireArgUnpacking]
[-TestingAndDebugging::ProhibitNoWarnings]
-[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
-[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
-[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
# severity 3 policies currently violated
diff --git a/contrib/intarray/bench/bench.pl b/contrib/intarray/bench/bench.pl
index daf3febc80..263cf6ca56 100755
--- a/contrib/intarray/bench/bench.pl
+++ b/contrib/intarray/bench/bench.pl
@@ -100,25 +100,25 @@ if ($opt{e})
my $t0 = [gettimeofday];
my $count = 0;
-my $b = $opt{b};
-$b ||= 1;
-my @a;
-foreach (1 .. $b)
+my $opt_b = $opt{b};
+$opt_b ||= 1;
+my @rows;
+foreach (1 .. $opt_b)
{
- @a = exec_sql($dbi, $sql);
- $count = $#a;
+ @rows = exec_sql($dbi, $sql);
+ $count = $#rows;
}
my $elapsed = tv_interval($t0, [gettimeofday]);
if ($opt{o})
{
- foreach (@a)
+ foreach (@rows)
{
print "$_->{mid}\t$_->{sections}\n";
}
}
print sprintf(
"total: %.02f sec; number: %d; for one: %.03f sec; found %d docs\n",
- $elapsed, $b, $elapsed / $b,
+ $elapsed, $opt_b, $elapsed / $opt_b,
$count + 1);
$dbi->disconnect;
diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl
index 702c97bba2..68d1f517b7 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -21,8 +21,8 @@ sub error
return;
}
-$, = ' '; # set output field separator
-$\ = "\n"; # set output record separator
+local $, = ' '; # set output field separator
+local $\ = "\n"; # set output record separator
my %keyword_categories;
$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD';
diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index b61968b7e0..5efafd6e20 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -8,7 +8,7 @@ open(my $in_fh, '<', $ARGV[0]) || die;
chop(my (@words) = <$in_fh>);
close($in_fh);
-$" = "\n";
+local $" = "\n";
my (@result) = sort @words;
print "@result\n";
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 1d5450758e..b55823f356 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -1254,7 +1254,7 @@ END
$node->clean_node if $exit_code == 0 && TestLib::all_tests_passing();
}
- $? = $exit_code;
+ $? = $exit_code; ## no critic (RequireLocalizedPunctuationVars)
}
=pod
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm
index 1a92ed233a..f5b90261f5 100644
--- a/src/tools/msvc/Install.pm
+++ b/src/tools/msvc/Install.pm
@@ -45,7 +45,7 @@ sub lcopy
sub Install
{
- $| = 1;
+ local $| = 1;
my $target = shift;
$insttype = shift;
@@ -762,13 +762,10 @@ sub read_file
{
my $filename = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', $filename) || die "Could not open file $filename\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm
index d90a996d46..20f79b382b 100644
--- a/src/tools/msvc/Project.pm
+++ b/src/tools/msvc/Project.pm
@@ -420,13 +420,10 @@ sub read_file
{
my $filename = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', $filename) || croak "Could not open file $filename\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
@@ -435,15 +432,12 @@ sub read_makefile
{
my $reldir = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', "$reldir/GNUmakefile")
|| open($F, '<', "$reldir/Makefile")
|| confess "Could not open $reldir/Makefile\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 4550928319..4130da460a 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -23,6 +23,14 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
# allow octal constants with leading zeros
[-ValuesAndExpressions::ProhibitLeadingZeros]
+# Require 'local' declarations for assignments to perl magic variables,
+# but don't require local declarations for assignments to %ENV and %SIG, even
+# though many should be local, especially for %ENV.
+# Note: perlcritic doesn't like things like this, even though it's safe:
+# local %ENV = %ENV; $ENV{foo} = 'bar';
+[Variables::RequireLocalizedPunctuationVars]
+allow = %ENV %SIG
+
# severity 4 policies currently violated
[-BuiltinFunctions::RequireBlockGrep]
@@ -38,7 +46,6 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
-[-Variables::RequireLocalizedPunctuationVars]
# severity 3 policies currently violated
diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl
index 25f7efbc58..97484016bb 100755
--- a/src/tools/win32tzlist.pl
+++ b/src/tools/win32tzlist.pl
@@ -60,12 +60,13 @@ $basekey->Close();
# Fetch all timezones currently in the file
#
my @file_zones;
+my $pgtz;
open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
-my $t = $/;
-undef $/;
-my $pgtz = <$tzfh>;
+{
+ local $/ = undef;
+ $pgtz = <$tzfh>;
+}
close($tzfh);
-$/ = $t;
# Attempt to locate and extract the complete win32_tzmap struct
$pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
diff --git a/contrib/intarray/bench/bench.pl b/contrib/intarray/bench/bench.pl
index 92035d6c06..daf3febc80 100755
--- a/contrib/intarray/bench/bench.pl
+++ b/contrib/intarray/bench/bench.pl
@@ -1,6 +1,7 @@
#!/usr/bin/perl
use strict;
+use warnings;
# make sure we are in a sane environment.
use DBI();
diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl
index d2c678bb53..3f2a6e4da2 100755
--- a/contrib/intarray/bench/create_test.pl
+++ b/contrib/intarray/bench/create_test.pl
@@ -3,6 +3,8 @@
# contrib/intarray/bench/create_test.pl
use strict;
+use warnings;
+
print <<EOT;
create table message (
mid int not null,
diff --git a/contrib/seg/seg-validate.pl b/contrib/seg/seg-validate.pl
index b8957ed984..9fa0887e71 100755
--- a/contrib/seg/seg-validate.pl
+++ b/contrib/seg/seg-validate.pl
@@ -1,6 +1,7 @@
#!/usr/bin/perl
use strict;
+use warnings;
my $integer = '[+-]?[0-9]+';
my $real = '[+-]?[0-9]+\.[0-9]+';
diff --git a/contrib/seg/sort-segments.pl b/contrib/seg/sort-segments.pl
index 04eafd92f2..2e3c9734a9 100755
--- a/contrib/seg/sort-segments.pl
+++ b/contrib/seg/sort-segments.pl
@@ -3,6 +3,7 @@
# this script will sort any table with the segment data type in its last column
use strict;
+use warnings;
my @rows;
diff --git a/doc/src/sgml/mk_feature_tables.pl b/doc/src/sgml/mk_feature_tables.pl
index 476e50e66d..ee158cb196 100644
--- a/doc/src/sgml/mk_feature_tables.pl
+++ b/doc/src/sgml/mk_feature_tables.pl
@@ -1,8 +1,9 @@
-# /usr/bin/perl -w
+# /usr/bin/perl
# doc/src/sgml/mk_feature_tables.pl
use strict;
+use warnings;
my $yesno = $ARGV[0];
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index ad24f4dcb9..da34124595 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#----------------------------------------------------------------------
#
# genbki.pl
diff --git a/src/backend/utils/Gen_fmgrtab.pl b/src/backend/utils/Gen_fmgrtab.pl
index 7c68dbec22..b7c7b4c8fa 100644
--- a/src/backend/utils/Gen_fmgrtab.pl
+++ b/src/backend/utils/Gen_fmgrtab.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#-------------------------------------------------------------------------
#
# Gen_fmgrtab.pl
diff --git a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
index 4c8aaf751c..84c9c53541 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
@@ -25,6 +25,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_BIG5.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
index b493a13838..1596b64238 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for GB18030
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
index 4faf597271..092a5b44f5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
@@ -8,6 +8,8 @@
# "euc-jis-2004-std.txt" (http://x0213.org)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
index 86743a4074..1d88c0296e 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
@@ -12,6 +12,8 @@
# organization's ftp site.
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
index a81a7d61ce..b560f9f37e 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
@@ -17,6 +17,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
index b9ec01dd85..0f52183ff5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
@@ -18,6 +18,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
index 779e3f7f01..57e63b4004 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for GB18030
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_GB18030.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl b/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
index c1967e00da..0bcea9e0d4 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
@@ -16,6 +16,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
index cac9a9c87d..b516e91306 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
@@ -8,6 +8,8 @@
# "sjis-0213-2004-std.txt" (http://x0213.org)
use strict;
+use warnings;
+
use convutils;
# first generate UTF-8 --> SHIFT_JIS_2004 table
diff --git a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
index c65091159b..5f4512ec87 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
@@ -11,6 +11,8 @@
# ftp site.
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_SJIS.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_UHC.pl b/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
index 78b982a22e..3282106d7f 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for UHC
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_UHC.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_most.pl b/src/backend/utils/mb/Unicode/UCS_to_most.pl
index 7ff724558d..8a7b26a5c5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_most.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_most.pl
@@ -16,6 +16,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_most.pl';
diff --git a/src/backend/utils/mb/Unicode/convutils.pm b/src/backend/utils/mb/Unicode/convutils.pm
index 1903b345cb..2f64a12ea1 100644
--- a/src/backend/utils/mb/Unicode/convutils.pm
+++ b/src/backend/utils/mb/Unicode/convutils.pm
@@ -6,6 +6,7 @@
package convutils;
use strict;
+use warnings;
use Carp;
use Exporter 'import';
diff --git a/src/backend/utils/sort/gen_qsort_tuple.pl b/src/backend/utils/sort/gen_qsort_tuple.pl
index b6b2ffa7d0..9ed6cfc7ea 100644
--- a/src/backend/utils/sort/gen_qsort_tuple.pl
+++ b/src/backend/utils/sort/gen_qsort_tuple.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# gen_qsort_tuple.pl
@@ -26,6 +26,7 @@
#
use strict;
+use warnings;
my $SUFFIX;
my $EXTRAARGS;
diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl
index a3b34603ef..ee82e64583 100644
--- a/src/bin/psql/create_help.pl
+++ b/src/bin/psql/create_help.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#################################################################
# create_help.pl -- converts SGML docs to internal psql help
@@ -20,6 +20,7 @@
#
use strict;
+use warnings;
my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n";
my $hfile = $ARGV[1] . '.h'
diff --git a/src/interfaces/libpq/test/regress.pl b/src/interfaces/libpq/test/regress.pl
index 3ad638a91b..54db4f1abf 100644
--- a/src/interfaces/libpq/test/regress.pl
+++ b/src/interfaces/libpq/test/regress.pl
@@ -1,6 +1,7 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
+use warnings;
# use of SRCDIR/SUBDIR is required for supporting VPath builds
my $srcdir = $ENV{'SRCDIR'} or die 'SRCDIR environment variable is not set';
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index f41aa80e80..ee1b9bf463 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -1,6 +1,7 @@
# src/pl/plperl/plc_perlboot.pl
use strict;
+use warnings;
use 5.008001;
use vars qw(%_SHARED $_TD);
diff --git a/src/pl/plperl/plperl_opmask.pl b/src/pl/plperl/plperl_opmask.pl
index e4e64b843f..3b33112ff9 100644
--- a/src/pl/plperl/plperl_opmask.pl
+++ b/src/pl/plperl/plperl_opmask.pl
@@ -1,4 +1,4 @@
-#!perl -w
+#!perl
use strict;
use warnings;
diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index b8fc93aab1..b61968b7e0 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -1,6 +1,7 @@
#! /usr/bin/perl
use strict;
+use warnings;
use locale;
open(my $in_fh, '<', $ARGV[0]) || die;
diff --git a/src/test/perl/SimpleTee.pm b/src/test/perl/SimpleTee.pm
index 9de7b1ac32..74409bde6d 100644
--- a/src/test/perl/SimpleTee.pm
+++ b/src/test/perl/SimpleTee.pm
@@ -9,6 +9,7 @@
package SimpleTee;
use strict;
+use warnings;
sub TIEHANDLE
{
diff --git a/src/tools/fix-old-flex-code.pl b/src/tools/fix-old-flex-code.pl
index 2954cf5a72..1bbb7cdb84 100644
--- a/src/tools/fix-old-flex-code.pl
+++ b/src/tools/fix-old-flex-code.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#----------------------------------------------------------------------
#
# fix-old-flex-code.pl
diff --git a/src/tools/msvc/build.pl b/src/tools/msvc/build.pl
index 2e47f24783..3c886fcd49 100644
--- a/src/tools/msvc/build.pl
+++ b/src/tools/msvc/build.pl
@@ -3,6 +3,7 @@
# src/tools/msvc/build.pl
use strict;
+use warnings;
use File::Basename;
use File::Spec;
diff --git a/src/tools/msvc/pgbison.pl b/src/tools/msvc/pgbison.pl
index 490df83367..774d5be059 100644
--- a/src/tools/msvc/pgbison.pl
+++ b/src/tools/msvc/pgbison.pl
@@ -3,6 +3,8 @@
# src/tools/msvc/pgbison.pl
use strict;
+use warnings;
+
use File::Basename;
# assume we are in the postgres source root
diff --git a/src/tools/msvc/pgflex.pl b/src/tools/msvc/pgflex.pl
index aceed5ffd6..26c73dbfad 100644
--- a/src/tools/msvc/pgflex.pl
+++ b/src/tools/msvc/pgflex.pl
@@ -3,6 +3,8 @@
# src/tools/msvc/pgflex.pl
use strict;
+use warnings;
+
use File::Basename;
# silence flex bleatings about file path style
diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl
index 82dca29a61..c39178a93c 100644
--- a/src/tools/msvc/vcregress.pl
+++ b/src/tools/msvc/vcregress.pl
@@ -3,6 +3,7 @@
# src/tools/msvc/vcregress.pl
use strict;
+use warnings;
our $config;
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 5784a0f765..4550928319 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -35,7 +35,6 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[-Subroutines::RequireArgUnpacking]
[-TestingAndDebugging::ProhibitNoWarnings]
[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
-[-TestingAndDebugging::RequireUseWarnings]
[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
diff --git a/src/tools/pginclude/pgcheckdefines b/src/tools/pginclude/pgcheckdefines
index 4edf7fc56e..0a760d6eca 100755
--- a/src/tools/pginclude/pgcheckdefines
+++ b/src/tools/pginclude/pgcheckdefines
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#
# This script looks for symbols that are referenced in #ifdef or defined()
@@ -21,6 +21,7 @@
#
use strict;
+use warnings;
use Cwd;
use File::Basename;
diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl
index cb59ad234a..fcd3f18048 100755
--- a/src/tools/version_stamp.pl
+++ b/src/tools/version_stamp.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#################################################################
# version_stamp.pl -- update version stamps throughout the source tree
@@ -21,6 +21,7 @@
#
use strict;
+use warnings;
# Major version is hard-wired into the script. We update it when we branch
# a new development version.
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 12c09a453e..5784a0f765 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -6,13 +6,77 @@
#
#####################################################################
-severity = 5
+severity = 3
+# ignore any other themes the use might have installed
theme = core
+# print the policy name as well as the normal output
+verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
+
+# Note: for policy descriptions see https://metacpan.org/release/Perl-Critic
+
+# Policy settings. Eventually policies from the "currently violated"
+# sections below should either be addressed via patches or moved to
+# this section.
+
# allow octal constants with leading zeros
[-ValuesAndExpressions::ProhibitLeadingZeros]
-# for now raise severity of this to level 5
-[Subroutines::RequireFinalReturn]
-severity = 5
+# severity 4 policies currently violated
+
+[-BuiltinFunctions::RequireBlockGrep]
+[-BuiltinFunctions::RequireBlockMap]
+[-InputOutput::ProhibitReadlineInForLoop]
+[-InputOutput::RequireBriefOpen]
+[-Modules::ProhibitAutomaticExportation]
+[-Modules::ProhibitMultiplePackages]
+[-Objects::ProhibitIndirectSyntax]
+[-Subroutines::RequireArgUnpacking]
+[-TestingAndDebugging::ProhibitNoWarnings]
+[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
+[-TestingAndDebugging::RequireUseWarnings]
+[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
+[-Variables::RequireLocalizedPunctuationVars]
+
+# severity 3 policies currently violated
+
+[-BuiltinFunctions::ProhibitComplexMappings]
+[-BuiltinFunctions::ProhibitLvalueSubstr]
+[-BuiltinFunctions::ProhibitVoidMap]
+[-BuiltinFunctions::RequireSimpleSortBlock]
+[-ClassHierarchies::ProhibitExplicitISA]
+[-CodeLayout::ProhibitHardTabs]
+[-ControlStructures::ProhibitCascadingIfElse]
+[-ControlStructures::ProhibitDeepNests]
+[-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
+[-ErrorHandling::RequireCarping]
+[-ErrorHandling::RequireCheckingReturnValueOfEval]
+[-InputOutput::ProhibitBacktickOperators]
+[-InputOutput::ProhibitJoinedReadline]
+[-InputOutput::RequireCheckedOpen]
+[-Miscellanea::ProhibitUnrestrictedNoCritic]
+[-Modules::ProhibitConditionalUseStatements]
+[-Modules::ProhibitExcessMainComplexity]
+[-NamingConventions::ProhibitAmbiguousNames]
+[-RegularExpressions::ProhibitCaptureWithoutTest]
+[-RegularExpressions::ProhibitComplexRegexes]
+[-RegularExpressions::ProhibitUnusedCapture]
+[-RegularExpressions::RequireExtendedFormatting]
+[-Subroutines::ProhibitExcessComplexity]
+[-Subroutines::ProhibitManyArgs]
+[-Subroutines::ProhibitUnusedPrivateSubroutines]
+[-TestingAndDebugging::RequireTestLabels]
+[-ValuesAndExpressions::ProhibitImplicitNewlines]
+[-ValuesAndExpressions::ProhibitMismatchedOperators]
+[-ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters]
+[-ValuesAndExpressions::ProhibitVersionStrings]
+[-ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[-Variables::ProhibitPackageVars]
+[-Variables::ProhibitReusedNames]
+[-Variables::ProhibitUnusedVariables]
+[-Variables::RequireInitializationForLocalVars]
+
+# EOF
