From 4329578b2fb066a9a21fe610aa93899205cc99d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 17 Dec 2008 19:35:53 -0600 Subject: [PATCH] add a new db-connection tuple for live database connections instead of reusing the db setup tuple update sqlite and postgresql backends for the change --- basis/db/db.factor | 18 +++++++---- basis/db/postgresql/postgresql.factor | 46 ++++++++++++++++----------- basis/db/queries/queries.factor | 13 ++++---- basis/db/sqlite/lib/lib.factor | 5 +-- basis/db/sqlite/sqlite-tests.factor | 4 +-- basis/db/sqlite/sqlite.factor | 44 +++++++++++++++---------- 6 files changed, 78 insertions(+), 52 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index b7bd8218a2..d4e91cf720 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -5,24 +5,30 @@ namespaces sequences classes.tuple words strings tools.walker accessors combinators fry ; IN: db -TUPLE: db +SYMBOL: db + +>insert-statements H{ } clone >>update-statements H{ } clone >>delete-statements ; inline +PRIVATE> + GENERIC: db-open ( db -- db ) HOOK: db-close db ( handle -- ) : dispose-statements ( assoc -- ) values dispose-each ; -M: db dispose ( db -- ) +M: db-connection dispose ( db -- ) dup db [ [ dispose-statements H{ } clone ] change-insert-statements [ dispose-statements H{ } clone ] change-update-statements @@ -130,9 +136,9 @@ 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 ; +M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ; +M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ; +M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ; : in-transaction? ( -- ? ) in-transaction get ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 90a875b8ff..0041a70985 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io kernel math math.parser namespaces make prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges -combinators classes locals words tools.walker +combinators classes locals words tools.walker db.private nmake accessors random db.queries destructors db.tuples.private ; USE: tools.walker IN: db.postgresql -TUPLE: postgresql-db < db - host port pgopts pgtty database username password ; +TUPLE: postgresql-db host port pgopts pgtty database username password ; : ( -- postgresql-db ) - postgresql-db new-db ; + postgresql-db new ; + + ( handle -- db-connection ) + postgresql-db-connection new-db-connection + swap >>handle ; + +PRIVATE> TUPLE: postgresql-statement < statement ; TUPLE: postgresql-result-set < result-set ; -M: postgresql-db db-open ( db -- db ) - dup { +M: postgresql-db db-open ( db -- db-connection ) + { [ host>> ] [ port>> ] [ pgopts>> ] @@ -28,9 +36,9 @@ M: postgresql-db db-open ( db -- db ) [ database>> ] [ username>> ] [ password>> ] - } cleave connect-postgres >>handle ; + } cleave connect-postgres ; -M: postgresql-db db-close ( handle -- ) +M: postgresql-db-connection db-close ( handle -- ) PQfinish ; M: postgresql-statement bind-statement* ( statement -- ) drop ; @@ -103,20 +111,20 @@ M: postgresql-statement prepare-statement ( statement -- ) length f PQprepare postgresql-error >>handle drop ; -M: postgresql-db ( sql in out -- statement ) +M: postgresql-db-connection ( sql in out -- statement ) postgresql-statement new-statement ; -M: postgresql-db ( sql in out -- statement ) +M: postgresql-db-connection ( sql in out -- statement ) dup prepare-statement ; : bind-name% ( -- ) CHAR: $ 0, sql-counter [ inc ] [ get 0# ] bi ; -M: postgresql-db bind% ( spec -- ) +M: postgresql-db-connection bind% ( spec -- ) bind-name% 1, ; -M: postgresql-db bind# ( spec object -- ) +M: postgresql-db-connection bind# ( spec object -- ) [ bind-name% f swap type>> ] dip 1, ; @@ -162,7 +170,7 @@ M: postgresql-db bind# ( spec object -- ) "_seq'');' language sql;" 0% ] query-make ; -M: postgresql-db create-sql-statement ( class -- seq ) +M: postgresql-db-connection create-sql-statement ( class -- seq ) [ [ create-table-sql , ] keep dup db-assigned? [ create-function-sql , ] [ drop ] if @@ -182,13 +190,13 @@ M: postgresql-db create-sql-statement ( class -- seq ) "drop table " 0% 0% drop ] query-make ; -M: postgresql-db drop-sql-statement ( class -- seq ) +M: postgresql-db-connection drop-sql-statement ( class -- seq ) [ [ drop-table-sql , ] keep dup db-assigned? [ drop-function-sql , ] [ drop ] if ] { } make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db-connection ( class -- statement ) [ "select add_" 0% 0% "(" 0% @@ -198,7 +206,7 @@ M: postgresql-db ( class -- statement ) ");" 0% ] query-make ; -M: postgresql-db ( class -- statement ) +M: postgresql-db-connection ( class -- statement ) [ "insert into " 0% 0% "(" 0% @@ -221,10 +229,10 @@ M: postgresql-db ( class -- statement ) ");" 0% ] query-make ; -M: postgresql-db insert-tuple-set-key ( tuple statement -- ) +M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- ) query-modify-tuple ; -M: postgresql-db persistent-table ( -- hashtable ) +M: postgresql-db-connection persistent-table ( -- hashtable ) H{ { +db-assigned-id+ { "integer" "serial" f } } { +user-assigned-id+ { f f f } } @@ -264,7 +272,7 @@ M: postgresql-db persistent-table ( -- hashtable ) } ; ERROR: no-compound-found string object ; -M: postgresql-db compound ( string object -- string' ) +M: postgresql-db-connection compound ( string object -- string' ) over { { "default" [ first number>string " " glue ] } { "varchar" [ first number>string "(" ")" surround append ] } diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index a96398ff2c..2d7ea67107 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -3,7 +3,8 @@ USING: accessors kernel math namespaces make sequences random strings math.parser math.intervals combinators math.bitwise nmake db db.tuples db.types classes words shuffle arrays -destructors continuations db.tuples.private prettyprint ; +destructors continuations db.tuples.private prettyprint +db.private ; IN: db.queries GENERIC: where ( specs obj -- ) @@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- ) dup column-name>> 0% " = " 0% bind% ] interleave ; -M: db ( class -- statement ) +M: db-connection ( class -- statement ) [ "update " 0% 0% " set " 0% @@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ; : where-clause ( tuple specs -- ) dupd filter-slots [ drop ] [ many-where ] if-empty ; -M: db ( tuple table -- sql ) +M: db-connection ( tuple table -- sql ) [ "delete from " 0% 0% where-clause @@ -150,7 +151,7 @@ M: db ( tuple table -- sql ) ERROR: all-slots-ignored class ; -M: db ( tuple class -- statement ) +M: db-connection ( tuple class -- statement ) [ "select " 0% [ dupd filter-ignores ] dip @@ -185,13 +186,13 @@ M: db ( tuple class -- statement ) [ offset>> [ do-offset ] [ drop ] if* ] } 2cleave ; -M: db query>statement ( query -- tuple ) +M: db-connection query>statement ( query -- tuple ) [ tuple>> dup class ] keep [ ] dip make-query* ; ! select ID, NAME, SCORE from EXAM limit 1 offset 3 -M: db ( query -- statement ) +M: db-connection ( query -- statement ) [ tuple>> dup class ] keep [ [ "select count(*) from " 0% 0% where-clause ] query-make ] dip make-query* ; diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index bcd38b172d..6741296806 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -5,7 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary io.backend db.errors present urls io.encodings.utf8 -io.encodings.string accessors shuffle ; +io.encodings.string accessors shuffle io prettyprint ; IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; @@ -124,7 +124,8 @@ ERROR: sqlite-sql-error < sql-error n string ; ] if* (sqlite-bind-type) ; : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ; -: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ; +: sqlite-reset ( handle -- ) +"resetting: " write dup . sqlite3_reset sqlite-check-result ; : sqlite-clear-bindings ( handle -- ) sqlite3_clear_bindings sqlite-check-result ; : sqlite-#columns ( query -- int ) sqlite3_column_count ; diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index b816e414ba..6fb1cd19ad 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -3,8 +3,8 @@ kernel namespaces prettyprint tools.test db.sqlite db sequences continuations db.types db.tuples unicode.case ; IN: db.sqlite.tests -: db-path "test.db" temp-file ; -: test.db db-path ; +: db-path ( -- path ) "test.db" temp-file ; +: test.db ( -- sqlite-db ) db-path ; [ ] [ [ db-path delete-file ] ignore-errors ] unit-test diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 32c5ca0075..42a2cb56ee 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -6,28 +6,38 @@ sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random math.bitwise db.queries destructors db.tuples.private interpolate -io.streams.string multiline make ; +io.streams.string multiline make db.private ; IN: db.sqlite -TUPLE: sqlite-db < db path ; +TUPLE: sqlite-db path ; : ( path -- sqlite-db ) - sqlite-db new-db + sqlite-db new swap >>path ; -M: sqlite-db db-open ( db -- db ) - dup path>> sqlite-open >>handle ; + ( handle -- db-connection ) + sqlite-db-connection new-db-connection + swap >>handle ; + +PRIVATE> + +M: sqlite-db db-open ( db -- db-connection ) + path>> sqlite-open ; + +M: sqlite-db-connection db-close ( handle -- ) sqlite-close ; TUPLE: sqlite-statement < statement ; TUPLE: sqlite-result-set < result-set has-more? ; -M: sqlite-db ( str in out -- obj ) +M: sqlite-db-connection ( str in out -- obj ) ; -M: sqlite-db ( str in out -- obj ) +M: sqlite-db-connection ( str in out -- obj ) sqlite-statement new-statement ; : sqlite-maybe-prepare ( statement -- statement ) @@ -92,7 +102,7 @@ ERROR: sqlite-last-id-fail ; db get handle>> sqlite3_last_insert_rowid dup zero? [ sqlite-last-id-fail ] when ; -M: sqlite-db insert-tuple-set-key ( tuple statement -- ) +M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- ) execute-statement last-insert-id swap set-primary-key ; M: sqlite-result-set #columns ( result-set -- n ) @@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set ) dup handle>> sqlite-result-set new-result-set dup advance-row ; -M: sqlite-db create-sql-statement ( class -- statement ) +M: sqlite-db-connection create-sql-statement ( class -- statement ) [ dupd "create table " 0% 0% @@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement ) "));" 0% ] query-make ; -M: sqlite-db drop-sql-statement ( class -- statement ) +M: sqlite-db-connection drop-sql-statement ( class -- statement ) [ "drop table " 0% 0% ";" 0% drop ] query-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db-connection ( tuple -- statement ) [ "insert into " 0% 0% "(" 0% @@ -159,19 +169,19 @@ M: sqlite-db ( tuple -- statement ) ");" 0% ] query-make ; -M: sqlite-db ( tuple -- statement ) +M: sqlite-db-connection ( tuple -- statement ) ; -M: sqlite-db bind# ( spec obj -- ) +M: sqlite-db-connection bind# ( spec obj -- ) [ [ column-name>> ":" next-sql-counter surround dup 0% ] [ type>> ] bi ] dip 1, ; -M: sqlite-db bind% ( spec -- ) +M: sqlite-db-connection bind% ( spec -- ) dup 1, column-name>> ":" prepend 0% ; -M: sqlite-db persistent-table ( -- assoc ) +M: sqlite-db-connection persistent-table ( -- assoc ) H{ { +db-assigned-id+ { "integer" "integer" f } } { +user-assigned-id+ { f f f } } @@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc ) delete-trigger-restrict sqlite-trigger, ] if ; -M: sqlite-db compound ( string seq -- new-string ) +M: sqlite-db-connection compound ( string seq -- new-string ) over { { "default" [ first number>string " " glue ] } { "references" [