X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=base%2Fconditions.lisp;h=6b7d971d6cf3df623922b11c06e7aeadeaa87fff;hp=5f0fb3a09077a9a36922de7ff21cebd2a10dc654;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hpb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7 diff --git a/base/conditions.lisp b/base/conditions.lisp index 5f0fb3a..6b7d971 100644 --- a/base/conditions.lisp +++ b/base/conditions.lisp @@ -2,15 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: conditions.cl +;;;; 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 ;;;; -;;;; $Id: conditions.lisp,v 1.1 2002/09/30 10:19:01 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; 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 @@ -18,8 +18,11 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-base-sys) +(in-package #:clsql-base) + +(defvar *backend-warning-behavior* :warn + "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 () @@ -37,6 +40,12 @@ (define-condition clsql-simple-warning (simple-condition clsql-warning) ()) +(define-condition clsql-generic-error (clsql-error) + ((message :initarg :message + :reader clsql-generic-error-message)) + (: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) @@ -55,40 +64,54 @@ and signal an clsql-invalid-spec-error if they don't match." `(handler-case (destructuring-bind ,template ,connection-spec - (declare (ignore ,@template)) + (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-connect-error (clsql-error) +(define-condition clsql-access-error (clsql-error) ((database-type :initarg :database-type - :reader clsql-connect-error-database-type) + :reader clsql-access-error-database-type) (connection-spec :initarg :connection-spec - :reader clsql-connect-error-connection-spec) - (errno :initarg :errno :reader clsql-connect-error-errno) - (error :initarg :error :reader clsql-connect-error-error)) + :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)) (: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-connect-error-connection-spec c) - (clsql-connect-error-database-type c)) - (clsql-connect-error-database-type c) + (clsql-access-error-connection-spec c) + (clsql-access-error-database-type c)) + (clsql-access-error-database-type c) (clsql-connect-error-errno c) - (clsql-connect-error-error c))))) + (clsql-access-error-error c))))) (define-condition clsql-sql-error (clsql-error) ((database :initarg :database :reader clsql-sql-error-database) - (expression :initarg :expression :reader clsql-sql-error-expression) - (errno :initarg :errno :reader clsql-sql-error-errno) - (error :initarg :error :reader clsql-sql-error-error)) + (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) - (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))))) + (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) @@ -137,12 +160,21 @@ and signal an clsql-invalid-spec-error if they don't match." (format stream "The database ~A has already been closed." (clsql-closed-error-database c))))) -(define-condition clsql-nodb-error (clsql-error) - ((database :initarg :database :reader clsql-nodb-error-database)) +(define-condition clsql-no-database-error (clsql-error) + ((database :initarg :database :reader clsql-no-database-error-database)) (:report (lambda (c stream) - (format stream "No such database ~S is open." - (clsql-nodb-error-database c))))) - + (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 @@ -152,8 +184,27 @@ and signal an clsql-invalid-spec-error if they don't match." 'clsql-closed-error :database database)) -(defun signal-nodb-error (database) - (cerror "Ignore this error and return nil." - 'clsql-nodb-error - :database 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)) + (:report (lambda (c stream) + (format stream "Invalid SQL syntax: ~A" + (clsql-sql-syntax-error-reason c)))))