@ -355,6 +355,8 @@ 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 +430,8 @@ sub init
my $ pgdata = $ self - > data_dir ;
my $ host = $ self - > host ;
local % ENV = $ self - > _get_env ( ) ;
$ params { allows_streaming } = 0 unless defined $ params { allows_streaming } ;
$ params { has_archiving } = 0 unless defined $ params { has_archiving } ;
@ -555,6 +559,8 @@ sub backup
my $ backup_path = $ self - > backup_dir . '/' . $ backup_name ;
my $ name = $ self - > name ;
local % ENV = $ self - > _get_env ( ) ;
print "# Taking pg_basebackup $backup_name from node \"$name\"\n" ;
TestLib:: system_or_bail (
'pg_basebackup' , '-D' , $ backup_path , '-h' ,
@ -784,18 +790,15 @@ sub start
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' ,
$ self - > logfile , '-o' , "--cluster-name=$name" , 'start' ) ;
}
# Temporarily unset PGAPPNAME so that the server doesn't
# inherit it. Otherwise this could affect libpqwalreceiver
# connections in confusing ways.
local % ENV = $ self - > _get_env ( PGAPPNAME = > undef ) ;
# 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 +829,9 @@ sub kill9
my ( $ self ) = @ _ ;
my $ name = $ self - > name ;
return unless defined $ self - > { _pid } ;
local % ENV = $ self - > _get_env ( ) ;
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 +858,9 @@ sub stop
my $ port = $ self - > port ;
my $ pgdata = $ self - > data_dir ;
my $ name = $ self - > name ;
local % ENV = $ self - > _get_env ( ) ;
$ mode = 'fast' unless defined $ mode ;
return unless defined $ self - > { _pid } ;
print "### Stopping node \"$name\" using mode $mode\n" ;
@ -874,6 +883,9 @@ sub reload
my $ port = $ self - > port ;
my $ pgdata = $ self - > data_dir ;
my $ name = $ self - > name ;
local % ENV = $ self - > _get_env ( ) ;
print "### Reloading node \"$name\"\n" ;
TestLib:: system_or_bail ( 'pg_ctl' , '-D' , $ pgdata , 'reload' ) ;
return ;
@ -895,15 +907,12 @@ sub restart
my $ logfile = $ self - > logfile ;
my $ name = $ self - > name ;
print "### Restarting node \"$name\"\n" ;
local % ENV = $ self - > _get_env ( PGAPPNAME = > undef ) ;
{
local % ENV = % ENV ;
delete $ ENV { PGAPPNAME } ;
print "### Restarting node \"$name\"\n" ;
TestLib:: system_or_bail ( 'pg_ctl' , '-D' , $ pgdata , '-l' , $ logfile ,
'restart' ) ;
}
TestLib:: system_or_bail ( 'pg_ctl' , '-D' , $ pgdata , '-l' , $ logfile ,
'restart' ) ;
$ self - > _update_pid ( 1 ) ;
return ;
@ -924,6 +933,9 @@ sub promote
my $ pgdata = $ self - > data_dir ;
my $ logfile = $ self - > logfile ;
my $ name = $ self - > name ;
local % ENV = $ self - > _get_env ( ) ;
print "### Promoting node \"$name\"\n" ;
TestLib:: system_or_bail ( 'pg_ctl' , '-D' , $ pgdata , '-l' , $ logfile ,
'promote' ) ;
@ -945,6 +957,9 @@ sub logrotate
my $ pgdata = $ self - > data_dir ;
my $ logfile = $ self - > logfile ;
my $ name = $ self - > name ;
local % ENV = $ self - > _get_env ( ) ;
print "### Rotating log in node \"$name\"\n" ;
TestLib:: system_or_bail ( 'pg_ctl' , '-D' , $ pgdata , '-l' , $ logfile ,
'logrotate' ) ;
@ -1117,6 +1132,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 +1188,89 @@ 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 return a copy of the environment with the PATH and
# (DY)LD_LIBRARY_PATH correctly set when there is an install path set for
# the node.
#
# Routines that call Postgres binaries need to call this routine like this:
#
# local %ENV = $self->_get_env{[%extra_settings]);
#
# A copy of the environment is taken and node's host and port settings are
# added as PGHOST and PGPORT, Then the extra settings (if any) are applied.
# Any setting in %extra_settings with a value that is undefined is deleted
# the remainder are# set. Then the PATH and (DY)LD_LIBRARY_PATH are adjusted
# if the node's install path is set, and the copy environment is returned.
#
# 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 _get_env
{
my $ self = shift ;
my % inst_env = ( % ENV , PGHOST = > $ self - > { _host } , PGPORT = > $ self - > { _port } ) ;
# the remaining arguments are modifications to make to the environment
my % mods = ( @ _ ) ;
while ( my ( $ k , $ v ) = each % mods )
{
if ( defined $ v )
{
$ inst_env { $ k } = "$v" ;
}
else
{
delete $ inst_env { $ k } ;
}
}
# now fix up the new environment for the install path
my $ inst = $ self - > { _install_path } ;
if ( $ inst )
{
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' )
{
$ inst_env { PATH } = "$inst/bin;$inst/lib;$ENV{PATH}" ;
}
else
{
$ inst_env { PATH } = "$inst/bin:$inst/lib:$ENV{PATH}" ;
}
}
else
{
my $ dylib_name =
$ Config { osname } eq 'darwin'
? "DYLD_LIBRARY_PATH"
: "LD_LIBRARY_PATH" ;
$ inst_env { PATH } = "$inst/bin:$ENV{PATH}" ;
if ( exists $ ENV { $ dylib_name } )
{
$ inst_env { $ dylib_name } = "$inst/lib:$ENV{$dylib_name}" ;
}
else
{
$ inst_env { $ dylib_name } = "$inst/lib" ;
}
}
}
return ( % inst_env ) ;
}
= pod
= item get_free_port ( )
@ -1330,6 +1430,8 @@ sub safe_psql
{
my ( $ self , $ dbname , $ sql , % params ) = @ _ ;
local % ENV = $ self - > _get_env ( ) ;
my ( $ stdout , $ stderr ) ;
my $ ret = $ self - > psql (
@ -1441,6 +1543,8 @@ sub psql
{
my ( $ self , $ dbname , $ sql , % params ) = @ _ ;
local % ENV = $ self - > _get_env ( ) ;
my $ stdout = $ params { stdout } ;
my $ stderr = $ params { stderr } ;
my $ replication = $ params { replication } ;
@ -1634,6 +1738,8 @@ sub background_psql
{
my ( $ self , $ dbname , $ stdin , $ stdout , $ timer , % params ) = @ _ ;
local % ENV = $ self - > _get_env ( ) ;
my $ replication = $ params { replication } ;
my @ psql_params = (
@ -1712,6 +1818,8 @@ sub interactive_psql
{
my ( $ self , $ dbname , $ stdin , $ stdout , $ timer , % params ) = @ _ ;
local % ENV = $ self - > _get_env ( ) ;
my @ psql_params = ( 'psql' , '-XAt' , '-d' , $ self - > connstr ( $ dbname ) ) ;
push @ psql_params , @ { $ params { extra_params } }
@ -1755,6 +1863,8 @@ sub poll_query_until
{
my ( $ self , $ dbname , $ query , $ expected ) = @ _ ;
local % ENV = $ self - > _get_env ( ) ;
$ expected = 't' unless defined ( $ expected ) ; # default value
my $ cmd = [ 'psql' , '-XAt' , '-c' , $ query , '-d' , $ self - > connstr ( $ dbname ) ] ;
@ -1810,8 +1920,7 @@ sub command_ok
my $ self = shift ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
TestLib:: command_ok ( @ _ ) ;
return ;
@ -1831,8 +1940,7 @@ sub command_fails
my $ self = shift ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
TestLib:: command_fails ( @ _ ) ;
return ;
@ -1852,8 +1960,7 @@ sub command_like
my $ self = shift ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
TestLib:: command_like ( @ _ ) ;
return ;
@ -1874,8 +1981,7 @@ sub command_checks_all
my $ self = shift ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
TestLib:: command_checks_all ( @ _ ) ;
return ;
@ -1899,8 +2005,7 @@ sub issues_sql_like
my ( $ self , $ cmd , $ expected_sql , $ test_name ) = @ _ ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
truncate $ self - > logfile , 0 ;
my $ result = TestLib:: run_log ( $ cmd ) ;
@ -1923,8 +2028,7 @@ sub run_log
{
my $ self = shift ;
local $ ENV { PGHOST } = $ self - > host ;
local $ ENV { PGPORT } = $ self - > port ;
local % ENV = $ self - > _get_env ( ) ;
TestLib:: run_log ( @ _ ) ;
return ;
@ -2174,6 +2278,9 @@ sub pg_recvlogical_upto
{
my ( $ self , $ dbname , $ slot_name , $ endpos , $ timeout_secs , % plugin_options )
= @ _ ;
local % ENV = $ self - > _get_env ( ) ;
my ( $ stdout , $ stderr ) ;
my $ timeout_exception = 'pg_recvlogical timed out' ;