From 93f77da9bfe5e8a5a2407e4953368e4b3e6f7255 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 9 Sep 2008 17:27:37 -0500 Subject: [PATCH] cleanups, fix errors --- basis/db/db.factor | 30 +++++++++++++++++------------- basis/db/queries/queries.factor | 14 +++++--------- basis/db/tuples/tuples.factor | 22 +++++++++++----------- basis/db/types/types-docs.factor | 12 ------------ 4 files changed, 33 insertions(+), 45 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index 4e3fe49947..eac22a2999 100755 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -116,19 +116,6 @@ M: object execute-statement* ( statement type -- ) : default-query ( query -- result-set ) query-results [ [ sql-row ] query-map ] with-disposal ; -SYMBOL: in-transaction -HOOK: begin-transaction db ( -- ) -HOOK: commit-transaction db ( -- ) -HOOK: rollback-transaction db ( -- ) - -: in-transaction? ( -- ? ) in-transaction get ; - -: with-transaction ( quot -- ) - t in-transaction [ - begin-transaction - [ ] [ rollback-transaction ] cleanup commit-transaction - ] with-variable ; - : sql-query ( sql -- rows ) f f [ default-query ] with-disposal ; @@ -140,3 +127,20 @@ HOOK: rollback-transaction db ( -- ) [ sql-command ] each ! ] with-transaction ] if ; + +SYMBOL: in-transaction +HOOK: begin-transaction db ( -- ) +HOOK: commit-transaction db ( -- ) +HOOK: rollback-transaction db ( -- ) + +M: db begin-transaction ( -- ) "BEGIN" sql-command ; +M: db commit-transaction ( -- ) "COMMIT" sql-command ; +M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ; + +: in-transaction? ( -- ? ) in-transaction get ; + +: with-transaction ( quot -- ) + t in-transaction [ + begin-transaction + [ ] [ rollback-transaction ] cleanup commit-transaction + ] with-variable ; diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 023ef3d9a8..ede7612942 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -50,10 +50,6 @@ M: retryable execute-statement* ( statement type -- ) [ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake maybe-make-retryable ; inline -M: db begin-transaction ( -- ) "BEGIN" sql-command ; -M: db commit-transaction ( -- ) "COMMIT" sql-command ; -M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ; - : where-primary-key% ( specs -- ) " where " 0% find-primary-key dup column-name>> 0% " = " 0% bind% ; @@ -70,7 +66,7 @@ M: db ( class -- statement ) M: random-id-generator eval-generator ( singleton -- obj ) drop system-random-generator get [ - 63 [ 2^ random ] keep 1 - set-bit + 63 [ random-bits ] keep 1- set-bit ] with-random ; : interval-comparison ( ? str -- str ) @@ -154,22 +150,22 @@ M: db ( tuple class -- statement ) : do-group ( tuple groups -- ) [ - ", " join " group by " prepend append + ", " join " group by " swap 3append ] curry change-sql drop ; : do-order ( tuple order -- ) [ - ", " join " order by " prepend append + ", " join " order by " swap 3append ] curry change-sql drop ; : do-offset ( tuple n -- ) [ - number>string " offset " prepend append + number>string " offset " swap 3append ] curry change-sql drop ; : do-limit ( tuple n -- ) [ - number>string " limit " prepend append + number>string " limit " swap 3append ] curry change-sql drop ; : make-query ( tuple query -- tuple' ) diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 94fa1a66e8..3c3bae3adc 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -15,13 +15,13 @@ IN: db.tuples ERROR: not-persistent class ; -: db-table ( class -- obj ) +: db-table ( class -- object ) dup "db-table" word-prop [ ] [ not-persistent ] ?if ; -: db-columns ( class -- obj ) +: db-columns ( class -- object ) superclasses [ "db-columns" word-prop ] map concat ; -: db-relations ( class -- obj ) +: db-relations ( class -- object ) "db-relations" word-prop ; : set-primary-key ( key tuple -- ) @@ -34,13 +34,13 @@ SYMBOL: sql-counter sql-counter [ inc ] [ get ] bi number>string ; ! returns a sequence of prepared-statements -HOOK: create-sql-statement db ( class -- obj ) -HOOK: drop-sql-statement db ( class -- obj ) +HOOK: create-sql-statement db ( class -- object ) +HOOK: drop-sql-statement db ( class -- object ) -HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) -HOOK: db ( tuple class -- obj ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( tuple class -- object ) HOOK: db ( tuple class -- tuple ) TUPLE: query group order offset limit ; HOOK: db ( tuple class query -- statement' ) @@ -48,7 +48,7 @@ HOOK: db ( tuple class groups -- n ) HOOK: insert-tuple* db ( tuple statement -- ) -GENERIC: eval-generator ( singleton -- obj ) +GENERIC: eval-generator ( singleton -- object ) : resulting-tuple ( exemplar-tuple row out-params -- tuple ) rot class new [ @@ -68,7 +68,7 @@ GENERIC: eval-generator ( singleton -- obj ) [ slot-name>> ] dip set-slot-named ] curry 2each ; -: with-disposals ( seq quot -- ) +: with-disposals ( object quotation -- ) over sequence? [ [ with-disposal ] curry each ] [ diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index d60878555a..ded13137af 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -133,12 +133,6 @@ HELP: db-assigned-id-spec? { "?" "a boolean" } } { $description "" } ; -HELP: double-quote -{ $values - { "string" string } - { "new-string" null } } -{ $description "" } ; - HELP: find-primary-key { $values { "specs" null } @@ -266,12 +260,6 @@ HELP: set-slot-named { "value" null } { "name" null } { "obj" object } } { $description "" } ; -HELP: single-quote -{ $values - { "string" string } - { "new-string" null } } -{ $description "" } ; - HELP: spec>tuple { $values { "class" class } { "spec" null }