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

cleanup

db4
Doug Coleman 2008-04-06 01:22:52 -05:00
parent aade46d448
commit 0804c7e7af
1 changed files with 22 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -20,7 +20,6 @@ M: sqlite-db db-close ( handle -- ) sqlite-close ;
M: sqlite-db dispose ( db -- ) dispose-db ;
TUPLE: sqlite-statement < throwable-statement ;
! INSTANCE: sqlite-statement throwable-statement
TUPLE: sqlite-result-set < result-set has-more? ;
@ -57,11 +56,11 @@ M: sqlite-statement bind-statement* ( statement -- )
M: sqlite-statement bind-tuple ( tuple statement -- )
[
statement-in-params
in-params>>
[
[ sql-spec-column-name ":" prepend ]
[ sql-spec-slot-name rot get-slot-named ]
[ sql-spec-type ] tri 3array
[ column-name>> ":" prepend ]
[ slot-name>> rot get-slot-named ]
[ type>> ] tri 3array
] with map
] keep
bind-statement ;
@ -71,28 +70,27 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
dup zero? [ "last-id failed" throw ] when ;
M: sqlite-db insert-tuple* ( tuple statement -- )
execute-statement last-insert-id swap set-primary-key ;
execute-statement last-insert-id >>primary-key drop ;
M: sqlite-result-set #columns ( result-set -- n )
result-set-handle sqlite-#columns ;
handle>> sqlite-#columns ;
M: sqlite-result-set row-column ( result-set n -- obj )
>r result-set-handle r> sqlite-column ;
[ handle>> ] [ sqlite-column ] bi* ;
M: sqlite-result-set row-column-typed ( result-set n -- obj )
dup pick result-set-out-params nth sql-spec-type
>r >r result-set-handle r> r> sqlite-column-typed ;
dup pick out-params>> nth type>>
>r >r handle>> r> r> sqlite-column-typed ;
M: sqlite-result-set advance-row ( result-set -- )
[ result-set-handle sqlite-next ] keep
set-sqlite-result-set-has-more? ;
dup handle>> sqlite-next >>has-more? drop ;
M: sqlite-result-set more-rows? ( result-set -- ? )
sqlite-result-set-has-more? ;
has-more?>> ;
M: sqlite-statement query-results ( query -- result-set )
sqlite-maybe-prepare
dup statement-handle sqlite-result-set construct-result-set
dup handle>> sqlite-result-set construct-result-set
dup advance-row ;
M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ;
@ -107,9 +105,9 @@ M: sqlite-db create-sql-statement ( class -- statement )
[
"create table " 0% 0%
"(" 0% [ ", " 0% ] [
dup sql-spec-column-name 0%
dup column-name>> 0%
" " 0%
dup sql-spec-type t lookup-type 0%
dup type>> t lookup-type 0%
modifiers 0%
] interleave ");" 0%
] sqlite-make ;
@ -122,7 +120,7 @@ M: sqlite-db <insert-native-statement> ( tuple -- statement )
"insert into " 0% 0%
"(" 0%
maybe-remove-id
dup [ ", " 0% ] [ sql-spec-column-name 0% ] interleave
dup [ ", " 0% ] [ column-name>> 0% ] interleave
") values(" 0%
[ ", " 0% ] [ bind% ] interleave
");" 0%
@ -133,11 +131,11 @@ M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
: where-primary-key% ( specs -- )
" where " 0%
find-primary-key dup sql-spec-column-name 0% " = " 0% bind% ;
find-primary-key dup column-name>> 0% " = " 0% bind% ;
: where-clause ( specs -- )
" where " 0%
[ " and " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave ;
[ " and " 0% ] [ dup column-name>> 0% " = " 0% bind% ] interleave ;
M: sqlite-db <update-tuple-statement> ( class -- statement )
[
@ -145,7 +143,7 @@ M: sqlite-db <update-tuple-statement> ( class -- statement )
0%
" set " 0%
dup remove-id
[ ", " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
[ ", " 0% ] [ dup column-name>> 0% " = " 0% bind% ] interleave
where-primary-key%
] sqlite-make ;
@ -154,23 +152,23 @@ M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
"delete from " 0% 0%
" where " 0%
find-primary-key
dup sql-spec-column-name 0% " = " 0% bind%
dup column-name>> 0% " = " 0% bind%
] sqlite-make ;
! : select-interval ( interval name -- ) ;
! : select-sequence ( seq name -- ) ;
M: sqlite-db bind% ( spec -- )
dup 1, sql-spec-column-name ":" prepend 0% ;
dup 1, column-name>> ":" prepend 0% ;
M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
[
"select " 0%
over [ ", " 0% ]
[ dup sql-spec-column-name 0% 2, ] interleave
[ dup column-name>> 0% 2, ] interleave
" from " 0% 0%
[ sql-spec-slot-name swap get-slot-named ] with subset
[ column-name>> swap get-slot-named ] with subset
dup empty? [ drop ] [ where-clause ] if ";" 0%
] sqlite-make ;