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-sys)
  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-invalid-spec-error (clsql-error)
  40   ((connection-spec :initarg :connection-spec
  41                     :reader clsql-invalid-spec-error-connection-spec)
  42    (database-type :initarg :database-type
  43                   :reader clsql-invalid-spec-error-database-type)
  44    (template :initarg :template
  45              :reader clsql-invalid-spec-error-template))
  46   (:report (lambda (c stream)
  47              (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
  48                      (clsql-invalid-spec-error-connection-spec c)
  49                      (clsql-invalid-spec-error-database-type c)
  50                      (clsql-invalid-spec-error-template c)))))
  51
  52 (defmacro check-connection-spec (connection-spec database-type template)
  53   "Check the connection specification against the provided template,
  54 and signal an clsql-invalid-spec-error if they don't match."
  55   `(handler-case
  56     (destructuring-bind ,template ,connection-spec
  57       (declare (ignore ,@(remove '&optional template)))
  58       t)
  59     (error () (error 'clsql-invalid-spec-error
  60                      :connection-spec ,connection-spec
  61                      :database-type ,database-type
  62                      :template (quote ,template)))))
  63
  64 (define-condition clsql-connect-error (clsql-error)
  65   ((database-type :initarg :database-type
  66                   :reader clsql-connect-error-database-type)
  67    (connection-spec :initarg :connection-spec
  68                     :reader clsql-connect-error-connection-spec)
  69    (errno :initarg :errno :reader clsql-connect-error-errno)
  70    (error :initarg :error :reader clsql-connect-error-error))
  71   (:report (lambda (c stream)
  72              (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
  73                      (database-name-from-spec
  74                       (clsql-connect-error-connection-spec c)
  75                       (clsql-connect-error-database-type c))
  76                      (clsql-connect-error-database-type c)
  77                      (clsql-connect-error-errno c)
  78                      (clsql-connect-error-error c)))))
  79
  80 (define-condition clsql-sql-error (clsql-error)
  81   ((database :initarg :database :reader clsql-sql-error-database)
  82    (expression :initarg :expression :reader clsql-sql-error-expression)
  83    (errno :initarg :errno :reader clsql-sql-error-errno)
  84    (error :initarg :error :reader clsql-sql-error-error))
  85   (:report (lambda (c stream)
  86              (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
  87                      (clsql-sql-error-database c)
  88                      (clsql-sql-error-expression c)
  89                      (clsql-sql-error-errno c)
  90                      (clsql-sql-error-error c)))))
  91
  92 (define-condition clsql-database-warning (clsql-warning)
  93   ((database :initarg :database :reader clsql-database-warning-database)
  94    (message :initarg :message :reader clsql-database-warning-message))
  95   (:report (lambda (c stream)
  96              (format stream "While accessing database ~A~%  Warning: ~A~%  has occurred."
  97                      (clsql-database-warning-database c)
  98                      (clsql-database-warning-message c)))))
  99
 100 (define-condition clsql-exists-condition (clsql-condition)
 101    ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
 102     (new-db :initarg :new-db :reader clsql-exists-condition-new-db
 103             :initform nil))
 104    (:report (lambda (c stream)
 105               (format stream "In call to ~S:~%" 'connect)
 106               (cond
 107                 ((null (clsql-exists-condition-new-db c))
 108                  (format stream
 109                          "  There is an existing connection ~A to database ~A."
 110                          (clsql-exists-condition-old-db c)
 111                          (database-name (clsql-exists-condition-old-db c))))
 112                 ((eq (clsql-exists-condition-new-db c)
 113                      (clsql-exists-condition-old-db c))
 114                  (format stream
 115                          "  Using existing connection ~A to database ~A."
 116                          (clsql-exists-condition-old-db c)
 117                          (database-name (clsql-exists-condition-old-db c))))
 118                 (t
 119                  (format stream
 120                          "  Created new connection ~A to database ~A~%, although there is an existing connection (~A)."
 121                          (clsql-exists-condition-new-db c)
 122                          (database-name (clsql-exists-condition-new-db c))
 123                          (clsql-exists-condition-old-db c)))))))
 124
 125 (define-condition clsql-exists-warning (clsql-exists-condition
 126                                          clsql-warning)
 127   ())
 128
 129 (define-condition clsql-exists-error (clsql-exists-condition
 130                                        clsql-error)
 131   ())
 132
 133 (define-condition clsql-closed-error (clsql-error)
 134   ((database :initarg :database :reader clsql-closed-error-database))
 135   (:report (lambda (c stream)
 136              (format stream "The database ~A has already been closed."
 137                      (clsql-closed-error-database c)))))
 138
 139 (define-condition clsql-nodb-error (clsql-error)
 140   ((database :initarg :database :reader clsql-nodb-error-database))
 141   (:report (lambda (c stream)
 142              (format stream "No such database ~S is open."
 143                      (clsql-nodb-error-database c)))))
 144
 145
 146 ;; Signal conditions
 147
 148
 149 (defun signal-closed-database-error (database)
 150   (cerror "Ignore this error and return nil."
 151           'clsql-closed-error
 152           :database database))
 153
 154 (defun signal-nodb-error (database)
 155   (cerror "Ignore this error and return nil."
 156           'clsql-nodb-error
 157           :database database))
 158
 159 (defun signal-no-database-error ()
 160   (cerror "Ignore this error and return nil."
 161           'clsql-nodb-error))
 162
 163 ;; for USQL support
 164
 165 (define-condition clsql-type-error (clsql-error clsql-condition)
 166   ((slotname :initarg :slotname
 167              :reader clsql-type-error-slotname)
 168    (typespec :initarg :typespec
 169              :reader clsql-type-error-typespec)
 170    (value :initarg :value
 171           :reader clsql-type-error-value))
 172   (:report (lambda (c stream)
 173              (format stream
 174                      "Invalid value ~A in slot ~A, not of type ~A."
 175                      (clsql-type-error-value c)
 176                      (clsql-type-error-slotname c)
 177                      (clsql-type-error-typespec c)))))
 178
 179 (define-condition clsql-sql-syntax-error (clsql-error)
 180   ((reason :initarg :reason
 181            :reader clsql-sql-syntax-error-reason))
 182   (:report (lambda (c stream)
 183              (format stream "Invalid SQL syntax: ~A"
 184                      (clsql-sql-syntax-error-reason c)))))