+++ /dev/null
---
--- SQL queries for upgrade tests across different major versions.
---
--- This file includes a set of SQL queries to make a cluster to-be-upgraded
--- compatible with the version this file is based on. Note that this
--- requires psql, as per-version queries are controlled with a set of \if
--- clauses.
-
--- This script is backward-compatible, so it is able to work with any version
--- newer than 9.2 we are upgrading from, up to the branch this script is stored
--- on (even if this would not run if running pg_upgrade with the same version
--- for the origin and the target).
-
--- \if accepts a simple boolean value, so all the version checks are
--- saved based on this assumption.
-SELECT
- ver <= 902 AS oldpgversion_le92,
- ver <= 904 AS oldpgversion_le94,
- ver <= 906 AS oldpgversion_le96,
- ver <= 1000 AS oldpgversion_le10,
- ver <= 1100 AS oldpgversion_le11,
- ver <= 1300 AS oldpgversion_le13
- FROM (SELECT current_setting('server_version_num')::int / 100 AS ver) AS v;
-\gset
-
--- Objects last appearing in 9.2.
-\if :oldpgversion_le92
--- Note that those tables are removed from the regression tests in 9.3
--- and newer versions.
-DROP TABLE abstime_tbl;
-DROP TABLE reltime_tbl;
-DROP TABLE tinterval_tbl;
-\endif
-
--- Objects last appearing in 9.4.
-\if :oldpgversion_le94
--- This aggregate has been fixed in 9.5 and later versions, so drop
--- and re-create it.
-DROP AGGREGATE array_cat_accum(anyarray);
-CREATE AGGREGATE array_larger_accum (anyarray) (
- sfunc = array_larger,
- stype = anyarray,
- initcond = $${}$$);
--- This operator has been fixed in 9.5 and later versions, so drop and
--- re-create it.
-DROP OPERATOR @#@ (NONE, bigint);
-CREATE OPERATOR @#@ (PROCEDURE = factorial,
- RIGHTARG = bigint);
-\endif
-
--- Objects last appearing in 9.6.
-\if :oldpgversion_le96
-DROP FUNCTION public.oldstyle_length(integer, text);
-\endif
-
--- Objects last appearing in 10.
-\if :oldpgversion_le10
-DROP FUNCTION IF EXISTS boxarea(box);
-DROP FUNCTION IF EXISTS funny_dup17();
-\endif
-
--- Objects last appearing in 11.
-\if :oldpgversion_le11
--- WITH OIDS is supported until v11, so remove its support for any
--- relations marked as such.
-DO $stmt$
- DECLARE
- rec text;
- BEGIN
- FOR rec in
- SELECT oid::regclass::text
- FROM pg_class
- WHERE relname !~ '^pg_'
- AND relhasoids
- AND relkind in ('r', 'f')
- ORDER BY 1
- LOOP
- EXECUTE 'ALTER TABLE ' || quote_ident(rec) || ' SET WITHOUT OIDS';
- END LOOP;
- END; $stmt$;
-\endif
-
--- Objects last appearing in 13.
-\if :oldpgversion_le13
--- Until v10, operators could only be dropped one at a time, so be careful
--- to stick with one command for each drop here.
-DROP OPERATOR public.#@# (pg_catalog.int8, NONE);
-DROP OPERATOR public.#%# (pg_catalog.int8, NONE);
-DROP OPERATOR public.!=- (pg_catalog.int8, NONE);
-DROP OPERATOR public.#@%# (pg_catalog.int8, NONE);
-\endif
--- /dev/null
+
+# Copyright (c) 2023, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::Test::AdjustUpgrade - helper module for cross-version upgrade tests
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::Test::AdjustUpgrade;
+
+ # Build commands to adjust contents of old-version database before dumping
+ $statements = adjust_database_contents($old_version, %dbnames);
+
+ # Adjust contents of old pg_dumpall output file to match newer version
+ $dump = adjust_old_dumpfile($old_version, $dump);
+
+ # Adjust contents of new pg_dumpall output file to match older version
+ $dump = adjust_new_dumpfile($old_version, $dump);
+
+=head1 DESCRIPTION
+
+C
encapsulates various hacks needed to+compare the results of cross-version upgrade tests.
+
+=cut
+
+package PostgreSQL::Test::AdjustUpgrade;
+
+use strict;
+use warnings;
+
+use Exporter 'import';
+use PostgreSQL::Version;
+
+our @EXPORT = qw(
+ adjust_database_contents
+ adjust_old_dumpfile
+ adjust_new_dumpfile
+);
+
+=pod
+
+=head1 ROUTINES
+
+=over
+
+=item $statements = adjust_database_contents($old_version, %dbnames)
+
+Generate SQL commands to perform any changes to an old-version installation
+that are needed before we can pg_upgrade it into the current PostgreSQL
+version.
+
+Typically this involves dropping or adjusting no-longer-supported objects.
+
+Arguments:
+
+=over
+
+=item C
: Branch we are upgrading from, represented as a+PostgreSQL::Version object.
+
+=item C: Hash of database names present in the old installation.
+
+=back
+
+Returns a reference to a hash, wherein the keys are database names and the
+values are arrayrefs to lists of statements to be run in those databases.
+
+=cut
+
+sub adjust_database_contents
+{
+ my ($old_version, %dbnames) = @_;
+ my $result = {};
+
+ # remove dbs of modules known to cause pg_upgrade to fail
+ # anything not builtin and incompatible should clean up its own db
+ foreach my $bad_module ('test_ddl_deparse', 'tsearch2')
+ {
+ if ($dbnames{"contrib_regression_$bad_module"})
+ {
+ _add_st($result, 'postgres',
+ "drop database contrib_regression_$bad_module");
+ delete($dbnames{"contrib_regression_$bad_module"});
+ }
+ }
+
+ # avoid version number issues with test_ext7
+ if ($dbnames{contrib_regression_test_extensions})
+ {
+ _add_st(
+ $result,
+ 'contrib_regression_test_extensions',
+ 'drop extension if exists test_ext7');
+ }
+
+ # stuff not supported from release 14
+ if ($old_version < 14)
+ {
+ # postfix operators (some don't exist in very old versions)
+ _add_st(
+ $result,
+ 'regression',
+ 'drop operator #@# (bigint,NONE)',
+ 'drop operator #%# (bigint,NONE)',
+ 'drop operator if exists !=- (bigint,NONE)',
+ 'drop operator if exists #@%# (bigint,NONE)');
+
+ # get rid of dblink's dependencies on regress.so
+ my $regrdb =
+ $old_version le '9.4'
+ ? 'contrib_regression'
+ : 'contrib_regression_dblink';
+
+ if ($dbnames{$regrdb})
+ {
+ _add_st(
+ $result, $regrdb,
+ 'drop function if exists public.putenv(text)',
+ 'drop function if exists public.wait_pid(integer)');
+ }
+ }
+
+ # user table OIDs are gone from release 12 on
+ if ($old_version < 12)
+ {
+ my $nooid_stmt = q{
+ DO $stmt$
+ DECLARE
+ rec text;
+ BEGIN
+ FOR rec in
+ select oid::regclass::text
+ from pg_class
+ where relname !~ '^pg_'
+ and relhasoids
+ and relkind in ('r','m')
+ order by 1
+ LOOP
+ execute 'ALTER TABLE ' || rec || ' SET WITHOUT OIDS';
+ RAISE NOTICE 'removing oids from table %', rec;
+ END LOOP;
+ END; $stmt$;
+ };
+
+ foreach my $oiddb ('regression', 'contrib_regression_btree_gist')
+ {
+ next unless $dbnames{$oiddb};
+ _add_st($result, $oiddb, $nooid_stmt);
+ }
+
+ # this table had OIDs too, but we'll just drop it
+ if ($old_version >= 10 && $dbnames{'contrib_regression_postgres_fdw'})
+ {
+ _add_st(
+ $result,
+ 'contrib_regression_postgres_fdw',
+ 'drop foreign table ft_pg_type');
+ }
+ }
+
+ # abstime+friends are gone from release 12 on; but these tables
+ # might or might not be present depending on regression test vintage
+ if ($old_version < 12)
+ {
+ _add_st($result, 'regression',
+ 'drop table if exists abstime_tbl, reltime_tbl, tinterval_tbl');
+ }
+
+ # some regression functions gone from release 11 on
+ if ($old_version < 11)
+ {
+ _add_st(
+ $result, 'regression',
+ 'drop function if exists public.boxarea(box)',
+ 'drop function if exists public.funny_dup17()');
+ }
+
+ # version-0 C functions are no longer supported
+ if ($old_version < 10)
+ {
+ _add_st($result, 'regression',
+ 'drop function oldstyle_length(integer, text)');
+ }
+
+ if ($old_version lt '9.5')
+ {
+ # cope with changes of underlying functions
+ _add_st(
+ $result,
+ 'regression',
+ 'drop operator @#@ (NONE, bigint)',
+ 'CREATE OPERATOR @#@ ('
+ . 'PROCEDURE = factorial, RIGHTARG = bigint )',
+ 'drop aggregate public.array_cat_accum(anyarray)',
+ 'CREATE AGGREGATE array_larger_accum (anyarray) ' . ' ( '
+ . ' sfunc = array_larger, '
+ . ' stype = anyarray, '
+ . ' initcond = $${}$$ ' . ' ) ');
+
+ # "=>" is no longer valid as an operator name
+ _add_st($result, 'regression',
+ 'drop operator if exists public.=> (bigint, NONE)');
+ }
+
+ return $result;
+}
+
+# Internal subroutine to add statement(s) to the list for the given db.
+sub _add_st
+{
+ my ($result, $db, @st) = @_;
+
+ $result->{$db} ||= [];
+ push(@{ $result->{$db} }, @st);
+}
+
+=pod
+
+=item adjust_old_dumpfile($old_version, $dump)
+
+Edit a dump output file, taken from the adjusted old-version installation
+by current-version C
, so that it will match the results of+C
on the pg_upgrade'd installation.+
+Typically this involves coping with cosmetic differences in the output
+of backend subroutines used by pg_dump.
+
+Arguments:
+
+=over
+
+=item C
: Branch we are upgrading from, represented as a+PostgreSQL::Version object.
+
+=item C: Contents of dump file
+
+=back
+
+Returns the modified dump text.
+
+=cut
+
+sub adjust_old_dumpfile
+{
+ my ($old_version, $dump) = @_;
+
+ # use Unix newlines
+ $dump =~ s/\r\n/\n/g;
+
+ # Version comments will certainly not match.
+ $dump =~ s/^-- Dumped from database version.*\n//mg;
+
+ if ($old_version < 14)
+ {
+ # Remove mentions of extended hash functions.
+ $dump =~ s {^(\s+OPERATOR\s1\s=\(integer,integer\))\s,\n
+ \s+FUNCTION\s2\s\(integer,\sinteger\)\spublic\.part_hashint4_noop\(integer,bigint\);}
+ {$1;}mxg;
+ $dump =~ s {^(\s+OPERATOR\s1\s=\(text,text\))\s,\n
+ \s+FUNCTION\s2\s\(text,\stext\)\spublic\.part_hashtext_length\(text,bigint\);}
+ {$1;}mxg;
+ }
+
+ # Change trigger definitions to say ... EXECUTE FUNCTION ...
+ if ($old_version < 12)
+ {
+ # would like to use lookbehind here but perl complains
+ # so do it this way
+ $dump =~ s/
+ (^CREATE\sTRIGGER\s.*?)
+ \sEXECUTE\sPROCEDURE
+ /$1 EXECUTE FUNCTION/mgx;
+ }
+
+ if ($old_version lt '9.6')
+ {
+ # adjust some places where we don't print so many parens anymore
+
+ my $prefix =
+ "'New York'\tnew & york | big & apple | nyc\t'new' & 'york'\t";
+ my $orig = "( 'new' & 'york' | 'big' & 'appl' ) | 'nyc'";
+ my $repl = "'new' & 'york' | 'big' & 'appl' | 'nyc'";
+ $dump =~ s/(?<=^\Q$prefix\E)\Q$orig\E/$repl/mg;
+
+ $prefix =
+ "'Sanct Peter'\tPeterburg | peter | 'Sanct Peterburg'\t'sanct' & 'peter'\t";
+ $orig = "( 'peterburg' | 'peter' ) | 'sanct' & 'peterburg'";
+ $repl = "'peterburg' | 'peter' | 'sanct' & 'peterburg'";
+ $dump =~ s/(?<=^\Q$prefix\E)\Q$orig\E/$repl/mg;
+ }
+
+ # dumps from pre-9.6 databases will show assorted default grants explicitly
+ if ($old_version lt '9.6')
+ {
+ my $comment =
+ "-- Name: SCHEMA public; Type: ACL; Schema: -; Owner: .*";
+ my $sql =
+ "REVOKE ALL ON SCHEMA public FROM PUBLIC;\n"
+ . "REVOKE ALL ON SCHEMA public FROM .*;\n"
+ . "GRANT ALL ON SCHEMA public TO .*;\n"
+ . "GRANT ALL ON SCHEMA public TO PUBLIC;";
+ $dump =~ s/^--\n$comment\n--\n+$sql\n+//mg;
+
+ $comment = "-- Name: DATABASE .*; Type: ACL; Schema: -; Owner: .*";
+ $sql =
+ "REVOKE ALL ON DATABASE .* FROM PUBLIC;\n"
+ . "REVOKE ALL ON DATABASE .* FROM .*;\n"
+ . "GRANT ALL ON DATABASE .* TO .*;\n"
+ . "GRANT CONNECT,TEMPORARY ON DATABASE .* TO PUBLIC;\n";
+ $dump =~ s/^--\n$comment\n--\n+$sql\n+//mg;
+ $dump =~ s/^$sql//mg;
+
+ $sql =
+ "REVOKE ALL ON TABLE .* FROM PUBLIC;\n"
+ . "REVOKE ALL ON TABLE .* FROM .*;\n"
+ . "GRANT ALL ON TABLE .* TO .*;\n";
+ $dump =~ s/^$sql//mg;
+ }
+
+ if ($old_version lt '9.5')
+ {
+ # adjust some places where we don't print so many parens anymore
+
+ my $prefix = "CONSTRAINT (?:sequence|copy)_con CHECK [(][(]";
+ my $orig = "((x > 3) AND (y <> 'check failed'::text))";
+ my $repl = "(x > 3) AND (y <> 'check failed'::text)";
+ $dump =~ s/($prefix)\Q$orig\E/$1$repl/mg;
+
+ $prefix = "CONSTRAINT insert_con CHECK [(][(]";
+ $orig = "((x >= 3) AND (y <> 'check failed'::text))";
+ $repl = "(x >= 3) AND (y <> 'check failed'::text)";
+ $dump =~ s/($prefix)\Q$orig\E/$1$repl/mg;
+
+ $orig = "DEFAULT ((-1) * currval('public.insert_seq'::regclass))";
+ $repl =
+ "DEFAULT ('-1'::integer * currval('public.insert_seq'::regclass))";
+ $dump =~ s/\Q$orig\E/$repl/mg;
+
+ my $expr =
+ "(rsl.sl_color = rsh.slcolor) AND (rsl.sl_len_cm >= rsh.slminlen_cm)";
+ $dump =~ s/WHERE \(\(\Q$expr\E\)/WHERE ($expr/g;
+
+ $expr =
+ "(rule_and_refint_t3.id3a = new.id3a) AND (rule_and_refint_t3.id3b = new.id3b)";
+ $dump =~ s/WHERE \(\(\Q$expr\E\)/WHERE ($expr/g;
+
+ $expr =
+ "(rule_and_refint_t3_1.id3a = new.id3a) AND (rule_and_refint_t3_1.id3b = new.id3b)";
+ $dump =~ s/WHERE \(\(\Q$expr\E\)/WHERE ($expr/g;
+ }
+
+ if ($old_version lt '9.3')
+ {
+ # CREATE VIEW/RULE statements were not pretty-printed before 9.3.
+ # To cope, reduce all whitespace sequences within them to one space.
+ # This must be done on both old and new dumps.
+ $dump = _mash_view_whitespace($dump);
+
+ # _mash_view_whitespace doesn't handle multi-command rules;
+ # rather than trying to fix that, just hack the exceptions manually.
+
+ my $prefix =
+ "CREATE RULE rtest_sys_del AS ON DELETE TO public.rtest_system DO (DELETE FROM public.rtest_interface WHERE (rtest_interface.sysname = old.sysname);";
+ my $line2 = " DELETE FROM public.rtest_admin";
+ my $line3 = " WHERE (rtest_admin.sysname = old.sysname);";
+ $dump =~
+ s/(?<=\Q$prefix\E)\Q$line2$line3\E \);/\n$line2\n $line3\n);/mg;
+
+ $prefix =
+ "CREATE RULE rtest_sys_upd AS ON UPDATE TO public.rtest_system DO (UPDATE public.rtest_interface SET sysname = new.sysname WHERE (rtest_interface.sysname = old.sysname);";
+ $line2 = " UPDATE public.rtest_admin SET sysname = new.sysname";
+ $line3 = " WHERE (rtest_admin.sysname = old.sysname);";
+ $dump =~
+ s/(?<=\Q$prefix\E)\Q$line2$line3\E \);/\n$line2\n $line3\n);/mg;
+
+ # and there's one place where pre-9.3 uses a different table alias
+ $dump =~ s {^(CREATE\sRULE\srule_and_refint_t3_ins\sAS\s
+ ON\sINSERT\sTO\spublic\.rule_and_refint_t3\s
+ WHERE\s\(EXISTS\s\(SELECT\s1\sFROM\spublic\.rule_and_refint_t3)\s
+ (WHERE\s\(\(rule_and_refint_t3)
+ (\.id3a\s=\snew\.id3a\)\sAND\s\(rule_and_refint_t3)
+ (\.id3b\s=\snew\.id3b\)\sAND\s\(rule_and_refint_t3)}
+ {$1 rule_and_refint_t3_1 $2_1$3_1$4_1}mx;
+
+ # Also fix old use of NATURAL JOIN syntax
+ $dump =~ s {NATURAL JOIN public\.credit_card r}
+ {JOIN public.credit_card r USING (cid)}mg;
+ $dump =~ s {NATURAL JOIN public\.credit_usage r}
+ {JOIN public.credit_usage r USING (cid)}mg;
+ }
+
+ # Suppress blank lines, as some places in pg_dump emit more or fewer.
+ $dump =~ s/\n\n+/\n/g;
+
+ return $dump;
+}
+
+# Internal subroutine to mangle whitespace within view/rule commands.
+# Any consecutive sequence of whitespace is reduced to one space.
+sub _mash_view_whitespace
+{
+ my ($dump) = @_;
+
+ foreach my $leader ('CREATE VIEW', 'CREATE RULE')
+ {
+ my @splitchunks = split $leader, $dump;
+
+ $dump = shift(@splitchunks);
+ foreach my $chunk (@splitchunks)
+ {
+ my @thischunks = split /;/, $chunk, 2;
+ my $stmt = shift(@thischunks);
+
+ # now $stmt is just the body of the CREATE VIEW/RULE
+ $stmt =~ s/\s+/ /sg;
+ # we also need to smash these forms for sub-selects and rules
+ $stmt =~ s/\( SELECT/(SELECT/g;
+ $stmt =~ s/\( INSERT/(INSERT/g;
+ $stmt =~ s/\( UPDATE/(UPDATE/g;
+ $stmt =~ s/\( DELETE/(DELETE/g;
+
+ $dump .= $leader . $stmt . ';' . $thischunks[0];
+ }
+ }
+ return $dump;
+}
+
+=pod
+
+=item adjust_new_dumpfile($old_version, $dump)
+
+Edit a dump output file, taken from the pg_upgrade'd installation
+by current-version C
, so that it will match the old+dump output file as adjusted by C
.+
+Typically this involves deleting data not present in the old installation.
+
+Arguments:
+
+=over
+
+=item C
: Branch we are upgrading from, represented as a+PostgreSQL::Version object.
+
+=item C: Contents of dump file
+
+=back
+
+Returns the modified dump text.
+
+=cut
+
+sub adjust_new_dumpfile
+{
+ my ($old_version, $dump) = @_;
+
+ # use Unix newlines
+ $dump =~ s/\r\n/\n/g;
+
+ # Version comments will certainly not match.
+ $dump =~ s/^-- Dumped from database version.*\n//mg;
+
+ if ($old_version < 14)
+ {
+ # Suppress noise-word uses of IN in CREATE/ALTER PROCEDURE.
+ $dump =~ s/^(CREATE PROCEDURE .*?)\(IN /$1(/mg;
+ $dump =~ s/^(ALTER PROCEDURE .*?)\(IN /$1(/mg;
+ $dump =~ s/^(CREATE PROCEDURE .*?), IN /$1, /mg;
+ $dump =~ s/^(ALTER PROCEDURE .*?), IN /$1, /mg;
+ $dump =~ s/^(CREATE PROCEDURE .*?), IN /$1, /mg;
+ $dump =~ s/^(ALTER PROCEDURE .*?), IN /$1, /mg;
+
+ # Remove SUBSCRIPT clauses in CREATE TYPE.
+ $dump =~ s/^\s+SUBSCRIPT = raw_array_subscript_handler,\n//mg;
+
+ # Remove multirange_type_name clauses in CREATE TYPE AS RANGE.
+ $dump =~ s {,\n\s+multirange_type_name = .*?(,?)$} {$1}mg;
+
+ # Remove mentions of extended hash functions.
+ $dump =~
+ s {^ALTER\sOPERATOR\sFAMILY\spublic\.part_test_int4_ops\sUSING\shash\sADD\n
+ \s+FUNCTION\s2\s\(integer,\sinteger\)\spublic\.part_hashint4_noop\(integer,bigint\);} {}mxg;
+ $dump =~
+ s {^ALTER\sOPERATOR\sFAMILY\spublic\.part_test_text_ops\sUSING\shash\sADD\n
+ \s+FUNCTION\s2\s\(text,\stext\)\spublic\.part_hashtext_length\(text,bigint\);} {}mxg;
+ }
+
+ # pre-v12 dumps will not say anything about default_table_access_method.
+ if ($old_version < 12)
+ {
+ $dump =~ s/^SET default_table_access_method = heap;\n//mg;
+ }
+
+ # dumps from pre-9.6 dblink may include redundant ACL settings
+ if ($old_version lt '9.6')
+ {
+ my $comment =
+ "-- Name: FUNCTION dblink_connect_u\(.*?\); Type: ACL; Schema: public; Owner: .*";
+ my $sql =
+ "REVOKE ALL ON FUNCTION public\.dblink_connect_u\(.*?\) FROM PUBLIC;";
+ $dump =~ s/^--\n$comment\n--\n+$sql\n+//mg;
+ }
+
+ if ($old_version lt '9.3')
+ {
+ # CREATE VIEW/RULE statements were not pretty-printed before 9.3.
+ # To cope, reduce all whitespace sequences within them to one space.
+ # This must be done on both old and new dumps.
+ $dump = _mash_view_whitespace($dump);
+ }
+
+ # Suppress blank lines, as some places in pg_dump emit more or fewer.
+ $dump =~ s/\n\n+/\n/g;
+
+ return $dump;
+}
+
+=pod
+
+=back
+
+=cut
+
+1;
--- /dev/null
+############################################################################
+#
+# PostgreSQL/Version.pm
+#
+# Module encapsulating Postgres Version numbers
+#
+# Copyright (c) 2021-2022, PostgreSQL Global Development Group
+#
+############################################################################
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::Version - class representing PostgreSQL version numbers
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::Version;
+
+ my $version = PostgreSQL::Version->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";
+
+ # get the major version
+ my $maj = $version->major;
+
+=head1 DESCRIPTION
+
+PostgreSQL::Version encapsulates Postgres version numbers, providing parsing
+of common version formats and comparison operations.
+
+=cut
+
+package PostgreSQL::Version;
+
+use strict;
+use warnings;
+
+use Scalar::Util qw(blessed);
+
+use overload
+ '<=>' => \&_version_cmp,
+ 'cmp' => \&_version_cmp,
+ '""' => \&_stringify;
+
+=pod
+
+=head1 METHODS
+
+=over
+
+=item PostgreSQL::Version->new($version)
+
+Create a new PostgreSQL::Version 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;
+
+ chomp $arg;
+
+ # Accept standard formats, in case caller has handed us the output of a
+ # postgres command line tool
+ my $devel;
+ ($arg, $devel) = ($1, $2)
+ if (
+ $arg =~ m!^ # beginning of line
+ (?:\(?PostgreSQL\)?\s)? # ignore PostgreSQL marker
+ (\d+(?:\.\d+)*) # version number, dotted notation
+ (devel|(?:alpha|beta|rc)\d+)? # dev marker - see version_stamp.pl
+ !x);
+
+ # Split into an array
+ my @numbers = split(/\./, $arg);
+
+ # Treat development versions as having a minor/micro version one less than
+ # the first released version of that branch.
+ push @numbers, -1 if ($devel);
+
+ $devel ||= "";
+
+ return bless { str => "$arg$devel", num => \@numbers }, $class;
+}
+
+# Routine which compares the _pg_version_array obtained for the two
+# arguments and returns -1, 0, or 1, allowing comparison between two
+# PostgreSQL::Version objects or a PostgreSQL::Version 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, $swapped) = @_;
+
+ $b = __PACKAGE__->new($b) unless blessed($b);
+
+ ($a, $b) = ($b, $a) if $swapped;
+
+ my ($an, $bn) = ($a->{num}, $b->{num});
+
+ for (my $idx = 0;; $idx++)
+ {
+ return 0
+ if ($idx >= @$an && $idx >= @$bn);
+ # treat a missing number as 0
+ my ($anum, $bnum) = ($an->[$idx] || 0, $bn->[$idx] || 0);
+ return $anum <=> $bnum
+ if ($anum <=> $bnum);
+ }
+}
+
+# Render the version number using the saved string.
+sub _stringify
+{
+ my $self = shift;
+ return $self->{str};
+}
+
+=pod
+
+=over
+
+=item major([separator => 'char'])
+
+Returns the major version. For versions before 10 the parts are separated by
+a dot unless the separator argument is given.
+
+=back
+
+=cut
+
+sub major
+{
+ my ($self, %params) = @_;
+ my $result = $self->{num}->[0];
+ if ($result + 0 < 10)
+ {
+ my $sep = $params{separator} || '.';
+ $result .= "$sep$self->{num}->[1]";
+ }
+ return $result;
+}
+
+1;
projects / postgresql.git / commitdiff