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

@@ -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);

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<undef>
+if no rows are returned or if its value is I<NULL>.
+
+=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<DBIx::Simple>
+
+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

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) \

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; i<nfields; i++) {
+        const char *key = PQfname(r, i);
+        int len = -strlen(key);
+        if (hv_exists(hv, key, len)) {
+            SvREFCNT_dec((SV *)hv);
+            croak("Query returns multiple columns with the same name ('%s')", key);
+        }
+        hv_store(hv, key, len, &PL_sv_yes, 0);
+    }
+    SvREFCNT_dec((SV *)hv);
+}
+
 static void fupg_st_execute(pTHX_ fupg_st *st) {
     /* Disallow fetching the results more than once. I don't see a reason why
      * someone would need that and disallowing it leaves room for fetching the
@@ -240,6 +262,59 @@ static SV *fupg_st_exec(pTHX_ fupg_st *st) {
     return fupg_exec_result(st->result);
 }
 
+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; i<nfields; i++) mPUSHs(fupg_val(aTHX_ st->result, 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; i<nfields; i++) av_push_simple(av, fupg_val(aTHX_ st->result, 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; i<nfields; i++) {
+        const char *key = PQfname(st->result, 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 */

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'); };
+subtest '$conn->exec', sub {
-okerr FATAL => exec => qr/unexpected status code/;
+    ok !eval { $conn->exec('COPY (SELECT 1) TO STDOUT'); };
+    okerr FATAL => exec => qr/unexpected status code/;
 
-ok !eval { $conn->exec('SELEXT'); };
+    ok !eval { $conn->exec('SELEXT'); };
-okerr ERROR => exec => qr/syntax error/;
+    okerr ERROR => exec => qr/syntax error/;
 
-ok !defined $conn->exec('');
+    ok !defined $conn->exec('');
-is $conn->exec('SELECT 1'), 1;
+    is $conn->exec('SELECT 1'), 1;
 
-ok !eval { $conn->q('SELEXT')->params; };
+    ok !eval { $conn->q('SELEXT')->params; };
-okerr ERROR => prepare => qr/syntax error/;
+    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 };
+    is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0;
-okerr ERROR => exec => qr/bind message supplies 1 parameters, but prepared statement/;
 
-ok !eval { $conn->q('SELECT $1')->exec; 1 };
+    ok !eval { $conn->q('SELECT 1', 1)->exec; 1 };
-okerr ERROR => exec => qr/bind message supplies 0 parameters, but prepared statement/;
+    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}\"");