steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve the db protocol and update sqlite to use it

db4
Doug Coleman 2008-02-02 23:28:33 -06:00
parent 7954bc33bf
commit 2c1bad2254
4 changed files with 108 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
extra/db/db.factor
View File

@ -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 ( -- )

47
extra/db/postgresql/postgresql.factor
View File

@ -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> ;

41
extra/db/sqlite/sqlite-tests.factor
View File

@ -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

49
extra/db/sqlite/sqlite.factor
View File

@ -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 ;