From 16e6f36fc97ef2ddd2880b0775007ead904e822f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 17 Mar 2008 00:26:05 -0500 Subject: [PATCH] refactor db start on random-id --- extra/db/db.factor | 24 ++++++++++++++++- extra/db/postgresql/postgresql.factor | 3 ++- extra/db/sqlite/sqlite.factor | 25 ++++++++++++++---- extra/db/tuples/tuples-tests.factor | 8 +++--- extra/db/tuples/tuples.factor | 16 +++++++----- extra/db/types/types.factor | 37 +++++++++++++++------------ 6 files changed, 79 insertions(+), 34 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 309847209f..ac46be4422 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -33,6 +33,19 @@ HOOK: db-close db ( handle -- ) TUPLE: statement handle sql in-params out-params bind-params bound? ; TUPLE: simple-statement ; TUPLE: prepared-statement ; +TUPLE: nonthrowable-statement ; +: make-nonthrowable ( obj -- obj' ) + dup sequence? [ + [ make-nonthrowable ] map + ] [ + nonthrowable-statement construct-delegate + ] if ; + +MIXIN: throwable-statement +INSTANCE: statement throwable-statement +INSTANCE: simple-statement throwable-statement +INSTANCE: prepared-statement throwable-statement + TUPLE: result-set sql in-params out-params handle n max ; : ( sql in out -- statement ) { (>>sql) (>>in-params) (>>out-params) } statement construct ; @@ -50,13 +63,22 @@ GENERIC# row-column-typed 1 ( result-set column -- sql ) GENERIC: advance-row ( result-set -- ) GENERIC: more-rows? ( result-set -- ? ) -: execute-statement ( statement -- ) +GENERIC: execute-statement ( statement -- ) + +M: throwable-statement execute-statement ( statement -- ) dup sequence? [ [ execute-statement ] each ] [ query-results dispose ] if ; +M: nonthrowable-statement execute-statement ( statement -- ) + dup sequence? [ + [ execute-statement ] each + ] [ + [ query-results dispose ] [ 2drop ] recover + ] if ; + : bind-statement ( obj statement -- ) swap >>bind-params [ bind-statement* ] keep diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index b2042c98bd..8a6f8632ec 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -10,6 +10,7 @@ IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; TUPLE: postgresql-statement ; +INSTANCE: postgresql-statement throwable-statement TUPLE: postgresql-result-set ; : ( statement in out -- postgresql-statement ) @@ -194,7 +195,7 @@ M: postgresql-db ( class -- statement ) ");" 0% ] postgresql-make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db ( class -- statement ) [ "insert into " 0% 0% "(" 0% diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index b8ef5c7b17..1b594d6fa4 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -6,6 +6,7 @@ prettyprint sequences strings tuples alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words combinators.lib db.types combinators combinators.cleave io namespaces.lib ; +USE: tools.walker IN: db.sqlite TUPLE: sqlite-db path ; @@ -22,6 +23,8 @@ M: sqlite-db dispose ( db -- ) dispose-db ; : with-sqlite ( path quot -- ) sqlite-db swap with-db ; inline TUPLE: sqlite-statement ; +INSTANCE: sqlite-statement throwable-statement + TUPLE: sqlite-result-set has-more? ; M: sqlite-db ( str in out -- obj ) @@ -33,13 +36,20 @@ M: sqlite-db ( str in out -- obj ) set-statement-in-params set-statement-out-params } statement construct - db get db-handle over statement-sql sqlite-prepare - over set-statement-handle sqlite-statement construct-delegate ; +: sqlite-maybe-prepare ( statement -- statement ) + dup statement-handle [ + [ + delegate + db get db-handle over statement-sql sqlite-prepare + swap set-statement-handle + ] keep + ] unless ; + M: sqlite-statement dispose ( statement -- ) statement-handle - [ sqlite3_reset drop ] keep sqlite-finalize ; + [ [ sqlite3_reset drop ] keep sqlite-finalize ] when* ; M: sqlite-result-set dispose ( result-set -- ) f swap set-result-set-handle ; @@ -47,9 +57,12 @@ M: sqlite-result-set dispose ( result-set -- ) : sqlite-bind ( triples handle -- ) swap [ first3 sqlite-bind-type ] with each ; -: reset-statement ( statement -- ) statement-handle sqlite-reset ; +: reset-statement ( statement -- ) + sqlite-maybe-prepare + statement-handle sqlite-reset ; M: sqlite-statement bind-statement* ( statement -- ) + sqlite-maybe-prepare dup statement-bound? [ dup reset-statement ] when [ statement-bind-params ] [ statement-handle ] bi sqlite-bind ; @@ -90,6 +103,7 @@ M: sqlite-result-set more-rows? ( result-set -- ? ) sqlite-result-set-has-more? ; M: sqlite-statement query-results ( query -- result-set ) + sqlite-maybe-prepare dup statement-handle sqlite-result-set dup advance-row ; @@ -126,7 +140,7 @@ M: sqlite-db ( tuple -- statement ) ");" 0% ] sqlite-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db ( tuple -- statement ) ; : where-primary-key% ( specs -- ) @@ -176,6 +190,7 @@ M: sqlite-db modifier-table ( -- hashtable ) H{ { +native-id+ "primary key" } { +assigned-id+ "primary key" } + ! { +nonnative-id+ "primary key" } { +autoincrement+ "autoincrement" } { +unique+ "unique" } { +default+ "default" } diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 8e347490e4..2dbf6d1008 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -9,7 +9,7 @@ IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real ts date time blob factor-blob ; -: ( name age real ts date time blob -- person ) +: ( name age real ts date time blob factor-blob -- person ) { set-person-the-name set-person-the-number @@ -190,18 +190,16 @@ TUPLE: annotation n paste-id summary author mode contents ; : test-postgresql ( -- ) >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ; -[ native-person-schema test-tuples ] test-sqlite -[ assigned-person-schema test-tuples ] test-sqlite - : test-repeated-insert [ ] [ person ensure-table ] unit-test [ ] [ person1 get insert-tuple ] unit-test [ person1 get insert-tuple ] must-fail ; +[ native-person-schema test-tuples ] test-sqlite +[ assigned-person-schema test-tuples ] test-sqlite [ native-person-schema test-tuples ] test-postgresql [ assigned-person-schema test-tuples ] test-postgresql - [ assigned-person-schema test-repeated-insert ] test-sqlite [ assigned-person-schema test-repeated-insert ] test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index d50e42c0fb..0f69b0fafb 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -28,7 +28,7 @@ HOOK: create-sql-statement db ( class -- obj ) HOOK: drop-sql-statement db ( class -- obj ) HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) +HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) HOOK: db ( class -- obj ) @@ -75,21 +75,25 @@ HOOK: insert-tuple* db ( tuple statement -- ) drop-sql-statement [ execute-statement ] with-disposals ; : ensure-table ( class -- ) - [ dup drop-table ] ignore-errors create-table ; + [ + drop-sql-statement make-nonthrowable + [ execute-statement ] with-disposals + ] [ create-table ] bi ; : insert-native ( tuple -- ) dup class db get db-insert-statements [ ] cache [ bind-tuple ] 2keep insert-tuple* ; -: insert-assigned ( tuple -- ) +: insert-nonnative ( tuple -- ) +! TODO logic here for unique ids dup class - db get db-insert-statements [ ] cache + db get db-insert-statements [ ] cache [ bind-tuple ] keep execute-statement ; : insert-tuple ( tuple -- ) - dup class db-columns find-primary-key assigned-id? [ - insert-assigned + dup class db-columns find-primary-key nonnative-id? [ + insert-nonnative ] [ insert-native ] if ; diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 7014aaa943..532c097957 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -3,7 +3,8 @@ USING: arrays assocs db kernel math math.parser sequences continuations sequences.deep sequences.lib words namespaces tools.walker slots slots.private classes -mirrors tuples combinators calendar.format symbols ; +mirrors tuples combinators calendar.format symbols +singleton ; IN: db.types HOOK: modifier-table db ( -- hash ) @@ -14,22 +15,32 @@ HOOK: compound-type db ( str n -- hash ) TUPLE: sql-spec class slot-name column-name type modifiers primary-key ; -SYMBOLS: +native-id+ +assigned-id+ +autoincrement+ -+serial+ +unique+ +default+ +null+ +not-null+ + +SINGLETON: +native-id+ +SINGLETON: +assigned-id+ +SINGLETON: +random-id+ +UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ; +UNION: +nonnative-id+ +random-id+ +assigned-id+ ; + +! +native-id+ +assigned-id+ +random-assigned-id+ +SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ +foreign-id+ +has-many+ ; -: (primary-key?) ( obj -- ? ) - { +native-id+ +assigned-id+ } member? ; - : primary-key? ( spec -- ? ) - sql-spec-primary-key (primary-key?) ; + sql-spec-primary-key +primary-key+? ; + +: native-id? ( spec -- ? ) + sql-spec-primary-key +native-id+? ; + +: nonnative-id? ( spec -- ? ) + sql-spec-primary-key +nonnative-id+? ; : 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 ; @@ -37,12 +48,6 @@ SYMBOLS: +native-id+ +assigned-id+ +autoincrement+ : find-primary-key ( specs -- obj ) [ sql-spec-primary-key ] find nip ; -: native-id? ( spec -- ? ) - sql-spec-primary-key +native-id+ = ; - -: assigned-id? ( spec -- ? ) - sql-spec-primary-key +assigned-id+ = ; - : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ; SYMBOLS: INTEGER BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR @@ -69,7 +74,7 @@ TUPLE: no-sql-modifier ; dup number? [ number>string ] when ; : maybe-remove-id ( specs -- obj ) - [ native-id? not ] subset ; + [ +native-id+? not ] subset ; : remove-relations ( specs -- newcolumns ) [ relation? not ] subset ;