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

fix sqlite foreign triggers create/delete bug 

ignore-errors only if there is a sql spec defined for the class until database-specific errors are implemented
db4
Doug Coleman 2009-02-19 18:26:11 -06:00
parent 52365c76fd
commit a61bac7ab5
4 changed files with 130 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/db/sqlite/lib/lib.factor
View File

@ -5,8 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators
continuations db.types calendar.format serialize
io.streams.byte-array byte-arrays io.encodings.binary
io.backend db.errors present urls io.encodings.utf8
io.encodings.string accessors shuffle io prettyprint
db.private ;
io.encodings.string accessors shuffle io db.private ;
IN: db.sqlite.lib
ERROR: sqlite-error < db-error n string ;
@ -125,8 +124,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
] if* (sqlite-bind-type) ;
: sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
: sqlite-reset ( handle -- )
"resetting: " write dup . sqlite3_reset sqlite-check-result ;
: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
: sqlite-clear-bindings ( handle -- )
sqlite3_clear_bindings sqlite-check-result ;
: sqlite-#columns ( query -- int ) sqlite3_column_count ;

8
basis/db/sqlite/sqlite-tests.factor
View File

@ -1,6 +1,7 @@
USING: io io.files io.files.temp io.directories io.launcher
kernel namespaces prettyprint tools.test db.sqlite db sequences
continuations db.types db.tuples unicode.case ;
continuations db.types db.tuples unicode.case accessors arrays
sorting ;
IN: db.sqlite.tests
: db-path ( -- path ) "test.db" temp-file ;
@ -74,8 +75,9 @@ IN: db.sqlite.tests
] with-db
] unit-test
[ \ swap ensure-table ] must-fail
! You don't need a primary key
USING: accessors arrays sorting ;
TUPLE: things one two ;
things "THINGS" {
@ -163,5 +165,3 @@ watch "WATCH" {
user>> f user boa select-tuple
] with-db
] unit-test
[ \ swap ensure-table ] must-fail

135
basis/db/sqlite/sqlite.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays assocs classes compiler db hashtables
io.files kernel math math.parser namespaces prettyprint
io.files kernel math math.parser namespaces prettyprint fry
sequences strings classes.tuple alien.c-types continuations
db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
math.intervals io nmake accessors vectors math.ranges random
math.bitwise db.queries destructors db.tuples.private interpolate
io.streams.string multiline make db.private ;
io.streams.string multiline make db.private sequences.deep ;
IN: db.sqlite
TUPLE: sqlite-db path ;
@ -126,30 +126,6 @@ M: sqlite-statement query-results ( query -- result-set )
dup handle>> sqlite-result-set new-result-set
dup advance-row ;
M: sqlite-db-connection create-sql-statement ( class -- statement )
[
dupd
"create table " 0% 0%
"(" 0% [ ", " 0% ] [
dup "sql-spec" set
dup column-name>> [ "table-id" set ] [ 0% ] bi
" " 0%
dup type>> lookup-create-type 0%
modifiers 0%
] interleave
find-primary-key [
", " 0%
"primary key(" 0%
[ "," 0% ] [ column-name>> 0% ] interleave
")" 0%
] unless-empty
");" 0%
] query-make ;
M: sqlite-db-connection drop-sql-statement ( class -- statement )
[ "drop table " 0% 0% ";" 0% drop ] query-make ;
M: sqlite-db-connection <insert-db-assigned-statement> ( tuple -- statement )
[
"insert into " 0% 0%
@ -225,7 +201,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: insert-trigger ( -- string )
[
<"
CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
@ -237,7 +213,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: insert-trigger-not-null ( -- string )
[
<"
CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
@ -247,10 +223,17 @@ M: sqlite-db-connection persistent-table ( -- assoc )
"> interpolate
] with-string-writer ;
: drop-insert-trigger ( -- string )
[
<"
DROP TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id;
"> interpolate
] with-string-writer ;
: update-trigger ( -- string )
[
<"
CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
@ -262,7 +245,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: update-trigger-not-null ( -- string )
[
<"
CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
@ -272,10 +255,17 @@ M: sqlite-db-connection persistent-table ( -- assoc )
"> interpolate
] with-string-writer ;
: drop-update-trigger ( -- string )
[
<"
DROP TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id;
"> interpolate
] with-string-writer ;
: delete-trigger-restrict ( -- string )
[
<"
CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
@ -284,10 +274,17 @@ M: sqlite-db-connection persistent-table ( -- assoc )
"> interpolate
] with-string-writer ;
: drop-delete-trigger-restrict ( -- string )
[
<"
DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id;
"> interpolate
] with-string-writer ;
: delete-trigger-cascade ( -- string )
[
<"
CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id};
@ -295,6 +292,13 @@ M: sqlite-db-connection persistent-table ( -- assoc )
"> interpolate
] with-string-writer ;
: drop-delete-trigger-cascade ( -- string )
[
<"
DROP TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id;
"> interpolate
] with-string-writer ;
: can-be-null? ( -- ? )
"sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
@ -318,14 +322,69 @@ M: sqlite-db-connection persistent-table ( -- assoc )
delete-trigger-restrict sqlite-trigger,
] if ;
: drop-sqlite-triggers ( -- )
drop-insert-trigger sqlite-trigger,
drop-update-trigger sqlite-trigger,
delete-cascade? [
drop-delete-trigger-cascade sqlite-trigger,
] [
drop-delete-trigger-restrict sqlite-trigger,
] if ;
: db-triggers ( sql-specs word -- )
'[
[ modifiers>> [ +foreign-id+ = ] deep-any? ] filter
[
[ class>> db-table-name "db-table" set ]
[ column-name>> "table-id" set ]
[
modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter
[
[ second db-table-name "foreign-table-name" set ]
[ third "foreign-table-id" set ] bi
_ execute
] each
] tri
] each
] call ;
: sqlite-create-table ( sql-specs class-name -- )
[
"create table " 0% 0%
"(" 0% [ ", " 0% ] [
dup "sql-spec" set
dup column-name>> [ "table-id" set ] [ 0% ] bi
" " 0%
dup type>> lookup-create-type 0%
modifiers 0%
] interleave
] [
drop
find-primary-key [
", " 0%
"primary key(" 0%
[ "," 0% ] [ column-name>> 0% ] interleave
")" 0%
] unless-empty
");" 0%
] 2bi ;
M: sqlite-db-connection create-sql-statement ( class -- statement )
[
! specs name
[ sqlite-create-table ]
[ drop \ create-sqlite-triggers db-triggers ] 2bi
] query-make ;
M: sqlite-db-connection drop-sql-statement ( class -- statements )
[
[ nip "drop table " 0% 0% ";" 0% ]
[ drop \ drop-sqlite-triggers db-triggers ] 2bi
] query-make ;
M: sqlite-db-connection compound ( string seq -- new-string )
over {
{ "default" [ first number>string " " glue ] }
{ "references" [
[ >reference-string ] keep
first2 [ db-table-name "foreign-table-name" set ]
[ "foreign-table-id" set ] bi*
create-sqlite-triggers
] }
{ "references" [ >reference-string ] }
[ 2drop ]
} case ;

37
basis/db/tuples/tuples.factor
View File

@ -3,7 +3,8 @@
USING: arrays assocs classes db kernel namespaces
classes.tuple words sequences slots math accessors
math.parser io prettyprint db.types continuations
destructors mirrors sets db.types db.private ;
destructors mirrors sets db.types db.private fry
combinators.short-circuit ;
IN: db.tuples
HOOK: create-sql-statement db-connection ( class -- object )
@ -29,7 +30,7 @@ GENERIC: eval-generator ( singleton -- object )
: resulting-tuple ( exemplar-tuple row out-params -- tuple )
rot class new [
[ [ slot-name>> ] dip set-slot-named ] curry 2each
'[ slot-name>> _ set-slot-named ] 2each
] keep ;
: query-tuples ( exemplar-tuple statement -- seq )
@ -98,33 +99,49 @@ M: query >query clone ;
M: tuple >query <query> swap >>tuple ;
ERROR: no-defined-persistent object ;
: ensure-defined-persistent ( object -- object )
dup { [ class? ] [ "db-table" word-prop ] } 1&& [
no-defined-persistent
] unless ;
: create-table ( class -- )
ensure-defined-persistent
create-sql-statement [ execute-statement ] with-disposals ;
: drop-table ( class -- )
ensure-defined-persistent
drop-sql-statement [ execute-statement ] with-disposals ;
: recreate-table ( class -- )
ensure-defined-persistent
[
[ drop-sql-statement [ execute-statement ] with-disposals
] curry ignore-errors
'[
_ drop-sql-statement [ execute-statement ] with-disposals
] ignore-errors
] [ create-table ] bi ;
: ensure-table ( class -- ) [ create-table ] curry ignore-errors ;
: ensure-table ( class -- )
ensure-defined-persistent
'[ _ create-table ] ignore-errors ;
: ensure-tables ( classes -- ) [ ensure-table ] each ;
: insert-tuple ( tuple -- )
dup class db-columns find-primary-key db-assigned-id-spec?
dup class ensure-defined-persistent
db-columns find-primary-key db-assigned-id-spec?
[ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ;
: update-tuple ( tuple -- )
dup class
dup class ensure-defined-persistent
db-connection get update-statements>> [ <update-tuple-statement> ] cache
[ bind-tuple ] keep execute-statement ;
: delete-tuples ( tuple -- )
dup dup class <delete-tuples-statement> [
dup
dup class ensure-defined-persistent
<delete-tuples-statement> [
[ bind-tuple ] keep execute-statement
] with-disposal ;
@ -132,8 +149,8 @@ M: tuple >query <query> swap >>tuple ;
>query [ tuple>> ] [ query>statement ] bi do-select ;
: select-tuple ( query/tuple -- tuple/f )
>query 1 >>limit [ tuple>> ] [ query>statement ] bi do-select
[ f ] [ first ] if-empty ;
>query 1 >>limit [ tuple>> ] [ query>statement ] bi
do-select [ f ] [ first ] if-empty ;
: count-tuples ( query/tuple -- n )
>query [ tuple>> ] [ <count-statement> ] bi do-count