Changeset error-handling,3

Timestamp:

11/28/2007 05:54:57 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

error-handling

revision id:

dsowen@fugue88.ws-20071128175457-jt34hu6qm16hk2h4

Message:

Root condition, plus a foreign-key condition.

Location:

error-handling/src/odbc

Files:

• odbc-functions.lisp (modified) (2 diffs)
• plain-odbc-package.lisp (modified) (1 diff)

error-handling/src/odbc/odbc-functions.lisp

@@ -110 +110 @@
     ))
 
+
+(defun print-odbc-error (condition stream)
+  (with-slots (message code) condition
+    (format stream "[ODBC error] ~a; state: ~a" message code)))
+
+(define-condition odbc-error (error)
+  ((message :initarg :message :reader error-message)
+   (code :initarg :code :reader error-code))
+  (:report print-odbc-error))
+
+(define-condition odbc-foreign-key-error (odbc-error) ())
+
+(defun read-and-throw-error (henv hdbc hstmt)
+  (multiple-value-bind (error-message sql-state)
+      (handle-error (or henv (cffi:null-pointer))
+                    (or hdbc (cffi:null-pointer))
+                    (or hstmt (cffi:null-pointer)))
+    (let ((type (cdr (assoc sql-state '(("23503" . odbc-foreign-key-error))
+                            :test #'string=))))
+      (error (if type type 'odbc-error)
+             :message error-message
+             :code sql-state))))
 
 ;;; rav:
@@ -154 +176 @@
           (error "[ODBC error] Still executing"))
          (#.$SQL_ERROR
-          (multiple-value-bind (error-message sql-state)
-                               (handle-error (or ,henv (cffi:null-pointer))
-                                             (or ,hdbc (cffi:null-pointer))
-                                             (or ,hstmt (cffi:null-pointer)))
-            (error "[ODBC error] ~a; state: ~a" error-message sql-state)))
+          (read-and-throw-error ,henv ,hdbc ,hstmt))
          (otherwise
            (progn ,result-code ,@body))

error-handling/src/odbc/plain-odbc-package.lisp

@@ -12 +12 @@
    "COMMON-LISP" #+mcl "CCL" #+cormanlisp "WIN32" "CFFI")
   (:export
+   "ODBC-ERROR"
+   "ODBC-FOREIGN-KEY-ERROR"
+
    "EXEC-QUERY" 
    "EXEC-UPDATE"