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