From cfc7ef04b574596724285802381c943e91ab4e44 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Tue, 19 Feb 2008 12:09:59 +1100
Subject: [PATCH] db.sqlite: add with-tmp-sqlite, db.tuples: some fixes

---
 extra/db/sqlite/sqlite.factor |  7 ++++++-
 extra/db/tuples/tuples.factor | 33 ++++++++++++++++++++++++---------
 2 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 4eabfc2ecd..17948bbbc4 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays assocs classes compiler db
-hashtables io.files kernel math math.parser namespaces
+hashtables io.files io.files.tmp kernel math math.parser namespaces
 prettyprint sequences strings tuples alien.c-types
 continuations db.sqlite.lib db.sqlite.ffi db.tuples
 words combinators.lib db.types ;
@@ -22,6 +22,11 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
 : with-sqlite ( path quot -- )
     >r <sqlite-db> r> with-db ; inline
 
+: with-tmp-sqlite ( quot -- )
+    ".db" [
+        swap with-sqlite
+    ] with-tmpfile ;
+
 TUPLE: sqlite-statement ;
 C: <sqlite-statement> sqlite-statement
 
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index 20cdd8a386..00f0f97c9e 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -12,23 +12,38 @@ TUPLE: no-slot-named ;
 : no-slot-named ( -- * ) T{ no-slot-named } throw ;
 
 : slot-spec-named ( str class -- slot-spec )
-    "slots" word-prop [ slot-spec-name = ] with find nip
-    [ no-slot-named ] unless* ;
+    "slots" word-prop [ slot-spec-name = ] with find nip ;
 
 : offset-of-slot ( str obj -- n )
-    class slot-spec-named slot-spec-offset ;
+    class slot-spec-named dup [ slot-spec-offset ] when ;
+
+DEFER: get-slot-named
+: get-delegate-slot-named ( str obj -- value )
+    delegate [ get-slot-named ] [ drop no-slot-named ] if* ;
 
 : get-slot-named ( str obj -- value )
-    tuck offset-of-slot [ no-slot-named ] unless* slot ;
+    2dup offset-of-slot [
+        rot drop slot
+    ] [
+        get-delegate-slot-named
+    ] if* ;
+
+DEFER: set-slot-named
+: set-delegate-slot-named ( value str obj -- )
+    delegate [ set-slot-named ] [ 2drop no-slot-named ] if* ;
 
 : set-slot-named ( value str obj -- )
-    tuck offset-of-slot [ no-slot-named ] unless* set-slot ;
+    2dup offset-of-slot [
+        rot drop set-slot
+    ] [
+        set-delegate-slot-named
+    ] if* ;
 
 : primary-key-spec ( class -- spec )
     db-columns [ primary-key? ] find nip ;
     
 : primary-key ( tuple -- obj )
-    dup class primary-key-spec get-slot-named ;
+    dup class primary-key-spec first swap get-slot-named ;
 
 : set-primary-key ( obj tuple -- )
     [ class primary-key-spec first ] keep
@@ -41,9 +56,9 @@ TUPLE: no-slot-named ;
 HOOK: create-sql db ( columns table -- seq )
 HOOK: drop-sql db ( columns table -- seq )
 
-HOOK: insert-sql* db ( columns table -- slot-names sql )
-HOOK: update-sql* db ( columns table -- slot-names sql )
-HOOK: delete-sql* db ( columns table -- slot-names sql )
+HOOK: insert-sql* db ( columns table -- sql )
+HOOK: update-sql* db ( columns table -- sql )
+HOOK: delete-sql* db ( columns table -- sql )
 HOOK: select-sql db ( tuple -- statement )
 
 HOOK: row-column-typed db ( result-set n type -- sql )