;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-rabbit/errors.lisp#2 $

(in-package "RABBITMQ")

;;                            ERRORS.LISP
;;           Nick Levine, Ravenbrook Limited, 2007-09-21
;; 
;; 1.  INTRODUCTION
;;
;; The purpose of this document is to improve the handling of errors
;; in the RabbitMQ interface.
;;
;; See Appendix C below for copyright and license.


(defmethod describe-exception :around ((self java-exception))
  (let* ((stack (call-next-method))
	 (exception  (java-exception-exception self))
	 (cause (IOException.getCause exception)))
    (if cause
	(let ((text (Object.toString cause))
	      (code-marker "reply code="))
	  (when-let (where (search code-marker text))
	    (change-class self 'amqp-exception
			  :code (parse-integer text 
					       :start (+ where (length code-marker))
					       :junk-allowed t)))
	  (format nil "~a~2%~a"
		  (simple-word-wrap text)
		  stack))
      (let ((string (Object.toString exception)))
	(cond ((string= string "java.lang.IllegalStateException: Attempt to use closed channel")
	       (change-class self 'channel-not-alive))
	      ((string= string "java.lang.IllegalStateException: Attempt to use closed connection")
	       (change-class self 'connection-not-alive))
	      )
	stack))))

(define-condition amqp-exception (java-exception)
  ((code :reader amqp-exception-code :initarg :code)))

(defmacro trapping-not-found (&body body)
  `(block trapping-not-found 
     (handler-bind ((amqp-exception (lambda (e)
                                      (when (= (amqp-exception-code e) 404)     ; NOT_FOUND
                                        (return-from trapping-not-found
                                          nil)))))
       ,@body)))

(defun simple-word-wrap (text &optional (start 0))
  (let* ((ideal 72)
         (where (+ start ideal))
         (length (length text)))
    (when (>= where length)
      (return-from simple-word-wrap
        text))
    (loop (when (whitespace-char-p (schar text where))
            (setf (schar text where) #\Newline)
            (return-from simple-word-wrap
              (simple-word-wrap text (1+ where))))
          (when (= (decf where) start)
            (return)))
    (setf where (+ start ideal 1))
    (loop (when (whitespace-char-p (schar text where))
            (setf (schar text where) #\Newline)
            (return
             (simple-word-wrap text (1+ where))))
          (when (= (incf where) length)
            (return text)))))
    



;; A.  REFERENCES
;;
;;
;; B.  HISTORY
;;
;; 2007-09-21 NDL Created.
;;
;;
;; C.  COPYRIGHT
;;
;; Copyright (c) 2007 Wiinz Limited. 
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.