Restructure type conversions

Allow for 2-way registered conversions. From Raku objects to a format suitable for the database (this was hardcoded for Buf already) in addition to the previously registerable conversions from DB to Raku (Bool, DateTime, Buf).

Allow registration of conversion via register-type-conversion() function calls. This hides the internal implementation which will probably change at some point.

The pg_custom_type.p6 file contains a sample Raku Point(:$x, :$y) object to a Pg "point" type in both directions.

examples/pg_custom_type.p6

@@ -0,0 +1,81 @@
+#!/usr/bin/env perl6
+
+use v6;
+use lib 'lib';
+use DBIish;
+use NativeCall;
+
+# Windows support
+if $*DISTRO.is-win {
+    # libpq.dll on windows depends on libeay32.dll which in this path
+    my constant PG-HOME   = 'C:\Program Files\PostgreSQL\9.3';
+    my $path              = sprintf( 'Path=%s;%s\bin', %*ENV<Path>, PG-HOME );
+    %*ENV<DBIISH_PG_LIB>  = (PG-HOME).fmt( '%s\lib\libpq.dll' );
+
+    # Since %*ENV<Path> = ... does not actually own process environment
+    # Weird magic but needed atm :)
+    sub _putenv(Str) is native('msvcrt') { ... }
+    _putenv( $path);
+}
+
+my $dbh = DBIish.connect(
+        "Pg",
+        :database<dbiish>,
+        :user<dbiish>,
+        );
+
+# Create a temporary table with a type that isn't already converted
+# via DBIish. By default DBIish will return the same string that PostgreSQL
+# does.
+$dbh.execute(q:to/STATEMENT/);
+  CREATE TEMPORARY TABLE tab (
+      col point NOT NULL
+  );
+STATEMENT
+
+# The structure of the type within Raku can be nearly anything.
+# A Point class with X and Y coordinates will be used for the PostgreSQL point type
+class Point {
+    has Int $.x is required;
+    has Int $.y is required;
+}
+
+
+# Conversion from the DB to the Raku type.
+#
+# Extract the X/Y pieces from the string PostgreSQL returns and return an instance
+# of the point class.
+#
+# More complex conversions might be needed for PostGIS types, etc.
+my $from-db-sub = sub ($value --> Point) {
+    if $value ~~ / "(" $<x>=(<[-]>? \d+) "," $<y>=(<[-]>? \d+)  ")"/ {
+        return Point.new(x => Int.new(~$<x>), y => Int.new(~$<y>));
+    } else {
+        die "Value '$value' is not a point";
+    }
+}
+
+# Conversion routine to create a PostgreSQL string for the Point class.
+my $to-db-sub = sub (Point $obj --> Str) {
+    # Encode the object value for the database type
+    return '(%d,%d)'.sprintf($obj.x, $obj.y);
+};
+
+# Register the PG/Raku conversion functions. The type OID will be looked up once per connection
+# and used to detect when conversion should occur.
+$dbh.register-type-conversion(schema => 'pg_catalog', db-type => 'point', raku-type => Point, :$from-db-sub, :$to-db-sub);
+
+# Roundtrip the datum. Store the Point, then retrieve it back again.
+my $point = Point.new(x => 4, y => -8);
+$dbh.execute('INSERT INTO tab VALUES ($1)', $point);
+
+for $dbh.execute('SELECT col FROM tab').allrows(:array-of-hash) -> $row {
+    # $retrieved-point is a Point object with x and y values set.
+    # $point == $retrieved-point;
+    my $retrieved-point = $row<col>;
+
+    say "Point: ({$retrieved-point.x}, {$retrieved-point.y})";
+}
+
+# Disconnect
+$dbh.dispose;

lib/DBDish.pm6

@@ -37,7 +37,7 @@ role Driver does DBDish::ErrorHandling {
     }
 }
 
-role TypeConverter does Associative {
+role TypeConverterFromDB does Associative {
     has Callable %!Conversions{Mu:U} handles <AT-KEY EXISTS-KEY>;
 
     # The role implements the conversion
@@ -63,6 +63,7 @@ role TypeConverter does Associative {
             }
         }
     }
+
     method STORE(::?CLASS:D: \to_store) {
         for @(to_store) {
             when Callable { %!Conversions{$_.signature.returns} = $_ }
@@ -71,6 +72,35 @@ role TypeConverter does Associative {
     }
 }
 
+role TypeConverterToDB does Associative {
+    has Callable %!Conversions{Mu:U} handles <AT-KEY EXISTS-KEY>;
+
+    # The role implements the conversion:
+    method convert (::?CLASS:D: Mu $datum --> Str) {
+        my Mu:U $type = $datum.WHAT;
+
+        # Normalize Buf. Due to an implementation quirk, Buf != Buf.new(^256)
+        # but whateverable can handle it. Convert to a static term for hash lookup purposes.
+        $type = Buf if ($type ~~ Buf);
+
+        with %!Conversions{$type} -> &converter {
+            converter($datum);
+        } else { # Common case. Convert using simple stringification.
+            Str($datum);
+        }
+    }
+    method STORE(::?CLASS:D: \to_store) {
+        for @(to_store) {
+            when Callable {
+                my Mu:U $type = $_.signature.params[0].type;
+                $type = Buf if ($type ~~ Buf);
+                %!Conversions{$type} = $_;
+            }
+            when Pair { %!Conversions{::($_.key)} = $_.value }
+        }
+    }
+}
+
 =begin pod
 =head1 DESCRIPTION
 The DBDish module loads the generic code needed by every DBDish driver of the

lib/DBDish/Connection.pm6

@@ -181,6 +181,12 @@ method Statements() {
     $!statements-lock.protect: { %!statements.clone }
 }
 
+multi method register-type-conversion(Int :$db-type is required, Mu :$raku-type is required, Callable :$from-db-sub, Callable :$to-db-sub) {
+    self.dynamic-types{$db-type} = $raku-type with $db-type;
+    self.Converter-From-DB{$raku-type} = $from-db-sub with $from-db-sub;
+    self.Converter-To-DB{$raku-type} = $to-db-sub with $to-db-sub;
+}
+
 =begin pod
 =head5 quote
 

lib/DBDish/Pg/Connection.pm6

@@ -13,14 +13,40 @@ has PGconn $!pg-conn handles <
     pg-port pg-options quote>;
 has $.AutoCommit is rw = True;
 has $.in-transaction is rw = False;
-has %.Converter is DBDish::TypeConverter;
+has %.Converter-From-DB is DBDish::TypeConverterFromDB;
+has %.Converter-To-DB is DBDish::TypeConverterToDB;
 has %.dynamic-types = %oid-to-type;
 
-submethod BUILD(:$!pg-conn!, :$!parent!, :$!AutoCommit) {
-    %!Converter =
+submethod BUILD(:$!pg-conn!, :$!parent!, :$!AutoCommit) { }
+submethod TWEAK() {
+    %!Converter-From-DB =
             method (--> Bool) { self eq 't' },
             method (--> DateTime) { DateTime.new(self.split(' ').join('T')) },
             :Buf(&str-to-blob);
+
+    %!Converter-To-DB =
+            sub (Buf $val) {$!pg-conn.escapeBytea(($val ~~ Buf) ?? $val !! ~$val.encode)};
+    # TODO: Array needs 2 layers of conversion; one for individual elements and the other for the array itself
+    #        method (Array $val) {self.pg-array-str($val)};
+}
+
+multi method register-type-conversion(Str :$schema = 'pg_catalog', Str :$db-type is required, Mu :$raku-type is required,
+                                      Callable :$from-db-sub, Callable :$to-db-sub)
+{
+    my $sql = q:to/SQL/;
+       SELECT pg_type.oid
+         FROM pg_type
+         JOIN pg_namespace ON (pg_namespace.oid = typnamespace)
+        WHERE nspname = $1
+          AND typname = $2
+    SQL
+
+    # Expecting a single result, silently fail if not applicable.
+    for self.execute($sql, $schema, $db-type).row() -> $row {
+        my Int $type-id = $row[0].Int;
+
+        self.register-type-conversion(db-type => $type-id, :$from-db-sub, :$to-db-sub, :$raku-type);
+    }
 }
 
 has $!statement-posfix = 0;

lib/DBDish/Pg/StatementHandle.pm6

@@ -66,15 +66,21 @@ submethod BUILD(:$!parent!, :$!pg-conn!, # Per protocol
 method execute(**@params --> DBDish::StatementHandle) {
     self!enter-execute(@params.elems, @!param-type.elems);
 
+    my %Converter := $!parent.Converter-To-DB;
+
     $!parent.protect-connection: {
         my @param_values := ParamArray.new;
-        for @params.kv -> $k, $v {
-            if $v.defined {
-                @param_values[$k] = @!param-type[$k] ~~ Buf
-                        ?? $!pg-conn.escapeBytea(($v ~~ Buf) ?? $v !! ~$v.encode)
-                        !! @!param-type[$k] ~~ Array ?? self.pg-array-str($v)
-                        !! ~$v;
-            } else { @param_values[$k] = Str }
+        for @params.kv -> $k, $val {
+            if $val.defined {
+                my $have-type = $val.WHAT;
+                if $have-type ~~ Array {
+                    @param_values[$k] = self.pg-array-str($val);
+                } else {
+                    @param_values[$k] = %Converter.convert($val);
+                }
+            } else {
+                @param_values[$k] = Str;
+            }
         }
 
         $!result = $!statement-name
@@ -105,7 +111,7 @@ method _row() {
     # Cache type conversion functions. Allow column-type to be configured by the client
     # after prepare/execute
     if @!import-func.elems != $!field-count {
-        my %Converter := $!parent.Converter;
+        my %Converter := $!parent.Converter-From-DB;
 
         for @!column-type -> $type {
             @!import-func.push: do {
@@ -197,15 +203,19 @@ sub _pg-to-array(Str $text, Mu:U $type, %Converter) {
 }
 
 method pg-array-str(\arr) {
+    my %Converter := $!parent.Converter-To-DB;
+
     my @tmp;
     my @data := arr ~~ Array ?? arr !! [ arr ];
     for @data -> $c {
         if $c ~~ Array {
             @tmp.push(self.pg-array-str($c));
-        } elsif $c ~~ Numeric {
-            @tmp.push($c);
         } else {
-            my $t = $c.subst('\\', '\\\\', :g).subst('"', '\\"', :g);
+            # Convert $c from Raku object value to DB string value if necessary.
+            my $t = %Converter.convert($c);
+
+            # Escape the converted value and push it into the array string.
+            $t = $t.subst('\\', '\\\\', :g).subst('"', '\\"', :g);
             @tmp.push('"'~$t~'"');
         }
     }

lib/DBDish/mysql/Connection.pm6

@@ -7,7 +7,7 @@ use DBDish::mysql::Native;
 need DBDish::mysql::StatementHandle;
 
 has MYSQL $!mysql-client;
-has %.Converter is DBDish::TypeConverter;
+has %.Converter is DBDish::TypeConverterFromDB;
 has %.dynamic-types = %mysql-type-conv;
 
 submethod BUILD(:$!mysql-client!, :$!parent!) {

t/06-types.t

@@ -5,7 +5,7 @@ need DBDish;
 plan 12;
 
 class type-test {
-	has %.Converter is DBDish::TypeConverter;
+	has %.Converter is DBDish::TypeConverterFromDB;
 
 	method test-str(Str $value) {
 		$value.flip;

t/34-pg-types.t

@@ -2,7 +2,7 @@ use v6;
 use Test;
 use DBIish;
 
-plan 9;
+plan 11;
 
 my %con-parms;
 # If env var set, no parameter needed.
@@ -50,11 +50,56 @@ my ($col1) = $sth.row;
 isa-ok $col1, Str;
 is $col1, 'test',			    'Test';
 
+
 # Change the type conversion and start a new statement handle. Type conversions are fixed
 # after the statement handle is prepared.
-$dbh.Converter{Str} = sub ($) { 'changed' };
+$dbh.register-type-conversion(db-type => 'text', raku-type => Str, from-db-sub => sub (Str $value) {'changed'});
 $sth = $dbh.prepare('SELECT col1 FROM test_types');
 $sth.execute;
 is $sth.rows, 1,			    '1 row';
 ($col1) = $sth.row;
 is $col1, 'changed',		    'Changed';
+
+
+# Round-trip a complex type
+# See examples/pg_custom_type.p6 for details
+{
+    $dbh.execute(q:to/STATEMENT/);
+     CREATE TEMPORARY TABLE tab (
+      col point NOT NULL
+     );
+    STATEMENT
+
+    class Point {
+        has Int $.x is required;
+        has Int $.y is required;
+    }
+
+    # Conversion from the DB to the Raku type.
+    my $from-db-sub = sub ($value --> Point) {
+        if $value ~~ / "(" $<x>=(<[-]>? \d+) "," $<y>=(<[-]>? \d+)  ")"/ {
+            return Point.new(x => Int.new(~$<x>), y => Int.new(~$<y>));
+        } else {
+            die "Value '$value' is not a point";
+        }
+    }
+
+    # Conversion routine to create a PostgreSQL string for the Point class.
+    my $to-db-sub = sub (Point $obj --> Str) {
+        return '(%d,%d)'.sprintf($obj.x.Str, $obj.y.Str);
+    };
+
+    $dbh.register-type-conversion(schema => 'pg_catalog', db-type => 'point', raku-type => Point, :$from-db-sub, :$to-db-sub);
+
+    my $point = Point.new(x => 4, y => -8);
+    $dbh.execute('INSERT INTO tab VALUES ($1)', $point);
+
+    if $dbh.execute('SELECT col FROM tab').row(:hash) -> $row {
+        my $retrieved-point = $row<col>;
+
+        is $point.x, $retrieved-point.x, 'X coord matches';
+        is $point.y, $retrieved-point.y, 'Y coord matches';
+    } else {
+        fail('Record Does not exist');
+    }
+}