On 4/21/21 1:13 AM, Michael Paquier wrote:
> On Tue, Apr 20, 2021 at 01:11:59PM -0400, Andrew Dunstan wrote:
>> Here's the patch for that.
> Thanks.
>
>> + # 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)?)/);
> Interesting. This would work even if using --with-extra-version,
> which is a good thing.
>
>> +# render the version number in the standard "joined by dots" notation if
>> +# interpolated into a string
>> +sub _stringify
>> +{
>> + my $self = shift;
>> + return join('.', @$self);
>> +}
> This comes out a bit strangely when using a devel build as this
> appends -1 as sub-version number, becoming say 14.-1. It may be
> clearer to add back "devel" in this case?
>
> Wouldn't it be better to add some perldoc to PostgresVersion.pm?
Here's a patch with these things attended to.
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index b32223f716..d126c1df9f 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;
@@ -1196,9 +1197,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 0000000000..9bb0b667d2
--- /dev/null
+++ b/src/test/perl/PostgresVersion.pm
@@ -0,0 +1,138 @@
+############################################################################
+#
+# 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
+# PostgresNodes or a PostgresNode and a version string.
+#
+# 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
+sub _stringify
+{
+ my $self = shift;
+ my @sections = @$self;
+ if ($sections[-1] == -1)
+ {
+ pop @sections;
+ $sections[-1] = "$sections[-1]devel";
+ }
+ return join('.', @sections);
+}
+
+1;
