Fix Postgres 16 issues

Tests failed because sometimes a tag appears in tag stats as `Foo` and
other times as `foo`. So teach the tag stats to always lowercase tag
names for consistent formatting, both in tests and as things change in
time.

Replace the PL/Perl-based mocks, which used the `%_SHARED` hash, with a
session-based config value. Required because security appears to have
been increased on `%_SHARED`, as it was empty inside the `SECURITY
DEFINER` functions that called mock functions that use it. Since we
require Postgres 12 or higher now, we can do away with that hack ans use
the much cleaner configuration-based mocks.

Update the CI workflow to test on Postgres 16 and use the most recent
checkout action.

While at it, eliminate stray diagnostic lines from test output from the
pgTAP tests by using a different unprintable character in the
`distributions.pg` test, and using error descriptions instead of the
invalid terms and tags in `types.pg`.

.github/workflows/ci.yml

@@ -9,7 +9,7 @@ jobs:
   build:
     strategy:
       matrix:
-        pg: [15, 14, 13, 12]
+        pg: [16, 15, 14, 13, 12]
     name: 🐘 PostgreSQL ${{ matrix.pg }}
     runs-on: ubuntu-latest
     container: pgxn/pgxn-tools
@@ -19,7 +19,7 @@ jobs:
       - name: Start PostgreSQL ${{ matrix.pg }}
         run: |-
           pg-start ${{ matrix.pg }} postgresql-plperl-${{ matrix.pg }} libxml-parser-perl libarchive-zip-perl libarchive-extract-perl libaliased-perl libsoftware-license-perl libtap-parser-sourcehandler-pgtap-perl libtest-file-perl libtest-file-contents-perl libtest-harness-perl libtest-mockmodule-perl libtest-nowarnings-perl libtest-xml-perl libtest-xpath-perl libclass-isa-perl libdata-dump-perl libdata-validate-uri-perl libdbi-perl libdbix-connector-perl libemail-valid-perl libemail-mime-perl libemail-address-perl libencode-perl libexception-class-dbi-perl libhttp-body-perl libhttp-negotiate-perl libjson-xs-perl libmoose-perl libmoosex-singleton-perl libnamespace-autoclean-perl libplack-perl libplack-middleware-session-perl libplack-middleware-methodoverride-perl libsemver-perl libtemplate-declare-perl libtry-tiny-perl liburi-template-perl libplack-middleware-debug-perl libplack-middleware-reverseproxy-perl libtest-pod-perl libtest-pod-coverage-perl libtest-spelling-perl cpanminus
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - name: Build PGXN Manager
         run: |-
           perl Build.PL

Changes

@@ -1,9 +1,14 @@
 Revision history for Perl extension PGXN::Manager
 
 0.30.2
-      - Added the application names (pgxn_manager and pgxn_consumer) to the
-        Postgres connections.
-      - Updated pgxn_consumer to delete the PID file on exit.
+       - Added the application names (pgxn_manager and pgxn_consumer) to the
+         Postgres connections.
+       - Updated pgxn_consumer to delete the PID file on exit.
+       - Updated tag stats to lowercase the tag name, both for consistency
+         across updates for this case-insensitive value, as well as for test
+         consistency.
+       - Fixed test failures on Postgres 16 by replacing PL/Perl-based mocks
+         with pure SQL.
 
 0.30.1   2023-02-18T23:15:06Z
        - Added the --log-file option to `pgxn_consumer`.

sql/19-tag-stats-json.sql

@@ -0,0 +1,50 @@
+-- sql/19-tag-stats-json.sql SQL Migration
+
+SET client_min_messages TO warning;
+
+BEGIN;
+
+CREATE OR REPLACE FUNCTION tag_stats_json(
+    num_popular INT DEFAULT 56
+) RETURNS TEXT LANGUAGE sql STABLE STRICT AS $$
+/*
+
+    % select tag_stats_json(4);
+                    tag_stats_json
+    ──────────────────────────────────────────────
+     {                                           ↵
+        "count": 212,                            ↵
+        "popular": [                             ↵
+           {"tag": "data types", "dists": 4},    ↵
+           {"tag": "key value", "dists": 2},     ↵
+           {"tag": "france", "dists": 1},        ↵
+           {"tag": "key value pair", "dists": 1} ↵
+        ]                                        ↵
+     }                                           ↵
+
+Returns a JSON representation of tag statistics. These include:
+
+* `count`: A count of all tags in the database.
+* `popular`: A list of the most used tags in the system, listed in descending
+  order by the number of uses.
+
+Since tags are case-insensitive, `tag_stats_json()` returns lowercases tag
+names.
+
+Pass in the optional `num_popular` parameter to limit the number of tags that
+appear in the popular list. The default limit is 56.
+
+*/
+    SELECT E'{\n   "count": ' || COUNT(DISTINCT tag) || E',\n   "popular": [\n'
+        || array_to_string(ARRAY(
+        SELECT '      {"tag": ' || json_value(LOWER(tag))
+            || ', "dists": ' || COUNT(DISTINCT distribution) || E'}'
+          FROM distribution_tags
+         GROUP BY tag
+         ORDER BY COUNT(DISTINCT distribution) DESC, tag
+         LIMIT $1
+        ), E',\n') || E'\n   ]\n}\n'
+      FROM distribution_tags
+$$;
+
+COMMIT;

t/dist_management.pg

@@ -826,7 +826,7 @@ SELECT bag_eq(
       {"tag": "foo", "dists": 2},
       {"tag": "bar", "dists": 1},
       {"tag": "baz", "dists": 1},
-      {"tag": "PAIR", "dists": 1}
+      {"tag": "pair", "dists": 1}
    ]
 }
 '), ('stats','user','{
@@ -1116,11 +1116,11 @@ SELECT bag_eq(
 '), ('stats','tag','{
    "count": 6,
    "popular": [
-      {"tag": "Foo", "dists": 2},
+      {"tag": "foo", "dists": 2},
       {"tag": "bar", "dists": 1},
       {"tag": "baz", "dists": 1},
       {"tag": "heavy", "dists": 1},
-      {"tag": "PAIR", "dists": 1},
+      {"tag": "pair", "dists": 1},
       {"tag": "words", "dists": 1}
    ]
 }
@@ -1534,7 +1534,7 @@ SELECT bag_eq(
       {"tag": "foo", "dists": 2},
       {"tag": "bar", "dists": 1},
       {"tag": "baz", "dists": 1},
-      {"tag": "PAIR", "dists": 1},
+      {"tag": "pair", "dists": 1},
       {"tag": "wang", "dists": 1},
       {"tag": "words", "dists": 1},
       {"tag": "yo", "dists": 1}
@@ -1877,7 +1877,7 @@ SELECT bag_eq(
       {"tag": "foo", "dists": 2},
       {"tag": "bar", "dists": 1},
       {"tag": "baz", "dists": 1},
-      {"tag": "PAIR", "dists": 1},
+      {"tag": "pair", "dists": 1},
       {"tag": "wang", "dists": 1},
       {"tag": "words", "dists": 1},
       {"tag": "yo", "dists": 1}

t/distributions.pg

@@ -110,13 +110,13 @@ SELECT throws_like(
     $$ INSERT INTO distributions (name, version, creator, sha1, meta)
        VALUES($$ || quote_literal(bad) || $$, '1.0.0', 'theory', 'bar', 'baz')$$,
     '%"term_check"%',
-    'Should get exception for name "' || bad || '"'
+    'Should get exception for name ' || quote_ident(bad)
 ) FROM unnest(ARRAY[
     'f',           -- too short
     'foo/bar',     -- slash
     'foo\bar',     -- backslash
     'foo bar',     -- whitespace
-    E'foo\x0abar'  -- unprintable
+    E'foo\x09bar'  -- unprintable
 ]) AS bad;
 
 /****************************************************************************/

t/json_data.pg

@@ -644,12 +644,12 @@ VALUES
        ('pair', '0.0.1',   'foo'),
        ('pair', '0.0.2-a1', 'foo'),
        ('pair', '0.0.2',   'foo'),
-       ('trip', '0.2.5',   'foo'),
+       ('trip', '0.2.5',   'Foo'),
        ('pair', '0.0.10',  'foo'),
 
        -- bar for two latest pairs.
-       ('pair', '0.0.2',   'bar'),
-       ('pair', '0.0.10',  'bar')
+       ('pair', '0.0.2',   'Bar'),
+       ('pair', '0.0.10',  'Bar')
 ;
 
 SELECT is_empty(
@@ -760,7 +760,7 @@ SELECT results_eq(
 SELECT results_eq(
     $$ SELECT * FROM tag_json('pair', '0.0.10') ORDER BY tag $$,
     $$ VALUES ('bar'::tag, '{
-   "tag": "bar",
+   "tag": "Bar",
    "releases": {
       "pair": {
          "stable": [

t/tokens.pg

@@ -70,18 +70,12 @@ SELECT is(
 /****************************************************************************/
 -- Now mock rand_str_of_len()
 CREATE SCHEMA mock;
-
-CREATE FUNCTION mock.set_rand_str(
-    string TEXT
-) RETURNS SETOF BOOLEAN LANGUAGE plperl AS $$
-    $_SHARED{random_string} = shift;
-    return;
-$$;
+SET SESSION mock.random_string = 'foobar';
 
 CREATE FUNCTION mock.rand_str_of_len(
     INTEGER
-) RETURNS TEXT LANGUAGE plperl AS $$
-    return $_SHARED{random_string};
+) RETURNS TEXT LANGUAGE sql AS $$
+    SELECT current_setting('mock.random_string')
 $$;
 
 DO LANGUAGE plpgsql $$
@@ -90,7 +84,6 @@ BEGIN
 END;
 $$;
 
-SELECT * FROM set_rand_str('foobar');
 SELECT is(rand_str_of_len(NULL), 'foobar', 'Should get mocked random string');
 
 /****************************************************************************/
@@ -174,7 +167,7 @@ SELECT ok(
 );
 UPDATE users SET status = 'active' WHERE nickname = 'strongrrl';
 
-SELECT * FROM set_rand_str('howdy');
+SET SESSION mock.random_string = 'howdy';
 SELECT is(
     forgot_password('strongrrl'),
     ARRAY['howdy', '[email protected]'],
@@ -190,7 +183,7 @@ SELECT is(
 ) FROM tokens WHERE token = 'howdy';
 
 -- Create another token for the same user.
-SELECT * FROM set_rand_str('booyah');
+SET SESSION mock.random_string = 'booyah';
 SELECT is(
     forgot_password('theory'),
     ARRAY['booyah','[email protected]'],
@@ -276,7 +269,7 @@ SELECT is(set_by, 'kamala', 'New user should have been set by self')
   FROM users WHERE nickname = 'kamala';
 
 -- Update the mocked random string.
-SELECT * FROM set_rand_str('clanker');
+SET SESSION mock.random_string = 'clanker';
 SELECT is(rand_str_of_len(NULL), 'clanker', 'Should get new mocked random string');
 
 -- Now clear the password.
@@ -311,7 +304,7 @@ SELECT throws_like(
 );
 
 -- Create another token for the same user.
-SELECT * FROM set_rand_str('mobius');
+SET SESSION mock.random_string = 'mobius';
 SELECT is(
     clear_password('theory', 'kamala', '10 days'),
     ARRAY['mobius','[email protected]'],

t/types.pg

@@ -162,19 +162,19 @@ SELECT is( 'foo'::term, 'FOO'::term, 'terms should be case-insensitive' );
 SELECT is( NULL::term, NULL, 'terms should be NULLable' );
 
 SELECT throws_like(
-    'SELECT ' || quote_literal(bad) || '::term',
+    'SELECT ' || quote_literal(term) || '::term',
     '%"term_check"%',
-    'Should get invalid term exception for "' || bad || '"'
+    'Should get invalid term exception due to "' || err || '"'
 ) FROM unnest(ARRAY[
-    'foo/bar',    -- slash
-    'foo\bar',    -- backslash
-    'foo	bar', -- tab
-    'f',          -- length
-    E'foo\nbar',  -- newline
-    E'foo\rbar',  -- return
-    E'foo\fbar',  -- feed
-    E'foo\x0abar' -- unprintable
-]) AS bad;
+    ('foo/bar'::text,       'slash'::text),
+    ('foo\bar'::text,       'backslash'::text),
+    (E'foo\tbar'::text,     'tab'::text),
+    ('f'::text,             'shortness'::text),
+    ('foo\nbar'::text,      'newline'::text),
+    ('foo\rbar'::text,      'return'::text),
+    (E'foo\fbar'::text,     'feed'::text),
+    (E'foo\x09bar'::text,   'unprintable'::text)
+]) AS bad (term text, err text);
 
 SELECT lives_ok(
     'SELECT ' || quote_literal(good) || '::term',
@@ -195,17 +195,17 @@ SELECT is( NULL::tag, NULL, 'tags should be NULLable' );
 SELECT throws_like(
     'SELECT ' || quote_literal(bad) || '::tag',
     '%"tag_check"%',
-    'Should get invalid tag exception for "' || bad || '"'
+    'Should get invalid tag exception due to "' || err || '"'
 ) FROM unnest(ARRAY[
-    'foo/bar',       -- slash
-    'foo\bar',       -- backslash
-    'foo	bar',    -- tab
-    E'foo\nbar',     -- newline
-    E'foo\rbar',     -- return
-    E'foo\fbar',     -- feed
-    E'foo\x0abar',   -- unprintable
-    repeat('x', 257) -- too long
-]) AS bad;
+    ('foo/bar'::text,       'slash'::text),
+    ('foo\bar'::text,       'backslash'::text),
+    (E'foo\tbar'::text,     'tab'::text),
+    ('foo\nbar'::text,      'newline'::text),
+    ('foo\rbar'::text,      'return'::text),
+    (E'foo\fbar'::text,     'feed'::text),
+    (E'foo\x09bar'::text,   'unprintable'::text),
+    (repeat('x', 257),      'length'::text)
+]) AS bad (term text, err text);
 
 SELECT lives_ok(
     'SELECT ' || quote_literal(good) || '::tag',

t/users.pg

@@ -232,17 +232,13 @@ SELECT throws_ok(
 /*****************************************************************************/
 -- Mock NOW().
 CREATE SCHEMA mock;
-
-CREATE FUNCTION set_now(timestamptz) RETURNS SETOF boolean LANGUAGE plperl AS $$
-    $_SHARED{now} = shift;
-    return;
-$$;
+SET SESSION mock.time = '2010-08-19 11:01:03.306399+00';
 
 -- Won't be used by table defaults, which seem to be linked to
 -- pg_catalog.now() at creation time.
-CREATE FUNCTION mock.now() RETURNS timestamptz LANGUAGE plperl AS '$_SHARED{now}';
-
-SELECT * FROM set_now('2010-08-19 11:01:03.306399+00');
+CREATE FUNCTION mock.now() RETURNS timestamptz IMMUTABLE PARALLEL SAFE LANGUAGE sql AS $$
+    SELECT current_setting('mock.time')::timestamptz
+$$;
 
 DO LANGUAGE plpgsql $$
 BEGIN
@@ -375,7 +371,7 @@ SELECT is(
     'Password should be unchanged'
 ) FROM users WHERE nickname = 'theory';
 
-SELECT * FROM set_now('2010-08-19 14:01:03.306399+00');
+SET SESSION mock.time = '2010-08-19 14:01:03.306399+00';
 
 SELECT isnt(updated_at, '2010-08-19 14:01:03.306399+00', 'updated_at should be default')
   FROM users WHERE nickname = 'theory';
@@ -464,7 +460,7 @@ SELECT ok(
 );
 
 -- Update now().
-SELECT * FROM set_now('2010-08-20 14:01:03.306399+00');
+SET SESSION mock.time = '2010-08-20 14:01:03.306399+00';
 
 SELECT ok(
     update_user(
@@ -636,7 +632,7 @@ SELECT ok(
 
 
 UPDATE users SET updated_at = pg_catalog.now() WHERE nickname IN ('theory', 'strongrrl');
-SELECT * FROM set_now('2010-08-21 22:01:03.306399+00');
+SET SESSION mock.time = '2010-08-21 22:01:03.306399+00';
 
 SELECT ok(is_admin, nickname || ' should be an admin')
   FROM users WHERE nickname IN ('theory', 'strongrrl');
@@ -706,7 +702,7 @@ SELECT is(
     'User visted_at should be updated'
 ) FROM users WHERE nickname = 'theory';
 
-SELECT * FROM set_now('2010-08-23 11:01:03.306399+00');
+SET SESSION mock.time = '2010-08-23 11:01:03.306399+00';
 
 -- Invalid password.
 SELECT ok(