diff --git a/basis/db/db.factor b/basis/db/db.factor index 0b18044f2b..96b72b8865 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -2,17 +2,17 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes continuations destructors kernel math namespaces sequences classes.tuple words strings -tools.walker accessors combinators fry ; +tools.walker accessors combinators fry db.errors ; IN: db ->insert-statements @@ -23,6 +23,7 @@ PRIVATE> GENERIC: db-open ( db -- db-connection ) HOOK: db-close db-connection ( handle -- ) +HOOK: parse-db-error db-connection ( error -- error' ) : dispose-statements ( assoc -- ) values dispose-each ; @@ -77,7 +78,11 @@ GENERIC: bind-tuple ( tuple statement -- ) GENERIC: execute-statement* ( statement type -- ) M: object execute-statement* ( statement type -- ) - drop query-results dispose ; + '[ + _ _ drop query-results dispose + ] [ + parse-db-error rethrow + ] recover ; : execute-one-statement ( statement -- ) dup type>> execute-statement* ; diff --git a/basis/db/errors/errors.factor b/basis/db/errors/errors.factor index da6301639f..9420dbbfc4 100644 --- a/basis/db/errors/errors.factor +++ b/basis/db/errors/errors.factor @@ -8,3 +8,11 @@ ERROR: sql-error ; ERROR: table-exists ; ERROR: bad-schema ; + +ERROR: sql-syntax-error error ; + +ERROR: sql-table-exists table ; +C: sql-table-exists + +ERROR: sql-table-missing table ; +C: sql-table-missing diff --git a/basis/db/errors/postgresql/authors.txt b/basis/db/errors/postgresql/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/db/errors/postgresql/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/db/errors/postgresql/postgresql-tests.factor b/basis/db/errors/postgresql/postgresql-tests.factor new file mode 100644 index 0000000000..59b9bfe4a8 --- /dev/null +++ b/basis/db/errors/postgresql/postgresql-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test db.errors.postgresql ; +IN: db.errors.postgresql.tests diff --git a/basis/db/errors/postgresql/postgresql.factor b/basis/db/errors/postgresql/postgresql.factor new file mode 100644 index 0000000000..e45ff092e8 --- /dev/null +++ b/basis/db/errors/postgresql/postgresql.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: ; +IN: db.errors.postgresql diff --git a/basis/db/errors/sqlite/authors.txt b/basis/db/errors/sqlite/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/db/errors/sqlite/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/db/errors/sqlite/sqlite-tests.factor b/basis/db/errors/sqlite/sqlite-tests.factor new file mode 100644 index 0000000000..68ae55f8a8 --- /dev/null +++ b/basis/db/errors/sqlite/sqlite-tests.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit db db.errors +db.errors.sqlite db.sqlite io.files.unique kernel namespaces +tools.test ; +IN: db.errors.sqlite.tests + +: sqlite-error-test-db-path ( -- path ) + "sqlite" "error-test" make-unique-file ; + +sqlite-error-test-db-path [ + + [ + "insert into foo (id) values('1');" sql-command + ] [ + { [ sql-table-missing? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + + [ + "create table foo(id);" sql-command + "create table foo(id);" sql-command + ] [ + { [ sql-table-exists? ] [ table>> "foo" = ] } 1&& + ] must-fail-with + +] with-db \ No newline at end of file diff --git a/basis/db/errors/sqlite/sqlite.factor b/basis/db/errors/sqlite/sqlite.factor new file mode 100644 index 0000000000..c247a36257 --- /dev/null +++ b/basis/db/errors/sqlite/sqlite.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators db kernel sequences peg.ebnf +strings db.errors ; +IN: db.errors.sqlite + +ERROR: unparsed-sqlite-error error ; + +SINGLETONS: table-exists table-missing ; + +: sqlite-table-error ( table message -- error ) + { + { table-exists [ ] } + } case ; + +EBNF: parse-sqlite-sql-error + +TableMessage = " already exists" => [[ table-exists ]] + +SqliteError = + "table " (!(TableMessage).)+:table TableMessage:message + => [[ table >string message sqlite-table-error ]] + | "no such table: " .+:table + => [[ table >string ]] +;EBNF diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor index cf6dc903f1..e2e2cbf7c0 100644 --- a/basis/db/postgresql/postgresql-tests.factor +++ b/basis/db/postgresql/postgresql-tests.factor @@ -3,7 +3,7 @@ prettyprint sequences namespaces tools.test db db.private db.tuples db.types unicode.case accessors system ; IN: db.postgresql.tests -: test-db ( -- postgresql-db ) +: postgresql-test-db ( -- postgresql-db ) "localhost" >>host "postgres" >>username @@ -11,10 +11,10 @@ IN: db.postgresql.tests "factor-test" >>database ; os windows? cpu x86.64? and [ - [ ] [ test-db [ ] with-db ] unit-test + [ ] [ postgresql-test-db [ ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ [ "drop table person;" sql-command ] ignore-errors "create table person (name varchar(30), country varchar(30));" sql-command @@ -30,7 +30,7 @@ os windows? cpu x86.64? and [ { "Jane" "New Zealand" } } ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test @@ -40,11 +40,11 @@ os windows? cpu x86.64? and [ { "John" "America" } { "Jane" "New Zealand" } } - ] [ test-db [ "select * from person" sql-query ] with-db ] unit-test + ] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ "insert into person(name, country) values('Jimmy', 'Canada')" sql-command ] with-db @@ -56,10 +56,10 @@ os windows? cpu x86.64? and [ { "Jane" "New Zealand" } { "Jimmy" "Canada" } } - ] [ test-db [ "select * from person" sql-query ] with-db ] unit-test + ] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test [ - test-db [ + postgresql-test-db [ [ "insert into person(name, country) values('Jose', 'Mexico')" sql-command "insert into person(name, country) values('Jose', 'Mexico')" sql-command @@ -69,14 +69,14 @@ os windows? cpu x86.64? and [ ] must-fail [ 3 ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query length ] with-db ] unit-test [ ] [ - test-db [ + postgresql-test-db [ [ "insert into person(name, country) values('Jose', 'Mexico')" sql-command @@ -87,7 +87,7 @@ os windows? cpu x86.64? and [ ] unit-test [ 5 ] [ - test-db [ + postgresql-test-db [ "select * from person" sql-query length ] with-db ] unit-test diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 1f55dcf769..1c39166071 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -5,8 +5,8 @@ kernel math math.parser namespaces make prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators classes locals words tools.walker db.private -nmake accessors random db.queries destructors db.tuples.private ; -USE: tools.walker +nmake accessors random db.queries destructors db.tuples.private +db.postgresql ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty database username password ; @@ -280,3 +280,6 @@ M: postgresql-db-connection compound ( string object -- string' ) { "references" [ >reference-string ] } [ drop no-compound-found ] } case ; + +M: postgresql-db-connection parse-db-error + ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 19cfc5d0b7..5b658f36c9 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -6,7 +6,8 @@ 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 sequences.deep ; +io.streams.string multiline make db.private sequences.deep +db.errors.sqlite ; IN: db.sqlite TUPLE: sqlite-db path ; @@ -223,13 +224,6 @@ 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 ) [ <" @@ -255,13 +249,6 @@ 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 ) [ <" @@ -274,13 +261,6 @@ 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 ) [ <" @@ -292,13 +272,6 @@ 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 ; @@ -322,33 +295,22 @@ 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 +: create-db-triggers ( sql-specs -- ) + [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter + [ + [ class>> db-table-name "db-table" set ] [ - [ class>> db-table-name "db-table" set ] + [ "sql-spec" set ] + [ column-name>> "table-id" set ] + [ ] tri + modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter [ - [ "sql-spec" set ] - [ column-name>> "table-id" set ] - [ ] tri - modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter - [ - [ second db-table-name "foreign-table-name" set ] - [ third "foreign-table-id" set ] bi - _ execute - ] each - ] bi - ] each - ] call ; inline + [ second db-table-name "foreign-table-name" set ] + [ third "foreign-table-id" set ] bi + create-sqlite-triggers + ] each + ] bi + ] each ; : sqlite-create-table ( sql-specs class-name -- ) [ @@ -373,15 +335,12 @@ M: sqlite-db-connection persistent-table ( -- assoc ) M: sqlite-db-connection create-sql-statement ( class -- statement ) [ - ! specs name [ sqlite-create-table ] - [ drop \ create-sqlite-triggers db-triggers ] 2bi + [ drop create-db-triggers ] 2bi ] query-make ; M: sqlite-db-connection drop-sql-statement ( class -- statements ) - [ - nip "drop table " 0% 0% ";" 0% - ] query-make ; + [ nip "drop table " 0% 0% ";" 0% ] query-make ; M: sqlite-db-connection compound ( string seq -- new-string ) over { @@ -389,3 +348,9 @@ M: sqlite-db-connection compound ( string seq -- new-string ) { "references" [ >reference-string ] } [ 2drop ] } case ; + +M: sqlite-db-connection parse-db-error + dup n>> { + { 1 [ string>> parse-sqlite-sql-error ] } + [ drop ] + } case ;