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);
}
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');
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";
}
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>)
{
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/;
}
}
-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,
print "</tbody>\n";
-close FEAT;
+close $feat;
$catalog{columns} = [];
$catalog{data} = [];
- open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
+ open(my $ifh, '<', $input_file) || die "$input_file: $!";
my ($filename) = ($input_file =~ m/(\w+)\.h$/);
my $natts_pat = "Natts_$filename";
# Scan the input file.
- while (<INPUT_FILE>)
+ while (<$ifh>)
{
# Strip C-style comments.
{
# 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;
}
}
$catalogs{$catname} = \%catalog;
- close INPUT_FILE;
+ close $ifh;
}
return \%catalogs;
}
# 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.
# 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;
# .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}
my @attnames;
my $first = 1;
- print BKI " (\n";
+ print $bki " (\n";
foreach my $column (@{ $catalog->{columns} })
{
my $attname = $column->{name};
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})
# 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};
}
}
}
}
- 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
# 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
# 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);
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
}
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";
my $errors = 0;
-sub error(@)
+sub error
{
print STDERR @_;
$errors = 1;
$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;
{
# Is this the beginning of a keyword list?
- foreach $k (keys %keyword_categories)
+ foreach my $k (keys %keyword_categories)
{
if ($S =~ m/^($k):/)
{
}
# 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++)
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.
# 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) = $_;
}
}
}
-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))
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>)
{
while ($lastlockidx < $lockidx - 1)
{
++$lastlockidx;
- printf C "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
+ printf $c "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
$continue = ",\n";
}
- printf C "%s \"%s\"", $continue, $lockname;
+ printf $c "%s \"%s\"", $continue, $lockname;
$lastlockidx = $lockidx;
$continue = ",\n";
- print H "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
+ print $h "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
}
-printf C "\n};\n";
-print H "\n";
-printf H "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
+printf $c "\n};\n";
+print $h "\n";
+printf $h "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
-close H;
-close C;
+close $h;
+close $c;
rename($htmp, 'lwlocknames.h') || die "rename: $htmp: $!";
rename($ctmp, 'lwlocknames.c') || die "rename: $ctmp: $!";
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
*/
|;
-print P
+print $pfh
qq|/*-------------------------------------------------------------------------
*
* fmgrprotos.h
|;
-print T
+print $tfh
qq|/*-------------------------------------------------------------------------
*
* fmgrtab.c
{
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) */
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);
"/* 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>)
{
# 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();
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' ],
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');
'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');
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.
*
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.
*
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 =~
$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) . ");
";
}
-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} },
";
}
-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) */
#endif /* $define */
";
-close CFILE;
-close HFILE;
+close $cfile_handle;
+close $hfile_handle;
closedir DIR;
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 (/^%%/)
{
}
}
-close GRAM;
+close $parser_fh;
if ($verbose)
{
print "$cc rules loaded\n";
my $ret = 0;
$cc = 0;
-open ECPG, $filename or die $!;
-while (<ECPG>)
+open my $ecpg_fh, '<', $filename or die $!;
+while (<$ecpg_fh>)
{
if (!/^ECPG:/)
{
$ret = 1;
}
}
-close ECPG;
+close $ecpg_fh;
if ($verbose)
{
my $regress_out = "regress.out";
# open input file first, so possible error isn't sent to redirected STDERR
-open(REGRESS_IN, "<", $regress_in)
+open(my $regress_in_fh, "<", $regress_in)
or die "can't open $regress_in for reading: $!";
# save STDOUT/ERR and redirect both to regress.out
-open(OLDOUT, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
-open(OLDERR, ">&", \*STDERR) or die "can't dup STDERR: $!";
+open(my $oldout_fh, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
+open(my $olderr_fh, ">&", \*STDERR) or die "can't dup STDERR: $!";
open(STDOUT, ">", $regress_out)
or die "can't open $regress_out for writing: $!";
open(STDERR, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
# read lines from regress.in and run uri-regress on them
-while (<REGRESS_IN>)
+while (<$regress_in_fh>)
{
chomp;
print "trying $_\n";
}
# 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");
{
- package PostgreSQL::InServer;
+ package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage);
use strict;
use warnings;
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;
# 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.
#
(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},
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.*>;
"/* 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>)
{
"/* 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>)
{
"/* 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>)
{
use strict;
use locale;
-open(INFILE, "<$ARGV[0]");
-chop(my (@words) = <INFILE>);
-close(INFILE);
+open(my $in_fh, '<', $ARGV[0]) || die;
+chop(my (@words) = <$in_fh>);
+close($in_fh);
$" = "\n";
my (@result) = sort @words;
$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)
{
@{ $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";
# 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";
chomp($result);
if ($result eq '')
{
- return undef;
+ return;
}
else
{
$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
# 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
$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);
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;
}
# 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;
}
# 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);
|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);
# 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");
$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);
$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');
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;
$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);
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;
{
s/VFT_APP/VFT_DLL/gm;
}
- print O;
+ print $o $_;
}
+ close($o);
+ close($i);
}
- close(O);
- close(I);
$self->AddFile("$dir/win32ver.rc");
}
$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
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;
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);
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
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\], \[([^\]]+)\]/)
{
$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 '');
if (IsNewer("src/include/pg_config.h", "src/include/pg_config.h.win32"))
{
print "Generating pg_config.h...\n";
- open(I, "src/include/pg_config.h.win32")
+ open(my $i, '<', "src/include/pg_config.h.win32")
|| confess "Could not open pg_config.h.win32\n";
- open(O, ">src/include/pg_config.h")
+ open(my $o, '>', "src/include/pg_config.h")
|| confess "Could not write to pg_config.h\n";
my $extraver = $self->{options}->{extraver};
$extraver = '' unless defined $extraver;
- while (<I>)
+ while (<$i>)
{
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}$extraver"};
s{PG_VERSION_NUM \d+}{PG_VERSION_NUM $self->{numver}};
s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY(z)\n#define PG_VERSION_STR "PostgreSQL $self->{strver}$extraver, compiled by Visual C++ build " __STRINGIFY2(_MSC_VER) ", $bits-bit"};
- print O;
+ print $o $_;
}
- print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
- print O "#define LOCALEDIR \"/share/locale\"\n"
+ print $o "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
+ print $o "#define LOCALEDIR \"/share/locale\"\n"
if ($self->{options}->{nls});
- print O "/* defines added by config steps */\n";
- print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
- print O "#define USE_ASSERT_CHECKING 1\n"
+ print $o "/* defines added by config steps */\n";
+ print $o "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
+ print $o "#define USE_ASSERT_CHECKING 1\n"
if ($self->{options}->{asserts});
- print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
- print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
- print O "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
- print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
+ print $o "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
+ print $o "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
+ print $o "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
+ print $o "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
- print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
- print O "#define RELSEG_SIZE ",
+ print $o "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
+ print $o "#define RELSEG_SIZE ",
(1024 / $self->{options}->{blocksize}) *
$self->{options}->{segsize} *
1024, "\n";
- print O "#define XLOG_BLCKSZ ",
+ print $o "#define XLOG_BLCKSZ ",
1024 * $self->{options}->{wal_blocksize}, "\n";
- print O "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
+ print $o "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
" * 1024 * 1024)\n";
if ($self->{options}->{float4byval})
{
- print O "#define USE_FLOAT4_BYVAL 1\n";
- print O "#define FLOAT4PASSBYVAL true\n";
+ print $o "#define USE_FLOAT4_BYVAL 1\n";
+ print $o "#define FLOAT4PASSBYVAL true\n";
}
else
{
- print O "#define FLOAT4PASSBYVAL false\n";
+ print $o "#define FLOAT4PASSBYVAL false\n";
}
if ($self->{options}->{float8byval})
{
- print O "#define USE_FLOAT8_BYVAL 1\n";
- print O "#define FLOAT8PASSBYVAL true\n";
+ print $o "#define USE_FLOAT8_BYVAL 1\n";
+ print $o "#define FLOAT8PASSBYVAL true\n";
}
else
{
- print O "#define FLOAT8PASSBYVAL false\n";
+ print $o "#define FLOAT8PASSBYVAL false\n";
}
if ($self->{options}->{uuid})
{
- print O "#define HAVE_UUID_OSSP\n";
- print O "#define HAVE_UUID_H\n";
+ print $o "#define HAVE_UUID_OSSP\n";
+ print $o "#define HAVE_UUID_H\n";
}
if ($self->{options}->{xml})
{
- print O "#define HAVE_LIBXML2\n";
- print O "#define USE_LIBXML\n";
+ print $o "#define HAVE_LIBXML2\n";
+ print $o "#define USE_LIBXML\n";
}
if ($self->{options}->{xslt})
{
- print O "#define HAVE_LIBXSLT\n";
- print O "#define USE_LIBXSLT\n";
+ print $o "#define HAVE_LIBXSLT\n";
+ print $o "#define USE_LIBXSLT\n";
}
if ($self->{options}->{gss})
{
- print O "#define ENABLE_GSS 1\n";
+ print $o "#define ENABLE_GSS 1\n";
}
if (my $port = $self->{options}->{"--with-pgport"})
{
- print O "#undef DEF_PGPORT\n";
- print O "#undef DEF_PGPORT_STR\n";
- print O "#define DEF_PGPORT $port\n";
- print O "#define DEF_PGPORT_STR \"$port\"\n";
+ print $o "#undef DEF_PGPORT\n";
+ print $o "#undef DEF_PGPORT_STR\n";
+ print $o "#define DEF_PGPORT $port\n";
+ print $o "#define DEF_PGPORT_STR \"$port\"\n";
}
- print O "#define VAL_CONFIGURE \""
+ print $o "#define VAL_CONFIGURE \""
. $self->GetFakeConfigure() . "\"\n";
- print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
- close(O);
- close(I);
+ print $o "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
+ close($o);
+ close($i);
}
if (IsNewer(
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'))
'src/interfaces/ecpg/include/ecpg_config.h.in'))
{
print "Generating ecpg_config.h...\n";
- open(O, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
+ open(my $o, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
|| confess "Could not open ecpg_config.h";
- print O <<EOF;
+ print $o <<EOF;
#if (_MSC_VER > 1200)
#define HAVE_LONG_LONG_INT_64
#define ENABLE_THREAD_SAFETY 1
EOF
- print O "#endif\n";
- close(O);
+ print $o "#endif\n";
+ close($o);
}
unless (-f "src/port/pg_config_paths.h")
{
print "Generating pg_config_paths.h...\n";
- open(O, '>', 'src/port/pg_config_paths.h')
+ open(my $o, '>', 'src/port/pg_config_paths.h')
|| confess "Could not open pg_config_paths.h";
- print O <<EOF;
+ print $o <<EOF;
#define PGBINDIR "/bin"
#define PGSHAREDIR "/share"
#define SYSCONFDIR "/etc"
#define HTMLDIR "/doc"
#define MANDIR "/man"
EOF
- close(O);
+ close($o);
}
my $mf = Project::read_file('src/backend/catalog/Makefile');
}
}
- 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
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);
}
}
}
}
- 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
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}
{
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}
}
}
- print SLN <<EOF;
+ print $sln <<EOF;
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
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
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);
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);
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:
# 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';
# 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);
}
my %def = ();
-while (<$ARGV[0]/*.obj>)
+while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
{
my $objfile = $_;
my $symfile = $objfile;
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();
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);
# 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
my $makefile = dirname($input) . "/Makefile";
my ($mf, $make);
-open($mf, $makefile);
+open($mf, '<', $makefile);
local $/ = undef;
$make = <$mf>;
close($mf);
# 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];
# 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);
{
# 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/)
# 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/;
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:
if (-e "src/tools/msvc/buildenv.pl")
{
- require "src/tools/msvc/buildenv.pl";
+ do "src/tools/msvc/buildenv.pl";
}
my $what = shift || "";
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>;
# 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)
{
my $handle;
- open($handle, "<GNUmakefile")
- || open($handle, "<Makefile")
+ open($handle, '<', "GNUmakefile")
+ || open($handle, '<', "Makefile")
|| die "Could not open Makefile";
local ($/) = undef;
my $m = <$handle>;
#
my (@cfiles, @hfiles);
-open PIPE, "$FIND * -type f -name '*.c' |"
+open my $pipe, '-|', "$FIND * -type f -name '*.c'"
or die "can't fork: $!";
-while (<PIPE>)
+while (<$pipe>)
{
chomp;
push @cfiles, $_;
}
-close PIPE or die "$FIND failed: $!";
+close $pipe or die "$FIND failed: $!";
-open PIPE, "$FIND * -type f -name '*.h' |"
+open $pipe, '-|', "$FIND * -type f -name '*.h'"
or die "can't fork: $!";
-while (<PIPE>)
+while (<$pipe>)
{
chomp;
push @hfiles, $_
unless m|^src/include/port/|
|| m|^src/backend/port/\w+/|;
}
-close PIPE or die "$FIND failed: $!";
+close $pipe or die "$FIND failed: $!";
#
# For each .h file, extract all the symbols it #define's, and add them to
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;
}
#
my ($CPPFLAGS, $CFLAGS, $CFLAGS_SL, $PTHREAD_CFLAGS, $CC);
- open PIPE, "$MAKECMD |"
+ open $pipe, '-|', "$MAKECMD"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^CPPFLAGS :?= (.*)/)
{
#
my @includes = ();
my $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname";
- open PIPE, "$COMPILE 2>&1 >/dev/null |"
+ open $pipe, '-|', "$COMPILE 2>&1 >/dev/null"
or die "can't fork: $!";
- while (<PIPE>)
+ while (<$pipe>)
{
if (m/^\.+ (.*)/)
{
# We assume #ifdef isn't continued across lines, and that defined(foo)
# isn't split across lines either
#
- open FILE, $fname
+ open my $fh, '<', $fname
or die "can't open $file: $!";
my $inif = 0;
- while (<FILE>)
+ while (<$fh>)
{
my $line = $_;
if ($line =~ m/^\s*#\s*ifdef\s+(\w+)/)
}
}
}
- close FILE;
+ close $fh;
chdir $topdir or die "can't chdir to $topdir: $!";
}
while (my $line = <$eh>)
{
chomp $line;
- my $rgx;
- eval " \$rgx = qr!$line!;";
+ my $rgx = qr!$line!;
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
}
close($eh);
sub run_build
{
- eval "use LWP::Simple;";
+ eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
my $code_base = shift || '.';
my $save_dir = getcwd();
# (this also ensures we're in the right directory)
my $aconfver = "";
-open(FILE, "configure.in") || die "could not read configure.in: $!\n";
-while (<FILE>)
+open(my $fh, '<', "configure.in") || die "could not read configure.in: $!\n";
+while (<$fh>)
{
if (
m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
last;
}
}
-close(FILE);
+close($fh);
$aconfver ne ""
|| die "could not find autoconf version number in configure.in\n";
# 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
projects / postgresql / commitdiff