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

checking in db before a major overhaul

db4
Doug Coleman 2008-02-15 20:37:54 -06:00
parent d8e7f0c84a
commit 3028416a4c
5 changed files with 54 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/db/db.factor
View File

@ -4,12 +4,9 @@ USING: arrays assocs classes continuations kernel math
namespaces sequences sequences.lib tuples words strings ;
IN: db
TUPLE: db handle insert-statements update-statements delete-statements select-statements ;
TUPLE: db handle insert-statements update-statements delete-statements ;
: <db> ( handle -- obj )
H{ } clone
H{ } clone
H{ } clone
H{ } clone
H{ } clone H{ } clone H{ } clone
db construct-boa ;
GENERIC: db-open ( db -- )
@ -23,11 +20,10 @@ HOOK: db-close db ( handle -- )
dup db-insert-statements dispose-statements
dup db-update-statements dispose-statements
dup db-delete-statements dispose-statements
dup db-select-statements dispose-statements
db-handle db-close
] with-variable ;
TUPLE: statement sql params handle bound? ;
TUPLE: statement sql params handle bound? slot-names ;
TUPLE: simple-statement ;
TUPLE: prepared-statement ;
@ -115,5 +111,7 @@ HOOK: rollback-transaction db ( -- )
dup string? [
<simple-statement> [ execute-statement ] with-disposal
] [
[ [ sql-command ] each ] with-transaction
! [
[ sql-command ] each
! ] with-transaction
] if ;

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

@ -65,7 +65,7 @@ M: postgresql-result-set sql-type>factor-type ( obj type -- newobj )
} case ;
M: postgresql-statement insert-statement ( statement -- id )
query-results [ break 0 row-column ] with-disposal ;
query-results [ 0 row-column ] with-disposal string>number ;
M: postgresql-statement query-results ( query -- result-set )
dup statement-params [
@ -211,7 +211,7 @@ M: postgresql-db drop-sql ( columns table -- seq )
over native-id? [ drop-function , ] [ 2drop ] if
] { } make ;
M: postgresql-db insert-sql* ( columns table -- sql )
M: postgresql-db insert-sql* ( columns table -- slot-names sql )
[
"select add_" % %
"(" %
@ -219,7 +219,7 @@ M: postgresql-db insert-sql* ( columns table -- sql )
")" %
] "" make ;
M: postgresql-db update-sql* ( columns table -- sql )
M: postgresql-db update-sql* ( columns table -- slot-names sql )
[
"update " %
%
@ -231,7 +231,7 @@ M: postgresql-db update-sql* ( columns table -- sql )
[ primary-key? ] find nip second dup % " = $" % length 2 + #
] "" make ;
M: postgresql-db delete-sql* ( columns table -- sql )
M: postgresql-db delete-sql* ( columns table -- slot-names sql )
[
"delete from " %
%
@ -239,7 +239,7 @@ M: postgresql-db delete-sql* ( columns table -- sql )
first second % " = $1" %
] "" make ;
M: postgresql-db select-sql* ( columns table -- sql )
M: postgresql-db select-sql ( columns table -- slot-names sql )
drop ;
M: postgresql-db tuple>params ( columns tuple -- obj )

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

@ -114,6 +114,10 @@ M: sqlite-db insert-sql* ( columns table -- sql )
")" %
] "" make ;
: where-primary-key% ( columns -- )
" where " %
[ primary-key? ] find nip second dup % " = :" % % ;
M: sqlite-db update-sql* ( columns table -- sql )
[
"update " %
@ -121,8 +125,7 @@ M: sqlite-db update-sql* ( columns table -- sql )
" set " %
dup remove-id
[ ", " % ] [ second dup % " = :" % % ] interleave
" where " %
[ primary-key? ] find nip second dup % " = :" % %
where-primary-key%
] "" make ;
M: sqlite-db delete-sql* ( columns table -- sql )
@ -133,13 +136,18 @@ M: sqlite-db delete-sql* ( columns table -- sql )
first second dup % " = :" % %
] "" make ;
M: sqlite-db select-sql* ( columns table -- sql )
: select-interval ( interval name -- )
;
: select-sequence ( seq name -- )
;
M: sqlite-db select-sql ( columns table -- sql )
[
"select ROWID, " %
swap [ ", " % ] [ second % ] interleave
" from " %
%
" where ROWID = :ID" %
over [ ", " % ] [ second % ] interleave
" from " % %
" where " %
] "" make ;
M: sqlite-db tuple>params ( columns tuple -- obj )

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

@ -31,7 +31,7 @@ SYMBOL: the-person
[ ] [ the-person get update-tuple ] unit-test
[ ] [ the-person get delete-tuple ] unit-test
[ ] [ person drop-table ] unit-test ;
; ! 1 [ ] [ person drop-table ] unit-test ;
: test-sqlite ( -- )
"tuples-test.db" resource-path <sqlite-db> [
@ -54,17 +54,17 @@ person "PERSON"
"billy" 10 3.14 <person> the-person set
! test-sqlite
test-postgresql
test-postgresql
person "PERSON"
{
{ "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 } }
} define-persistent
! person "PERSON"
! {
! { "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 } }
! } define-persistent
1 "billy" 20 6.28 <assigned-person> the-person set
! 1 "billy" 20 6.28 <assigned-person> the-person set
! test-sqlite
! test-postgresql

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

@ -41,13 +41,25 @@ TUPLE: no-slot-named ;
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 )
HOOK: select-sql* db ( columns table -- sql )
HOOK: insert-sql* db ( columns table -- slot-names sql )
HOOK: update-sql* db ( columns table -- slot-names sql )
HOOK: delete-sql* db ( columns table -- slot-names sql )
HOOK: select-sql db ( tuple -- statement )
HOOK: row-column-typed db ( result-set n type -- sql )
HOOK: sql-type>factor-type db ( obj type -- obj )
HOOK: tuple>params db ( columns tuple -- obj )
HOOK: make-slot-names* db ( quot -- seq )
HOOK: column-slot-name% db ( spec -- )
HOOK: column-bind-name% db ( spec -- )
: make-slots-names ( quot -- seq str )
[ make-column-names ] "" make ; inline
: slot-name% ( seq -- ) first % ;
: column-name% ( seq -- ) second % ;
: column-type% ( seq -- ) third % ;
: insert-sql ( columns class -- statement )
db get db-insert-statements [ insert-sql* ] cache-statement ;
@ -58,10 +70,6 @@ HOOK: sql-type>factor-type db ( obj type -- obj )
: delete-sql ( columns class -- statement )
db get db-delete-statements [ delete-sql* ] cache-statement ;
: select-sql ( columns class -- statement )
db get db-select-statements [ select-sql* ] cache-statement ;
HOOK: tuple>params db ( columns tuple -- obj )
: tuple-statement ( columns tuple quot -- statement )
>r [ tuple>params ] 2keep class r> call
@ -93,8 +101,8 @@ HOOK: tuple>params db ( columns tuple -- obj )
: delete-tuple ( tuple -- )
[ [ primary-key? ] subset ] [ delete-sql ] do-tuple-statement ;
! : select-tuple ( tuple -- )
! [ select-sql ] bind-tuple do-query ;
: select-tuple ( tuple -- )
[ select-sql ] keep do-query ;
: persist ( tuple -- )
dup primary-key [ update-tuple ] [ insert-tuple ] if ;