perlcritic
We now have 80+ Perl files in our tree, and it's growing. Some of those
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 a makefile that is not part of
the normal build process. I'll send in a few more patches to that in a
separate message that should help testing.
To install perlcritic, run
cpan -i Perl::Critic
and then run
perlcritic .
at the top of the tree (or a subdirectory).
Attachments:
0001-Clean-up-Perl-code-according-to-perlcritic-severity-.patchtext/x-patch; name=0001-Clean-up-Perl-code-according-to-perlcritic-severity-.patchDownload
>From e38edbf5f911eb67750cf890cfd384758e43466e Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter_e@gmx.net>
Date: Mon, 31 Aug 2015 23:06:07 -0400
Subject: [PATCH] Clean up Perl code according to perlcritic severity level 5
List of issues addressed:
123 Two-argument "open" used
114 Bareword file handle opened
35 Loop iterator is not lexical
26 "require" statement with library name as string
21 Code before strictures are enabled
3 Expression form of "eval"
2 Package declaration must match filename
1 Subroutine prototypes used
1 Stricture disabled
1 Glob written as <...>
1 Don't modify $_ in list functions
Many additional fixes were the result of enabling strictures, especially
undeclared local variables.
---
contrib/intarray/bench/create_test.pl | 20 +-
contrib/seg/seg-validate.pl | 35 +--
contrib/seg/sort-segments.pl | 10 +-
doc/src/sgml/generate-errcodes-table.pl | 2 +-
doc/src/sgml/mk_feature_tables.pl | 14 +-
src/backend/catalog/Catalog.pm | 8 +-
src/backend/catalog/genbki.pl | 64 ++---
src/backend/parser/check_keywords.pl | 30 +--
src/backend/utils/Gen_fmgrtab.pl | 24 +-
src/backend/utils/generate-errcodes.pl | 2 +-
src/backend/utils/mb/Unicode/UCS_to_BIG5.pl | 108 ++++----
src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl | 77 +++---
.../utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl | 297 ++++++++++-----------
src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl | 141 +++++-----
src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl | 77 +++---
src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl | 81 +++---
src/backend/utils/mb/Unicode/UCS_to_GB18030.pl | 65 ++---
.../utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl | 241 ++++++++---------
src/backend/utils/mb/Unicode/UCS_to_SJIS.pl | 75 +++---
src/backend/utils/mb/Unicode/UCS_to_most.pl | 85 +++---
.../utils/mb/Unicode/{ucs2utf.pl => ucs2utf.pm} | 8 +-
src/bin/pg_basebackup/t/010_pg_basebackup.pl | 20 +-
src/bin/pg_ctl/t/001_start_stop.pl | 10 +-
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 | 6 +-
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/test/locale/sort-test.pl | 6 +-
src/test/perl/TestLib.pm | 38 +--
src/test/ssl/ServerSetup.pm | 42 +--
src/test/ssl/t/001_ssltests.pl | 6 +-
src/tools/msvc/Install.pm | 10 +-
src/tools/msvc/Mkvcbuild.pm | 2 +-
src/tools/msvc/Project.pm | 28 +-
src/tools/msvc/Solution.pm | 166 ++++++------
src/tools/msvc/build.pl | 12 +-
src/tools/msvc/builddoc.pl | 2 +-
src/tools/msvc/gendef.pl | 24 +-
src/tools/msvc/install.pl | 4 +-
src/tools/msvc/mkvcbuild.pl | 4 +-
src/tools/msvc/pgbison.pl | 4 +-
src/tools/msvc/pgflex.pl | 18 +-
src/tools/msvc/vcregress.pl | 19 +-
src/tools/pginclude/pgcheckdefines | 91 ++++---
src/tools/pgindent/pgindent | 4 +-
src/tools/version_stamp.pl | 26 +-
src/tools/win32tzlist.pl | 6 +-
51 files changed, 1061 insertions(+), 1015 deletions(-)
rename src/backend/utils/mb/Unicode/{ucs2utf.pl => ucs2utf.pm} (92%)
diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl
index 1323b31..f3262df 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/contrib/seg/seg-validate.pl b/contrib/seg/seg-validate.pl
index cb3fb9a..b8957ed 100755
--- a/contrib/seg/seg-validate.pl
+++ b/contrib/seg/seg-validate.pl
@@ -1,20 +1,23 @@
#!/usr/bin/perl
-$integer = '[+-]?[0-9]+';
-$real = '[+-]?[0-9]+\.[0-9]+';
-
-$RANGE = '(\.\.)(\.)?';
-$PLUMIN = q(\'\+\-\');
-$FLOAT = "(($integer)|($real))([eE]($integer))?";
-$EXTENSION = '<|>|~';
-
-$boundary = "($EXTENSION)?$FLOAT";
-$deviation = $FLOAT;
-
-$rule_1 = $boundary . $PLUMIN . $deviation;
-$rule_2 = $boundary . $RANGE . $boundary;
-$rule_3 = $boundary . $RANGE;
-$rule_4 = $RANGE . $boundary;
-$rule_5 = $boundary;
+
+use strict;
+
+my $integer = '[+-]?[0-9]+';
+my $real = '[+-]?[0-9]+\.[0-9]+';
+
+my $RANGE = '(\.\.)(\.)?';
+my $PLUMIN = q(\'\+\-\');
+my $FLOAT = "(($integer)|($real))([eE]($integer))?";
+my $EXTENSION = '<|>|~';
+
+my $boundary = "($EXTENSION)?$FLOAT";
+my $deviation = $FLOAT;
+
+my $rule_1 = $boundary . $PLUMIN . $deviation;
+my $rule_2 = $boundary . $RANGE . $boundary;
+my $rule_3 = $boundary . $RANGE;
+my $rule_4 = $RANGE . $boundary;
+my $rule_5 = $boundary;
print "$rule_5\n";
diff --git a/contrib/seg/sort-segments.pl b/contrib/seg/sort-segments.pl
index a465468..04eafd9 100755
--- a/contrib/seg/sort-segments.pl
+++ b/contrib/seg/sort-segments.pl
@@ -2,6 +2,10 @@
# this script will sort any table with the segment data type in its last column
+use strict;
+
+my @rows;
+
while (<>)
{
chomp;
@@ -10,11 +14,11 @@
foreach (
sort {
- @ar = split("\t", $a);
- $valA = pop @ar;
+ my @ar = split("\t", $a);
+ my $valA = pop @ar;
$valA =~ s/[~<> ]+//g;
@ar = split("\t", $b);
- $valB = pop @ar;
+ my $valB = pop @ar;
$valB =~ s/[~<> ]+//g;
$valA <=> $valB
} @rows)
diff --git a/doc/src/sgml/generate-errcodes-table.pl b/doc/src/sgml/generate-errcodes-table.pl
index a7e630e..5e13be0 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 45dea79..9b111b8 100644
--- a/doc/src/sgml/mk_feature_tables.pl
+++ b/doc/src/sgml/mk_feature_tables.pl
@@ -2,13 +2,15 @@
# doc/src/sgml/mk_feature_tables.pl
+use strict;
+
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/;
@@ -22,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,
@@ -67,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 5e70418..c439152 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 d06eae0..a36179e 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 85c2e11..26a6bcb 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/utils/Gen_fmgrtab.pl b/src/backend/utils/Gen_fmgrtab.pl
index f5cc265..94e69c2 100644
--- a/src/backend/utils/Gen_fmgrtab.pl
+++ b/src/backend/utils/Gen_fmgrtab.pl
@@ -89,10 +89,10 @@
my $oidsfile = $output_path . 'fmgroids.h';
my $tabfile = $output_path . 'fmgrtab.c';
-open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$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 $tfh, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!";
-print H
+print $ofh
qq|/*-------------------------------------------------------------------------
*
* fmgroids.h
@@ -130,7 +130,7 @@
*/
|;
-print T
+print $tfh
qq|/*-------------------------------------------------------------------------
*
* fmgrtab.c
@@ -163,25 +163,25 @@
{
next if $seenit{ $s->{prosrc} };
$seenit{ $s->{prosrc} } = 1;
- print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
- print T "extern Datum $s->{prosrc} (PG_FUNCTION_ARGS);\n";
+ print $ofh "#define F_" . uc $s->{prosrc} . " $s->{oid}\n";
+ print $tfh "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 $ofh "\n#endif /* FMGROIDS_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) */
@@ -192,8 +192,8 @@
const int fmgr_nbuiltins = (sizeof(fmgr_builtins) / sizeof(FmgrBuiltin)) - 1;
|;
-close(H);
-close(T);
+close($ofh);
+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 53cb7ac..b16da76 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/backend/utils/mb/Unicode/UCS_to_BIG5.pl b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
index bd47929..f7c5561 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
@@ -24,33 +24,35 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
+use strict;
-require "ucs2utf.pl";
+require ucs2utf;
#
# first, generate UTF8 --> BIG5 table
#
-$in_file = "BIG5.TXT";
+my $in_file = "BIG5.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
+my %array;
+my $count = 0;
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -59,22 +61,22 @@
$array{$utf} = $code;
}
}
-close(FILE);
+close($fh);
$in_file = "CP950.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT
@@ -83,8 +85,8 @@
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -93,52 +95,52 @@
$array{$utf} = $code;
}
}
-close(FILE);
+close($fh);
-$file = lc("utf8_to_big5.map");
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapBIG5[ $count ] = {\n";
+my $file = lc("utf8_to_big5.map");
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapBIG5[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate BIG5 --> UTF8 table
#
$in_file = "BIG5.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
+%array = ();
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -147,22 +149,22 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$in_file = "CP950.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
# Pick only the ETEN extended characters in the range 0xf9d6 - 0xf9dc
# from CP950.TXT
@@ -171,8 +173,8 @@
&& $code >= 0xf9d6
&& $code <= 0xf9dc)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -181,24 +183,24 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$file = lc("big5_to_utf8.map");
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapBIG5[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapBIG5[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 bfc9912..cf1ffea 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
@@ -16,28 +16,33 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
+
+my %array;
+my $count = 0;
# first generate UTF-8 --> EUC_CN table
-$in_file = "GB2312.TXT";
+my $in_file = "GB2312.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -47,54 +52,54 @@
$array{$utf} = ($code | 0x8080);
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> EUC_CN table
#
-$file = "utf8_to_euc_cn.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapEUC_CN[ $count ] = {\n";
+my $file = "utf8_to_euc_cn.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapEUC_CN[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate EUC_JP --> UTF8 table
#
-reset 'array';
+%array = ();
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
@@ -105,24 +110,24 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$file = "euc_cn_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapEUC_CN[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapEUC_CN[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 7860736..9e6d5a4 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
@@ -7,102 +7,98 @@
# Generate UTF-8 <--> EUC_JIS_2004 code conversion tables from
# "euc-jis-2004-std.txt" (http://x0213.org)
-require "ucs2utf.pl";
+use strict;
-$TEST = 1;
+require ucs2utf;
+
+my $TEST = 1;
# first generate UTF-8 --> EUC_JIS_2004 table
-$in_file = "euc-jis-2004-std.txt";
+my $in_file = "euc-jis-2004-std.txt";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
-reset 'array1';
-reset 'comment';
-reset 'comment1';
+my (%array, %array1, %comment, %comment1);
+my $count = 0;
+my $count1 = 0;
-while ($line = <FILE>)
+while (my $line = <$fh>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u1 = $2;
- $u2 = $3;
- $rest = "U+" . $u1 . "+" . $u2 . $4;
- $code = hex($c);
- $ucs = hex($u1);
- $utf1 = &ucs2utf($ucs);
- $ucs = hex($u2);
- $utf2 = &ucs2utf($ucs);
- $str = sprintf "%08x%08x", $utf1, $utf2;
+ my $c = $1;
+ my $u1 = $2;
+ my $u2 = $3;
+ my $rest = "U+" . $u1 . "+" . $u2 . $4;
+ my $code = hex($c);
+ my $ucs = hex($u1);
+ my $utf1 = &ucs2utf($ucs);
+ $ucs = hex($u2);
+ my $utf2 = &ucs2utf($ucs);
+ my $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$str} = $code;
$comment1{$str} = $rest;
$count1++;
- next;
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u = $2;
- $rest = "U+" . $u . $3;
- }
- else
- {
- next;
- }
-
- $ucs = hex($u);
- $code = hex($c);
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
- {
- printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
- next;
+ my $c = $1;
+ my $u = $2;
+ my $rest = "U+" . $u . $3;
+ my $ucs = hex($u);
+ my $code = hex($c);
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
+ {
+ printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
+ next;
+ }
+ $array{$utf} = $code;
+ $comment{$code} = $rest;
+ $count++;
}
- $count++;
-
- $array{$utf} = $code;
- $comment{$code} = $rest;
}
-close(FILE);
+close($fh);
-$file = "utf8_to_euc_jis_2004.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE "static const pg_utf_to_local ULmapEUC_JIS_2004[] = {\n";
+my $file = "utf8_to_euc_jis_2004.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh "static const pg_utf_to_local ULmapEUC_JIS_2004[] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
+ printf $fh " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
$comment{$code};
}
else
{
- printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
+ printf $fh " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
$comment{$code};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
+
+my ($fh1, $fh2);
if ($TEST == 1)
{
- $file1 = "utf8.data";
- $file2 = "euc_jis_2004.data";
- open(FILE1, "> $file1") || die("cannot open $file1");
- open(FILE2, "> $file2") || die("cannot open $file2");
+ my $file1 = "utf8.data";
+ my $file2 = "euc_jis_2004.data";
+ open($fh1, '>', $file1) || die("cannot open $file1");
+ open($fh2, '>', $file2) || die("cannot open $file2");
- for $index (sort { $a <=> $b } keys(%array))
+ for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
if ( $code > 0x00
&& $code != 0x09
&& $code != 0x0a
@@ -113,53 +109,53 @@
|| ($code >= 0x8fa1a1 && $code <= 0x8ffefe)
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
- for ($i = 3; $i >= 0; $i--)
+ for (my $i = 3; $i >= 0; $i--)
{
- $s = $i * 8;
- $mask = 0xff << $s;
- print FILE1 pack("C", ($index & $mask) >> $s)
+ my $s = $i * 8;
+ my $mask = 0xff << $s;
+ print $fh1 pack("C", ($index & $mask) >> $s)
if $index & $mask;
- print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask;
+ print $fh2 pack("C", ($code & $mask) >> $s) if $code & $mask;
}
- print FILE1 "\n";
- print FILE2 "\n";
+ print $fh1 "\n";
+ print $fh2 "\n";
}
}
}
$file = "utf8_to_euc_jis_2004_combined.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh
"static const pg_utf_to_local_combined ULmapEUC_JIS_2004_combined[] = {\n";
-for $index (sort { $a cmp $b } keys(%array1))
+for my $index (sort { $a cmp $b } keys(%array1))
{
- $code = $array1{$index};
+ my $code = $array1{$index};
$count1--;
if ($count1 == 0)
{
- printf FILE " {0x%s, 0x%s, 0x%06x} /* %s */\n", substr($index, 0, 8),
+ printf $fh " {0x%s, 0x%s, 0x%06x} /* %s */\n", substr($index, 0, 8),
substr($index, 8, 8), $code, $comment1{$index};
}
else
{
- printf FILE " {0x%s, 0x%s, 0x%06x}, /* %s */\n",
+ printf $fh " {0x%s, 0x%s, 0x%06x}, /* %s */\n",
substr($index, 0, 8), substr($index, 8, 8), $code,
$comment1{$index};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
if ($TEST == 1)
{
- for $index (sort { $a cmp $b } keys(%array1))
+ for my $index (sort { $a cmp $b } keys(%array1))
{
- $code = $array1{$index};
+ my $code = $array1{$index};
if ( $code > 0x00
&& $code != 0x09
&& $code != 0x0a
@@ -171,135 +167,128 @@
|| ($code >= 0xa1a1 && $code <= 0x8fefe)))
{
- $v1 = hex(substr($index, 0, 8));
- $v2 = hex(substr($index, 8, 8));
+ my $v1 = hex(substr($index, 0, 8));
+ my $v2 = hex(substr($index, 8, 8));
- for ($i = 3; $i >= 0; $i--)
+ for (my $i = 3; $i >= 0; $i--)
{
- $s = $i * 8;
- $mask = 0xff << $s;
- print FILE1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask;
- print FILE2 pack("C", ($code & $mask) >> $s) if $code & $mask;
+ my $s = $i * 8;
+ my $mask = 0xff << $s;
+ print $fh1 pack("C", ($v1 & $mask) >> $s) if $v1 & $mask;
+ print $fh2 pack("C", ($code & $mask) >> $s) if $code & $mask;
}
- for ($i = 3; $i >= 0; $i--)
+ for (my $i = 3; $i >= 0; $i--)
{
- $s = $i * 8;
- $mask = 0xff << $s;
- print FILE1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask;
+ my $s = $i * 8;
+ my $mask = 0xff << $s;
+ print $fh1 pack("C", ($v2 & $mask) >> $s) if $v2 & $mask;
}
- print FILE1 "\n";
- print FILE2 "\n";
+ print $fh1 "\n";
+ print $fh2 "\n";
}
}
- close(FILE1);
- close(FILE2);
+ close($fh1);
+ close($fh2);
}
# then generate EUC_JIS_2004 --> UTF-8 table
$in_file = "euc-jis-2004-std.txt";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
-reset 'array1';
-reset 'comment';
-reset 'comment1';
+%array = ();
+%array1 = ();
+%comment = ();
+%comment1 = ();
-while ($line = <FILE>)
+while (my $line = <$fh>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u1 = $2;
- $u2 = $3;
- $rest = "U+" . $u1 . "+" . $u2 . $4;
- $code = hex($c);
- $ucs = hex($u1);
- $utf1 = &ucs2utf($ucs);
- $ucs = hex($u2);
- $utf2 = &ucs2utf($ucs);
- $str = sprintf "%08x%08x", $utf1, $utf2;
+ my $c = $1;
+ my $u1 = $2;
+ my $u2 = $3;
+ my $rest = "U+" . $u1 . "+" . $u2 . $4;
+ my $code = hex($c);
+ my $ucs = hex($u1);
+ my $utf1 = &ucs2utf($ucs);
+ $ucs = hex($u2);
+ my $utf2 = &ucs2utf($ucs);
+ my $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$code} = $str;
$comment1{$code} = $rest;
$count1++;
- next;
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u = $2;
- $rest = "U+" . $u . $3;
- }
- else
- {
- next;
- }
-
- $ucs = hex($u);
- $code = hex($c);
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
- {
- printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
- next;
+ my $c = $1;
+ my $u = $2;
+ my $rest = "U+" . $u . $3;
+ my $ucs = hex($u);
+ my $code = hex($c);
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
+ {
+ printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
+ next;
+ }
+ $array{$code} = $utf;
+ $comment{$utf} = $rest;
+ $count++;
}
- $count++;
-
- $array{$code} = $utf;
- $comment{$utf} = $rest;
}
-close(FILE);
+close($fh);
$file = "euc_jis_2004_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE "static const pg_local_to_utf LUmapEUC_JIS_2004[] = {\n";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh "static const pg_local_to_utf LUmapEUC_JIS_2004[] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%06x, 0x%08x} /* %s */\n", $index, $code,
+ printf $fh " {0x%06x, 0x%08x} /* %s */\n", $index, $code,
$comment{$code};
}
else
{
- printf FILE " {0x%06x, 0x%08x}, /* %s */\n", $index, $code,
+ printf $fh " {0x%06x, 0x%08x}, /* %s */\n", $index, $code,
$comment{$code};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
$file = "euc_jis_2004_to_utf8_combined.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_EUC_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh
"static const pg_local_to_utf_combined LUmapEUC_JIS_2004_combined[] = {\n";
-for $index (sort { $a <=> $b } keys(%array1))
+for my $index (sort { $a <=> $b } keys(%array1))
{
- $code = $array1{$index};
+ my $code = $array1{$index};
$count1--;
if ($count1 == 0)
{
- printf FILE " {0x%06x, 0x%s, 0x%s} /* %s */\n", $index,
+ printf $fh " {0x%06x, 0x%s, 0x%s} /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
else
{
- printf FILE " {0x%06x, 0x%s, 0x%s}, /* %s */\n", $index,
+ printf $fh " {0x%06x, 0x%s, 0x%s}, /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 79bc05b..30c5288 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
@@ -27,33 +27,36 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
# first generate UTF-8 --> EUC_JP table
#
# JIS0201
#
-$in_file = "JIS0201.TXT";
+my $in_file = "JIS0201.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
+my %array;
+my $count = 0;
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -64,29 +67,29 @@
$array{$utf} = ($code | 0x8e00);
}
}
-close(FILE);
+close($fh);
#
# JIS0208
#
$in_file = "JIS0208.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($s, $c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($s, $c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -96,29 +99,29 @@
$array{$utf} = ($code | 0x8080);
}
}
-close(FILE);
+close($fh);
#
# JIS0212
#
$in_file = "JIS0212.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -128,32 +131,32 @@
$array{$utf} = ($code | 0x8f8080);
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> EUC_JP table
#
-$file = "utf8_to_euc_jp.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapEUC_JP[ $count ] = {\n";
+my $file = "utf8_to_euc_jp.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapEUC_JP[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate EUC_JP --> UTF8 table
@@ -164,24 +167,24 @@
#
$in_file = "JIS0201.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '>', $in_file) || die("cannot open $in_file");
-reset 'array';
+%array = ();
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
@@ -193,29 +196,29 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
#
# JIS0208
#
$in_file = "JIS0208.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($s, $c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($s, $c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
@@ -226,29 +229,29 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
#
# JIS0212
#
$in_file = "JIS0212.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
@@ -259,24 +262,24 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$file = "euc_jp_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapEUC_JP[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapEUC_JP[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 fa553fd..1e3ac4e 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
@@ -16,28 +16,33 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
+
+my %array;
+my $count = 0;
# first generate UTF-8 --> EUC_KR table
-$in_file = "KSX1001.TXT";
+my $in_file = "KSX1001.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -47,54 +52,54 @@
$array{$utf} = ($code | 0x8080);
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> EUC_KR table
#
-$file = "utf8_to_euc_kr.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapEUC_KR[ $count ] = {\n";
+my $file = "utf8_to_euc_kr.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapEUC_KR[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate EUC_JP --> UTF8 table
#
-reset 'array';
+%array = ();
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
@@ -105,24 +110,24 @@
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$file = "euc_kr_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapEUC_KR[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapEUC_KR[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 02414ba..db09126 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
@@ -17,35 +17,40 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
# first generate UTF-8 --> EUC_TW table
-$in_file = "CNS11643.TXT";
+my %array;
+my $count = 0;
+
+my $in_file = "CNS11643.TXT";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
$count++;
- $plane = ($code & 0x1f0000) >> 16;
+ my $plane = ($code & 0x1f0000) >> 16;
if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n";
@@ -63,61 +68,61 @@
}
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> EUC_TW table
#
-$file = "utf8_to_euc_tw.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapEUC_TW[ $count ] = {\n";
+my $file = "utf8_to_euc_tw.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapEUC_TW[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate EUC_JP --> UTF8 table
#
-reset 'array';
+%array = ();
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate code: %04x\n", $ucs;
next;
}
$count++;
- $plane = ($code & 0x1f0000) >> 16;
+ my $plane = ($code & 0x1f0000) >> 16;
if ($plane > 16)
{
printf STDERR "Warning: invalid plane No.$plane. ignored\n";
@@ -134,24 +139,24 @@
$array{$c} = $utf;
}
}
-close(FILE);
+close($fh);
$file = "euc_tw_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapEUC_TW[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapEUC_TW[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
diff --git a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
index e73ed4d..ff46743 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
@@ -12,32 +12,37 @@
# where the "u" field is the Unicode code point in hex,
# and the "b" field is the hex byte sequence for GB18030
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
+
+my (%arrayc, %arrayu);
+my $count = 0;
# Read the input
-$in_file = "gb-18030-2000.xml";
+my $in_file = "gb-18030-2000.xml";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
next if (!m/<a u="([0-9A-F]+)" b="([0-9A-F ]+)"/);
- $u = $1;
- $c = $2;
+ my $u = $1;
+ my $c = $2;
$c =~ s/ //g;
- $ucs = hex($u);
- $code = hex($c);
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($arrayu{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($arrayu{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
}
- if ($arrayc{$code} ne "")
+ if (defined($arrayc{$code}))
{
printf STDERR "Warning: duplicate GB18030: %08x\n", $code;
next;
@@ -47,34 +52,34 @@
$count++;
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> GB18030 table
#
-$file = "utf8_to_gb18030.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapGB18030[ $count ] = {\n";
+my $file = "utf8_to_gb18030.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapGB18030[ $count ] = {\n";
-$cc = $count;
-for $index (sort { $a <=> $b } keys(%arrayu))
+my $cc = $count;
+for my $index (sort { $a <=> $b } keys(%arrayu))
{
- $code = $arrayu{$index};
+ my $code = $arrayu{$index};
$cc--;
if ($cc == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
@@ -82,23 +87,23 @@
#
$file = "gb18030_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapGB18030[ $count ] = {\n";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapGB18030[ $count ] = {\n";
$cc = $count;
-for $index (sort { $a <=> $b } keys(%arrayc))
+for my $index (sort { $a <=> $b } keys(%arrayc))
{
- $utf = $arrayc{$index};
+ my $utf = $arrayc{$index};
$cc--;
if ($cc == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
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 33d108e..f3d5b4f 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
@@ -7,228 +7,215 @@
# Generate UTF-8 <--> SHIFT_JIS_2004 code conversion tables from
# "sjis-0213-2004-std.txt" (http://x0213.org)
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
# first generate UTF-8 --> SHIFT_JIS_2004 table
-$in_file = "sjis-0213-2004-std.txt";
+my $in_file = "sjis-0213-2004-std.txt";
-open(FILE, $in_file) || die("cannot open $in_file");
+open(my $fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
-reset 'array1';
-reset 'comment';
-reset 'comment1';
+my (%array, %array1, %comment, %comment1);
+my $count = 0;
+my $count1 = 0;
-while ($line = <FILE>)
+while (my $line = <$fh>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u1 = $2;
- $u2 = $3;
- $rest = "U+" . $u1 . "+" . $u2 . $4;
- $code = hex($c);
- $ucs = hex($u1);
- $utf1 = &ucs2utf($ucs);
- $ucs = hex($u2);
- $utf2 = &ucs2utf($ucs);
- $str = sprintf "%08x%08x", $utf1, $utf2;
+ my $c = $1;
+ my $u1 = $2;
+ my $u2 = $3;
+ my $rest = "U+" . $u1 . "+" . $u2 . $4;
+ my $code = hex($c);
+ my $ucs = hex($u1);
+ my $utf1 = &ucs2utf($ucs);
+ $ucs = hex($u2);
+ my $utf2 = &ucs2utf($ucs);
+ my $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$str} = $code;
$comment1{$str} = $rest;
$count1++;
- next;
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u = $2;
- $rest = "U+" . $u . $3;
- }
- else
- {
- next;
- }
-
- $ucs = hex($u);
- $code = hex($c);
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
- {
- printf STDERR
- "Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
- $ucs, $code;
- next;
+ my $c = $1;
+ my $u = $2;
+ my $rest = "U+" . $u . $3;
+ my $ucs = hex($u);
+ my $code = hex($c);
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
+ {
+ printf STDERR
+ "Warning: duplicate UTF8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
+ $ucs, $code;
+ }
+ $array{$utf} = $code;
+ $comment{$code} = $rest;
+ $count++;
}
- $count++;
- $array{$utf} = $code;
- $comment{$code} = $rest;
}
-close(FILE);
+close($fh);
-$file = "utf8_to_shift_jis_2004.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE "static const pg_utf_to_local ULmapSHIFT_JIS_2004[] = {\n";
+my $file = "utf8_to_shift_jis_2004.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh "static const pg_utf_to_local ULmapSHIFT_JIS_2004[] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
+ printf $fh " {0x%08x, 0x%06x} /* %s */\n", $index, $code,
$comment{$code};
}
else
{
- printf FILE " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
+ printf $fh " {0x%08x, 0x%06x}, /* %s */\n", $index, $code,
$comment{$code};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
$file = "utf8_to_shift_jis_2004_combined.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh
"static const pg_utf_to_local_combined ULmapSHIFT_JIS_2004_combined[] = {\n";
-for $index (sort { $a cmp $b } keys(%array1))
+for my $index (sort { $a cmp $b } keys(%array1))
{
- $code = $array1{$index};
+ my $code = $array1{$index};
$count1--;
if ($count1 == 0)
{
- printf FILE " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8),
+ printf $fh " {0x%s, 0x%s, 0x%04x} /* %s */\n", substr($index, 0, 8),
substr($index, 8, 8), $code, $comment1{$index};
}
else
{
- printf FILE " {0x%s, 0x%s, 0x%04x}, /* %s */\n",
+ printf $fh " {0x%s, 0x%s, 0x%04x}, /* %s */\n",
substr($index, 0, 8), substr($index, 8, 8), $code,
$comment1{$index};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
# then generate SHIFT_JIS_2004 --> UTF-8 table
$in_file = "sjis-0213-2004-std.txt";
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
-reset 'array1';
-reset 'comment';
-reset 'comment1';
+%array = ();
+%array1 = ();
+%comment = ();
+%comment1 = ();
-while ($line = <FILE>)
+while (my $line = <$fh>)
{
if ($line =~ /^0x(.*)[ \t]*U\+(.*)\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u1 = $2;
- $u2 = $3;
- $rest = "U+" . $u1 . "+" . $u2 . $4;
- $code = hex($c);
- $ucs = hex($u1);
- $utf1 = &ucs2utf($ucs);
- $ucs = hex($u2);
- $utf2 = &ucs2utf($ucs);
- $str = sprintf "%08x%08x", $utf1, $utf2;
+ my $c = $1;
+ my $u1 = $2;
+ my $u2 = $3;
+ my $rest = "U+" . $u1 . "+" . $u2 . $4;
+ my $code = hex($c);
+ my $ucs = hex($u1);
+ my $utf1 = &ucs2utf($ucs);
+ $ucs = hex($u2);
+ my $utf2 = &ucs2utf($ucs);
+ my $str = sprintf "%08x%08x", $utf1, $utf2;
$array1{$code} = $str;
$comment1{$code} = $rest;
$count1++;
- next;
}
elsif ($line =~ /^0x(.*)[ \t]*U\+(.*)[ \t]*#(.*)$/)
{
- $c = $1;
- $u = $2;
- $rest = "U+" . $u . $3;
+ my $c = $1;
+ my $u = $2;
+ my $rest = "U+" . $u . $3;
+ my $ucs = hex($u);
+ my $code = hex($c);
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
+ {
+ printf STDERR
+ "Warning: duplicate UTF-8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
+ $ucs, $code;
+ printf STDERR "Previous value: UTF-8: %08x\n", $array{$utf};
+ next;
+ }
+ $array{$code} = $utf;
+ $comment{$utf} = $rest;
+ $count++;
}
- else
- {
- next;
- }
-
- $ucs = hex($u);
- $code = hex($c);
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
- {
- printf STDERR
- "Warning: duplicate UTF-8: %08x UCS: %04x Shift JIS: %04x\n", $utf,
- $ucs, $code;
- printf STDERR "Previous value: UTF-8: %08x\n", $array{$utf};
- next;
- }
- $count++;
-
- $array{$code} = $utf;
- $comment{$utf} = $rest;
}
-close(FILE);
+close($fh);
$file = "shift_jis_2004_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_SHIFTJIS_2004.pl\n";
-print FILE " */\n";
-print FILE "static const pg_local_to_utf LUmapSHIFT_JIS_2004[] = {\n";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_SHIFTJIS_2004.pl\n";
+print $fh " */\n";
+print $fh "static const pg_local_to_utf LUmapSHIFT_JIS_2004[] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%08x} /* %s */\n", $index, $code,
+ printf $fh " {0x%04x, 0x%08x} /* %s */\n", $index, $code,
$comment{$code};
}
else
{
- printf FILE " {0x%04x, 0x%08x}, /* %s */\n", $index, $code,
+ printf $fh " {0x%04x, 0x%08x}, /* %s */\n", $index, $code,
$comment{$code};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
$file = "shift_jis_2004_to_utf8_combined.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "/*\n";
-print FILE " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
-print FILE " */\n";
-print FILE
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "/*\n";
+print $fh " * This file was generated by UCS_to_SHIFT_JIS_2004.pl\n";
+print $fh " */\n";
+print $fh
"static const pg_local_to_utf_combined LUmapSHIFT_JIS_2004_combined[] = {\n";
-for $index (sort { $a <=> $b } keys(%array1))
+for my $index (sort { $a <=> $b } keys(%array1))
{
- $code = $array1{$index};
+ my $code = $array1{$index};
$count1--;
if ($count1 == 0)
{
- printf FILE " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index,
+ printf $fh " {0x%04x, 0x%s, 0x%s} /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
else
{
- printf FILE " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index,
+ printf $fh " {0x%04x, 0x%s, 0x%s}, /* %s */\n", $index,
substr($code, 0, 8), substr($code, 8, 8), $comment1{$index};
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
diff --git a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
index 74cd7ac..01f72d8 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
@@ -17,28 +17,33 @@
# # and Unicode name (not used in this script)
# Warning: SHIFTJIS.TXT contains only JIS0201 and JIS0208. no JIS0212.
-require "ucs2utf.pl";
+use strict;
+
+require ucs2utf;
# first generate UTF-8 --> SJIS table
-$in_file = "CP932.TXT";
-$count = 0;
+my $in_file = "CP932.TXT";
+my $count = 0;
+my %array;
+
+my $fh;
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
+ my $utf = &ucs2utf($ucs);
if ((($code >= 0xed40) && ($code <= 0xeefc))
|| ( ($code >= 0x8754)
&& ($code <= 0x875d))
@@ -64,78 +69,78 @@
}
}
-close(FILE);
+close($fh);
#
# first, generate UTF8 --> SJIS table
#
-$file = "utf8_to_sjis.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_utf_to_local ULmapSJIS[ $count ] = {\n";
+my $file = "utf8_to_sjis.map";
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_utf_to_local ULmapSJIS[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
#
# then generate SJIS --> UTF8 table
#
-open(FILE, $in_file) || die("cannot open $in_file");
+open($fh, '<', $in_file) || die("cannot open $in_file");
-reset 'array';
+%array = ();
$count = 0;
-while (<FILE>)
+while (<$fh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
+ my $utf = &ucs2utf($ucs);
$count++;
$array{$code} = $utf;
}
}
-close(FILE);
+close($fh);
$file = "sjis_to_utf8.map";
-open(FILE, "> $file") || die("cannot open $file");
-print FILE "static const pg_local_to_utf LUmapSJIS[ $count ] = {\n";
-for $index (sort { $a <=> $b } keys(%array))
+open($fh, '>', $file) || die("cannot open $file");
+print $fh "static const pg_local_to_utf LUmapSJIS[ $count ] = {\n";
+for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $fh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
-print FILE "};\n";
-close(FILE);
+print $fh "};\n";
+close($fh);
diff --git a/src/backend/utils/mb/Unicode/UCS_to_most.pl b/src/backend/utils/mb/Unicode/UCS_to_most.pl
index 94e13fa..7a35c7f 100644
--- a/src/backend/utils/mb/Unicode/UCS_to_most.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_most.pl
@@ -15,9 +15,12 @@
# UCS-2 code in hex
# # and Unicode name (not used in this script)
-require "ucs2utf.pl";
+use strict;
+use warnings;
-%filename = (
+require ucs2utf;
+
+my %filename = (
'WIN866' => 'CP866.TXT',
'WIN874' => 'CP874.TXT',
'WIN1250' => 'CP1250.TXT',
@@ -48,34 +51,36 @@
'UHC' => 'CP949.TXT',
'JOHAB' => 'JOHAB.TXT',);
-@charsets = keys(filename);
+my @charsets = keys(%filename);
@charsets = @ARGV if scalar(@ARGV);
-foreach $charset (@charsets)
+foreach my $charset (@charsets)
{
#
# first, generate UTF8-> charset table
#
- $in_file = $filename{$charset};
+ my $in_file = $filename{$charset};
+
+ open(my $ifh, '<', $in_file) || die("cannot open $in_file");
- open(FILE, $in_file) || die("cannot open $in_file");
+ my %array;
- reset 'array';
+ my $count = 0;
- while (<FILE>)
+ while (<$ifh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$utf} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$utf}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -84,50 +89,50 @@
$array{$utf} = $code;
}
}
- close(FILE);
+ close($ifh);
- $file = lc("utf8_to_${charset}.map");
- open(FILE, "> $file") || die("cannot open $file");
- print FILE "static const pg_utf_to_local ULmap${charset}[ $count ] = {\n";
+ my $file = lc("utf8_to_${charset}.map");
+ open(my $ofh, '>', $file) || die("cannot open $file");
+ print $ofh "static const pg_utf_to_local ULmap${charset}[ $count ] = {\n";
- for $index (sort { $a <=> $b } keys(%array))
+ for my $index (sort { $a <=> $b } keys(%array))
{
- $code = $array{$index};
+ my $code = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $code;
+ printf $ofh " {0x%04x, 0x%04x}\n", $index, $code;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $code;
+ printf $ofh " {0x%04x, 0x%04x},\n", $index, $code;
}
}
- print FILE "};\n";
- close(FILE);
+ print $ofh "};\n";
+ close($ofh);
#
# then generate character set code ->UTF8 table
#
- open(FILE, $in_file) || die("cannot open $in_file");
+ open($ifh, '<', $in_file) || die("cannot open $in_file");
- reset 'array';
+ %array = ();
- while (<FILE>)
+ while (<$ifh>)
{
chop;
if (/^#/)
{
next;
}
- ($c, $u, $rest) = split;
- $ucs = hex($u);
- $code = hex($c);
+ my ($c, $u, $rest) = split;
+ my $ucs = hex($u);
+ my $code = hex($c);
if ($code >= 0x80 && $ucs >= 0x0080)
{
- $utf = &ucs2utf($ucs);
- if ($array{$code} ne "")
+ my $utf = &ucs2utf($ucs);
+ if (defined($array{$code}))
{
printf STDERR "Warning: duplicate UTF8: %04x\n", $ucs;
next;
@@ -136,25 +141,25 @@
$array{$code} = $utf;
}
}
- close(FILE);
+ close($ifh);
$file = lc("${charset}_to_utf8.map");
- open(FILE, "> $file") || die("cannot open $file");
- print FILE "static const pg_local_to_utf LUmap${charset}[ $count ] = {\n";
- for $index (sort { $a <=> $b } keys(%array))
+ open($ofh, '>', $file) || die("cannot open $file");
+ print $ofh "static const pg_local_to_utf LUmap${charset}[ $count ] = {\n";
+ for my $index (sort { $a <=> $b } keys(%array))
{
- $utf = $array{$index};
+ my $utf = $array{$index};
$count--;
if ($count == 0)
{
- printf FILE " {0x%04x, 0x%04x}\n", $index, $utf;
+ printf $ofh " {0x%04x, 0x%04x}\n", $index, $utf;
}
else
{
- printf FILE " {0x%04x, 0x%04x},\n", $index, $utf;
+ printf $ofh " {0x%04x, 0x%04x},\n", $index, $utf;
}
}
- print FILE "};\n";
- close(FILE);
+ print $ofh "};\n";
+ close($ofh);
}
diff --git a/src/backend/utils/mb/Unicode/ucs2utf.pl b/src/backend/utils/mb/Unicode/ucs2utf.pm
similarity index 92%
rename from src/backend/utils/mb/Unicode/ucs2utf.pl
rename to src/backend/utils/mb/Unicode/ucs2utf.pm
index a096056..e8351d0 100644
--- a/src/backend/utils/mb/Unicode/ucs2utf.pl
+++ b/src/backend/utils/mb/Unicode/ucs2utf.pm
@@ -4,10 +4,14 @@
# src/backend/utils/mb/Unicode/ucs2utf.pl
# convert UCS-4 to UTF-8
#
+
+use strict;
+use warnings;
+
sub ucs2utf
{
- local ($ucs) = @_;
- local $utf;
+ my ($ucs) = @_;
+ my $utf;
if ($ucs <= 0x007f)
{
diff --git a/src/bin/pg_basebackup/t/010_pg_basebackup.pl b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
index dc96bbf..8d01bf2 100644
--- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl
+++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
@@ -20,10 +20,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;
}
configure_hba_for_replication "$tempdir/pgdata";
@@ -33,11 +33,11 @@
[ 'pg_basebackup', '-D', "$tempdir/backup" ],
'pg_basebackup fails because of WAL configuration');
-open CONF, ">>$tempdir/pgdata/postgresql.conf";
-print CONF "max_replication_slots = 10\n";
-print CONF "max_wal_senders = 10\n";
-print CONF "wal_level = archive\n";
-close CONF;
+open my $conf, '>>', "$tempdir/pgdata/postgresql.conf";
+print $conf "max_replication_slots = 10\n";
+print $conf "max_wal_senders = 10\n";
+print $conf "wal_level = archive\n";
+close $conf;
restart_test_server;
command_ok([ 'pg_basebackup', '-D', "$tempdir/backup" ],
@@ -83,8 +83,8 @@
my $superlongname = "superlongname_" . ("x" x 100);
my $superlongpath = "$tempdir/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;
command_fails([ 'pg_basebackup', '-D', "$tempdir/tarbackup_l1", '-Ft' ],
'pg_basebackup tar with long name fails');
unlink "$tempdir/pgdata/$superlongname";
diff --git a/src/bin/pg_ctl/t/001_start_stop.pl b/src/bin/pg_ctl/t/001_start_stop.pl
index dae47a8..6eb8fa4 100644
--- a/src/bin/pg_ctl/t/001_start_stop.pl
+++ b/src/bin/pg_ctl/t/001_start_stop.pl
@@ -19,17 +19,17 @@
[ $ENV{PG_REGRESS}, '--config-auth',
"$tempdir/data" ],
'configure authentication');
-open CONF, ">>$tempdir/data/postgresql.conf";
+open my $conf, '>>', "$tempdir/data/postgresql.conf";
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", '-w' ],
'pg_ctl start -w');
command_ok([ 'pg_ctl', 'start', '-D', "$tempdir/data", '-w' ],
diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl
index bbebe52..3d0b704 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.
*
@@ -74,7 +74,7 @@
";
-print CFILE "/*
+print $cfile_handle "/*
* *** Do not change this file by hand. It is automatically
* *** generated from the DocBook documentation.
*
@@ -96,9 +96,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 =~
@@ -170,8 +170,8 @@
$synopsis =~ s/\\n/\\n"\n$prefix"/g;
my @args =
("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} }));
- print HFILE "extern void sql_help_$id(PQExpBuffer buf);\n";
- print CFILE "void
+ print $hfile_handle "extern void sql_help_$id(PQExpBuffer buf);\n";
+ print $cfile_handle "void
sql_help_$id(PQExpBuffer buf)
{
\tappendPQExpBuffer(" . join(",\n$prefix", @args) . ");
@@ -180,7 +180,7 @@
";
}
-print HFILE "
+print $hfile_handle "
static const struct _helpStruct QL_HELP[] = {
";
@@ -188,7 +188,7 @@
{
my $id = $_;
$id =~ s/ /_/g;
- print HFILE " { \"$_\",
+ print $hfile_handle " { \"$_\",
N_(\"$entries{$_}{cmddesc}\"),
sql_help_$id,
$entries{$_}{nl_count} },
@@ -196,7 +196,7 @@
";
}
-print HFILE "
+print $hfile_handle "
{ NULL, NULL, NULL } /* End of list marker */
};
@@ -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 d537773..6ad4b67 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 1dab122..b61f36b 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 d506d01..292c910 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -1,5 +1,7 @@
# src/pl/plperl/plc_perlboot.pl
+use strict;
+
use 5.008001;
use vars qw(%_SHARED $_TD);
@@ -50,7 +52,7 @@ sub ::encode_array_constructor
{
- package PostgreSQL::InServer;
+ package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage);
use strict;
use warnings;
@@ -84,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 cd61882..38255b4 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 c88e5ec..e681fca 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 3e9a1a4..64e8efc 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 b329378..e4844e6 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/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index ce7b93c..157893e 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -1,9 +1,9 @@
#! /usr/bin/perl
+
+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/TestLib.pm b/src/test/perl/TestLib.pm
index 4927d45..8938e34 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -55,13 +55,13 @@ mkdir $log_path;
my $test_logfile = basename($0);
$test_logfile =~ s/\.[^.]+$//;
$test_logfile = "$log_path/regress_log_$test_logfile";
-open TESTLOG, '>', $test_logfile or die "Cannot open STDOUT to logfile: $!";
+open my $testlog, '>', $test_logfile or die "Cannot open STDOUT to 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
@@ -69,16 +69,16 @@ open(STDERR, ">&TESTLOG");
# 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;
# Set to untranslated messages, to be able to compare program output
# with expected strings.
@@ -141,18 +141,18 @@ sub standard_initdb
my $tempdir_short = tempdir_short;
- open CONF, ">>$pgdata/postgresql.conf";
- print CONF "\n# Added by TestLib.pm)\n";
+ open my $conf, '>>', "$pgdata/postgresql.conf";
+ print $conf "\n# Added by TestLib.pm)\n";
if ($windows_os)
{
- print CONF "listen_addresses = '127.0.0.1'\n";
+ print $conf "listen_addresses = '127.0.0.1'\n";
}
else
{
- print CONF "unix_socket_directories = '$tempdir_short'\n";
- print CONF "listen_addresses = ''\n";
+ print $conf "unix_socket_directories = '$tempdir_short'\n";
+ print $conf "listen_addresses = ''\n";
}
- close CONF;
+ close $conf;
$ENV{PGHOST} = $windows_os ? "127.0.0.1" : $tempdir_short;
}
@@ -163,17 +163,17 @@ sub configure_hba_for_replication
{
my $pgdata = shift;
- open HBA, ">>$pgdata/pg_hba.conf";
- print HBA "\n# Allow replication (set up by TestLib.pm)\n";
+ open my $hba, '>>', "$pgdata/pg_hba.conf";
+ print $hba "\n# Allow replication (set up by TestLib.pm)\n";
if (! $windows_os)
{
- print HBA "local replication all trust\n";
+ print $hba "local replication all trust\n";
}
else
{
- print HBA "host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n";
+ print $hba "host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n";
}
- close HBA;
+ close $hba;
}
my ($test_server_datadir, $test_server_logfile);
diff --git a/src/test/ssl/ServerSetup.pm b/src/test/ssl/ServerSetup.pm
index a8228b0..f62f4db 100644
--- a/src/test/ssl/ServerSetup.pm
+++ b/src/test/ssl/ServerSetup.pm
@@ -54,16 +54,16 @@ sub configure_test_server_for_ssl
psql 'postgres', "CREATE DATABASE certdb";
# enable logging etc.
- open CONF, ">>$tempdir/pgdata/postgresql.conf";
- print CONF "fsync=off\n";
- print CONF "log_connections=on\n";
- print CONF "log_hostname=on\n";
- print CONF "log_statement=all\n";
+ open my $conf, '>>', "$tempdir/pgdata/postgresql.conf";
+ print $conf "fsync=off\n";
+ print $conf "log_connections=on\n";
+ print $conf "log_hostname=on\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;
# Copy all server certificates and keys, and client root cert, to the data dir
copy_files("ssl/server-*.crt", "$tempdir/pgdata");
@@ -76,18 +76,18 @@ sub configure_test_server_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, ">$tempdir/pgdata/pg_hba.conf";
- print HBA
+ open my $hba, '>', "$tempdir/pgdata/pg_hba.conf";
+ print $hba
"# TYPE DATABASE USER ADDRESS METHOD\n";
- print HBA
+ print $hba
"hostssl trustdb ssltestuser 127.0.0.1/32 trust\n";
- print HBA
+ print $hba
"hostssl trustdb ssltestuser ::1/128 trust\n";
- print HBA
+ print $hba
"hostssl certdb ssltestuser 127.0.0.1/32 cert\n";
- print HBA
+ print $hba
"hostssl certdb ssltestuser ::1/128 cert\n";
- close HBA;
+ close $hba;
}
# Change the configuration to use given server cert file, and restart
@@ -99,13 +99,13 @@ sub switch_server_cert
diag "Restarting server with certfile \"$certfile\"...";
- open SSLCONF, ">$tempdir/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;
+ open my $sslconf, '>', "$tempdir/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;
# Stop and restart server to reload the new config. We cannot use
# restart_test_server() because that overrides listen_addresses to only all
diff --git a/src/test/ssl/t/001_ssltests.pl b/src/test/ssl/t/001_ssltests.pl
index 5d24d8d..c7bf764 100644
--- a/src/test/ssl/t/001_ssltests.pl
+++ b/src/test/ssl/t/001_ssltests.pl
@@ -43,10 +43,10 @@ sub run_test_psql
'psql', '-A', '-t', '-c', "SELECT 'connected with $connstr'",
'-d', "$connstr" ];
- open CLIENTLOG, ">>$tempdir/client-log"
+ open my $clientlog, '>>', "$tempdir/client-log"
or die "Could not open client-log file";
- print CLIENTLOG "\n# Running test: $connstr $logstring\n";
- close CLIENTLOG;
+ print $clientlog "\n# Running test: $connstr $logstring\n";
+ close $clientlog;
my $result = run $cmd, '>>', "$tempdir/client-log", '2>&1';
return $result;
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm
index f955725..a3dfaba 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";
}
- 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);
@@ -402,7 +402,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');
@@ -722,7 +722,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 3abbb4c..13eb20a 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -839,7 +839,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 4ce0941..6377390 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 6b16e69..82483de 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -108,14 +108,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
@@ -124,9 +124,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\], \[([^\]]+)\]/)
{
@@ -139,7 +139,7 @@ sub GenerateFiles
$self->{majorver} = sprintf("%d.%d", $1, $2);
}
}
- close(C);
+ close($c);
confess "Unable to parse configure.in for all variables!"
if ($self->{strver} eq '' || $self->{numver} eq '');
@@ -152,93 +152,93 @@ 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_INTEGER_DATETIMES 1\n"
+ print $o "#define USE_INTEGER_DATETIMES 1\n"
if ($self->{options}->{integer_datetimes});
- 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(
@@ -344,17 +344,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'))
@@ -380,25 +380,25 @@ 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 "#define USE_INTEGER_DATETIMES 1\n"
+ print $o "#define USE_INTEGER_DATETIMES 1\n"
if ($self->{options}->{integer_datetimes});
- 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"
@@ -412,7 +412,7 @@ EOF
#define HTMLDIR "/doc"
#define MANDIR "/man"
EOF
- close(O);
+ close($o);
}
my $mf = Project::read_file('src/backend/catalog/Makefile');
@@ -441,13 +441,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
@@ -457,18 +457,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);
}
}
@@ -537,19 +537,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
@@ -557,14 +557,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}
@@ -577,7 +577,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}
@@ -586,7 +586,7 @@ EOF
}
}
- print SLN <<EOF;
+ print $sln <<EOF;
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
@@ -599,15 +599,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 e107d41..5db0ed4 100644
--- a/src/tools/msvc/build.pl
+++ b/src/tools/msvc/build.pl
@@ -2,6 +2,8 @@
# src/tools/msvc/build.pl
+use strict;
+
BEGIN
{
@@ -21,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);
@@ -66,6 +68,6 @@ BEGIN
# report status
-$status = $? >> 8;
+my $status = $? >> 8;
exit $status;
diff --git a/src/tools/msvc/builddoc.pl b/src/tools/msvc/builddoc.pl
index 2b56ced..e0b5c50 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 8ccaab3..e0a7477 100644
--- a/src/tools/msvc/gendef.pl
+++ b/src/tools/msvc/gendef.pl
@@ -1,10 +1,10 @@
-my @def;
-
-use warnings;
use strict;
+use warnings;
use 5.8.0;
use List::Util qw(max);
+my @def;
+
#
# Script that generates a .DEF file for all objects in a directory
#
@@ -29,8 +29,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:
@@ -112,14 +112,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';
@@ -132,14 +132,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);
}
@@ -171,7 +171,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 bde5b7c..b2d7f9e 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 6f1c42e..9255dff 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 31e7540..e799d90 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 c5b90ad..f3b3e74 100644
--- a/src/tools/msvc/pgflex.pl
+++ b/src/tools/msvc/pgflex.pl
@@ -2,15 +2,15 @@
# src/tools/msvc/pgflex.pl
-# silence flex bleatings about file path style
-$ENV{CYGWIN} = 'nodosfilewarning';
-
use strict;
use File::Basename;
+# silence flex bleatings about file path style
+$ENV{CYGWIN} = 'nodosfilewarning';
+
# 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];
@@ -40,7 +40,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);
@@ -56,24 +56,24 @@
# For reentrant scanners (like the core scanner) we do not
# need to (and must not) change the yywrap definition.
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/)
{
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 reading: $!";
+ open($cfile, '>', $output) || die "opening $output for reading: $!";
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 d3d736b..1f20c42 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 || "";
@@ -435,8 +435,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>;
@@ -451,8 +451,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)
@@ -470,8 +471,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 5db5070..aa7c9c2 100755
--- a/src/tools/pginclude/pgcheckdefines
+++ b/src/tools/pginclude/pgcheckdefines
@@ -20,14 +20,16 @@
# src/tools/pginclude/pgcheckdefines
#
+use strict;
+
use Cwd;
use File::Basename;
-$topdir = cwd();
+my $topdir = cwd();
# Programs to use
-$FIND = "find";
-$MAKE = "make";
+my $FIND = "find";
+my $MAKE = "make";
#
# Build arrays of all the .c and .h files in the tree
@@ -38,43 +40,47 @@ $MAKE = "make";
# Including these .h files would clutter the list of define'd symbols and
# cause a lot of false-positive results.
#
-open PIPE, "$FIND * -type f -name '*.c' |"
+my (@cfiles, @hfiles);
+
+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
# a hash table. To cover the possibility of multiple .h files defining
# the same symbol, we make each hash entry a hash of filenames.
#
-foreach $hfile (@hfiles)
+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;
}
#
@@ -82,9 +88,9 @@ foreach $hfile (@hfiles)
# files it #include's. Then extract all the symbols it tests for defined-ness,
# and check each one against the previously built hashtable.
#
-foreach $file (@hfiles, @cfiles)
+foreach my $file (@hfiles, @cfiles)
{
- ($fname, $fpath) = fileparse($file);
+ my ($fname, $fpath) = fileparse($file);
chdir $fpath or die "can't chdir to $fpath: $!";
#
@@ -96,16 +102,18 @@ foreach $file (@hfiles, @cfiles)
# hence printing multiple definitions --- we keep the last one, which
# should come from the current Makefile.
#
+ my $MAKECMD;
+
if (-f "Makefile" || -f "GNUmakefile")
{
$MAKECMD = "$MAKE -qp";
}
else
{
- $subdir = $fpath;
+ my $subdir = $fpath;
chop $subdir;
- $top_builddir = "..";
- $tmp = $fpath;
+ my $top_builddir = "..";
+ my $tmp = $fpath;
while (($tmp = dirname($tmp)) ne '.')
{
$top_builddir = $top_builddir . "/..";
@@ -113,9 +121,12 @@ foreach $file (@hfiles, @cfiles)
$MAKECMD =
"$MAKE -qp 'subdir=$subdir' 'top_builddir=$top_builddir' -f '$top_builddir/src/Makefile.global'";
}
- open PIPE, "$MAKECMD |"
+
+ my ($CPPFLAGS, $CFLAGS, $CFLAGS_SL, $PTHREAD_CFLAGS, $CC);
+
+ open $pipe, '-|', "$MAKECMD"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^CPPFLAGS :?= (.*)/)
{
@@ -153,15 +164,15 @@ foreach $file (@hfiles, @cfiles)
# "gcc -H" reports inclusions on stderr as "... filename" where the
# number of dots varies according to nesting depth.
#
- @includes = ();
- $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname";
- open PIPE, "$COMPILE 2>&1 >/dev/null |"
+ my @includes = ();
+ my $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname";
+ open $pipe, '-|', "$COMPILE 2>&1 >/dev/null"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^\.+ (.*)/)
{
- $include = $1;
+ my $include = $1;
# Ignore system headers (absolute paths); but complain if a
# .c file includes a system header before any PG header.
@@ -176,7 +187,7 @@ foreach $file (@hfiles, @cfiles)
$include =~ s|^\./||;
# Make path relative to top of tree
- $ipath = $fpath;
+ my $ipath = $fpath;
while ($include =~ s|^\.\./||)
{
$ipath = dirname($ipath) . "/";
@@ -200,21 +211,19 @@ foreach $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: $!";
- $inif = 0;
- while (<FILE>)
+ my $inif = 0;
+ while (<$fh>)
{
- $line = $_;
+ my $line = $_;
if ($line =~ m/^\s*#\s*ifdef\s+(\w+)/)
{
- $symbol = $1;
- &checkit;
+ checkit($file, $1, @includes);
}
if ($line =~ m/^\s*#\s*ifndef\s+(\w+)/)
{
- $symbol = $1;
- &checkit;
+ checkit($file, $1, @includes);
}
if ($line =~ m/^\s*#\s*if\s+/)
{
@@ -224,8 +233,7 @@ foreach $file (@hfiles, @cfiles)
{
while ($line =~ s/\bdefined(\s+|\s*\(\s*)(\w+)//)
{
- $symbol = $2;
- &checkit;
+ checkit($file, $2, @includes);
}
if (!($line =~ m/\\$/))
{
@@ -233,7 +241,7 @@ foreach $file (@hfiles, @cfiles)
}
}
}
- close FILE;
+ close $fh;
chdir $topdir or die "can't chdir to $topdir: $!";
}
@@ -243,6 +251,7 @@ exit 0;
# Check an is-defined reference
sub checkit
{
+ my ($file, $symbol, @includes) = @_;
# Ignore if symbol isn't defined in any PG include files
if (!defined $defines{$symbol})
@@ -258,10 +267,10 @@ sub checkit
# occur after the use of the symbol. Given our normal file layout,
# however, the risk is minimal.
#
- foreach $deffile (keys %{ $defines{$symbol} })
+ foreach my $deffile (keys %{ $defines{$symbol} })
{
return if $deffile eq $file;
- foreach $reffile (@includes)
+ foreach my $reffile (@includes)
{
return if $deffile eq $reffile;
}
@@ -273,7 +282,7 @@ sub checkit
#
if ($file =~ m/\.h$/)
{
- foreach $deffile (keys %{ $defines{$symbol} })
+ foreach my $deffile (keys %{ $defines{$symbol} })
{
return if $deffile eq 'src/include/c.h';
return if $deffile eq 'src/include/postgres.h';
@@ -284,7 +293,7 @@ sub checkit
}
#
- @places = keys %{ $defines{$symbol} };
+ my @places = keys %{ $defines{$symbol} };
print "$file references $symbol, defined in @places\n";
# print "includes: @includes\n";
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index 0d3859d..a6b24b5 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 607649a..d312b4a 100755
--- a/src/tools/version_stamp.pl
+++ b/src/tools/version_stamp.pl
@@ -20,15 +20,19 @@
# "devel", "alphaN", "betaN", "rcN".
#
+use strict;
+
# Major version is hard-wired into the script. We update it when we branch
# a new development version.
-$major1 = 9;
-$major2 = 6;
+my $major1 = 9;
+my $major2 = 6;
# Validate argument and compute derived variables
-$minor = shift;
+my $minor = shift;
defined($minor) || die "$0: missing required argument: minor-version\n";
+my ($dotneeded, $numericminor);
+
if ($minor =~ m/^\d+$/)
{
$dotneeded = 1;
@@ -59,6 +63,8 @@
die "$0: minor-version must be N, devel, alphaN, betaN, or rcN\n";
}
+my ($majorversion, $fullversion);
+
# Create various required forms of the version number
$majorversion = $major1 . "." . $major2;
if ($dotneeded)
@@ -69,15 +75,15 @@
{
$fullversion = $majorversion . $minor;
}
-$numericversion = $majorversion . "." . $numericminor;
-$padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor);
+my $numericversion = $majorversion . "." . $numericminor;
+my $padnumericversion = sprintf("%d%02d%02d", $major1, $major2, $numericminor);
# Get the autoconf version number for eventual nag message
# (this also ensures we're in the right directory)
-$aconfver = "";
-open(FILE, "configure.in") || die "could not read configure.in: $!\n";
-while (<FILE>)
+my $aconfver = "";
+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/)
@@ -86,13 +92,13 @@
last;
}
}
-close(FILE);
+close($fh);
$aconfver ne ""
|| die "could not find autoconf version number in configure.in\n";
# Update configure.in and other files that contain version numbers
-$fixedfiles = "";
+my $fixedfiles = "";
sed_file("configure.in",
"-e 's/AC_INIT(\\[PostgreSQL\\], \\[[0-9a-z.]*\\]/AC_INIT([PostgreSQL], [$fullversion]/'"
diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl
index ea33ac5..b21e30f 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.5.1
On Tue, Sep 1, 2015 at 12:57 PM, Peter Eisentraut <peter_e@gmx.net> wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).
Do you think we should be concerned about the increased difficulty to
backpatch fixes if this patch is applied? I personally think that's
fine to do this cleanup on HEAD only, still others may have a
different opinion.
Testing guidelines:
- msvc files need to be tested separately. I tested as best as I could
on a non-Windows system.
And tested on Windows, I am not seeing failures.
--
Michael
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On Sep 1, 2015 6:25 AM, "Michael Paquier" <michael.paquier@gmail.com> wrote:
On Tue, Sep 1, 2015 at 12:57 PM, Peter Eisentraut <peter_e@gmx.net> wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).Do you think we should be concerned about the increased difficulty to
backpatch fixes if this patch is applied? I personally think that's
fine to do this cleanup on HEAD only, still others may have a
different opinion.
It seems like something we want to do at some point, so we're going to have
to take the pain at some point.
We might want to wait until after we get 9.5 to rc as there's likely to be
more changes then, but I don't see any point in delaying it beyond that.
/Magnus
On 08/31/2015 11:57 PM, Peter Eisentraut wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).
I don't object to this. Forcing strict mode is good, and I think I
stopped using bareword file handles around 17 years ago. OTOH, I don't
care that much about the two argument form of open(), and I doubt we
gain a heck of a lot by changing it to the three argument form. It seems
to me more a matter of stylistic preference than any significant
technical improvement. In some cases it arguably leads to less clarity,
e.g. this doesn't seem to add clarity:
- open $fh, "./$tmp |" or die;
+ open $fh, '<', "./$tmp |" or die;
Note also that in some cases all that's happened is that it's added
comments so that future percritic runs will ignore what it's complaining
about. We should look at those cases and annotate them (either we're
happy the way it is or we should fix them)
In pgindent, there are a couple of uses of eval that are mine
originally. At least one should be able to be replaced, thus:
require LWP::Simple;
LWP::Simple->import('getstore');
I'd have to look at the other one more closely.
cheers
andrew
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On Tue, Sep 1, 2015 at 9:58 AM, Andrew Dunstan <andrew@dunslane.net> wrote:
On 08/31/2015 11:57 PM, Peter Eisentraut wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).I don't object to this. Forcing strict mode is good, and I think I stopped
using bareword file handles around 17 years ago.
FWIW, I think perlcritic is both useless and annoying. I've always
used bareword file handles, and I don't really see what the problem
with it is, especially in very short script files. And what's wrong
with two-argument form of open, if the path is a constant rather than
possibly-tainted user input? Perl advertises that TMTOWTDI, and then
perlcritic complains about which one you picked, mostly AFAICS for no
particularly compelling reason. So I'm pretty meh about this whole
exercise, especially if we follow it up by cleaning up the lower
levels of warnings which, from what I can see, are unnecessary
pedantry on top of unnecessary pedantry.
But I suspect I'm in the minority here, so feel free to ignore me. (I
certainly do agree that use strict and use warnings are a good thing
to use everywhere. It's just perlcritic I dislike.)
--
Robert Haas
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On Tue, Sep 01, 2015 at 11:26:27AM -0400, Robert Haas wrote:
On Tue, Sep 1, 2015 at 9:58 AM, Andrew Dunstan <andrew@dunslane.net> wrote:
On 08/31/2015 11:57 PM, Peter Eisentraut wrote:
We now have 80+ Perl files in our tree, and it's growing. Some
of those 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).I don't object to this. Forcing strict mode is good, and I think I
stopped using bareword file handles around 17 years ago.FWIW, I think perlcritic is both useless and annoying. I've always
used bareword file handles, and I don't really see what the problem
with it is, especially in very short script files. And what's wrong
with two-argument form of open, if the path is a constant rather
than possibly-tainted user input? Perl advertises that TMTOWTDI,
and then perlcritic complains about which one you picked, mostly
AFAICS for no particularly compelling reason. So I'm pretty meh
about this whole exercise, especially if we follow it up by cleaning
up the lower levels of warnings which, from what I can see, are
unnecessary pedantry on top of unnecessary pedantry.But I suspect I'm in the minority here, so feel free to ignore me.
(I certainly do agree that use strict and use warnings are a good
thing to use everywhere. It's just perlcritic I dislike.)
I believe there are ways to get perlcritic to keep quiet about things
we don't find relevant. Maybe that's a better way to use it.
Cheers,
David.
--
David Fetter <david@fetter.org> http://fetter.org/
Phone: +1 415 235 3778 AIM: dfetter666 Yahoo!: dfetter
Skype: davidfetter XMPP: david.fetter@gmail.com
Remember to vote!
Consider donating to Postgres: http://www.postgresql.org/about/donate
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
David wrote:
I believe there are ways to get perlcritic to keep quiet about things
we don't find relevant. Maybe that's a better way to use it.
There are indeed. A .perlcriticrc file can suppress (or add) either
individual rules or groups of rules. I use one to ignore the ones I
disagree with, along with the comment form to ignore specific cases.
I see perlcritic as functioning for me along the same lines as a style
guide, giving a consistency that helps with long term maintainability.
It also helps keep me from straying into golf. ^_^
On Tue, Sep 1, 2015 at 11:58 AM, Mike Blackwell <mike.blackwell@rrd.com> wrote:
David wrote:
I believe there are ways to get perlcritic to keep quiet about things
we don't find relevant. Maybe that's a better way to use it.There are indeed. A .perlcriticrc file can suppress (or add) either
individual rules or groups of rules. I use one to ignore the ones I
disagree with, along with the comment form to ignore specific cases.
Well, then we'd have to agree on which rules have any value; it will
probably be impossible to get consensus on that. My suggestion for a
.perlcriticrc file will be one that ignores all of the rules and, if
there's a way to do it, causes perlcritic to uninstall itself and
leave behind a note apologizing for its existence. :-)
In all seriousness, I'm totally fine with trying to create more
stylistic consistency among our Perl scripts, and if Peter finds
perlcritic a helpful way to get there, that's fair enough. But for
myself, I am an inveterate perlcriticcritic.
--
Robert Haas
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On Tue, Sep 01, 2015 at 11:26:27AM -0400, Robert Haas wrote:
On Tue, Sep 1, 2015 at 9:58 AM, Andrew Dunstan <andrew@dunslane.net> wrote:
On 08/31/2015 11:57 PM, Peter Eisentraut wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).I don't object to this. Forcing strict mode is good, and I think I stopped
using bareword file handles around 17 years ago.FWIW, I think perlcritic is both useless and annoying. I've always
used bareword file handles, and I don't really see what the problem
with it is, especially in very short script files.
A bareword file handle is a form of global variable, so the criticism is
helpful for codebases large enough to make those a maintenance problem. It's
important for any CPAN module, so I can understand perlcritic including it.
Plenty of uses in our tree are fine.
And what's wrong
with two-argument form of open, if the path is a constant rather than
possibly-tainted user input? Perl advertises that TMTOWTDI, and then
perlcritic complains about which one you picked, mostly AFAICS for no
particularly compelling reason. So I'm pretty meh about this whole
exercise, especially if we follow it up by cleaning up the lower
levels of warnings which, from what I can see, are unnecessary
pedantry on top of unnecessary pedantry.But I suspect I'm in the minority here, so feel free to ignore me. (I
certainly do agree that use strict and use warnings are a good thing
to use everywhere. It's just perlcritic I dislike.)
I agree with the rest of your message.
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
Hi,
On 2015-08-31 23:57:25 -0400, Peter Eisentraut wrote:
We now have 80+ Perl files in our tree, and it's growing. Some of those
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).
As far as I can see we haven't really come to any conclusion in this
thread?
Peter, where do you want to go from here? As this patch has been in
waiting-for-author for a month, I'm marking it as
returned-with-feedback.
Greetings,
Andres Freund
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
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
Attachments:
v2-0001-Clean-up-Perl-code-according-to-perlcritic-severi.patchtext/x-patch; name=v2-0001-Clean-up-Perl-code-according-to-perlcritic-severi.patchDownload
From af08d7e1b7a947a3f94bb1cef7508c3f926cc35a Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter_e@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
Hi Peter,
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
I posted this about 18 months ago but then ran out of steam. [ ] 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.
Attached is a patch on top of yours that addresses all the ## no critic
annotations except RequireFilenameMatchesPackage, which can't be fixed
without more drastic reworking of the plperl build process.
Tested on perl 5.8.1 and 5.24.0 by configuring with --with-perl and
--enable-tap-tests followed by make check-world, and running pgindent
--build.
--
"A disappointingly low fraction of the human race is,
at any given time, on fire." - Stig Sandbeck Mathisen
Attachments:
0001-Fix-most-perlcritic-exceptions.patchtext/x-diffDownload
From cdf3ca19cbbf03111243f9b39eb6f402f25b4502 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Wed, 1 Mar 2017 15:32:45 +0000
Subject: [PATCH] Fix most perlcritic exceptions
The RequireFilenameMatchesPackage ones would require reworking the
plperl build process more drastically.
---
src/pl/plperl/plc_perlboot.pl | 9 +++------
src/tools/msvc/gendef.pl | 2 +-
src/tools/pgindent/pgindent | 6 +++---
3 files changed, 7 insertions(+), 10 deletions(-)
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 292c9101c9..b4212f5ab2 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -81,18 +81,15 @@ sub ::encode_array_constructor
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
- return qq[ package main; sub { $BEGIN $prolog $src } ];
+ # default no strict and no warnings
+ return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ];
}
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(@_));
+ my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
- ## use critic
}
1;
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl
index 64227c2dce..e2653f11d8 100644
--- a/src/tools/msvc/gendef.pl
+++ b/src/tools/msvc/gendef.pl
@@ -174,7 +174,7 @@ sub usage
my %def = ();
-while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
+while (glob($ARGV[0]/*.obj))
{
my $objfile = $_;
my $symfile = $objfile;
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index a6b24b5348..51d6a28953 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -159,8 +159,7 @@ sub process_exclude
while (my $line = <$eh>)
{
chomp $line;
- my $rgx;
- eval " \$rgx = qr!$line!;"; ## no critic (ProhibitStringyEval);
+ my $rgx = eval { qr!$line! };
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
}
close($eh);
@@ -435,7 +434,8 @@ sub diff
sub run_build
{
- eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
+ require LWP::Simple;
+ LWP::Simple->import(qw(getstore is_success));
my $code_base = shift || '.';
my $save_dir = getcwd();
--
2.11.0
ilmari@ilmari.org (Dagfinn Ilmari Mannsåker) writes:
Hi Peter,
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
I posted this about 18 months ago but then ran out of steam. [ ] 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.Attached is a patch on top of yours that addresses all the ## no critic
annotations except RequireFilenameMatchesPackage, which can't be fixed
without more drastic reworking of the plperl build process.Tested on perl 5.8.1 and 5.24.0 by configuring with --with-perl and
--enable-tap-tests followed by make check-world, and running pgindent
--build.
Attached is an updated version of the patch, in which
src/tools/msvc/gendef.pl actually compiles. If someone on Windows could
test it, that would be great.
--
"The surreality of the universe tends towards a maximum" -- Skud's Law
"Never formulate a law or axiom that you're not prepared to live with
the consequences of." -- Skud's Meta-Law
Attachments:
0001-Fix-most-perlcritic-exceptions-v2.patchtext/x-diffDownload
From 2bbdd768bdbabe10e0af6b95d2d09d29095d3a8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Wed, 1 Mar 2017 15:32:45 +0000
Subject: [PATCH] Fix most perlcritic exceptions
The RequireFilenameMatchesPackage ones would require reworking the
plperl build process more drastically.
---
src/pl/plperl/plc_perlboot.pl | 9 +++------
src/tools/msvc/gendef.pl | 2 +-
src/tools/pgindent/pgindent | 6 +++---
3 files changed, 7 insertions(+), 10 deletions(-)
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 292c9101c9..b4212f5ab2 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -81,18 +81,15 @@ sub ::encode_array_constructor
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
- return qq[ package main; sub { $BEGIN $prolog $src } ];
+ # default no strict and no warnings
+ return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ];
}
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(@_));
+ my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
- ## use critic
}
1;
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl
index 64227c2dce..598699e6ea 100644
--- a/src/tools/msvc/gendef.pl
+++ b/src/tools/msvc/gendef.pl
@@ -174,7 +174,7 @@ sub usage
my %def = ();
-while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
+while (glob("$ARGV[0]/*.obj"))
{
my $objfile = $_;
my $symfile = $objfile;
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index a6b24b5348..51d6a28953 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -159,8 +159,7 @@ sub process_exclude
while (my $line = <$eh>)
{
chomp $line;
- my $rgx;
- eval " \$rgx = qr!$line!;"; ## no critic (ProhibitStringyEval);
+ my $rgx = eval { qr!$line! };
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
}
close($eh);
@@ -435,7 +434,8 @@ sub diff
sub run_build
{
- eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
+ require LWP::Simple;
+ LWP::Simple->import(qw(getstore is_success));
my $code_base = shift || '.';
my $save_dir = getcwd();
--
2.11.0
Hi Daniel,
On 3/6/17 12:02 PM, Dagfinn Ilmari Mannsåker wrote:
ilmari@ilmari.org (Dagfinn Ilmari Mannsåker) writes:
Hi Peter,
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
I posted this about 18 months ago but then ran out of steam. [ ] 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.Attached is a patch on top of yours that addresses all the ## no critic
annotations except RequireFilenameMatchesPackage, which can't be fixed
without more drastic reworking of the plperl build process.Tested on perl 5.8.1 and 5.24.0 by configuring with --with-perl and
--enable-tap-tests followed by make check-world, and running pgindent
--build.Attached is an updated version of the patch, in which
src/tools/msvc/gendef.pl actually compiles. If someone on Windows could
test it, that would be great.
You are signed up to review this patch. Do you know when you'll have a
chance to do that?
Thanks,
--
-David
david@pgmasters.net
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On 21 Mar 2017, at 19:20, David Steele <david@pgmasters.net> wrote:
On 3/6/17 12:02 PM, Dagfinn Ilmari Mannsåker wrote:
ilmari@ilmari.org (Dagfinn Ilmari Mannsåker) writes:
Hi Peter,
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
I posted this about 18 months ago but then ran out of steam. [ ] 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.Attached is a patch on top of yours that addresses all the ## no critic
annotations except RequireFilenameMatchesPackage, which can't be fixed
without more drastic reworking of the plperl build process.Tested on perl 5.8.1 and 5.24.0 by configuring with --with-perl and
--enable-tap-tests followed by make check-world, and running pgindent
--build.Attached is an updated version of the patch, in which
src/tools/msvc/gendef.pl actually compiles. If someone on Windows could
test it, that would be great.You are signed up to review this patch. Do you know when you'll have a chance to do that?
I have on my TODO for today or tomorrow to wrap that up.
cheers ./daniel
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On 21 Mar 2017, at 19:20, David Steele <david@pgmasters.net> wrote:
On 3/6/17 12:02 PM, Dagfinn Ilmari Mannsåker wrote:
ilmari@ilmari.org (Dagfinn Ilmari Mannsåker) writes:
Hi Peter,
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
I posted this about 18 months ago but then ran out of steam. [ ] 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.Attached is a patch on top of yours that addresses all the ## no critic
annotations except RequireFilenameMatchesPackage, which can't be fixed
without more drastic reworking of the plperl build process.Tested on perl 5.8.1 and 5.24.0 by configuring with --with-perl and
--enable-tap-tests followed by make check-world, and running pgindent
--build.Attached is an updated version of the patch, in which
src/tools/msvc/gendef.pl actually compiles. If someone on Windows could
test it, that would be great.You are signed up to review this patch. Do you know when you'll have a chance to do that?
Below is a review of the two patches attached to the commitfest entry:
The v2-0001-Clean-up-Perl-code-according-to-perlcritic-severi.patch didn’t
apply cleanly due to later commits, but the fixes to get there were trivial.
The followup 0001-Fix-most-perlcritic-exceptions-v2.patch applied clean on top
of that. The attached patch contains these two patches, rebased on top of
current master, with the below small nitpicks.
Since the original submission, most things have been addressed already, leaving
this patch with mostly changing to three-close open. The no critic exceptions
left are quite harmless: two cases of RequireFilenameMatchesPackage and one
ProhibitStringyEval. All three could be fixed at the expense of complicating
things without much (or any) benefit (as mentioned up-thread by Dagfinn Ilmari
Mannsåker), so I’m fine with leaving them in.
A few small nitpicks on the patch:
## In src/interfaces/libpq/test/regress.pl:
-open(REGRESS_IN, "<", $regress_in)
+open(my $regress_in_fh, "<", $regress_in)
Reading and closing this file was still using REGRESS_IN, fixed in the attached
updated patch.
## In src/test/locale/sort-test.pl:
-open(INFILE, "<$ARGV[0]");
-chop(my (@words) = <INFILE>);
-close(INFILE);
+chop(my (@words) = <>);
While this hunk does provide the same functionality due to the magic handling
of ARGV in <>, it also carries the side “benefit” that arbitrary applications
can be executed by using a | to read the output from a program:
$ src/test/locale/sort-test.pl "rm README |"
$ cat README
cat: README: No such file or directory
A silly example for sure, but since the intent of the patch is to apply best
practices and safe practices, I’d argue that a normal three-clause open is
safer here. The risk for misuse is very low, but it also makes the code less
magic and more readable IMO.
Reading the thread, most of the discussion was around the use of three-clause
open instead of the older two-clause. Without diving into the arguments, there
are a few places where we should use three-clause open, so simply applying it
everywhere rather than on a case by case basis seems reasonable to me.
Consistency across the codebase helps when reading the code.
There is no measurable performance impact on the changes, and no user visible
changes to functionality. With this applied, make check-world passes and
perlcritic returns a clean run (except on the autogenerated Gen_dummy_probes.pl
which is kept out of this work). The intent of the patch is to make the code
consistent and readable, and it achieves that. I see no reason to not go ahead
with these changes, if only to keep the codebase consistent with with modern
Perl code is expected to look like.
Given the nitpick nature of the comments, bumping status to ready for
committer.
cheers ./daniel
Attachments:
perlcritic-with-review-comments.patchapplication/octet-stream; name=perlcritic-with-review-comments.patchDownload
From 1bb98a74ef2a5f5c820ed16ffc2a6a73870b50d9 Mon Sep 17 00:00:00 2001
From: Daniel Gustafsson <daniel@yesql.se>
Date: Thu, 23 Mar 2017 16:25:13 +0100
Subject: [PATCH] Updated perlcritic patch with review comments
---
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 | 14 +-
src/pl/plperl/plc_perlboot.pl | 9 +-
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 | 6 +-
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 | 6 +-
src/tools/version_stamp.pl | 6 +-
src/tools/win32tzlist.pl | 6 +-
41 files changed, 362 insertions(+), 362 deletions(-)
diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl
index 1323b31..f3262df 100755
--- a/contrib/intarray/bench/create_test.pl
+++ b/contrib/intarray/bench/create_test.pl
@@ -15,8 +15,8 @@ create table message_section_map (
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 @@ foreach my $i (1 .. 200000)
}
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 66be811..01fc616 100644
--- a/doc/src/sgml/generate-errcodes-table.pl
+++ b/doc/src/sgml/generate-errcodes-table.pl
@@ -9,7 +9,7 @@ use strict;
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 93dab21..9b111b8 100644
--- a/doc/src/sgml/mk_feature_tables.pl
+++ b/doc/src/sgml/mk_feature_tables.pl
@@ -6,11 +6,11 @@ use strict;
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 @@ while (<PACK>)
}
}
-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 @@ while (<FEAT>)
print "</tbody>\n";
-close FEAT;
+close $feat;
diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index bccbc51..6ffd5f9 100644
--- a/src/backend/catalog/Catalog.pm
+++ b/src/backend/catalog/Catalog.pm
@@ -44,13 +44,13 @@ sub Catalogs
$catalog{columns} = [];
$catalog{data} = [];
- open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
+ open(my $ifh, '<', $input_file) || die "$input_file: $!";
my ($filename) = ($input_file =~ m/(\w+)\.h$/);
my $natts_pat = "Natts_$filename";
# Scan the input file.
- while (<INPUT_FILE>)
+ while (<$ifh>)
{
# Strip C-style comments.
@@ -59,7 +59,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;
@@ -211,7 +211,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 079516c..f9ecb02 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -66,16 +66,16 @@ if ($output_path ne '' && substr($output_path, -1) ne '/')
# 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 @@ my $catalogs = Catalog::Catalogs(@input_files);
# 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 @@ foreach my $catname (@{ $catalogs->{names} })
# .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 @@ foreach my $catname (@{ $catalogs->{names} })
my @attnames;
my $first = 1;
- print BKI " (\n";
+ print $bki " (\n";
foreach my $column (@{ $catalog->{columns} })
{
my $attname = $column->{name};
@@ -130,27 +130,27 @@ foreach my $catname (@{ $catalogs->{names} })
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 @@ foreach my $catname (@{ $catalogs->{names} })
# 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 @@ foreach my $catname (@{ $catalogs->{names} })
}
}
- 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 @@ foreach my $catname (@{ $catalogs->{names} })
# 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 @@ EOM
# 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 45862ce..84fef1d 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -14,7 +14,7 @@ my $kwlist_filename = $ARGV[1];
my $errors = 0;
-sub error(@)
+sub error
{
print STDERR @_;
$errors = 1;
@@ -29,18 +29,18 @@ $keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD';
$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 @@ line: while (<GRAM>)
{
# 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 @@ line: while (<GRAM>)
}
# 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 @@ line: while (<GRAM>)
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 @@ while (my ($kcat, $kcat_id) = each(%keyword_categories))
# 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 @@ kwlist_line: while (<KWLIST>)
}
}
}
-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 f80d2c8..10d0698 100644
--- a/src/backend/storage/lmgr/generate-lwlocknames.pl
+++ b/src/backend/storage/lmgr/generate-lwlocknames.pl
@@ -9,21 +9,21 @@ use strict;
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 (<$lwlocknames>)
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 cdd603a..2af9b35 100644
--- a/src/backend/utils/Gen_fmgrtab.pl
+++ b/src/backend/utils/Gen_fmgrtab.pl
@@ -90,11 +90,11 @@ my $oidsfile = $output_path . 'fmgroids.h';
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 @@ qq|/*-------------------------------------------------------------------------
*/
|;
-print P
+print $pfh
qq|/*-------------------------------------------------------------------------
*
* fmgrprotos.h
@@ -159,7 +159,7 @@ qq|/*-------------------------------------------------------------------------
|;
-print T
+print $tfh
qq|/*-------------------------------------------------------------------------
*
* fmgrtab.c
@@ -193,26 +193,26 @@ foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr)
{
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 @@ qq| /* dummy entry is easier than getting rid of comma after last real one */
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 b84c6b0..6a577f6 100644
--- a/src/backend/utils/generate-errcodes.pl
+++ b/src/backend/utils/generate-errcodes.pl
@@ -10,7 +10,7 @@ print
"/* 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 14bd813..1d3c498 100644
--- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl
+++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
@@ -24,10 +24,10 @@ $node->command_fails(['pg_basebackup'],
# 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();
@@ -45,19 +45,19 @@ $node->command_fails(
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 current_logfiles.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' ],
@@ -124,8 +124,8 @@ $node->command_fails(
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 8f16bf9..9182574 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 @@ command_ok([ 'pg_ctl', 'initdb', '-D', "$tempdir/data", '-o', '-N' ],
'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 359670b..cedb767 100644
--- a/src/bin/psql/create_help.pl
+++ b/src/bin/psql/create_help.pl
@@ -42,12 +42,12 @@ $define =~ s/\W/_/g;
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 @@ struct _helpStruct
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 @@ foreach my $file (sort readdir DIR)
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 @@ foreach (sort keys %entries)
$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 @@ sql_help_$id(PQExpBuffer buf)
";
}
-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 @@ foreach (sort keys %entries)
";
}
-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 @@ print HFILE "
#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 dce4bc6..e681943 100644
--- a/src/interfaces/ecpg/preproc/check_rules.pl
+++ b/src/interfaces/ecpg/preproc/check_rules.pl
@@ -53,8 +53,8 @@ my $comment = 0;
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 @@ while (<GRAM>)
}
}
-close GRAM;
+close $parser_fh;
if ($verbose)
{
print "$cc rules loaded\n";
@@ -154,8 +154,8 @@ if ($verbose)
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 @@ while (<ECPG>)
$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 1dab122..c403130 100644
--- a/src/interfaces/libpq/test/regress.pl
+++ b/src/interfaces/libpq/test/regress.pl
@@ -14,19 +14,19 @@ my $expected_out = "$srcdir/$subdir/expected.out";
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: $!";
open(STDERR, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
# read lines from regress.in and run uri-regress on them
-while (<REGRESS_IN>)
+while (<$regress_in_fh>)
{
chomp;
print "trying $_\n";
@@ -35,11 +35,11 @@ while (<REGRESS_IN>)
}
# 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;
+close $regress_in_fh;
my $diff_status = system(
"diff -c \"$srcdir/$subdir/expected.out\" regress.out >regress.diff");
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index bb2d009..b4212f5 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;
@@ -81,14 +81,13 @@ sub ::encode_array_constructor
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
- return qq[ package main; sub { $BEGIN $prolog $src } ];
+ # default no strict and no warnings
+ return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ];
}
sub mkfunc
{
- no strict; # default to no strict for the eval
- no warnings; # default to no warnings for the eval
- my $ret = eval(mkfuncsrc(@_));
+ my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
diff --git a/src/pl/plperl/plc_trusted.pl b/src/pl/plperl/plc_trusted.pl
index cd61882..38255b4 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 c88e5ec..e681fca 100644
--- a/src/pl/plperl/text2macro.pl
+++ b/src/pl/plperl/text2macro.pl
@@ -49,7 +49,7 @@ for my $src_file (@ARGV)
(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 6a676c0..eb135bc 100644
--- a/src/pl/plpgsql/src/generate-plerrcodes.pl
+++ b/src/pl/plpgsql/src/generate-plerrcodes.pl
@@ -10,7 +10,7 @@ print
"/* 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 ab0fa4a..a9ee960 100644
--- a/src/pl/plpython/generate-spiexceptions.pl
+++ b/src/pl/plpython/generate-spiexceptions.pl
@@ -10,7 +10,7 @@ print
"/* 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 e20a0af..b4e429a 100644
--- a/src/pl/tcl/generate-pltclerrcodes.pl
+++ b/src/pl/tcl/generate-pltclerrcodes.pl
@@ -10,7 +10,7 @@ print
"/* 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 cb7e493..c0bc5d6 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -3,9 +3,9 @@
use strict;
use locale;
-open(INFILE, "<$ARGV[0]");
-chop(my (@words) = <INFILE>);
-close(INFILE);
+open my $in_fh, '<', $ARGV[0] || die;
+chop(my (@words) = <$in_fh>);
+close($in_fh);
$" = "\n";
my (@result) = sort @words;
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 5ef007f..1ad8f7f 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)
{
@@ -399,7 +399,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";
@@ -820,7 +820,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";
@@ -1357,7 +1357,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 d22957c..ae8d178 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 9441249..6d17d6d 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 8dafcae..bc868df 100644
--- a/src/tools/fix-old-flex-code.pl
+++ b/src/tools/fix-old-flex-code.pl
@@ -25,7 +25,7 @@ my $filename = shift;
# 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 @@ $ccode =~ s|(struct yyguts_t \* yyg = \(struct yyguts_t\*\)yyscanner; /\* This v
|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 0aa1422..045ac44 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 12f73f3..ba1bf6d 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -825,7 +825,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 faf1a68..9817b94 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 ff9064f..abac2c7 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 2e7c548..7246064 100644
--- a/src/tools/msvc/build.pl
+++ b/src/tools/msvc/build.pl
@@ -23,17 +23,17 @@ use Mkvcbuild;
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 2b56ced..e0b5c50 100644
--- a/src/tools/msvc/builddoc.pl
+++ b/src/tools/msvc/builddoc.pl
@@ -18,7 +18,7 @@ chdir '../../..' if (-d '../msvc' && -d '../../../src');
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 3bcff7f..598699e 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 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n";
my %def = ();
-while (<$ARGV[0]/*.obj>)
+while (glob("$ARGV[0]/*.obj"))
{
my $objfile = $_;
my $symfile = $objfile;
diff --git a/src/tools/msvc/install.pl b/src/tools/msvc/install.pl
index bde5b7c..b2d7f9e 100755
--- a/src/tools/msvc/install.pl
+++ b/src/tools/msvc/install.pl
@@ -14,11 +14,11 @@ use Install qw(Install);
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 6f1c42e..9255dff 100644
--- a/src/tools/msvc/mkvcbuild.pl
+++ b/src/tools/msvc/mkvcbuild.pl
@@ -19,7 +19,7 @@ print "Warning: no config.pl found, using default.\n"
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 31e7540..e799d90 100644
--- a/src/tools/msvc/pgbison.pl
+++ b/src/tools/msvc/pgbison.pl
@@ -7,7 +7,7 @@ use File::Basename;
# 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 @@ $output =~ s/gram\.c$/pl_gram.c/ if $input =~ /src.pl.plpgsql.src.gram\.y$/;
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 fab0efa..67397ba 100644
--- a/src/tools/msvc/pgflex.pl
+++ b/src/tools/msvc/pgflex.pl
@@ -10,7 +10,7 @@ $ENV{CYGWIN} = 'nodosfilewarning';
# 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 @@ elsif (!-e $input)
# 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 @@ if ($? == 0)
{
# 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 @@ if ($? == 0)
# 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 f1b9819..d9367f8 100644
--- a/src/tools/msvc/vcregress.pl
+++ b/src/tools/msvc/vcregress.pl
@@ -20,8 +20,8 @@ chdir "../../.." if (-d "../../../src/tools/msvc");
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 @@ require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
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 e166efa..aa7c9c2 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 0d3859d..51d6a28 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -159,8 +159,7 @@ sub process_exclude
while (my $line = <$eh>)
{
chomp $line;
- my $rgx;
- eval " \$rgx = qr!$line!;";
+ my $rgx = eval { qr!$line! };
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
}
close($eh);
@@ -435,7 +434,8 @@ sub diff
sub run_build
{
- eval "use LWP::Simple;";
+ require LWP::Simple;
+ LWP::Simple->import(qw(getstore is_success));
my $code_base = shift || '.';
my $save_dir = getcwd();
diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl
index dc9173f..f973dd9 100755
--- a/src/tools/version_stamp.pl
+++ b/src/tools/version_stamp.pl
@@ -80,8 +80,8 @@ my $padnumericversion = sprintf("%d%04d", $majorversion, $numericminor);
# (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 @@ m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
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 6345465..0bdcc36 100755
--- a/src/tools/win32tzlist.pl
+++ b/src/tools/win32tzlist.pl
@@ -58,11 +58,11 @@ $basekey->Close();
# 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.6.4 (Apple Git-63)
On 3/1/17 11:21, Dagfinn Ilmari Mannsåker wrote:
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index 292c9101c9..b4212f5ab2 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -81,18 +81,15 @@ sub ::encode_array_constructor } sort keys %$imports; $BEGIN &&= "BEGIN { $BEGIN }";- return qq[ package main; sub { $BEGIN $prolog $src } ]; + # default no strict and no warnings + return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ]; }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(@_)); + my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval); $@ =~ s/\(eval \d+\) //g if $@; return $ret; - ## use critic }1;
I have no idea what this code does or how to test it, so I didn't touch it.
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl index 64227c2dce..e2653f11d8 100644 --- a/src/tools/msvc/gendef.pl +++ b/src/tools/msvc/gendef.pl @@ -174,7 +174,7 @@ sub usagemy %def = ();
-while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction); +while (glob($ARGV[0]/*.obj)) { my $objfile = $_; my $symfile = $objfile;
I think what this code is meant to do might be better written as a
foreach loop. Again, can't test it.
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent index a6b24b5348..51d6a28953 100755 --- a/src/tools/pgindent/pgindent +++ b/src/tools/pgindent/pgindent @@ -159,8 +159,7 @@ sub process_exclude while (my $line = <$eh>) { chomp $line; - my $rgx; - eval " \$rgx = qr!$line!;"; ## no critic (ProhibitStringyEval); + my $rgx = eval { qr!$line! }; @files = grep { $_ !~ /$rgx/ } @files if $rgx; } close($eh);
After further thinking, I changed this to just
my $rgx = qr!$line!;
which works just fine.
@@ -435,7 +434,8 @@ sub diff
sub run_build { - eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval); + require LWP::Simple; + LWP::Simple->import(qw(getstore is_success));my $code_base = shift || '.';
my $save_dir = getcwd();
I think this is mean to not fail compilation if you don't have that
module, so I left it as is.
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
On 3/23/17 11:58, Daniel Gustafsson wrote:
Given the nitpick nature of the comments, bumping status to ready for
committer.
Committed, with your changes.
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
Peter Eisentraut <peter.eisentraut@2ndquadrant.com> writes:
On 3/1/17 11:21, Dagfinn Ilmari Mannsåker wrote:
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index 292c9101c9..b4212f5ab2 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -81,18 +81,15 @@ sub ::encode_array_constructor } sort keys %$imports; $BEGIN &&= "BEGIN { $BEGIN }";- return qq[ package main; sub { $BEGIN $prolog $src } ]; + # default no strict and no warnings + return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ]; }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(@_)); + my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval); $@ =~ s/\(eval \d+\) //g if $@; return $ret; - ## use critic }1;
I have no idea what this code does or how to test it, so I didn't touch it.
This code compiles a string of perl source into a subroutine reference.
It's is called by plperl_create_sub() in src/pl/plperl/plperl.c, which
is called whenever a plperl function needs to be compiled, i.e. during
CREATE FUNCTION (unless check_function_bodies is off) and when the
function is executed and the compiled form is not already cached in
plperl_proc_hash.
The change reduces the scope of the stricture and warning disablement to
just the compiled code, instead of the surrounding compiling code too.
Putting them inside the sub block has no runtime overhead, since they're
compile-time directives, not runtime statements.
It can be tested by creating a plperl function with a construct that
would fall foul of warnings or strictures, which
src/pl/plperl/sql/plperl_elog.sql does.
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl index 64227c2dce..e2653f11d8 100644 --- a/src/tools/msvc/gendef.pl +++ b/src/tools/msvc/gendef.pl @@ -174,7 +174,7 @@ sub usagemy %def = ();
-while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction); +while (glob($ARGV[0]/*.obj)) { my $objfile = $_; my $symfile = $objfile;I think what this code is meant to do might be better written as a
foreach loop. Again, can't test it.
glob("...") is exactly equivalent to <...> (except when <...> parses as
readline, which is why Perl::Critic complains).
Writing it as 'for my $objfile (glob("$ARGV[0]/*.obj")) { ... }' would
be neater, I agree.
difff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent index a6b24b5348..51d6a28953 100755 --- a/src/tools/pgindent/pgindent +++ b/src/tools/pgindent/pgindent @@ -159,8 +159,7 @@ sub process_exclude while (my $line = <$eh>) { chomp $line; - my $rgx; - eval " \$rgx = qr!$line!;"; ## no critic (ProhibitStringyEval); + my $rgx = eval { qr!$line! }; @files = grep { $_ !~ /$rgx/ } @files if $rgx; } close($eh);After further thinking, I changed this to just
my $rgx = qr!$line!;
which works just fine.
That changes the behaviour from silently skipping invalid regular
expressions in the exclude file to dying on encountering one. That
might be desirable, but should be done deliberately.
@@ -435,7 +434,8 @@ sub diff
sub run_build { - eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval); + require LWP::Simple; + LWP::Simple->import(qw(getstore is_success));my $code_base = shift || '.';
my $save_dir = getcwd();I think this is mean to not fail compilation if you don't have that
module, so I left it as is.
Yes, it's using string eval to defer the compilation of the "use"
statement to runtime. The require+import does exactly the same thing,
since they are run-time already, so won't be called until run_build is.
While looking at this again, I realised that the 'do' statement in
src/tools/msvc/install.pl will break on the upcoming perl 5.26, which
doesn't include '.' in @INC (the search path for 'require' and 'do') by
default.
if (-e "src/tools/msvc/buildenv.pl")
{
do "src/tools/msvc/buildenv.pl";
}
Attached is a final patch with the above changes, which I think should
be applied before this can be considered complete.
Attachments:
0001-Fix-most-remaining-perlcritic-exceptions.patchtext/x-diffDownload
From 1d388d13d572912df2faa7d1c4004a635f956306 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Wed, 1 Mar 2017 15:32:45 +0000
Subject: [PATCH] Fix most remaining perlcritic exceptions
The ProhibitStringyEval one is unavoidable when compiling plperl
functions at runtime.
The RequireFilenameMatchesPackage ones would require reworking the
plperl build process more drastically.
---
src/pl/plperl/plc_perlboot.pl | 9 +++------
src/tools/msvc/gendef.pl | 6 ++----
src/tools/msvc/install.pl | 4 ++--
src/tools/pgindent/pgindent | 3 ++-
4 files changed, 9 insertions(+), 13 deletions(-)
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 292c9101c9..b4212f5ab2 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -81,18 +81,15 @@ sub ::encode_array_constructor
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
- return qq[ package main; sub { $BEGIN $prolog $src } ];
+ # default no strict and no warnings
+ return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ];
}
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(@_));
+ my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
- ## use critic
}
1;
diff --git a/src/tools/msvc/gendef.pl b/src/tools/msvc/gendef.pl
index 64227c2dce..c5c7f9c25f 100644
--- a/src/tools/msvc/gendef.pl
+++ b/src/tools/msvc/gendef.pl
@@ -174,11 +174,9 @@ sub usage
my %def = ();
-while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
+for my $objfile (glob("$ARGV[0]/*.obj"))
{
- my $objfile = $_;
- my $symfile = $objfile;
- $symfile =~ s/\.obj$/.sym/i;
+ (my $symfile = $objfile) =~ s/\.obj$/.sym/i;
dumpsyms($objfile, $symfile);
print ".";
extract_syms($symfile, \%def);
diff --git a/src/tools/msvc/install.pl b/src/tools/msvc/install.pl
index b2d7f9e040..f4bd0d0e75 100755
--- a/src/tools/msvc/install.pl
+++ b/src/tools/msvc/install.pl
@@ -12,9 +12,9 @@
# it should contain lines like:
# $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}";
-if (-e "src/tools/msvc/buildenv.pl")
+if (-e "./src/tools/msvc/buildenv.pl")
{
- do "src/tools/msvc/buildenv.pl";
+ do "./src/tools/msvc/buildenv.pl";
}
elsif (-e "./buildenv.pl")
{
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index 0f3a1ba69a..3d24a092a8 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -434,7 +434,8 @@ sub diff
sub run_build
{
- eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
+ require LWP::Simple;
+ LWP::Simple->import(qw(getstore is_success));
my $code_base = shift || '.';
my $save_dir = getcwd();
--
2.11.0