improve the db protocol and update sqlite to use it
Doug Coleman
parent
7954bc33bf
commit
2c1bad2254
extra/db
|
|
@ -12,30 +12,20 @@ C: <db> 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: <simple-statement> db ( str -- statement )
|
||||
HOOK: <bound-statement> db ( str obj -- statement )
|
||||
HOOK: <prepared-statement> db ( str -- statement )
|
||||
HOOK: <prepared-bound-statement> 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 -- ? )
|
||||
|
||||
: <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 )
|
||||
<simple-statement> do-query ;
|
||||
: do-bound-command ( obj query -- rows )
|
||||
[ bind-statement ] keep execute-statement ;
|
||||
|
||||
: do-bound-query ( sql obj -- rows )
|
||||
<bound-statement> do-query ;
|
||||
: sql-query ( sql -- rows )
|
||||
<simple-statement> [ do-query ] with-disposal ;
|
||||
|
||||
: do-simple-command ( sql -- )
|
||||
<simple-statement> do-statement ;
|
||||
|
||||
: do-bound-command ( sql obj -- )
|
||||
<bound-statement> do-statement ;
|
||||
: sql-command ( sql -- )
|
||||
<simple-statement> [ execute-statement ] with-disposal ;
|
||||
|
||||
SYMBOL: in-transaction
|
||||
HOOK: begin-transaction db ( -- )
|
||||
|
|
|
|||
|
|
@ -38,32 +38,41 @@ M: postgresql-db dispose ( db -- )
|
|||
: with-postgresql ( host ust pass db quot -- )
|
||||
>r <postgresql-db> 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 <simple-statement> ( sql -- statement )
|
|||
{ set-statement-sql } statement construct
|
||||
<postgresql-statement> ;
|
||||
|
||||
M: postgresql-db <bound-statement> ( sql array -- statement )
|
||||
{ set-statement-sql set-statement-params } statement construct
|
||||
<postgresql-statement> ;
|
||||
|
||||
M: postgresql-db <prepared-statement> ( sql -- statement )
|
||||
;
|
||||
|
||||
M: postgresql-db <prepared-bound-statement> ( sql seq -- statement )
|
||||
;
|
||||
{ set-statement-sql } statement construct
|
||||
<postgresql-statement> ;
|
||||
|
|
|
|||
|
|
@ -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" } }
|
||||
<bound-statement> dup [ sql-row ] query-map
|
||||
<simple-statement> [
|
||||
{ { ":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
|
||||
|
|
|
|||
|
|
@ -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> sqlite-statement
|
||||
|
||||
TUPLE: sqlite-result-set ;
|
||||
: <sqlite-result-set> ( query -- sqlite-result-set )
|
||||
dup statement-handle sqlite-result-set <result-set> ;
|
||||
|
||||
M: sqlite-db <simple-statement> ( str -- obj )
|
||||
<prepared-statement> ;
|
||||
|
||||
M: sqlite-db <bound-statement> ( str -- obj )
|
||||
<prepared-bound-statement> ;
|
||||
|
||||
M: sqlite-db <prepared-statement> ( str -- obj )
|
||||
db get db-handle over sqlite-prepare
|
||||
{ set-statement-sql set-statement-handle } statement construct
|
||||
<sqlite-statement> [ set-delegate ] keep ;
|
||||
|
||||
M: sqlite-db <prepared-bound-statement> ( str assoc -- obj )
|
||||
swap <prepared-statement> 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 <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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue