>From 1bb98a74ef2a5f5c820ed16ffc2a6a73870b50d9 Mon Sep 17 00:00:00 2001 From: Daniel Gustafsson Date: Thu, 23 Mar 2017 16:25:13 +0100 Subject: [PATCH] Updated perlcritic patch with review comments --- contrib/intarray/bench/create_test.pl | 20 +-- doc/src/sgml/generate-errcodes-table.pl | 2 +- doc/src/sgml/mk_feature_tables.pl | 12 +- src/backend/catalog/Catalog.pm | 8 +- src/backend/catalog/genbki.pl | 64 ++++----- src/backend/parser/check_keywords.pl | 30 ++--- src/backend/storage/lmgr/generate-lwlocknames.pl | 30 ++--- src/backend/utils/Gen_fmgrtab.pl | 32 ++--- src/backend/utils/generate-errcodes.pl | 2 +- src/bin/pg_basebackup/t/010_pg_basebackup.pl | 26 ++-- src/bin/pg_ctl/t/001_start_stop.pl | 14 +- src/bin/psql/create_help.pl | 28 ++-- src/interfaces/ecpg/preproc/check_rules.pl | 12 +- src/interfaces/libpq/test/regress.pl | 14 +- src/pl/plperl/plc_perlboot.pl | 9 +- src/pl/plperl/plc_trusted.pl | 2 +- src/pl/plperl/text2macro.pl | 8 +- src/pl/plpgsql/src/generate-plerrcodes.pl | 2 +- src/pl/plpython/generate-spiexceptions.pl | 2 +- src/pl/tcl/generate-pltclerrcodes.pl | 2 +- src/test/locale/sort-test.pl | 6 +- src/test/perl/PostgresNode.pm | 8 +- src/test/perl/TestLib.pm | 16 +-- src/test/ssl/ServerSetup.pm | 48 +++---- src/tools/fix-old-flex-code.pl | 4 +- src/tools/msvc/Install.pm | 10 +- src/tools/msvc/Mkvcbuild.pm | 2 +- src/tools/msvc/Project.pm | 28 ++-- src/tools/msvc/Solution.pm | 162 +++++++++++------------ src/tools/msvc/build.pl | 8 +- src/tools/msvc/builddoc.pl | 2 +- src/tools/msvc/gendef.pl | 18 +-- src/tools/msvc/install.pl | 4 +- src/tools/msvc/mkvcbuild.pl | 4 +- src/tools/msvc/pgbison.pl | 4 +- src/tools/msvc/pgflex.pl | 12 +- src/tools/msvc/vcregress.pl | 19 +-- src/tools/pginclude/pgcheckdefines | 32 ++--- src/tools/pgindent/pgindent | 6 +- src/tools/version_stamp.pl | 6 +- src/tools/win32tzlist.pl | 6 +- 41 files changed, 362 insertions(+), 362 deletions(-) diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl index 1323b31..f3262df 100755 --- a/contrib/intarray/bench/create_test.pl +++ b/contrib/intarray/bench/create_test.pl @@ -15,8 +15,8 @@ create table message_section_map ( EOT -open(MSG, ">message.tmp") || die; -open(MAP, ">message_section_map.tmp") || die; +open(my $msg, '>', "message.tmp") || die; +open(my $map, '>', "message_section_map.tmp") || die; srand(1); @@ -42,16 +42,16 @@ foreach my $i (1 .. 200000) } if ($#sect < 0 || rand() < 0.1) { - print MSG "$i\t\\N\n"; + print $msg "$i\t\\N\n"; } else { - print MSG "$i\t{" . join(',', @sect) . "}\n"; - map { print MAP "$i\t$_\n" } @sect; + print $msg "$i\t{" . join(',', @sect) . "}\n"; + map { print $map "$i\t$_\n" } @sect; } } -close MAP; -close MSG; +close $map; +close $msg; copytable('message'); copytable('message_section_map'); @@ -79,8 +79,8 @@ sub copytable my $t = shift; print "COPY $t from stdin;\n"; - open(FFF, "$t.tmp") || die; - while () { print; } - close FFF; + open(my $fff, '<', "$t.tmp") || die; + while (<$fff>) { print; } + close $fff; print "\\.\n"; } diff --git a/doc/src/sgml/generate-errcodes-table.pl b/doc/src/sgml/generate-errcodes-table.pl index 66be811..01fc616 100644 --- a/doc/src/sgml/generate-errcodes-table.pl +++ b/doc/src/sgml/generate-errcodes-table.pl @@ -9,7 +9,7 @@ use strict; print "\n"; -open my $errcodes, $ARGV[0] or die; +open my $errcodes, '<', $ARGV[0] or die; while (<$errcodes>) { diff --git a/doc/src/sgml/mk_feature_tables.pl b/doc/src/sgml/mk_feature_tables.pl index 93dab21..9b111b8 100644 --- a/doc/src/sgml/mk_feature_tables.pl +++ b/doc/src/sgml/mk_feature_tables.pl @@ -6,11 +6,11 @@ use strict; my $yesno = $ARGV[0]; -open PACK, $ARGV[1] or die; +open my $pack, '<', $ARGV[1] or die; my %feature_packages; -while () +while (<$pack>) { chomp; my ($fid, $pname) = split /\t/; @@ -24,13 +24,13 @@ while () } } -close PACK; +close $pack; -open FEAT, $ARGV[2] or die; +open my $feat, '<', $ARGV[2] or die; print "\n"; -while () +while (<$feat>) { chomp; my ($feature_id, $feature_name, $subfeature_id, @@ -69,4 +69,4 @@ while () print "\n"; -close FEAT; +close $feat; diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm index bccbc51..6ffd5f9 100644 --- a/src/backend/catalog/Catalog.pm +++ b/src/backend/catalog/Catalog.pm @@ -44,13 +44,13 @@ sub Catalogs $catalog{columns} = []; $catalog{data} = []; - open(INPUT_FILE, '<', $input_file) || die "$input_file: $!"; + open(my $ifh, '<', $input_file) || die "$input_file: $!"; my ($filename) = ($input_file =~ m/(\w+)\.h$/); my $natts_pat = "Natts_$filename"; # Scan the input file. - while () + while (<$ifh>) { # Strip C-style comments. @@ -59,7 +59,7 @@ sub Catalogs { # handle multi-line comments properly. - my $next_line = ; + my $next_line = <$ifh>; die "$input_file: ends within C-style comment\n" if !defined $next_line; $_ .= $next_line; @@ -211,7 +211,7 @@ sub Catalogs } } $catalogs{$catname} = \%catalog; - close INPUT_FILE; + close $ifh; } return \%catalogs; } diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl index 079516c..f9ecb02 100644 --- a/src/backend/catalog/genbki.pl +++ b/src/backend/catalog/genbki.pl @@ -66,16 +66,16 @@ if ($output_path ne '' && substr($output_path, -1) ne '/') # Open temp files my $tmpext = ".tmp$$"; my $bkifile = $output_path . 'postgres.bki'; -open BKI, '>', $bkifile . $tmpext +open my $bki, '>', $bkifile . $tmpext or die "can't open $bkifile$tmpext: $!"; my $schemafile = $output_path . 'schemapg.h'; -open SCHEMAPG, '>', $schemafile . $tmpext +open my $schemapg, '>', $schemafile . $tmpext or die "can't open $schemafile$tmpext: $!"; my $descrfile = $output_path . 'postgres.description'; -open DESCR, '>', $descrfile . $tmpext +open my $descr, '>', $descrfile . $tmpext or die "can't open $descrfile$tmpext: $!"; my $shdescrfile = $output_path . 'postgres.shdescription'; -open SHDESCR, '>', $shdescrfile . $tmpext +open my $shdescr, '>', $shdescrfile . $tmpext or die "can't open $shdescrfile$tmpext: $!"; # Fetch some special data that we will substitute into the output file. @@ -97,7 +97,7 @@ my $catalogs = Catalog::Catalogs(@input_files); # Generate postgres.bki, postgres.description, and postgres.shdescription # version marker for .bki file -print BKI "# PostgreSQL $major_version\n"; +print $bki "# PostgreSQL $major_version\n"; # vars to hold data needed for schemapg.h my %schemapg_entries; @@ -110,7 +110,7 @@ foreach my $catname (@{ $catalogs->{names} }) # .bki CREATE command for this catalog my $catalog = $catalogs->{$catname}; - print BKI "create $catname $catalog->{relation_oid}" + print $bki "create $catname $catalog->{relation_oid}" . $catalog->{shared_relation} . $catalog->{bootstrap} . $catalog->{without_oids} @@ -120,7 +120,7 @@ foreach my $catname (@{ $catalogs->{names} }) my @attnames; my $first = 1; - print BKI " (\n"; + print $bki " (\n"; foreach my $column (@{ $catalog->{columns} }) { my $attname = $column->{name}; @@ -130,27 +130,27 @@ foreach my $catname (@{ $catalogs->{names} }) if (!$first) { - print BKI " ,\n"; + print $bki " ,\n"; } $first = 0; - print BKI " $attname = $atttype"; + print $bki " $attname = $atttype"; if (defined $column->{forcenotnull}) { - print BKI " FORCE NOT NULL"; + print $bki " FORCE NOT NULL"; } elsif (defined $column->{forcenull}) { - print BKI " FORCE NULL"; + print $bki " FORCE NULL"; } } - print BKI "\n )\n"; + print $bki "\n )\n"; # open it, unless bootstrap case (create bootstrap does this automatically) if ($catalog->{bootstrap} eq '') { - print BKI "open $catname\n"; + print $bki "open $catname\n"; } if (defined $catalog->{data}) @@ -175,17 +175,17 @@ foreach my $catname (@{ $catalogs->{names} }) # Write to postgres.bki my $oid = $row->{oid} ? "OID = $row->{oid} " : ''; - printf BKI "insert %s( %s)\n", $oid, $row->{bki_values}; + printf $bki "insert %s( %s)\n", $oid, $row->{bki_values}; # Write comments to postgres.description and postgres.shdescription if (defined $row->{descr}) { - printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname, + printf $descr "%s\t%s\t0\t%s\n", $row->{oid}, $catname, $row->{descr}; } if (defined $row->{shdescr}) { - printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname, + printf $shdescr "%s\t%s\t%s\n", $row->{oid}, $catname, $row->{shdescr}; } } @@ -267,7 +267,7 @@ foreach my $catname (@{ $catalogs->{names} }) } } - print BKI "close $catname\n"; + print $bki "close $catname\n"; } # Any information needed for the BKI that is not contained in a pg_*.h header @@ -276,19 +276,19 @@ foreach my $catname (@{ $catalogs->{names} }) # Write out declare toast/index statements foreach my $declaration (@{ $catalogs->{toasting}->{data} }) { - print BKI $declaration; + print $bki $declaration; } foreach my $declaration (@{ $catalogs->{indexing}->{data} }) { - print BKI $declaration; + print $bki $declaration; } # Now generate schemapg.h # Opening boilerplate for schemapg.h -print SCHEMAPG <{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 () + open(my $find_defined_symbol, '<', $file) || die "$file: $!"; + while (<$find_defined_symbol>) { if (/^#define\s+\Q$symbol\E\s+(\S+)/) { return $1; } } - close FIND_DEFINED_SYMBOL; + close $find_defined_symbol; die "$file: no definition found for $symbol\n"; } die "$catalog_header: not found in any include directory\n"; diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl index 45862ce..84fef1d 100644 --- a/src/backend/parser/check_keywords.pl +++ b/src/backend/parser/check_keywords.pl @@ -14,7 +14,7 @@ my $kwlist_filename = $ARGV[1]; my $errors = 0; -sub error(@) +sub error { print STDERR @_; $errors = 1; @@ -29,18 +29,18 @@ $keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD'; $keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD'; $keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD'; -open(GRAM, $gram_filename) || die("Could not open : $gram_filename"); +open(my $gram, '<', $gram_filename) || die("Could not open : $gram_filename"); -my ($S, $s, $k, $n, $kcat); +my $kcat; my $comment; my @arr; my %keywords; -line: while () +line: while (my $S = <$gram>) { - chomp; # strip record separator + chomp $S; # strip record separator - $S = $_; + my $s; # Make sure any braces are split $s = '{', $S =~ s/$s/ { /g; @@ -54,7 +54,7 @@ line: while () { # Is this the beginning of a keyword list? - foreach $k (keys %keyword_categories) + foreach my $k (keys %keyword_categories) { if ($S =~ m/^($k):/) { @@ -66,7 +66,7 @@ line: while () } # Now split the line into individual fields - $n = (@arr = split(' ', $S)); + my $n = (@arr = split(' ', $S)); # Ok, we're in a keyword list. Go through each field in turn for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++) @@ -109,15 +109,15 @@ line: while () push @{ $keywords{$kcat} }, $arr[$fieldIndexer]; } } -close GRAM; +close $gram; # Check that each keyword list is in alphabetical order (just for neatnik-ism) -my ($prevkword, $kword, $bare_kword); -foreach $kcat (keys %keyword_categories) +my ($prevkword, $bare_kword); +foreach my $kcat (keys %keyword_categories) { $prevkword = ''; - foreach $kword (@{ $keywords{$kcat} }) + foreach my $kword (@{ $keywords{$kcat} }) { # Some keyword have a _P suffix. Remove it for the comparison. @@ -149,12 +149,12 @@ while (my ($kcat, $kcat_id) = each(%keyword_categories)) # Now read in kwlist.h -open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename"); +open(my $kwlist, '<', $kwlist_filename) || die("Could not open : $kwlist_filename"); my $prevkwstring = ''; my $bare_kwname; my %kwhash; -kwlist_line: while () +kwlist_line: while (<$kwlist>) { my ($line) = $_; @@ -219,7 +219,7 @@ kwlist_line: while () } } } -close KWLIST; +close $kwlist; # Check that we've paired up all keywords from gram.y with lines in kwlist.h while (my ($kwcat, $kwcat_id) = each(%keyword_categories)) diff --git a/src/backend/storage/lmgr/generate-lwlocknames.pl b/src/backend/storage/lmgr/generate-lwlocknames.pl index f80d2c8..10d0698 100644 --- a/src/backend/storage/lmgr/generate-lwlocknames.pl +++ b/src/backend/storage/lmgr/generate-lwlocknames.pl @@ -9,21 +9,21 @@ use strict; my $lastlockidx = -1; my $continue = "\n"; -open my $lwlocknames, $ARGV[0] or die; +open my $lwlocknames, '<', $ARGV[0] or die; # Include PID in suffix in case parallel make runs this multiple times. my $htmp = "lwlocknames.h.tmp$$"; my $ctmp = "lwlocknames.c.tmp$$"; -open H, '>', $htmp or die "Could not open $htmp: $!"; -open C, '>', $ctmp or die "Could not open $ctmp: $!"; +open my $h, '>', $htmp or die "Could not open $htmp: $!"; +open my $c, '>', $ctmp or die "Could not open $ctmp: $!"; my $autogen = "/* autogenerated from src/backend/storage/lmgr/lwlocknames.txt, do not edit */\n"; -print H $autogen; -print H "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n"; -print C $autogen, "\n"; +print $h $autogen; +print $h "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n"; +print $c $autogen, "\n"; -print C "char *MainLWLockNames[] = {"; +print $c "char *MainLWLockNames[] = {"; while (<$lwlocknames>) { @@ -44,22 +44,22 @@ while (<$lwlocknames>) while ($lastlockidx < $lockidx - 1) { ++$lastlockidx; - printf C "%s \"\"", $continue, $lastlockidx; + printf $c "%s \"\"", $continue, $lastlockidx; $continue = ",\n"; } - printf C "%s \"%s\"", $continue, $lockname; + printf $c "%s \"%s\"", $continue, $lockname; $lastlockidx = $lockidx; $continue = ",\n"; - print H "#define $lockname (&MainLWLockArray[$lockidx].lock)\n"; + print $h "#define $lockname (&MainLWLockArray[$lockidx].lock)\n"; } -printf C "\n};\n"; -print H "\n"; -printf H "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1; +printf $c "\n};\n"; +print $h "\n"; +printf $h "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1; -close H; -close C; +close $h; +close $c; rename($htmp, 'lwlocknames.h') || die "rename: $htmp: $!"; rename($ctmp, 'lwlocknames.c') || die "rename: $ctmp: $!"; diff --git a/src/backend/utils/Gen_fmgrtab.pl b/src/backend/utils/Gen_fmgrtab.pl index cdd603a..2af9b35 100644 --- a/src/backend/utils/Gen_fmgrtab.pl +++ b/src/backend/utils/Gen_fmgrtab.pl @@ -90,11 +90,11 @@ my $oidsfile = $output_path . 'fmgroids.h'; my $protosfile = $output_path . 'fmgrprotos.h'; my $tabfile = $output_path . 'fmgrtab.c'; -open H, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!"; -open P, '>', $protosfile . $tmpext or die "Could not open $protosfile$tmpext: $!"; -open T, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!"; +open my $ofh, '>', $oidsfile . $tmpext or die "Could not open $oidsfile$tmpext: $!"; +open my $pfh, '>', $protosfile . $tmpext or die "Could not open $protosfile$tmpext: $!"; +open my $tfh, '>', $tabfile . $tmpext or die "Could not open $tabfile$tmpext: $!"; -print H +print $ofh qq|/*------------------------------------------------------------------------- * * fmgroids.h @@ -132,7 +132,7 @@ qq|/*------------------------------------------------------------------------- */ |; -print P +print $pfh qq|/*------------------------------------------------------------------------- * * fmgrprotos.h @@ -159,7 +159,7 @@ qq|/*------------------------------------------------------------------------- |; -print T +print $tfh qq|/*------------------------------------------------------------------------- * * fmgrtab.c @@ -193,26 +193,26 @@ foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr) { next if $seenit{ $s->{prosrc} }; $seenit{ $s->{prosrc} } = 1; - print H "#define F_" . uc $s->{prosrc} . " $s->{oid}\n"; - print P "extern Datum $s->{prosrc}(PG_FUNCTION_ARGS);\n"; + print $ofh "#define F_" . uc $s->{prosrc} . " $s->{oid}\n"; + print $pfh "extern Datum $s->{prosrc}(PG_FUNCTION_ARGS);\n"; } # Create the fmgr_builtins table -print T "\nconst FmgrBuiltin fmgr_builtins[] = {\n"; +print $tfh "\nconst FmgrBuiltin fmgr_builtins[] = {\n"; my %bmap; $bmap{'t'} = 'true'; $bmap{'f'} = 'false'; foreach my $s (sort { $a->{oid} <=> $b->{oid} } @fmgr) { - print T + print $tfh " { $s->{oid}, \"$s->{prosrc}\", $s->{nargs}, $bmap{$s->{strict}}, $bmap{$s->{retset}}, $s->{prosrc} },\n"; } # And add the file footers. -print H "\n#endif /* FMGROIDS_H */\n"; -print P "\n#endif /* FMGRPROTOS_H */\n"; +print $ofh "\n#endif /* FMGROIDS_H */\n"; +print $pfh "\n#endif /* FMGRPROTOS_H */\n"; -print T +print $tfh qq| /* dummy entry is easier than getting rid of comma after last real one */ /* (not that there has ever been anything wrong with *having* a comma after the last field in an array initializer) */ @@ -223,9 +223,9 @@ qq| /* dummy entry is easier than getting rid of comma after last real one */ const int fmgr_nbuiltins = (sizeof(fmgr_builtins) / sizeof(FmgrBuiltin)) - 1; |; -close(H); -close(P); -close(T); +close($ofh); +close($pfh); +close($tfh); # Finally, rename the completed files into place. Catalog::RenameTempFile($oidsfile, $tmpext); diff --git a/src/backend/utils/generate-errcodes.pl b/src/backend/utils/generate-errcodes.pl index b84c6b0..6a577f6 100644 --- a/src/backend/utils/generate-errcodes.pl +++ b/src/backend/utils/generate-errcodes.pl @@ -10,7 +10,7 @@ print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print "/* there is deliberately not an #ifndef ERRCODES_H here */\n"; -open my $errcodes, $ARGV[0] or die; +open my $errcodes, '<', $ARGV[0] or die; while (<$errcodes>) { diff --git a/src/bin/pg_basebackup/t/010_pg_basebackup.pl b/src/bin/pg_basebackup/t/010_pg_basebackup.pl index 14bd813..1d3c498 100644 --- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl +++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl @@ -24,10 +24,10 @@ $node->command_fails(['pg_basebackup'], # Some Windows ANSI code pages may reject this filename, in which case we # quietly proceed without this bit of test coverage. -if (open BADCHARS, ">>$tempdir/pgdata/FOO\xe0\xe0\xe0BAR") +if (open my $badchars, '>>', "$tempdir/pgdata/FOO\xe0\xe0\xe0BAR") { - print BADCHARS "test backup of file with non-UTF8 name\n"; - close BADCHARS; + print $badchars "test backup of file with non-UTF8 name\n"; + close $badchars; } $node->set_replication_conf(); @@ -45,19 +45,19 @@ $node->command_fails( ok(-d "$tempdir/backup", 'backup directory was created and left behind'); -open CONF, ">>$pgdata/postgresql.conf"; -print CONF "max_replication_slots = 10\n"; -print CONF "max_wal_senders = 10\n"; -print CONF "wal_level = replica\n"; -close CONF; +open my $conf, '>>', "$pgdata/postgresql.conf"; +print $conf "max_replication_slots = 10\n"; +print $conf "max_wal_senders = 10\n"; +print $conf "wal_level = replica\n"; +close $conf; $node->restart; # Write some files to test that they are not copied. foreach my $filename (qw(backup_label tablespace_map postgresql.auto.conf.tmp current_logfiles.tmp)) { - open FILE, ">>$pgdata/$filename"; - print FILE "DONOTCOPY"; - close FILE; + open my $file, '>>', "$pgdata/$filename"; + print $file "DONOTCOPY"; + close $file; } $node->command_ok([ 'pg_basebackup', '-D', "$tempdir/backup", '-X', 'none' ], @@ -124,8 +124,8 @@ $node->command_fails( my $superlongname = "superlongname_" . ("x" x 100); my $superlongpath = "$pgdata/$superlongname"; -open FILE, ">$superlongpath" or die "unable to create file $superlongpath"; -close FILE; +open my $file, '>', "$superlongpath" or die "unable to create file $superlongpath"; +close $file; $node->command_fails( [ 'pg_basebackup', '-D', "$tempdir/tarbackup_l1", '-Ft' ], 'pg_basebackup tar with long name fails'); diff --git a/src/bin/pg_ctl/t/001_start_stop.pl b/src/bin/pg_ctl/t/001_start_stop.pl index 8f16bf9..9182574 100644 --- a/src/bin/pg_ctl/t/001_start_stop.pl +++ b/src/bin/pg_ctl/t/001_start_stop.pl @@ -20,18 +20,18 @@ command_ok([ 'pg_ctl', 'initdb', '-D', "$tempdir/data", '-o', '-N' ], 'pg_ctl initdb'); command_ok([ $ENV{PG_REGRESS}, '--config-auth', "$tempdir/data" ], 'configure authentication'); -open CONF, ">>$tempdir/data/postgresql.conf"; -print CONF "fsync = off\n"; -if (!$windows_os) +open my $conf, '>>', "$tempdir/data/postgresql.conf"; +print $conf "fsync = off\n"; +if (! $windows_os) { - print CONF "listen_addresses = ''\n"; - print CONF "unix_socket_directories = '$tempdir_short'\n"; + print $conf "listen_addresses = ''\n"; + print $conf "unix_socket_directories = '$tempdir_short'\n"; } else { - print CONF "listen_addresses = '127.0.0.1'\n"; + print $conf "listen_addresses = '127.0.0.1'\n"; } -close CONF; +close $conf; command_ok([ 'pg_ctl', 'start', '-D', "$tempdir/data" ], 'pg_ctl start'); diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl index 359670b..cedb767 100644 --- a/src/bin/psql/create_help.pl +++ b/src/bin/psql/create_help.pl @@ -42,12 +42,12 @@ $define =~ s/\W/_/g; opendir(DIR, $docdir) or die "$0: could not open documentation source dir '$docdir': $!\n"; -open(HFILE, ">$hfile") +open(my $hfile_handle, '>', $hfile) or die "$0: could not open output file '$hfile': $!\n"; -open(CFILE, ">$cfile") +open(my $cfile_handle, '>', $cfile) or die "$0: could not open output file '$cfile': $!\n"; -print HFILE "/* +print $hfile_handle "/* * *** Do not change this file by hand. It is automatically * *** generated from the DocBook documentation. * @@ -72,7 +72,7 @@ struct _helpStruct extern const struct _helpStruct QL_HELP[]; "; -print CFILE "/* +print $cfile_handle "/* * *** Do not change this file by hand. It is automatically * *** generated from the DocBook documentation. * @@ -97,9 +97,9 @@ foreach my $file (sort readdir DIR) my (@cmdnames, $cmddesc, $cmdsynopsis); $file =~ /\.sgml$/ or next; - open(FILE, "$docdir/$file") or next; - my $filecontent = join('', ); - close FILE; + open(my $fh, '<', "$docdir/$file") or next; + my $filecontent = join('', <$fh>); + close $fh; # Ignore files that are not for SQL language statements $filecontent =~ @@ -171,7 +171,7 @@ foreach (sort keys %entries) $synopsis =~ s/\\n/\\n"\n$prefix"/g; my @args = ("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} })); - print CFILE "static void + print $cfile_handle "static void sql_help_$id(PQExpBuffer buf) { \tappendPQExpBuffer(" . join(",\n$prefix", @args) . "); @@ -180,14 +180,14 @@ sql_help_$id(PQExpBuffer buf) "; } -print CFILE " +print $cfile_handle " const struct _helpStruct QL_HELP[] = { "; foreach (sort keys %entries) { my $id = $_; $id =~ s/ /_/g; - print CFILE " { \"$_\", + print $cfile_handle " { \"$_\", N_(\"$entries{$_}{cmddesc}\"), sql_help_$id, $entries{$_}{nl_count} }, @@ -195,12 +195,12 @@ foreach (sort keys %entries) "; } -print CFILE " +print $cfile_handle " { NULL, NULL, NULL } /* End of list marker */ }; "; -print HFILE " +print $hfile_handle " #define QL_HELP_COUNT " . scalar(keys %entries) . " /* number of help items */ #define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */ @@ -209,6 +209,6 @@ print HFILE " #endif /* $define */ "; -close CFILE; -close HFILE; +close $cfile_handle; +close $hfile_handle; closedir DIR; diff --git a/src/interfaces/ecpg/preproc/check_rules.pl b/src/interfaces/ecpg/preproc/check_rules.pl index dce4bc6..e681943 100644 --- a/src/interfaces/ecpg/preproc/check_rules.pl +++ b/src/interfaces/ecpg/preproc/check_rules.pl @@ -53,8 +53,8 @@ my $comment = 0; my $non_term_id = ''; my $cc = 0; -open GRAM, $parser or die $!; -while () +open my $parser_fh, '<', $parser or die $!; +while (<$parser_fh>) { if (/^%%/) { @@ -145,7 +145,7 @@ while () } } -close GRAM; +close $parser_fh; if ($verbose) { print "$cc rules loaded\n"; @@ -154,8 +154,8 @@ if ($verbose) my $ret = 0; $cc = 0; -open ECPG, $filename or die $!; -while () +open my $ecpg_fh, '<', $filename or die $!; +while (<$ecpg_fh>) { if (!/^ECPG:/) { @@ -170,7 +170,7 @@ while () $ret = 1; } } -close ECPG; +close $ecpg_fh; if ($verbose) { diff --git a/src/interfaces/libpq/test/regress.pl b/src/interfaces/libpq/test/regress.pl index 1dab122..c403130 100644 --- a/src/interfaces/libpq/test/regress.pl +++ b/src/interfaces/libpq/test/regress.pl @@ -14,19 +14,19 @@ my $expected_out = "$srcdir/$subdir/expected.out"; my $regress_out = "regress.out"; # open input file first, so possible error isn't sent to redirected STDERR -open(REGRESS_IN, "<", $regress_in) +open(my $regress_in_fh, "<", $regress_in) or die "can't open $regress_in for reading: $!"; # save STDOUT/ERR and redirect both to regress.out -open(OLDOUT, ">&", \*STDOUT) or die "can't dup STDOUT: $!"; -open(OLDERR, ">&", \*STDERR) or die "can't dup STDERR: $!"; +open(my $oldout_fh, ">&", \*STDOUT) or die "can't dup STDOUT: $!"; +open(my $olderr_fh, ">&", \*STDERR) or die "can't dup STDERR: $!"; open(STDOUT, ">", $regress_out) or die "can't open $regress_out for writing: $!"; open(STDERR, ">&", \*STDOUT) or die "can't dup STDOUT: $!"; # read lines from regress.in and run uri-regress on them -while () +while (<$regress_in_fh>) { chomp; print "trying $_\n"; @@ -35,11 +35,11 @@ while () } # restore STDOUT/ERR so we can print the outcome to the user -open(STDERR, ">&", \*OLDERR) or die; # can't complain as STDERR is still duped -open(STDOUT, ">&", \*OLDOUT) or die "can't restore STDOUT: $!"; +open(STDERR, ">&", $olderr_fh) or die; # can't complain as STDERR is still duped +open(STDOUT, ">&", $oldout_fh) or die "can't restore STDOUT: $!"; # just in case -close REGRESS_IN; +close $regress_in_fh; my $diff_status = system( "diff -c \"$srcdir/$subdir/expected.out\" regress.out >regress.diff"); diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index bb2d009..b4212f5 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -52,7 +52,7 @@ sub ::encode_array_constructor { - package PostgreSQL::InServer; + package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage); use strict; use warnings; @@ -81,14 +81,13 @@ sub ::encode_array_constructor } sort keys %$imports; $BEGIN &&= "BEGIN { $BEGIN }"; - return qq[ package main; sub { $BEGIN $prolog $src } ]; + # default no strict and no warnings + return qq[ package main; sub { no strict; no warnings; $BEGIN $prolog $src } ]; } sub mkfunc { - no strict; # default to no strict for the eval - no warnings; # default to no warnings for the eval - my $ret = eval(mkfuncsrc(@_)); + my $ret = eval(mkfuncsrc(@_)); ## no critic (ProhibitStringyEval); $@ =~ s/\(eval \d+\) //g if $@; return $ret; } diff --git a/src/pl/plperl/plc_trusted.pl b/src/pl/plperl/plc_trusted.pl index cd61882..38255b4 100644 --- a/src/pl/plperl/plc_trusted.pl +++ b/src/pl/plperl/plc_trusted.pl @@ -1,6 +1,6 @@ # src/pl/plperl/plc_trusted.pl -package PostgreSQL::InServer::safe; +package PostgreSQL::InServer::safe; ## no critic (RequireFilenameMatchesPackage); # Load widely useful pragmas into plperl to make them available. # diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl index c88e5ec..e681fca 100644 --- a/src/pl/plperl/text2macro.pl +++ b/src/pl/plperl/text2macro.pl @@ -49,7 +49,7 @@ for my $src_file (@ARGV) (my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x; - open my $src_fh, $src_file # not 3-arg form + open my $src_fh, '<', $src_file or die "Can't open $src_file: $!"; printf qq{#define %s%s \\\n}, @@ -80,19 +80,19 @@ sub selftest my $tmp = "text2macro_tmp"; my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b}; - open my $fh, ">$tmp.pl" or die; + open my $fh, '>', "$tmp.pl" or die; print $fh $string; close $fh; system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die; - open $fh, ">>$tmp.c"; + open $fh, '>>', "$tmp.c"; print $fh "#include \n"; print $fh "int main() { puts(X); return 0; }\n"; close $fh; system("cat -n $tmp.c"); system("make $tmp") == 0 or die; - open $fh, "./$tmp |" or die; + open $fh, '<', "./$tmp |" or die; my $result = <$fh>; unlink <$tmp.*>; diff --git a/src/pl/plpgsql/src/generate-plerrcodes.pl b/src/pl/plpgsql/src/generate-plerrcodes.pl index 6a676c0..eb135bc 100644 --- a/src/pl/plpgsql/src/generate-plerrcodes.pl +++ b/src/pl/plpgsql/src/generate-plerrcodes.pl @@ -10,7 +10,7 @@ print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n"; -open my $errcodes, $ARGV[0] or die; +open my $errcodes, '<', $ARGV[0] or die; while (<$errcodes>) { diff --git a/src/pl/plpython/generate-spiexceptions.pl b/src/pl/plpython/generate-spiexceptions.pl index ab0fa4a..a9ee960 100644 --- a/src/pl/plpython/generate-spiexceptions.pl +++ b/src/pl/plpython/generate-spiexceptions.pl @@ -10,7 +10,7 @@ print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n"; -open my $errcodes, $ARGV[0] or die; +open my $errcodes, '<', $ARGV[0] or die; while (<$errcodes>) { diff --git a/src/pl/tcl/generate-pltclerrcodes.pl b/src/pl/tcl/generate-pltclerrcodes.pl index e20a0af..b4e429a 100644 --- a/src/pl/tcl/generate-pltclerrcodes.pl +++ b/src/pl/tcl/generate-pltclerrcodes.pl @@ -10,7 +10,7 @@ print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; print "/* there is deliberately not an #ifndef PLTCLERRCODES_H here */\n"; -open my $errcodes, $ARGV[0] or die; +open my $errcodes, '<', $ARGV[0] or die; while (<$errcodes>) { diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl index cb7e493..c0bc5d6 100755 --- a/src/test/locale/sort-test.pl +++ b/src/test/locale/sort-test.pl @@ -3,9 +3,9 @@ use strict; use locale; -open(INFILE, "<$ARGV[0]"); -chop(my (@words) = ); -close(INFILE); +open my $in_fh, '<', $ARGV[0] || die; +chop(my (@words) = <$in_fh>); +close($in_fh); $" = "\n"; my (@result) = sort @words; diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm index 5ef007f..1ad8f7f 100644 --- a/src/test/perl/PostgresNode.pm +++ b/src/test/perl/PostgresNode.pm @@ -347,7 +347,7 @@ sub set_replication_conf $self->host eq $test_pghost or die "set_replication_conf only works with the default host"; - open my $hba, ">>$pgdata/pg_hba.conf"; + open my $hba, '>>', "$pgdata/pg_hba.conf"; print $hba "\n# Allow replication (set up by PostgresNode.pm)\n"; if ($TestLib::windows_os) { @@ -399,7 +399,7 @@ sub init @{ $params{extra} }); TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata); - open my $conf, ">>$pgdata/postgresql.conf"; + open my $conf, '>>', "$pgdata/postgresql.conf"; print $conf "\n# Added by PostgresNode.pm\n"; print $conf "fsync = off\n"; print $conf "log_line_prefix = '%m [%p] %q%a '\n"; @@ -820,7 +820,7 @@ sub _update_pid # If we can open the PID file, read its first line and that's the PID we # want. If the file cannot be opened, presumably the server is not # running; don't be noisy in that case. - if (open my $pidfile, $self->data_dir . "/postmaster.pid") + if (open my $pidfile, '<', $self->data_dir . "/postmaster.pid") { chomp($self->{_pid} = <$pidfile>); print "# Postmaster PID for node \"$name\" is $self->{_pid}\n"; @@ -1357,7 +1357,7 @@ sub lsn chomp($result); if ($result eq '') { - return undef; + return; } else { diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index d22957c..ae8d178 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -84,14 +84,14 @@ INIT $test_logfile = basename($0); $test_logfile =~ s/\.[^.]+$//; $test_logfile = "$log_path/regress_log_$test_logfile"; - open TESTLOG, '>', $test_logfile + open my $testlog, '>', $test_logfile or die "could not open STDOUT to logfile \"$test_logfile\": $!"; # Hijack STDOUT and STDERR to the log file - open(ORIG_STDOUT, ">&STDOUT"); - open(ORIG_STDERR, ">&STDERR"); - open(STDOUT, ">&TESTLOG"); - open(STDERR, ">&TESTLOG"); + open(my $orig_stdout, '>&', \*STDOUT); + open(my $orig_stderr, '>&', \*STDERR); + open(STDOUT, '>&', $testlog); + open(STDERR, '>&', $testlog); # The test output (ok ...) needs to be printed to the original STDOUT so # that the 'prove' program can parse it, and display it to the user in @@ -99,16 +99,16 @@ INIT # in the log. my $builder = Test::More->builder; my $fh = $builder->output; - tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG; + tie *$fh, "SimpleTee", $orig_stdout, $testlog; $fh = $builder->failure_output; - tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG; + tie *$fh, "SimpleTee", $orig_stderr, $testlog; # Enable auto-flushing for all the file handles. Stderr and stdout are # redirected to the same file, and buffering causes the lines to appear # in the log in confusing order. autoflush STDOUT 1; autoflush STDERR 1; - autoflush TESTLOG 1; + autoflush $testlog 1; } END diff --git a/src/test/ssl/ServerSetup.pm b/src/test/ssl/ServerSetup.pm index 9441249..6d17d6d 100644 --- a/src/test/ssl/ServerSetup.pm +++ b/src/test/ssl/ServerSetup.pm @@ -58,21 +58,21 @@ sub configure_test_server_for_ssl $node->psql('postgres', "CREATE DATABASE certdb"); # enable logging etc. - open CONF, ">>$pgdata/postgresql.conf"; - print CONF "fsync=off\n"; - print CONF "log_connections=on\n"; - print CONF "log_hostname=on\n"; - print CONF "listen_addresses='$serverhost'\n"; - print CONF "log_statement=all\n"; + open my $conf, '>>', "$pgdata/postgresql.conf"; + print $conf "fsync=off\n"; + print $conf "log_connections=on\n"; + print $conf "log_hostname=on\n"; + print $conf "listen_addresses='$serverhost'\n"; + print $conf "log_statement=all\n"; # enable SSL and set up server key - print CONF "include 'sslconfig.conf'"; + print $conf "include 'sslconfig.conf'"; - close CONF; + close $conf; # ssl configuration will be placed here - open SSLCONF, ">$pgdata/sslconfig.conf"; - close SSLCONF; + open my $sslconf, '>', "$pgdata/sslconfig.conf"; + close $sslconf; # Copy all server certificates and keys, and client root cert, to the data dir copy_files("ssl/server-*.crt", $pgdata); @@ -100,13 +100,13 @@ sub switch_server_cert diag "Reloading server with certfile \"$certfile\" and cafile \"$cafile\"..."; - open SSLCONF, ">$pgdata/sslconfig.conf"; - print SSLCONF "ssl=on\n"; - print SSLCONF "ssl_ca_file='$cafile.crt'\n"; - print SSLCONF "ssl_cert_file='$certfile.crt'\n"; - print SSLCONF "ssl_key_file='$certfile.key'\n"; - print SSLCONF "ssl_crl_file='root+client.crl'\n"; - close SSLCONF; + open my $sslconf, '>', "$pgdata/sslconfig.conf"; + print $sslconf "ssl=on\n"; + print $sslconf "ssl_ca_file='root+client_ca.crt'\n"; + print $sslconf "ssl_cert_file='$certfile.crt'\n"; + print $sslconf "ssl_key_file='$certfile.key'\n"; + print $sslconf "ssl_crl_file='root+client.crl'\n"; + close $sslconf; $node->reload; } @@ -121,16 +121,16 @@ sub configure_hba_for_ssl # but seems best to keep it as narrow as possible for security reasons. # # When connecting to certdb, also check the client certificate. - open HBA, ">$pgdata/pg_hba.conf"; - print HBA + open my $hba, '>', "$pgdata/pg_hba.conf"; + print $hba "# TYPE DATABASE USER ADDRESS METHOD\n"; - print HBA + print $hba "hostssl trustdb ssltestuser $serverhost/32 trust\n"; - print HBA + print $hba "hostssl trustdb ssltestuser ::1/128 trust\n"; - print HBA + print $hba "hostssl certdb ssltestuser $serverhost/32 cert\n"; - print HBA + print $hba "hostssl certdb ssltestuser ::1/128 cert\n"; - close HBA; + close $hba; } diff --git a/src/tools/fix-old-flex-code.pl b/src/tools/fix-old-flex-code.pl index 8dafcae..bc868df 100644 --- a/src/tools/fix-old-flex-code.pl +++ b/src/tools/fix-old-flex-code.pl @@ -25,7 +25,7 @@ my $filename = shift; # Suck in the whole file. local $/ = undef; my $cfile; -open($cfile, $filename) || die "opening $filename for reading: $!"; +open($cfile, '<', $filename) || die "opening $filename for reading: $!"; my $ccode = <$cfile>; close($cfile); @@ -45,7 +45,7 @@ $ccode =~ s|(struct yyguts_t \* yyg = \(struct yyguts_t\*\)yyscanner; /\* This v |s; # Write the modified file back out. -open($cfile, ">$filename") || die "opening $filename for writing: $!"; +open($cfile, '>', $filename) || die "opening $filename for writing: $!"; print $cfile $ccode; close($cfile); diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm index 0aa1422..045ac44 100644 --- a/src/tools/msvc/Install.pm +++ b/src/tools/msvc/Install.pm @@ -58,8 +58,8 @@ sub Install # suppress warning about harmless redeclaration of $config no warnings 'misc'; - require "config_default.pl"; - require "config.pl" if (-f "config.pl"); + do "config_default.pl"; + do "config.pl" if (-f "config.pl"); } chdir("../../..") if (-f "../../../configure"); @@ -367,7 +367,7 @@ sub GenerateConversionScript $sql .= "COMMENT ON CONVERSION pg_catalog.$name IS 'conversion for $se to $de';\n\n"; } - open($F, ">$target/share/conversion_create.sql") + open($F, '>', "$target/share/conversion_create.sql") || die "Could not write to conversion_create.sql\n"; print $F $sql; close($F); @@ -409,7 +409,7 @@ sub GenerateTsearchFiles $mf =~ /^LANGUAGES\s*=\s*(.*)$/m || die "Could not find LANGUAGES line in snowball Makefile\n"; my @pieces = split /\s+/, $1; - open($F, ">$target/share/snowball_create.sql") + open($F, '>', "$target/share/snowball_create.sql") || die "Could not write snowball_create.sql"; print $F read_file('src/backend/snowball/snowball_func.sql.in'); @@ -735,7 +735,7 @@ sub read_file my $t = $/; undef $/; - open($F, $filename) || die "Could not open file $filename\n"; + open($F, '<', $filename) || die "Could not open file $filename\n"; my $txt = <$F>; close($F); $/ = $t; diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm index 12f73f3..ba1bf6d 100644 --- a/src/tools/msvc/Mkvcbuild.pm +++ b/src/tools/msvc/Mkvcbuild.pm @@ -825,7 +825,7 @@ sub GenerateContribSqlFiles $dn =~ s/\.sql$//; $cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g; my $o; - open($o, ">contrib/$n/$out") + open($o, '>', "contrib/$n/$out") || croak "Could not write to contrib/$n/$d"; print $o $cont; close($o); diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm index faf1a68..9817b94 100644 --- a/src/tools/msvc/Project.pm +++ b/src/tools/msvc/Project.pm @@ -310,12 +310,12 @@ sub AddResourceFile if (Solution::IsNewer("$dir/win32ver.rc", 'src/port/win32ver.rc')) { print "Generating win32ver.rc for $dir\n"; - open(I, 'src/port/win32ver.rc') + open(my $i, '<', 'src/port/win32ver.rc') || confess "Could not open win32ver.rc"; - open(O, ">$dir/win32ver.rc") + open(my $o, '>', "$dir/win32ver.rc") || confess "Could not write win32ver.rc"; my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : ""; - while () + while (<$i>) { s/FILEDESC/"$desc"/gm; s/_ICO_/$icostr/gm; @@ -324,11 +324,11 @@ sub AddResourceFile { s/VFT_APP/VFT_DLL/gm; } - print O; + print $o $_; } + close($o); + close($i); } - close(O); - close(I); $self->AddFile("$dir/win32ver.rc"); } @@ -357,13 +357,13 @@ sub Save $self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64'); # Dump the project - open(F, ">$self->{name}$self->{filenameExtension}") + open(my $f, '>', "$self->{name}$self->{filenameExtension}") || croak( "Could not write to $self->{name}$self->{filenameExtension}\n"); - $self->WriteHeader(*F); - $self->WriteFiles(*F); - $self->Footer(*F); - close(F); + $self->WriteHeader($f); + $self->WriteFiles($f); + $self->Footer($f); + close($f); } sub GetAdditionalLinkerDependencies @@ -397,7 +397,7 @@ sub read_file my $t = $/; undef $/; - open($F, $filename) || croak "Could not open file $filename\n"; + open($F, '<', $filename) || croak "Could not open file $filename\n"; my $txt = <$F>; close($F); $/ = $t; @@ -412,8 +412,8 @@ sub read_makefile my $t = $/; undef $/; - open($F, "$reldir/GNUmakefile") - || open($F, "$reldir/Makefile") + open($F, '<', "$reldir/GNUmakefile") + || open($F, '<', "$reldir/Makefile") || confess "Could not open $reldir/Makefile\n"; my $txt = <$F>; close($F); diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm index ff9064f..abac2c7 100644 --- a/src/tools/msvc/Solution.pm +++ b/src/tools/msvc/Solution.pm @@ -102,14 +102,14 @@ sub IsNewer sub copyFile { my ($src, $dest) = @_; - open(I, $src) || croak "Could not open $src"; - open(O, ">$dest") || croak "Could not open $dest"; - while () + open(my $i, '<', $src) || croak "Could not open $src"; + open(my $o, '>', $dest) || croak "Could not open $dest"; + while (<$i>) { - print O; + print $o $_; } - close(I); - close(O); + close($i); + close($o); } sub GenerateFiles @@ -118,9 +118,9 @@ sub GenerateFiles my $bits = $self->{platform} eq 'Win32' ? 32 : 64; # Parse configure.in to get version numbers - open(C, "configure.in") + open(my $c, '<', "configure.in") || confess("Could not open configure.in for reading\n"); - while () + while (<$c>) { if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/) { @@ -133,7 +133,7 @@ sub GenerateFiles $self->{majorver} = sprintf("%d", $1); } } - close(C); + close($c); confess "Unable to parse configure.in for all variables!" if ($self->{strver} eq '' || $self->{numver} eq ''); @@ -146,91 +146,91 @@ sub GenerateFiles if (IsNewer("src/include/pg_config.h", "src/include/pg_config.h.win32")) { print "Generating pg_config.h...\n"; - open(I, "src/include/pg_config.h.win32") + open(my $i, '<', "src/include/pg_config.h.win32") || confess "Could not open pg_config.h.win32\n"; - open(O, ">src/include/pg_config.h") + open(my $o, '>', "src/include/pg_config.h") || confess "Could not write to pg_config.h\n"; my $extraver = $self->{options}->{extraver}; $extraver = '' unless defined $extraver; - while () + while (<$i>) { s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}$extraver"}; s{PG_VERSION_NUM \d+}{PG_VERSION_NUM $self->{numver}}; s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY(z)\n#define PG_VERSION_STR "PostgreSQL $self->{strver}$extraver, compiled by Visual C++ build " __STRINGIFY2(_MSC_VER) ", $bits-bit"}; - print O; + print $o $_; } - print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n"; - print O "#define LOCALEDIR \"/share/locale\"\n" + print $o "#define PG_MAJORVERSION \"$self->{majorver}\"\n"; + print $o "#define LOCALEDIR \"/share/locale\"\n" if ($self->{options}->{nls}); - print O "/* defines added by config steps */\n"; - print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n"; - print O "#define USE_ASSERT_CHECKING 1\n" + print $o "/* defines added by config steps */\n"; + print $o "#ifndef IGNORE_CONFIGURED_SETTINGS\n"; + print $o "#define USE_ASSERT_CHECKING 1\n" if ($self->{options}->{asserts}); - print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap}); - print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib}); - print O "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl}); - print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls}); + print $o "#define USE_LDAP 1\n" if ($self->{options}->{ldap}); + print $o "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib}); + print $o "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl}); + print $o "#define ENABLE_NLS 1\n" if ($self->{options}->{nls}); - print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n"; - print O "#define RELSEG_SIZE ", + print $o "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n"; + print $o "#define RELSEG_SIZE ", (1024 / $self->{options}->{blocksize}) * $self->{options}->{segsize} * 1024, "\n"; - print O "#define XLOG_BLCKSZ ", + print $o "#define XLOG_BLCKSZ ", 1024 * $self->{options}->{wal_blocksize}, "\n"; - print O "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize}, + print $o "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize}, " * 1024 * 1024)\n"; if ($self->{options}->{float4byval}) { - print O "#define USE_FLOAT4_BYVAL 1\n"; - print O "#define FLOAT4PASSBYVAL true\n"; + print $o "#define USE_FLOAT4_BYVAL 1\n"; + print $o "#define FLOAT4PASSBYVAL true\n"; } else { - print O "#define FLOAT4PASSBYVAL false\n"; + print $o "#define FLOAT4PASSBYVAL false\n"; } if ($self->{options}->{float8byval}) { - print O "#define USE_FLOAT8_BYVAL 1\n"; - print O "#define FLOAT8PASSBYVAL true\n"; + print $o "#define USE_FLOAT8_BYVAL 1\n"; + print $o "#define FLOAT8PASSBYVAL true\n"; } else { - print O "#define FLOAT8PASSBYVAL false\n"; + print $o "#define FLOAT8PASSBYVAL false\n"; } if ($self->{options}->{uuid}) { - print O "#define HAVE_UUID_OSSP\n"; - print O "#define HAVE_UUID_H\n"; + print $o "#define HAVE_UUID_OSSP\n"; + print $o "#define HAVE_UUID_H\n"; } if ($self->{options}->{xml}) { - print O "#define HAVE_LIBXML2\n"; - print O "#define USE_LIBXML\n"; + print $o "#define HAVE_LIBXML2\n"; + print $o "#define USE_LIBXML\n"; } if ($self->{options}->{xslt}) { - print O "#define HAVE_LIBXSLT\n"; - print O "#define USE_LIBXSLT\n"; + print $o "#define HAVE_LIBXSLT\n"; + print $o "#define USE_LIBXSLT\n"; } if ($self->{options}->{gss}) { - print O "#define ENABLE_GSS 1\n"; + print $o "#define ENABLE_GSS 1\n"; } if (my $port = $self->{options}->{"--with-pgport"}) { - print O "#undef DEF_PGPORT\n"; - print O "#undef DEF_PGPORT_STR\n"; - print O "#define DEF_PGPORT $port\n"; - print O "#define DEF_PGPORT_STR \"$port\"\n"; + print $o "#undef DEF_PGPORT\n"; + print $o "#undef DEF_PGPORT_STR\n"; + print $o "#define DEF_PGPORT $port\n"; + print $o "#define DEF_PGPORT_STR \"$port\"\n"; } - print O "#define VAL_CONFIGURE \"" + print $o "#define VAL_CONFIGURE \"" . $self->GetFakeConfigure() . "\"\n"; - print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n"; - close(O); - close(I); + print $o "#endif /* IGNORE_CONFIGURED_SETTINGS */\n"; + close($o); + close($i); } if (IsNewer( @@ -379,17 +379,17 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); my $d = ($year - 100) . "$yday"; - open(I, '<', 'src/interfaces/libpq/libpq.rc.in') + open(my $i, '<', 'src/interfaces/libpq/libpq.rc.in') || confess "Could not open libpq.rc.in"; - open(O, '>', 'src/interfaces/libpq/libpq.rc') + open(my $o, '>', 'src/interfaces/libpq/libpq.rc') || confess "Could not open libpq.rc"; - while () + while (<$i>) { s/(VERSION.*),0/$1,$d/; - print O; + print $o; } - close(I); - close(O); + close($i); + close($o); } if (IsNewer('src/bin/psql/sql_help.h', 'src/bin/psql/create_help.pl')) @@ -415,23 +415,23 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY 'src/interfaces/ecpg/include/ecpg_config.h.in')) { print "Generating ecpg_config.h...\n"; - open(O, '>', 'src/interfaces/ecpg/include/ecpg_config.h') + open(my $o, '>', 'src/interfaces/ecpg/include/ecpg_config.h') || confess "Could not open ecpg_config.h"; - print O < 1200) #define HAVE_LONG_LONG_INT_64 #define ENABLE_THREAD_SAFETY 1 EOF - print O "#endif\n"; - close(O); + print $o "#endif\n"; + close($o); } unless (-f "src/port/pg_config_paths.h") { print "Generating pg_config_paths.h...\n"; - open(O, '>', 'src/port/pg_config_paths.h') + open(my $o, '>', 'src/port/pg_config_paths.h') || confess "Could not open pg_config_paths.h"; - print O <doc/src/sgml/version.sgml") + open(my $o, '>', "doc/src/sgml/version.sgml") || croak "Could not write to version.sgml\n"; - print O <{strver}"> {majorver}"> EOF - close(O); + close($o); } sub GenerateDefFile @@ -490,18 +490,18 @@ sub GenerateDefFile if (IsNewer($deffile, $txtfile)) { print "Generating $deffile...\n"; - open(I, $txtfile) || confess("Could not open $txtfile\n"); - open(O, ">$deffile") || confess("Could not open $deffile\n"); - print O "LIBRARY $libname\nEXPORTS\n"; - while () + open(my $if, '<', $txtfile) || confess("Could not open $txtfile\n"); + open(my $of, '>', $deffile) || confess("Could not open $deffile\n"); + print $of "LIBRARY $libname\nEXPORTS\n"; + while (<$if>) { next if (/^#/); next if (/^\s*$/); my ($f, $o) = split; - print O " $f @ $o\n"; + print $of " $f @ $o\n"; } - close(O); - close(I); + close($of); + close($if); } } @@ -575,19 +575,19 @@ sub Save } } - open(SLN, ">pgsql.sln") || croak "Could not write to pgsql.sln\n"; - print SLN <', "pgsql.sln") || croak "Could not write to pgsql.sln\n"; + print $sln <{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 <{name}$proj->{filenameExtension}", "$proj->{guid}" EndProject EOF @@ -595,14 +595,14 @@ EOF if ($fld ne "") { $flduid{$fld} = Win32::GuidGen(); - print SLN <{platform}= Debug|$self->{platform} @@ -615,7 +615,7 @@ EOF { foreach my $proj (@{ $self->{projects}->{$fld} }) { - print SLN <{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform} $proj->{guid}.Debug|$self->{platform}.Build.0 = Debug|$self->{platform} $proj->{guid}.Release|$self->{platform}.ActiveCfg = Release|$self->{platform} @@ -624,7 +624,7 @@ EOF } } - print SLN <{projects}->{$fld} }) { - print SLN "\t\t$proj->{guid} = $flduid{$fld}\n"; + print $sln "\t\t$proj->{guid} = $flduid{$fld}\n"; } } - print SLN <) + open(my $f, '<', $symfile) || die "Could not open $symfile for $_\n"; + while (<$f>) { # Expected symbol lines look like: @@ -115,14 +115,14 @@ sub extract_syms # whatever came last. $def->{ $pieces[6] } = $pieces[3]; } - close(F); + close($f); } sub writedef { my ($deffile, $platform, $def) = @_; - open(DEF, ">$deffile") || die "Could not write to $deffile\n"; - print DEF "EXPORTS\n"; + open(my $fh, '>', $deffile) || die "Could not write to $deffile\n"; + print $fh "EXPORTS\n"; foreach my $f (sort keys %{$def}) { my $isdata = $def->{$f} eq 'data'; @@ -135,14 +135,14 @@ sub writedef # decorated with the DATA option for variables. if ($isdata) { - print DEF " $f DATA\n"; + print $fh " $f DATA\n"; } else { - print DEF " $f\n"; + print $fh " $f\n"; } } - close(DEF); + close($fh); } @@ -174,7 +174,7 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n"; my %def = (); -while (<$ARGV[0]/*.obj>) +while (glob("$ARGV[0]/*.obj")) { my $objfile = $_; my $symfile = $objfile; diff --git a/src/tools/msvc/install.pl b/src/tools/msvc/install.pl index bde5b7c..b2d7f9e 100755 --- a/src/tools/msvc/install.pl +++ b/src/tools/msvc/install.pl @@ -14,11 +14,11 @@ use Install qw(Install); if (-e "src/tools/msvc/buildenv.pl") { - require "src/tools/msvc/buildenv.pl"; + do "src/tools/msvc/buildenv.pl"; } elsif (-e "./buildenv.pl") { - require "./buildenv.pl"; + do "./buildenv.pl"; } my $target = shift || Usage(); diff --git a/src/tools/msvc/mkvcbuild.pl b/src/tools/msvc/mkvcbuild.pl index 6f1c42e..9255dff 100644 --- a/src/tools/msvc/mkvcbuild.pl +++ b/src/tools/msvc/mkvcbuild.pl @@ -19,7 +19,7 @@ print "Warning: no config.pl found, using default.\n" unless (-f 'src/tools/msvc/config.pl'); our $config; -require 'src/tools/msvc/config_default.pl'; -require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); +do 'src/tools/msvc/config_default.pl'; +do 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); Mkvcbuild::mkvcbuild($config); diff --git a/src/tools/msvc/pgbison.pl b/src/tools/msvc/pgbison.pl index 31e7540..e799d90 100644 --- a/src/tools/msvc/pgbison.pl +++ b/src/tools/msvc/pgbison.pl @@ -7,7 +7,7 @@ use File::Basename; # assume we are in the postgres source root -require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; +do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; my ($bisonver) = `bison -V`; # grab first line $bisonver = (split(/\s+/, $bisonver))[3]; # grab version number @@ -38,7 +38,7 @@ $output =~ s/gram\.c$/pl_gram.c/ if $input =~ /src.pl.plpgsql.src.gram\.y$/; my $makefile = dirname($input) . "/Makefile"; my ($mf, $make); -open($mf, $makefile); +open($mf, '<', $makefile); local $/ = undef; $make = <$mf>; close($mf); diff --git a/src/tools/msvc/pgflex.pl b/src/tools/msvc/pgflex.pl index fab0efa..67397ba 100644 --- a/src/tools/msvc/pgflex.pl +++ b/src/tools/msvc/pgflex.pl @@ -10,7 +10,7 @@ $ENV{CYGWIN} = 'nodosfilewarning'; # assume we are in the postgres source root -require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; +do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; my ($flexver) = `flex -V`; # grab first line $flexver = (split(/\s+/, $flexver))[1]; @@ -41,7 +41,7 @@ elsif (!-e $input) # get flex flags from make file my $makefile = dirname($input) . "/Makefile"; my ($mf, $make); -open($mf, $makefile); +open($mf, '<', $makefile); local $/ = undef; $make = <$mf>; close($mf); @@ -53,7 +53,7 @@ if ($? == 0) { # Check for "%option reentrant" in .l file. my $lfile; - open($lfile, $input) || die "opening $input for reading: $!"; + open($lfile, '<', $input) || die "opening $input for reading: $!"; my $lcode = <$lfile>; close($lfile); if ($lcode =~ /\%option\sreentrant/) @@ -69,18 +69,18 @@ if ($? == 0) # For reentrant scanners (like the core scanner) we do not # need to (and must not) change the yywrap definition. my $cfile; - open($cfile, $output) || die "opening $output for reading: $!"; + open($cfile, '<', $output) || die "opening $output for reading: $!"; my $ccode = <$cfile>; close($cfile); $ccode =~ s/yywrap\(n\)/yywrap()/; - open($cfile, ">$output") || die "opening $output for writing: $!"; + open($cfile, '>', $output) || die "opening $output for writing: $!"; print $cfile $ccode; close($cfile); } if ($flexflags =~ /\s-b\s/) { my $lexback = "lex.backup"; - open($lfile, $lexback) || die "opening $lexback for reading: $!"; + open($lfile, '<', $lexback) || die "opening $lexback for reading: $!"; my $lexbacklines = <$lfile>; close($lfile); my $linecount = $lexbacklines =~ tr /\n/\n/; diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl index f1b9819..d9367f8 100644 --- a/src/tools/msvc/vcregress.pl +++ b/src/tools/msvc/vcregress.pl @@ -20,8 +20,8 @@ chdir "../../.." if (-d "../../../src/tools/msvc"); my $topdir = getcwd(); my $tmp_installdir = "$topdir/tmp_install"; -require 'src/tools/msvc/config_default.pl'; -require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); +do 'src/tools/msvc/config_default.pl'; +do 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); # buildenv.pl is for specifying the build environment settings # it should contain lines like: @@ -29,7 +29,7 @@ require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); if (-e "src/tools/msvc/buildenv.pl") { - require "src/tools/msvc/buildenv.pl"; + do "src/tools/msvc/buildenv.pl"; } my $what = shift || ""; @@ -505,8 +505,8 @@ sub upgradecheck sub fetchRegressOpts { my $handle; - open($handle, "; @@ -521,8 +521,9 @@ sub fetchRegressOpts # an unhandled variable reference. Ignore anything that isn't an # option starting with "--". @opts = grep { - s/\Q$(top_builddir)\E/\"$topdir\"/; - $_ !~ /\$\(/ && $_ =~ /^--/ + my $x = $_; + $x =~ s/\Q$(top_builddir)\E/\"$topdir\"/; + $x !~ /\$\(/ && $x =~ /^--/ } split(/\s+/, $1); } if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m) @@ -540,8 +541,8 @@ sub fetchTests { my $handle; - open($handle, "; diff --git a/src/tools/pginclude/pgcheckdefines b/src/tools/pginclude/pgcheckdefines index e166efa..aa7c9c2 100755 --- a/src/tools/pginclude/pgcheckdefines +++ b/src/tools/pginclude/pgcheckdefines @@ -42,25 +42,25 @@ my $MAKE = "make"; # my (@cfiles, @hfiles); -open PIPE, "$FIND * -type f -name '*.c' |" +open my $pipe, '-|', "$FIND * -type f -name '*.c'" or die "can't fork: $!"; -while () +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 () +while (<$pipe>) { chomp; push @hfiles, $_ unless m|^src/include/port/| || m|^src/backend/port/\w+/|; } -close PIPE or die "$FIND failed: $!"; +close $pipe or die "$FIND failed: $!"; # # For each .h file, extract all the symbols it #define's, and add them to @@ -71,16 +71,16 @@ my %defines; foreach my $hfile (@hfiles) { - open HFILE, $hfile + open my $fh, '<', $hfile or die "can't open $hfile: $!"; - while () + while (<$fh>) { if (m/^\s*#\s*define\s+(\w+)/) { $defines{$1}{$hfile} = 1; } } - close HFILE; + close $fh; } # @@ -124,9 +124,9 @@ foreach my $file (@hfiles, @cfiles) my ($CPPFLAGS, $CFLAGS, $CFLAGS_SL, $PTHREAD_CFLAGS, $CC); - open PIPE, "$MAKECMD |" + open $pipe, '-|', "$MAKECMD" or die "can't fork: $!"; - while () + while (<$pipe>) { if (m/^CPPFLAGS :?= (.*)/) { @@ -166,9 +166,9 @@ foreach my $file (@hfiles, @cfiles) # my @includes = (); my $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname"; - open PIPE, "$COMPILE 2>&1 >/dev/null |" + open $pipe, '-|', "$COMPILE 2>&1 >/dev/null" or die "can't fork: $!"; - while () + while (<$pipe>) { if (m/^\.+ (.*)/) { @@ -211,10 +211,10 @@ foreach my $file (@hfiles, @cfiles) # We assume #ifdef isn't continued across lines, and that defined(foo) # isn't split across lines either # - open FILE, $fname + open my $fh, '<', $fname or die "can't open $file: $!"; my $inif = 0; - while () + while (<$fh>) { my $line = $_; if ($line =~ m/^\s*#\s*ifdef\s+(\w+)/) @@ -241,7 +241,7 @@ foreach my $file (@hfiles, @cfiles) } } } - close FILE; + close $fh; chdir $topdir or die "can't chdir to $topdir: $!"; } diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent index 0d3859d..51d6a28 100755 --- a/src/tools/pgindent/pgindent +++ b/src/tools/pgindent/pgindent @@ -159,8 +159,7 @@ sub process_exclude while (my $line = <$eh>) { chomp $line; - my $rgx; - eval " \$rgx = qr!$line!;"; + my $rgx = eval { qr!$line! }; @files = grep { $_ !~ /$rgx/ } @files if $rgx; } close($eh); @@ -435,7 +434,8 @@ sub diff sub run_build { - eval "use LWP::Simple;"; + require LWP::Simple; + LWP::Simple->import(qw(getstore is_success)); my $code_base = shift || '.'; my $save_dir = getcwd(); diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl index dc9173f..f973dd9 100755 --- a/src/tools/version_stamp.pl +++ b/src/tools/version_stamp.pl @@ -80,8 +80,8 @@ my $padnumericversion = sprintf("%d%04d", $majorversion, $numericminor); # (this also ensures we're in the right directory) my $aconfver = ""; -open(FILE, "configure.in") || die "could not read configure.in: $!\n"; -while () +open(my $fh, '<', "configure.in") || die "could not read configure.in: $!\n"; +while (<$fh>) { if ( m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) @@ -90,7 +90,7 @@ m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/) last; } } -close(FILE); +close($fh); $aconfver ne "" || die "could not find autoconf version number in configure.in\n"; diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl index 6345465..0bdcc36 100755 --- a/src/tools/win32tzlist.pl +++ b/src/tools/win32tzlist.pl @@ -58,11 +58,11 @@ $basekey->Close(); # Fetch all timezones currently in the file # my @file_zones; -open(TZFILE, "<$tzfile") or die "Could not open $tzfile!\n"; +open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n"; my $t = $/; undef $/; -my $pgtz = ; -close(TZFILE); +my $pgtz = <$tzfh>; +close($tzfh); $/ = $t; # Attempt to locate and extract the complete win32_tzmap struct -- 2.6.4 (Apple Git-63)