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

execute-statement is now a word not a generic 

sqlite works for tuple-tests
postgresql create/drop/insert works better now
db4
Doug Coleman 2008-02-14 01:27:54 -06:00
parent 35b5f222e3
commit 86667aee23
9 changed files with 130 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/db/db.factor
View File

@ -36,13 +36,17 @@ HOOK: <prepared-statement> db ( str -- statement )
GENERIC: prepare-statement ( statement -- )
GENERIC: bind-statement* ( obj statement -- )
GENERIC: reset-statement ( statement -- )
GENERIC: execute-statement* ( statement -- result-set )
GENERIC: insert-statement ( statement -- id )
HOOK: last-id db ( res -- id )
: execute-statement ( statement -- )
execute-statement* dispose ;
: execute-statement-last-id ( statement -- id )
execute-statement* [ last-id ] with-disposal ;
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 -- ? )
: execute-statement ( statement -- ) query-results dispose ;
: bind-statement ( obj statement -- )
dup statement-bound? [ dup reset-statement ] when
@ -50,14 +54,6 @@ HOOK: last-id db ( res -- id )
[ set-statement-params ] keep
t swap set-statement-bound? ;
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 -- ? )
: init-result-set ( result-set -- )
dup #rows over set-result-set-max
-1 swap set-result-set-n ;

11
extra/db/postgresql/lib/lib.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces
quotations sequences db.postgresql.ffi alien alien.c-types ;
quotations sequences db.postgresql.ffi alien alien.c-types
db.types ;
IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f )
@ -37,13 +38,9 @@ IN: db.postgresql.lib
>r db get db-handle r>
[ statement-sql ] keep
[ statement-params length f ] keep
statement-params [ second malloc-char-string ] map >c-void*-array
statement-params
[ first number>string* malloc-char-string ] map >c-void*-array
f f 0 PQexecParams
dup postgresql-result-ok? [
dup postgresql-result-error-message swap PQclear throw
] unless ;
: pq-oid-value ( res -- n )
PQoidValue dup InvalidOid = [
"postgresql returned an InvalidOid" throw
] when ;

6
extra/db/postgresql/postgresql-tests.factor
View File

@ -2,7 +2,7 @@
! Set username and password in the 'connect' word.
USING: kernel db.postgresql alien continuations io prettyprint
sequences namespaces tools.test db ;
sequences namespaces tools.test db db.types ;
IN: temporary
IN: scratchpad
@ -40,13 +40,13 @@ IN: temporary
test-db [
"select * from person where name = $1 and country = $2"
<simple-statement> [
{ "Jane" "New Zealand" }
{ { "Jane" TEXT } { "New Zealand" TEXT } }
over do-bound-query
{ { "Jane" "New Zealand" } } =
[ "test fails" throw ] unless
{ "John" "America" }
{ { "John" TEXT } { "America" TEXT } }
swap do-bound-query
] with-disposal
] with-db

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

@ -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 ;
db.tuples db.types tools.annotations ;
IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@ -52,8 +52,11 @@ 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 ;
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 ;
@ -105,72 +108,137 @@ 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" }
} ;
: postgresql-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ SERIAL "integer" }
{ TEXT "text" }
{ VARCHAR "varchar" }
{ DOUBLE "real" }
} ;
: enquote ( str -- newstr ) "(" swap ")" 3append ;
: postgresql-type ( str n/str -- newstr )
" " swap number>string* enquote 3append ;
: >sql-type* ( obj -- str )
dup pair? [
first2 >r >sql-type* r> postgresql-type
] [
dup postgresql-type-hash* at* [
nip
] [
drop >sql-type
] if
] if ;
M: postgresql-db >sql-type ( hash obj -- str )
dup pair? [
first2 >r >sql-type r> postgresql-type
] [
postgresql-type-hash at* [
no-sql-type
] unless
] if ;
M: postgresql-db create-sql ( columns table -- sql )
[
2dup
"create table " % %
" (" % [ ", " % ] [
dup second % " " %
dup third >sql-type % " " %
dup third >sql-type* % " " %
sql-modifiers " " join %
] interleave ")" %
] "" make ;
] interleave "); " %
M: postgresql-db drop-sql ( table -- sql )
[
"drop table " % %
] "" make ;
"create function add_" % dup %
"(" %
over [ "," % ]
[ third dup array? [ first ] when >sql-type % ] interleave
")" %
" returns bigint as '" %
SYMBOL: postgresql-counter
M: postgresql-db insert-sql* ( columns table -- sql )
[
postgresql-counter off
"insert into " %
2dup "insert into " %
%
"(" %
dup [ ", " % ] [ second % ] interleave
") " %
" values (" %
[ ", " % ] [
drop "$" % postgresql-counter [ inc ] keep get #
] interleave
[ ", " % ] [ drop counter% ] interleave
"); " %
"select currval(''" % % "_id_seq'');' language sql;" %
drop
] make-postgresql-counter dup . ;
M: postgresql-db drop-sql ( columns table -- sql )
[
dup "drop table " % %
"; drop function add_" % %
"(" %
[ "," % ] [ third >sql-type % ] interleave
")" %
] "" make ;
! \ create-sql reset
! \ create-sql watch
M: postgresql-db insert-sql* ( columns table -- sql )
[
"select add_" % %
"(" %
[ ", " % ] [ counter% ] interleave
")" %
] make-postgresql-counter ;
M: postgresql-db update-sql* ( columns table -- sql )
[
"update " %
%
" set " %
dup remove-id
[ ", " % ] [ second dup % " = :" % % ] interleave
[ ", " % ] [ second % " = " % counter% ] interleave
" where " %
[ primary-key? ] find nip second dup % " = :" % %
] "" make ;
[ primary-key? ] find nip second dup % " = " % counter%
] make-postgresql-counter ;
M: postgresql-db delete-sql* ( columns table -- sql )
[
"delete from " %
%
" where " %
first second dup % " = :" % %
] "" make ;
first second dup % " = " % counter%
] make-postgresql-counter ;
M: postgresql-db select-sql* ( columns table -- sql )
drop ;
M: postgresql-db tuple>params ( columns tuple -- obj )
[
>r dup first r> get-slot-named swap third
] curry { } map>assoc ;
[ >r dup third swap first r> get-slot-named swap ]
curry { } map>assoc ;
M: postgresql-db last-id ( res -- id )
pq-oid-value ;
drop f ;
: postgresql-db-modifiers ( -- hashtable )
H{
{ +native-id+ "primary key" }
{ +native-id+ "not null primary key" }
{ +assigned-id+ "primary key" }
{ +autoincrement+ "autoincrement" }
{ +unique+ "unique" }
@ -189,18 +257,3 @@ M: postgresql-db sql-modifiers* ( modifiers -- str )
swap at
] if
] with map [ ] subset ;
: postgresql-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ TEXT "text" }
{ VARCHAR "text" }
{ DOUBLE "real" }
} ;
M: postgresql-db >sql-type ( obj -- str )
dup pair? [
first >sql-type
] [
postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
] if ;

3
extra/db/sqlite/lib/lib.factor
View File

@ -74,10 +74,11 @@ IN: db.sqlite.lib
dup array? [ first ] when
{
{ INTEGER [ sqlite-bind-int-by-name ] }
{ BIG_INTEGER [ sqlite-bind-int-by-name ] }
{ BIG_INTEGER [ sqlite-bind-int64-by-name ] }
{ TEXT [ sqlite-bind-text-by-name ] }
{ VARCHAR [ sqlite-bind-text-by-name ] }
{ DOUBLE [ sqlite-bind-double-by-name ] }
{ SERIAL [ sqlite-bind-int-by-name ] }
! { NULL [ sqlite-bind-null-by-name ] }
[ no-sql-type ]
} case ;

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

@ -58,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- )
M: sqlite-statement reset-statement ( statement -- )
statement-handle sqlite-reset ;
M: sqlite-statement execute-statement* ( statement -- obj )
query-results ;
M: sqlite-statement insert-statement ( statement -- id )
query-results [ last-id ] with-disposal ;
M: sqlite-result-set #columns ( result-set -- n )
result-set-handle sqlite-#columns ;
@ -93,9 +93,10 @@ M: sqlite-db create-sql ( columns table -- sql )
] interleave ")" %
] "" make ;
M: sqlite-db drop-sql ( table -- sql )
M: sqlite-db drop-sql ( columns table -- sql )
[
"drop table " % %
drop
] "" make ;
M: sqlite-db insert-sql* ( columns table -- sql )
@ -175,6 +176,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
: sqlite-type-hash ( -- assoc )
H{
{ INTEGER "integer" }
{ SERIAL "integer" }
{ TEXT "text" }
{ VARCHAR "text" }
{ DOUBLE "real" }
@ -190,4 +192,3 @@ M: sqlite-db >sql-type ( obj -- str )
! HOOK: get-column-value ( n result-set type -- )
! M: sqlite get-column-value { { "TEXT" get-text-column } {
! "INTEGER" get-integer-column } ... } case ;

12
extra/db/tuples/tuples-tests.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.sqlite db.tuples
db.types continuations namespaces db.postgresql math
tools.time ;
db.types continuations namespaces db.postgresql math ;
! tools.time ;
IN: temporary
TUPLE: person the-id the-name the-number real ;
@ -44,7 +44,7 @@ SYMBOL: the-person
person "PERSON"
{
{ "the-id" "ROWID" INTEGER +native-id+ }
{ "the-id" "ID" SERIAL +native-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
@ -52,12 +52,12 @@ person "PERSON"
"billy" 10 3.14 <person> the-person set
test-sqlite
test-sqlite
! test-postgresql
person "PERSON"
{
{ "the-id" "ROWID" INTEGER +assigned-id+ }
{ "the-id" "ID" INTEGER +assigned-id+ }
{ "the-name" "NAME" { VARCHAR 256 } +not-null+ }
{ "the-number" "AGE" INTEGER { +default+ 0 } }
{ "real" "REAL" DOUBLE { +default+ 0.3 } }
@ -65,5 +65,5 @@ person "PERSON"
1 "billy" 20 6.28 <assigned-person> the-person set
test-sqlite
test-sqlite
! test-postgresql

6
extra/db/tuples/tuples.factor
View File

@ -39,7 +39,7 @@ TUPLE: no-slot-named ;
[ <prepared-statement> ] 3compose cache nip ; inline
HOOK: create-sql db ( columns table -- sql )
HOOK: drop-sql db ( table -- sql )
HOOK: drop-sql db ( columns table -- sql )
HOOK: insert-sql* db ( columns table -- sql )
HOOK: update-sql* db ( columns table -- sql )
HOOK: delete-sql* db ( columns table -- sql )
@ -75,12 +75,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
dup db-columns swap db-table create-sql sql-command ;
: drop-table ( class -- )
db-table drop-sql sql-command ;
dup db-columns swap db-table drop-sql sql-command ;
: insert-tuple ( tuple -- )
[
[ maybe-remove-id ] [ insert-sql ]
make-tuple-statement execute-statement-last-id
make-tuple-statement insert-statement
] keep set-primary-key ;
: update-tuple ( tuple -- )

1
extra/db/types/types.factor
View File

@ -22,6 +22,7 @@ SYMBOL: +not-null+
SYMBOL: +has-many+
SYMBOL: SERIAL
SYMBOL: INTEGER
SYMBOL: DOUBLE
SYMBOL: BOOLEAN