base/conditions.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          conditions.lisp
   6 ;;;; Purpose:       Error conditions for high-level SQL interface
   7 ;;;; Programmers:   Kevin M. Rosenberg based on
   8 ;;;;                 Original code by Pierre R. Mai
   9 ;;;; Date Started:  Feb 2002
  10 ;;;;
  11 ;;;; $Id$
  12 ;;;;
  13 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
  14 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
  15 ;;;;
  16 ;;;; CLSQL users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  18 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  19 ;;;; *************************************************************************
  20
  21 (in-package #:clsql-base)
  22
  23 ;;; Conditions
  24 (define-condition clsql-condition ()
  25   ())
  26
  27 (define-condition clsql-error (error clsql-condition)
  28   ())
  29
  30 (define-condition clsql-simple-error (simple-condition clsql-error)
  31   ())
  32
  33 (define-condition clsql-warning (warning clsql-condition)
  34   ())
  35
  36 (define-condition clsql-simple-warning (simple-condition clsql-warning)
  37   ())
  38
  39 (define-condition clsql-generic-error (clsql-error)
  40   ((message :initarg :message
  41             :reader clsql-generic-error-message))
  42   (:report (lambda (c stream)
  43              (format stream (clsql-generic-error-message c)))))
  44
  45 (define-condition clsql-invalid-spec-error (clsql-error)
  46   ((connection-spec :initarg :connection-spec
  47                     :reader clsql-invalid-spec-error-connection-spec)
  48    (database-type :initarg :database-type
  49                   :reader clsql-invalid-spec-error-database-type)
  50    (template :initarg :template
  51              :reader clsql-invalid-spec-error-template))
  52   (:report (lambda (c stream)
  53              (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
  54                      (clsql-invalid-spec-error-connection-spec c)
  55                      (clsql-invalid-spec-error-database-type c)
  56                      (clsql-invalid-spec-error-template c)))))
  57
  58 (defmacro check-connection-spec (connection-spec database-type template)
  59   "Check the connection specification against the provided template,
  60 and signal an clsql-invalid-spec-error if they don't match."
  61   `(handler-case
  62     (destructuring-bind ,template ,connection-spec
  63       (declare (ignore ,@(remove '&optional template)))
  64       t)
  65     (error () (error 'clsql-invalid-spec-error
  66                      :connection-spec ,connection-spec
  67                      :database-type ,database-type
  68                      :template (quote ,template)))))
  69
  70 (define-condition clsql-access-error (clsql-error)
  71   ((database-type :initarg :database-type
  72                   :reader clsql-access-error-database-type)
  73    (connection-spec :initarg :connection-spec
  74                     :reader clsql-access-error-connection-spec)
  75    (error :initarg :error :reader clsql-access-error-error))
  76   (:report (lambda (c stream)
  77              (format stream "While trying to access database ~A~%  using database-type ~A:~%  Error ~A~%  has occurred."
  78                      (database-name-from-spec
  79                       (clsql-access-error-connection-spec c)
  80                       (clsql-access-error-database-type c))
  81                      (clsql-access-error-database-type c)
  82                      (clsql-access-error-error c)))))
  83
  84 (define-condition clsql-connect-error (clsql-access-error)
  85   ((errno :initarg :errno :reader clsql-connect-error-errno))
  86   (:report (lambda (c stream)
  87              (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
  88                      (database-name-from-spec
  89                       (clsql-access-error-connection-spec c)
  90                       (clsql-access-error-database-type c))
  91                      (clsql-access-error-database-type c)
  92                      (clsql-connect-error-errno c)
  93                      (clsql-access-error-error c)))))
  94
  95 (define-condition clsql-sql-error (clsql-error)
  96   ((database :initarg :database :reader clsql-sql-error-database)
  97    (expression :initarg :expression :reader clsql-sql-error-expression)
  98    (errno :initarg :errno :reader clsql-sql-error-errno)
  99    (error :initarg :error :reader clsql-sql-error-error))
 100   (:report (lambda (c stream)
 101              (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
 102                      (clsql-sql-error-database c)
 103                      (clsql-sql-error-expression c)
 104                      (clsql-sql-error-errno c)
 105                      (clsql-sql-error-error c)))))
 106
 107 (define-condition clsql-database-warning (clsql-warning)
 108   ((database :initarg :database :reader clsql-database-warning-database)
 109    (message :initarg :message :reader clsql-database-warning-message))
 110   (:report (lambda (c stream)
 111              (format stream "While accessing database ~A~%  Warning: ~A~%  has occurred."
 112                      (clsql-database-warning-database c)
 113                      (clsql-database-warning-message c)))))
 114
 115 (define-condition clsql-exists-condition (clsql-condition)
 116    ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
 117     (new-db :initarg :new-db :reader clsql-exists-condition-new-db
 118             :initform nil))
 119    (:report (lambda (c stream)
 120               (format stream "In call to ~S:~%" 'connect)
 121               (cond
 122                 ((null (clsql-exists-condition-new-db c))
 123                  (format stream
 124                          "  There is an existing connection ~A to database ~A."
 125                          (clsql-exists-condition-old-db c)
 126                          (database-name (clsql-exists-condition-old-db c))))
 127                 ((eq (clsql-exists-condition-new-db c)
 128                      (clsql-exists-condition-old-db c))
 129                  (format stream
 130                          "  Using existing connection ~A to database ~A."
 131                          (clsql-exists-condition-old-db c)
 132                          (database-name (clsql-exists-condition-old-db c))))
 133                 (t
 134                  (format stream
 135                          "  Created new connection ~A to database ~A~%, although there is an existing connection (~A)."
 136                          (clsql-exists-condition-new-db c)
 137                          (database-name (clsql-exists-condition-new-db c))
 138                          (clsql-exists-condition-old-db c)))))))
 139
 140 (define-condition clsql-exists-warning (clsql-exists-condition
 141                                          clsql-warning)
 142   ())
 143
 144 (define-condition clsql-exists-error (clsql-exists-condition
 145                                        clsql-error)
 146   ())
 147
 148 (define-condition clsql-closed-error (clsql-error)
 149   ((database :initarg :database :reader clsql-closed-error-database))
 150   (:report (lambda (c stream)
 151              (format stream "The database ~A has already been closed."
 152                      (clsql-closed-error-database c)))))
 153
 154 (define-condition clsql-no-database-error (clsql-error)
 155   ((database :initarg :database :reader clsql-no-database-error-database))
 156   (:report (lambda (c stream)
 157              (format stream "~S is not a CLSQL database."
 158                      (clsql-no-database-error-database c)))))
 159
 160 (define-condition clsql-odbc-error (clsql-error)
 161   ((odbc-message :initarg :odbc-message
 162                  :reader clsql-odbc-error-message)
 163    (sql-state :initarg :sql-state :initform nil
 164               :reader clsql-odbc-error-sql-state))
 165   (:report (lambda (c stream)
 166              (format stream "[ODBC error] ~A; state: ~A"
 167                      (clsql-odbc-error-message c)
 168                      (clsql-odbc-error-sql-state c)))))
 169
 170 ;; Signal conditions
 171
 172
 173 (defun signal-closed-database-error (database)
 174   (cerror "Ignore this error and return nil."
 175           'clsql-closed-error
 176           :database database))
 177
 178 (defun signal-no-database-error (database)
 179   (error 'clsql-no-database-error :database database))
 180
 181 (define-condition clsql-type-error (clsql-error clsql-condition)
 182   ((slotname :initarg :slotname
 183              :reader clsql-type-error-slotname)
 184    (typespec :initarg :typespec
 185              :reader clsql-type-error-typespec)
 186    (value :initarg :value
 187           :reader clsql-type-error-value))
 188   (:report (lambda (c stream)
 189              (format stream
 190                      "Invalid value ~A in slot ~A, not of type ~A."
 191                      (clsql-type-error-value c)
 192                      (clsql-type-error-slotname c)
 193                      (clsql-type-error-typespec c)))))
 194
 195 (define-condition clsql-sql-syntax-error (clsql-error)
 196   ((reason :initarg :reason
 197            :reader clsql-sql-syntax-error-reason))
 198   (:report (lambda (c stream)
 199              (format stream "Invalid SQL syntax: ~A"
 200                      (clsql-sql-syntax-error-reason c)))))