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