mirror of
https://github.com/postgres/postgres.git
synced 2025-04-21 12:05:57 +03:00
The original code was a bit clunky; make it more amenable for further reuse by creating a new Perl package PostgresNode, which is an object-oriented representation of a single server, with some support routines such as init, start, stop, psql. This serves as a better basis on which to build further test code, and enables writing tests that use more than one server without too much complication. This commit modifies a lot of the existing test files, mostly to remove explicit calls to system commands (pg_ctl) replacing them with method calls of a PostgresNode object. The result is quite a bit more straightforward. Also move some initialization code to BEGIN and INIT blocks instead of having it straight in as top-level code. This commit also introduces package RecursiveCopy so that we can copy whole directories without having to depend on packages that may not be present on vanilla Perl 5.8 installations. I also ran perltidy on the modified files, which changes some code sites that are not otherwise touched by this patch. I tried to avoid this, but it ended up being more trouble than it's worth. Authors: Michael Paquier, Álvaro Herrera Review: Noah Misch
43 lines
1.0 KiB
Perl
43 lines
1.0 KiB
Perl
# RecursiveCopy, a simple recursive copy implementation
|
|
package RecursiveCopy;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use File::Basename;
|
|
use File::Copy;
|
|
|
|
sub copypath
|
|
{
|
|
my $srcpath = shift;
|
|
my $destpath = shift;
|
|
|
|
die "Cannot operate on symlinks" if -l $srcpath or -l $destpath;
|
|
|
|
# This source path is a file, simply copy it to destination with the
|
|
# same name.
|
|
die "Destination path $destpath exists as file" if -f $destpath;
|
|
if (-f $srcpath)
|
|
{
|
|
copy($srcpath, $destpath)
|
|
or die "copy $srcpath -> $destpath failed: $!";
|
|
return 1;
|
|
}
|
|
|
|
die "Destination needs to be a directory" unless -d $srcpath;
|
|
mkdir($destpath) or die "mkdir($destpath) failed: $!";
|
|
|
|
# Scan existing source directory and recursively copy everything.
|
|
opendir(my $directory, $srcpath) or die "could not opendir($srcpath): $!";
|
|
while (my $entry = readdir($directory))
|
|
{
|
|
next if ($entry eq '.' || $entry eq '..');
|
|
RecursiveCopy::copypath("$srcpath/$entry", "$destpath/$entry")
|
|
or die "copypath $srcpath/$entry -> $destpath/$entry failed";
|
|
}
|
|
closedir($directory);
|
|
return 1;
|
|
}
|
|
|
|
1;
|