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

rename db-table to db-table-name, use db-table-name instead of class name in creating triggers for sqlite

db4
Doug Coleman 2009-02-12 17:29:31 -06:00
parent 4e5b7bfa21
commit 8993e0536b
3 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/db/queries/queries.factor
View File

@ -44,11 +44,11 @@ M: retryable execute-statement* ( statement type -- )
] bi attempt-all drop ;
: sql-props ( class -- columns table )
[ db-columns ] [ db-table ] bi ;
[ db-columns ] [ db-table-name ] bi ;
: query-make ( class quot -- statements )
#! query, input, outputs, secondary queries
over db-table "table" set
over db-table-name "table-name" set
[ sql-props ] dip
[ 0 sql-counter rot with-variable ] curry
{ "" { } { } { } } nmake

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

@ -225,11 +225,11 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: insert-trigger ( -- string )
[
<"
CREATE TRIGGER fki_${table}_${foreign-table}_id
BEFORE INSERT ON ${table}
CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
"> interpolate
] with-string-writer ;
@ -237,12 +237,12 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: insert-trigger-not-null ( -- string )
[
<"
CREATE TRIGGER fki_${table}_${foreign-table}_id
BEFORE INSERT ON ${table}
CREATE TRIGGER fki_${table-name}_${foreign-table-name}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"')
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
WHERE NEW.${foreign-table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
"> interpolate
] with-string-writer ;
@ -250,11 +250,11 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: update-trigger ( -- string )
[
<"
CREATE TRIGGER fku_${table}_${foreign-table}_id
BEFORE UPDATE ON ${table}
CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
"> interpolate
] with-string-writer ;
@ -262,12 +262,12 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: update-trigger-not-null ( -- string )
[
<"
CREATE TRIGGER fku_${table}_${foreign-table}_id
BEFORE UPDATE ON ${table}
CREATE TRIGGER fku_${table-name}_${foreign-table-name}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"')
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
WHERE NEW.${foreign-table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
"> interpolate
] with-string-writer ;
@ -275,11 +275,11 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: delete-trigger-restrict ( -- string )
[
<"
CREATE TRIGGER fkd_${table}_${foreign-table}_id
BEFORE DELETE ON ${foreign-table}
CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table}" violates foreign key constraint "fk_${foreign-table}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
END;
"> interpolate
] with-string-writer ;
@ -287,10 +287,10 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: delete-trigger-cascade ( -- string )
[
<"
CREATE TRIGGER fkd_${table}_${foreign-table}_id
BEFORE DELETE ON ${foreign-table}
CREATE TRIGGER fkd_${table-name}_${foreign-table-name}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
DELETE from ${table} WHERE ${table-id} = OLD.${foreign-table-id};
DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id};
END;
"> interpolate
] with-string-writer ;
@ -323,7 +323,7 @@ M: sqlite-db-connection compound ( string seq -- new-string )
{ "default" [ first number>string " " glue ] }
{ "references" [
[ >reference-string ] keep
first2 [ "foreign-table" set ]
first2 [ db-table-name "foreign-table-name" set ]
[ "foreign-table-id" set ] bi*
create-sqlite-triggers
] }

4
basis/db/types/types.factor
View File

@ -49,7 +49,7 @@ ERROR: no-slot ;
ERROR: not-persistent class ;
: db-table ( class -- object )
: db-table-name ( class -- object )
dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
: db-columns ( class -- object )
@ -165,7 +165,7 @@ ERROR: no-column column ;
: >reference-string ( string pair -- string )
first2
[ [ db-table " " glue ] [ db-columns ] bi ] dip
[ [ db-table-name " " glue ] [ db-columns ] bi ] dip
swap [ column-name>> = ] with find nip
[ no-column ] unless*
column-name>> "(" ")" surround append ;