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