I posted this about 18 months ago but then ran out of steam. In the
meantime, some people have been going around doing various Perl code
cleanups in parts of the code, so it seems it makes sense to proceed
with this. We use "use strict" everywhere now, so some of the original
patch has gone away. Here is an updated patch. The testing
instructions below still apply. Especially welcome would be ideas on
how to address some of the places I have marked with ## no critic.
On 8/31/15 23:57, Peter Eisentraut wrote:
> We now have 80+ Perl files in our tree, and it's growing. Some of those
[actually >=117 now]
> files were originally written for Perl 4, and the coding styles and
> quality are quite, uh, divergent. So I figured it's time to clean up
> that code a bit. I ran perlcritic over the tree and cleaned up all the
> warnings at level 5 (the default, least severe).
>
> Testing guidelines:
>
> - Many files are part of the regular build or test process.
>
> - msvc files need to be tested separately. I tested as best as I could
> on a non-Windows system.
>
> - There are a couple of one-offs in contrib and src/test that need to be
> run manually.
>
> - The stuff under utils/mb/Unicode/
[has already been cleaned up separately]
> To install perlcritic, run
>
> cpan -i Perl::Critic
>
> and then run
>
> perlcritic .
>
> at the top of the tree (or a subdirectory).
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
From af08d7e1b7a947a3f94bb1cef7508c3f926cc35a Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <pete...@gmx.net>
Date: Wed, 4 Jan 2017 12:00:00 -0500
Subject: [PATCH v2 1/2] Clean up Perl code according to perlcritic severity
level 5
---
contrib/intarray/bench/create_test.pl | 20 +--
doc/src/sgml/generate-errcodes-table.pl | 2 +-
doc/src/sgml/mk_feature_tables.pl | 12 +-
src/backend/catalog/Catalog.pm | 8 +-
src/backend/catalog/genbki.pl | 64 ++++-----
src/backend/parser/check_keywords.pl | 30 ++---
src/backend/storage/lmgr/generate-lwlocknames.pl | 30 ++---
src/backend/utils/Gen_fmgrtab.pl | 32 ++---
src/backend/utils/generate-errcodes.pl | 2 +-
src/bin/pg_basebackup/t/010_pg_basebackup.pl | 26 ++--
src/bin/pg_ctl/t/001_start_stop.pl | 14 +-
src/bin/psql/create_help.pl | 28 ++--
src/interfaces/ecpg/preproc/check_rules.pl | 12 +-
src/interfaces/libpq/test/regress.pl | 10 +-
src/pl/plperl/plc_perlboot.pl | 4 +-
src/pl/plperl/plc_trusted.pl | 2 +-
src/pl/plperl/text2macro.pl | 8 +-
src/pl/plpgsql/src/generate-plerrcodes.pl | 2 +-
src/pl/plpython/generate-spiexceptions.pl | 2 +-
src/pl/tcl/generate-pltclerrcodes.pl | 2 +-
src/test/locale/sort-test.pl | 4 +-
src/test/perl/PostgresNode.pm | 8 +-
src/test/perl/TestLib.pm | 16 +--
src/test/ssl/ServerSetup.pm | 48 +++----
src/tools/fix-old-flex-code.pl | 4 +-
src/tools/msvc/Install.pm | 10 +-
src/tools/msvc/Mkvcbuild.pm | 2 +-
src/tools/msvc/Project.pm | 28 ++--
src/tools/msvc/Solution.pm | 162 +++++++++++------------
src/tools/msvc/build.pl | 8 +-
src/tools/msvc/builddoc.pl | 2 +-
src/tools/msvc/gendef.pl | 18 +--
src/tools/msvc/install.pl | 4 +-
src/tools/msvc/mkvcbuild.pl | 4 +-
src/tools/msvc/pgbison.pl | 4 +-
src/tools/msvc/pgflex.pl | 12 +-
src/tools/msvc/vcregress.pl | 19 +--
src/tools/pginclude/pgcheckdefines | 32 ++---
src/tools/pgindent/pgindent | 4 +-
src/tools/version_stamp.pl | 6 +-
src/tools/win32tzlist.pl | 6 +-
41 files changed, 356 insertions(+), 355 deletions(-)
diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl
index 1323b31e4d..f3262df05b 100755
--- a/contrib/intarray/bench/create_test.pl
+++ b/contrib/intarray/bench/create_test.pl
@@ -15,8 +15,8 @@
EOT
-open(MSG, ">message.tmp") || die;
-open(MAP, ">message_section_map.tmp") || die;
+open(my $msg, '>', "message.tmp") || die;
+open(my $map, '>', "message_section_map.tmp") || die;
srand(1);
@@ -42,16 +42,16 @@
}
if ($#sect < 0 || rand() < 0.1)
{
- print MSG "$i\t\\N\n";
+ print $msg "$i\t\\N\n";
}
else
{
- print MSG "$i\t{" . join(',', @sect) . "}\n";
- map { print MAP "$i\t$_\n" } @sect;
+ print $msg "$i\t{" . join(',', @sect) . "}\n";
+ map { print $map "$i\t$_\n" } @sect;
}
}
-close MAP;
-close MSG;
+close $map;
+close $msg;
copytable('message');
copytable('message_section_map');
@@ -79,8 +79,8 @@ sub copytable
my $t = shift;
print "COPY $t from stdin;\n";
- open(FFF, "$t.tmp") || die;
- while (<FFF>) { print; }
- close FFF;
+ open(my $fff, '<', "$t.tmp") || die;
+ while (<$fff>) { print; }
+ close $fff;
print "\\.\n";
}
diff --git a/doc/src/sgml/generate-errcodes-table.pl b/doc/src/sgml/generate-errcodes-table.pl
index 66be811adb..01fc6166bf 100644
--- a/doc/src/sgml/generate-errcodes-table.pl
+++ b/doc/src/sgml/generate-errcodes-table.pl
@@ -9,7 +9,7 @@
print
"<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n";
-open my $errcodes, $ARGV[0] or die;
+open my $errcodes, '<', $ARGV[0] or die;
while (<$errcodes>)
{
diff --git a/doc/src/sgml/mk_feature_tables.pl b/doc/src/sgml/mk_feature_tables.pl
index 93dab2132e..9b111b8b40 100644
--- a/doc/src/sgml/mk_feature_tables.pl
+++ b/doc/src/sgml/mk_feature_tables.pl
@@ -6,11 +6,11 @@
my $yesno = $ARGV[0];
-open PACK, $ARGV[1] or die;
+open my $pack, '<', $ARGV[1] or die;
my %feature_packages;
-while (<PACK>)
+while (<$pack>)
{
chomp;
my ($fid, $pname) = split /\t/;
@@ -24,13 +24,13 @@
}
}
-close PACK;
+close $pack;
-open FEAT, $ARGV[2] or die;
+open my $feat, '<', $ARGV[2] or die;
print "<tbody>\n";
-while (<FEAT>)
+while (<$feat>)
{
chomp;
my ($feature_id, $feature_name, $subfeature_id,
@@ -69,4 +69,4 @@
print "</tbody>\n";
-close FEAT;
+close $feat;
diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index e1f3c3a5ee..ee16a737f4 100644
--- a/src/backend/catalog/Catalog.pm
+++ b/src/backend/catalog/Catalog.pm
@@ -44,10 +44,10 @@ sub Catalogs
$catalog{columns} = [];
$catalog{data} = [];
- open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
+ open(my $ifh, '<', $input_file) || die "$input_file: $!";
# Scan the input file.
- while (<INPUT_FILE>)
+ while (<$ifh>)
{
# Strip C-style comments.
@@ -56,7 +56,7 @@ sub Catalogs
{
# handle multi-line comments properly.
- my $next_line = <INPUT_FILE>;
+ my $next_line = <$ifh>;
die "$input_file: ends within C-style comment\n"
if !defined $next_line;
$_ .= $next_line;
@@ -198,7 +198,7 @@ sub Catalogs
}
}
$catalogs{$catname} = \%catalog;
- close INPUT_FILE;
+ close $ifh;
}
return \%catalogs;
}
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index 079516ca2f..f9ecb02548 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -66,16 +66,16 @@
# Open temp files
my $tmpext = ".tmp$$";
my $bkifile = $output_path . 'postgres.bki';
-open BKI, '>', $bkifile . $tmpext
+open my $bki, '>', $bkifile . $tmpext
or die "can't open $bkifile$tmpext: $!";
my $schemafile = $output_path . 'schemapg.h';
-open SCHEMAPG, '>', $schemafile . $tmpext
+open my $schemapg, '>', $schemafile . $tmpext
or die "can't open $schemafile$tmpext: $!";
my $descrfile = $output_path . 'postgres.description';
-open DESCR, '>', $descrfile . $tmpext
+open my $descr, '>', $descrfile . $tmpext
or die "can't open $descrfile$tmpext: $!";
my $shdescrfile = $output_path . 'postgres.shdescription';
-open SHDESCR, '>', $shdescrfile . $tmpext
+open my $shdescr, '>', $shdescrfile . $tmpext
or die "can't open $shdescrfile$tmpext: $!";
# Fetch some special data that we will substitute into the output file.
@@ -97,7 +97,7 @@
# Generate postgres.bki, postgres.description, and postgres.shdescription
# version marker for .bki file
-print BKI "# PostgreSQL $major_version\n";
+print $bki "# PostgreSQL $major_version\n";
# vars to hold data needed for schemapg.h
my %schemapg_entries;
@@ -110,7 +110,7 @@
# .bki CREATE command for this catalog
my $catalog = $catalogs->{$catname};
- print BKI "create $catname $catalog->{relation_oid}"
+ print $bki "create $catname $catalog->{relation_oid}"
. $catalog->{shared_relation}
. $catalog->{bootstrap}
. $catalog->{without_oids}
@@ -120,7 +120,7 @@
my @attnames;
my $first = 1;
- print BKI " (\n";
+ print $bki " (\n";
foreach my $column (@{ $catalog->{columns} })
{
my $attname = $column->{name};
@@ -130,27 +130,27 @@
if (!$first)
{
- print BKI " ,\n";
+ print $bki " ,\n";
}
$first = 0;
- print BKI " $attname = $atttype";
+ print $bki " $attname = $atttype";
if (defined $column->{forcenotnull})
{
- print BKI " FORCE NOT NULL";
+ print $bki " FORCE NOT NULL";
}
elsif (defined $column->{forcenull})
{
- print BKI " FORCE NULL";
+ print $bki " FORCE NULL";
}
}
- print BKI "\n )\n";
+ print $bki "\n )\n";
# open it, unless bootstrap case (create bootstrap does this automatically)
if ($catalog->{bootstrap} eq '')
{
- print BKI "open $catname\n";
+ print $bki "open $catname\n";
}
if (defined $catalog->{data})
@@ -175,17 +175,17 @@
# Write to postgres.bki
my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
- printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
+ printf $bki "insert %s( %s)\n", $oid, $row->{bki_values};
# Write comments to postgres.description and postgres.shdescription
if (defined $row->{descr})
{
- printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
+ printf $descr "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
$row->{descr};
}
if (defined $row->{shdescr})
{
- printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname,
+ printf $shdescr "%s\t%s\t%s\n", $row->{oid}, $catname,
$row->{shdescr};
}
}
@@ -267,7 +267,7 @@
}
}
- print BKI "close $catname\n";
+ print $bki "close $catname\n";
}
# Any information needed for the BKI that is not contained in a pg_*.h header
@@ -276,19 +276,19 @@
# Write out declare toast/index statements
foreach my $declaration (@{ $catalogs->{toasting}->{data} })
{
- print BKI $declaration;
+ print $bki $declaration;
}
foreach my $declaration (@{ $catalogs->{indexing}->{data} })
{
- print BKI $declaration;
+ print $bki $declaration;
}
# Now generate schemapg.h
# Opening boilerplate for schemapg.h
-print SCHEMAPG <<EOM;
+print $schemapg <<EOM;
/*-------------------------------------------------------------------------
*
* schemapg.h
@@ -313,19 +313,19 @@
# Emit schemapg declarations
foreach my $table_name (@tables_needing_macros)
{
- print SCHEMAPG "\n#define Schema_$table_name \\\n";
- print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} };
- print SCHEMAPG "\n";
+ print $schemapg "\n#define Schema_$table_name \\\n";
+ print $schemapg join ", \\\n", @{ $schemapg_entries{$table_name} };
+ print $schemapg "\n";
}
# Closing boilerplate for schemapg.h
-print SCHEMAPG "\n#endif /* SCHEMAPG_H */\n";
+print $schemapg "\n#endif /* SCHEMAPG_H */\n";
# We're done emitting data
-close BKI;
-close SCHEMAPG;
-close DESCR;
-close SHDESCR;
+close $bki;
+close $schemapg;
+close $descr;
+close $shdescr;
# Finally, rename the completed files into place.
Catalog::RenameTempFile($bkifile, $tmpext);
@@ -425,7 +425,7 @@ sub bki_insert
my @attnames = @_;
my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
my $bki_values = join ' ', map $row->{$_}, @attnames;
- printf BKI "insert %s( %s)\n", $oid, $bki_values;
+ printf $bki "insert %s( %s)\n", $oid, $bki_values;
}
# The field values of a Schema_pg_xxx declaration are similar, but not
@@ -472,15 +472,15 @@ sub find_defined_symbol
}
my $file = $path . $catalog_header;
next if !-f $file;
- open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!";
- while (<FIND_DEFINED_SYMBOL>)
+ open(my $find_defined_symbol, '<', $file) || die "$file: $!";
+ while (<$find_defined_symbol>)
{
if (/^#define\s+\Q$symbol\E\s+(\S+)/)
{
return $1;
}
}
- close FIND_DEFINED_SYMBOL;
+ close $find_defined_symbol;
die "$file: no definition found for $symbol\n";
}
die "$catalog_header: not found in any include directory\n";
diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl
index 45862ce940..84fef1d95e 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -14,7 +14,7 @@
my $errors = 0;
-sub error(@)
+sub error
{
print STDERR @_;
$errors = 1;
@@ -29,18 +29,18 @@ (@)
$keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD';
-open(GRAM, $gram_filename) || die("Could not open : $gram_filename");
+open(my $gram, '<', $gram_filename) || die("Could not open : $gram_filename");
-my ($S, $s, $k, $n, $kcat);
+my $kcat;
my $comment;
my @arr;
my %keywords;
-line: while (<GRAM>)
+line: while (my $S = <$gram>)
{
- chomp; # strip record separator
+ chomp $S; # strip record separator
- $S = $_;
+ my $s;
# Make sure any braces are split
$s = '{', $S =~ s/$s/ { /g;
@@ -54,7 +54,7 @@ (@)
{
# Is this the beginning of a keyword list?
- foreach $k (keys %keyword_categories)
+ foreach my $k (keys %keyword_categories)
{
if ($S =~ m/^($k):/)
{
@@ -66,7 +66,7 @@ (@)
}
# Now split the line into individual fields
- $n = (@arr = split(' ', $S));
+ my $n = (@arr = split(' ', $S));
# Ok, we're in a keyword list. Go through each field in turn
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
@@ -109,15 +109,15 @@ (@)
push @{ $keywords{$kcat} }, $arr[$fieldIndexer];
}
}
-close GRAM;
+close $gram;
# Check that each keyword list is in alphabetical order (just for neatnik-ism)
-my ($prevkword, $kword, $bare_kword);
-foreach $kcat (keys %keyword_categories)
+my ($prevkword, $bare_kword);
+foreach my $kcat (keys %keyword_categories)
{
$prevkword = '';
- foreach $kword (@{ $keywords{$kcat} })
+ foreach my $kword (@{ $keywords{$kcat} })
{
# Some keyword have a _P suffix. Remove it for the comparison.
@@ -149,12 +149,12 @@ (@)
# Now read in kwlist.h
-open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename");
+open(my $kwlist, '<', $kwlist_filename) || die("Could not open : $kwlist_filename");
my $prevkwstring = '';
my $bare_kwname;
my %kwhash;
-kwlist_line: while (<KWLIST>)
+kwlist_line: while (<$kwlist>)
{
my ($line) = $_;
@@ -219,7 +219,7 @@ (@)
}
}
}
-close KWLIST;
+close $kwlist;
# Check that we've paired up all keywords from gram.y with lines in kwlist.h
while (my ($kwcat, $kwcat_id) = each(%keyword_categories))
diff --git a/src/backend/storage/lmgr/generate-lwlocknames.pl b/src/backend/storage/lmgr/generate-lwlocknames.pl
index f80d2c8121..10d069896f 100644
--- a/src/backend/storage/lmgr/generate-lwlocknames.pl
+++ b/src/backend/storage/lmgr/generate-lwlocknames.pl
@@ -9,21 +9,21 @@
my $lastlockidx = -1;
my $continue = "\n";
-open my $lwlocknames, $ARGV[0] or die;
+open my $lwlocknames, '<', $ARGV[0] or die;
# Include PID in suffix in case parallel make runs this multiple times.
my $htmp = "lwlocknames.h.tmp$$";
my $ctmp = "lwlocknames.c.tmp$$";
-open H, '>', $htmp or die "Could not open $htmp: $!";
-open C, '>', $ctmp or die "Could not open $ctmp: $!";
+open my $h, '>', $htmp or die "Could not open $htmp: $!";
+open my $c, '>', $ctmp or die "Could not open $ctmp: $!";
my $autogen =
"/* autogenerated from src/backend/storage/lmgr/lwlocknames.txt, do not edit */\n";
-print H $autogen;
-print H "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n";
-print C $autogen, "\n";
+print $h $autogen;
+print $h "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n";
+print $c $autogen, "\n";
-print C "char *MainLWLockNames[] = {";
+print $c "char *MainLWLockNames[] = {";
while (<$lwlocknames>)
{
@@ -44,22 +44,22 @@
while ($lastlockidx < $lockidx - 1)
{
++$lastlockidx;
- printf C "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
+ printf $c "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
$continue = ",\n";
}
- printf C "%s \"%s\"", $continue, $lockname;
+ printf $c "%s \"%s\"", $continue, $lockname;
$lastlockidx = $lockidx;
$continue = ",\n";
- print H "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
+ print $h "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
}
-printf C "\n};\n";
-print H "\n";
-printf H "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
+printf $c "\n};\n";
+print $h "\n";
+printf $h "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
-close H;
-close C;
+close $h;
+close $c;
rename($htmp, 'lwlocknames.h') || die "rename: $htmp: $!";
rename($ctmp, 'lwlocknames.c') || die "rename: $ctmp: $!";
diff --git a/src/backend/utils/Gen_fmgrtab.pl b/src/backend/utils/Gen_fmgrtab.pl
index cdd603ab6f..2af9b355e7 100644
--- a/src/backend/utils/Gen_fmgrtab.pl
+++ b/src/backend/utils/Gen_fmgrtab.pl
@@ -90,11 +90,11 @@
my $protosfile = $output_path . 'fmgrprotos.h';
my $tabfile = $output_path . 'fmgrtab.c';
-open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!";
-open P, '>', $protosfile . $tmpext or die "Could not open $protosfile$tmpext: $!";
-open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!";
+open my $ofh, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!";
+open my $pfh, '>', $protosfile . $tmpext or die "Could not open $protosfile$tmpext: $!";
+open my $tfh, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!";
-print H
+print $ofh
qq|/*-------------------------------------------------------------------------
*
* fmgroids.h
@@ -132,7 +132,7 @@
*/
|;
-print P
+print $pfh
qq|/*-------------------------------------------------------------------------
*
* fmgrprotos.h
@@ -159,7 +159,7 @@
|;
-print T
+print $tfh
qq|/*-------------------------------------------------------------------------
*
* fmgrtab.c
@@ -193,26 +193,26 @@
{
next if $seenit{ $s->{prosrc} };
$seenit{ $s->{prosrc} } = 1;
- print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
- print P "extern Datum $s->{prosrc}(PG_FUNCTION_ARGS);\n";
+ print $ofh "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
+ print $pfh "extern Datum $s->{prosrc}(PG_FUNCTION_ARGS);\n";
}
# Create the fmgr_builtins table
-print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n";
+print $tfh "\nconst FmgrBuiltin fmgr_builtins[] = {\n";
my %bmap;
$bmap{'t'} = 'true';
$bmap{'f'} = 'false';
foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{
- print T
+ print $tfh
" { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n";
}
# And add the file footers.
-print H "\n#endif /* FMGROIDS_H */\n";
-print P "\n#endif /* FMGRPROTOS_H */\n";
+print $ofh "\n#endif /* FMGROIDS_H */\n";
+print $pfh "\n#endif /* FMGRPROTOS_H */\n";
-print T
+print $tfh
qq| /* dummy entry is easier than getting rid of comma after last real one */
/* (not that there has ever been anything wrong with *having* a
comma after the last field in an array initializer) */
@@ -223,9 +223,9 @@
const int fmgr_nbuiltins = (sizeof(fmgr_builtins) / sizeof(FmgrBuiltin)) - 1;
|;
-close(H);
-close(P);
-close(T);
+close($ofh);
+close($pfh);
+close($tfh);
# Finally, rename the completed files into place.
Catalog::RenameTempFile($oidsfile, $tmpext);
diff --git a/src/backend/utils/generate-errcodes.pl b/src/backend/utils/generate-errcodes.pl
index b84c6b0d0f..6a577f657a 100644
--- a/src/backend/utils/generate-errcodes.pl
+++ b/src/backend/utils/generate-errcodes.pl
@@ -10,7 +10,7 @@
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef ERRCODES_H here */\n";
-open my $errcodes, $ARGV[0] or die;
+open my $errcodes, '<', $ARGV[0] or die;
while (<$errcodes>)
{
diff --git a/src/bin/pg_basebackup/t/010_pg_basebackup.pl b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
index 29f519d8c9..c349d03910 100644
--- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl
+++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
@@ -27,10 +27,10 @@
# Some Windows ANSI code pages may reject this filename, in which case we
# quietly proceed without this bit of test coverage.
-if (open BADCHARS, ">>$tempdir/pgdata/FOO\xe0\xe0\xe0BAR")
+if (open my $badchars, '>>', "$tempdir/pgdata/FOO\xe0\xe0\xe0BAR")
{
- print BADCHARS "test backup of file with non-UTF8 name\n";
- close BADCHARS;
+ print $badchars "test backup of file with non-UTF8 name\n";
+ close $badchars;
}
$node->set_replication_conf();
@@ -48,19 +48,19 @@
ok(-d "$tempdir/backup", 'backup directory was created and left behind');
-open CONF, ">>$pgdata/postgresql.conf";
-print CONF "max_replication_slots = 10\n";
-print CONF "max_wal_senders = 10\n";
-print CONF "wal_level = replica\n";
-close CONF;
+open my $conf, '>>', "$pgdata/postgresql.conf";
+print $conf "max_replication_slots = 10\n";
+print $conf "max_wal_senders = 10\n";
+print $conf "wal_level = replica\n";
+close $conf;
$node->restart;
# Write some files to test that they are not copied.
foreach my $filename (qw(backup_label tablespace_map postgresql.auto.conf.tmp))
{
- open FILE, ">>$pgdata/$filename";
- print FILE "DONOTCOPY";
- close FILE;
+ open my $file, '>>', "$pgdata/$filename";
+ print $file "DONOTCOPY";
+ close $file;
}
$node->command_ok([ 'pg_basebackup', '-D', "$tempdir/backup", '-X', 'none' ],
@@ -127,8 +127,8 @@
my $superlongname = "superlongname_" . ("x" x 100);
my $superlongpath = "$pgdata/$superlongname";
-open FILE, ">$superlongpath" or die "unable to create file $superlongpath";
-close FILE;
+open my $file, '>', "$superlongpath" or die "unable to create file $superlongpath";
+close $file;
$node->command_fails(
[ 'pg_basebackup', '-D', "$tempdir/tarbackup_l1", '-Ft' ],
'pg_basebackup tar with long name fails');
diff --git a/src/bin/pg_ctl/t/001_start_stop.pl b/src/bin/pg_ctl/t/001_start_stop.pl
index 8f16bf9795..918257441b 100644
--- a/src/bin/pg_ctl/t/001_start_stop.pl
+++ b/src/bin/pg_ctl/t/001_start_stop.pl
@@ -20,18 +20,18 @@
'pg_ctl initdb');
command_ok([ $ENV{PG_REGRESS}, '--config-auth', "$tempdir/data" ],
'configure authentication');
-open CONF, ">>$tempdir/data/postgresql.conf";
-print CONF "fsync = off\n";
-if (!$windows_os)
+open my $conf, '>>', "$tempdir/data/postgresql.conf";
+print $conf "fsync = off\n";
+if (! $windows_os)
{
- print CONF "listen_addresses = ''\n";
- print CONF "unix_socket_directories = '$tempdir_short'\n";
+ print $conf "listen_addresses = ''\n";
+ print $conf "unix_socket_directories = '$tempdir_short'\n";
}
else
{
- print CONF "listen_addresses = '127.0.0.1'\n";
+ print $conf "listen_addresses = '127.0.0.1'\n";
}
-close CONF;
+close $conf;
command_ok([ 'pg_ctl', 'start', '-D', "$tempdir/data" ],
'pg_ctl start');
diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl
index 359670b6e9..cedb767b27 100644
--- a/src/bin/psql/create_help.pl
+++ b/src/bin/psql/create_help.pl
@@ -42,12 +42,12 @@
opendir(DIR, $docdir)
or die "$0: could not open documentation source dir '$docdir': $!\n";
-open(HFILE, ">$hfile")
+open(my $hfile_handle, '>', $hfile)
or die "$0: could not open output file '$hfile': $!\n";
-open(CFILE, ">$cfile")
+open(my $cfile_handle, '>', $cfile)
or die "$0: could not open output file '$cfile': $!\n";
-print HFILE "/*
+print $hfile_handle "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
@@ -72,7 +72,7 @@
extern const struct _helpStruct QL_HELP[];
";
-print CFILE "/*
+print $cfile_handle "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
@@ -97,9 +97,9 @@
my (@cmdnames, $cmddesc, $cmdsynopsis);
$file =~ /\.sgml$/ or next;
- open(FILE, "$docdir/$file") or next;
- my $filecontent = join('', <FILE>);
- close FILE;
+ open(my $fh, '<', "$docdir/$file") or next;
+ my $filecontent = join('', <$fh>);
+ close $fh;
# Ignore files that are not for SQL language statements
$filecontent =~
@@ -171,7 +171,7 @@
$synopsis =~ s/\\n/\\n"\n$prefix"/g;
my @args =
("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} }));
- print CFILE "static void
+ print $cfile_handle "static void
sql_help_$id(PQExpBuffer buf)
{
\tappendPQExpBuffer(" . join(",\n$prefix", @args) . ");
@@ -180,14 +180,14 @@
";
}
-print CFILE "
+print $cfile_handle "
const struct _helpStruct QL_HELP[] = {
";
foreach (sort keys %entries)
{
my $id = $_;
$id =~ s/ /_/g;
- print CFILE " { \"$_\",
+ print $cfile_handle " { \"$_\",
N_(\"$entries{$_}{cmddesc}\"),
sql_help_$id,
$entries{$_}{nl_count} },
@@ -195,12 +195,12 @@
";
}
-print CFILE "
+print $cfile_handle "
{ NULL, NULL, NULL } /* End of list marker */
};
";
-print HFILE "
+print $hfile_handle "
#define QL_HELP_COUNT "
. scalar(keys %entries) . " /* number of help items */
#define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */
@@ -209,6 +209,6 @@
#endif /* $define */
";
-close CFILE;
-close HFILE;
+close $cfile_handle;
+close $hfile_handle;
closedir DIR;
diff --git a/src/interfaces/ecpg/preproc/check_rules.pl b/src/interfaces/ecpg/preproc/check_rules.pl
index dce4bc6a02..e681943856 100644
--- a/src/interfaces/ecpg/preproc/check_rules.pl
+++ b/src/interfaces/ecpg/preproc/check_rules.pl
@@ -53,8 +53,8 @@
my $non_term_id = '';
my $cc = 0;
-open GRAM, $parser or die $!;
-while (<GRAM>)
+open my $parser_fh, '<', $parser or die $!;
+while (<$parser_fh>)
{
if (/^%%/)
{
@@ -145,7 +145,7 @@
}
}
-close GRAM;
+close $parser_fh;
if ($verbose)
{
print "$cc rules loaded\n";
@@ -154,8 +154,8 @@
my $ret = 0;
$cc = 0;
-open ECPG, $filename or die $!;
-while (<ECPG>)
+open my $ecpg_fh, '<', $filename or die $!;
+while (<$ecpg_fh>)
{
if (!/^ECPG:/)
{
@@ -170,7 +170,7 @@
$ret = 1;
}
}
-close ECPG;
+close $ecpg_fh;
if ($verbose)
{
diff --git a/src/interfaces/libpq/test/regress.pl b/src/interfaces/libpq/test/regress.pl
index 1dab12282b..b61f36babf 100644
--- a/src/interfaces/libpq/test/regress.pl
+++ b/src/interfaces/libpq/test/regress.pl
@@ -14,12 +14,12 @@
my $regress_out = "regress.out";
# open input file first, so possible error isn't sent to redirected STDERR
-open(REGRESS_IN, "<", $regress_in)
+open(my $regress_in_fh, "<", $regress_in)
or die "can't open $regress_in for reading: $!";
# save STDOUT/ERR and redirect both to regress.out
-open(OLDOUT, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
-open(OLDERR, ">&", \*STDERR) or die "can't dup STDERR: $!";
+open(my $oldout_fh, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
+open(my $olderr_fh, ">&", \*STDERR) or die "can't dup STDERR: $!";
open(STDOUT, ">", $regress_out)
or die "can't open $regress_out for writing: $!";
@@ -35,8 +35,8 @@
}
# restore STDOUT/ERR so we can print the outcome to the user
-open(STDERR, ">&", \*OLDERR) or die; # can't complain as STDERR is still duped
-open(STDOUT, ">&", \*OLDOUT) or die "can't restore STDOUT: $!";
+open(STDERR, ">&", $olderr_fh) or die; # can't complain as STDERR is still duped
+open(STDOUT, ">&", $oldout_fh) or die "can't restore STDOUT: $!";
# just in case
close REGRESS_IN;
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index bb2d009be0..292c9101c9 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -52,7 +52,7 @@ sub ::encode_array_constructor
{
- package PostgreSQL::InServer;
+ package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage);
use strict;
use warnings;
@@ -86,11 +86,13 @@ sub ::encode_array_constructor
sub mkfunc
{
+ ## no critic (ProhibitNoStrict, ProhibitStringyEval);
no strict; # default to no strict for the eval
no warnings; # default to no warnings for the eval
my $ret = eval(mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
+ ## use critic
}
1;
diff --git a/src/pl/plperl/plc_trusted.pl b/src/pl/plperl/plc_trusted.pl
index cd61882eb6..38255b4afc 100644
--- a/src/pl/plperl/plc_trusted.pl
+++ b/src/pl/plperl/plc_trusted.pl
@@ -1,6 +1,6 @@
# src/pl/plperl/plc_trusted.pl
-package PostgreSQL::InServer::safe;
+package PostgreSQL::InServer::safe; ## no critic (RequireFilenameMatchesPackage);
# Load widely useful pragmas into plperl to make them available.
#
diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl
index c88e5ec4be..e681fca21a 100644
--- a/src/pl/plperl/text2macro.pl
+++ b/src/pl/plperl/text2macro.pl
@@ -49,7 +49,7 @@ =head1 DESCRIPTION
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
- open my $src_fh, $src_file # not 3-arg form
+ open my $src_fh, '<', $src_file
or die "Can't open $src_file: $!";
printf qq{#define %s%s \\\n},
@@ -80,19 +80,19 @@ sub selftest
my $tmp = "text2macro_tmp";
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
- open my $fh, ">$tmp.pl" or die;
+ open my $fh, '>', "$tmp.pl" or die;
print $fh $string;
close $fh;
system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
- open $fh, ">>$tmp.c";
+ open $fh, '>>', "$tmp.c";
print $fh "#include <stdio.h>\n";
print $fh "int main() { puts(X); return 0; }\n";
close $fh;
system("cat -n $tmp.c");
system("make $tmp") == 0 or die;
- open $fh, "./$tmp |" or die;
+ open $fh, '<', "./$tmp |" or die;
my $result = <$fh>;
unlink <$tmp.*>;
diff --git a/src/pl/plpgsql/src/generate-plerrcodes.pl b/src/pl/plpgsql/src/generate-plerrcodes.pl
index 6a676c0953..eb135bc25e 100644
--- a/src/pl/plpgsql/src/generate-plerrcodes.pl
+++ b/src/pl/plpgsql/src/generate-plerrcodes.pl
@@ -10,7 +10,7 @@
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n";
-open my $errcodes, $ARGV[0] or die;
+open my $errcodes, '<', $ARGV[0] or die;
while (<$errcodes>)
{
diff --git a/src/pl/plpython/generate-spiexceptions.pl b/src/pl/plpython/generate-spiexceptions.pl
index ab0fa4aeaa..a9ee9601b3 100644
--- a/src/pl/plpython/generate-spiexceptions.pl
+++ b/src/pl/plpython/generate-spiexceptions.pl
@@ -10,7 +10,7 @@
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n";
-open my $errcodes, $ARGV[0] or die;
+open my $errcodes, '<', $ARGV[0] or die;
while (<$errcodes>)
{
diff --git a/src/pl/tcl/generate-pltclerrcodes.pl b/src/pl/tcl/generate-pltclerrcodes.pl
index e20a0aff4a..b4e429a4fb 100644
--- a/src/pl/tcl/generate-pltclerrcodes.pl
+++ b/src/pl/tcl/generate-pltclerrcodes.pl
@@ -10,7 +10,7 @@
"/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef PLTCLERRCODES_H here */\n";
-open my $errcodes, $ARGV[0] or die;
+open my $errcodes, '<', $ARGV[0] or die;
while (<$errcodes>)
{
diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index cb7e4934e4..157893e9d7 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -3,9 +3,7 @@
use strict;
use locale;
-open(INFILE, "<$ARGV[0]");
-chop(my (@words) = <INFILE>);
-close(INFILE);
+chop(my (@words) = <>);
$" = "\n";
my (@result) = sort @words;
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 4018f0af1f..25dbae7d72 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -347,7 +347,7 @@ sub set_replication_conf
$self->host eq $test_pghost
or die "set_replication_conf only works with the default host";
- open my $hba, ">>$pgdata/pg_hba.conf";
+ open my $hba, '>>', "$pgdata/pg_hba.conf";
print $hba "\n# Allow replication (set up by PostgresNode.pm)\n";
if (!$TestLib::windows_os)
{
@@ -408,7 +408,7 @@ sub init
@{ $params{extra} });
TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
- open my $conf, ">>$pgdata/postgresql.conf";
+ open my $conf, '>>', "$pgdata/postgresql.conf";
print $conf "\n# Added by PostgresNode.pm\n";
print $conf "fsync = off\n";
print $conf "log_line_prefix = '%m [%p] %q%a '\n";
@@ -835,7 +835,7 @@ sub _update_pid
# If we can open the PID file, read its first line and that's the PID we
# want. If the file cannot be opened, presumably the server is not
# running; don't be noisy in that case.
- if (open my $pidfile, $self->data_dir . "/postmaster.pid")
+ if (open my $pidfile, '<', $self->data_dir . "/postmaster.pid")
{
chomp($self->{_pid} = <$pidfile>);
print "# Postmaster PID for node \"$name\" is $self->{_pid}\n";
@@ -1372,7 +1372,7 @@ sub lsn
chomp($result);
if ($result eq '')
{
- return undef;
+ return;
}
else
{
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index d22957ceb0..ae8d1782da 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -84,14 +84,14 @@ INIT
$test_logfile = basename($0);
$test_logfile =~ s/\.[^.]+$//;
$test_logfile = "$log_path/regress_log_$test_logfile";
- open TESTLOG, '>', $test_logfile
+ open my $testlog, '>', $test_logfile
or die "could not open STDOUT to logfile \"$test_logfile\": $!";
# Hijack STDOUT and STDERR to the log file
- open(ORIG_STDOUT, ">&STDOUT");
- open(ORIG_STDERR, ">&STDERR");
- open(STDOUT, ">&TESTLOG");
- open(STDERR, ">&TESTLOG");
+ open(my $orig_stdout, '>&', \*STDOUT);
+ open(my $orig_stderr, '>&', \*STDERR);
+ open(STDOUT, '>&', $testlog);
+ open(STDERR, '>&', $testlog);
# The test output (ok ...) needs to be printed to the original STDOUT so
# that the 'prove' program can parse it, and display it to the user in
@@ -99,16 +99,16 @@ INIT
# in the log.
my $builder = Test::More->builder;
my $fh = $builder->output;
- tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG;
+ tie *$fh, "SimpleTee", $orig_stdout, $testlog;
$fh = $builder->failure_output;
- tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG;
+ tie *$fh, "SimpleTee", $orig_stderr, $testlog;
# Enable auto-flushing for all the file handles. Stderr and stdout are
# redirected to the same file, and buffering causes the lines to appear
# in the log in confusing order.
autoflush STDOUT 1;
autoflush STDERR 1;
- autoflush TESTLOG 1;
+ autoflush $testlog 1;
}
END
diff --git a/src/test/ssl/ServerSetup.pm b/src/test/ssl/ServerSetup.pm
index 9441249b3a..6d17d6d61a 100644
--- a/src/test/ssl/ServerSetup.pm
+++ b/src/test/ssl/ServerSetup.pm
@@ -58,21 +58,21 @@ sub configure_test_server_for_ssl
$node->psql('postgres', "CREATE DATABASE certdb");
# enable logging etc.
- open CONF, ">>$pgdata/postgresql.conf";
- print CONF "fsync=off\n";
- print CONF "log_connections=on\n";
- print CONF "log_hostname=on\n";
- print CONF "listen_addresses='$serverhost'\n";
- print CONF "log_statement=all\n";
+ open my $conf, '>>', "$pgdata/postgresql.conf";
+ print $conf "fsync=off\n";
+ print $conf "log_connections=on\n";
+ print $conf "log_hostname=on\n";
+ print $conf "listen_addresses='$serverhost'\n";
+ print $conf "log_statement=all\n";
# enable SSL and set up server key
- print CONF "include 'sslconfig.conf'";
+ print $conf "include 'sslconfig.conf'";
- close CONF;
+ close $conf;
# ssl configuration will be placed here
- open SSLCONF, ">$pgdata/sslconfig.conf";
- close SSLCONF;
+ open my $sslconf, '>', "$pgdata/sslconfig.conf";
+ close $sslconf;
# Copy all server certificates and keys, and client root cert, to the data dir
copy_files("ssl/server-*.crt", $pgdata);
@@ -100,13 +100,13 @@ sub switch_server_cert
diag "Reloading server with certfile \"$certfile\" and cafile \"$cafile\"...";
- open SSLCONF, ">$pgdata/sslconfig.conf";
- print SSLCONF "ssl=on\n";
- print SSLCONF "ssl_ca_file='$cafile.crt'\n";
- print SSLCONF "ssl_cert_file='$certfile.crt'\n";
- print SSLCONF "ssl_key_file='$certfile.key'\n";
- print SSLCONF "ssl_crl_file='root+client.crl'\n";
- close SSLCONF;
+ open my $sslconf, '>', "$pgdata/sslconfig.conf";
+ print $sslconf "ssl=on\n";
+ print $sslconf "ssl_ca_file='root+client_ca.crt'\n";
+ print $sslconf "ssl_cert_file='$certfile.crt'\n";
+ print $sslconf "ssl_key_file='$certfile.key'\n";
+ print $sslconf "ssl_crl_file='root+client.crl'\n";
+ close $sslconf;
$node->reload;
}
@@ -121,16 +121,16 @@ sub configure_hba_for_ssl
# but seems best to keep it as narrow as possible for security reasons.
#
# When connecting to certdb, also check the client certificate.
- open HBA, ">$pgdata/pg_hba.conf";
- print HBA
+ open my $hba, '>', "$pgdata/pg_hba.conf";
+ print $hba
"# TYPE DATABASE USER ADDRESS METHOD\n";
- print HBA
+ print $hba
"hostssl trustdb ssltestuser $serverhost/32 trust\n";
- print HBA
+ print $hba
"hostssl trustdb ssltestuser ::1/128 trust\n";
- print HBA
+ print $hba
"hostssl certdb ssltestuser $serverhost/32 cert\n";
- print HBA
+ print $hba
"hostssl certdb ssltestuser ::1/128 cert\n";
- close HBA;
+ close $hba;
}
diff --git a/src/tools/fix-old-flex-code.pl b/src/tools/fix-old-flex-code.pl
index 8dafcae15e..bc868dfd7f 100644
--- a/src/tools/fix-old-flex-code.pl
+++ b/src/tools/fix-old-flex-code.pl
@@ -25,7 +25,7 @@
# Suck in the whole file.
local $/ = undef;
my $cfile;
-open($cfile, $filename) || die "opening $filename for reading: $!";
+open($cfile, '<', $filename) || die "opening $filename for reading: $!";
my $ccode = <$cfile>;
close($cfile);
@@ -45,7 +45,7 @@
|s;
# Write the modified file back out.
-open($cfile, ">$filename") || die "opening $filename for writing: $!";
+open($cfile, '>', $filename) || die "opening $filename for writing: $!";
print $cfile $ccode;
close($cfile);
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm
index 0aa1422b9f..045ac440b2 100644
--- a/src/tools/msvc/Install.pm
+++ b/src/tools/msvc/Install.pm
@@ -58,8 +58,8 @@ sub Install
# suppress warning about harmless redeclaration of $config
no warnings 'misc';
- require "config_default.pl";
- require "config.pl" if (-f "config.pl");
+ do "config_default.pl";
+ do "config.pl" if (-f "config.pl");
}
chdir("../../..") if (-f "../../../configure");
@@ -367,7 +367,7 @@ sub GenerateConversionScript
$sql .=
"COMMENT ON CONVERSION pg_catalog.$name IS 'conversion for $se to $de';\n\n";
}
- open($F, ">$target/share/conversion_create.sql")
+ open($F, '>', "$target/share/conversion_create.sql")
|| die "Could not write to conversion_create.sql\n";
print $F $sql;
close($F);
@@ -409,7 +409,7 @@ sub GenerateTsearchFiles
$mf =~ /^LANGUAGES\s*=\s*(.*)$/m
|| die "Could not find LANGUAGES line in snowball Makefile\n";
my @pieces = split /\s+/, $1;
- open($F, ">$target/share/snowball_create.sql")
+ open($F, '>', "$target/share/snowball_create.sql")
|| die "Could not write snowball_create.sql";
print $F read_file('src/backend/snowball/snowball_func.sql.in');
@@ -735,7 +735,7 @@ sub read_file
my $t = $/;
undef $/;
- open($F, $filename) || die "Could not open file $filename\n";
+ open($F, '<', $filename) || die "Could not open file $filename\n";
my $txt = <$F>;
close($F);
$/ = $t;
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm
index 51b5d5449a..2d5d83c9ec 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -809,7 +809,7 @@ sub GenerateContribSqlFiles
$dn =~ s/\.sql$//;
$cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g;
my $o;
- open($o, ">contrib/$n/$out")
+ open($o, '>', "contrib/$n/$out")
|| croak "Could not write to contrib/$n/$d";
print $o $cont;
close($o);
diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm
index faf1a683f6..9817b9439a 100644
--- a/src/tools/msvc/Project.pm
+++ b/src/tools/msvc/Project.pm
@@ -310,12 +310,12 @@ sub AddResourceFile
if (Solution::IsNewer("$dir/win32ver.rc", 'src/port/win32ver.rc'))
{
print "Generating win32ver.rc for $dir\n";
- open(I, 'src/port/win32ver.rc')
+ open(my $i, '<', 'src/port/win32ver.rc')
|| confess "Could not open win32ver.rc";
- open(O, ">$dir/win32ver.rc")
+ open(my $o, '>', "$dir/win32ver.rc")
|| confess "Could not write win32ver.rc";
my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : "";
- while (<I>)
+ while (<$i>)
{
s/FILEDESC/"$desc"/gm;
s/_ICO_/$icostr/gm;
@@ -324,11 +324,11 @@ sub AddResourceFile
{
s/VFT_APP/VFT_DLL/gm;
}
- print O;
+ print $o $_;
}
+ close($o);
+ close($i);
}
- close(O);
- close(I);
$self->AddFile("$dir/win32ver.rc");
}
@@ -357,13 +357,13 @@ sub Save
$self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64');
# Dump the project
- open(F, ">$self->{name}$self->{filenameExtension}")
+ open(my $f, '>', "$self->{name}$self->{filenameExtension}")
|| croak(
"Could not write to $self->{name}$self->{filenameExtension}\n");
- $self->WriteHeader(*F);
- $self->WriteFiles(*F);
- $self->Footer(*F);
- close(F);
+ $self->WriteHeader($f);
+ $self->WriteFiles($f);
+ $self->Footer($f);
+ close($f);
}
sub GetAdditionalLinkerDependencies
@@ -397,7 +397,7 @@ sub read_file
my $t = $/;
undef $/;
- open($F, $filename) || croak "Could not open file $filename\n";
+ open($F, '<', $filename) || croak "Could not open file $filename\n";
my $txt = <$F>;
close($F);
$/ = $t;
@@ -412,8 +412,8 @@ sub read_makefile
my $t = $/;
undef $/;
- open($F, "$reldir/GNUmakefile")
- || open($F, "$reldir/Makefile")
+ open($F, '<', "$reldir/GNUmakefile")
+ || open($F, '<', "$reldir/Makefile")
|| confess "Could not open $reldir/Makefile\n";
my $txt = <$F>;
close($F);
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index ff9064f923..abac2c7402 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -102,14 +102,14 @@ sub IsNewer
sub copyFile
{
my ($src, $dest) = @_;
- open(I, $src) || croak "Could not open $src";
- open(O, ">$dest") || croak "Could not open $dest";
- while (<I>)
+ open(my $i, '<', $src) || croak "Could not open $src";
+ open(my $o, '>', $dest) || croak "Could not open $dest";
+ while (<$i>)
{
- print O;
+ print $o $_;
}
- close(I);
- close(O);
+ close($i);
+ close($o);
}
sub GenerateFiles
@@ -118,9 +118,9 @@ sub GenerateFiles
my $bits = $self->{platform} eq 'Win32' ? 32 : 64;
# Parse configure.in to get version numbers
- open(C, "configure.in")
+ open(my $c, '<', "configure.in")
|| confess("Could not open configure.in for reading\n");
- while (<C>)
+ while (<$c>)
{
if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/)
{
@@ -133,7 +133,7 @@ sub GenerateFiles
$self->{majorver} = sprintf("%d", $1);
}
}
- close(C);
+ close($c);
confess "Unable to parse configure.in for all variables!"
if ($self->{strver} eq '' || $self->{numver} eq '');
@@ -146,91 +146,91 @@ sub GenerateFiles
if (IsNewer("src/include/pg_config.h", "src/include/pg_config.h.win32"))
{
print "Generating pg_config.h...\n";
- open(I, "src/include/pg_config.h.win32")
+ open(my $i, '<', "src/include/pg_config.h.win32")
|| confess "Could not open pg_config.h.win32\n";
- open(O, ">src/include/pg_config.h")
+ open(my $o, '>', "src/include/pg_config.h")
|| confess "Could not write to pg_config.h\n";
my $extraver = $self->{options}->{extraver};
$extraver = '' unless defined $extraver;
- while (<I>)
+ while (<$i>)
{
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}$extraver"};
s{PG_VERSION_NUM \d+}{PG_VERSION_NUM $self->{numver}};
s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY(z)\n#define PG_VERSION_STR "PostgreSQL $self->{strver}$extraver, compiled by Visual C++ build " __STRINGIFY2(_MSC_VER) ", $bits-bit"};
- print O;
+ print $o $_;
}
- print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
- print O "#define LOCALEDIR \"/share/locale\"\n"
+ print $o "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
+ print $o "#define LOCALEDIR \"/share/locale\"\n"
if ($self->{options}->{nls});
- print O "/* defines added by config steps */\n";
- print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
- print O "#define USE_ASSERT_CHECKING 1\n"
+ print $o "/* defines added by config steps */\n";
+ print $o "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
+ print $o "#define USE_ASSERT_CHECKING 1\n"
if ($self->{options}->{asserts});
- print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
- print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
- print O "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
- print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
+ print $o "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
+ print $o "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
+ print $o "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
+ print $o "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
- print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
- print O "#define RELSEG_SIZE ",
+ print $o "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
+ print $o "#define RELSEG_SIZE ",
(1024 / $self->{options}->{blocksize}) *
$self->{options}->{segsize} *
1024, "\n";
- print O "#define XLOG_BLCKSZ ",
+ print $o "#define XLOG_BLCKSZ ",
1024 * $self->{options}->{wal_blocksize}, "\n";
- print O "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
+ print $o "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
" * 1024 * 1024)\n";
if ($self->{options}->{float4byval})
{
- print O "#define USE_FLOAT4_BYVAL 1\n";
- print O "#define FLOAT4PASSBYVAL true\n";
+ print $o "#define USE_FLOAT4_BYVAL 1\n";
+ print $o "#define FLOAT4PASSBYVAL true\n";
}
else
{
- print O "#define FLOAT4PASSBYVAL false\n";
+ print $o "#define FLOAT4PASSBYVAL false\n";
}
if ($self->{options}->{float8byval})
{
- print O "#define USE_FLOAT8_BYVAL 1\n";
- print O "#define FLOAT8PASSBYVAL true\n";
+ print $o "#define USE_FLOAT8_BYVAL 1\n";
+ print $o "#define FLOAT8PASSBYVAL true\n";
}
else
{
- print O "#define FLOAT8PASSBYVAL false\n";
+ print $o "#define FLOAT8PASSBYVAL false\n";
}
if ($self->{options}->{uuid})
{
- print O "#define HAVE_UUID_OSSP\n";
- print O "#define HAVE_UUID_H\n";
+ print $o "#define HAVE_UUID_OSSP\n";
+ print $o "#define HAVE_UUID_H\n";
}
if ($self->{options}->{xml})
{
- print O "#define HAVE_LIBXML2\n";
- print O "#define USE_LIBXML\n";
+ print $o "#define HAVE_LIBXML2\n";
+ print $o "#define USE_LIBXML\n";
}
if ($self->{options}->{xslt})
{
- print O "#define HAVE_LIBXSLT\n";
- print O "#define USE_LIBXSLT\n";
+ print $o "#define HAVE_LIBXSLT\n";
+ print $o "#define USE_LIBXSLT\n";
}
if ($self->{options}->{gss})
{
- print O "#define ENABLE_GSS 1\n";
+ print $o "#define ENABLE_GSS 1\n";
}
if (my $port = $self->{options}->{"--with-pgport"})
{
- print O "#undef DEF_PGPORT\n";
- print O "#undef DEF_PGPORT_STR\n";
- print O "#define DEF_PGPORT $port\n";
- print O "#define DEF_PGPORT_STR \"$port\"\n";
+ print $o "#undef DEF_PGPORT\n";
+ print $o "#undef DEF_PGPORT_STR\n";
+ print $o "#define DEF_PGPORT $port\n";
+ print $o "#define DEF_PGPORT_STR \"$port\"\n";
}
- print O "#define VAL_CONFIGURE \""
+ print $o "#define VAL_CONFIGURE \""
. $self->GetFakeConfigure() . "\"\n";
- print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
- close(O);
- close(I);
+ print $o "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
+ close($o);
+ close($i);
}
if (IsNewer(
@@ -379,17 +379,17 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
localtime(time);
my $d = ($year - 100) . "$yday";
- open(I, '<', 'src/interfaces/libpq/libpq.rc.in')
+ open(my $i, '<', 'src/interfaces/libpq/libpq.rc.in')
|| confess "Could not open libpq.rc.in";
- open(O, '>', 'src/interfaces/libpq/libpq.rc')
+ open(my $o, '>', 'src/interfaces/libpq/libpq.rc')
|| confess "Could not open libpq.rc";
- while (<I>)
+ while (<$i>)
{
s/(VERSION.*),0/$1,$d/;
- print O;
+ print $o;
}
- close(I);
- close(O);
+ close($i);
+ close($o);
}
if (IsNewer('src/bin/psql/sql_help.h', 'src/bin/psql/create_help.pl'))
@@ -415,23 +415,23 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
'src/interfaces/ecpg/include/ecpg_config.h.in'))
{
print "Generating ecpg_config.h...\n";
- open(O, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
+ open(my $o, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
|| confess "Could not open ecpg_config.h";
- print O <<EOF;
+ print $o <<EOF;
#if (_MSC_VER > 1200)
#define HAVE_LONG_LONG_INT_64
#define ENABLE_THREAD_SAFETY 1
EOF
- print O "#endif\n";
- close(O);
+ print $o "#endif\n";
+ close($o);
}
unless (-f "src/port/pg_config_paths.h")
{
print "Generating pg_config_paths.h...\n";
- open(O, '>', 'src/port/pg_config_paths.h')
+ open(my $o, '>', 'src/port/pg_config_paths.h')
|| confess "Could not open pg_config_paths.h";
- print O <<EOF;
+ print $o <<EOF;
#define PGBINDIR "/bin"
#define PGSHAREDIR "/share"
#define SYSCONFDIR "/etc"
@@ -445,7 +445,7 @@ EOF
#define HTMLDIR "/doc"
#define MANDIR "/man"
EOF
- close(O);
+ close($o);
}
my $mf = Project::read_file('src/backend/catalog/Makefile');
@@ -474,13 +474,13 @@ EOF
}
}
- open(O, ">doc/src/sgml/version.sgml")
+ open(my $o, '>', "doc/src/sgml/version.sgml")
|| croak "Could not write to version.sgml\n";
- print O <<EOF;
+ print $o <<EOF;
<!ENTITY version "$self->{strver}">
<!ENTITY majorversion "$self->{majorver}">
EOF
- close(O);
+ close($o);
}
sub GenerateDefFile
@@ -490,18 +490,18 @@ sub GenerateDefFile
if (IsNewer($deffile, $txtfile))
{
print "Generating $deffile...\n";
- open(I, $txtfile) || confess("Could not open $txtfile\n");
- open(O, ">$deffile") || confess("Could not open $deffile\n");
- print O "LIBRARY $libname\nEXPORTS\n";
- while (<I>)
+ open(my $if, '<', $txtfile) || confess("Could not open $txtfile\n");
+ open(my $of, '>', $deffile) || confess("Could not open $deffile\n");
+ print $of "LIBRARY $libname\nEXPORTS\n";
+ while (<$if>)
{
next if (/^#/);
next if (/^\s*$/);
my ($f, $o) = split;
- print O " $f @ $o\n";
+ print $of " $f @ $o\n";
}
- close(O);
- close(I);
+ close($of);
+ close($if);
}
}
@@ -575,19 +575,19 @@ sub Save
}
}
- open(SLN, ">pgsql.sln") || croak "Could not write to pgsql.sln\n";
- print SLN <<EOF;
+ open(my $sln, '>', "pgsql.sln") || croak "Could not write to pgsql.sln\n";
+ print $sln <<EOF;
Microsoft Visual Studio Solution File, Format Version $self->{solutionFileVersion}
# $self->{visualStudioName}
EOF
- print SLN $self->GetAdditionalHeaders();
+ print $sln $self->GetAdditionalHeaders();
foreach my $fld (keys %{ $self->{projects} })
{
foreach my $proj (@{ $self->{projects}->{$fld} })
{
- print SLN <<EOF;
+ print $sln <<EOF;
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "$proj->{name}", "$proj->{name}$proj->{filenameExtension}", "$proj->{guid}"
EndProject
EOF
@@ -595,14 +595,14 @@ EOF
if ($fld ne "")
{
$flduid{$fld} = Win32::GuidGen();
- print SLN <<EOF;
+ print $sln <<EOF;
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "$fld", "$fld", "$flduid{$fld}"
EndProject
EOF
}
}
- print SLN <<EOF;
+ print $sln <<EOF;
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|$self->{platform}= Debug|$self->{platform}
@@ -615,7 +615,7 @@ EOF
{
foreach my $proj (@{ $self->{projects}->{$fld} })
{
- print SLN <<EOF;
+ print $sln <<EOF;
$proj->{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform}
$proj->{guid}.Debug|$self->{platform}.Build.0 = Debug|$self->{platform}
$proj->{guid}.Release|$self->{platform}.ActiveCfg = Release|$self->{platform}
@@ -624,7 +624,7 @@ EOF
}
}
- print SLN <<EOF;
+ print $sln <<EOF;
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
@@ -637,15 +637,15 @@ EOF
next if ($fld eq "");
foreach my $proj (@{ $self->{projects}->{$fld} })
{
- print SLN "\t\t$proj->{guid} = $flduid{$fld}\n";
+ print $sln "\t\t$proj->{guid} = $flduid{$fld}\n";
}
}
- print SLN <<EOF;
+ print $sln <<EOF;
EndGlobalSection
EndGlobal
EOF
- close(SLN);
+ close($sln);
}
sub GetFakeConfigure
diff --git a/src/tools/msvc/build.pl b/src/tools/msvc/build.pl
index 2e7c54853a..7246064290 100644
--- a/src/tools/msvc/build.pl
+++ b/src/tools/msvc/build.pl
@@ -23,17 +23,17 @@ BEGIN
if (-e "src/tools/msvc/buildenv.pl")
{
- require "src/tools/msvc/buildenv.pl";
+ do "src/tools/msvc/buildenv.pl";
}
elsif (-e "./buildenv.pl")
{
- require "./buildenv.pl";
+ do "./buildenv.pl";
}
# set up the project
our $config;
-require "config_default.pl";
-require "config.pl" if (-f "src/tools/msvc/config.pl");
+do "config_default.pl";
+do "config.pl" if (-f "src/tools/msvc/config.pl");
my $vcver = Mkvcbuild::mkvcbuild($config);
diff --git a/src/tools/msvc/builddoc.pl b/src/tools/msvc/builddoc.pl
index 2b56ced43c..e0b5c50b34 100644
--- a/src/tools/msvc/builddoc.pl
+++ b/src/tools/msvc/builddoc.pl
@@ -18,7 +18,7 @@
noversion() unless -e 'doc/src/sgml/version.sgml';
-require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
+do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
my $docroot = $ENV{DOCROOT};
die "bad DOCROOT '$docroot'" unless ($docroot && -d $docroot);
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl
index 3bcff7ffaf..64227c2dce 100644
--- a/src/tools/msvc/gendef.pl
+++ b/src/tools/msvc/gendef.pl
@@ -32,8 +32,8 @@ sub dumpsyms
sub extract_syms
{
my ($symfile, $def) = @_;
- open(F, "<$symfile") || die "Could not open $symfile for $_\n";
- while (<F>)
+ open(my $f, '<', $symfile) || die "Could not open $symfile for $_\n";
+ while (<$f>)
{
# Expected symbol lines look like:
@@ -115,14 +115,14 @@ sub extract_syms
# whatever came last.
$def->{ $pieces[6] } = $pieces[3];
}
- close(F);
+ close($f);
}
sub writedef
{
my ($deffile, $platform, $def) = @_;
- open(DEF, ">$deffile") || die "Could not write to $deffile\n";
- print DEF "EXPORTS\n";
+ open(my $fh, '>', $deffile) || die "Could not write to $deffile\n";
+ print $fh "EXPORTS\n";
foreach my $f (sort keys %{$def})
{
my $isdata = $def->{$f} eq 'data';
@@ -135,14 +135,14 @@ sub writedef
# decorated with the DATA option for variables.
if ($isdata)
{
- print DEF " $f DATA\n";
+ print $fh " $f DATA\n";
}
else
{
- print DEF " $f\n";
+ print $fh " $f\n";
}
}
- close(DEF);
+ close($fh);
}
@@ -174,7 +174,7 @@ sub usage
my %def = ();
-while (<$ARGV[0]/*.obj>)
+while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
{
my $objfile = $_;
my $symfile = $objfile;
diff --git a/src/tools/msvc/install.pl b/src/tools/msvc/install.pl
index bde5b7c793..b2d7f9e040 100755
--- a/src/tools/msvc/install.pl
+++ b/src/tools/msvc/install.pl
@@ -14,11 +14,11 @@
if (-e "src/tools/msvc/buildenv.pl")
{
- require "src/tools/msvc/buildenv.pl";
+ do "src/tools/msvc/buildenv.pl";
}
elsif (-e "./buildenv.pl")
{
- require "./buildenv.pl";
+ do "./buildenv.pl";
}
my $target = shift || Usage();
diff --git a/src/tools/msvc/mkvcbuild.pl b/src/tools/msvc/mkvcbuild.pl
index 6f1c42e504..9255dff022 100644
--- a/src/tools/msvc/mkvcbuild.pl
+++ b/src/tools/msvc/mkvcbuild.pl
@@ -19,7 +19,7 @@
unless (-f 'src/tools/msvc/config.pl');
our $config;
-require 'src/tools/msvc/config_default.pl';
-require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
+do 'src/tools/msvc/config_default.pl';
+do 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
Mkvcbuild::mkvcbuild($config);
diff --git a/src/tools/msvc/pgbison.pl b/src/tools/msvc/pgbison.pl
index 31e75403f5..e799d900fe 100644
--- a/src/tools/msvc/pgbison.pl
+++ b/src/tools/msvc/pgbison.pl
@@ -7,7 +7,7 @@
# assume we are in the postgres source root
-require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
+do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
my ($bisonver) = `bison -V`; # grab first line
$bisonver = (split(/\s+/, $bisonver))[3]; # grab version number
@@ -38,7 +38,7 @@
my $makefile = dirname($input) . "/Makefile";
my ($mf, $make);
-open($mf, $makefile);
+open($mf, '<', $makefile);
local $/ = undef;
$make = <$mf>;
close($mf);
diff --git a/src/tools/msvc/pgflex.pl b/src/tools/msvc/pgflex.pl
index fab0efa79f..67397ba644 100644
--- a/src/tools/msvc/pgflex.pl
+++ b/src/tools/msvc/pgflex.pl
@@ -10,7 +10,7 @@
# assume we are in the postgres source root
-require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
+do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
my ($flexver) = `flex -V`; # grab first line
$flexver = (split(/\s+/, $flexver))[1];
@@ -41,7 +41,7 @@
# get flex flags from make file
my $makefile = dirname($input) . "/Makefile";
my ($mf, $make);
-open($mf, $makefile);
+open($mf, '<', $makefile);
local $/ = undef;
$make = <$mf>;
close($mf);
@@ -53,7 +53,7 @@
{
# Check for "%option reentrant" in .l file.
my $lfile;
- open($lfile, $input) || die "opening $input for reading: $!";
+ open($lfile, '<', $input) || die "opening $input for reading: $!";
my $lcode = <$lfile>;
close($lfile);
if ($lcode =~ /\%option\sreentrant/)
@@ -69,18 +69,18 @@
# For reentrant scanners (like the core scanner) we do not
# need to (and must not) change the yywrap definition.
my $cfile;
- open($cfile, $output) || die "opening $output for reading: $!";
+ open($cfile, '<', $output) || die "opening $output for reading: $!";
my $ccode = <$cfile>;
close($cfile);
$ccode =~ s/yywrap\(n\)/yywrap()/;
- open($cfile, ">$output") || die "opening $output for writing: $!";
+ open($cfile, '>', $output) || die "opening $output for writing: $!";
print $cfile $ccode;
close($cfile);
}
if ($flexflags =~ /\s-b\s/)
{
my $lexback = "lex.backup";
- open($lfile, $lexback) || die "opening $lexback for reading: $!";
+ open($lfile, '<', $lexback) || die "opening $lexback for reading: $!";
my $lexbacklines = <$lfile>;
close($lfile);
my $linecount = $lexbacklines =~ tr /\n/\n/;
diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl
index f1b9819cd2..d9367f8fd5 100644
--- a/src/tools/msvc/vcregress.pl
+++ b/src/tools/msvc/vcregress.pl
@@ -20,8 +20,8 @@
my $topdir = getcwd();
my $tmp_installdir = "$topdir/tmp_install";
-require 'src/tools/msvc/config_default.pl';
-require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
+do 'src/tools/msvc/config_default.pl';
+do 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
# buildenv.pl is for specifying the build environment settings
# it should contain lines like:
@@ -29,7 +29,7 @@
if (-e "src/tools/msvc/buildenv.pl")
{
- require "src/tools/msvc/buildenv.pl";
+ do "src/tools/msvc/buildenv.pl";
}
my $what = shift || "";
@@ -505,8 +505,8 @@ sub upgradecheck
sub fetchRegressOpts
{
my $handle;
- open($handle, "<GNUmakefile")
- || open($handle, "<Makefile")
+ open($handle, '<', "GNUmakefile")
+ || open($handle, '<', "Makefile")
|| die "Could not open Makefile";
local ($/) = undef;
my $m = <$handle>;
@@ -521,8 +521,9 @@ sub fetchRegressOpts
# an unhandled variable reference. Ignore anything that isn't an
# option starting with "--".
@opts = grep {
- s/\Q$(top_builddir)\E/\"$topdir\"/;
- $_ !~ /\$\(/ && $_ =~ /^--/
+ my $x = $_;
+ $x =~ s/\Q$(top_builddir)\E/\"$topdir\"/;
+ $x !~ /\$\(/ && $x =~ /^--/
} split(/\s+/, $1);
}
if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m)
@@ -540,8 +541,8 @@ sub fetchTests
{
my $handle;
- open($handle, "<GNUmakefile")
- || open($handle, "<Makefile")
+ open($handle, '<', "GNUmakefile")
+ || open($handle, '<', "Makefile")
|| die "Could not open Makefile";
local ($/) = undef;
my $m = <$handle>;
diff --git a/src/tools/pginclude/pgcheckdefines b/src/tools/pginclude/pgcheckdefines
index e166efa08d..aa7c9c2fc1 100755
--- a/src/tools/pginclude/pgcheckdefines
+++ b/src/tools/pginclude/pgcheckdefines
@@ -42,25 +42,25 @@ my $MAKE = "make";
#
my (@cfiles, @hfiles);
-open PIPE, "$FIND * -type f -name '*.c' |"
+open my $pipe, '-|', "$FIND * -type f -name '*.c'"
or die "can't fork: $!";
-while (<PIPE>)
+while (<$pipe>)
{
chomp;
push @cfiles, $_;
}
-close PIPE or die "$FIND failed: $!";
+close $pipe or die "$FIND failed: $!";
-open PIPE, "$FIND * -type f -name '*.h' |"
+open $pipe, '-|', "$FIND * -type f -name '*.h'"
or die "can't fork: $!";
-while (<PIPE>)
+while (<$pipe>)
{
chomp;
push @hfiles, $_
unless m|^src/include/port/|
|| m|^src/backend/port/\w+/|;
}
-close PIPE or die "$FIND failed: $!";
+close $pipe or die "$FIND failed: $!";
#
# For each .h file, extract all the symbols it #define's, and add them to
@@ -71,16 +71,16 @@ my %defines;
foreach my $hfile (@hfiles)
{
- open HFILE, $hfile
+ open my $fh, '<', $hfile
or die "can't open $hfile: $!";
- while (<HFILE>)
+ while (<$fh>)
{
if (m/^\s*#\s*define\s+(\w+)/)
{
$defines{$1}{$hfile} = 1;
}
}
- close HFILE;
+ close $fh;
}
#
@@ -124,9 +124,9 @@ foreach my $file (@hfiles, @cfiles)
my ($CPPFLAGS, $CFLAGS, $CFLAGS_SL, $PTHREAD_CFLAGS, $CC);
- open PIPE, "$MAKECMD |"
+ open $pipe, '-|', "$MAKECMD"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^CPPFLAGS :?= (.*)/)
{
@@ -166,9 +166,9 @@ foreach my $file (@hfiles, @cfiles)
#
my @includes = ();
my $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname";
- open PIPE, "$COMPILE 2>&1 >/dev/null |"
+ open $pipe, '-|', "$COMPILE 2>&1 >/dev/null"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^\.+ (.*)/)
{
@@ -211,10 +211,10 @@ foreach my $file (@hfiles, @cfiles)
# We assume #ifdef isn't continued across lines, and that defined(foo)
# isn't split across lines either
#
- open FILE, $fname
+ open my $fh, '<', $fname
or die "can't open $file: $!";
my $inif = 0;
- while (<FILE>)
+ while (<$fh>)
{
my $line = $_;
if ($line =~ m/^\s*#\s*ifdef\s+(\w+)/)
@@ -241,7 +241,7 @@ foreach my $file (@hfiles, @cfiles)
}
}
}
- close FILE;
+ close $fh;
chdir $topdir or die "can't chdir to $topdir: $!";
}
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index 0d3859d029..a6b24b5348 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -160,7 +160,7 @@ sub process_exclude
{
chomp $line;
my $rgx;
- eval " \$rgx = qr!$line!;";
+ eval " \$rgx = qr!$line!;"; ## no critic (ProhibitStringyEval);
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
}
close($eh);
@@ -435,7 +435,7 @@ sub diff
sub run_build
{
- eval "use LWP::Simple;";
+ eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
my $code_base = shift || '.';
my $save_dir = getcwd();
diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl
index dc9173f234..f973dd950c 100755
--- a/src/tools/version_stamp.pl
+++ b/src/tools/version_stamp.pl
@@ -80,8 +80,8 @@
# (this also ensures we're in the right directory)
my $aconfver = "";
-open(FILE, "configure.in") || die "could not read configure.in: $!\n";
-while (<FILE>)
+open(my $fh, '<', "configure.in") || die "could not read configure.in: $!\n";
+while (<$fh>)
{
if (
m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
@@ -90,7 +90,7 @@
last;
}
}
-close(FILE);
+close($fh);
$aconfver ne ""
|| die "could not find autoconf version number in configure.in\n";
diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl
index 6345465b19..0bdcc3610f 100755
--- a/src/tools/win32tzlist.pl
+++ b/src/tools/win32tzlist.pl
@@ -58,11 +58,11 @@
# Fetch all timezones currently in the file
#
my @file_zones;
-open(TZFILE, "<$tzfile") or die "Could not open $tzfile!\n";
+open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
my $t = $/;
undef $/;
-my $pgtz = <TZFILE>;
-close(TZFILE);
+my $pgtz = <$tzfh>;
+close($tzfh);
$/ = $t;
# Attempt to locate and extract the complete win32_tzmap struct
--
2.12.0
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
