use v5.36; use Test::More; plan skip_all => $@ if !eval { require FU::Pg; } && $@ =~ /Unable to load libpq/; die $@ if $@; plan skip_all => 'Please set FU_TEST_DB to a PostgreSQL connection string to run these tests' if !$ENV{FU_TEST_DB}; sub okerr($sev, $act, $msg) { is ref $@, 'FU::Pg::error'; is $@->{severity}, $sev; is $@->{action}, $act; like "$@", $msg; } ok !eval { FU::Pg->connect("invalid") }; okerr FATAL => connect => qr/missing "=" after "invalid"/; ok FU::Pg::lib_version() > 100000; my $conn = FU::Pg->connect($ENV{FU_TEST_DB})->text->cache(0); $conn->_debug_trace(0); is ref $conn, 'FU::Pg::conn'; ok $conn->server_version > 100000; is $conn->lib_version, FU::Pg::lib_version(); is $conn->status, 'idle'; subtest '$conn->exec', sub { ok !eval { $conn->exec('COPY (SELECT 1) TO STDOUT'); }; okerr FATAL => exec => qr/unexpected status code/; ok !eval { $conn->exec('SELEXT'); }; okerr ERROR => exec => qr/syntax error/; ok !defined $conn->exec(''); is $conn->exec('SELECT 1'), 1; ok !eval { $conn->q('SELEXT')->param_types; }; okerr ERROR => prepare => qr/syntax error/; is $conn->exec('SET client_encoding=utf8'), undef; }; subtest '$st prepare & exec', sub { { my $st = $conn->q('SELECT 1'); is_deeply $st->param_types, []; is_deeply $st->columns, [{ name => '?column?', oid => 23 }]; ok !eval { $st->cache; 1 }; like $@, qr/Invalid attempt to change statement configuration/; $st = $st->text; is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 1; is $st->exec, 1; ok !eval { $st->exec; 1 }; like $@, qr/Invalid attempt to execute statement multiple times/; } { my $st = $conn->q("SELECT \$1::int AS a, \$2::char(5) AS \"\x{1F603}\"", 1, 2); is_deeply $st->param_types, [ 23, 1042 ]; is_deeply $st->columns, [ { oid => 23, name => 'a' }, { oid => 1042, name => "\x{1F603}", typemod => 9 }, ]; is $st->exec, 1; } is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0; ok !eval { $conn->q('SELECT 1', 1)->exec; 1 }; like $@, qr/Statement expects 0 bind parameters but 1 were given/; ok !eval { $conn->q('SELECT $1')->exec; 1 }; like $@, qr/Statement expects 1 bind parameters but 0 were given/; # prepare + describe won't let us detect empty queries, hmm... is_deeply $conn->q('')->param_types, []; is_deeply $conn->q('')->columns, []; ok !eval { $conn->q('')->exec; 1 }; okerr FATAL => exec => qr/unexpected status code/; is $conn->q('SET client_encoding=utf8')->exec, undef; ok !eval { $conn->q('select 1; select 2')->exec; 1 }; okerr ERROR => prepare => qr/cannot insert multiple commands into a prepared statement/; # Interleaved { my $x = $conn->q('SELECT 1 as a'); my $y = $conn->q('SELECT 2 as b'); is_deeply $x->columns, [ { oid => 23, name => 'a' } ]; is_deeply $y->columns, [ { oid => 23, name => 'b' } ]; is $x->val, 1; is $y->val, 2; } }; subtest '$st->val', sub { ok !eval { $conn->q('SELECT')->val; 1 }; like $@, qr/on query returning no data/; ok !eval { $conn->q('SELECT 1, 2')->val; 1 }; like $@, qr/on query returning more than one column/; ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->val; 1 }; like $@, qr/on query returning more than one row/; ok !defined $conn->q('SELECT 1 WHERE false')->val; ok !defined $conn->q('SELECT null')->val; is $conn->q('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}"; }; subtest '$st->rowl', sub { ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowl; 1 }; like $@, qr/on query returning more than one row/; ok !eval { $conn->q('SELEXT')->rowl; 1; }; is scalar $conn->q('SELECT')->rowl, 0; is scalar $conn->q('SELECT 1, 2')->rowl, 2; is_deeply [$conn->q('SELECT')->rowl], []; is_deeply [$conn->q('SELECT 1, null')->rowl], [1, undef]; is_deeply [$conn->q('SELECT 1, $1', undef)->rowl], [1, undef]; is_deeply [$conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowl], [1, undef]; is_deeply [$conn->q('SELECT 1 WHERE false')->rowl], []; }; subtest '$st->rowa', sub { ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowa; 1 }; like $@, qr/on query returning more than one row/; ok !eval { $conn->q('SELEXT')->rowa; 1; }; is $conn->q('SELECT 1 WHERE false')->rowa, undef; is_deeply $conn->q('SELECT')->rowa, []; is_deeply $conn->q('SELECT 1, 2')->rowa, [1, 2]; is_deeply $conn->q('SELECT 1, null')->rowa, [1, undef]; is_deeply $conn->q('SELECT 1, $1', undef)->rowa, [1, undef]; is_deeply $conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef]; }; subtest '$st->rowh', sub { ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowh; 1 }; like $@, qr/on query returning more than one row/; ok !eval { $conn->q('SELECT 1 as a, 2 as a')->rowh; 1 }; like $@, qr/Query returns multiple columns with the same name/; is $conn->q('SELECT 1 WHERE false')->rowh, undef; is_deeply $conn->q('SELECT')->rowh, {}; is_deeply $conn->q('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2}; is_deeply $conn->q('SELECT 1 as a, null as b')->rowh, {a => 1, b => undef}; is_deeply $conn->q('SELECT 1 as a, $1::int as b', undef)->rowh, {a => 1, b => undef}; }; subtest '$st->alla', sub { is_deeply $conn->q('SELECT 1 WHERE false')->alla, []; is_deeply $conn->q('SELECT')->alla, [[]]; is_deeply $conn->q('SELECT 1')->alla, [[1]]; is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->alla, [[1,undef],[undef,2]]; }; subtest '$st->allh', sub { ok !eval { $conn->q('SELECT 1 as a, 2 as a')->allh; 1 }; like $@, qr/Query returns multiple columns with the same name/; is_deeply $conn->q('SELECT 1 WHERE false')->allh, []; is_deeply $conn->q('SELECT')->allh, [{}]; is_deeply $conn->q('SELECT 1 a')->allh, [{a=>1}]; is_deeply $conn->q('SELECT 1 a, null b UNION ALL SELECT NULL, 2')->allh, [{a=>1,b=>undef},{a=>undef,b=>2}]; }; subtest '$st->flat', sub { is_deeply $conn->q('SELECT 1 WHERE false')->flat, []; is_deeply $conn->q('SELECT')->flat, []; is_deeply $conn->q('SELECT 1')->flat, [1]; is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->flat, [1,undef,undef,2]; }; subtest '$st->kvv', sub { ok !eval { $conn->q('SELECT')->kvv; 1; }; like $@, qr/returning no data/; ok !eval { $conn->q('SELECT 1, 2, 3')->kvv; 1; }; like $@, qr/returning more than two columns/; ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvv; 1; }; like $@, qr/is duplicated/; is_deeply $conn->q('SELECT 1 WHERE false')->kvv, {}; is_deeply $conn->q('SELECT 1')->kvv, {1=>1}; is_deeply $conn->q('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2}; }; subtest '$st->kva', sub { ok !eval { $conn->q('SELECT')->kva; 1; }; like $@, qr/returning no data/; ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kva; 1; }; like $@, qr/is duplicated/; is_deeply $conn->q('SELECT 1 WHERE false')->kva, {}; is_deeply $conn->q('SELECT 1')->kva, {1=>[]}; is_deeply $conn->q("SELECT 1, null, 'hi' UNION ALL SELECT 3, 2, 'ok'")->kva, {1=>[undef,'hi'], 3=>[2, 'ok']}; }; subtest '$st->kvh', sub { ok !eval { $conn->q('SELECT')->kvh; 1; }; like $@, qr/returning no data/; ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvh; 1; }; like $@, qr/is duplicated/; ok !eval { $conn->q('SELECT 1, 2, 3')->kvh; 1; }; like $@, qr/Query returns multiple columns with the same name/; is_deeply $conn->q('SELECT 1 WHERE false')->kvh, {}; is_deeply $conn->q('SELECT 1')->kvh, {1=>{}}; is_deeply $conn->q("SELECT 1 as a , null as a, 'hi' as b UNION ALL SELECT 3, 2, 'ok'")->kvh, {1=>{a=>undef,b=>'hi'}, 3=>{a=>2,b=>'ok'}}; }; subtest 'txn', sub { $conn->exec('CREATE TEMPORARY TABLE fupg_tst (id int)'); $conn->txn->exec('INSERT INTO fupg_tst VALUES (1)'); # rolled back is $conn->q('SELECT COUNT(*) FROM fupg_tst')->val, 0; my $st = $conn->q('SELECT COUNT(*) FROM fupg_tst'); my $sst; { my $txn = $conn->txn; is $conn->status, 'txn_idle'; is $txn->status, 'idle'; ok !eval { $st->exec; 1 }; like $@, qr/Invalid cross-transaction/; ok !eval { $conn->exec('SELECT 1'); 1 }; like $@, qr/Invalid operation on the top-level connection/; ok !eval { $conn->q('SELECT 1'); 1 }; like $@, qr/Invalid operation on the top-level connection/; ok !eval { $conn->txn; 1 }; like $@, qr/Invalid operation on the top-level connection/; $txn->exec('INSERT INTO fupg_tst VALUES (1)'); $sst = $txn->q('SELECT 1'); is $conn->status, 'txn_idle'; is $txn->status, 'idle'; $txn->commit; is $conn->status, 'txn_done'; is $txn->status, 'done'; ok !eval { $txn->rollback; 1 }; like $@, qr/Invalid operation on a transaction that has already been marked as done/; ok !eval { $txn->commit; 1 }; like $@, qr/Invalid operation on a transaction that has already been marked as done/; ok !eval { $txn->txn; 1 }; like $@, qr/Invalid operation on a transaction that has already been marked as done/; ok !eval { $txn->exec('select 1'); 1 }; like $@, qr/Invalid operation on a transaction that has already been marked as done/; ok !eval { $txn->q('select 1'); 1 }; like $@, qr/Invalid operation on a transaction that has already been marked as done/; ok !eval { $conn->exec('SELECT 1'); 1 }; like $@, qr/Invalid operation on the top-level connection/; } is $conn->status, 'idle'; is $st->val, 1; ok !eval { $sst->exec; 1 }; like $@, qr/Invalid cross-transaction/; { my $txn = $conn->txn; ok !eval { $txn->exec('SELEXT'); 1 }; # puts txn in error state is $conn->status, 'txn_error'; is $txn->status, 'error'; ok !eval { $txn->exec('SELECT 1'); 1 }; like $@, qr/current transaction is aborted/; $txn->rollback; is $conn->status, 'txn_done'; is $txn->status, 'done'; } ok $conn->exec('SELECT 1'); { my $txn = $conn->txn; my $st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2'); { my $sub = $txn->txn; is $conn->status, 'txn_idle'; is $txn->status, 'txn_idle'; is $sub->status, 'idle'; $sub->exec('INSERT INTO fupg_tst VALUES (2)'); ok !eval { $sub->exec('SELEXT'); 1 }; ok !eval { $txn->rollback; 1 }; like $@, qr/Invalid operation on transaction/; is $conn->status, 'txn_error'; is $txn->status, 'txn_error'; is $sub->status, 'error'; } is $conn->status, 'txn_idle'; is $txn->status, 'idle'; is $st->val, 0; $st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2'); { my $sub = $txn->txn; $sub->exec('INSERT INTO fupg_tst VALUES (2)'); $sub->commit; is $conn->status, 'txn_idle'; is $txn->status, 'txn_idle'; # No way to tell that it's actually done is $sub->status, 'done'; } is $st->val, 1; } is $conn->status, 'idle'; { my $txn = $conn->txn; my $sub = $txn->txn; undef $txn; # sub keeps a ref on $txn is $sub->status, 'idle'; is $conn->status, 'txn_idle'; $sub->exec('INSERT INTO fupg_tst VALUES (3)'); $sub->commit; } # We didn't commit $txn, so $sub got aborted as well is $conn->q('SELECT count(*) FROM fupg_tst WHERE id = 3')->val, 0; }; { local $_ = 'x'; my $st = $conn->q('SELECT $1', $_); $_ = 'y'; is $st->val, 'x', 'shallow copy'; } { my $x = [1,2]; my $st = $conn->q('SELECT $1::int[]', $x)->text(0); $x->[1] = 3; is_deeply $st->val, [1,3], 'not deep copy'; } subtest 'Prepared statement cache', sub { my $txn = $conn->cache_size(2)->txn->cache; my sub numexec($sql) { $txn->q('SELECT generic_plans + custom_plans FROM pg_prepared_statements WHERE statement = $1', $sql)->cache(0)->val } is $txn->q('SELECT 1')->val, 1; is numexec('SELECT 1'), 1; my $sql = 'SELECT $1::int as a, $2::text as b'; ok !defined numexec($sql); my $params = $txn->q($sql)->param_types; is_deeply $params, [23, 25]; is numexec($sql), 0; my $cparams = $txn->q($sql)->param_types; is_deeply $cparams, $params; my $cols = $txn->q($sql)->columns; is_deeply $cols, [{ name => 'a', oid => 23 }, { name => 'b', oid => 25 }]; my $ccols = $txn->q($sql)->columns; is_deeply $ccols, $cols; $txn->q($sql, 0, '')->exec; is numexec($sql), 1; $txn->q($sql, 0, '')->exec; is numexec($sql), 2; is numexec('SELECT 1'), 1; $txn->q('SELECT 2')->exec; ok !defined numexec('SELECT 1'); is numexec('SELECT 2'), 1; $conn->cache_size(1); ok !defined numexec('SELECT 1'); ok !defined numexec($sql); is numexec('SELECT 2'), 1; $conn->cache_size(0); ok !defined numexec($sql); ok !defined numexec('SELECT 2'); }; subtest 'Tracing', sub { my @log; $conn->query_trace(sub($st) { push @log, $st }); is_deeply $conn->q('SELECT 1 AS a, $1 AS b', 123)->rowa, [ 1, 123 ]; is scalar @log, 1; my $st = shift @log; is ref $st, 'FU::Pg::st'; is_deeply $st->param_types, [ 25 ]; is_deeply $st->param_values, [ 123 ]; is_deeply $st->columns, [{ name => 'a', oid => 23 }, { name => 'b', oid => 25 }]; is $st->nrows, 1; is $st->query, 'SELECT 1 AS a, $1 AS b'; ok $st->exec_time > 0 && $st->exec_time < 1; ok $st->prepare_time > 0 && $st->prepare_time < 1; ok !$st->get_cache; ok $st->text_params; ok $st->text_results; $conn->exec('SET client_encoding=UTF8'); is scalar @log, 1; $st = shift @log; is ref $st, 'FU::Pg::st'; is_deeply $st->param_types, []; is_deeply $st->param_values, []; is_deeply $st->columns, []; is $st->nrows, 0; is $st->query, 'SET client_encoding=UTF8'; ok $st->exec_time > 0 && $st->exec_time < 1; ok !defined $st->prepare_time; ok !$st->get_cache; ok $st->text_params; ok $st->text_results; $conn->query_trace(undef); $conn->exec('SELECT 1'); is scalar @log, 0; }; { my $st = $conn->q("SELECT 1"); undef $conn; # statement keeps the connection alive is $st->val, 1; } done_testing;