diff --git a/extra/db/db.factor b/extra/db/db.factor index 365f0c009c..3595558dec 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes continuations kernel math -namespaces sequences sequences.lib tuples words ; +namespaces sequences sequences.lib tuples words strings ; IN: db TUPLE: db handle insert-statements update-statements delete-statements select-statements ; @@ -37,14 +37,14 @@ GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: reset-statement ( statement -- ) GENERIC: insert-statement ( statement -- id ) -HOOK: last-id db ( res -- id ) TUPLE: result-set sql params handle n max ; GENERIC: query-results ( query -- result-set ) GENERIC: #rows ( result-set -- n ) GENERIC: #columns ( result-set -- n ) GENERIC# row-column 1 ( result-set n -- obj ) -GENERIC: advance-row ( result-set -- ? ) +GENERIC: advance-row ( result-set -- ) +GENERIC: more-rows? ( result-set -- ? ) : execute-statement ( statement -- ) query-results dispose ; @@ -56,7 +56,7 @@ GENERIC: advance-row ( result-set -- ? ) : init-result-set ( result-set -- ) dup #rows over set-result-set-max - -1 swap set-result-set-n ; + 0 swap set-result-set-n ; : ( query handle tuple -- result-set ) >r >r { statement-sql statement-params } get-slots r> @@ -70,10 +70,10 @@ GENERIC: advance-row ( result-set -- ? ) dup #columns [ row-column ] with map ; : query-each ( statement quot -- ) - over advance-row [ - 2drop + over more-rows? [ + [ call ] 2keep over advance-row query-each ] [ - [ call ] 2keep query-each + 2drop ] if ; inline : query-map ( statement quot -- seq ) @@ -94,11 +94,6 @@ GENERIC: advance-row ( result-set -- ? ) : do-bound-command ( obj query -- ) [ bind-statement ] keep execute-statement ; -: sql-query ( sql -- rows ) - [ do-query ] with-disposal ; - -: sql-command ( sql -- ) - [ execute-statement ] with-disposal ; SYMBOL: in-transaction HOOK: begin-transaction db ( -- ) @@ -112,3 +107,13 @@ HOOK: rollback-transaction db ( -- ) begin-transaction [ ] [ rollback-transaction ] cleanup commit-transaction ] with-variable ; + +: sql-query ( sql -- rows ) + [ do-query ] with-disposal ; + +: sql-command ( sql -- ) + dup string? [ + [ execute-statement ] with-disposal + ] [ + [ [ sql-command ] each ] with-transaction + ] if ; diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 93c66708b4..f198a5c04c 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -3,7 +3,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 ; +db.tuples db.types tools.annotations math.ranges ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; @@ -52,14 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n ) M: postgresql-result-set row-column ( result-set n -- obj ) >r dup result-set-handle swap result-set-n r> PQgetvalue ; -M: postgresql-statement execute-statement ( statement -- obj ) - query-results dispose ; - M: postgresql-statement insert-statement ( statement -- id ) - query-results dispose ; - -: increment-n ( result-set -- n ) - dup result-set-n 1+ dup rot set-result-set-n ; + query-results [ break 0 row-column ] with-disposal ; M: postgresql-statement query-results ( query -- result-set ) dup statement-params [ @@ -71,8 +65,11 @@ M: postgresql-statement query-results ( query -- result-set ) postgresql-result-set dup init-result-set ; -M: postgresql-result-set advance-row ( result-set -- ? ) - dup increment-n swap result-set-max >= ; +M: postgresql-result-set advance-row ( result-set -- ) + dup result-set-n 1+ swap set-result-set-n ; + +M: postgresql-result-set more-rows? ( result-set -- ? ) + dup result-set-n swap result-set-max < ; M: postgresql-statement dispose ( query -- ) dup statement-handle PQclear @@ -108,15 +105,6 @@ M: postgresql-db commit-transaction ( -- ) M: postgresql-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; -SYMBOL: postgresql-counter - -: make-postgresql-counter ( quot -- ) - [ postgresql-counter off ] swap compose "" make ; - -: counter% ( -- ) - CHAR: $ , - postgresql-counter [ inc ] keep get # ; - : postgresql-type-hash* ( -- assoc ) H{ { SERIAL "serial" } @@ -156,16 +144,9 @@ M: postgresql-db >sql-type ( hash obj -- str ) ] unless ] if ; -M: postgresql-db create-sql ( columns table -- sql ) +: insert-function ( columns table -- sql ) [ - 2dup - "create table " % % - " (" % [ ", " % ] [ - dup second % " " % - dup third >sql-type* % " " % - sql-modifiers " " join % - ] interleave "); " % - + >r remove-id r> "create function add_" % dup % "(" % over [ "," % ] @@ -179,33 +160,52 @@ M: postgresql-db create-sql ( columns table -- sql ) dup [ ", " % ] [ second % ] interleave ") " % " values (" % - [ ", " % ] [ drop counter% ] interleave + length [1,b] [ ", " % ] [ "$" % # ] interleave "); " % "select currval(''" % % "_id_seq'');' language sql;" % drop - ] make-postgresql-counter dup . ; + ] "" make ; -M: postgresql-db drop-sql ( columns table -- sql ) +: drop-function ( columns table -- sql ) [ - dup "drop table " % % - "; drop function add_" % % + >r remove-id r> + "drop function add_" % % "(" % [ "," % ] [ third >sql-type % ] interleave ")" % - ] "" make ; -! \ create-sql reset -! \ create-sql watch +M: postgresql-db create-sql ( columns table -- seq ) + [ + [ + 2dup + "create table " % % + " (" % [ ", " % ] [ + dup second % " " % + dup third >sql-type* % " " % + sql-modifiers " " join % + ] interleave "); " % + ] "" make , + + over native-id? [ insert-function , ] [ 2drop ] if + ] { } make ; + +M: postgresql-db drop-sql ( columns table -- seq ) + [ + [ + dup "drop table " % % ";" % + ] "" make , + over native-id? [ drop-function , ] [ 2drop ] if + ] { } make ; M: postgresql-db insert-sql* ( columns table -- sql ) [ "select add_" % % "(" % - [ ", " % ] [ counter% ] interleave + length [1,b] [ ", " % ] [ "$" % # ] interleave ")" % - ] make-postgresql-counter ; + ] "" make ; M: postgresql-db update-sql* ( columns table -- sql ) [ @@ -213,18 +213,19 @@ M: postgresql-db update-sql* ( columns table -- sql ) % " set " % dup remove-id - [ ", " % ] [ second % " = " % counter% ] interleave + dup length [1,b] swap 2array flip + [ ", " % ] [ first2 second % " = $" % # ] interleave " where " % - [ primary-key? ] find nip second dup % " = " % counter% - ] make-postgresql-counter ; + [ primary-key? ] find nip second dup % " = $" % length 2 + # + ] "" make ; M: postgresql-db delete-sql* ( columns table -- sql ) [ "delete from " % % " where " % - first second dup % " = " % counter% - ] make-postgresql-counter ; + first second % " = $1" % + ] "" make ; M: postgresql-db select-sql* ( columns table -- sql ) drop ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 2c0f2ae130..dfa8a4b2dc 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -100,13 +100,13 @@ IN: db.sqlite.lib : sqlite-row ( handle -- seq ) dup sqlite-#columns [ sqlite-column ] with map ; -: step-complete? ( step-result -- bool ) +: sqlite-step-has-more-rows? ( step-result -- bool ) dup SQLITE_ROW = [ - drop f + drop t ] [ dup SQLITE_DONE = - [ drop ] [ sqlite-check-result ] if t + [ drop ] [ sqlite-check-result ] if f ] if ; : sqlite-next ( prepared -- ? ) - sqlite3_step step-complete? ; + sqlite3_step sqlite-step-has-more-rows? ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index d83642bd8c..298220b3ca 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -25,9 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ; TUPLE: sqlite-statement ; C: sqlite-statement -TUPLE: sqlite-result-set advanced? ; -: ( query -- sqlite-result-set ) - dup statement-handle sqlite-result-set ; +TUPLE: sqlite-result-set has-more? ; M: sqlite-db ( str -- obj ) ; @@ -40,13 +38,7 @@ M: sqlite-db ( str -- obj ) M: sqlite-statement dispose ( statement -- ) statement-handle sqlite-finalize ; -: maybe-advance-row ( result-set -- result-set ) - dup sqlite-result-set-advanced? [ - dup advance-row drop - ] unless ; - M: sqlite-result-set dispose ( result-set -- ) - maybe-advance-row f swap set-result-set-handle ; : sqlite-bind ( triples handle -- ) @@ -58,8 +50,12 @@ M: sqlite-statement bind-statement* ( triples statement -- ) M: sqlite-statement reset-statement ( statement -- ) statement-handle sqlite-reset ; +: last-insert-id ( -- id ) + db get db-handle sqlite3_last_insert_rowid + dup zero? [ "last-id failed" throw ] when ; + M: sqlite-statement insert-statement ( statement -- id ) - query-results [ last-id ] with-disposal ; + execute-statement last-insert-id ; M: sqlite-result-set #columns ( result-set -- n ) result-set-handle sqlite-#columns ; @@ -67,12 +63,16 @@ M: sqlite-result-set #columns ( result-set -- n ) M: sqlite-result-set row-column ( result-set n -- obj ) >r result-set-handle r> sqlite-column ; -M: sqlite-result-set advance-row ( result-set -- handle ? ) +M: sqlite-result-set advance-row ( result-set -- ) [ result-set-handle sqlite-next ] keep - t swap set-sqlite-result-set-advanced? ; + set-sqlite-result-set-has-more? ; + +M: sqlite-result-set more-rows? ( result-set -- ? ) + sqlite-result-set-has-more? ; M: sqlite-statement query-results ( query -- result-set ) - dup statement-handle sqlite-result-set ; + dup statement-handle sqlite-result-set + dup advance-row ; M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ; @@ -145,11 +145,6 @@ M: sqlite-db tuple>params ( columns tuple -- obj ) dupd >r first r> get-slot-named swap third 3array ] curry map ; - -M: sqlite-db last-id ( result-set -- id ) - maybe-advance-row drop - db get db-handle sqlite3_last_insert_rowid - dup zero? [ "last-id failed" throw ] when ; : sqlite-db-modifiers ( -- hashtable ) H{ diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index cb4129965c..72fb6396b5 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -30,7 +30,8 @@ SYMBOL: the-person [ ] [ the-person get update-tuple ] unit-test - [ ] [ the-person get delete-tuple ] unit-test ; + [ ] [ the-person get delete-tuple ] unit-test + [ ] [ person drop-table ] unit-test ; : test-sqlite ( -- ) "tuples-test.db" resource-path [ @@ -52,8 +53,8 @@ person "PERSON" "billy" 10 3.14 the-person set - test-sqlite -! test-postgresql +! test-sqlite +test-postgresql person "PERSON" { @@ -65,5 +66,5 @@ person "PERSON" 1 "billy" 20 6.28 the-person set - test-sqlite +! test-sqlite ! test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 1697de83d3..74726f12aa 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -38,8 +38,9 @@ TUPLE: no-slot-named ; [ db-table dupd ] swap [ ] 3compose cache nip ; inline -HOOK: create-sql db ( columns table -- sql ) -HOOK: drop-sql db ( columns table -- sql ) +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 ) diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 30c15682fa..7cacbcf861 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -11,6 +11,12 @@ SYMBOL: +assigned-id+ : primary-key? ( spec -- ? ) [ { +native-id+ +assigned-id+ } member? ] contains? ; +: contains-id? ( columns id -- ? ) + swap [ member? ] with contains? ; + +: assigned-id? ( columns -- ? ) +assigned-id+ contains-id? ; +: native-id? ( columns -- ? ) +native-id+ contains-id? ; + ! Same concept, SQLite has autoincrement, PostgreSQL has serial SYMBOL: +autoincrement+ SYMBOL: +serial+