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).
>From e38edbf5f911eb67750cf890cfd384758e43466e Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <pete...@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
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
