Make PostgresNode version aware

A new PostgresVersion object type is created and this is used in
PostgresNode using the output of `pg_config --version` and the result
stored in the PostgresNode object.  This object can be compared to other
PostgresVersion objects, or to a number or string.

PostgresNode is currently believed to be compatible with versions down
to release 12, so PostgresNode will issue a warning if used with a
version prior to that.

No attempt has been made to deal with incompatibilities in older
versions - that remains work to be undertaken in a subsequent
development cycle.

Based on code from Mark Dilger and Jehan-Guillaume de Rorthais.

Discussion: https://postgr.es/m/a80421c0-3d7e-def1-bcfe-24777f15e344@dunslane.net

diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 685dee6fab54dda74c5e33249ce8876105f66deb..0eb8df5fbf0dc9674382abb9370a2bcb609aa225 100644 (file)
--- 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 (file)
index 0000000..1475036
--- /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;