diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/test/perl/PostgresNode.pm | 56 | ||||
| -rw-r--r-- | src/test/perl/PostgresVersion.pm | 137 |
2 files changed, 193 insertions, 0 deletions
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm index 685dee6fab5..0eb8df5fbf0 100644 --- a/src/test/perl/PostgresNode.pm +++ b/src/test/perl/PostgresNode.pm @@ -96,6 +96,7 @@ use File::Spec; use File::stat qw(stat); use File::Temp (); use IPC::Run; +use PostgresVersion; use RecursiveCopy; use Socket; use Test::More; @@ -350,6 +351,8 @@ sub info my $_info = ''; open my $fh, '>', \$_info or die; print $fh "Name: " . $self->name . "\n"; + print $fh "Version: " . $self->{_pg_version} . "\n" + if $self->{_pg_version}; print $fh "Data directory: " . $self->data_dir . "\n"; print $fh "Backup directory: " . $self->backup_dir . "\n"; print $fh "Archive directory: " . $self->archive_dir . "\n"; @@ -1196,9 +1199,62 @@ sub get_new_node # Add node to list of nodes push(@all_nodes, $node); + $node->_set_pg_version; + + my $v = $node->{_pg_version}; + + carp("PostgresNode isn't fully compatible with version " . $v) + if $v < 12; + return $node; } +# Private routine to run the pg_config binary found in our environment (or in +# our install_path, if we have one), and set the version from it +# +sub _set_pg_version +{ + my ($self) = @_; + my $inst = $self->{_install_path}; + my $pg_config = "pg_config"; + + if (defined $inst) + { + # If the _install_path is invalid, our PATH variables might find an + # unrelated pg_config executable elsewhere. Sanity check the + # directory. + BAIL_OUT("directory not found: $inst") + unless -d $inst; + + # If the directory exists but is not the root of a postgresql + # installation, or if the user configured using + # --bindir=$SOMEWHERE_ELSE, we're not going to find pg_config, so + # complain about that, too. + $pg_config = "$inst/bin/pg_config"; + BAIL_OUT("pg_config not found: $pg_config") + unless -e $pg_config; + BAIL_OUT("pg_config not executable: $pg_config") + unless -x $pg_config; + + # Leave $pg_config install_path qualified, to be sure we get the right + # version information, below, or die trying + } + + local %ENV = $self->_get_env(); + + # We only want the version field + open my $fh, "-|", $pg_config, "--version" + or + BAIL_OUT("$pg_config failed: $!"); + my $version_line = <$fh>; + close $fh or die; + + $self->{_pg_version} = PostgresVersion->new($version_line); + + BAIL_OUT("could not parse pg_config --version output: $version_line") + unless defined $self->{_pg_version}; +} + # 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. diff --git a/src/test/perl/PostgresVersion.pm b/src/test/perl/PostgresVersion.pm new file mode 100644 index 00000000000..14750365acf --- /dev/null +++ b/src/test/perl/PostgresVersion.pm @@ -0,0 +1,137 @@ +############################################################################ +# +# PostgresVersion.pm +# +# Module encapsulating Postgres Version numbers +# +# Copyright (c) 2021, PostgreSQL Global Development Group +# +############################################################################ + +=pod + +=head1 NAME + +PostgresVersion - class representing PostgreSQL version numbers + +=head1 SYNOPSIS + + use PostgresVersion; + + my $version = PostgresVersion->new($version_arg); + + # compare two versions + my $bool = $version1 <= $version2; + + # or compare with a number + $bool = $version < 12; + + # or with a string + $bool = $version lt "13.1"; + + # interpolate in a string + my $stringyval = "version: $version"; + +=head1 DESCRIPTION + +PostgresVersion encapsulated Postgres version numbers, providing parsing +of common version formats and comparison operations. + +=cut + +package PostgresVersion; + +use strict; +use warnings; + +use Scalar::Util qw(blessed); + +use overload + '<=>' => \&_version_cmp, + 'cmp' => \&_version_cmp, + '""' => \&_stringify; + +=pod + +=head1 METHODS + +=over + +=item PostgresVersion->new($version) + +Create a new PostgresVersion instance. + +The argument can be a number like 12, or a string like '12.2' or the output +of a Postgres command like `psql --version` or `pg_config --version`; + +=back + +=cut + +sub new +{ + my $class = shift; + my $arg = shift; + + # Accept standard formats, in case caller has handed us the output of a + # postgres command line tool + $arg = $1 + if ($arg =~ m/\(?PostgreSQL\)? (\d+(?:\.\d+)*(?:devel)?)/); + + # Split into an array + my @result = split(/\./, $arg); + + # Treat development versions as having a minor/micro version one less than + # the first released version of that branch. + if ($result[$#result] =~ m/^(\d+)devel$/) + { + pop(@result); + push(@result, $1, -1); + } + + my $res = [@result]; + bless $res, $class; + return $res; +} + + +# Routine which compares the _pg_version_array obtained for the two +# arguments and returns -1, 0, or 1, allowing comparison between two +# PostgresVersion objects or a PostgresVersion and a version string or number. +# +# If the second argument is not a blessed object we call the constructor +# to make one. +# +# Because we're overloading '<=>' and 'cmp' this function supplies us with +# all the comparison operators ('<' and friends, 'gt' and friends) +# +sub _version_cmp +{ + my ($a, $b) = @_; + + $b = __PACKAGE__->new($b) unless blessed($b); + + for (my $idx = 0;; $idx++) + { + return 0 unless (defined $a->[$idx] && defined $b->[$idx]); + return $a->[$idx] <=> $b->[$idx] + if ($a->[$idx] <=> $b->[$idx]); + } +} + +# Render the version number in the standard "joined by dots" notation if +# interpolated into a string. Put back 'devel' if we previously turned it +# into a -1. +sub _stringify +{ + my $self = shift; + my @sections = @$self; + if ($sections[-1] == -1) + { + pop @sections; + $sections[-1] = "$sections[-1]devel"; + } + return join('.', @sections); +} + +1; |