On 3/23/21 7:09 PM, Andrew Dunstan wrote:
> On 3/23/21 6:36 PM, Michael Paquier wrote:
>> On Thu, Jan 28, 2021 at 10:19:57AM -0500, Andrew Dunstan wrote:
>>> +BEGIN
>>> +{
>>> +
>>> + # putting this in a BEGIN block means it's run and checked by perl -c
>>> +
>>> +
>>> + # everything other than info and get_new_node that we need to override.
>>> + # they are all instance methods, so we can use the same template for
>>> all.
>>> + my @instance_overrides = qw(init backup start kill9 stop reload restart
>>> + promote logrotate safe_psql psql background_psql
>>> + interactive_psql poll_query_until command_ok
>>> + command_fails command_like command_checks_all
>>> + issues_sql_like run_log pg_recvlogical_upto
>>> + );
>> No actual objections here, but it would be easy to miss the addition
>> of a new routine. Would an exclusion filter be more adapted, aka
>> override everything except get_new_node() and info()?
>
>
> Actually, following a brief offline discussion today I've thought of a
> way that doesn't require subclassing. Will post that probably tomorrow.
>
And here it is. No subclass, no eval, no magic :-) Some of my colleagues
are a lot happier ;-)
The downside is that we need to litter PostgresNode with a bunch of
lines like:
local %ENV = %ENV;
_set_install_env($self);
The upside is that there's no longer a possibility that someone will add
a new routine to PostgresNode and forget to update the subclass.
Here is my simple test program:
#!/usr/bin/perl
use lib '/home/andrew/pgl/pg_head/src/test/perl';
# PostgresNode (via TestLib) hijacks stdout, so make a dup before it
gets a chance
use vars qw($out);
BEGIN
{
open ($out, ">&STDOUT");
}
use PostgresNode;
my $node = PostgresNode->get_new_node('v12', install_path =>
'/home/andrew/pgl/inst.12.5711');
$ENV{PG_REGRESS} = '/bin/true'; # stupid but necessary
$node->init();
$node->start();
my $version = $node->safe_psql('postgres', 'select version()');
$node->stop();
print $out "Version: $version\n";
print $out $node->info();
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 97e05993be..5eabea4b2b 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -355,6 +355,7 @@ sub info
print $fh "Archive directory: " . $self->archive_dir . "\n";
print $fh "Connection string: " . $self->connstr . "\n";
print $fh "Log file: " . $self->logfile . "\n";
+ print $fh "Install Path: " , $self->{_install_path} . "\n" if $self->{_install_path};
close $fh or die;
return $_info;
}
@@ -428,6 +429,9 @@ sub init
my $pgdata = $self->data_dir;
my $host = $self->host;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
$params{allows_streaming} = 0 unless defined $params{allows_streaming};
$params{has_archiving} = 0 unless defined $params{has_archiving};
@@ -555,6 +559,9 @@ sub backup
my $backup_path = $self->backup_dir . '/' . $backup_name;
my $name = $self->name;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "# Taking pg_basebackup $backup_name from node \"$name\"\n";
TestLib::system_or_bail(
'pg_basebackup', '-D', $backup_path, '-h',
@@ -780,22 +787,22 @@ sub start
my $name = $self->name;
my $ret;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
BAIL_OUT("node \"$name\" is already running") if defined $self->{_pid};
print("### Starting node \"$name\"\n");
- {
- # Temporarily unset PGAPPNAME so that the server doesn't
- # inherit it. Otherwise this could affect libpqwalreceiver
- # connections in confusing ways.
- local %ENV = %ENV;
- delete $ENV{PGAPPNAME};
-
- # Note: We set the cluster_name here, not in postgresql.conf (in
- # sub init) so that it does not get copied to standbys.
- $ret = TestLib::system_log('pg_ctl', '-D', $self->data_dir, '-l',
+ # Temporarily unset PGAPPNAME so that the server doesn't
+ # inherit it. Otherwise this could affect libpqwalreceiver
+ # connections in confusing ways.
+ delete $ENV{PGAPPNAME};
+
+ # Note: We set the cluster_name here, not in postgresql.conf (in
+ # sub init) so that it does not get copied to standbys.
+ $ret = TestLib::system_log('pg_ctl', '-D', $self->data_dir, '-l',
$self->logfile, '-o', "--cluster-name=$name", 'start');
- }
if ($ret != 0)
{
@@ -826,6 +833,10 @@ sub kill9
my ($self) = @_;
my $name = $self->name;
return unless defined $self->{_pid};
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "### Killing node \"$name\" using signal 9\n";
# kill(9, ...) fails under msys Perl 5.8.8, so fall back on pg_ctl.
kill(9, $self->{_pid})
@@ -852,6 +863,10 @@ sub stop
my $port = $self->port;
my $pgdata = $self->data_dir;
my $name = $self->name;
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
$mode = 'fast' unless defined $mode;
return unless defined $self->{_pid};
print "### Stopping node \"$name\" using mode $mode\n";
@@ -874,6 +889,10 @@ sub reload
my $port = $self->port;
my $pgdata = $self->data_dir;
my $name = $self->name;
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "### Reloading node \"$name\"\n";
TestLib::system_or_bail('pg_ctl', '-D', $pgdata, 'reload');
return;
@@ -895,15 +914,15 @@ sub restart
my $logfile = $self->logfile;
my $name = $self->name;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "### Restarting node \"$name\"\n";
- {
- local %ENV = %ENV;
- delete $ENV{PGAPPNAME};
+ delete $ENV{PGAPPNAME};
- TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
+ TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
'restart');
- }
$self->_update_pid(1);
return;
@@ -924,6 +943,10 @@ sub promote
my $pgdata = $self->data_dir;
my $logfile = $self->logfile;
my $name = $self->name;
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "### Promoting node \"$name\"\n";
TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
'promote');
@@ -945,6 +968,10 @@ sub logrotate
my $pgdata = $self->data_dir;
my $logfile = $self->logfile;
my $name = $self->name;
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
print "### Rotating log in node \"$name\"\n";
TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
'logrotate');
@@ -1117,6 +1144,14 @@ By default, all nodes use the same PGHOST value. If specified, generate a
PGHOST specific to this node. This allows multiple nodes to use the same
port.
+=item install_path => '/path/to/postgres/installation'
+
+Using this parameter is it possible to have nodes pointing to different
+installations, for testing different versions together or the same version
+with different build parameters. The provided path must be the parent of the
+installation's 'bin' and 'lib' directories. In the common case where this is
+not provided, Postgres binaries will be found in the caller's PATH.
+
=back
For backwards compatibility, it is also exported as a standalone function,
@@ -1165,12 +1200,65 @@ sub get_new_node
# Lock port number found by creating a new node
my $node = $class->new($name, $host, $port);
+ if ($params{install_path})
+ {
+ $node->{_install_path} = $params{install_path};
+ }
+
# Add node to list of nodes
push(@all_nodes, $node);
return $node;
}
+# Private routine to set the PATH and (DY)LD_LIBRARY_PATH correctly when there
+# is an install path set for the node.
+# Routines that call Postgres binaries need to call this routine like this:
+#
+# local %ENV = %ENV;
+# _set_install_env{$self);
+#
+# This is effectively a no-op if the install path isn't set.
+#
+# The install path set in get_new_node needs to be a directory containing
+# bin and lib subdirectories as in a standard PostgreSQL installation, so this
+# can't be used with installations where the bin and lib directories don't have
+# a common parent directory.
+sub _set_install_env
+{
+ my $self = shift;
+ my $inst = $self->{_install_path};
+ return unless $inst;
+ # the caller must have set up a local copy of %ENV
+ if ($TestLib::windows_os)
+ {
+ # Windows picks up DLLs from the PATH rather than *LD_LIBRARY_PATH
+ # choose the right path separator
+ if ($Config{osname} eq 'MSWin32')
+ {
+ $ENV{PATH} = "$inst/bin;$inst/lib;$ENV{PATH}";
+ }
+ else
+ {
+ $ENV{PATH} = "$inst/bin:$inst/lib:$ENV{PATH}";
+ }
+ }
+ else
+ {
+ my $dylib_name =
+ $Config{osname} eq 'darwin' ? "DYLD_LIBRARY_PATH" : "LD_LIBRARY_PATH";
+ $ENV{PATH} = "$inst/bin:$ENV{PATH}";
+ if (exists $ENV{$dylib_name})
+ {
+ $ENV{$dylib_name} = "$inst/lib:$ENV{$dylib_name}";
+ }
+ else
+ {
+ $ENV{$dylib_name} = "$inst/lib";
+ }
+ }
+}
+
=pod
=item get_free_port()
@@ -1330,6 +1418,9 @@ sub safe_psql
{
my ($self, $dbname, $sql, %params) = @_;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
my ($stdout, $stderr);
my $ret = $self->psql(
@@ -1441,6 +1532,9 @@ sub psql
{
my ($self, $dbname, $sql, %params) = @_;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
my $stdout = $params{stdout};
my $stderr = $params{stderr};
my $replication = $params{replication};
@@ -1634,6 +1728,9 @@ sub background_psql
{
my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
my $replication = $params{replication};
my @psql_params = (
@@ -1712,6 +1809,9 @@ sub interactive_psql
{
my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
my @psql_params = ('psql', '-XAt', '-d', $self->connstr($dbname));
push @psql_params, @{ $params{extra_params} }
@@ -1755,6 +1855,9 @@ sub poll_query_until
{
my ($self, $dbname, $query, $expected) = @_;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
$expected = 't' unless defined($expected); # default value
my $cmd = [ 'psql', '-XAt', '-c', $query, '-d', $self->connstr($dbname) ];
@@ -1810,8 +1913,11 @@ sub command_ok
my $self = shift;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
TestLib::command_ok(@_);
return;
@@ -1831,8 +1937,11 @@ sub command_fails
my $self = shift;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
TestLib::command_fails(@_);
return;
@@ -1852,8 +1961,11 @@ sub command_like
my $self = shift;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
TestLib::command_like(@_);
return;
@@ -1874,8 +1986,11 @@ sub command_checks_all
my $self = shift;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
TestLib::command_checks_all(@_);
return;
@@ -1899,8 +2014,11 @@ sub issues_sql_like
my ($self, $cmd, $expected_sql, $test_name) = @_;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
truncate $self->logfile, 0;
my $result = TestLib::run_log($cmd);
@@ -1923,8 +2041,11 @@ sub run_log
{
my $self = shift;
- local $ENV{PGHOST} = $self->host;
- local $ENV{PGPORT} = $self->port;
+ local %ENV = %ENV;
+ _set_install_env($self);
+
+ $ENV{PGHOST} = $self->host;
+ $ENV{PGPORT} = $self->port;
TestLib::run_log(@_);
return;
@@ -2174,6 +2295,10 @@ sub pg_recvlogical_upto
{
my ($self, $dbname, $slot_name, $endpos, $timeout_secs, %plugin_options)
= @_;
+
+ local %ENV = %ENV;
+ _set_install_env($self);
+
my ($stdout, $stderr);
my $timeout_exception = 'pg_recvlogical timed out';
