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
COMMONSQL INCOMPATIBILITY
- o Condition names/accessors
o userenv (Oracle specific but deprecated in Oracle 9)
VARIANCES FROM COMMONSQL
(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
(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))
(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)
(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
(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)
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)
(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)
(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
(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))
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
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)))
(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))
(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))))))
((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)))))
: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))
(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)
(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))
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)"))))
(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
(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)
)))
(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)
: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
(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)
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))))))))
((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)
(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
(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)
(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
(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)
(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
(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
(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)
(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))
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)))
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))))
(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))
: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))
"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
(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)
(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
+cl-sql (2.10.19-1) unstable; urgency=low
+
+ * New upstream
+ * Fix depends [patch from Erik Naggum]
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Wed, 19 May 2004 16:33:07 -0600
+
cl-sql (2.10.18-1) unstable; urgency=low
* New upstream
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
(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)
*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 " "))))))))
;;;; *************************************************************************
;;;; 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
"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)))))
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)))
(: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
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
+(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
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))
(: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
(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)))
(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*)))
(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*)))
(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
(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*))
(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
(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
#: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*
;; 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-<=
#:*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
(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
(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)
: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
;; ------------------------------------------------------------
;; 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)
(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))
(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)
projects / clsql.git / commitdiff