diff --git a/extra/db/db.factor b/extra/db/db.factor index 597ac1f0f3..813ce901ff 100644 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -12,30 +12,20 @@ C: db ( handle -- obj ) GENERIC: db-open ( db -- ) GENERIC: db-close ( db -- ) -TUPLE: statement sql params handle bound? n max ; +TUPLE: statement sql params handle bound? ; TUPLE: simple-statement ; -TUPLE: bound-statement ; TUPLE: prepared-statement ; -TUPLE: prepared-bound-statement ; HOOK: db ( str -- statement ) -HOOK: db ( str obj -- statement ) HOOK: db ( str -- statement ) -HOOK: db ( str obj -- statement ) - -! TUPLE: result sql params handle n max ; - -GENERIC: #rows ( statement -- n ) -GENERIC: #columns ( statement -- n ) -GENERIC# row-column 1 ( statement n -- obj ) -GENERIC: advance-row ( statement -- ? ) GENERIC: prepare-statement ( statement -- ) -GENERIC: reset-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: rebind-statement ( obj statement -- ) +GENERIC: execute-statement ( statement -- ) + : bind-statement ( obj statement -- ) 2dup dup statement-bound? [ rebind-statement @@ -45,7 +35,24 @@ GENERIC: rebind-statement ( obj statement -- ) tuck set-statement-params t swap set-statement-bound? ; -: sql-row ( statement -- seq ) +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 -- ? ) + +: ( query handle tuple -- result-set ) + >r >r { statement-sql statement-params } get-slots r> + { + set-result-set-sql + set-result-set-params + set-result-set-handle + } result-set construct r> construct-delegate ; + +: sql-row ( result-set -- seq ) dup #columns [ row-column ] with map ; : query-each ( statement quot -- ) @@ -64,23 +71,20 @@ GENERIC: rebind-statement ( obj statement -- ) [ db swap with-variable ] curry with-disposal ] with-scope ; -: do-statement ( statement -- ) - [ advance-row drop ] with-disposal ; +: do-query ( query -- result-set ) + query-results [ [ sql-row ] query-map ] with-disposal ; -: do-query ( query -- rows ) - [ [ sql-row ] query-map ] with-disposal ; +: do-bound-query ( obj query -- rows ) + [ bind-statement ] keep do-query ; -: do-simple-query ( sql -- rows ) - do-query ; +: do-bound-command ( obj query -- rows ) + [ bind-statement ] keep execute-statement ; -: do-bound-query ( sql obj -- rows ) - do-query ; +: sql-query ( sql -- rows ) + [ do-query ] with-disposal ; -: do-simple-command ( sql -- ) - do-statement ; - -: do-bound-command ( sql obj -- ) - do-statement ; +: sql-command ( sql -- ) + [ execute-statement ] with-disposal ; SYMBOL: in-transaction HOOK: begin-transaction db ( -- ) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index cd2c34682e..2ea1b3a1dc 100644 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -38,32 +38,41 @@ M: postgresql-db dispose ( db -- ) : with-postgresql ( host ust pass db quot -- ) >r r> with-disposal ; -M: postgresql-statement #rows ( statement -- n ) + +M: postgresql-result-set #rows ( statement -- n ) statement-handle PQntuples ; -M: postgresql-statement #columns ( statement -- n ) +M: postgresql-result-set #columns ( statement -- n ) statement-handle PQnfields ; -M: postgresql-statement row-column ( statement n -- obj ) +M: postgresql-result-set row-column ( statement n -- obj ) >r dup statement-handle swap statement-n r> PQgetvalue ; -: init-statement ( statement -- ) - dup statement-max [ - dup do-postgresql-statement over set-statement-handle - dup #rows over set-statement-max - -1 over set-statement-n + +: init-result-set ( result-set -- ) + dup result-set-max [ + dup do-postgresql-statement over set-result-set-handle + dup #rows over set-result-set-max + -1 over set-result-set-n ] unless drop ; -: increment-n ( statement -- n ) - dup statement-n 1+ dup rot set-statement-n ; +: increment-n ( result-set -- n ) + dup result-set-n 1+ dup rot set-result-set-n ; + +M: postgresql-result-set advance-row ( result-set -- ? ) + dup init-result-set + dup increment-n swap result-set-max >= ; -M: postgresql-statement advance-row ( statement -- ? ) - dup init-statement - dup increment-n swap statement-max >= ; M: postgresql-statement dispose ( query -- ) dup statement-handle PQclear - 0 0 rot { set-statement-n set-statement-max } set-slots ; + f swap set-statement-handle ; + +M: postgresql-result-set dispose ( result-set -- ) + dup result-set-handle PQclear + 0 0 f roll { + set-statement-n set-statement-max set-statement-handle + } set-slots ; M: postgresql-statement prepare-statement ( statement -- ) [ @@ -76,12 +85,6 @@ M: postgresql-db ( sql -- statement ) { set-statement-sql } statement construct ; -M: postgresql-db ( sql array -- statement ) - { set-statement-sql set-statement-params } statement construct - ; - M: postgresql-db ( sql -- statement ) - ; - -M: postgresql-db ( sql seq -- statement ) - ; + { set-statement-sql } statement construct + ; diff --git a/extra/db/sqlite/sqlite-tests.factor b/extra/db/sqlite/sqlite-tests.factor index 79e967de24..ef1bbfc262 100644 --- a/extra/db/sqlite/sqlite-tests.factor +++ b/extra/db/sqlite/sqlite-tests.factor @@ -26,20 +26,27 @@ IN: temporary { "John" "America" } { "Jane" "New Zealand" } } -] [ test.db [ "select * from person" do-simple-query ] with-sqlite ] unit-test +] [ + "extra/db/sqlite/test.db" resource-path [ + "select * from person" sql-query + ] with-sqlite +] unit-test [ { { "John" "America" } } ] [ - test.db [ + "extra/db/sqlite/test.db" resource-path [ "select * from person where name = :name and country = :country" - { { ":name" "Jane" } { ":country" "New Zealand" } } - dup [ sql-row ] query-map + [ + { { ":name" "Jane" } { ":country" "New Zealand" } } + over do-bound-query - { { "Jane" "New Zealand" } } = [ "test fails" throw ] unless - { { ":name" "John" } { ":country" "America" } } over bind-statement + { { "Jane" "New Zealand" } } = + [ "test fails" throw ] unless - dup [ sql-row ] query-map swap dispose + { { ":name" "John" } { ":country" "America" } } + swap do-bound-query + ] with-disposal ] with-sqlite ] unit-test @@ -48,13 +55,13 @@ IN: temporary { "1" "John" "America" } { "2" "Jane" "New Zealand" } } -] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test +] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test [ ] [ "extra/db/sqlite/test.db" resource-path [ "insert into person(name, country) values('Jimmy', 'Canada')" - do-simple-command + sql-command ] with-sqlite ] unit-test @@ -64,13 +71,13 @@ IN: temporary { "2" "Jane" "New Zealand" } { "3" "Jimmy" "Canada" } } -] [ test.db [ "select rowid, * from person" do-simple-query ] with-sqlite ] unit-test +] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test [ "extra/db/sqlite/test.db" resource-path [ [ - "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command - "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command + "insert into person(name, country) values('Jose', 'Mexico')" sql-command + "insert into person(name, country) values('Jose', 'Mexico')" sql-command "oops" throw ] with-transaction ] with-sqlite @@ -78,7 +85,7 @@ IN: temporary [ 3 ] [ "extra/db/sqlite/test.db" resource-path [ - "select * from person" do-simple-query length + "select * from person" sql-query length ] with-sqlite ] unit-test @@ -86,14 +93,16 @@ IN: temporary ] [ "extra/db/sqlite/test.db" resource-path [ [ - "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command - "insert into person(name, country) values('Jose', 'Mexico')" do-simple-command + "insert into person(name, country) values('Jose', 'Mexico')" + sql-command + "insert into person(name, country) values('Jose', 'Mexico')" + sql-command ] with-transaction ] with-sqlite ] unit-test [ 5 ] [ "extra/db/sqlite/test.db" resource-path [ - "select * from person" do-simple-query length + "select * from person" sql-query length ] with-sqlite ] unit-test diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index c5964ed599..8352d2e11f 100644 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays assocs classes compiler db db.sql hashtables -io.files kernel math math.parser namespaces prettyprint sequences -strings sqlite.lib tuples alien.c-types continuations -db.sqlite.lib db.sqlite.ffi ; +USING: alien arrays assocs classes compiler db db.sql +hashtables io.files kernel math math.parser namespaces +prettyprint sequences strings tuples alien.c-types +continuations db.sqlite.lib db.sqlite.ffi ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -24,47 +24,52 @@ M: sqlite-db dispose ( obj -- ) TUPLE: sqlite-statement ; C: sqlite-statement +TUPLE: sqlite-result-set ; +: ( query -- sqlite-result-set ) + dup statement-handle sqlite-result-set ; + M: sqlite-db ( str -- obj ) ; -M: sqlite-db ( str -- obj ) - ; - M: sqlite-db ( str -- obj ) db get db-handle over sqlite-prepare { set-statement-sql set-statement-handle } statement construct [ set-delegate ] keep ; -M: sqlite-db ( str assoc -- obj ) - swap tuck bind-statement ; - M: sqlite-statement dispose ( statement -- ) statement-handle sqlite-finalize ; +M: sqlite-result-set dispose ( result-set -- ) + f swap set-result-set-handle ; + M: sqlite-statement bind-statement* ( assoc statement -- ) statement-handle swap sqlite-bind-assoc ; M: sqlite-statement rebind-statement ( assoc statement -- ) - dup reset-statement + dup statement-handle sqlite-reset statement-handle swap sqlite-bind-assoc ; -M: sqlite-statement #columns ( statement -- n ) - statement-handle sqlite-#columns ; +M: sqlite-statement execute-statement ( statement -- ) + statement-handle sqlite-next drop ; -M: sqlite-statement row-column ( statement n -- obj ) - >r statement-handle r> sqlite-column ; +M: sqlite-result-set #columns ( result-set -- n ) + result-set-handle sqlite-#columns ; -M: sqlite-statement advance-row ( statement -- ? ) - statement-handle sqlite-next ; +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 ? ) + result-set-handle sqlite-next ; + +M: sqlite-statement query-results ( query -- result-set ) + dup statement-handle sqlite-result-set ; -M: sqlite-statement reset-statement ( statement -- ) - statement-handle sqlite-reset ; M: sqlite-db begin-transaction ( -- ) - "BEGIN" do-simple-command ; + "BEGIN" sql-command ; M: sqlite-db commit-transaction ( -- ) - "COMMIT" do-simple-command ; + "COMMIT" sql-command ; M: sqlite-db rollback-transaction ( -- ) - "ROLLBACK" do-simple-command ; + "ROLLBACK" sql-command ;