Clean up Perl code according to perlcritic
Fix all perlcritic warnings of severity level 5, except in src/backend/utils/Gen_dummy_probes.pl, which is automatically generated. Reviewed-by: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> Reviewed-by: Daniel Gustafsson <daniel@yesql.se>
This commit is contained in:
Peter Eisentraut
parent
de4da168d5
commit
facde2a98f
|
|
@ -15,8 +15,8 @@ create table message_section_map (
|
|||
|
||||
EOT
|
||||
|
||||
open(MSG, ">message.tmp") || die;
|
||||
open(MAP, ">message_section_map.tmp") || die;
|
||||
open(my $msg, '>', "message.tmp") || die;
|
||||
open(my $map, '>', "message_section_map.tmp") || die;
|
||||
|
||||
srand(1);
|
||||
|
||||
|
|
@ -42,16 +42,16 @@ foreach my $i (1 .. 200000)
|
|||
}
|
||||
if ($#sect < 0 || rand() < 0.1)
|
||||
{
|
||||
print MSG "$i\t\\N\n";
|
||||
print $msg "$i\t\\N\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print MSG "$i\t{" . join(',', @sect) . "}\n";
|
||||
map { print MAP "$i\t$_\n" } @sect;
|
||||
print $msg "$i\t{" . join(',', @sect) . "}\n";
|
||||
map { print $map "$i\t$_\n" } @sect;
|
||||
}
|
||||
}
|
||||
close MAP;
|
||||
close MSG;
|
||||
close $map;
|
||||
close $msg;
|
||||
|
||||
copytable('message');
|
||||
copytable('message_section_map');
|
||||
|
|
@ -79,8 +79,8 @@ sub copytable
|
|||
my $t = shift;
|
||||
|
||||
print "COPY $t from stdin;\n";
|
||||
open(FFF, "$t.tmp") || die;
|
||||
while (<FFF>) { print; }
|
||||
close FFF;
|
||||
open(my $fff, '<', "$t.tmp") || die;
|
||||
while (<$fff>) { print; }
|
||||
close $fff;
|
||||
print "\\.\n";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ use strict;
|
|||
print
|
||||
"<!-- autogenerated from src/backend/utils/errcodes.txt, do not edit -->\n";
|
||||
|
||||
open my $errcodes, $ARGV[0] or die;
|
||||
open my $errcodes, '<', $ARGV[0] or die;
|
||||
|
||||
while (<$errcodes>)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -6,11 +6,11 @@ use strict;
|
|||
|
||||
my $yesno = $ARGV[0];
|
||||
|
||||
open PACK, $ARGV[1] or die;
|
||||
open my $pack, '<', $ARGV[1] or die;
|
||||
|
||||
my %feature_packages;
|
||||
|
||||
while (<PACK>)
|
||||
while (<$pack>)
|
||||
{
|
||||
chomp;
|
||||
my ($fid, $pname) = split /\t/;
|
||||
|
|
@ -24,13 +24,13 @@ while (<PACK>)
|
|||
}
|
||||
}
|
||||
|
||||
close PACK;
|
||||
close $pack;
|
||||
|
||||
open FEAT, $ARGV[2] or die;
|
||||
open my $feat, '<', $ARGV[2] or die;
|
||||
|
||||
print "<tbody>\n";
|
||||
|
||||
while (<FEAT>)
|
||||
while (<$feat>)
|
||||
{
|
||||
chomp;
|
||||
my ($feature_id, $feature_name, $subfeature_id,
|
||||
|
|
@ -69,4 +69,4 @@ while (<FEAT>)
|
|||
|
||||
print "</tbody>\n";
|
||||
|
||||
close FEAT;
|
||||
close $feat;
|
||||
|
|
|
|||
|
|
@ -44,13 +44,13 @@ sub Catalogs
|
|||
$catalog{columns} = [];
|
||||
$catalog{data} = [];
|
||||
|
||||
open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
|
||||
open(my $ifh, '<', $input_file) || die "$input_file: $!";
|
||||
|
||||
my ($filename) = ($input_file =~ m/(\w+)\.h$/);
|
||||
my $natts_pat = "Natts_$filename";
|
||||
|
||||
# Scan the input file.
|
||||
while (<INPUT_FILE>)
|
||||
while (<$ifh>)
|
||||
{
|
||||
|
||||
# Strip C-style comments.
|
||||
|
|
@ -59,7 +59,7 @@ sub Catalogs
|
|||
{
|
||||
|
||||
# handle multi-line comments properly.
|
||||
my $next_line = <INPUT_FILE>;
|
||||
my $next_line = <$ifh>;
|
||||
die "$input_file: ends within C-style comment\n"
|
||||
if !defined $next_line;
|
||||
$_ .= $next_line;
|
||||
|
|
@ -211,7 +211,7 @@ sub Catalogs
|
|||
}
|
||||
}
|
||||
$catalogs{$catname} = \%catalog;
|
||||
close INPUT_FILE;
|
||||
close $ifh;
|
||||
}
|
||||
return \%catalogs;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -66,16 +66,16 @@ if ($output_path ne '' && substr($output_path, -1) ne '/')
|
|||
# Open temp files
|
||||
my $tmpext = ".tmp$$";
|
||||
my $bkifile = $output_path . 'postgres.bki';
|
||||
open BKI, '>', $bkifile . $tmpext
|
||||
open my $bki, '>', $bkifile . $tmpext
|
||||
or die "can't open $bkifile$tmpext: $!";
|
||||
my $schemafile = $output_path . 'schemapg.h';
|
||||
open SCHEMAPG, '>', $schemafile . $tmpext
|
||||
open my $schemapg, '>', $schemafile . $tmpext
|
||||
or die "can't open $schemafile$tmpext: $!";
|
||||
my $descrfile = $output_path . 'postgres.description';
|
||||
open DESCR, '>', $descrfile . $tmpext
|
||||
open my $descr, '>', $descrfile . $tmpext
|
||||
or die "can't open $descrfile$tmpext: $!";
|
||||
my $shdescrfile = $output_path . 'postgres.shdescription';
|
||||
open SHDESCR, '>', $shdescrfile . $tmpext
|
||||
open my $shdescr, '>', $shdescrfile . $tmpext
|
||||
or die "can't open $shdescrfile$tmpext: $!";
|
||||
|
||||
# Fetch some special data that we will substitute into the output file.
|
||||
|
|
@ -97,7 +97,7 @@ my $catalogs = Catalog::Catalogs(@input_files);
|
|||
# Generate postgres.bki, postgres.description, and postgres.shdescription
|
||||
|
||||
# version marker for .bki file
|
||||
print BKI "# PostgreSQL $major_version\n";
|
||||
print $bki "# PostgreSQL $major_version\n";
|
||||
|
||||
# vars to hold data needed for schemapg.h
|
||||
my %schemapg_entries;
|
||||
|
|
@ -110,7 +110,7 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
|
||||
# .bki CREATE command for this catalog
|
||||
my $catalog = $catalogs->{$catname};
|
||||
print BKI "create $catname $catalog->{relation_oid}"
|
||||
print $bki "create $catname $catalog->{relation_oid}"
|
||||
. $catalog->{shared_relation}
|
||||
. $catalog->{bootstrap}
|
||||
. $catalog->{without_oids}
|
||||
|
|
@ -120,7 +120,7 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
my @attnames;
|
||||
my $first = 1;
|
||||
|
||||
print BKI " (\n";
|
||||
print $bki " (\n";
|
||||
foreach my $column (@{ $catalog->{columns} })
|
||||
{
|
||||
my $attname = $column->{name};
|
||||
|
|
@ -130,27 +130,27 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
|
||||
if (!$first)
|
||||
{
|
||||
print BKI " ,\n";
|
||||
print $bki " ,\n";
|
||||
}
|
||||
$first = 0;
|
||||
|
||||
print BKI " $attname = $atttype";
|
||||
print $bki " $attname = $atttype";
|
||||
|
||||
if (defined $column->{forcenotnull})
|
||||
{
|
||||
print BKI " FORCE NOT NULL";
|
||||
print $bki " FORCE NOT NULL";
|
||||
}
|
||||
elsif (defined $column->{forcenull})
|
||||
{
|
||||
print BKI " FORCE NULL";
|
||||
print $bki " FORCE NULL";
|
||||
}
|
||||
}
|
||||
print BKI "\n )\n";
|
||||
print $bki "\n )\n";
|
||||
|
||||
# open it, unless bootstrap case (create bootstrap does this automatically)
|
||||
if ($catalog->{bootstrap} eq '')
|
||||
{
|
||||
print BKI "open $catname\n";
|
||||
print $bki "open $catname\n";
|
||||
}
|
||||
|
||||
if (defined $catalog->{data})
|
||||
|
|
@ -175,17 +175,17 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
|
||||
# Write to postgres.bki
|
||||
my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
|
||||
printf BKI "insert %s( %s)\n", $oid, $row->{bki_values};
|
||||
printf $bki "insert %s( %s)\n", $oid, $row->{bki_values};
|
||||
|
||||
# Write comments to postgres.description and postgres.shdescription
|
||||
if (defined $row->{descr})
|
||||
{
|
||||
printf DESCR "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
|
||||
printf $descr "%s\t%s\t0\t%s\n", $row->{oid}, $catname,
|
||||
$row->{descr};
|
||||
}
|
||||
if (defined $row->{shdescr})
|
||||
{
|
||||
printf SHDESCR "%s\t%s\t%s\n", $row->{oid}, $catname,
|
||||
printf $shdescr "%s\t%s\t%s\n", $row->{oid}, $catname,
|
||||
$row->{shdescr};
|
||||
}
|
||||
}
|
||||
|
|
@ -267,7 +267,7 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
}
|
||||
}
|
||||
|
||||
print BKI "close $catname\n";
|
||||
print $bki "close $catname\n";
|
||||
}
|
||||
|
||||
# Any information needed for the BKI that is not contained in a pg_*.h header
|
||||
|
|
@ -276,19 +276,19 @@ foreach my $catname (@{ $catalogs->{names} })
|
|||
# Write out declare toast/index statements
|
||||
foreach my $declaration (@{ $catalogs->{toasting}->{data} })
|
||||
{
|
||||
print BKI $declaration;
|
||||
print $bki $declaration;
|
||||
}
|
||||
|
||||
foreach my $declaration (@{ $catalogs->{indexing}->{data} })
|
||||
{
|
||||
print BKI $declaration;
|
||||
print $bki $declaration;
|
||||
}
|
||||
|
||||
|
||||
# Now generate schemapg.h
|
||||
|
||||
# Opening boilerplate for schemapg.h
|
||||
print SCHEMAPG <<EOM;
|
||||
print $schemapg <<EOM;
|
||||
/*-------------------------------------------------------------------------
|
||||
*
|
||||
* schemapg.h
|
||||
|
|
@ -313,19 +313,19 @@ EOM
|
|||
# Emit schemapg declarations
|
||||
foreach my $table_name (@tables_needing_macros)
|
||||
{
|
||||
print SCHEMAPG "\n#define Schema_$table_name \\\n";
|
||||
print SCHEMAPG join ", \\\n", @{ $schemapg_entries{$table_name} };
|
||||
print SCHEMAPG "\n";
|
||||
print $schemapg "\n#define Schema_$table_name \\\n";
|
||||
print $schemapg join ", \\\n", @{ $schemapg_entries{$table_name} };
|
||||
print $schemapg "\n";
|
||||
}
|
||||
|
||||
# Closing boilerplate for schemapg.h
|
||||
print SCHEMAPG "\n#endif /* SCHEMAPG_H */\n";
|
||||
print $schemapg "\n#endif /* SCHEMAPG_H */\n";
|
||||
|
||||
# We're done emitting data
|
||||
close BKI;
|
||||
close SCHEMAPG;
|
||||
close DESCR;
|
||||
close SHDESCR;
|
||||
close $bki;
|
||||
close $schemapg;
|
||||
close $descr;
|
||||
close $shdescr;
|
||||
|
||||
# Finally, rename the completed files into place.
|
||||
Catalog::RenameTempFile($bkifile, $tmpext);
|
||||
|
|
@ -425,7 +425,7 @@ sub bki_insert
|
|||
my @attnames = @_;
|
||||
my $oid = $row->{oid} ? "OID = $row->{oid} " : '';
|
||||
my $bki_values = join ' ', map $row->{$_}, @attnames;
|
||||
printf BKI "insert %s( %s)\n", $oid, $bki_values;
|
||||
printf $bki "insert %s( %s)\n", $oid, $bki_values;
|
||||
}
|
||||
|
||||
# The field values of a Schema_pg_xxx declaration are similar, but not
|
||||
|
|
@ -472,15 +472,15 @@ sub find_defined_symbol
|
|||
}
|
||||
my $file = $path . $catalog_header;
|
||||
next if !-f $file;
|
||||
open(FIND_DEFINED_SYMBOL, '<', $file) || die "$file: $!";
|
||||
while (<FIND_DEFINED_SYMBOL>)
|
||||
open(my $find_defined_symbol, '<', $file) || die "$file: $!";
|
||||
while (<$find_defined_symbol>)
|
||||
{
|
||||
if (/^#define\s+\Q$symbol\E\s+(\S+)/)
|
||||
{
|
||||
return $1;
|
||||
}
|
||||
}
|
||||
close FIND_DEFINED_SYMBOL;
|
||||
close $find_defined_symbol;
|
||||
die "$file: no definition found for $symbol\n";
|
||||
}
|
||||
die "$catalog_header: not found in any include directory\n";
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ my $kwlist_filename = $ARGV[1];
|
|||
|
||||
my $errors = 0;
|
||||
|
||||
sub error(@)
|
||||
sub error
|
||||
{
|
||||
print STDERR @_;
|
||||
$errors = 1;
|
||||
|
|
@ -29,18 +29,18 @@ $keyword_categories{'col_name_keyword'} = 'COL_NAME_KEYWORD';
|
|||
$keyword_categories{'type_func_name_keyword'} = 'TYPE_FUNC_NAME_KEYWORD';
|
||||
$keyword_categories{'reserved_keyword'} = 'RESERVED_KEYWORD';
|
||||
|
||||
open(GRAM, $gram_filename) || die("Could not open : $gram_filename");
|
||||
open(my $gram, '<', $gram_filename) || die("Could not open : $gram_filename");
|
||||
|
||||
my ($S, $s, $k, $n, $kcat);
|
||||
my $kcat;
|
||||
my $comment;
|
||||
my @arr;
|
||||
my %keywords;
|
||||
|
||||
line: while (<GRAM>)
|
||||
line: while (my $S = <$gram>)
|
||||
{
|
||||
chomp; # strip record separator
|
||||
chomp $S; # strip record separator
|
||||
|
||||
$S = $_;
|
||||
my $s;
|
||||
|
||||
# Make sure any braces are split
|
||||
$s = '{', $S =~ s/$s/ { /g;
|
||||
|
|
@ -54,7 +54,7 @@ line: while (<GRAM>)
|
|||
{
|
||||
|
||||
# Is this the beginning of a keyword list?
|
||||
foreach $k (keys %keyword_categories)
|
||||
foreach my $k (keys %keyword_categories)
|
||||
{
|
||||
if ($S =~ m/^($k):/)
|
||||
{
|
||||
|
|
@ -66,7 +66,7 @@ line: while (<GRAM>)
|
|||
}
|
||||
|
||||
# Now split the line into individual fields
|
||||
$n = (@arr = split(' ', $S));
|
||||
my $n = (@arr = split(' ', $S));
|
||||
|
||||
# Ok, we're in a keyword list. Go through each field in turn
|
||||
for (my $fieldIndexer = 0; $fieldIndexer < $n; $fieldIndexer++)
|
||||
|
|
@ -109,15 +109,15 @@ line: while (<GRAM>)
|
|||
push @{ $keywords{$kcat} }, $arr[$fieldIndexer];
|
||||
}
|
||||
}
|
||||
close GRAM;
|
||||
close $gram;
|
||||
|
||||
# Check that each keyword list is in alphabetical order (just for neatnik-ism)
|
||||
my ($prevkword, $kword, $bare_kword);
|
||||
foreach $kcat (keys %keyword_categories)
|
||||
my ($prevkword, $bare_kword);
|
||||
foreach my $kcat (keys %keyword_categories)
|
||||
{
|
||||
$prevkword = '';
|
||||
|
||||
foreach $kword (@{ $keywords{$kcat} })
|
||||
foreach my $kword (@{ $keywords{$kcat} })
|
||||
{
|
||||
|
||||
# Some keyword have a _P suffix. Remove it for the comparison.
|
||||
|
|
@ -149,12 +149,12 @@ while (my ($kcat, $kcat_id) = each(%keyword_categories))
|
|||
|
||||
# Now read in kwlist.h
|
||||
|
||||
open(KWLIST, $kwlist_filename) || die("Could not open : $kwlist_filename");
|
||||
open(my $kwlist, '<', $kwlist_filename) || die("Could not open : $kwlist_filename");
|
||||
|
||||
my $prevkwstring = '';
|
||||
my $bare_kwname;
|
||||
my %kwhash;
|
||||
kwlist_line: while (<KWLIST>)
|
||||
kwlist_line: while (<$kwlist>)
|
||||
{
|
||||
my ($line) = $_;
|
||||
|
||||
|
|
@ -219,7 +219,7 @@ kwlist_line: while (<KWLIST>)
|
|||
}
|
||||
}
|
||||
}
|
||||
close KWLIST;
|
||||
close $kwlist;
|
||||
|
||||
# Check that we've paired up all keywords from gram.y with lines in kwlist.h
|
||||
while (my ($kwcat, $kwcat_id) = each(%keyword_categories))
|
||||
|
|
|
|||
|
|
@ -9,21 +9,21 @@ use strict;
|
|||
my $lastlockidx = -1;
|
||||
my $continue = "\n";
|
||||
|
||||
open my $lwlocknames, $ARGV[0] or die;
|
||||
open my $lwlocknames, '<', $ARGV[0] or die;
|
||||
|
||||
# Include PID in suffix in case parallel make runs this multiple times.
|
||||
my $htmp = "lwlocknames.h.tmp$$";
|
||||
my $ctmp = "lwlocknames.c.tmp$$";
|
||||
open H, '>', $htmp or die "Could not open $htmp: $!";
|
||||
open C, '>', $ctmp or die "Could not open $ctmp: $!";
|
||||
open my $h, '>', $htmp or die "Could not open $htmp: $!";
|
||||
open my $c, '>', $ctmp or die "Could not open $ctmp: $!";
|
||||
|
||||
my $autogen =
|
||||
"/* autogenerated from src/backend/storage/lmgr/lwlocknames.txt, do not edit */\n";
|
||||
print H $autogen;
|
||||
print H "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n";
|
||||
print C $autogen, "\n";
|
||||
print $h $autogen;
|
||||
print $h "/* there is deliberately not an #ifndef LWLOCKNAMES_H here */\n\n";
|
||||
print $c $autogen, "\n";
|
||||
|
||||
print C "char *MainLWLockNames[] = {";
|
||||
print $c "char *MainLWLockNames[] = {";
|
||||
|
||||
while (<$lwlocknames>)
|
||||
{
|
||||
|
|
@ -44,22 +44,22 @@ while (<$lwlocknames>)
|
|||
while ($lastlockidx < $lockidx - 1)
|
||||
{
|
||||
++$lastlockidx;
|
||||
printf C "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
|
||||
printf $c "%s \"<unassigned:%d>\"", $continue, $lastlockidx;
|
||||
$continue = ",\n";
|
||||
}
|
||||
printf C "%s \"%s\"", $continue, $lockname;
|
||||
printf $c "%s \"%s\"", $continue, $lockname;
|
||||
$lastlockidx = $lockidx;
|
||||
$continue = ",\n";
|
||||
|
||||
print H "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
|
||||
print $h "#define $lockname (&MainLWLockArray[$lockidx].lock)\n";
|
||||
}
|
||||
|
||||
printf C "\n};\n";
|
||||
print H "\n";
|
||||
printf H "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
|
||||
printf $c "\n};\n";
|
||||
print $h "\n";
|
||||
printf $h "#define NUM_INDIVIDUAL_LWLOCKS %s\n", $lastlockidx + 1;
|
||||
|
||||
close H;
|
||||
close C;
|
||||
close $h;
|
||||
close $c;
|
||||
|
||||
rename($htmp, 'lwlocknames.h') || die "rename: $htmp: $!";
|
||||
rename($ctmp, 'lwlocknames.c') || die "rename: $ctmp: $!";
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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>)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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');
|
||||
|
|
|
|||
|
|
@ -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');
|
||||
|
||||
|
|
|
|||
|
|
@ -42,12 +42,12 @@ $define =~ s/\W/_/g;
|
|||
|
||||
opendir(DIR, $docdir)
|
||||
or die "$0: could not open documentation source dir '$docdir': $!\n";
|
||||
open(HFILE, ">$hfile")
|
||||
open(my $hfile_handle, '>', $hfile)
|
||||
or die "$0: could not open output file '$hfile': $!\n";
|
||||
open(CFILE, ">$cfile")
|
||||
open(my $cfile_handle, '>', $cfile)
|
||||
or die "$0: could not open output file '$cfile': $!\n";
|
||||
|
||||
print HFILE "/*
|
||||
print $hfile_handle "/*
|
||||
* *** Do not change this file by hand. It is automatically
|
||||
* *** generated from the DocBook documentation.
|
||||
*
|
||||
|
|
@ -72,7 +72,7 @@ struct _helpStruct
|
|||
extern const struct _helpStruct QL_HELP[];
|
||||
";
|
||||
|
||||
print CFILE "/*
|
||||
print $cfile_handle "/*
|
||||
* *** Do not change this file by hand. It is automatically
|
||||
* *** generated from the DocBook documentation.
|
||||
*
|
||||
|
|
@ -97,9 +97,9 @@ foreach my $file (sort readdir DIR)
|
|||
my (@cmdnames, $cmddesc, $cmdsynopsis);
|
||||
$file =~ /\.sgml$/ or next;
|
||||
|
||||
open(FILE, "$docdir/$file") or next;
|
||||
my $filecontent = join('', <FILE>);
|
||||
close FILE;
|
||||
open(my $fh, '<', "$docdir/$file") or next;
|
||||
my $filecontent = join('', <$fh>);
|
||||
close $fh;
|
||||
|
||||
# Ignore files that are not for SQL language statements
|
||||
$filecontent =~
|
||||
|
|
@ -171,7 +171,7 @@ foreach (sort keys %entries)
|
|||
$synopsis =~ s/\\n/\\n"\n$prefix"/g;
|
||||
my @args =
|
||||
("buf", $synopsis, map("_(\"$_\")", @{ $entries{$_}{params} }));
|
||||
print CFILE "static void
|
||||
print $cfile_handle "static void
|
||||
sql_help_$id(PQExpBuffer buf)
|
||||
{
|
||||
\tappendPQExpBuffer(" . join(",\n$prefix", @args) . ");
|
||||
|
|
@ -180,14 +180,14 @@ sql_help_$id(PQExpBuffer buf)
|
|||
";
|
||||
}
|
||||
|
||||
print CFILE "
|
||||
print $cfile_handle "
|
||||
const struct _helpStruct QL_HELP[] = {
|
||||
";
|
||||
foreach (sort keys %entries)
|
||||
{
|
||||
my $id = $_;
|
||||
$id =~ s/ /_/g;
|
||||
print CFILE " { \"$_\",
|
||||
print $cfile_handle " { \"$_\",
|
||||
N_(\"$entries{$_}{cmddesc}\"),
|
||||
sql_help_$id,
|
||||
$entries{$_}{nl_count} },
|
||||
|
|
@ -195,12 +195,12 @@ foreach (sort keys %entries)
|
|||
";
|
||||
}
|
||||
|
||||
print CFILE "
|
||||
print $cfile_handle "
|
||||
{ NULL, NULL, NULL } /* End of list marker */
|
||||
};
|
||||
";
|
||||
|
||||
print HFILE "
|
||||
print $hfile_handle "
|
||||
#define QL_HELP_COUNT "
|
||||
. scalar(keys %entries) . " /* number of help items */
|
||||
#define QL_MAX_CMD_LEN $maxlen /* largest strlen(cmd) */
|
||||
|
|
@ -209,6 +209,6 @@ print HFILE "
|
|||
#endif /* $define */
|
||||
";
|
||||
|
||||
close CFILE;
|
||||
close HFILE;
|
||||
close $cfile_handle;
|
||||
close $hfile_handle;
|
||||
closedir DIR;
|
||||
|
|
|
|||
|
|
@ -53,8 +53,8 @@ my $comment = 0;
|
|||
my $non_term_id = '';
|
||||
my $cc = 0;
|
||||
|
||||
open GRAM, $parser or die $!;
|
||||
while (<GRAM>)
|
||||
open my $parser_fh, '<', $parser or die $!;
|
||||
while (<$parser_fh>)
|
||||
{
|
||||
if (/^%%/)
|
||||
{
|
||||
|
|
@ -145,7 +145,7 @@ while (<GRAM>)
|
|||
}
|
||||
}
|
||||
|
||||
close GRAM;
|
||||
close $parser_fh;
|
||||
if ($verbose)
|
||||
{
|
||||
print "$cc rules loaded\n";
|
||||
|
|
@ -154,8 +154,8 @@ if ($verbose)
|
|||
my $ret = 0;
|
||||
$cc = 0;
|
||||
|
||||
open ECPG, $filename or die $!;
|
||||
while (<ECPG>)
|
||||
open my $ecpg_fh, '<', $filename or die $!;
|
||||
while (<$ecpg_fh>)
|
||||
{
|
||||
if (!/^ECPG:/)
|
||||
{
|
||||
|
|
@ -170,7 +170,7 @@ while (<ECPG>)
|
|||
$ret = 1;
|
||||
}
|
||||
}
|
||||
close ECPG;
|
||||
close $ecpg_fh;
|
||||
|
||||
if ($verbose)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -14,19 +14,19 @@ my $expected_out = "$srcdir/$subdir/expected.out";
|
|||
my $regress_out = "regress.out";
|
||||
|
||||
# open input file first, so possible error isn't sent to redirected STDERR
|
||||
open(REGRESS_IN, "<", $regress_in)
|
||||
open(my $regress_in_fh, "<", $regress_in)
|
||||
or die "can't open $regress_in for reading: $!";
|
||||
|
||||
# save STDOUT/ERR and redirect both to regress.out
|
||||
open(OLDOUT, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
|
||||
open(OLDERR, ">&", \*STDERR) or die "can't dup STDERR: $!";
|
||||
open(my $oldout_fh, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
|
||||
open(my $olderr_fh, ">&", \*STDERR) or die "can't dup STDERR: $!";
|
||||
|
||||
open(STDOUT, ">", $regress_out)
|
||||
or die "can't open $regress_out for writing: $!";
|
||||
open(STDERR, ">&", \*STDOUT) or die "can't dup STDOUT: $!";
|
||||
|
||||
# read lines from regress.in and run uri-regress on them
|
||||
while (<REGRESS_IN>)
|
||||
while (<$regress_in_fh>)
|
||||
{
|
||||
chomp;
|
||||
print "trying $_\n";
|
||||
|
|
@ -35,11 +35,11 @@ while (<REGRESS_IN>)
|
|||
}
|
||||
|
||||
# restore STDOUT/ERR so we can print the outcome to the user
|
||||
open(STDERR, ">&", \*OLDERR) or die; # can't complain as STDERR is still duped
|
||||
open(STDOUT, ">&", \*OLDOUT) or die "can't restore STDOUT: $!";
|
||||
open(STDERR, ">&", $olderr_fh) or die; # can't complain as STDERR is still duped
|
||||
open(STDOUT, ">&", $oldout_fh) or die "can't restore STDOUT: $!";
|
||||
|
||||
# just in case
|
||||
close REGRESS_IN;
|
||||
close $regress_in_fh;
|
||||
|
||||
my $diff_status = system(
|
||||
"diff -c \"$srcdir/$subdir/expected.out\" regress.out >regress.diff");
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ sub ::encode_array_constructor
|
|||
|
||||
{
|
||||
|
||||
package PostgreSQL::InServer;
|
||||
package PostgreSQL::InServer; ## no critic (RequireFilenameMatchesPackage);
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
@ -86,11 +86,13 @@ sub ::encode_array_constructor
|
|||
|
||||
sub mkfunc
|
||||
{
|
||||
## no critic (ProhibitNoStrict, ProhibitStringyEval);
|
||||
no strict; # default to no strict for the eval
|
||||
no warnings; # default to no warnings for the eval
|
||||
my $ret = eval(mkfuncsrc(@_));
|
||||
$@ =~ s/\(eval \d+\) //g if $@;
|
||||
return $ret;
|
||||
## use critic
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
#
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ for my $src_file (@ARGV)
|
|||
|
||||
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
|
||||
|
||||
open my $src_fh, $src_file # not 3-arg form
|
||||
open my $src_fh, '<', $src_file
|
||||
or die "Can't open $src_file: $!";
|
||||
|
||||
printf qq{#define %s%s \\\n},
|
||||
|
|
@ -80,19 +80,19 @@ sub selftest
|
|||
my $tmp = "text2macro_tmp";
|
||||
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
|
||||
|
||||
open my $fh, ">$tmp.pl" or die;
|
||||
open my $fh, '>', "$tmp.pl" or die;
|
||||
print $fh $string;
|
||||
close $fh;
|
||||
|
||||
system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
|
||||
open $fh, ">>$tmp.c";
|
||||
open $fh, '>>', "$tmp.c";
|
||||
print $fh "#include <stdio.h>\n";
|
||||
print $fh "int main() { puts(X); return 0; }\n";
|
||||
close $fh;
|
||||
system("cat -n $tmp.c");
|
||||
|
||||
system("make $tmp") == 0 or die;
|
||||
open $fh, "./$tmp |" or die;
|
||||
open $fh, '<', "./$tmp |" or die;
|
||||
my $result = <$fh>;
|
||||
unlink <$tmp.*>;
|
||||
|
||||
|
|
|
|||
|
|
@ -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>)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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>)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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>)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
use strict;
|
||||
use locale;
|
||||
|
||||
open(INFILE, "<$ARGV[0]");
|
||||
chop(my (@words) = <INFILE>);
|
||||
close(INFILE);
|
||||
open(my $in_fh, '<', $ARGV[0]) || die;
|
||||
chop(my (@words) = <$in_fh>);
|
||||
close($in_fh);
|
||||
|
||||
$" = "\n";
|
||||
my (@result) = sort @words;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -310,12 +310,12 @@ sub AddResourceFile
|
|||
if (Solution::IsNewer("$dir/win32ver.rc", 'src/port/win32ver.rc'))
|
||||
{
|
||||
print "Generating win32ver.rc for $dir\n";
|
||||
open(I, 'src/port/win32ver.rc')
|
||||
open(my $i, '<', 'src/port/win32ver.rc')
|
||||
|| confess "Could not open win32ver.rc";
|
||||
open(O, ">$dir/win32ver.rc")
|
||||
open(my $o, '>', "$dir/win32ver.rc")
|
||||
|| confess "Could not write win32ver.rc";
|
||||
my $icostr = $ico ? "IDI_ICON ICON \"src/port/$ico.ico\"" : "";
|
||||
while (<I>)
|
||||
while (<$i>)
|
||||
{
|
||||
s/FILEDESC/"$desc"/gm;
|
||||
s/_ICO_/$icostr/gm;
|
||||
|
|
@ -324,11 +324,11 @@ sub AddResourceFile
|
|||
{
|
||||
s/VFT_APP/VFT_DLL/gm;
|
||||
}
|
||||
print O;
|
||||
print $o $_;
|
||||
}
|
||||
close($o);
|
||||
close($i);
|
||||
}
|
||||
close(O);
|
||||
close(I);
|
||||
$self->AddFile("$dir/win32ver.rc");
|
||||
}
|
||||
|
||||
|
|
@ -357,13 +357,13 @@ sub Save
|
|||
$self->DisableLinkerWarnings('4197') if ($self->{platform} eq 'x64');
|
||||
|
||||
# Dump the project
|
||||
open(F, ">$self->{name}$self->{filenameExtension}")
|
||||
open(my $f, '>', "$self->{name}$self->{filenameExtension}")
|
||||
|| croak(
|
||||
"Could not write to $self->{name}$self->{filenameExtension}\n");
|
||||
$self->WriteHeader(*F);
|
||||
$self->WriteFiles(*F);
|
||||
$self->Footer(*F);
|
||||
close(F);
|
||||
$self->WriteHeader($f);
|
||||
$self->WriteFiles($f);
|
||||
$self->Footer($f);
|
||||
close($f);
|
||||
}
|
||||
|
||||
sub GetAdditionalLinkerDependencies
|
||||
|
|
@ -397,7 +397,7 @@ sub read_file
|
|||
my $t = $/;
|
||||
|
||||
undef $/;
|
||||
open($F, $filename) || croak "Could not open file $filename\n";
|
||||
open($F, '<', $filename) || croak "Could not open file $filename\n";
|
||||
my $txt = <$F>;
|
||||
close($F);
|
||||
$/ = $t;
|
||||
|
|
@ -412,8 +412,8 @@ sub read_makefile
|
|||
my $t = $/;
|
||||
|
||||
undef $/;
|
||||
open($F, "$reldir/GNUmakefile")
|
||||
|| open($F, "$reldir/Makefile")
|
||||
open($F, '<', "$reldir/GNUmakefile")
|
||||
|| open($F, '<', "$reldir/Makefile")
|
||||
|| confess "Could not open $reldir/Makefile\n";
|
||||
my $txt = <$F>;
|
||||
close($F);
|
||||
|
|
|
|||
|
|
@ -102,14 +102,14 @@ sub IsNewer
|
|||
sub copyFile
|
||||
{
|
||||
my ($src, $dest) = @_;
|
||||
open(I, $src) || croak "Could not open $src";
|
||||
open(O, ">$dest") || croak "Could not open $dest";
|
||||
while (<I>)
|
||||
open(my $i, '<', $src) || croak "Could not open $src";
|
||||
open(my $o, '>', $dest) || croak "Could not open $dest";
|
||||
while (<$i>)
|
||||
{
|
||||
print O;
|
||||
print $o $_;
|
||||
}
|
||||
close(I);
|
||||
close(O);
|
||||
close($i);
|
||||
close($o);
|
||||
}
|
||||
|
||||
sub GenerateFiles
|
||||
|
|
@ -118,9 +118,9 @@ sub GenerateFiles
|
|||
my $bits = $self->{platform} eq 'Win32' ? 32 : 64;
|
||||
|
||||
# Parse configure.in to get version numbers
|
||||
open(C, "configure.in")
|
||||
open(my $c, '<', "configure.in")
|
||||
|| confess("Could not open configure.in for reading\n");
|
||||
while (<C>)
|
||||
while (<$c>)
|
||||
{
|
||||
if (/^AC_INIT\(\[PostgreSQL\], \[([^\]]+)\]/)
|
||||
{
|
||||
|
|
@ -133,7 +133,7 @@ sub GenerateFiles
|
|||
$self->{majorver} = sprintf("%d", $1);
|
||||
}
|
||||
}
|
||||
close(C);
|
||||
close($c);
|
||||
confess "Unable to parse configure.in for all variables!"
|
||||
if ($self->{strver} eq '' || $self->{numver} eq '');
|
||||
|
||||
|
|
@ -146,91 +146,91 @@ sub GenerateFiles
|
|||
if (IsNewer("src/include/pg_config.h", "src/include/pg_config.h.win32"))
|
||||
{
|
||||
print "Generating pg_config.h...\n";
|
||||
open(I, "src/include/pg_config.h.win32")
|
||||
open(my $i, '<', "src/include/pg_config.h.win32")
|
||||
|| confess "Could not open pg_config.h.win32\n";
|
||||
open(O, ">src/include/pg_config.h")
|
||||
open(my $o, '>', "src/include/pg_config.h")
|
||||
|| confess "Could not write to pg_config.h\n";
|
||||
my $extraver = $self->{options}->{extraver};
|
||||
$extraver = '' unless defined $extraver;
|
||||
while (<I>)
|
||||
while (<$i>)
|
||||
{
|
||||
s{PG_VERSION "[^"]+"}{PG_VERSION "$self->{strver}$extraver"};
|
||||
s{PG_VERSION_NUM \d+}{PG_VERSION_NUM $self->{numver}};
|
||||
s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY(z)\n#define PG_VERSION_STR "PostgreSQL $self->{strver}$extraver, compiled by Visual C++ build " __STRINGIFY2(_MSC_VER) ", $bits-bit"};
|
||||
print O;
|
||||
print $o $_;
|
||||
}
|
||||
print O "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
|
||||
print O "#define LOCALEDIR \"/share/locale\"\n"
|
||||
print $o "#define PG_MAJORVERSION \"$self->{majorver}\"\n";
|
||||
print $o "#define LOCALEDIR \"/share/locale\"\n"
|
||||
if ($self->{options}->{nls});
|
||||
print O "/* defines added by config steps */\n";
|
||||
print O "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
|
||||
print O "#define USE_ASSERT_CHECKING 1\n"
|
||||
print $o "/* defines added by config steps */\n";
|
||||
print $o "#ifndef IGNORE_CONFIGURED_SETTINGS\n";
|
||||
print $o "#define USE_ASSERT_CHECKING 1\n"
|
||||
if ($self->{options}->{asserts});
|
||||
print O "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
|
||||
print O "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
|
||||
print O "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
|
||||
print O "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
|
||||
print $o "#define USE_LDAP 1\n" if ($self->{options}->{ldap});
|
||||
print $o "#define HAVE_LIBZ 1\n" if ($self->{options}->{zlib});
|
||||
print $o "#define USE_OPENSSL 1\n" if ($self->{options}->{openssl});
|
||||
print $o "#define ENABLE_NLS 1\n" if ($self->{options}->{nls});
|
||||
|
||||
print O "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
|
||||
print O "#define RELSEG_SIZE ",
|
||||
print $o "#define BLCKSZ ", 1024 * $self->{options}->{blocksize}, "\n";
|
||||
print $o "#define RELSEG_SIZE ",
|
||||
(1024 / $self->{options}->{blocksize}) *
|
||||
$self->{options}->{segsize} *
|
||||
1024, "\n";
|
||||
print O "#define XLOG_BLCKSZ ",
|
||||
print $o "#define XLOG_BLCKSZ ",
|
||||
1024 * $self->{options}->{wal_blocksize}, "\n";
|
||||
print O "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
|
||||
print $o "#define XLOG_SEG_SIZE (", $self->{options}->{wal_segsize},
|
||||
" * 1024 * 1024)\n";
|
||||
|
||||
if ($self->{options}->{float4byval})
|
||||
{
|
||||
print O "#define USE_FLOAT4_BYVAL 1\n";
|
||||
print O "#define FLOAT4PASSBYVAL true\n";
|
||||
print $o "#define USE_FLOAT4_BYVAL 1\n";
|
||||
print $o "#define FLOAT4PASSBYVAL true\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print O "#define FLOAT4PASSBYVAL false\n";
|
||||
print $o "#define FLOAT4PASSBYVAL false\n";
|
||||
}
|
||||
if ($self->{options}->{float8byval})
|
||||
{
|
||||
print O "#define USE_FLOAT8_BYVAL 1\n";
|
||||
print O "#define FLOAT8PASSBYVAL true\n";
|
||||
print $o "#define USE_FLOAT8_BYVAL 1\n";
|
||||
print $o "#define FLOAT8PASSBYVAL true\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print O "#define FLOAT8PASSBYVAL false\n";
|
||||
print $o "#define FLOAT8PASSBYVAL false\n";
|
||||
}
|
||||
|
||||
if ($self->{options}->{uuid})
|
||||
{
|
||||
print O "#define HAVE_UUID_OSSP\n";
|
||||
print O "#define HAVE_UUID_H\n";
|
||||
print $o "#define HAVE_UUID_OSSP\n";
|
||||
print $o "#define HAVE_UUID_H\n";
|
||||
}
|
||||
if ($self->{options}->{xml})
|
||||
{
|
||||
print O "#define HAVE_LIBXML2\n";
|
||||
print O "#define USE_LIBXML\n";
|
||||
print $o "#define HAVE_LIBXML2\n";
|
||||
print $o "#define USE_LIBXML\n";
|
||||
}
|
||||
if ($self->{options}->{xslt})
|
||||
{
|
||||
print O "#define HAVE_LIBXSLT\n";
|
||||
print O "#define USE_LIBXSLT\n";
|
||||
print $o "#define HAVE_LIBXSLT\n";
|
||||
print $o "#define USE_LIBXSLT\n";
|
||||
}
|
||||
if ($self->{options}->{gss})
|
||||
{
|
||||
print O "#define ENABLE_GSS 1\n";
|
||||
print $o "#define ENABLE_GSS 1\n";
|
||||
}
|
||||
if (my $port = $self->{options}->{"--with-pgport"})
|
||||
{
|
||||
print O "#undef DEF_PGPORT\n";
|
||||
print O "#undef DEF_PGPORT_STR\n";
|
||||
print O "#define DEF_PGPORT $port\n";
|
||||
print O "#define DEF_PGPORT_STR \"$port\"\n";
|
||||
print $o "#undef DEF_PGPORT\n";
|
||||
print $o "#undef DEF_PGPORT_STR\n";
|
||||
print $o "#define DEF_PGPORT $port\n";
|
||||
print $o "#define DEF_PGPORT_STR \"$port\"\n";
|
||||
}
|
||||
print O "#define VAL_CONFIGURE \""
|
||||
print $o "#define VAL_CONFIGURE \""
|
||||
. $self->GetFakeConfigure() . "\"\n";
|
||||
print O "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
|
||||
close(O);
|
||||
close(I);
|
||||
print $o "#endif /* IGNORE_CONFIGURED_SETTINGS */\n";
|
||||
close($o);
|
||||
close($i);
|
||||
}
|
||||
|
||||
if (IsNewer(
|
||||
|
|
@ -379,17 +379,17 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
|
|||
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
|
||||
localtime(time);
|
||||
my $d = ($year - 100) . "$yday";
|
||||
open(I, '<', 'src/interfaces/libpq/libpq.rc.in')
|
||||
open(my $i, '<', 'src/interfaces/libpq/libpq.rc.in')
|
||||
|| confess "Could not open libpq.rc.in";
|
||||
open(O, '>', 'src/interfaces/libpq/libpq.rc')
|
||||
open(my $o, '>', 'src/interfaces/libpq/libpq.rc')
|
||||
|| confess "Could not open libpq.rc";
|
||||
while (<I>)
|
||||
while (<$i>)
|
||||
{
|
||||
s/(VERSION.*),0/$1,$d/;
|
||||
print O;
|
||||
print $o;
|
||||
}
|
||||
close(I);
|
||||
close(O);
|
||||
close($i);
|
||||
close($o);
|
||||
}
|
||||
|
||||
if (IsNewer('src/bin/psql/sql_help.h', 'src/bin/psql/create_help.pl'))
|
||||
|
|
@ -415,23 +415,23 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
|
|||
'src/interfaces/ecpg/include/ecpg_config.h.in'))
|
||||
{
|
||||
print "Generating ecpg_config.h...\n";
|
||||
open(O, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
|
||||
open(my $o, '>', 'src/interfaces/ecpg/include/ecpg_config.h')
|
||||
|| confess "Could not open ecpg_config.h";
|
||||
print O <<EOF;
|
||||
print $o <<EOF;
|
||||
#if (_MSC_VER > 1200)
|
||||
#define HAVE_LONG_LONG_INT_64
|
||||
#define ENABLE_THREAD_SAFETY 1
|
||||
EOF
|
||||
print O "#endif\n";
|
||||
close(O);
|
||||
print $o "#endif\n";
|
||||
close($o);
|
||||
}
|
||||
|
||||
unless (-f "src/port/pg_config_paths.h")
|
||||
{
|
||||
print "Generating pg_config_paths.h...\n";
|
||||
open(O, '>', 'src/port/pg_config_paths.h')
|
||||
open(my $o, '>', 'src/port/pg_config_paths.h')
|
||||
|| confess "Could not open pg_config_paths.h";
|
||||
print O <<EOF;
|
||||
print $o <<EOF;
|
||||
#define PGBINDIR "/bin"
|
||||
#define PGSHAREDIR "/share"
|
||||
#define SYSCONFDIR "/etc"
|
||||
|
|
@ -445,7 +445,7 @@ EOF
|
|||
#define HTMLDIR "/doc"
|
||||
#define MANDIR "/man"
|
||||
EOF
|
||||
close(O);
|
||||
close($o);
|
||||
}
|
||||
|
||||
my $mf = Project::read_file('src/backend/catalog/Makefile');
|
||||
|
|
@ -474,13 +474,13 @@ EOF
|
|||
}
|
||||
}
|
||||
|
||||
open(O, ">doc/src/sgml/version.sgml")
|
||||
open(my $o, '>', "doc/src/sgml/version.sgml")
|
||||
|| croak "Could not write to version.sgml\n";
|
||||
print O <<EOF;
|
||||
print $o <<EOF;
|
||||
<!ENTITY version "$self->{strver}">
|
||||
<!ENTITY majorversion "$self->{majorver}">
|
||||
EOF
|
||||
close(O);
|
||||
close($o);
|
||||
}
|
||||
|
||||
sub GenerateDefFile
|
||||
|
|
@ -490,18 +490,18 @@ sub GenerateDefFile
|
|||
if (IsNewer($deffile, $txtfile))
|
||||
{
|
||||
print "Generating $deffile...\n";
|
||||
open(I, $txtfile) || confess("Could not open $txtfile\n");
|
||||
open(O, ">$deffile") || confess("Could not open $deffile\n");
|
||||
print O "LIBRARY $libname\nEXPORTS\n";
|
||||
while (<I>)
|
||||
open(my $if, '<', $txtfile) || confess("Could not open $txtfile\n");
|
||||
open(my $of, '>', $deffile) || confess("Could not open $deffile\n");
|
||||
print $of "LIBRARY $libname\nEXPORTS\n";
|
||||
while (<$if>)
|
||||
{
|
||||
next if (/^#/);
|
||||
next if (/^\s*$/);
|
||||
my ($f, $o) = split;
|
||||
print O " $f @ $o\n";
|
||||
print $of " $f @ $o\n";
|
||||
}
|
||||
close(O);
|
||||
close(I);
|
||||
close($of);
|
||||
close($if);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -575,19 +575,19 @@ sub Save
|
|||
}
|
||||
}
|
||||
|
||||
open(SLN, ">pgsql.sln") || croak "Could not write to pgsql.sln\n";
|
||||
print SLN <<EOF;
|
||||
open(my $sln, '>', "pgsql.sln") || croak "Could not write to pgsql.sln\n";
|
||||
print $sln <<EOF;
|
||||
Microsoft Visual Studio Solution File, Format Version $self->{solutionFileVersion}
|
||||
# $self->{visualStudioName}
|
||||
EOF
|
||||
|
||||
print SLN $self->GetAdditionalHeaders();
|
||||
print $sln $self->GetAdditionalHeaders();
|
||||
|
||||
foreach my $fld (keys %{ $self->{projects} })
|
||||
{
|
||||
foreach my $proj (@{ $self->{projects}->{$fld} })
|
||||
{
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "$proj->{name}", "$proj->{name}$proj->{filenameExtension}", "$proj->{guid}"
|
||||
EndProject
|
||||
EOF
|
||||
|
|
@ -595,14 +595,14 @@ EOF
|
|||
if ($fld ne "")
|
||||
{
|
||||
$flduid{$fld} = Win32::GuidGen();
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "$fld", "$fld", "$flduid{$fld}"
|
||||
EndProject
|
||||
EOF
|
||||
}
|
||||
}
|
||||
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
Global
|
||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||
Debug|$self->{platform}= Debug|$self->{platform}
|
||||
|
|
@ -615,7 +615,7 @@ EOF
|
|||
{
|
||||
foreach my $proj (@{ $self->{projects}->{$fld} })
|
||||
{
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
$proj->{guid}.Debug|$self->{platform}.ActiveCfg = Debug|$self->{platform}
|
||||
$proj->{guid}.Debug|$self->{platform}.Build.0 = Debug|$self->{platform}
|
||||
$proj->{guid}.Release|$self->{platform}.ActiveCfg = Release|$self->{platform}
|
||||
|
|
@ -624,7 +624,7 @@ EOF
|
|||
}
|
||||
}
|
||||
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
EndGlobalSection
|
||||
GlobalSection(SolutionProperties) = preSolution
|
||||
HideSolutionNode = FALSE
|
||||
|
|
@ -637,15 +637,15 @@ EOF
|
|||
next if ($fld eq "");
|
||||
foreach my $proj (@{ $self->{projects}->{$fld} })
|
||||
{
|
||||
print SLN "\t\t$proj->{guid} = $flduid{$fld}\n";
|
||||
print $sln "\t\t$proj->{guid} = $flduid{$fld}\n";
|
||||
}
|
||||
}
|
||||
|
||||
print SLN <<EOF;
|
||||
print $sln <<EOF;
|
||||
EndGlobalSection
|
||||
EndGlobal
|
||||
EOF
|
||||
close(SLN);
|
||||
close($sln);
|
||||
}
|
||||
|
||||
sub GetFakeConfigure
|
||||
|
|
|
|||
|
|
@ -23,17 +23,17 @@ use Mkvcbuild;
|
|||
|
||||
if (-e "src/tools/msvc/buildenv.pl")
|
||||
{
|
||||
require "src/tools/msvc/buildenv.pl";
|
||||
do "src/tools/msvc/buildenv.pl";
|
||||
}
|
||||
elsif (-e "./buildenv.pl")
|
||||
{
|
||||
require "./buildenv.pl";
|
||||
do "./buildenv.pl";
|
||||
}
|
||||
|
||||
# set up the project
|
||||
our $config;
|
||||
require "config_default.pl";
|
||||
require "config.pl" if (-f "src/tools/msvc/config.pl");
|
||||
do "config_default.pl";
|
||||
do "config.pl" if (-f "src/tools/msvc/config.pl");
|
||||
|
||||
my $vcver = Mkvcbuild::mkvcbuild($config);
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ chdir '../../..' if (-d '../msvc' && -d '../../../src');
|
|||
|
||||
noversion() unless -e 'doc/src/sgml/version.sgml';
|
||||
|
||||
require 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
|
||||
do 'src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl';
|
||||
|
||||
my $docroot = $ENV{DOCROOT};
|
||||
die "bad DOCROOT '$docroot'" unless ($docroot && -d $docroot);
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ sub dumpsyms
|
|||
sub extract_syms
|
||||
{
|
||||
my ($symfile, $def) = @_;
|
||||
open(F, "<$symfile") || die "Could not open $symfile for $_\n";
|
||||
while (<F>)
|
||||
open(my $f, '<', $symfile) || die "Could not open $symfile for $_\n";
|
||||
while (<$f>)
|
||||
{
|
||||
|
||||
# Expected symbol lines look like:
|
||||
|
|
@ -115,14 +115,14 @@ sub extract_syms
|
|||
# whatever came last.
|
||||
$def->{ $pieces[6] } = $pieces[3];
|
||||
}
|
||||
close(F);
|
||||
close($f);
|
||||
}
|
||||
|
||||
sub writedef
|
||||
{
|
||||
my ($deffile, $platform, $def) = @_;
|
||||
open(DEF, ">$deffile") || die "Could not write to $deffile\n";
|
||||
print DEF "EXPORTS\n";
|
||||
open(my $fh, '>', $deffile) || die "Could not write to $deffile\n";
|
||||
print $fh "EXPORTS\n";
|
||||
foreach my $f (sort keys %{$def})
|
||||
{
|
||||
my $isdata = $def->{$f} eq 'data';
|
||||
|
|
@ -135,14 +135,14 @@ sub writedef
|
|||
# decorated with the DATA option for variables.
|
||||
if ($isdata)
|
||||
{
|
||||
print DEF " $f DATA\n";
|
||||
print $fh " $f DATA\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print DEF " $f\n";
|
||||
print $fh " $f\n";
|
||||
}
|
||||
}
|
||||
close(DEF);
|
||||
close($fh);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -174,7 +174,7 @@ print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n";
|
|||
|
||||
my %def = ();
|
||||
|
||||
while (<$ARGV[0]/*.obj>)
|
||||
while (<$ARGV[0]/*.obj>) ## no critic (RequireGlobFunction);
|
||||
{
|
||||
my $objfile = $_;
|
||||
my $symfile = $objfile;
|
||||
|
|
|
|||
|
|
@ -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();
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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/;
|
||||
|
|
|
|||
|
|
@ -20,8 +20,8 @@ chdir "../../.." if (-d "../../../src/tools/msvc");
|
|||
my $topdir = getcwd();
|
||||
my $tmp_installdir = "$topdir/tmp_install";
|
||||
|
||||
require 'src/tools/msvc/config_default.pl';
|
||||
require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
|
||||
do 'src/tools/msvc/config_default.pl';
|
||||
do 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
|
||||
|
||||
# buildenv.pl is for specifying the build environment settings
|
||||
# it should contain lines like:
|
||||
|
|
@ -29,7 +29,7 @@ require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
|
|||
|
||||
if (-e "src/tools/msvc/buildenv.pl")
|
||||
{
|
||||
require "src/tools/msvc/buildenv.pl";
|
||||
do "src/tools/msvc/buildenv.pl";
|
||||
}
|
||||
|
||||
my $what = shift || "";
|
||||
|
|
@ -505,8 +505,8 @@ sub upgradecheck
|
|||
sub fetchRegressOpts
|
||||
{
|
||||
my $handle;
|
||||
open($handle, "<GNUmakefile")
|
||||
|| open($handle, "<Makefile")
|
||||
open($handle, '<', "GNUmakefile")
|
||||
|| open($handle, '<', "Makefile")
|
||||
|| die "Could not open Makefile";
|
||||
local ($/) = undef;
|
||||
my $m = <$handle>;
|
||||
|
|
@ -521,8 +521,9 @@ sub fetchRegressOpts
|
|||
# an unhandled variable reference. Ignore anything that isn't an
|
||||
# option starting with "--".
|
||||
@opts = grep {
|
||||
s/\Q$(top_builddir)\E/\"$topdir\"/;
|
||||
$_ !~ /\$\(/ && $_ =~ /^--/
|
||||
my $x = $_;
|
||||
$x =~ s/\Q$(top_builddir)\E/\"$topdir\"/;
|
||||
$x !~ /\$\(/ && $x =~ /^--/
|
||||
} split(/\s+/, $1);
|
||||
}
|
||||
if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m)
|
||||
|
|
@ -540,8 +541,8 @@ sub fetchTests
|
|||
{
|
||||
|
||||
my $handle;
|
||||
open($handle, "<GNUmakefile")
|
||||
|| open($handle, "<Makefile")
|
||||
open($handle, '<', "GNUmakefile")
|
||||
|| open($handle, '<', "Makefile")
|
||||
|| die "Could not open Makefile";
|
||||
local ($/) = undef;
|
||||
my $m = <$handle>;
|
||||
|
|
|
|||
|
|
@ -42,25 +42,25 @@ my $MAKE = "make";
|
|||
#
|
||||
my (@cfiles, @hfiles);
|
||||
|
||||
open PIPE, "$FIND * -type f -name '*.c' |"
|
||||
open my $pipe, '-|', "$FIND * -type f -name '*.c'"
|
||||
or die "can't fork: $!";
|
||||
while (<PIPE>)
|
||||
while (<$pipe>)
|
||||
{
|
||||
chomp;
|
||||
push @cfiles, $_;
|
||||
}
|
||||
close PIPE or die "$FIND failed: $!";
|
||||
close $pipe or die "$FIND failed: $!";
|
||||
|
||||
open PIPE, "$FIND * -type f -name '*.h' |"
|
||||
open $pipe, '-|', "$FIND * -type f -name '*.h'"
|
||||
or die "can't fork: $!";
|
||||
while (<PIPE>)
|
||||
while (<$pipe>)
|
||||
{
|
||||
chomp;
|
||||
push @hfiles, $_
|
||||
unless m|^src/include/port/|
|
||||
|| m|^src/backend/port/\w+/|;
|
||||
}
|
||||
close PIPE or die "$FIND failed: $!";
|
||||
close $pipe or die "$FIND failed: $!";
|
||||
|
||||
#
|
||||
# For each .h file, extract all the symbols it #define's, and add them to
|
||||
|
|
@ -71,16 +71,16 @@ my %defines;
|
|||
|
||||
foreach my $hfile (@hfiles)
|
||||
{
|
||||
open HFILE, $hfile
|
||||
open my $fh, '<', $hfile
|
||||
or die "can't open $hfile: $!";
|
||||
while (<HFILE>)
|
||||
while (<$fh>)
|
||||
{
|
||||
if (m/^\s*#\s*define\s+(\w+)/)
|
||||
{
|
||||
$defines{$1}{$hfile} = 1;
|
||||
}
|
||||
}
|
||||
close HFILE;
|
||||
close $fh;
|
||||
}
|
||||
|
||||
#
|
||||
|
|
@ -124,9 +124,9 @@ foreach my $file (@hfiles, @cfiles)
|
|||
|
||||
my ($CPPFLAGS, $CFLAGS, $CFLAGS_SL, $PTHREAD_CFLAGS, $CC);
|
||||
|
||||
open PIPE, "$MAKECMD |"
|
||||
open $pipe, '-|', "$MAKECMD"
|
||||
or die "can't fork: $!";
|
||||
while (<PIPE>)
|
||||
while (<$pipe>)
|
||||
{
|
||||
if (m/^CPPFLAGS :?= (.*)/)
|
||||
{
|
||||
|
|
@ -166,9 +166,9 @@ foreach my $file (@hfiles, @cfiles)
|
|||
#
|
||||
my @includes = ();
|
||||
my $COMPILE = "$CC $CPPFLAGS $CFLAGS -H -E $fname";
|
||||
open PIPE, "$COMPILE 2>&1 >/dev/null |"
|
||||
open $pipe, '-|', "$COMPILE 2>&1 >/dev/null"
|
||||
or die "can't fork: $!";
|
||||
while (<PIPE>)
|
||||
while (<$pipe>)
|
||||
{
|
||||
if (m/^\.+ (.*)/)
|
||||
{
|
||||
|
|
@ -211,10 +211,10 @@ foreach my $file (@hfiles, @cfiles)
|
|||
# We assume #ifdef isn't continued across lines, and that defined(foo)
|
||||
# isn't split across lines either
|
||||
#
|
||||
open FILE, $fname
|
||||
open my $fh, '<', $fname
|
||||
or die "can't open $file: $!";
|
||||
my $inif = 0;
|
||||
while (<FILE>)
|
||||
while (<$fh>)
|
||||
{
|
||||
my $line = $_;
|
||||
if ($line =~ m/^\s*#\s*ifdef\s+(\w+)/)
|
||||
|
|
@ -241,7 +241,7 @@ foreach my $file (@hfiles, @cfiles)
|
|||
}
|
||||
}
|
||||
}
|
||||
close FILE;
|
||||
close $fh;
|
||||
|
||||
chdir $topdir or die "can't chdir to $topdir: $!";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -159,8 +159,7 @@ sub process_exclude
|
|||
while (my $line = <$eh>)
|
||||
{
|
||||
chomp $line;
|
||||
my $rgx;
|
||||
eval " \$rgx = qr!$line!;";
|
||||
my $rgx = qr!$line!;
|
||||
@files = grep { $_ !~ /$rgx/ } @files if $rgx;
|
||||
}
|
||||
close($eh);
|
||||
|
|
@ -435,7 +434,7 @@ sub diff
|
|||
|
||||
sub run_build
|
||||
{
|
||||
eval "use LWP::Simple;";
|
||||
eval "use LWP::Simple;"; ## no critic (ProhibitStringyEval);
|
||||
|
||||
my $code_base = shift || '.';
|
||||
my $save_dir = getcwd();
|
||||
|
|
|
|||
|
|
@ -80,8 +80,8 @@ my $padnumericversion = sprintf("%d%04d", $majorversion, $numericminor);
|
|||
# (this also ensures we're in the right directory)
|
||||
|
||||
my $aconfver = "";
|
||||
open(FILE, "configure.in") || die "could not read configure.in: $!\n";
|
||||
while (<FILE>)
|
||||
open(my $fh, '<', "configure.in") || die "could not read configure.in: $!\n";
|
||||
while (<$fh>)
|
||||
{
|
||||
if (
|
||||
m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
|
||||
|
|
@ -90,7 +90,7 @@ m/^m4_if\(m4_defn\(\[m4_PACKAGE_VERSION\]\), \[(.*)\], \[\], \[m4_fatal/)
|
|||
last;
|
||||
}
|
||||
}
|
||||
close(FILE);
|
||||
close($fh);
|
||||
$aconfver ne ""
|
||||
|| die "could not find autoconf version number in configure.in\n";
|
||||
|
||||
|
|
|
|||
|
|
@ -58,11 +58,11 @@ $basekey->Close();
|
|||
# Fetch all timezones currently in the file
|
||||
#
|
||||
my @file_zones;
|
||||
open(TZFILE, "<$tzfile") or die "Could not open $tzfile!\n";
|
||||
open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
|
||||
my $t = $/;
|
||||
undef $/;
|
||||
my $pgtz = <TZFILE>;
|
||||
close(TZFILE);
|
||||
my $pgtz = <$tzfh>;
|
||||
close($tzfh);
|
||||
$/ = $t;
|
||||
|
||||
# Attempt to locate and extract the complete win32_tzmap struct
|
||||
|
|
|
|||
Loading…
Reference in New Issue