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~A: ~A / ~A~%  ~A"
  47                      (if (sql-error-database c)
  48                          (format nil " on database ~A" (sql-error-database c))
  49                          "")
  50                      (sql-error-error-id c)
  51                      (sql-error-secondary-error-id c)
  52                      (sql-error-database-message c))))
  53   (:documentation "Used to signal an error in a CLSQL database interface."))
  54
  55 (define-condition sql-connection-error (sql-database-error)
  56   ((database-type :initarg :database-type :initform nil
  57                   :reader sql-error-database-type)
  58    (connection-spec :initarg :connection-spec :initform nil
  59                   :reader sql-error-connection-spec))
  60   (:report (lambda (c stream)
  61              (format stream "While trying to connect to database ~A~%  using database-type ~A:~%  Error ~D / ~A~%  has occurred."
  62                      (when (and (sql-error-connection-spec c)
  63                                 (sql-error-database-type c))
  64                        (database-name-from-spec
  65                         (sql-error-connection-spec c)
  66                         (sql-error-database-type c)))
  67                      (sql-error-database-type c)
  68                      (sql-error-error-id c)
  69                      (sql-error-database-message c))))
  70   (:documentation "Used to signal an error in connecting to a database."))
  71
  72 (define-condition sql-database-data-error (sql-database-error)
  73   ((expression :initarg :expression :initarg nil
  74                :reader sql-error-expression))
  75   (:report (lambda (c stream)
  76              (format stream "While accessing database ~A~%  with expression ~S:~%  Error ~D / ~A~%  has occurred."
  77                      (sql-error-database c)
  78                      (sql-error-expression c)
  79                      (sql-error-error-id c)
  80                      (sql-error-database-message c))))
  81   (:documentation "Used to signal an error with the SQL data
  82   passed to a database."))
  83
  84 (define-condition sql-temporary-error (sql-database-error)
  85   ()
  86   (:documentation "Used to signal an error when the database
  87 cannot currently process a valid interaction because, for
  88 example, it is still executing another command possibly issued by
  89 another user."))
  90
  91 (define-condition sql-timeout-error (sql-connection-error)
  92   ()
  93   (:documentation "Used to signal an error when the database
  94 times out while processing some operation."))
  95
  96 (define-condition sql-fatal-error (sql-connection-error)
  97   ()
  98   (:documentation "Used to signal an error when the database
  99 connection is no longer usable."))
 100
 101 (define-condition sql-user-error (sql-error)
 102   ((message :initarg :message
 103             :initform "Unspecified error"
 104             :reader sql-user-error-message))
 105   (:report (lambda (c stream)
 106              (format stream "A CLSQL lisp code error occurred: ~A "
 107                      (sql-user-error-message c))))
 108   (:documentation  "Used to signal lisp errors inside CLSQL."))
 109
 110
 111
 112 ;; Signal conditions
 113
 114 (defun signal-closed-database-error (database)
 115   (error 'sql-fatal-error
 116          :database database
 117          :connection-spec (when database (connection-spec database))
 118          :database-type (when database (database-type database))
 119          :message "Database is closed."))
 120
 121 (defun signal-no-database-error (database)
 122   (error 'sql-database-error
 123          :database database
 124          :message (format nil "~A is not a database." database)))
 125
 126
 127 ;;; CLSQL Extensions
 128
 129 (define-condition sql-warning (warning sql-condition)
 130   ((message :initarg :message :initform nil :reader sql-warning-message))
 131   (:report (lambda (c stream)
 132              (format stream "~A" (sql-warning-message c)))))
 133
 134 (define-condition sql-database-warning (sql-warning)
 135   ((database :initarg :database :reader sql-warning-database))
 136   (:report (lambda (c stream)
 137              (format stream
 138                      "While accessing database ~A~%  Warning: ~A~%  has occurred."
 139                      (sql-warning-database c)
 140                      (sql-warning-message c)))))