From a4518150a7f34165fc7d810d95899c4a85fe1e66 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 24 Feb 2008 12:32:36 -0600
Subject: [PATCH] fix postgresql connect error message fix unit test

---
 extra/db/postgresql/lib/lib.factor    | 12 ++++++---
 extra/db/postgresql/postgresql.factor |  4 +--
 extra/db/tuples/tuples-tests.factor   |  3 ++-
 extra/db/tuples/tuples.factor         | 35 +++++++++++++++++++--------
 4 files changed, 37 insertions(+), 17 deletions(-)

diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor
index cdfa3535a0..25b3a6d2cf 100755
--- a/extra/db/postgresql/lib/lib.factor
+++ b/extra/db/postgresql/lib/lib.factor
@@ -2,21 +2,25 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ;
+db.types tools.walker ascii splitting ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
     dup zero? [
         drop f
     ] [
-        PQresultErrorMessage [ CHAR: \n = ] right-trim
+        PQresultErrorMessage [ blank? ] trim
     ] if ;
 
 : postgres-result-error ( res -- )
     postgresql-result-error-message [ throw ] when* ;
 
+: (postgresql-error-message) ( handle -- str )
+    PQerrorMessage
+    "\n" split [ [ blank? ] trim ] map "\n" join ;
+
 : postgresql-error-message ( -- str )
-    db get db-handle PQerrorMessage [ CHAR: \n = ] right-trim ;
+    db get db-handle (postgresql-error-message) ;
 
 : postgresql-error ( res -- res )
     dup [ postgresql-error-message throw ] unless ;
@@ -27,7 +31,7 @@ IN: db.postgresql.lib
 
 : connect-postgres ( host port pgopts pgtty db user pass -- conn )
     PQsetdbLogin
-    dup PQstatus zero? [ postgresql-error-message throw ] unless ;
+    dup PQstatus zero? [ (postgresql-error-message) throw ] unless ;
 
 : do-postgresql-statement ( statement -- res )
     db get db-handle swap statement-sql PQexec dup postgresql-result-ok? [
diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor
index ef7c870501..85fcca4b43 100755
--- a/extra/db/postgresql/postgresql.factor
+++ b/extra/db/postgresql/postgresql.factor
@@ -208,7 +208,7 @@ M: postgresql-db <insert-assigned-statement> ( tuple -- statement )
         ");" 0%
     ] postgresql-make ;
 
-M: postgresql-db <update-tuple-statement> ( tuple -- statement )
+M: postgresql-db <update-tuple-statement> ( class -- statement )
     [
         "update " 0% 0%
         " set " 0%
@@ -220,7 +220,7 @@ M: postgresql-db <update-tuple-statement> ( tuple -- statement )
         dup sql-spec-column-name 0% " = " 0% bind%
     ] postgresql-make ;
 
-M: postgresql-db <delete-tuple-statement> ( tuple -- statement )
+M: postgresql-db <delete-tuple-statement> ( class -- statement )
     [
         "delete from " 0% 0%
         " where " 0%
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index b484ccf016..9177e4981c 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -31,7 +31,8 @@ SYMBOL: the-person
 
     [ ] [ the-person get update-tuple ] unit-test
 
-    ! T{ person f f f 200 f } select-tuples
+    [ T{ person f 1 "billy" 200 3.14 } ]
+    [ T{ person f 1 } select-tuple ] unit-test
 
     ! [ ] [ the-person get delete-tuple ] unit-test
     ! [ ] [ person drop-table ] unit-test
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index ea66d5890f..5c9e3f6b64 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -32,6 +32,12 @@ HOOK: <delete-tuples-statement> db ( tuple -- obj )
 
 HOOK: row-column-typed db ( result-set n type -- sql )
 
+: resulting-tuple ( class out-params row -- tuple )
+    >r >r construct-empty r> r> rot [
+        >r [ sql-spec-type sql-type>factor-type ] keep
+        sql-spec-slot-name r> set-slot-named
+    ] curry 2each ;
+
 : query-tuple ( tuple statement -- seq )
     dupd
     [ query-results [ sql-row ] with-disposal ] keep
@@ -40,8 +46,14 @@ HOOK: row-column-typed db ( result-set n type -- sql )
         sql-spec-slot-name r> set-slot-named
     ] curry 2each ;
  
-: query-tuples ( statement -- seq )
-    ;
+: query-tuples ( tuple statement -- seq )
+    dup query-results [
+        statement-out-params [
+break
+            >r [ sql-spec-type sql-type>factor-type ] keep
+            sql-spec-slot-name r> set-slot-named
+        ] with with query-map
+    ] with-disposal ; 
 
 : sql-props ( class -- columns table )
     dup db-columns swap db-table ;
@@ -51,7 +63,7 @@ HOOK: row-column-typed db ( result-set n type -- sql )
 
 : insert-native ( tuple -- )
     dup class <insert-native-statement>
-    [ bind-tuple ] 2keep query-tuple ;
+    [ bind-tuple ] 2keep query-tuple drop ;
 
 : insert-assigned ( tuple -- )
     dup <insert-assigned-statement>
@@ -65,13 +77,12 @@ HOOK: row-column-typed db ( result-set n type -- sql )
     ] if ;
 
 : update-tuple ( tuple -- )
-    <update-tuple-statement> execute-statement ;
+    dup class <update-tuple-statement>
+    [ bind-tuple ] keep execute-statement ;
 
 : update-tuples ( seq -- )
     <update-tuples-statement> execute-statement ;
 
-
-
 ! : persist ( tuple -- )
 
 HOOK: delete-by-id db ( tuple -- )
@@ -80,10 +91,14 @@ HOOK: delete-by-id db ( tuple -- )
 
 HOOK: <select-by-slots-statement> db ( tuple -- tuple )
 
-: select-tuple ( tuple -- tuple )
+: setup-select ( tuple -- tuple statement )
     dup dup class <select-by-slots-statement>
-    [ bind-tuple ] 2keep query-tuple ;
+    [ bind-tuple ] 2keep ;
+
+: select-tuple ( tuple -- tuple )
+    setup-select query-tuple ;
 
 : select-tuples ( tuple -- tuple )
-    dup dup class <select-by-slots-statement>
-    [ bind-tuple ] 2keep query-tuples ;
+    setup-select query-tuples ;
+
+! uniqueResult