From 8c6c643e3debe875bd14408cc3129d8148dfd125 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 19 May 2004 23:46:45 +0000 Subject: [PATCH] r9403: Rework conditions to be CommonSQL backward compatible --- ChangeLog | 6 +- TODO | 1 - db-aodbc/aodbc-sql.lisp | 20 +- db-mysql/mysql-sql.lisp | 62 ++-- db-odbc/odbc-api.lisp | 18 +- db-odbc/odbc-dbi.lisp | 3 +- db-odbc/odbc-sql.lisp | 41 ++- db-oracle/oracle-sql.lisp | 13 +- .../postgresql-socket-sql.lisp | 47 +-- db-postgresql/postgresql-sql.lisp | 73 +++-- db-sqlite/sqlite-sql.lisp | 24 +- debian/changelog | 7 + debian/control | 2 +- sql/classes.lisp | 12 +- sql/conditions.lisp | 242 +++++---------- sql/database.lisp | 41 ++- sql/db-interface.lisp | 14 +- sql/loop-extension.lisp | 42 ++- sql/objects.lisp | 10 +- sql/operations.lisp | 4 +- sql/package.lisp | 280 +++++++++--------- sql/sql.lisp | 6 +- sql/syntax.lisp | 2 +- sql/time.lisp | 12 +- sql/transaction.lisp | 5 +- 25 files changed, 456 insertions(+), 531 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4667f2c..6ba7890 100644 --- a/ChangeLog +++ b/ChangeLog @@ -7,7 +7,11 @@ 19 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * sql/package.lisp: Export initialize-database-type and *initialize-database-types* from CLSQL package. - + * sql/conditions.lisp: Add new CommonSQL compatible conditions, + remove old CLSQL conditions. + * sql/loop-extensions.lisp: Make errors of type sql-user-error + * */*.lisp: Convert to from old to new conditions + 18 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * sql/table.lisp: Add PURGE to drop command for oracle 10g backend. To handle this difference, will need to add a new database-drop-table diff --git a/TODO b/TODO index 58e6660..5eb551e 100644 --- a/TODO +++ b/TODO @@ -11,7 +11,6 @@ TESTS TO ADD COMMONSQL INCOMPATIBILITY - o Condition names/accessors o userenv (Oracle specific but deprecated in Oracle 9) VARIANCES FROM COMMONSQL diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp index f357e59..060db96 100644 --- a/db-aodbc/aodbc-sql.lisp +++ b/db-aodbc/aodbc-sql.lisp @@ -59,11 +59,10 @@ (clsql-error (e) (error e)) (error () ;; Init or Connect failed - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno nil - :error "Connection failed"))))) + :message "Connection failed"))))) (defmethod database-disconnect ((database aodbc-database)) #+aodbc-v2 @@ -80,11 +79,10 @@ (clsql-error (e) (error e)) (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error "Query failed")))) + :message "Query failed.")))) (defmethod database-execute-command (sql-expression (database aodbc-database)) @@ -94,11 +92,10 @@ (clsql-error (e) (error e)) (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno nil - :error "Execute command failed")))) + :error "Execute command failed.")))) (defstruct aodbc-result-set (query nil) @@ -127,11 +124,10 @@ (clsql-error (e) (error e)) (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error "Query result set failed")))) + :error "Query result set failed.")))) (defmethod database-dump-result-set (result-set (database aodbc-database)) #+aodbc-v2 diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 08f50fb..f85ffac 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -99,11 +99,11 @@ (let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql))) (socket nil)) (if (uffi:null-pointer-p mysql-ptr) - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)) + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)) (uffi:with-cstrings ((host-native host) (user-native user) (password-native password) @@ -117,11 +117,11 @@ db-native 0 socket-native 0)) (progn (setq error-occurred t) - (error 'clsql-connect-error + (error 'sql-connect-error :database-type database-type :connection-spec connection-spec - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr))) + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr))) (make-instance 'mysql-database :name (database-name-from-spec connection-spec database-type) @@ -173,16 +173,16 @@ (when field-names (result-field-names num-fields res-ptr)))) (mysql-free-result res-ptr)) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))) - (error 'clsql-sql-error + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))) + (error 'sql-database-data-error :database database :expression query-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))))) + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))))) (defmethod database-execute-command (sql-expression (database mysql-database)) (uffi:with-cstring (sql-native sql-expression) @@ -191,11 +191,11 @@ (if (zerop (mysql-real-query mysql-ptr sql-native (length sql-expression))) t - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))))) + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))))) (defstruct mysql-result-set @@ -233,16 +233,16 @@ (mysql-num-rows res-ptr)) (values result-set num-fields))) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))) - (error 'clsql-sql-error + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))) + (error 'sql-database-data-error :database database :expression query-expression - :errno (mysql-errno mysql-ptr) - :error (mysql-error-string mysql-ptr)))))) + :error-id (mysql-errno mysql-ptr) + :message (mysql-error-string mysql-ptr)))))) (defmethod database-dump-result-set (result-set (database mysql-database)) (mysql-free-result (mysql-result-set-res-ptr result-set)) @@ -398,12 +398,11 @@ name) (if (or (not (eql 0 status)) (and (search "failed" output) (search "error" output))) - (error 'clsql-access-error - :connection-spec connection-spec - :database-type type - :error - (format nil "database-create failed: ~A" output)) - t)))) + (error 'sql-database-error + :message + (format nil "mysql database creation failed with connection-spec ~A." + connection-spec)) + t)))) (defmethod database-destroy (connection-spec (type (eql :mysql))) (destructuring-bind (host name user password) connection-spec @@ -414,11 +413,10 @@ name) (if (or (not (eql 0 status)) (and (search "failed" output) (search "error" output))) - (error 'clsql-access-error - :connection-spec connection-spec - :database-type type - :error - (format nil "database-destroy failed: ~A" output)) + (error 'sql-database-error + :message + (format nil "mysql database deletion failed with connection-spec ~A." + connection-spec)) t)))) (defmethod database-probe (connection-spec (type (eql :mysql))) diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp index c5cca32..94017dc 100644 --- a/db-odbc/odbc-api.lisp +++ b/db-odbc/odbc-api.lisp @@ -113,20 +113,20 @@ as possible second argument) to the desired representation of date/time/timestam (progn ,result-code ,@body)) (#.$SQL_INVALID_HANDLE (error - 'clsql-sys:clsql-odbc-error - :odbc-message "Invalid handle")) + 'clsql-sys:sql-database-error + :message "ODBC: Invalid handle")) (#.$SQL_STILL_EXECUTING (error - 'clsql-sys:clsql-odbc-error - :odbc-message "Still executing")) + 'clsql-sys:sql-temporary-error + :message "ODBC: Still executing")) (#.$SQL_ERROR (multiple-value-bind (error-message sql-state) (handle-error (or ,henv +null-handle-ptr+) (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-sys:clsql-odbc-error - :odbc-message error-message + 'clsql-sys:sql-database-error + :message error-message :sql-state sql-state))) (#.$SQL_NO_DATA_FOUND (progn ,result-code ,@body)) @@ -138,9 +138,9 @@ as possible second argument) to the desired representation of date/time/timestam (or ,hdbc +null-handle-ptr+) (or ,hstmt +null-handle-ptr+)) (error - 'clsql-sys:clsql-odbc-error - :odbc-message error-message - :sql-state sql-state)) + 'clsql-sys:sql-database-error + :message error-message + :secondary-error-id sql-state)) #+ignore (progn ,result-code ,@body)))))) diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp index 29a44f0..3a14e72 100644 --- a/db-odbc/odbc-dbi.lisp +++ b/db-odbc/odbc-dbi.lisp @@ -176,7 +176,8 @@ the query against." )) ((zerop count) (close-query query) (when eof-errorp - (error 'clsql-odbc-error :odbc-message "Ran out of data in fetch-row")) + (error 'sql-database-data-error + :message "ODBC: Ran out of data in fetch-row")) eof-value) (t (car row))))) diff --git a/db-odbc/odbc-sql.lisp b/db-odbc/odbc-sql.lisp index 656e8f4..227c217 100644 --- a/db-odbc/odbc-sql.lisp +++ b/db-odbc/odbc-sql.lisp @@ -50,15 +50,14 @@ :data-source-name dsn)))) (store-type-of-connected-database db) db) - (clsql-error (e) - (error e)) - #+ignore - (error () ;; Init or Connect failed - (error 'clsql-connect-error - :database-type database-type - :connection-spec connection-spec - :errno nil - :error "Connection failed"))))) + #+ignore + (sql-condition (e) + (error e)) + (error () ;; Init or Connect failed + (error 'sql-connection-error + :database-type database-type + :connection-spec connection-spec + :message "Connection failed"))))) (defmethod database-underlying-type ((database odbc-database)) (database-odbc-db-type database)) @@ -92,29 +91,27 @@ (odbc-dbi:sql query-expression :db (database-odbc-conn database) :result-types result-types :column-names field-names) - (clsql-error (e) - (error e)) #+ignore + (sql-error (e) + (error e)) (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error "Query failed")))) + :message "Query failed")))) (defmethod database-execute-command (sql-expression (database odbc-database)) (handler-case (odbc-dbi:sql sql-expression :db (database-odbc-conn database)) - (clsql-error (e) - (error e)) #+ignore + (sql-error (e) + (error e)) (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno nil - :error "Execute command failed")))) + :message "Execute command failed")))) (defstruct odbc-result-set (query nil) @@ -138,13 +135,11 @@ (length column-names) nil ;; not able to return number of rows with odbc )) - #+ignore (error () - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error "Query result set failed")))) + :message "Query result set failed")))) (defmethod database-dump-result-set (result-set (database odbc-database)) (odbc-dbi:close-query (odbc-result-set-query result-set)) diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 7e471a9..ea990b5 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -140,17 +140,16 @@ the length of that format.") errcode errbuf +errbuf-len+ +oci-htype-error+) (let ((subcode (uffi:deref-pointer errcode :long))) (unless (and nulls-ok (= subcode +null-value-returned+)) - (error 'clsql-sql-error + (error 'sql-database-error :database database - :errno subcode - :expression nil - :error (uffi:convert-from-foreign-string errbuf))))))) + :error-id subcode + :message (uffi:convert-from-foreign-string errbuf))))))) (nulls-ok - (error 'clsql-sql-error + (error 'sql-database-error :database database :message "can't handle NULLS-OK without ERRHP")) (t - (error 'clsql-sql-error + (error 'sql-database-error :database database :message "OCI Error (and no ERRHP available to find subcode)")))) @@ -309,7 +308,7 @@ the length of that format.") (format nil "select user_tab_columns,column_name from user_tab_columns where user_tab_columns.table_name='~A'" table) - database nil nil)))) + database nil nil))) ;; Return one row of the table referred to by QC, represented as a diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index a0a534a..0bfc01b 100644 --- a/db-postgresql-socket/postgresql-socket-sql.lisp +++ b/db-postgresql-socket/postgresql-socket-sql.lisp @@ -106,10 +106,10 @@ doesn't depend on UFFI." (defun convert-to-clsql-warning (database condition) (ecase *backend-warning-behavior* (:warn - (warn 'clsql-database-warning :database database + (warn 'sql-database-warning :database database :message (postgresql-condition-message condition))) (:error - (error 'clsql-sql-error :database database + (error 'sql-database-error :database database :message (format nil "Warning upgraded to error: ~A" (postgresql-condition-message condition)))) ((:ignore nil) @@ -117,10 +117,11 @@ doesn't depend on UFFI." ))) (defun convert-to-clsql-error (database expression condition) - (error 'clsql-sql-error :database database + (error 'sql-database-data-error + :database database :expression expression - :errno (type-of condition) - :error (postgresql-condition-message condition))) + :error-id (type-of condition) + :message (postgresql-condition-message condition))) (defmacro with-postgresql-handlers ((database &optional expression) @@ -191,11 +192,11 @@ doesn't depend on UFFI." :password password)) (postgresql-error (c) ;; Connect failed - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno (type-of c) - :error (postgresql-condition-message c))) + :error-id (type-of c) + :message (postgresql-condition-message c))) (:no-error (connection) ;; Success, make instance (make-instance 'postgresql-socket-database @@ -217,11 +218,11 @@ doesn't depend on UFFI." (wait-for-query-results connection) (unless (eq status :cursor) (close-postgresql-connection connection) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression expression - :errno 'missing-result - :error "Didn't receive result cursor for query.")) + :error-id "missing-result" + :message "Didn't receive result cursor for query.")) (setq result-types (canonicalize-types result-types cursor)) (values (loop for row = (read-cursor-row cursor result-types) @@ -230,11 +231,11 @@ doesn't depend on UFFI." finally (unless (null (wait-for-query-results connection)) (close-postgresql-connection connection) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression expression - :errno 'multiple-results - :error "Received multiple results for query."))) + :error-id "multiple-results" + :message "Received multiple results for query."))) (when field-names (mapcar #'car (postgresql-cursor-fields cursor)))))))) @@ -258,19 +259,19 @@ doesn't depend on UFFI." ((eq status :completed) (unless (null (wait-for-query-results connection)) (close-postgresql-connection connection) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression expression - :errno 'multiple-results - :error "Received multiple results for command.")) + :error-id "multiple-results" + :message "Received multiple results for command.")) result) (t (close-postgresql-connection connection) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression expression - :errno 'missing-result - :error "Didn't receive completion for command."))))))) + :errno "missing-result" + :message "Didn't receive completion for command."))))))) (defstruct postgresql-socket-result-set (done nil) @@ -288,11 +289,11 @@ doesn't depend on UFFI." (wait-for-query-results connection) (unless (eq status :cursor) (close-postgresql-connection connection) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression expression - :errno 'missing-result - :error "Didn't receive result cursor for query.")) + :error-id "missing-result" + :message "Didn't receive result cursor for query.")) (values (make-postgresql-socket-result-set :done nil :cursor cursor diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index 0dc3f57..447bd7e 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -127,12 +127,12 @@ (declare (type pgsql-conn-def connection)) (when (not (eq (PQstatus connection) pgsql-conn-status-type#connection-ok)) - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno (PQstatus connection) - :error (tidy-error-message - (PQerrorMessage connection)))) + :error-id (PQstatus connection) + :message (tidy-error-message + (PQerrorMessage connection)))) (make-instance 'postgresql-database :name (database-name-from-spec connection-spec database-type) @@ -152,11 +152,10 @@ (uffi:with-cstring (query-native query-expression) (let ((result (PQexec conn-ptr query-native))) (when (uffi:null-pointer-p result) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error (tidy-error-message (PQerrorMessage conn-ptr)))) + :message (tidy-error-message (PQerrorMessage conn-ptr)))) (unwind-protect (case (PQresultStatus result) (#.pgsql-exec-status-type#empty-query @@ -179,12 +178,12 @@ (when field-names (result-field-names num-fields result))))) (t - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (PQresultStatus result) - :error (tidy-error-message - (PQresultErrorMessage result))))) + :error-id (PQresultStatus result) + :message (tidy-error-message + (PQresultErrorMessage result))))) (PQclear result)))))) (defun result-field-names (num-fields result) @@ -201,11 +200,10 @@ (uffi:with-cstring (sql-native sql-expression) (let ((result (PQexec conn-ptr sql-native))) (when (uffi:null-pointer-p result) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno nil - :error (tidy-error-message (PQerrorMessage conn-ptr)))) + :message (tidy-error-message (PQerrorMessage conn-ptr)))) (unwind-protect (case (PQresultStatus result) (#.pgsql-exec-status-type#command-ok @@ -215,12 +213,12 @@ (warn "Strange result...") t) (t - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno (PQresultStatus result) - :error (tidy-error-message - (PQresultErrorMessage result))))) + :error-id (PQresultStatus result) + :message (tidy-error-message + (PQresultErrorMessage result))))) (PQclear result)))))) (defstruct postgresql-result-set @@ -239,11 +237,10 @@ (uffi:with-cstring (query-native query-expression) (let ((result (PQexec conn-ptr query-native))) (when (uffi:null-pointer-p result) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno nil - :error (tidy-error-message (PQerrorMessage conn-ptr)))) + :message (tidy-error-message (PQerrorMessage conn-ptr)))) (case (PQresultStatus result) ((#.pgsql-exec-status-type#empty-query #.pgsql-exec-status-type#tuples-ok) @@ -263,12 +260,12 @@ (PQnfields result))))) (t (unwind-protect - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (PQresultStatus result) - :error (tidy-error-message - (PQresultErrorMessage result))) + :error-id (PQresultStatus result) + :message (tidy-error-message + (PQresultErrorMessage result))) (PQclear result)))))))) (defmethod database-dump-result-set (result-set (database postgresql-database)) @@ -524,12 +521,10 @@ name) (if (or (not (zerop status)) (search "database creation failed: ERROR:" output)) - (error 'clsql-access-error - :connection-spec connection-spec - :database-type type - :error - (format nil "database-create failed: ~A" - output)) + (error 'sql-database-error + :message + (format nil "createdb failed for postgresql backend with connection spec ~A." + connection-spec)) t)))) (defmethod database-destroy (connection-spec (type (eql :postgresql))) @@ -541,12 +536,10 @@ name) (if (or (not (zerop status)) (search "database removal failed: ERROR:" output)) - (error 'clsql-access-error - :connection-spec connection-spec - :database-type type - :error - (format nil "database-destory failed: ~A" - output)) + (error 'sql-database-error + :message + (format nil "dropdb failed for postgresql backend with connection spec ~A." + connection-spec)) t)))) @@ -594,11 +587,11 @@ (declare (type postgresql::pgsql-conn-ptr connection)) (unless (eq (PQstatus connection) :connection-ok) ;; Connect failed - (error 'clsql-connect-error + (error 'sql-connection-error :database-type :postgresql :connection-spec connection-spec - :errno (PQstatus connection) - :error (PQerrorMessage connection))) + :error-id (PQstatus connection) + :message (PQerrorMessage connection))) connection)))) (defmethod database-reconnect ((database postgresql-database)) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 6d7bbfa..8e1798b 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -45,11 +45,11 @@ :connection-spec connection-spec :sqlite-db (sqlite:sqlite-open (first connection-spec))) (sqlite:sqlite-error (err) - (error 'clsql-connect-error + (error 'sql-connection-error :database-type database-type :connection-spec connection-spec - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defmethod database-disconnect ((database sqlite-database)) (sqlite:sqlite-close (sqlite-db database)) @@ -67,11 +67,11 @@ "Result set not empty: ~@(~A~) row~:P, ~@(~A~) column~:P " :format-arguments (list row-n col-n)))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression sql-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err)))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err)))) t) (defstruct sqlite-result-set @@ -105,11 +105,11 @@ (values (nreverse rows) col-names)) (push new-row rows))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-data-error :database database :expression query-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defmethod database-query-result-set ((query-expression string) (database sqlite-database) @@ -134,11 +134,11 @@ (values result-set n-col nil) (values result-set n-col))))) (sqlite:sqlite-error (err) - (error 'clsql-sql-error + (error 'sql-database-error :database database :expression query-expression - :errno (sqlite:sqlite-error-code err) - :error (sqlite:sqlite-error-message err))))) + :error-id (sqlite:sqlite-error-code err) + :message (sqlite:sqlite-error-message err))))) (defun canonicalize-result-types (result-types n-col col-names) (when result-types diff --git a/debian/changelog b/debian/changelog index 47d4bb7..2c64767 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +cl-sql (2.10.19-1) unstable; urgency=low + + * New upstream + * Fix depends [patch from Erik Naggum] + + -- Kevin M. Rosenberg Wed, 19 May 2004 16:33:07 -0600 + cl-sql (2.10.18-1) unstable; urgency=low * New upstream diff --git a/debian/control b/debian/control index 1abcd05..b6d3a78 100644 --- a/debian/control +++ b/debian/control @@ -82,7 +82,7 @@ Description: CLSQL database backend, SQLite Package: cl-sql-tests Architecture: all -Depends: cl-sql, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-sqlite, cl-sql-odbc, rt +Depends: cl-sql, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-sql-sqlite, cl-sql-odbc, rt Suggests: acl-installer, libmyodbc, unixodbc,cl-sql-aodbc Description: Testing suite for CLSQL This package contains a test suite for CLSQL. It requires manual diff --git a/sql/classes.lisp b/sql/classes.lisp index 6203359..55801df 100644 --- a/sql/classes.lisp +++ b/sql/classes.lisp @@ -835,9 +835,9 @@ uninclusive, and the args from that keyword to the end." (let ((output (assoc (symbol-name constraint) *constraint-types* :test #'equal))) (if (null output) - (error 'clsql-sql-syntax-error - :reason (format nil "unsupported column constraint '~a'" - constraint)) + (error 'sql-user-error + :message (format nil "unsupported column constraint '~A'" + constraint)) (cdr output)))) (defmethod database-constraint-statement (constraint-list database) @@ -853,9 +853,9 @@ uninclusive, and the args from that keyword to the end." *constraint-types* :test #'equal))) (if (null output) - (error 'clsql-sql-syntax-error - :reason (format nil "unsupported column constraint '~a'" - constraint)) + (error 'sql-user-error + :message (format nil "unsupported column constraint '~A'" + constraint)) (setq string (concatenate 'string string (cdr output)))) (if (< 1 (length constraint)) (setq string (concatenate 'string string " ")))))))) diff --git a/sql/conditions.lisp b/sql/conditions.lisp index cfe3aa3..6270f91 100644 --- a/sql/conditions.lisp +++ b/sql/conditions.lisp @@ -2,16 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: conditions.lisp -;;;; Purpose: Error conditions for high-level SQL interface -;;;; Programmers: Kevin M. Rosenberg based on -;;;; Original code by Pierre R. Mai -;;;; Date Started: Feb 2002 +;;;; Name: conditions.lisp +;;;; Purpose: Error conditions for CLSQL ;;;; ;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg -;;;; and Copyright (c) 1999-2001 by Pierre R. Mai ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -24,187 +20,93 @@ "Action to perform on warning messages from backend. Default is to :warn. May also be set to :error to signal an error or :ignore/nil to silently ignore the warning.") -;;; Conditions -(define-condition clsql-condition () +;;; CommonSQL-compatible conditions + +(define-condition sql-condition () ()) -(define-condition clsql-error (error clsql-condition) - ()) - -(define-condition clsql-simple-error (simple-condition clsql-error) - ()) - -(define-condition clsql-warning (warning clsql-condition) - ()) - -(define-condition clsql-simple-warning (simple-condition clsql-warning) - ()) - -(define-condition clsql-generic-error (clsql-error) - ((message :initarg :message - :reader clsql-generic-error-message)) +(define-condition sql-database-error (simple-error sql-condition) + ((error-id :initarg :error-id + :initform nil + :reader sql-error-error-id) + (secondary-error-id :initarg :secondary-error-id + :initform nil + :reader sql-error-secondary-error-id) + (database-message :initarg :message + :initform nil + :reader sql-error-database-message) + (database :initarg :database + :initform nil + :reader sql-error-database)) (:report (lambda (c stream) - (format stream (clsql-generic-error-message c))))) - -(define-condition clsql-invalid-spec-error (clsql-error) - ((connection-spec :initarg :connection-spec - :reader clsql-invalid-spec-error-connection-spec) - (database-type :initarg :database-type - :reader clsql-invalid-spec-error-database-type) - (template :initarg :template - :reader clsql-invalid-spec-error-template)) - (:report (lambda (c stream) - (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A" - (clsql-invalid-spec-error-connection-spec c) - (clsql-invalid-spec-error-database-type c) - (clsql-invalid-spec-error-template c))))) - -(defmacro check-connection-spec (connection-spec database-type template) - "Check the connection specification against the provided template, -and signal an clsql-invalid-spec-error if they don't match." - `(handler-case - (destructuring-bind ,template ,connection-spec - (declare (ignore ,@(remove '&optional template))) - t) - (error () (error 'clsql-invalid-spec-error - :connection-spec ,connection-spec - :database-type ,database-type - :template (quote ,template))))) - -(define-condition clsql-access-error (clsql-error) - ((database-type :initarg :database-type - :reader clsql-access-error-database-type) - (connection-spec :initarg :connection-spec - :reader clsql-access-error-connection-spec) - (error :initarg :error :reader clsql-access-error-error)) - (:report (lambda (c stream) - (format stream "While trying to access database ~A~% using database-type ~A:~% Error ~A~% has occurred." - (database-name-from-spec - (clsql-access-error-connection-spec c) - (clsql-access-error-database-type c)) - (clsql-access-error-database-type c) - (clsql-access-error-error c))))) - -(define-condition clsql-connect-error (clsql-access-error) - ((errno :initarg :errno :reader clsql-connect-error-errno)) + (format stream "A database error occurred: ~A / ~A~% ~A" + (if (sql-error-database c) + (format nil " on database ~A" (sql-error-database c)) + "") + (sql-error-error-id c) + (sql-error-secondary-error-id c) + (sql-error-database-message c))))) + +(define-condition sql-connection-error (sql-database-error) + ((database-type :initarg :database-type :initform nil + :reader sql-error-database-type) + (connection-spec :initarg :connection-spec :initform nil + :reader sql-error-connection-spec)) (:report (lambda (c stream) (format stream "While trying to connect to database ~A~% using database-type ~A:~% Error ~D / ~A~% has occurred." (database-name-from-spec - (clsql-access-error-connection-spec c) - (clsql-access-error-database-type c)) - (clsql-access-error-database-type c) - (clsql-connect-error-errno c) - (clsql-access-error-error c))))) - -(define-condition clsql-sql-error (clsql-error) - ((database :initarg :database :reader clsql-sql-error-database) - (message :initarg :message :initform nil :reader clsql-sql-error-message) - (expression :initarg :expression :initarg nil :reader clsql-sql-error-expression) - (errno :initarg :errno :initarg nil :reader clsql-sql-error-errno) - (error :initarg :error :initarg nil :reader clsql-sql-error-error)) - (:report (lambda (c stream) - (if (clsql-sql-error-message c) - (format stream "While accessing database ~A,~% Error ~A~% has occurred." - (clsql-sql-error-database c) - (clsql-sql-error-message c)) - (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred." - (clsql-sql-error-database c) - (clsql-sql-error-expression c) - (clsql-sql-error-errno c) - (clsql-sql-error-error c)))))) - -(define-condition clsql-database-warning (clsql-warning) - ((database :initarg :database :reader clsql-database-warning-database) - (message :initarg :message :reader clsql-database-warning-message)) + (sql-error-connection-spec c) + (sql-error-database-type c)) + (sql-error-database-type c) + (sql-error-error-id c) + (sql-error-database-message c))))) + +(define-condition sql-database-data-error (sql-database-error) + ((expression :initarg :expression :initarg nil + :reader sql-error-expression)) (:report (lambda (c stream) - (format stream "While accessing database ~A~% Warning: ~A~% has occurred." - (clsql-database-warning-database c) - (clsql-database-warning-message c))))) - -(define-condition clsql-exists-condition (clsql-condition) - ((old-db :initarg :old-db :reader clsql-exists-condition-old-db) - (new-db :initarg :new-db :reader clsql-exists-condition-new-db - :initform nil)) - (:report (lambda (c stream) - (format stream "In call to ~S:~%" 'connect) - (cond - ((null (clsql-exists-condition-new-db c)) - (format stream - " There is an existing connection ~A to database ~A." - (clsql-exists-condition-old-db c) - (database-name (clsql-exists-condition-old-db c)))) - ((eq (clsql-exists-condition-new-db c) - (clsql-exists-condition-old-db c)) - (format stream - " Using existing connection ~A to database ~A." - (clsql-exists-condition-old-db c) - (database-name (clsql-exists-condition-old-db c)))) - (t - (format stream - " Created new connection ~A to database ~A~%, although there is an existing connection (~A)." - (clsql-exists-condition-new-db c) - (database-name (clsql-exists-condition-new-db c)) - (clsql-exists-condition-old-db c))))))) - -(define-condition clsql-exists-warning (clsql-exists-condition - clsql-warning) - ()) + (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred." + (sql-error-database c) + (sql-error-expression c) + (sql-error-error-id c) + (sql-error-database-message c))))) -(define-condition clsql-exists-error (clsql-exists-condition - clsql-error) +(define-condition sql-temporary-error (sql-database-error) ()) -(define-condition clsql-closed-error (clsql-error) - ((database :initarg :database :reader clsql-closed-error-database)) +(define-condition sql-user-error (simple-error sql-condition) + ((message :initarg :message + :initform "Unspecified error" + :reader sql-user-error-message)) (:report (lambda (c stream) - (format stream "The database ~A has already been closed." - (clsql-closed-error-database c))))) + (format stream "A CLSQL lisp code error occurred: ~A " + (sql-user-error-message c))))) -(define-condition clsql-no-database-error (clsql-error) - ((database :initarg :database :reader clsql-no-database-error-database)) - (:report (lambda (c stream) - (format stream "~S is not a CLSQL database." - (clsql-no-database-error-database c))))) - -(define-condition clsql-odbc-error (clsql-error) - ((odbc-message :initarg :odbc-message - :reader clsql-odbc-error-message) - (sql-state :initarg :sql-state :initform nil - :reader clsql-odbc-error-sql-state)) - (:report (lambda (c stream) - (format stream "[ODBC error] ~A; state: ~A" - (clsql-odbc-error-message c) - (clsql-odbc-error-sql-state c))))) ;; Signal conditions - (defun signal-closed-database-error (database) - (cerror "Ignore this error and return nil." - 'clsql-closed-error - :database database)) + (cerror 'sql-connection-error + :message + (format nil "Trying to perform operation on closed database ~A." + database))) (defun signal-no-database-error (database) - (error 'clsql-no-database-error :database database)) - -(define-condition clsql-type-error (clsql-error clsql-condition) - ((slotname :initarg :slotname - :reader clsql-type-error-slotname) - (typespec :initarg :typespec - :reader clsql-type-error-typespec) - (value :initarg :value - :reader clsql-type-error-value)) - (:report (lambda (c stream) - (format stream - "Invalid value ~A in slot ~A, not of type ~A." - (clsql-type-error-value c) - (clsql-type-error-slotname c) - (clsql-type-error-typespec c))))) - -(define-condition clsql-sql-syntax-error (clsql-error) - ((reason :initarg :reason - :reader clsql-sql-syntax-error-reason)) + (error 'sql-database-error + :message "Not a database: ~A." database)) + + +;;; CLSQL Extensions + +(define-condition sql-warning (warning sql-condition) + ((message :initarg :message :reader sql-warning-message)) (:report (lambda (c stream) - (format stream "Invalid SQL syntax: ~A" - (clsql-sql-syntax-error-reason c))))) + (format stream (sql-warning-message c))))) +(define-condition sql-database-warning (sql-warning) + ((database :initarg :database :reader sql-warning-database)) + (:report (lambda (c stream) + (format stream + "While accessing database ~A~% Warning: ~A~% has occurred." + (sql-warning-database c) + (sql-warning-message c))))) diff --git a/sql/database.lisp b/sql/database.lisp index b02a75a..704029f 100644 --- a/sql/database.lisp +++ b/sql/database.lisp @@ -86,7 +86,7 @@ pool is t the connection will be taken from the general pool, if pool is a conn-pool object the connection will be taken from this pool." (unless database-type - (error "Must specify a database-type.")) + (error 'sql-database-error :message "Must specify a database-type.")) (when (stringp connection-spec) (setq connection-spec (string-to-list-connection-spec connection-spec))) @@ -109,10 +109,18 @@ is a conn-pool object the connection will be taken from this pool." (:warn-new (setq result (database-connect connection-spec database-type)) - (warn 'clsql-exists-warning :old-db old-db :new-db result)) - (:error + (warn 'sql-warning + :message + (format nil + "Created new connection ~A to database ~A~%, although there is an existing connection (~A)." + result (database-name result) old-db))) + (:error (restart-case - (error 'clsql-exists-error :old-db old-db) + (error 'sql-connection-error + :message + "There is an existing connection ~A to database ~A." + old-db + (database-name old-db)) (create-new () :report "Create a new connection." (setq result @@ -122,7 +130,12 @@ is a conn-pool object the connection will be taken from this pool." (setq result old-db)))) (:warn-old (setq result old-db) - (warn 'clsql-exists-warning :old-db old-db :new-db old-db)) + (warn 'sql-warning + :message + (format nil + "Using existing connection ~A to database ~A." + old-db + (database-name old-db)))) (:old (setq result old-db))) (setq result @@ -163,8 +176,22 @@ this pool." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - +(defmacro check-connection-spec (connection-spec database-type template) + "Check the connection specification against the provided template, +and signal an sql-user-error if they don't match. This function +is called by database backends." + `(handler-case + (destructuring-bind ,template ,connection-spec + (declare (ignore ,@(remove '&optional template))) + t) + (error () + (error 'sql-user-error + :message + (format nil + "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A" + ,connection-spec + ,database-type + (quote ,template)))))) (defun reconnect (&key (database *default-database*) (error nil) (force t)) "Reconnects DATABASE to its underlying RDBMS. If successful, returns diff --git a/sql/db-interface.lisp b/sql/db-interface.lisp index 6484172..385e08b 100644 --- a/sql/db-interface.lisp +++ b/sql/db-interface.lisp @@ -85,7 +85,7 @@ implications, since many databases will require the query to be executed in full to answer this question. If the query produced no results then nil is returned for all values that would have been returned otherwise. If an error occurs during query execution, the -function should signal a clsql-sql-error.")) +function should signal a sql-database-data-error.")) (defgeneric database-dump-result-set (result-set database) (:method (result-set (database t)) @@ -158,13 +158,19 @@ if unable to destory.")) (:documentation "Select the last value in sequence NAME in DATABASE.")) (defgeneric database-start-transaction (database) - (:documentation "Start a transaction in DATABASE.")) + (:documentation "Start a transaction in DATABASE.") + (:method ((database t)) + (signal-no-database-error database))) (defgeneric database-commit-transaction (database) - (:documentation "Commit current transaction in DATABASE.")) + (:documentation "Commit current transaction in DATABASE.") + (:method ((database t)) + (signal-no-database-error database))) (defgeneric database-abort-transaction (database) - (:documentation "Abort current transaction in DATABASE.")) + (:documentation "Abort current transaction in DATABASE.") + (:method ((database t)) + (signal-no-database-error database))) (defgeneric database-get-type-specifier (type args database) (:documentation "Return the type SQL type specifier as a string, for diff --git a/sql/loop-extension.lisp b/sql/loop-extension.lisp index 701e77f..db1cfb6 100644 --- a/sql/loop-extension.lisp +++ b/sql/loop-extension.lisp @@ -16,7 +16,6 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #:ansi-loop (:import-from #+sbcl #:sb-loop #+allegro #:excl - #:loop-error #:*loop-epilogue* #:*loop-ansi-universe* #:add-loop-path))) @@ -34,19 +33,27 @@ (case prep ((:in :of) (when in-phrase - (ansi-loop::loop-error - "Duplicate OF or IN iteration path: ~S." (cons prep rest))) + (error 'clsql:sql-user-error + :message + (format nil + "Duplicate OF or IN iteration path: ~S." + (cons prep rest)))) (setq in-phrase rest)) ((:from) (when from-phrase - (ansi-loop::loop-error - "Duplicate FROM iteration path: ~S." (cons prep rest))) + (error 'clsql:sql-user-error + :message + (format nil + "Duplicate FROM iteration path: ~S." + (cons prep rest)))) (setq from-phrase rest)) (t - (ansi-loop::loop-error - "Unknown preposition: ~S." prep)))) + (error 'clsql:sql-user-error + :message + (format nil"Unknown preposition: ~S." prep))))) (unless in-phrase - (ansi-loop::loop-error "Missing OF or IN iteration path.")) + (error 'clsql:sql-user-error + :message "Missing OF or IN iteration path.")) (unless from-phrase (setq from-phrase '(clsql-sys:*default-database*))) @@ -140,19 +147,24 @@ (cond ((or (eq prep 'in) (eq prep 'of)) (when in-phrase - (error - "Duplicate OF or IN iteration path: ~S." (cons prep rest))) + (error 'clsql:sql-user-error + :message + (format nil "Duplicate OF or IN iteration path: ~S." + (cons prep rest)))) (setq in-phrase rest)) ((eq prep 'from) (when from-phrase - (error - "Duplicate FROM iteration path: ~S." (cons prep rest))) + (error 'clsql:sql-user-error + :message + (format nil "Duplicate FROM iteration path: ~S." + (cons prep rest)))) (setq from-phrase rest)) (t - (error - "Unknown preposition: ~S." prep)))) + (error 'clsql:sql-user-error + :message (format nil "Unknown preposition: ~S." prep))))) (unless in-phrase - (error "Missing OF or IN iteration path.")) + (error 'clsql:sql-user-error + :message "Missing OF or IN iteration path.")) (unless from-phrase (setq from-phrase '(clsql:*default-database*))) diff --git a/sql/objects.lisp b/sql/objects.lisp index 8fa9890..1c30975 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -317,10 +317,10 @@ superclass of the newly-defined View Class." (basetype (if (listp slot-type) (car slot-type) slot-type))) (when (and slot-type val) (unless (typep val basetype) - (error 'clsql-type-error - :slotname (slot-definition-name slotdef) - :typespec slot-type - :value val))))) + (error 'sql-user-error + :message + (format nil "Invalid value ~A in slot ~A, not of type ~A." + val (slot-definition-name slotdef) slot-type)))))) ;; ;; Called by find-all @@ -423,7 +423,7 @@ superclass of the newly-defined View Class." (let ((qualifier (key-qualifier-for-instance instance :database vd))) (delete-records :from vt :where qualifier :database vd) (setf (slot-value instance 'view-database) nil)) - (error 'clsql-no-database-error :database nil)))) + (signal-no-database-error vd)))) (defmethod update-instance-from-records ((instance standard-db-object) &key (database *default-database*)) diff --git a/sql/operations.lisp b/sql/operations.lisp index bc99d2a..b4d3eab 100644 --- a/sql/operations.lisp +++ b/sql/operations.lisp @@ -147,7 +147,7 @@ (if (= (length rest) 3) (make-instance 'sql-function-exp :name 'substring :args rest) - (error 'clsql-sql-syntax-error "SUBSTR must have 3 arguments."))) + (error 'sql-user-error :message "SUBSTR must have 3 arguments."))) (defsql sql-is (:symbol "is") (&rest rest) (make-instance 'sql-relational-exp @@ -213,7 +213,7 @@ (defsql sql-between (:symbol "between") (&rest rest) (if (= (length rest) 3) (make-instance 'sql-between-exp :name 'between :args rest) - (error 'clsql-sql-syntax-error "BETWEEN must have 3 arguments."))) + (error 'sql-user-error :message "BETWEEN must have 3 arguments."))) (defsql sql-distinct (:symbol "distinct") (&rest rest) (make-instance 'sql-query-modifier-exp :modifier 'distinct diff --git a/sql/package.lisp b/sql/package.lisp index 15c9a3a..29c109d 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -180,37 +180,6 @@ #:convert-to-db-default-case #:ensure-keyword - - #:clsql-invalid-spec-error - #:clsql-invalid-spec-error-connection-spec - #:clsql-invalid-spec-error-database-type - #:clsql-invalid-spec-error-template - #:clsql-access-error - #:clsql-access-error-database-type - #:clsql-access-error-connection-spec - #:clsql-access-error-error - #:clsql-connect-error - #:clsql-connect-error-errno - #:clsql-sql-error - #:clsql-sql-error-database - #:clsql-sql-error-expression - #:clsql-sql-error-errno - #:clsql-sql-error-error - #:clsql-database-warning - #:clsql-database-warning-database - #:clsql-database-warning-message - #:clsql-exists-condition - #:clsql-exists-condition-new-db - #:clsql-exists-condition-old-db - #:clsql-exists-warning - #:clsql-exists-error - #:clsql-closed-error - #:clsql-closed-error-database - #:clsql-sql-syntax-error - #:clsql-type-error - #:clsql-odbc-error - #:clsql-odbc-error-message - #:*loaded-database-types* #:reload-database-types #:*connect-if-exists* @@ -235,125 +204,140 @@ ;; CommonSQL API ;;------------------------------------------------ ;;FDML - #:select ; objects xx - #:cache-table-queries ; - #:*cache-table-queries-default* ; - #:delete-records ; sql xx - #:insert-records ; sql xx - #:update-records ; sql xx - #:execute-command ; sql xx - #:query ; sql xx - #:print-query ; sql xx - #:do-query ; sql xx - #:map-query ; sql xx - #:for-each-row - #:loop - - ;;FDDL - #:create-table ; table xx - #:drop-table ; table xx - #:list-tables ; table xx - #:table-exists-p ; table xx - #:list-attributes ; table xx - #:attribute-type ; table xx - #:list-attribute-types ; table xx - #:*cache-table-queries-default* - #:create-view ; table xx - #:drop-view ; table xx - #:create-index ; table xx - #:drop-index ; table xx - #:truncate-database - ;;OODDL - #:standard-db-object ; objects xx - #:def-view-class ; objects xx - #:create-view-from-class ; objects xx - #:drop-view-from-class ; objects xx - ;;OODML - #:instance-refreshed ; objects xx - #:update-object-joins ; - #:*default-update-objects-max-len* ; - #:update-slot-from-record ; objects xx - #:update-instance-from-records ; objects xx - #:update-records-from-instance ; objects xx - #:update-record-from-slot ; objects xx - #:update-record-from-slots ; objects xx - #:list-classes ; objects xx - #:delete-instance-records ; objects xx - ;;Symbolic SQL Syntax - #:sql ; syntax xx - #:sql-expression ; syntax xx - #:sql-operation ; syntax xx - #:sql-operator ; syntax xx - #:disable-sql-reader-syntax ; syntax xx - #:enable-sql-reader-syntax ; syntax xx - #:locally-disable-sql-reader-syntax ; syntax xx - #:locally-enable-sql-reader-syntax ; syntax xx - #:restore-sql-reader-syntax-state ; syntax xx + #:select ; objects xx + #:cache-table-queries ; + #:*cache-table-queries-default* ; + #:delete-records ; sql xx + #:insert-records ; sql xx + #:update-records ; sql xx + #:execute-command ; sql xx + #:query ; sql xx + #:print-query ; sql xx + #:do-query ; sql xx + #:map-query ; sql xx + #:for-each-row + #:loop - ;;FDDL - #:list-views ; table xx - #:view-exists-p ; table xx - #:list-indexes ; table xx - #:list-table-indexes ; table xx - #:index-exists-p ; table xx - #:create-sequence ; table xx - #:drop-sequence ; table xx - #:list-sequences ; table xx - #:sequence-exists-p ; table xx - #:sequence-next ; table xx - #:sequence-last ; table xx - #:set-sequence-position ; table xx - ;;OODDL - #:view-table ; metaclass x - #:universal-time ; objects xx - #:bigint - ;;OODML - #:*db-auto-sync* ; objects xx - #:add-to-relation ; objects x - #:remove-from-relation ; objects x - #:read-sql-value ; objects x - #:database-output-sql-as-type ; objects x - #:database-get-type-specifier ; objects x - #:database-output-sql ; sql/class xx + ;; conditions + #:sql-user-error + #:sql-database-error + #:sql-database-data-error + #:sql-connection-error + #:sql-temporary-error + #:sql-error-error-id + #:sql-error-secondary-error-id + #:sql-error-database-message - ;; conditions - #:clsql-condition - #:clsql-error - #:clsql-simple-error - #:clsql-warning - #:clsql-simple-warning + ;; CLSQL Extensions + #:sql-error-database + #:sql-database-warning + #:sql-warning + #:sql-condition - ;;----------------------------------------------- - ;; Symbolic Sql Syntax - ;;----------------------------------------------- - #:sql-and-qualifier - #:sql-escape - #:sql-query - #:sql-object-query - #:sql-any - #:sql-all - #:sql-not - #:sql-union - #:sql-intersection - #:sql-minus - #:sql-group-by - #:sql-having - #:sql-null - #:sql-not-null - #:sql-exists - #:sql-* - #:sql-+ - #:sql-/ - #:sql-like - #:sql-uplike - #:sql-and - #:sql-or - #:sql-in - #:sql-|| - #:sql-is - #:sql-= - #:sql-== - #:sql-< + ;;FDDL + #:create-table ; table xx + #:drop-table ; table xx + #:list-tables ; table xx + #:table-exists-p ; table xx + #:list-attributes ; table xx + #:attribute-type ; table xx + #:list-attribute-types ; table xx + #:*cache-table-queries-default* + #:create-view ; table xx + #:drop-view ; table xx + #:create-index ; table xx + #:drop-index ; table xx + #:truncate-database + ;;OODDL + #:standard-db-object ; objects xx + #:def-view-class ; objects xx + #:create-view-from-class ; objects xx + #:drop-view-from-class ; objects xx + ;;OODML + #:instance-refreshed ; objects xx + #:update-object-joins ; + #:*default-update-objects-max-len* ; + #:update-slot-from-record ; objects xx + #:update-instance-from-records ; objects xx + #:update-records-from-instance ; objects xx + #:update-record-from-slot ; objects xx + #:update-record-from-slots ; objects xx + #:list-classes ; objects xx + #:delete-instance-records ; objects xx + ;;Symbolic SQL Syntax + #:sql ; syntax xx + #:sql-expression ; syntax xx + #:sql-operation ; syntax xx + #:sql-operator ; syntax xx + #:disable-sql-reader-syntax ; syntax xx + #:enable-sql-reader-syntax ; syntax xx + #:locally-disable-sql-reader-syntax ; syntax xx + #:locally-enable-sql-reader-syntax ; syntax xx + #:restore-sql-reader-syntax-state ; syntax xx + + ;;FDDL + #:list-views ; table xx + #:view-exists-p ; table xx + #:list-indexes ; table xx + #:list-table-indexes ; table xx + #:index-exists-p ; table xx + #:create-sequence ; table xx + #:drop-sequence ; table xx + #:list-sequences ; table xx + #:sequence-exists-p ; table xx + #:sequence-next ; table xx + #:sequence-last ; table xx + #:set-sequence-position ; table xx + ;;OODDL + #:view-table ; metaclass x + #:universal-time ; objects xx + #:bigint + ;;OODML + #:*db-auto-sync* ; objects xx + #:add-to-relation ; objects x + #:remove-from-relation ; objects x + #:read-sql-value ; objects x + #:database-output-sql-as-type ; objects x + #:database-get-type-specifier ; objects x + #:database-output-sql ; sql/class xx + + ;; conditions + #:clsql-condition + #:clsql-error + #:clsql-simple-error + #:clsql-simple-warning + + ;;----------------------------------------------- + ;; Symbolic Sql Syntax + ;;----------------------------------------------- + #:sql-and-qualifier + #:sql-escape + #:sql-query + #:sql-object-query + #:sql-any + #:sql-all + #:sql-not + #:sql-union + #:sql-intersection + #:sql-minus + #:sql-group-by + #:sql-having + #:sql-null + #:sql-not-null + #:sql-exists + #:sql-* + #:sql-+ + #:sql-/ + #:sql-like + #:sql-uplike + #:sql-and + #:sql-or + #:sql-in + #:sql-|| + #:sql-is + #:sql-= + #:sql-== + #:sql-< #:sql-> #:sql->= #:sql-<= @@ -464,11 +448,11 @@ #:*initialized-database-types* #:initialize-database-type #:connect ; database xx + #:disconnect ; database xx #:*connect-if-exists* ; database xx #:connected-databases ; database xx #:database ; database xx #:database-name ; database xx - #:disconnect ; database xx #:reconnect ; database #:find-database ; database xx #:status ; database xx diff --git a/sql/sql.lisp b/sql/sql.lisp index 6bc4547..0a0d2f3 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -120,7 +120,7 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*." (av-pairs nil) (subquery nil)) (unless into - (error 'clsql-sql-syntax-error :reason ":into keyword not supplied")) + (error 'sql-user-error :message ":into keyword not supplied")) (let ((insert (make-instance 'sql-insert :into into))) (with-slots (attributes values query) insert @@ -138,8 +138,8 @@ table INTO. The default value of DATABASE is *DEFAULT-DATABASE*." (setf attributes attrs) (setf query subquery)) (t - (error 'clsql-sql-syntax-error - :reason "bad or ambiguous keyword combination."))) + (error 'sql-user-error + :message "bad or ambiguous keyword combination."))) insert))) (defun delete-records (&key (from nil) diff --git a/sql/syntax.lisp b/sql/syntax.lisp index c265f63..0202ced 100644 --- a/sql/syntax.lisp +++ b/sql/syntax.lisp @@ -133,7 +133,7 @@ reader syntax is disabled." :params sqlparam :type sqltype))))) (t - (error 'clsql-sql-syntax-error :reason "bad expression syntax")))) + (error 'sql-user-error :message "bad expression syntax")))) ;; Exported functions for dealing with SQL syntax diff --git a/sql/time.lisp b/sql/time.lisp index 8d06846..c5e78a6 100644 --- a/sql/time.lisp +++ b/sql/time.lisp @@ -1013,20 +1013,22 @@ rules" ;; ------------------------------------------------------------ ;; Parsing iso-8601 timestrings -(define-condition iso-8601-syntax-error (error) +(define-condition iso-8601-syntax-error (sql-user-error) ((bad-component;; year, month whatever :initarg :bad-component - :reader bad-component))) + :reader bad-component)) + (:report (lambda (c stream) + (format stream "Bad component: ~A " (bad-component c))))) (defun parse-timestring (timestring &key (start 0) end junk-allowed) "parse a timestring and return the corresponding wall-time. If the timestring starts with P, read a duration; otherwise read an ISO 8601 formatted date string." - (declare (ignore junk-allowed)) ;; FIXME + (declare (ignore junk-allowed)) (let ((string (subseq timestring start end))) (if (char= (aref string 0) #\P) - (parse-iso-8601-duration string) - (parse-iso-8601-time string)))) + (parse-iso-8601-duration string) + (parse-iso-8601-time string)))) (defvar *iso-8601-duration-delimiters* '((#\D . :days) diff --git a/sql/transaction.lisp b/sql/transaction.lisp index 0b2b63d..958ab02 100644 --- a/sql/transaction.lisp +++ b/sql/transaction.lisp @@ -32,8 +32,7 @@ (when (transaction database) (push rollback-hook (rollback-hooks (transaction database))))) -(defmethod database-start-transaction (database) - (unless database (error 'clsql-no-database-error)) +(defmethod database-start-transaction ((database database)) (unless (transaction database) (setf (transaction database) (make-instance 'transaction))) (when (= (incf (transaction-level database) 1)) @@ -43,7 +42,7 @@ (transaction-status transaction) nil) (execute-command "BEGIN" :database database)))) -(defmethod database-commit-transaction (database) +(defmethod database-commit-transaction ((database database)) (if (> (transaction-level database) 0) (when (zerop (decf (transaction-level database))) (execute-command "COMMIT" :database database) -- 2.34.1