From 9d5905e3b4fa28b99fa658acf67f745bf373ae74 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Thu, 6 Feb 2025 11:36:08 +0100 Subject: [PATCH] pg: Add a few result fetching methods I'm not sure if these are free from memory leaks, need to find a way to test for that. --- FU.xs | 16 ++++++++ FU/PG.pm | 42 ++++++++++++++++++++- c/libpq.h | 4 ++ c/pgconn.c | 81 ++++++++++++++++++++++++++++++++++++++++ t/pgconnect.t | 101 ++++++++++++++++++++++++++++++++++++++++---------- 5 files changed, 223 insertions(+), 21 deletions(-) diff --git a/FU.xs b/FU.xs index 251891b..4883bc0 100644 --- a/FU.xs +++ b/FU.xs @@ -107,6 +107,22 @@ void exec(fupg_st *st) CODE: ST(0) = fupg_st_exec(aTHX_ st); +void val(fupg_st *st) + CODE: + ST(0) = fupg_st_val(aTHX_ st); + +void rowl(fupg_st *st) + CODE: + XSRETURN(fupg_st_rowl(aTHX_ st, ax)); + +void rowa(fupg_st *st) + CODE: + ST(0) = fupg_st_rowa(aTHX_ st); + +void rowh(fupg_st *st) + CODE: + ST(0) = fupg_st_rowh(aTHX_ st); + void DESTROY(fupg_st *st) CODE: fupg_st_destroy(st); diff --git a/FU/PG.pm b/FU/PG.pm index 5d6ab01..5d4843e 100644 --- a/FU/PG.pm +++ b/FU/PG.pm @@ -108,7 +108,8 @@ used. =back -Statement objects returned by C<< $conn->q() >> support the following methods: +Statement objects returned by C<< $conn->q() >> can be inspected with the +following two methods: =over @@ -137,6 +138,40 @@ returns. # { name => 'title', oid => 25 }, # ] + +=back + +The statement can be executed with one of the following methods, depending on +how you'd like to obtain the results: + +=over + +=item B<< $st->exec >> + +Execute the query and return the number of rows affected. Similar to C<< +$conn->exec >>. + +=item B<< $st->val >> + +Return the first column of the first row. Throws an error if the query does not +return exactly one column, or if multiple rows are returned. Returns I +if no rows are returned or if its value is I. + +=item B<< $st->rowl >> + +Return the first row as a list. Throws an error if the query does not return +exactly one row. + +=item B<< $st->rowa >> + +Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but +probably slightly more efficient. + +=item B<< $st->rowh >> + +Return the first row as a hashref. Also throws an error if the query returns +multiple columns with the same name. + =back =head2 Transactions @@ -194,4 +229,9 @@ A thin wrapper around libpq. Lacks many higher-level conveniences and does not support binary transfers (at the time of writing, but then again there's little benefit in dealing with the binary format in pure perl anyway). +=item L + +A popular DBI wrapper with some API conveniences. I may have taken some +inspiration from it in the design of this module's API. + =back diff --git a/c/libpq.h b/c/libpq.h index 9dde49e..ed71002 100644 --- a/c/libpq.h +++ b/c/libpq.h @@ -47,9 +47,13 @@ typedef enum { PQSHOW_CONTEXT_NEVER, PQSHOW_CONTEXT_ERRORS, PQSHOW_CONTEXT_ALWAY X(PQfname, char *, const PGresult *, int) \ X(PQfreemem, void, void *) \ X(PQftype, Oid, const PGresult *, int) \ + X(PQgetisnull, int, const PGresult *, int, int) \ + X(PQgetlength, int, const PGresult *, int, int) \ + X(PQgetvalue, char *, const PGresult *, int, int) \ X(PQlibVersion, int, void) \ X(PQnfields, int, const PGresult *) \ X(PQnparams, int, const PGresult *) \ + X(PQntuples, int, const PGresult *) \ X(PQparamtype, Oid, const PGresult *, int) \ X(PQprepare, PGresult *, PGconn *, const char *, const char *, int, const Oid *) \ X(PQresStatus, char *, ExecStatusType) \ diff --git a/c/pgconn.c b/c/pgconn.c index a291236..89e0a6c 100644 --- a/c/pgconn.c +++ b/c/pgconn.c @@ -112,6 +112,13 @@ static SV *fupg_exec(pTHX_ fupg_conn *c, const char *sql) { return ret; } +/* Read a Perl value from a PGresult. + * Currently assumes text format and just creates a PV. */ +static SV *fupg_val(pTHX_ const PGresult *r, int row, int col) { + if (PQgetisnull(r, row, col)) return newSV(0); + return newSVpvn_utf8(PQgetvalue(r, row, col), PQgetlength(r, row, col), 1); +} + typedef struct { /* Set in $conn->q() */ SV *self; @@ -199,6 +206,21 @@ static SV *fupg_st_columns(pTHX_ fupg_st *st) { return sv_2mortal(newRV_noinc((SV *)av)); } +static void fupg_st_check_dupcols(pTHX_ PGresult *r) { + HV *hv = newHV(); + int i, nfields = PQnfields(r); + for (i=0; iresult); } +static SV *fupg_st_val(pTHX_ fupg_st *st) { + fupg_st_prepare(aTHX_ st); + if (PQnfields(st->describe) > 1) croak("Invalid use of $st->val() on query returning more than one column"); + if (PQnfields(st->describe) == 0) croak("Invalid use of $st->val() on query returning no data"); + fupg_st_execute(aTHX_ st); + if (PQntuples(st->result) > 1) croak("Invalid use of $st->val() on query returning more than one row"); + SV *sv = PQntuples(st->result) == 0 ? newSV(0) : fupg_val(aTHX_ st->result, 0, 0); + return sv_2mortal(sv); +} + +static I32 fupg_st_rowl(pTHX_ fupg_st *st, I32 ax) { + dSP; + fupg_st_execute(aTHX_ st); + if (PQntuples(st->result) == 0) croak("Invalid use of $st->rowl() on query returning zero rows"); + if (PQntuples(st->result) > 1) croak("Invalid use of $st->rowl() on query returning more than one row"); + if (GIMME_V != G_LIST) { + ST(0) = sv_2mortal(newSViv(PQnfields(st->result))); + return 1; + } + int i, nfields = PQnfields(st->result); + (void)POPs; + EXTEND(SP, nfields); + for (i=0; iresult, 0, i)); + return nfields; +} + +static SV *fupg_st_rowa(pTHX_ fupg_st *st) { + fupg_st_execute(aTHX_ st); + if (PQntuples(st->result) == 0) croak("Invalid use of $st->rowl() on query returning zero rows"); + if (PQntuples(st->result) > 1) croak("Invalid use of $st->rowl() on query returning more than one row"); + int i, nfields = PQnfields(st->result); + AV *av = newAV_alloc_x(nfields); + SV *sv = sv_2mortal(newRV_noinc((SV *)av)); + for (i=0; iresult, 0, i)); + return sv; +} + +static SV *fupg_st_rowh(pTHX_ fupg_st *st) { + fupg_st_prepare(aTHX_ st); + fupg_st_check_dupcols(aTHX_ st->describe); + fupg_st_execute(aTHX_ st); + if (PQntuples(st->result) == 0) croak("Invalid use of $st->rowh() on query returning zero rows"); + if (PQntuples(st->result) > 1) croak("Invalid use of $st->rowh() on query returning more than one row"); + int i, nfields = PQnfields(st->result); + HV *hv = newHV(); + SV *sv = sv_2mortal(newRV_noinc((SV *)hv)); + for (i=0; iresult, i); + hv_store(hv, key, -strlen(key), fupg_val(aTHX_ st->result, 0, i), 0); + } + return sv; +} + static void fupg_st_destroy(fupg_st *st) { int i; /* Ignore failure, this is just a best-effort attempt to free up resources on the backend */ @@ -255,3 +330,9 @@ static void fupg_st_destroy(fupg_st *st) { SvREFCNT_dec(st->conn->self); safefree(st); } + + +/* TODO: $st->alla, allh, flat, kvv, kva, kvh */ +/* TODO: Prepared statement caching */ +/* TODO: Transactions */ +/* TODO: Binary format fetching & type handling */ diff --git a/t/pgconnect.t b/t/pgconnect.t index 507d8b8..033e5a9 100644 --- a/t/pgconnect.t +++ b/t/pgconnect.t @@ -23,33 +23,94 @@ is ref $conn, 'FU::PG::conn'; ok $conn->server_version > 100000; is $conn->lib_version, FU::PG::lib_version(); -ok !eval { $conn->exec('COPY (SELECT 1) TO STDOUT'); }; -okerr FATAL => exec => qr/unexpected status code/; +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 !eval { $conn->exec('SELEXT'); }; + okerr ERROR => exec => qr/syntax error/; -ok !defined $conn->exec(''); -is $conn->exec('SELECT 1'), 1; + ok !defined $conn->exec(''); + is $conn->exec('SELECT 1'), 1; -ok !eval { $conn->q('SELEXT')->params; }; -okerr ERROR => prepare => qr/syntax error/; + ok !eval { $conn->q('SELEXT')->params; }; + okerr ERROR => prepare => qr/syntax error/; +}; -{ - my $st = $conn->q('SELECT 1'); - is_deeply $st->params, []; - is_deeply $st->columns, [{ name => '?column?', oid => 23 }]; - is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 1; - is $st->exec, 1; -} -is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0; +subtest '$st prepare & exec', sub { + { + my $st = $conn->q('SELECT 1'); + is_deeply $st->params, []; + is_deeply $st->columns, [{ name => '?column?', oid => 23 }]; + is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 1; + is $st->exec, 1; + } -ok !eval { $conn->q('SELECT 1', 1)->exec; 1 }; -okerr ERROR => exec => qr/bind message supplies 1 parameters, but prepared statement/; + is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0; -ok !eval { $conn->q('SELECT $1')->exec; 1 }; -okerr ERROR => exec => qr/bind message supplies 0 parameters, but prepared statement/; + ok !eval { $conn->q('SELECT 1', 1)->exec; 1 }; + okerr ERROR => exec => qr/bind message supplies 1 parameters, but prepared statement/; + + ok !eval { $conn->q('SELECT $1')->exec; 1 }; + okerr ERROR => exec => qr/bind message supplies 0 parameters, but prepared statement/; +}; + +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 WHERE false')->rowl; 1 }; + like $@, qr/on query returning zero rows/; + + 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, 2')->rowl], [1, 2]; +}; + +subtest '$st->rowa', sub { + ok !eval { $conn->q('SELECT 1 WHERE false')->rowa; 1 }; + like $@, qr/on query returning zero rows/; + + 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_deeply $conn->q('SELECT')->rowa, []; + is_deeply $conn->q('SELECT 1, 2')->rowa, [1, 2]; +}; + +subtest '$st->rowh', sub { + ok !eval { $conn->q('SELECT 1 WHERE false')->rowh; 1 }; + like $@, qr/on query returning zero rows/; + + 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/; + + ok !eval { $conn->q('SELEXT')->rowh; 1; }; + is_deeply $conn->q('SELECT')->rowh, {}; + is_deeply $conn->q('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2}; +}; { my $st = $conn->q("SELECT \$1::int AS a, \$2::char(5) AS \"\x{1F603}\"");