/[de-setf-amqp]/rabbitmq/connection.lisp
ViewVC logotype

Contents of /rabbitmq/connection.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Tue Feb 23 09:05:39 2010 UTC (4 years, 1 month ago) by janderson
File size: 4436 byte(s)
Merge commit 'remotes/github/master' into remotes/git-svn
1 ;;;-* Package: rabbitmq; -*-
2 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-rabbit/connection.lisp#2 $
3
4 (in-package :rabbitmq)
5
6 ;; CONNECTION.LISP
7 ;; Nick Levine, Ravenbrook Limited, 2007-09-20
8 ;; James Anderson, setf.de, 2010-02-04
9 ;;
10 ;; 1. INTRODUCTION
11 ;;
12 ;; The purpose of this document is to implement a lisp interface to AMQP connections consistent with the
13 ;; RabbitMQ API. It emulates the original com.nicklevine.rabbitmq version, which was layered over
14 ;; RabbitMQ/Java
15 ;;
16 ;; See Appendix C below for copyright and license.
17
18
19 ;; 2. OPEN & CLOSE
20
21 (defun new-connection (host vhost &rest args
22 &key (port amqp:*standard-port*)
23 (userinfo "guest:guest")
24 &allow-other-keys)
25 (initialize-rabbitmq)
26 (apply #'make-instance 'amqp:connection
27 :uri (puri:uri :scheme :amqp :host host :port port
28 :userinfo userinfo
29 :path vhost)
30 args))
31
32
33 (defmacro with-alive-connection ((connection &key (if-dead :error)) &body body)
34 (rebinding (connection)
35 `(if (connection-alive ,connection)
36 (progn ,@body)
37 ,@(case if-dead
38 ((:error)
39 `((progn (connection-not-alive ,connection)
40 ;; prevent tail call, aid debugging
41 nil)))))))
42
43 (defun new-connection-parameters (vhost)
44 (declare (ignore vhost))
45 (error "new-connection-parameters: no autonomous properties are implemented."))
46
47 (defun connection-not-alive (connection)
48 (error 'connection-not-alive :connection connection))
49
50 (define-condition connection-not-alive (error)
51 ((connection :reader connection-not-alive-connection :initform nil :initarg :connection))
52 (:report (lambda (condition stream)
53 (format stream "Connection~@[ ~a~] is no longer alive"
54 (connection-not-alive-connection condition)))))
55
56 (defun check-connection-alive (connection)
57 (with-alive-connection (connection)
58 ()))
59
60 (defun destroy-connection (connection &key code message)
61 (with-alive-connection (connection :if-dead nil)
62 (handler-case
63 (amqp:request-close connection
64 :reply-code code
65 :reply-test message)
66 (connection-not-alive () ())))
67 connection)
68
69
70 ;; 3. PROPERTIES
71
72 (defun connection-alive (connection)
73 (open-stream-p connection))
74
75 (defun connection-client-property (connection property)
76 (getf (amqp:connection-client-properties connection) property))
77
78 (defun connection-server-property (connection property)
79 (getf (amqp:connection-server-properties connection) property))
80
81 (defun connection-server-product (connection)
82 (connection-server-property connection :product))
83
84 (defun connection-server-platform (connection)
85 (connection-server-property connection :platform))
86
87 (defun connection-server-version (connection)
88 (connection-server-property connection :version))
89
90 (defun connection-server-copyright (connection)
91 (connection-server-property connection :copyright))
92
93 (defun connection-server-info (connection)
94 (connection-server-property connection :information))
95
96
97
98 ;; A. REFERENCES
99 ;; [1] [org.levine.rabbitmq](http://www.nicklevine.org/cl-rabbit/)
100 ;; [2] http://www.rabbitmq.com/releases/rabbitmq-java-client/v1.7.1/rabbitmq-java-client-javadoc-1.7.1/
101 ;;
102 ;; B. HISTORY
103 ;;
104 ;; 2007-09-20 NDL Created.
105 ;; 2010-02-04 JAA Emulation / de.setf.amqp.
106 ;;
107 ;;
108 ;; C. COPYRIGHT
109 ;;
110 ;; Copyright (c) 2007 Wiinz Limited.
111 ;; Copyright (c) 2010 james.anderson@setf.de
112 ;;
113 ;; See `rabbitmq.asd` for the license terms for the original org.levine.rabbitmq package.
114
115 ;;; This file is part of the `de.setf.amqp.rabbitmq` library module.
116 ;;; (c) 2010 [james anderson](mailto:james.anderson@setf.de)
117 ;;;
118 ;;; `de.setf.amqp.rabbitmq` is free software: you can redistribute it and/or modify
119 ;;; it under the terms of the GNU General Public License as published by
120 ;;; the Free Software Foundation as version 3 of the License.
121 ;;;
122 ;;; `de.setf.amqp.rabbitmq` is distributed in the hope that it will be useful,
123 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
124 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
125 ;;; GNU General Public License for more details.
126 ;;;
127 ;;; You should have received a copy of the GNU General Public License
128 ;;; along with `de.setf.amqp.rabbitmq`. If not, see the GNU [site](http://www.gnu.org/licenses/).

  ViewVC Help
Powered by ViewVC 1.1.5