On 2024-06-14 Fr 11:09, Andrew Dunstan wrote:
Over at [1] Andres expressed enthusiasm for enabling TAP tests to call
LibPQ directly via FFI, and there was some support from others as
well. Attached is a very rough POC for just that.There are two perl
modules, one which wraps libpq (or almost all of it) in perl, and
another which uses that module to create a session object that can be
used to run SQL. Also in the patch is a modification of one TAP test
(arbitrarily chosen as src/bin/pg_amcheck/t/004_verify_heapam.p) to
use the new interface, so it doesn't use psql at all.
There's a bunch of work to do here, but for a morning's work it's not
too bad :-) Luckily I had most of the first file already to hand.
Next I plan to look at some of the recovery tests and other uses of
background_psql, which might be more challenging,a dn require
extension of the session API. Also there's a lot of error checking and
documentation that need to be added.
cheers
andrew
[1]
https://postgr.es/m/20240612152812.ixz3eiz2p475g...@awork3.anarazel.de
And here's the patch
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
diff --git a/src/bin/pg_amcheck/t/004_verify_heapam.pl b/src/bin/pg_amcheck/t/004_verify_heapam.pl
index f6d2c5f787..c47ff3f939 100644
--- a/src/bin/pg_amcheck/t/004_verify_heapam.pl
+++ b/src/bin/pg_amcheck/t/004_verify_heapam.pl
@@ -5,6 +5,7 @@ use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -190,16 +191,17 @@ $node->append_conf('postgresql.conf', 'max_prepared_transactions=10');
$node->start;
my $port = $node->port;
my $pgdata = $node->data_dir;
-$node->safe_psql('postgres', "CREATE EXTENSION amcheck");
-$node->safe_psql('postgres', "CREATE EXTENSION pageinspect");
+my $session = PostgreSQL::Test::Session->new(node => $node);
+$session->do("CREATE EXTENSION amcheck");
+$session->do("CREATE EXTENSION pageinspect");
# Get a non-zero datfrozenxid
-$node->safe_psql('postgres', qq(VACUUM FREEZE));
+$session->do(qq(VACUUM FREEZE));
# Create the test table with precisely the schema that our corruption function
# expects.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
CREATE TABLE public.test (a BIGINT, b TEXT, c TEXT);
ALTER TABLE public.test SET (autovacuum_enabled=false);
ALTER TABLE public.test ALTER COLUMN c SET STORAGE EXTERNAL;
@@ -209,14 +211,15 @@ $node->safe_psql(
# We want (0 < datfrozenxid < test.relfrozenxid). To achieve this, we freeze
# an otherwise unused table, public.junk, prior to inserting data and freezing
# public.test
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
CREATE TABLE public.junk AS SELECT 'junk'::TEXT AS junk_column;
ALTER TABLE public.junk SET (autovacuum_enabled=false);
- VACUUM FREEZE public.junk
- ));
+ ),
+ 'VACUUM FREEZE public.junk'
+);
-my $rel = $node->safe_psql('postgres',
+my $rel = $session->query_oneval(
qq(SELECT pg_relation_filepath('public.test')));
my $relpath = "$pgdata/$rel";
@@ -229,23 +232,24 @@ my $ROWCOUNT_BASIC = 16;
# First insert data needed for tests unrelated to update chain validation.
# Then freeze the page. These tuples are at offset numbers 1 to 16.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
SELECT
x'DEADF9F9DEADF9F9'::bigint,
'abcdefg',
repeat('w', 10000)
FROM generate_series(1, $ROWCOUNT_BASIC);
- VACUUM FREEZE public.test;)
+ ),
+ 'VACUUM FREEZE public.test'
);
# Create some simple HOT update chains for line pointer validation. After
# the page is HOT pruned, we'll have two redirects line pointers each pointing
# to a tuple. We'll then change the second redirect to point to the same
# tuple as the first one and verify that we can detect corruption.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(1,2)); -- offset numbers 17 and 18
@@ -254,8 +258,8 @@ $node->safe_psql(
));
# Create some more HOT update chains.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(3,6)); -- offset numbers 21 through 24
@@ -264,25 +268,29 @@ $node->safe_psql(
));
# Negative test case of HOT-pruning with aborted tuple.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '5'; -- offset number 27
ABORT;
- VACUUM FREEZE public.test;
- ));
+ ),
+ 'VACUUM FREEZE public.test;',
+ );
# Next update on any tuple will be stored at the same place of tuple inserted
# by aborted transaction. This should not cause the table to appear corrupt.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
+ BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '6'; -- offset number 27 again
+ COMMIT;
VACUUM FREEZE public.test;
));
# Data for HOT chain validation, so not calling VACUUM FREEZE.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
+ BEGIN;
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(7,15)); -- offset numbers 28 to 36
@@ -293,11 +301,12 @@ $node->safe_psql(
UPDATE public.test SET c = 'a' WHERE c = '13'; -- offset number 41
UPDATE public.test SET c = 'a' WHERE c = '14'; -- offset number 42
UPDATE public.test SET c = 'a' WHERE c = '15'; -- offset number 43
+ COMMIT;
));
# Need one aborted transaction to test corruption in HOT chains.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '9'; -- offset number 44
ABORT;
@@ -306,19 +315,19 @@ $node->safe_psql(
# Need one in-progress transaction to test few corruption in HOT chains.
# We are creating PREPARE TRANSACTION here as these will not be aborted
# even if we stop the node.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
PREPARE TRANSACTION 'in_progress_tx';
));
-my $in_progress_xid = $node->safe_psql(
- 'postgres', qq(
+my $in_progress_xid = $session->query_oneval(
+ qq(
SELECT transaction FROM pg_prepared_xacts;
));
-my $relfrozenxid = $node->safe_psql('postgres',
+my $relfrozenxid = $session->query_oneval(
q(select relfrozenxid from pg_class where relname = 'test'));
-my $datfrozenxid = $node->safe_psql('postgres',
+my $datfrozenxid = $session->query_oneval(
q(select datfrozenxid from pg_database where datname = 'postgres'));
# Sanity check that our 'test' table has a relfrozenxid newer than the
@@ -326,6 +335,7 @@ my $datfrozenxid = $node->safe_psql('postgres',
# first normal xid. We rely on these invariants in some of our tests.
if ($datfrozenxid <= 3 || $datfrozenxid >= $relfrozenxid)
{
+ $session->close;
$node->clean_node;
plan skip_all =>
"Xid thresholds not as expected: got datfrozenxid = $datfrozenxid, relfrozenxid = $relfrozenxid";
@@ -334,17 +344,21 @@ if ($datfrozenxid <= 3 || $datfrozenxid >= $relfrozenxid)
# Find where each of the tuples is located on the page. If a particular
# line pointer is a redirect rather than a tuple, we record the offset as -1.
-my @lp_off = split '\n', $node->safe_psql(
- 'postgres', qq(
+my $lp_off_res = $session->query(
+ qq(
SELECT CASE WHEN lp_flags = 2 THEN -1 ELSE lp_off END
FROM heap_page_items(get_raw_page('test', 'main', 0))
)
-);
+ );
+my @lp_off;
+push(@lp_off, $_->[0]) foreach @{$lp_off_res->{rows}};
+
scalar @lp_off == $ROWCOUNT or BAIL_OUT("row offset counts mismatch");
# Sanity check that our 'test' table on disk layout matches expectations. If
# this is not so, we will have to skip the test until somebody updates the test
# to work on this platform.
+$session->close;
$node->stop;
my $file;
open($file, '+<', $relpath)
@@ -750,17 +764,19 @@ for (my $tupidx = 0; $tupidx < $ROWCOUNT; $tupidx++)
close($file)
or BAIL_OUT("close failed: $!");
$node->start;
+$session->reconnect;
# Run pg_amcheck against the corrupt table with epoch=0, comparing actual
# corruption messages against the expected messages
$node->command_checks_all(
[ 'pg_amcheck', '--no-dependent-indexes', '-p', $port, 'postgres' ],
2, [@expected], [], 'Expected corruption message output');
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
COMMIT PREPARED 'in_progress_tx';
));
+$session->close;
$node->teardown_node;
$node->clean_node;
diff --git a/src/test/perl/PostgreSQL/PqFFI.pm b/src/test/perl/PostgreSQL/PqFFI.pm
new file mode 100644
index 0000000000..fac544d32c
--- /dev/null
+++ b/src/test/perl/PostgreSQL/PqFFI.pm
@@ -0,0 +1,564 @@
+
+############################################
+#
+# FFI wrapper for libpq
+#
+############################################
+package PostgreSQL::PqFFI;
+
+use strict;
+use warnings FATAL => 'all';
+
+use FFI::Platypus;
+use FFI::CheckLib;
+
+use Exporter qw(import);
+
+our @EXPORT = qw (
+
+ CONNECTION_OK
+ CONNECTION_BAD
+ CONNECTION_STARTED
+ CONNECTION_MADE
+ CONNECTION_AWAITING_RESPONSE
+ CONNECTION_AUTH_OK
+ CONNECTION_SETENV
+ CONNECTION_SSL_STARTUP
+ CONNECTION_NEEDED
+ CONNECTION_CHECK_WRITABLE
+ CONNECTION_CONSUME
+ CONNECTION_GSS_STARTUP
+ CONNECTION_CHECK_TARGET
+ CONNECTION_CHECK_STANDBY
+
+ PGRES_EMPTY_QUERY
+ PGRES_COMMAND_OK
+ PGRES_TUPLES_OK
+ PGRES_COPY_OUT
+ PGRES_COPY_IN
+ PGRES_BAD_RESPONSE
+ PGRES_NONFATAL_ERROR
+ PGRES_FATAL_ERROR
+ PGRES_COPY_BOTH
+ PGRES_SINGLE_TUPLE
+ PGRES_PIPELINE_SYNC
+ PGRES_PIPELINE_ABORTED
+
+ PQPING_OK
+ PQPING_REJECT
+ PQPING_NO_RESPONSE
+ PQPING_NO_ATTEMPT
+
+ PQTRANS_IDLE
+ PQTRANS_ACTIVE
+ PQTRANS_INTRANS
+ PQTRANS_INERROR
+ PQTRANS_UNKNOWN
+
+ BOOLOID
+ BYTEAOID
+ CHAROID
+ NAMEOID
+ INT8OID
+ INT2OID
+ INT2VECTOROID
+ INT4OID
+ TEXTOID
+ OIDOID
+ TIDOID
+ XIDOID
+ CIDOID
+ OIDVECTOROID
+ JSONOID
+ XMLOID
+ XID8OID
+ POINTOID
+ LSEGOID
+ PATHOID
+ BOXOID
+ POLYGONOID
+ LINEOID
+ FLOAT4OID
+ FLOAT8OID
+ UNKNOWNOID
+ CIRCLEOID
+ MONEYOID
+ MACADDROID
+ INETOID
+ CIDROID
+ MACADDR8OID
+ ACLITEMOID
+ BPCHAROID
+ VARCHAROID
+ DATEOID
+ TIMEOID
+ TIMESTAMPOID
+ TIMESTAMPTZOID
+ INTERVALOID
+ TIMETZOID
+ BITOID
+ VARBITOID
+ NUMERICOID
+ REFCURSOROID
+ UUIDOID
+ TSVECTOROID
+ GTSVECTOROID
+ TSQUERYOID
+ JSONBOID
+ JSONPATHOID
+ TXID_SNAPSHOTOID
+ INT4RANGEOID
+ NUMRANGEOID
+ TSRANGEOID
+ TSTZRANGEOID
+ DATERANGEOID
+ INT8RANGEOID
+ INT4MULTIRANGEOID
+ NUMMULTIRANGEOID
+ TSMULTIRANGEOID
+ TSTZMULTIRANGEOID
+ DATEMULTIRANGEOID
+ INT8MULTIRANGEOID
+ RECORDOID
+ RECORDARRAYOID
+ CSTRINGOID
+ VOIDOID
+ TRIGGEROID
+ EVENT_TRIGGEROID
+ BOOLARRAYOID
+ BYTEAARRAYOID
+ CHARARRAYOID
+ NAMEARRAYOID
+ INT8ARRAYOID
+ INT2ARRAYOID
+ INT2VECTORARRAYOID
+ INT4ARRAYOID
+ TEXTARRAYOID
+ OIDARRAYOID
+ TIDARRAYOID
+ XIDARRAYOID
+ CIDARRAYOID
+ OIDVECTORARRAYOID
+ JSONARRAYOID
+ XMLARRAYOID
+ XID8ARRAYOID
+ POINTARRAYOID
+ LSEGARRAYOID
+ PATHARRAYOID
+ BOXARRAYOID
+ POLYGONARRAYOID
+ LINEARRAYOID
+ FLOAT4ARRAYOID
+ FLOAT8ARRAYOID
+ CIRCLEARRAYOID
+ MONEYARRAYOID
+ MACADDRARRAYOID
+ INETARRAYOID
+ CIDRARRAYOID
+ MACADDR8ARRAYOID
+ ACLITEMARRAYOID
+ BPCHARARRAYOID
+ VARCHARARRAYOID
+ DATEARRAYOID
+ TIMEARRAYOID
+ TIMESTAMPARRAYOID
+ TIMESTAMPTZARRAYOID
+ INTERVALARRAYOID
+ TIMETZARRAYOID
+ BITARRAYOID
+ VARBITARRAYOID
+ NUMERICARRAYOID
+ REFCURSORARRAYOID
+ UUIDARRAYOID
+ TSVECTORARRAYOID
+ GTSVECTORARRAYOID
+ TSQUERYARRAYOID
+ JSONBARRAYOID
+ JSONPATHARRAYOID
+ TXID_SNAPSHOTARRAYOID
+ INT4RANGEARRAYOID
+ NUMRANGEARRAYOID
+ TSRANGEARRAYOID
+ TSTZRANGEARRAYOID
+ DATERANGEARRAYOID
+ INT8RANGEARRAYOID
+ INT4MULTIRANGEARRAYOID
+ NUMMULTIRANGEARRAYOID
+ TSMULTIRANGEARRAYOID
+ TSTZMULTIRANGEARRAYOID
+ DATEMULTIRANGEARRAYOID
+ INT8MULTIRANGEARRAYOID
+ CSTRINGARRAYOID
+
+);
+
+# connection status
+
+use constant {
+ CONNECTION_OK => 0,
+ CONNECTION_BAD => 1,
+ # Non-blocking mode only below here
+
+ CONNECTION_STARTED => 2,
+ CONNECTION_MADE => 3,
+ CONNECTION_AWAITING_RESPONSE => 4,
+ CONNECTION_AUTH_OK => 5,
+ CONNECTION_SETENV => 6,
+ CONNECTION_SSL_STARTUP => 7,
+ CONNECTION_NEEDED => 8,
+ CONNECTION_CHECK_WRITABLE => 9,
+ CONNECTION_CONSUME => 10,
+ CONNECTION_GSS_STARTUP => 11,
+ CONNECTION_CHECK_TARGET => 12,
+ CONNECTION_CHECK_STANDBY => 13,
+};
+
+# exec status
+
+use constant {
+ PGRES_EMPTY_QUERY => 0,
+ PGRES_COMMAND_OK => 1,
+ PGRES_TUPLES_OK => 2,
+ PGRES_COPY_OUT => 3,
+ PGRES_COPY_IN => 4,
+ PGRES_BAD_RESPONSE => 5,
+ PGRES_NONFATAL_ERROR => 6,
+ PGRES_FATAL_ERROR => 7,
+ PGRES_COPY_BOTH => 8,
+ PGRES_SINGLE_TUPLE => 9,
+ PGRES_PIPELINE_SYNC => 10,
+ PGRES_PIPELINE_ABORTED => 11,
+};
+
+# ping status
+
+use constant {
+ PQPING_OK => 0,
+ PQPING_REJECT => 1,
+ PQPING_NO_RESPONSE => 2,
+ PQPING_NO_ATTEMPT => 3,
+};
+
+# txn status
+use constant {
+ PQTRANS_IDLE => 0,
+ PQTRANS_ACTIVE => 1,
+ PQTRANS_INTRANS => 2,
+ PQTRANS_INERROR => 3,
+ PQTRANS_UNKNOWN => 4,
+};
+
+# type oids
+use constant {
+ BOOLOID => 16,
+ BYTEAOID => 17,
+ CHAROID => 18,
+ NAMEOID => 19,
+ INT8OID => 20,
+ INT2OID => 21,
+ INT2VECTOROID => 22,
+ INT4OID => 23,
+ TEXTOID => 25,
+ OIDOID => 26,
+ TIDOID => 27,
+ XIDOID => 28,
+ CIDOID => 29,
+ OIDVECTOROID => 30,
+ JSONOID => 114,
+ XMLOID => 142,
+ XID8OID => 5069,
+ POINTOID => 600,
+ LSEGOID => 601,
+ PATHOID => 602,
+ BOXOID => 603,
+ POLYGONOID => 604,
+ LINEOID => 628,
+ FLOAT4OID => 700,
+ FLOAT8OID => 701,
+ UNKNOWNOID => 705,
+ CIRCLEOID => 718,
+ MONEYOID => 790,
+ MACADDROID => 829,
+ INETOID => 869,
+ CIDROID => 650,
+ MACADDR8OID => 774,
+ ACLITEMOID => 1033,
+ BPCHAROID => 1042,
+ VARCHAROID => 1043,
+ DATEOID => 1082,
+ TIMEOID => 1083,
+ TIMESTAMPOID => 1114,
+ TIMESTAMPTZOID => 1184,
+ INTERVALOID => 1186,
+ TIMETZOID => 1266,
+ BITOID => 1560,
+ VARBITOID => 1562,
+ NUMERICOID => 1700,
+ REFCURSOROID => 1790,
+ UUIDOID => 2950,
+ TSVECTOROID => 3614,
+ GTSVECTOROID => 3642,
+ TSQUERYOID => 3615,
+ JSONBOID => 3802,
+ JSONPATHOID => 4072,
+ TXID_SNAPSHOTOID => 2970,
+ INT4RANGEOID => 3904,
+ NUMRANGEOID => 3906,
+ TSRANGEOID => 3908,
+ TSTZRANGEOID => 3910,
+ DATERANGEOID => 3912,
+ INT8RANGEOID => 3926,
+ INT4MULTIRANGEOID => 4451,
+ NUMMULTIRANGEOID => 4532,
+ TSMULTIRANGEOID => 4533,
+ TSTZMULTIRANGEOID => 4534,
+ DATEMULTIRANGEOID => 4535,
+ INT8MULTIRANGEOID => 4536,
+ RECORDOID => 2249,
+ RECORDARRAYOID => 2287,
+ CSTRINGOID => 2275,
+ VOIDOID => 2278,
+ TRIGGEROID => 2279,
+ EVENT_TRIGGEROID => 3838,
+ BOOLARRAYOID => 1000,
+ BYTEAARRAYOID => 1001,
+ CHARARRAYOID => 1002,
+ NAMEARRAYOID => 1003,
+ INT8ARRAYOID => 1016,
+ INT2ARRAYOID => 1005,
+ INT2VECTORARRAYOID => 1006,
+ INT4ARRAYOID => 1007,
+ TEXTARRAYOID => 1009,
+ OIDARRAYOID => 1028,
+ TIDARRAYOID => 1010,
+ XIDARRAYOID => 1011,
+ CIDARRAYOID => 1012,
+ OIDVECTORARRAYOID => 1013,
+ JSONARRAYOID => 199,
+ XMLARRAYOID => 143,
+ XID8ARRAYOID => 271,
+ POINTARRAYOID => 1017,
+ LSEGARRAYOID => 1018,
+ PATHARRAYOID => 1019,
+ BOXARRAYOID => 1020,
+ POLYGONARRAYOID => 1027,
+ LINEARRAYOID => 629,
+ FLOAT4ARRAYOID => 1021,
+ FLOAT8ARRAYOID => 1022,
+ CIRCLEARRAYOID => 719,
+ MONEYARRAYOID => 791,
+ MACADDRARRAYOID => 1040,
+ INETARRAYOID => 1041,
+ CIDRARRAYOID => 651,
+ MACADDR8ARRAYOID => 775,
+ ACLITEMARRAYOID => 1034,
+ BPCHARARRAYOID => 1014,
+ VARCHARARRAYOID => 1015,
+ DATEARRAYOID => 1182,
+ TIMEARRAYOID => 1183,
+ TIMESTAMPARRAYOID => 1115,
+ TIMESTAMPTZARRAYOID => 1185,
+ INTERVALARRAYOID => 1187,
+ TIMETZARRAYOID => 1270,
+ BITARRAYOID => 1561,
+ VARBITARRAYOID => 1563,
+ NUMERICARRAYOID => 1231,
+ REFCURSORARRAYOID => 2201,
+ UUIDARRAYOID => 2951,
+ TSVECTORARRAYOID => 3643,
+ GTSVECTORARRAYOID => 3644,
+ TSQUERYARRAYOID => 3645,
+ JSONBARRAYOID => 3807,
+ JSONPATHARRAYOID => 4073,
+ TXID_SNAPSHOTARRAYOID => 2949,
+ INT4RANGEARRAYOID => 3905,
+ NUMRANGEARRAYOID => 3907,
+ TSRANGEARRAYOID => 3909,
+ TSTZRANGEARRAYOID => 3911,
+ DATERANGEARRAYOID => 3913,
+ INT8RANGEARRAYOID => 3927,
+ INT4MULTIRANGEARRAYOID => 6150,
+ NUMMULTIRANGEARRAYOID => 6151,
+ TSMULTIRANGEARRAYOID => 6152,
+ TSTZMULTIRANGEARRAYOID => 6153,
+ DATEMULTIRANGEARRAYOID => 6155,
+ INT8MULTIRANGEARRAYOID => 6157,
+ CSTRINGARRAYOID => 1263,
+};
+
+
+
+my @procs = qw(
+
+ PQconnectdb
+ PQconnectdbParams
+ PQsetdbLogin
+ PQfinish
+ PQreset
+ PQdb
+ PQuser
+ PQpass
+ PQhost
+ PQhostaddr
+ PQport
+ PQtty
+ PQoptions
+ PQstatus
+ PQtransactionStatus
+ PQparameterStatus
+ PQping
+ PQpingParams
+
+ PQexec
+ PQexecParams
+ PQprepare
+ PQexecPrepared
+
+ PQdescribePrepared
+ PQdescribePortal
+
+ PQclosePrepared
+ PQclosePortal
+ PQclear
+
+ PQprotocolVersion
+ PQserverVersion
+ PQerrorMessage
+ PQsocket
+ PQbackendPID
+ PQconnectionNeedsPassword
+ PQconnectionUsedPassword
+ PQconnectionUsedGSSAPI
+ PQclientEncoding
+ PQsetClientEncoding
+
+ PQresultStatus
+ PQresStatus
+ PQresultErrorMessage
+ PQresultErrorField
+ PQntuples
+ PQnfields
+ PQbinaryTuples
+ PQfname
+ PQfnumber
+ PQftable
+ PQftablecol
+ PQfformat
+ PQftype
+ PQfsize
+ PQfmod
+ PQcmdStatus
+ PQoidValue
+ PQcmdTuples
+ PQgetvalue
+ PQgetlength
+ PQgetisnull
+ PQnparams
+ PQparamtype
+
+);
+
+push(@EXPORT, @procs);
+
+sub setup
+{
+ my $libdir = shift;
+
+ my $ffi = FFI::Platypus->new(api => 1);
+
+ $ffi->type('opaque' => 'PGconn');
+ $ffi->type('opaque' => 'PGresult');
+ $ffi->type('uint32' => 'Oid');
+ $ffi->type('int' => 'ExecStatusType');
+
+ my $lib = find_lib_or_die(
+ lib => 'pq',
+ libpath => [$libdir],
+ systempath => [],);
+ $ffi->lib($lib);
+
+ $ffi->attach('PQconnectdb' => ['string'] => 'PGconn');
+ $ffi->attach(
+ 'PQconnectdbParams' => [ 'string[]', 'string[]', 'int' ] => 'PGconn');
+ $ffi->attach(
+ 'PQsetdbLogin' => [
+ 'string', 'string', 'string', 'string',
+ 'string', 'string', 'string',
+ ] => 'PGconn');
+ $ffi->attach('PQfinish' => ['PGconn'] => 'void');
+ $ffi->attach('PQreset' => ['PGconn'] => 'void');
+ $ffi->attach('PQdb' => ['PGconn'] => 'string');
+ $ffi->attach('PQuser' => ['PGconn'] => 'string');
+ $ffi->attach('PQpass' => ['PGconn'] => 'string');
+ $ffi->attach('PQhost' => ['PGconn'] => 'string');
+ $ffi->attach('PQhostaddr' => ['PGconn'] => 'string');
+ $ffi->attach('PQport' => ['PGconn'] => 'string');
+ $ffi->attach('PQtty' => ['PGconn'] => 'string');
+ $ffi->attach('PQoptions' => ['PGconn'] => 'string');
+ $ffi->attach('PQstatus' => ['PGconn'] => 'int');
+ $ffi->attach('PQtransactionStatus' => ['PGconn'] => 'int');
+ $ffi->attach('PQparameterStatus' => [ 'PGconn', 'string' ] => 'string');
+ $ffi->attach('PQping' => ['string'] => 'int');
+ $ffi->attach(
+ 'PQpingParams' => [ 'string[]', 'string[]', 'int' ] => 'int');
+
+ $ffi->attach('PQprotocolVersion' => ['PGconn'] => 'int');
+ $ffi->attach('PQserverVersion' => ['PGconn'] => 'int');
+ $ffi->attach('PQerrorMessage' => ['PGconn'] => 'string');
+ $ffi->attach('PQsocket' => ['PGconn'] => 'int');
+ $ffi->attach('PQbackendPID' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionNeedsPassword' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionUsedPassword' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionUsedGSSAPI' => ['PGconn'] => 'int');
+ $ffi->attach('PQclientEncoding' => ['PGconn'] => 'int');
+ $ffi->attach('PQsetClientEncoding' => [ 'PGconn', 'string' ] => 'int');
+
+ $ffi->attach('PQexec' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach(
+ 'PQexecParams' => [
+ 'PGconn', 'string', 'int', 'int[]',
+ 'string[]', 'int[]', 'int[]', 'int'
+ ] => 'PGresult');
+ $ffi->attach(
+ 'PQprepare' => [ 'PGconn', 'string', 'string', 'int', 'int[]' ] =>
+ 'PGresult');
+ $ffi->attach(
+ 'PQexecPrepared' => [ 'PGconn', 'string', 'int',
+ 'string[]', 'int[]', 'int[]', 'int' ] => 'PGresult');
+
+ $ffi->attach('PQresultStatus' => ['PGresult'] => 'ExecStatusType');
+ $ffi->attach('PQresStatus' => ['ExecStatusType'] => 'string');
+ $ffi->attach('PQresultErrorMessage' => ['PGresult'] => 'string');
+ $ffi->attach('PQresultErrorField' => [ 'PGresult', 'int' ] => 'string');
+ $ffi->attach('PQntuples' => ['PGresult'] => 'int');
+ $ffi->attach('PQnfields' => ['PGresult'] => 'int');
+ $ffi->attach('PQbinaryTuples' => ['PGresult'] => 'int');
+ $ffi->attach('PQfname' => [ 'PGresult', 'int' ] => 'string');
+ $ffi->attach('PQfnumber' => [ 'PGresult', 'string' ] => 'int');
+ $ffi->attach('PQftable' => [ 'PGresult', 'int' ] => 'Oid');
+ $ffi->attach('PQftablecol' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQfformat' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQftype' => [ 'PGresult', 'int' ] => 'Oid');
+ $ffi->attach('PQfsize' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQfmod' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQcmdStatus' => ['PGresult'] => 'string');
+ $ffi->attach('PQoidValue' => ['PGresult'] => 'Oid');
+ $ffi->attach('PQcmdTuples' => ['PGresult'] => 'string');
+ $ffi->attach('PQgetvalue' => [ 'PGresult', 'int', 'int' ] => 'string');
+ $ffi->attach('PQgetlength' => [ 'PGresult', 'int', 'int' ] => 'int');
+ $ffi->attach('PQgetisnull' => [ 'PGresult', 'int', 'int' ] => 'int');
+ $ffi->attach('PQnparams' => ['PGresult'] => 'int');
+ $ffi->attach('PQparamtype' => [ 'PGresult', 'int' ] => 'Oid');
+
+
+ $ffi->attach(
+ 'PQdescribePrepared' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQdescribePortal' => [ 'PGconn', 'string' ] => 'PGresult');
+
+ $ffi->attach('PQclosePrepared' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQclosePortal' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQclear' => ['PGresult'] => 'void');
+}
+
+
+1;
diff --git a/src/test/perl/PostgreSQL/Test/Session.pm b/src/test/perl/PostgreSQL/Test/Session.pm
new file mode 100644
index 0000000000..74443a9ee5
--- /dev/null
+++ b/src/test/perl/PostgreSQL/Test/Session.pm
@@ -0,0 +1,143 @@
+package PostgreSQL::Test::Session;
+
+use strict;
+use warnings FATAL => 'all';
+
+
+use PostgreSQL::PqFFI;
+
+my $setup_ok;
+
+sub setup
+{
+ return if $setup_ok;
+ my $libdir = shift;
+ PostgreSQL::PqFFI::setup($libdir);
+ $setup_ok = 1;
+}
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless $self, $class;
+ my %args = @_;
+ my $node = $args{node};
+ my $dbname = $args{dbname} || 'postgres';
+ die "bad node" unless $node->isa("PostgreSQL::Test::Cluster");
+ unless ($setup_ok)
+ {
+ my $libdir = $node->config_data('--libdir');
+ setup($libdir);
+ }
+ $self->{connstr} = $node->connstr($dbname);
+ $self->{conn} = PQconnectdb($self->{connstr});
+ return $self;
+}
+
+sub close
+{
+ my $self = shift;
+ PQfinish($self->{conn});
+ delete $self->{conn};
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ $self->close if $self->{conn};
+}
+
+sub reconnect
+{
+ my $self = shift;
+ $self->close if $self->{conn};
+ $self->{conn} = PQconnectdb($self->{connstr});
+}
+
+# run some sql which doesn't return tuples
+
+sub do
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ foreach my $sql (@_)
+ {
+ my $result = PQexec($conn, $sql);
+ my $ok = $result && (PQresultStatus($result) == PGRES_COMMAND_OK);
+ PQclear($result);
+ return undef unless $ok;
+ }
+ return 1;
+}
+
+# run some sql that does return tuples
+
+sub query
+{
+ my $self = shift;
+ my $sql = shift;
+ my $conn = $self->{conn};
+ my $result = PQexec($conn, $sql);
+ my $ok = $result && (PQresultStatus($result) == PGRES_TUPLES_OK);
+ unless ($ok)
+ {
+ PQclear($result);
+ return undef;
+ }
+ my $ntuples = PQntuples($result);
+ my $nfields = PQnfields($result);
+ my $res = { names => [], types => [], rows => [], };
+ # assuming here that the strings returned by PQfname and PQgetvalue
+ # are mapped into perl space using setsvpv or similar and thus won't
+ # be affect by us calling PQclear on the result object.
+ foreach my $field (0 .. $nfields-1)
+ {
+ push(@{$res->{names}}, PQfname($result, $field));
+ push(@{$res->{types}}, PQftype($result, $field));
+ }
+ foreach my $nrow (0.. $ntuples - 1)
+ {
+ my $row = [];
+ foreach my $field ( 0 .. $nfields)
+ {
+ my $val = PQgetvalue($result, $nrow, $field);
+ if (($val // "") eq "")
+ {
+ $val = undef if PQgetisnull($result, $nrow, $field);
+ }
+ push(@$row, $val);
+ }
+ push(@{$res->{rows}}, $row);
+ }
+ PQclear($result);
+ return $res;
+}
+
+sub query_oneval
+{
+ my $self = shift;
+ my $sql = shift;
+ my $conn = $self->{conn};
+ my $result = PQexec($conn, $sql);
+ my $ok = $result && (PQresultStatus($result) == PGRES_TUPLES_OK);
+ unless ($ok)
+ {
+ PQclear($result);
+ return undef;
+ }
+ my $ntuples = PQntuples($result);
+ my $nfields = PQnfields($result);
+ die "$ntuples tuples != 1 or $nfields fields != 1"
+ if $ntuples != 1 || $nfields != 1;
+ my $val = PQgetvalue($result, 0, 0);
+ if ($val eq "")
+ {
+ $val = undef if PGgetisnull($result, 0, 0);
+ }
+ PQclear($result);
+ return $val;
+
+}
+
+1;
