From beeefcf3373a11877d121f7eded08ab238b36189 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Wed, 30 Apr 2025 17:07:44 +0200
Subject: [PATCH] Pg: Add perl2bin() and bin2perl() conversion methods

---
 FU.xs       |  8 ++++++++
 FU/Pg.pm    | 26 +++++++++++++++++++++++++-
 c/pgconn.c  | 27 +++++++++++++++++++++++++++
 t/pgtypes.t | 10 +++++++++-
 4 files changed, 69 insertions(+), 2 deletions(-)

diff --git a/FU.xs b/FU.xs
index dc19870..68082a5 100644
--- a/FU.xs
+++ b/FU.xs
@@ -286,6 +286,14 @@ void _set_type(fupg_conn *c, SV *name, SV *sendsv, SV *recvsv)
     fupg_set_type(aTHX_ c, name, sendsv, recvsv);
     XSRETURN(1);
 
+void perl2bin(fupg_conn *c, int oid, SV *sv)
+  CODE:
+    ST(0) = fupg_perl2bin(aTHX_ c, oid, sv);
+
+void bin2perl(fupg_conn *c, int oid, SV *sv)
+  CODE:
+    ST(0) = fupg_bin2perl(aTHX_ c, oid, sv);
+
 
 MODULE = FU   PACKAGE = FU::Pg::txn
 
diff --git a/FU/Pg.pm b/FU/Pg.pm
index f43c7f8..d88a331 100644
--- a/FU/Pg.pm
+++ b/FU/Pg.pm
@@ -758,7 +758,31 @@ C<set_type()> to configure appropriate conversions for these types.
 
 =back
 
-I<TODO:> Methods to convert between the various formats.
+Utility functions:
+
+=over
+
+=item $conn->perl2bin($oid, $val)
+
+=item $conn->bin2perl($oid, $bin)
+
+Convert the value for a specific type between the Perl representation and the
+PostgreSQL binary format, using the current type configuration of the
+connection. This is the same conversion used internally by this module to send
+bind parameters and receive query results, and map to the C<send> and C<recv>
+functions of C<< $conn->set_type() >>.
+
+These methods throw an error if C<$oid> is not a known type or if the given
+data is not valid for the type. However, these methods should not be used for
+strict validation: the conversion routines are usually written under the
+assumption that the data has been received directly from Postgres or is about
+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
+
+I<TODO:> Methods to convert between bin and text formats.
 
 I<TODO:> Methods to query type info.
 
diff --git a/c/pgconn.c b/c/pgconn.c
index 3a20b56..04423e6 100644
--- a/c/pgconn.c
+++ b/c/pgconn.c
@@ -626,3 +626,30 @@ static void fupg_tio_free(fupg_tio *tio) {
         safefree(tio->record.tio);
     }
 }
+
+
+
+
+static SV *fupg_perl2bin(pTHX_ fupg_conn *conn, Oid oid, SV *sv) {
+    int refresh_done = 0;
+    fupg_tio tio;
+    fustr buf;
+    memset(&tio, 0, sizeof(tio));
+    fupg_tio_setup(aTHX_ conn, &tio, FUPGT_SEND, oid, &refresh_done);
+    fustr_init(&buf, sv_newmortal(), SIZE_MAX);
+    tio.send(aTHX_ &tio, sv, &buf); /* XXX: Leaks 'tio' on error */
+    fupg_tio_free(&tio);
+    return fustr_done(&buf);
+}
+
+static SV *fupg_bin2perl(pTHX_ fupg_conn *conn, Oid oid, SV *sv) {
+    int refresh_done = 0;
+    fupg_tio tio;
+    STRLEN len;
+    const char *buf = SvPVbyte(sv, len);
+    memset(&tio, 0, sizeof(tio));
+    fupg_tio_setup(aTHX_ conn, &tio, FUPGT_RECV, oid, &refresh_done);
+    SV *r = tio.recv(aTHX_ &tio, buf, len); /* XXX: Leaks 'tio' on error */
+    fupg_tio_free(&tio);
+    return r;
+}
diff --git a/t/pgtypes.t b/t/pgtypes.t
index 3a3252c..67e566e 100644
--- a/t/pgtypes.t
+++ b/t/pgtypes.t
@@ -19,9 +19,12 @@ sub v($type, $p_in, @args) {
     my $s_out = @args > 2 && defined $args[2] ? $args[2] : $s_in;
 
     my $test = "$type $s_in" =~ s/\n/\\n/rg;
+    my $oid;
     utf8::encode($test);
     {
-        my $array = $conn->q("SELECT \$1::$type", $s_in)->text_params->flat;
+        my $st = $conn->q("SELECT \$1::$type", $s_in)->text_params;
+        $oid = $st->param_types->[0];
+        my $array = $st->flat;
         my $res = $array->[0];
         ok is_bool($res), "$test is bool" if $type eq 'bool';
         ok created_as_number($res), "$test is number" if $type =~ /^(int|float)\d/;
@@ -36,6 +39,11 @@ sub v($type, $p_in, @args) {
         my $res = $conn->q("SELECT \$1::$type", $p_in)->val;
         is_deeply $res, $p_out, "$test bin->bin";
     }
+    {
+        my $bin = $conn->perl2bin($oid, $p_in);
+        ok defined $bin;
+        is_deeply $conn->bin2perl($oid, $bin), $p_out if $type !~ /\(/;
+    }
 }
 sub f($type, $p_in) {
     my $test = "$type $p_in" =~ s/\n/\\n/rg;