From 3028416a4c0e17c6c338784c9f0be16806867e7a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 15 Feb 2008 20:37:54 -0600 Subject: [PATCH] checking in db before a major overhaul --- extra/db/db.factor | 14 ++++++-------- extra/db/postgresql/postgresql.factor | 10 +++++----- extra/db/sqlite/sqlite.factor | 22 ++++++++++++++------- extra/db/tuples/tuples-tests.factor | 20 +++++++++---------- extra/db/tuples/tuples.factor | 28 +++++++++++++++++---------- 5 files changed, 54 insertions(+), 40 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 3595558dec..d88bbaee03 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -4,12 +4,9 @@ USING: arrays assocs classes continuations kernel math namespaces sequences sequences.lib tuples words strings ; IN: db -TUPLE: db handle insert-statements update-statements delete-statements select-statements ; +TUPLE: db handle insert-statements update-statements delete-statements ; : ( handle -- obj ) - H{ } clone - H{ } clone - H{ } clone - H{ } clone + H{ } clone H{ } clone H{ } clone db construct-boa ; GENERIC: db-open ( db -- ) @@ -23,11 +20,10 @@ HOOK: db-close db ( handle -- ) dup db-insert-statements dispose-statements dup db-update-statements dispose-statements dup db-delete-statements dispose-statements - dup db-select-statements dispose-statements db-handle db-close ] with-variable ; -TUPLE: statement sql params handle bound? ; +TUPLE: statement sql params handle bound? slot-names ; TUPLE: simple-statement ; TUPLE: prepared-statement ; @@ -115,5 +111,7 @@ HOOK: rollback-transaction db ( -- ) dup string? [ [ execute-statement ] with-disposal ] [ - [ [ sql-command ] each ] with-transaction + ! [ + [ sql-command ] each + ! ] with-transaction ] if ; diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 50704ea974..03746bcaa0 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -65,7 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj ) } case ; M: postgresql-statement insert-statement ( statement -- id ) - query-results [ break 0 row-column ] with-disposal ; + query-results [ 0 row-column ] with-disposal string>number ; M: postgresql-statement query-results ( query -- result-set ) dup statement-params [ @@ -211,7 +211,7 @@ M: postgresql-db drop-sql ( columns table -- seq ) over native-id? [ drop-function , ] [ 2drop ] if ] { } make ; -M: postgresql-db insert-sql* ( columns table -- sql ) +M: postgresql-db insert-sql* ( columns table -- slot-names sql ) [ "select add_" % % "(" % @@ -219,7 +219,7 @@ M: postgresql-db insert-sql* ( columns table -- sql ) ")" % ] "" make ; -M: postgresql-db update-sql* ( columns table -- sql ) +M: postgresql-db update-sql* ( columns table -- slot-names sql ) [ "update " % % @@ -231,7 +231,7 @@ M: postgresql-db update-sql* ( columns table -- sql ) [ primary-key? ] find nip second dup % " = $" % length 2 + # ] "" make ; -M: postgresql-db delete-sql* ( columns table -- sql ) +M: postgresql-db delete-sql* ( columns table -- slot-names sql ) [ "delete from " % % @@ -239,7 +239,7 @@ M: postgresql-db delete-sql* ( columns table -- sql ) first second % " = $1" % ] "" make ; -M: postgresql-db select-sql* ( columns table -- sql ) +M: postgresql-db select-sql ( columns table -- slot-names sql ) drop ; M: postgresql-db tuple>params ( columns tuple -- obj ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index 5e1bf0fa6f..4eabfc2ecd 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -114,6 +114,10 @@ M: sqlite-db insert-sql* ( columns table -- sql ) ")" % ] "" make ; +: where-primary-key% ( columns -- ) + " where " % + [ primary-key? ] find nip second dup % " = :" % % ; + M: sqlite-db update-sql* ( columns table -- sql ) [ "update " % @@ -121,8 +125,7 @@ M: sqlite-db update-sql* ( columns table -- sql ) " set " % dup remove-id [ ", " % ] [ second dup % " = :" % % ] interleave - " where " % - [ primary-key? ] find nip second dup % " = :" % % + where-primary-key% ] "" make ; M: sqlite-db delete-sql* ( columns table -- sql ) @@ -133,13 +136,18 @@ M: sqlite-db delete-sql* ( columns table -- sql ) first second dup % " = :" % % ] "" make ; -M: sqlite-db select-sql* ( columns table -- sql ) +: select-interval ( interval name -- ) + ; + +: select-sequence ( seq name -- ) + ; + +M: sqlite-db select-sql ( columns table -- sql ) [ "select ROWID, " % - swap [ ", " % ] [ second % ] interleave - " from " % - % - " where ROWID = :ID" % + over [ ", " % ] [ second % ] interleave + " from " % % + " where " % ] "" make ; M: sqlite-db tuple>params ( columns tuple -- obj ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 72fb6396b5..ea57193750 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -31,7 +31,7 @@ SYMBOL: the-person [ ] [ the-person get update-tuple ] unit-test [ ] [ the-person get delete-tuple ] unit-test - [ ] [ person drop-table ] unit-test ; + ; ! 1 [ ] [ person drop-table ] unit-test ; : test-sqlite ( -- ) "tuples-test.db" resource-path [ @@ -54,17 +54,17 @@ person "PERSON" "billy" 10 3.14 the-person set ! test-sqlite -test-postgresql + 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 } } -} define-persistent +! 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 } } +! } define-persistent -1 "billy" 20 6.28 the-person set +! 1 "billy" 20 6.28 the-person set ! test-sqlite ! test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 9b94c16672..be18f71e1b 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -41,13 +41,25 @@ TUPLE: no-slot-named ; HOOK: create-sql db ( columns table -- seq ) HOOK: drop-sql db ( columns table -- seq ) -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 ( columns table -- sql ) +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: select-sql db ( tuple -- statement ) HOOK: row-column-typed db ( result-set n type -- sql ) HOOK: sql-type>factor-type db ( obj type -- obj ) +HOOK: tuple>params db ( columns tuple -- obj ) + + +HOOK: make-slot-names* db ( quot -- seq ) +HOOK: column-slot-name% db ( spec -- ) +HOOK: column-bind-name% db ( spec -- ) + +: make-slots-names ( quot -- seq str ) + [ make-column-names ] "" make ; inline +: slot-name% ( seq -- ) first % ; +: column-name% ( seq -- ) second % ; +: column-type% ( seq -- ) third % ; : insert-sql ( columns class -- statement ) db get db-insert-statements [ insert-sql* ] cache-statement ; @@ -58,10 +70,6 @@ HOOK: sql-type>factor-type db ( obj type -- obj ) : delete-sql ( columns class -- statement ) db get db-delete-statements [ delete-sql* ] cache-statement ; -: select-sql ( columns class -- statement ) - db get db-select-statements [ select-sql* ] cache-statement ; - -HOOK: tuple>params db ( columns tuple -- obj ) : tuple-statement ( columns tuple quot -- statement ) >r [ tuple>params ] 2keep class r> call @@ -93,8 +101,8 @@ HOOK: tuple>params db ( columns tuple -- obj ) : delete-tuple ( tuple -- ) [ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ; -! : select-tuple ( tuple -- ) - ! [ select-sql ] bind-tuple do-query ; +: select-tuple ( tuple -- ) + [ select-sql ] keep do-query ; : persist ( tuple -- ) dup primary-key [ update-tuple ] [ insert-tuple ] if ;