delete-tuple now takes an object as a template

db4
Doug Coleman 2008-04-28 17:35:45 -05:00
parent 1c2d252ffd
commit 2d93f85029
2 changed files with 12 additions and 17 deletions

View File

@ -35,14 +35,6 @@ M: db <update-tuple-statement> ( class -- statement )
where-primary-key% where-primary-key%
] query-make ; ] query-make ;
M: db <delete-tuple-statement> ( specs table -- sql )
[
"delete from " 0% 0%
" where " 0%
find-primary-key
dup column-name>> 0% " = " 0% bind%
] query-make ;
M: random-id-generator eval-generator ( singleton -- obj ) M: random-id-generator eval-generator ( singleton -- obj )
drop drop
system-random-generator get [ system-random-generator get [
@ -87,6 +79,14 @@ M: string where ( spec obj -- ) object-where ;
2dup slot-name>> swap get-slot-named where 2dup slot-name>> swap get-slot-named where
] interleave drop ; ] interleave drop ;
M: db <delete-tuple-statement> ( tuple table -- sql )
[
"delete from " 0% 0%
dupd
[ slot-name>> swap get-slot-named ] with filter
dup empty? [ 2drop ] [ where-clause ] if ";" 0%
] query-make ;
M: db <select-by-slots-statement> ( tuple class -- statement ) M: db <select-by-slots-statement> ( tuple class -- statement )
[ [
"select " 0% "select " 0%

View File

@ -39,13 +39,8 @@ HOOK: drop-sql-statement db ( class -- obj )
HOOK: <insert-db-assigned-statement> db ( class -- obj ) HOOK: <insert-db-assigned-statement> db ( class -- obj )
HOOK: <insert-user-assigned-statement> db ( class -- obj ) HOOK: <insert-user-assigned-statement> db ( class -- obj )
HOOK: <update-tuple-statement> db ( class -- obj ) HOOK: <update-tuple-statement> db ( class -- obj )
HOOK: <update-tuples-statement> db ( class -- obj ) HOOK: <delete-tuple-statement> db ( tuple class -- obj )
HOOK: <delete-tuple-statement> db ( class -- obj )
HOOK: <delete-tuples-statement> db ( class -- obj )
HOOK: <select-by-slots-statement> db ( tuple class -- tuple ) HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
HOOK: insert-tuple* db ( tuple statement -- ) HOOK: insert-tuple* db ( tuple statement -- )
@ -139,9 +134,9 @@ M: retryable execute-statement* ( statement type -- )
[ bind-tuple ] keep execute-statement ; [ bind-tuple ] keep execute-statement ;
: delete-tuple ( tuple -- ) : delete-tuple ( tuple -- )
dup class dup dup class <delete-tuple-statement> [
db get db-delete-statements [ <delete-tuple-statement> ] cache [ bind-tuple ] keep execute-statement
[ bind-tuple ] keep execute-statement ; ] with-disposal ;
: select-tuples ( tuple -- tuples ) : select-tuples ( tuple -- tuples )
dup dup class <select-by-slots-statement> [ dup dup class <select-by-slots-statement> [