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

View File

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

View File

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

View File

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