base/conditions.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          conditions.cl
   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: conditions.cl,v 1.4 2002/09/17 17:16:43 kevin Exp $
  12 ;;;;
  13 ;;;; This file, part of CLSQL, is Copyright (c) 2002 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 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  22 (in-package :clsql-base-sys)
  23
  24 ;;; Conditions
  25 (define-condition clsql-condition ()
  26   ())
  27
  28 (define-condition clsql-error (error clsql-condition)
  29   ())
  30
  31 (define-condition clsql-simple-error (simple-condition clsql-error)
  32   ())
  33
  34 (define-condition clsql-warning (warning clsql-condition)
  35   ())
  36
  37 (define-condition clsql-simple-warning (simple-condition clsql-warning)
  38   ())
  39
  40 (define-condition clsql-invalid-spec-error (clsql-error)
  41   ((connection-spec :initarg :connection-spec
  42                     :reader clsql-invalid-spec-error-connection-spec)
  43    (database-type :initarg :database-type
  44                   :reader clsql-invalid-spec-error-database-type)
  45    (template :initarg :template
  46              :reader clsql-invalid-spec-error-template))
  47   (:report (lambda (c stream)
  48              (format stream "The connection specification ~A~%is invalid for database type ~A.~%The connection specification must conform to ~A"
  49                      (clsql-invalid-spec-error-connection-spec c)
  50                      (clsql-invalid-spec-error-database-type c)
  51                      (clsql-invalid-spec-error-template c)))))
  52
  53 (defmacro check-connection-spec (connection-spec database-type template)
  54   "Check the connection specification against the provided template,
  55 and signal an clsql-invalid-spec-error if they don't match."
  56   `(handler-case
  57     (destructuring-bind ,template ,connection-spec
  58       (declare (ignore ,@template))
  59       t)
  60     (error () (error 'clsql-invalid-spec-error
  61                      :connection-spec ,connection-spec
  62                      :database-type ,database-type
  63                      :template (quote ,template)))))
  64
  65 (define-condition clsql-connect-error (clsql-error)
  66   ((database-type :initarg :database-type
  67                   :reader clsql-connect-error-database-type)
  68    (connection-spec :initarg :connection-spec
  69                     :reader clsql-connect-error-connection-spec)
  70    (errno :initarg :errno :reader clsql-connect-error-errno)
  71    (error :initarg :error :reader clsql-connect-error-error))
  72   (:report (lambda (c stream)
  73              (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
  74                      (database-name-from-spec
  75                       (clsql-connect-error-connection-spec c)
  76                       (clsql-connect-error-database-type c))
  77                      (clsql-connect-error-database-type c)
  78                      (clsql-connect-error-errno c)
  79                      (clsql-connect-error-error c)))))
  80
  81 (define-condition clsql-sql-error (clsql-error)
  82   ((database :initarg :database :reader clsql-sql-error-database)
  83    (expression :initarg :expression :reader clsql-sql-error-expression)
  84    (errno :initarg :errno :reader clsql-sql-error-errno)
  85    (error :initarg :error :reader clsql-sql-error-error))
  86   (:report (lambda (c stream)
  87              (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
  88                      (clsql-sql-error-database c)
  89                      (clsql-sql-error-expression c)
  90                      (clsql-sql-error-errno c)
  91                      (clsql-sql-error-error c)))))
  92
  93 (define-condition clsql-database-warning (clsql-warning)
  94   ((database :initarg :database :reader clsql-database-warning-database)
  95    (message :initarg :message :reader clsql-database-warning-message))
  96   (:report (lambda (c stream)
  97              (format stream "While accessing database ~A~%  Warning: ~A~%  has occurred."
  98                      (clsql-database-warning-database c)
  99                      (clsql-database-warning-message c)))))
 100
 101 (define-condition clsql-exists-condition (clsql-condition)
 102    ((old-db :initarg :old-db :reader clsql-exists-condition-old-db)
 103     (new-db :initarg :new-db :reader clsql-exists-condition-new-db
 104             :initform nil))
 105    (:report (lambda (c stream)
 106               (format stream "In call to ~S:~%" 'connect)
 107               (cond
 108                 ((null (clsql-exists-condition-new-db c))
 109                  (format stream
 110                          "  There is an existing connection ~A to database ~A."
 111                          (clsql-exists-condition-old-db c)
 112                          (database-name (clsql-exists-condition-old-db c))))
 113                 ((eq (clsql-exists-condition-new-db c)
 114                      (clsql-exists-condition-old-db c))
 115                  (format stream
 116                          "  Using existing connection ~A to database ~A."
 117                          (clsql-exists-condition-old-db c)
 118                          (database-name (clsql-exists-condition-old-db c))))
 119                 (t
 120                  (format stream
 121                          "  Created new connection ~A to database ~A~%  ~
 122 although there is an existing connection (~A)."
 123                          (clsql-exists-condition-new-db c)
 124                          (database-name (clsql-exists-condition-new-db c))
 125                          (clsql-exists-condition-old-db c)))))))
 126
 127 (define-condition clsql-exists-warning (clsql-exists-condition
 128                                          clsql-warning)
 129   ())
 130
 131 (define-condition clsql-exists-error (clsql-exists-condition
 132                                        clsql-error)
 133   ())
 134
 135 (define-condition clsql-closed-error (clsql-error)
 136   ((database :initarg :database :reader clsql-closed-error-database))
 137   (:report (lambda (c stream)
 138              (format stream "The database ~A has already been closed."
 139                      (clsql-closed-error-database c)))))
 140
 141 (define-condition clsql-nodb-error (clsql-error)
 142   ((database :initarg :database :reader clsql-nodb-error-database))
 143   (:report (lambda (c stream)
 144              (format stream "No such database ~S is open."
 145                      (clsql-nodb-error-database c)))))
 146
 147
 148 ;; Signal conditions
 149
 150
 151 (defun signal-closed-database-error (database)
 152   (cerror "Ignore this error and return nil."
 153           'clsql-closed-error
 154           :database database))
 155
 156 (defun signal-nodb-error (database)
 157   (cerror "Ignore this error and return nil."
 158           'clsql-nodb-error
 159           :database database))
 160