From 76f55f277bd94155827ce6dcf23566f15128bab8 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Wed, 30 Apr 2025 20:02:12 +0200
Subject: [PATCH] Pg: Add text2bin() and bin2text() conversion methods

---
 FU.xs       |  8 ++++++++
 FU/Pg.pm    | 19 +++++++++++++++++--
 c/pgconn.c  | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 t/pgtypes.t | 19 ++++++++++++++++++-
 4 files changed, 93 insertions(+), 3 deletions(-)

diff --git a/FU.xs b/FU.xs
index 68082a5..1c342be 100644
--- a/FU.xs
+++ b/FU.xs
@@ -294,6 +294,14 @@ void bin2perl(fupg_conn *c, int oid, SV *sv)
   CODE:
     ST(0) = fupg_bin2perl(aTHX_ c, oid, sv);
 
+void bin2text(fupg_conn *c, ...)
+  CODE:
+    XSRETURN(fupg_bintext(aTHX_ c, 0, ax, items));
+
+void text2bin(fupg_conn *c, ...)
+  CODE:
+    XSRETURN(fupg_bintext(aTHX_ c, 1, ax, items));
+
 
 MODULE = FU   PACKAGE = FU::Pg::txn
 
diff --git a/FU/Pg.pm b/FU/Pg.pm
index d88a331..ff88d60 100644
--- a/FU/Pg.pm
+++ b/FU/Pg.pm
@@ -780,9 +780,24 @@ to be sent to (and further validated by) Postgres.  For some types,
 C<perl2bin()> may return invalid data on invalid input and C<bin2perl()> may
 accept invalid binary data.
 
-=back
+=item $conn->bin2text($oid, $bin, ...)
 
-I<TODO:> Methods to convert between bin and text formats.
+=item $conn->text2bin($oid, $text, ...)
+
+Convert between the binary format and the PostgreSQL text format. This
+conversion requires a round-trip to the server and throws an error if the
+connection state is not I<idle> or I<txn_idle>. Since it is Postgres doing the
+conversion, the input is properly validated and, in the case of C<bin2text()>,
+the result is guaranteed to be suitable for use as a textual bind parameter or
+for inclusion in an SQL query (but don't forget to use C<escape_literal()> in
+that case).
+
+Calling these methods many times can be pretty slow. If you have several values
+to convert, you can do that in a single call to speed things up:
+
+  my($text1, $text2, ..) = $conn->bin2text($oid1, $bin1, $oid2, $bin2, ..);
+
+=back
 
 I<TODO:> Methods to query type info.
 
diff --git a/c/pgconn.c b/c/pgconn.c
index 04423e6..607a9c6 100644
--- a/c/pgconn.c
+++ b/c/pgconn.c
@@ -653,3 +653,53 @@ static SV *fupg_bin2perl(pTHX_ fupg_conn *conn, Oid oid, SV *sv) {
     fupg_tio_free(&tio);
     return r;
 }
+
+
+static I32 fupg_bintext(pTHX_ fupg_conn *conn, int format, I32 ax, I32 argc) {
+    int vals = argc/2;
+
+    if (argc == 1 || argc % 2 == 0) croak("Usage: $conn->%s(oid, data, ...)", format ? "text2bin" : "bin2text");
+    if (vals > 1 && GIMME_V != G_LIST) {
+        ST(0) = sv_2mortal(newSViv(vals));
+        return 1;
+    }
+
+    Oid *paramtypes = safemalloc(vals * sizeof(*paramtypes));
+    const char **paramvalues = safemalloc(vals * sizeof(*paramvalues));
+    int *paramlengths = safemalloc(vals * sizeof(*paramlengths));
+    int *paramformats = safemalloc(vals * sizeof(*paramformats));
+
+    fustr sql;
+    fustr_init(&sql, NULL, SIZE_MAX);
+    fustr_write(&sql, "SELECT ", 7);
+
+    STRLEN len;
+    int i;
+    for (i=0; i<vals; i++) {
+        paramtypes[i] = SvIV(ST(i*2+1));
+        paramvalues[i] = format ? SvPVutf8(ST(i*2+2), len) : SvPVbyte(ST(i*2+2), len);
+        paramlengths[i] = len;
+        paramformats[i] = format ? 0 : 1;
+        if (i) fustr_write_ch(&sql, ',');
+        sql.cur -= 8 - sprintf(fustr_write_buf(&sql, 8), "$%d", i+1);
+    }
+    fustr_write_ch(&sql, 0);
+
+    PGresult *r = PQexecParams(conn->conn, fustr_start(&sql), vals,
+            paramtypes, paramvalues, paramlengths, paramformats, format);
+    safefree(paramtypes);
+    safefree(paramvalues);
+    safefree(paramlengths);
+    safefree(paramformats);
+    SvREFCNT_dec(sql.sv);
+
+    if (!r) fupg_conn_croak(conn, "exec");
+    if (PQresultStatus(r) != PGRES_TUPLES_OK) fupg_result_croak(r, "exec", sql.sv ? "SELECT $1, ..." : sql.sbuf);
+
+    /* The stack is guaranteed to be large enough, since we received 1+2*vals arguments */
+    for (i=0; i<vals; i++)
+        ST(i) = newSVpvn_flags(PQgetvalue(r, 0, i), PQgetlength(r, 0, i), SVs_TEMP | (format ? 0 : SVf_UTF8));
+
+    PQclear(r);
+    return vals;
+}
diff --git a/t/pgtypes.t b/t/pgtypes.t
index 67e566e..21c8eff 100644
--- a/t/pgtypes.t
+++ b/t/pgtypes.t
@@ -42,7 +42,11 @@ sub v($type, $p_in, @args) {
     {
         my $bin = $conn->perl2bin($oid, $p_in);
         ok defined $bin;
-        is_deeply $conn->bin2perl($oid, $bin), $p_out if $type !~ /\(/;
+        if ($type !~ /\(/) {
+            is_deeply $conn->bin2perl($oid, $bin), $p_out;
+            is $conn->bin2text($oid, $bin), $s_out;
+            is $conn->text2bin($oid, $s_out), $bin if $type ne 'jsonb'; # jsonb pretty-prints for some reason
+        }
     }
 }
 sub f($type, $p_in) {
@@ -180,6 +184,19 @@ is $conn->q('SELECT ($1::int2[])[2]', [1,2,3,4])->val, 2;
 is $conn->q('SELECT ($1::int2vector)[1]', [1,2,3,4])->val, 2;
 is $conn->q('SELECT ($1::oidvector)[1]', [1,2,3,4])->val, 2;
 
+is_deeply [$conn->bin2text(
+    16, $conn->perl2bin(16, 1),
+    25, 'Hello',
+    1007, $conn->perl2bin(1007, [-3,1,undef])
+)], ['t', 'Hello', '{-3,1,NULL}'];
+
+{
+    my($b,$s,$a) = $conn->text2bin(16, 't', 25, 'Hello', 1007, '{-3,1,NULL}');
+    is $conn->bin2perl(16, $b), 1;
+    is $conn->bin2perl(25, $s), 'Hello';
+    is_deeply $conn->bin2perl(1007, $a), [-3,1,undef];
+}
+
 {
     my $v = $conn->q("SELECT '{t,f,NULL}'::bool[]")->val;
     is_deeply $v, [true, false, undef];