sql/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 CLSQL
   7 ;;;;
   8 ;;;; $Id$
   9 ;;;;
  10 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; *************************************************************************
  16
  17 (in-package #:clsql-sys)
  18
  19 (defvar *backend-warning-behavior* :warn
  20   "Action to perform on warning messages from backend. Default is
  21 to :warn. May also be set to :error to signal an error
  22 or :ignore/nil to silently ignore the warning.")
  23
  24 ;;; CommonSQL-compatible conditions
  25
  26 (define-condition sql-condition ()
  27   ())
  28
  29 (define-condition sql-error (simple-error sql-condition)
  30   ())
  31
  32 (define-condition sql-database-error (sql-error)
  33   ((error-id :initarg :error-id
  34              :initform nil
  35              :reader sql-error-error-id)
  36    (secondary-error-id :initarg :secondary-error-id
  37                        :initform nil
  38                        :reader sql-error-secondary-error-id)
  39    (database-message :initarg :message
  40                      :initform nil
  41                      :reader sql-error-database-message)
  42    (database :initarg :database
  43                      :initform nil
  44                      :reader sql-error-database))
  45   (:report (lambda (c stream)
  46              (format stream "A database error occurred~@[ on database ~A~]: ~A / ~A~%  ~A"
  47                      (sql-error-database c)
  48                      (sql-error-error-id c)
  49                      (sql-error-secondary-error-id c)
  50                      (sql-error-database-message c))))
  51   (:documentation "Used to signal an error in a CLSQL database interface."))
  52
  53 (define-condition sql-connection-error (sql-database-error)
  54   ((database-type :initarg :database-type :initform nil
  55                   :reader sql-error-database-type)
  56    (connection-spec :initarg :connection-spec :initform nil
  57                   :reader sql-error-connection-spec))
  58   (:report (lambda (c stream)
  59              (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
  60                      (when (and (sql-error-connection-spec c)
  61                                 (sql-error-database-type c))
  62                        (database-name-from-spec
  63                         (sql-error-connection-spec c)
  64                         (sql-error-database-type c)))
  65                      (sql-error-database-type c)
  66                      (sql-error-error-id c)
  67                      (sql-error-database-message c))))
  68   (:documentation "Used to signal an error in connecting to a database."))
  69
  70 (define-condition sql-database-data-error (sql-database-error)
  71   ((expression :initarg :expression :initarg nil
  72                :reader sql-error-expression))
  73   (:report (lambda (c stream)
  74              (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
  75                      (sql-error-database c)
  76                      (sql-error-expression c)
  77                      (sql-error-error-id c)
  78                      (sql-error-database-message c))))
  79   (:documentation "Used to signal an error with the SQL data
  80   passed to a database."))
  81
  82 (define-condition sql-temporary-error (sql-database-error)
  83   ()
  84   (:documentation "Used to signal an error when the database
  85 cannot currently process a valid interaction because, for
  86 example, it is still executing another command possibly issued by
  87 another user."))
  88
  89 (define-condition sql-timeout-error (sql-connection-error)
  90   ()
  91   (:documentation "Used to signal an error when the database
  92 times out while processing some operation."))
  93
  94 (define-condition sql-fatal-error (sql-connection-error)
  95   ()
  96   (:documentation "Used to signal an error when the database
  97 connection is no longer usable."))
  98
  99 (define-condition sql-user-error (sql-error)
 100   ((message :initarg :message
 101             :initform "Unspecified error"
 102             :reader sql-user-error-message))
 103   (:report (lambda (c stream)
 104              (format stream "A CLSQL lisp code error occurred: ~A "
 105                      (sql-user-error-message c))))
 106   (:documentation  "Used to signal lisp errors inside CLSQL."))
 107
 108
 109
 110 ;; Signal conditions
 111
 112 (defun signal-closed-database-error (database)
 113   (error 'sql-fatal-error
 114          :database database
 115          :connection-spec (when database (connection-spec database))
 116          :database-type (when database (database-type database))
 117          :message "Database is closed."))
 118
 119 (defun signal-no-database-error (database)
 120   (error 'sql-database-error
 121          :database database
 122          :message (format nil "~A is not a database." database)))
 123
 124
 125 ;;; CLSQL Extensions
 126
 127 (define-condition sql-warning (warning sql-condition)
 128   ((message :initarg :message :initform nil :reader sql-warning-message))
 129   (:report (lambda (c stream)
 130              (format stream "~A" (sql-warning-message c)))))
 131
 132 (define-condition sql-database-warning (sql-warning)
 133   ((database :initarg :database :reader sql-warning-database))
 134   (:report (lambda (c stream)
 135              (format stream
 136                      "While accessing database ~A~%  Warning: ~A~%  has occurred."
 137                      (sql-warning-database c)
 138                      (sql-warning-message c)))))