From d1e5fddbedc4eec27dce70bda5a029472b17133c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 21 Feb 2008 15:57:18 -0600
Subject: [PATCH] fix a couple of minor bugs before major overhaul
---
extra/db/db.factor | 4 +--
extra/db/postgresql/postgresql.factor | 39 ++++++++++++++++-----------
extra/db/sqlite/lib/lib.factor | 1 +
extra/db/sqlite/sqlite.factor | 10 +++----
extra/db/tuples/tuples-tests.factor | 37 ++++++++++++-------------
extra/db/tuples/tuples.factor | 6 ++---
extra/db/types/types.factor | 11 +++++---
7 files changed, 60 insertions(+), 48 deletions(-)
diff --git a/extra/db/db.factor b/extra/db/db.factor
index d269d4654c..4fae508bb1 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -23,12 +23,12 @@ HOOK: db-close db ( handle -- )
db-handle db-close
] with-variable ;
-TUPLE: statement handle sql slot-names bound? in-params out-params ;
+TUPLE: statement handle sql bound? in-params out-params ;
TUPLE: simple-statement ;
TUPLE: prepared-statement ;
HOOK: <simple-statement> db ( str -- statement )
-HOOK: <prepared-statement> db ( str slot-names -- statement )
+HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- )
GENERIC: reset-statement ( statement -- )
diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor
index 8cf7e79f53..97e32a411d 100755
--- a/extra/db/postgresql/postgresql.factor
+++ b/extra/db/postgresql/postgresql.factor
@@ -4,7 +4,7 @@ USING: arrays assocs alien alien.syntax continuations io
kernel math math.parser namespaces prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges
-combinators sequences.lib classes locals words ;
+combinators sequences.lib classes locals words tools.walker ;
IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -65,6 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj )
} case ;
M: postgresql-statement insert-statement ( statement -- id )
+break
query-results [ 0 row-column ] with-disposal string>number ;
M: postgresql-statement query-results ( query -- result-set )
@@ -104,10 +105,13 @@ M: postgresql-db <simple-statement> ( sql -- statement )
{ set-statement-sql } statement construct
<postgresql-statement> ;
-M: postgresql-db <prepared-statement> ( pair -- statement )
- ?first2
- { set-statement-sql set-statement-slot-names }
- statement construct <postgresql-statement> ;
+M: postgresql-db <prepared-statement> ( triple -- statement )
+ ?first3
+ {
+ set-statement-sql
+ set-statement-in-params
+ set-statement-out-params
+ } statement construct <postgresql-statement> ;
M: postgresql-db begin-transaction ( -- )
"BEGIN" sql-command ;
@@ -166,6 +170,7 @@ SYMBOL: postgresql-counter
: drop-function-sql ( specs table -- sql )
[
+break
"drop function add_" % %
"(" %
remove-id
@@ -215,8 +220,8 @@ M: postgresql-db drop-sql ( specs table -- seq )
] postgresql-make ;
M: postgresql-db insert-sql* ( specs table -- sql in-specs out-specs )
- over find-primary-key native-id?
- [ insert-function-sql ] [ insert-table-sql ] if ;
+ dup class db-columns find-primary-key native-id?
+ [ insert-function-sql ] [ insert-table-sql ] if 3array ;
M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
[
@@ -228,7 +233,7 @@ M: postgresql-db update-sql* ( specs table -- sql in-specs out-specs )
" where " 0%
find-primary-key
dup sql-spec-column-name 0% " = " 0% bind%
- ] postgresql-make ;
+ ] postgresql-make 3array ;
M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
[
@@ -236,7 +241,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
" where " 0%
find-primary-key
dup sql-spec-column-name 0% " = " 0% bind%
- ] postgresql-make ;
+ ] postgresql-make 3array ;
: select-by-slots-sql ( tuple -- sql in-specs out-specs )
[
@@ -251,7 +256,7 @@ M: postgresql-db delete-sql* ( specs table -- sql in-specs out-specs )
[ ", " 0% ]
[ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
";" 0%
- ] postgresql-make ;
+ ] postgresql-make 3array ;
! : select-with-relations ( tuple -- sql in-specs out-specs )
@@ -259,7 +264,7 @@ M: postgresql-db select-sql ( tuple -- sql in-specs out-specs )
select-by-slots-sql ;
M: postgresql-db tuple>params ( specs tuple -- obj )
- [ >r dup third swap first r> get-slot-named swap ]
+ [ >r dup sql-spec-type swap sql-spec-slot-name r> get-slot-named swap ]
curry { } map>assoc ;
M: postgresql-db type-table ( -- hash )
@@ -268,6 +273,7 @@ M: postgresql-db type-table ( -- hash )
{ TEXT "text" }
{ VARCHAR "varchar" }
{ INTEGER "integer" }
+ { DOUBLE "real" }
{ TIMESTAMP "timestamp" }
} ;
@@ -278,12 +284,13 @@ M: postgresql-db create-type-table ( -- hash )
: postgresql-compound ( str n -- newstr )
over {
- { "varchar" [ first number>string join-space ] }
- { "references"
- [
+ { "default" [ first number>string join-space ] }
+ { "varchar" [ first number>string paren append ] }
+ { "references" [
first2 >r [ unparse join-space ] keep db-columns r>
- swap [ sql-spec-slot-name = ] with find nip sql-spec-column-name paren append
- ] }
+ swap [ sql-spec-slot-name = ] with find nip
+ sql-spec-column-name paren append
+ ] }
[ "no compound found" 3array throw ]
} case ;
diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor
index 6a3d7d03ae..648d8493dc 100755
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@@ -79,6 +79,7 @@ IN: db.sqlite.lib
{ VARCHAR [ sqlite-bind-text-by-name ] }
{ DOUBLE [ sqlite-bind-double-by-name ] }
{ TIMESTAMP [ sqlite-bind-double-by-name ] }
+ { +native-id+ [ sqlite-bind-int-by-name ] }
! { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ]
} case ;
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 748b2bbf68..249856e8bc 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -4,7 +4,7 @@ USING: alien arrays assocs classes compiler db
hashtables io.files 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 combinators ;
+words combinators.lib db.types combinators tools.walker ;
IN: db.sqlite
TUPLE: sqlite-db path ;
@@ -99,7 +99,7 @@ M: sqlite-db create-sql ( specs table -- sql )
M: sqlite-db drop-sql ( specs table -- sql )
[
- "drop table " % % ";" %
+ "drop table " % % ";" % drop
] "" make ;
M: sqlite-db insert-sql* ( specs table -- sql )
@@ -161,9 +161,9 @@ M: sqlite-db select-sql ( tuple -- sql )
M: sqlite-db tuple>params ( specs tuple -- obj )
[
- >r [ second ":" swap append ] keep r>
- dupd >r first r> get-slot-named swap
- third 3array
+ >r [ sql-spec-column-name ":" swap append ] keep r>
+ dupd >r sql-spec-slot-name r> get-slot-named swap
+ sql-spec-type 3array
] curry map ;
M: sqlite-db modifier-table ( -- hashtable )
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index 742702cebf..5a5df7c185 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -2,19 +2,18 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.sqlite db.tuples
db.types continuations namespaces db.postgresql math
-prettyprint ;
-! tools.time ;
+prettyprint tools.walker ;
IN: temporary
-TUPLE: person the-id the-name the-number real ;
+TUPLE: person the-id the-name the-number the-real ;
: <person> ( name age real -- person )
{
set-person-the-name
set-person-the-number
- set-person-real
+ set-person-the-real
} person construct ;
-: <assigned-person> ( id name number real -- obj )
+: <assigned-person> ( id name number the-real -- obj )
<person> [ set-person-the-id ] keep ;
SYMBOL: the-person
@@ -31,8 +30,10 @@ SYMBOL: the-person
[ ] [ the-person get update-tuple ] unit-test
+ ! T{ person f f f 200 f } select-tuples
+
[ ] [ the-person get delete-tuple ] unit-test
- ; ! 1 [ ] [ person drop-table ] unit-test ;
+ [ ] [ person drop-table ] unit-test ;
: test-sqlite ( -- )
"tuples-test.db" resource-path <sqlite-db> [
@@ -49,20 +50,20 @@ person "PERSON"
{ "the-id" "ID" +native-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } }
- { "real" "REAL" DOUBLE { +default+ 0.3 } }
+ { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
} define-persistent
"billy" 10 3.14 <person> the-person set
-test-sqlite
-! test-postgresql
+! test-sqlite
+test-postgresql
! person "PERSON"
! {
! { "the-id" "ID" INTEGER +assigned-id+ }
! { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
! { "the-number" "AGE" INTEGER { +default+ 0 } }
- ! { "real" "REAL" DOUBLE { +default+ 0.3 } }
+ ! { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
! } define-persistent
! 1 "billy" 20 6.28 <assigned-person> the-person set
@@ -95,11 +96,11 @@ annotation "ANNOTATION"
{ "contents" "CONTENTS" TEXT }
} define-persistent
-"localhost" "postgres" "" "factor-test" <postgresql-db> [
- [ paste drop-table ] [ drop ] recover
- [ annotation drop-table ] [ drop ] recover
- [ paste drop-table ] [ drop ] recover
- [ annotation drop-table ] [ drop ] recover
- paste create-table
- annotation create-table
-] with-db
+! "localhost" "postgres" "" "factor-test" <postgresql-db> [
+ ! [ paste drop-table ] [ drop ] recover
+ ! [ annotation drop-table ] [ drop ] recover
+ ! [ paste drop-table ] [ drop ] recover
+ ! [ annotation drop-table ] [ drop ] recover
+ ! [ ] [ paste create-table ] unit-test
+ ! [ ] [ annotation create-table ] unit-test
+! ] with-db
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index 11926b832d..7a95cc8e0e 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -3,7 +3,7 @@
USING: arrays assocs classes db kernel namespaces
tuples words sequences slots slots.private math
math.parser io prettyprint db.types continuations
-mirrors sequences.lib ;
+mirrors sequences.lib tools.walker ;
IN: db.tuples
: db-table ( class -- obj ) "db-table" word-prop ;
@@ -33,7 +33,7 @@ TUPLE: no-slot-named ;
dup class primary-key-spec get-slot-named ;
: set-primary-key ( obj tuple -- )
- [ class primary-key-spec first ] keep
+ [ class primary-key-spec sql-spec-slot-name ] keep
set-slot-named ;
: cache-statement ( columns class assoc quot -- statement )
@@ -92,7 +92,7 @@ HOOK: tuple>params db ( columns tuple -- obj )
: delete-tuple ( tuple -- )
[ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ;
-: select-tuple ( tuple -- )
+: select-tuples ( tuple -- )
[ select-sql ] keep do-query ;
: persist ( tuple -- )
diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor
index 77c704d1c9..a99ccc09f7 100755
--- a/extra/db/types/types.factor
+++ b/extra/db/types/types.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs db kernel math math.parser
sequences continuations sequences.deep sequences.lib
-words namespaces ;
+words namespaces tools.walker ;
IN: db.types
TUPLE: sql-spec slot-name column-name type modifiers primary-key ;
@@ -12,15 +12,18 @@ SYMBOL: +native-id+
! +assigned-id+ can only be a modifier
SYMBOL: +assigned-id+
-: primary-key? ( obj -- ? )
+: (primary-key?) ( obj -- ? )
{ +native-id+ +assigned-id+ } member? ;
+: primary-key? ( spec -- ? )
+ sql-spec-primary-key (primary-key?) ;
+
: normalize-spec ( spec -- )
- dup sql-spec-type dup primary-key? [
+ dup sql-spec-type dup (primary-key?) [
swap set-sql-spec-primary-key
] [
drop dup sql-spec-modifiers [
- primary-key?
+ (primary-key?)
] deep-find
[ swap set-sql-spec-primary-key ] [ drop ] if*
] if ;