Permalink
Browse files

added emulation for org.nicklevine.rabbitmq.

  • Loading branch information...
1 parent cc29b23 commit 9e93b21a7c39d34842e00d0984a05be23c65e6ed @lisp committed Feb 4, 2010
View
Binary file not shown.
View

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -0,0 +1,128 @@
+;;;-* Package: rabbitmq; -*-
+;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-rabbit/connection.lisp#2 $
+
+(in-package :rabbitmq)
+
+;; CONNECTION.LISP
+;; Nick Levine, Ravenbrook Limited, 2007-09-20
+;; James Anderson, setf.de, 2010-02-04
+;;
+;; 1. INTRODUCTION
+;;
+;; The purpose of this document is to implement a lisp interface to AMQP connections consistent with the
+;; RabbitMQ API. It emulates the original com.nicklevine.rabbitmq version, which was layered over
+;; RabbitMQ/Java
+;;
+;; See Appendix C below for copyright and license.
+
+
+;; 2. OPEN & CLOSE
+
+(defun new-connection (host vhost &rest args
+ &key (port amqp:*standard-port*)
+ (userinfo "guest:guest")
+ &allow-other-keys)
+ (initialize-rabbitmq)
+ (apply #'make-instance 'amqp:connection
+ :uri (puri:uri :scheme :amqp :host host :port port
+ :userinfo userinfo
+ :path vhost)
+ args))
+
+
+(defmacro with-alive-connection ((connection &key (if-dead :error)) &body body)
+ (rebinding (connection)
+ `(if (connection-alive ,connection)
+ (progn ,@body)
+ ,@(case if-dead
+ ((:error)
+ `((progn (connection-not-alive ,connection)
+ ;; prevent tail call, aid debugging
+ nil)))))))
+
+(defun new-connection-parameters (vhost)
+ (declare (ignore vhost))
+ (error "new-connection-parameters: no autonomous properties are implemented."))
+
+(defun connection-not-alive (connection)
+ (error 'connection-not-alive :connection connection))
+
+(define-condition connection-not-alive (error)
+ ((connection :reader connection-not-alive-connection :initform nil :initarg :connection))
+ (:report (lambda (condition stream)
+ (format stream "Connection~@[ ~a~] is no longer alive"
+ (connection-not-alive-connection condition)))))
+
+(defun check-connection-alive (connection)
+ (with-alive-connection (connection)
+ ()))
+
+(defun destroy-connection (connection &key code message)
+ (with-alive-connection (connection :if-dead nil)
+ (handler-case
+ (amqp:request-close connection
+ :reply-code code
+ :reply-test message)
+ (connection-not-alive () ())))
+ connection)
+
+
+;; 3. PROPERTIES
+
+(defun connection-alive (connection)
+ (open-stream-p connection))
+
+(defun connection-client-property (connection property)
+ (getf (amqp:connection-client-properties connection) property))
+
+(defun connection-server-property (connection property)
+ (getf (amqp:connection-server-properties connection) property))
+
+(defun connection-server-product (connection)
+ (connection-server-property connection :product))
+
+(defun connection-server-platform (connection)
+ (connection-server-property connection :platform))
+
+(defun connection-server-version (connection)
+ (connection-server-property connection :version))
+
+(defun connection-server-copyright (connection)
+ (connection-server-property connection :copyright))
+
+(defun connection-server-info (connection)
+ (connection-server-property connection :information))
+
+
+
+;; A. REFERENCES
+;; [1] [org.levine.rabbitmq](http://www.nicklevine.org/cl-rabbit/)
+;; [2] http://www.rabbitmq.com/releases/rabbitmq-java-client/v1.7.1/rabbitmq-java-client-javadoc-1.7.1/
+;;
+;; B. HISTORY
+;;
+;; 2007-09-20 NDL Created.
+;; 2010-02-04 JAA Emulation / de.setf.amqp.
+;;
+;;
+;; C. COPYRIGHT
+;;
+;; Copyright (c) 2007 Wiinz Limited.
+;; Copyright (c) 2010 james.anderson@setf.de
+;;
+;; See `rabbitmq.asd` for the license terms for the original org.levine.rabbitmq package.
+
+;;; This file is part of the `de.setf.amqp.rabbitmq` library module.
+;;; (c) 2010 [james anderson](mailto:james.anderson@setf.de)
+;;;
+;;; `de.setf.amqp.rabbitmq` is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation as version 3 of the License.
+;;;
+;;; `de.setf.amqp.rabbitmq` is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with `de.setf.amqp.rabbitmq`. If not, see the GNU [site](http://www.gnu.org/licenses/).
View
@@ -0,0 +1,83 @@
+;;;-* Package: rabbitmq; -*-
+;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-rabbit/errors.lisp#2 $
+
+(in-package :rabbitmq)
+
+;; ERRORS.LISP
+;; Nick Levine, Ravenbrook Limited, 2007-09-21
+;; James Anderson, setf.de, 2010-02-04
+;;
+;; 1. INTRODUCTION
+;;
+;; This document defines a RabbitMQ protocol class for errors and intergrates it into the de.setf.amqp
+;; error class.
+;;
+;; See Appendix C below for copyright and license.
+
+;;; define a protocol exception class for this interface and
+;;; modify the base definition to reflect it.
+
+(define-condition amqp-exception (#+jfli java-exception
+ #-jfli simple-error)
+ ())
+
+;;; adjust the error class to fit with the jfli-based class
+(interpose-superclass 'amqp-exception 'amqp:error)
+
+
+(defun call-ignoring-not-found (operator)
+ "Call the operator and suppress amqp not found exceptions.
+ Serves as the functional implementation for IGNORE-NOT-FOUND-ERRORS."
+ (declare (dynamic-extent operator))
+ (handler-bind ((amqp:not-found-error
+ (lambda (e)
+ (return-from call-ignoring-not-found
+ (values nil e)))))
+ (funcall operator)))
+
+(defmacro ignore-not-found-errors (&body body)
+ "Normal control flow returns the value(s) from the body.
+ Iff an AMQP exception is signaled with a not-found error code,
+ the error is ignored and the form returns two values, NIL and the
+ signaled exception."
+ (let ((operator (gensym (string 'ignore-not-found))))
+ `(flet ((,operator () ,@body))
+ (declare (dynamic-extent #',operator))
+ (call-ignoring-not-found #',operator))))
+
+(defmacro trapping-not-found (&body body)
+ `(ignore-not-found-errors ,@body))
+
+;; A. REFERENCES
+;; [1] [org.levine.rabbitmq](http://www.nicklevine.org/cl-rabbit/)
+;; [2] http://www.rabbitmq.com/releases/rabbitmq-java-client/v1.7.1/rabbitmq-java-client-javadoc-1.7.1/
+;;
+;; B. HISTORY
+;;
+;; 2007-09-21 NDL Created.
+;; 2010-02-04 JAA Emulation / de.setf.amqp.
+;; factored out jfli dependency for portability
+;; trapping-not-found -> ignore-not-found-errors
+;;
+;;
+;; C. COPYRIGHT
+;;
+;; Copyright (c) 2007 Wiinz Limited.
+;; Copyright (c) 2010 james.anderson@setf.de
+;;
+;; See `rabbitmq.asd` for the license terms for the original org.levine.rabbitmq package.
+
+;;; This file is part of the `de.setf.amqp.rabbitmq` library module.
+;;; (c) 2010 [james anderson](mailto:james.anderson@setf.de)
+;;;
+;;; `de.setf.amqp.rabbitmq` is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation as version 3 of the License.
+;;;
+;;; `de.setf.amqp.rabbitmq` is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with `de.setf.amqp.rabbitmq`. If not, see the GNU [site](http://www.gnu.org/licenses/).
View
@@ -0,0 +1,124 @@
+;;;-* Package: rabbitmq; -*-
+
+(in-package :rabbitmq)
+
+;; EXAMPLES.LISP
+;; Nick Levine, Ravenbrook Limited, 2007-09-04
+;; James Anderson, setf.de, 2010-02-04
+
+;; 1. INTRODUCTION
+;;
+;; The purpose of this document demonstrate the RABBITMQ package.
+;;
+;; See Appendix C below for copyright and license.
+
+;; This transcript paraphrases Levine's original README, with results as per emulation.
+;; It opens a connection and a channel, declares exchange and queue, binds them and
+;; loops a message back to itself.
+
+(defparameter *my-connection* nil)
+(defparameter *my-channel* nil)
+(defparameter *outgoing-message* nil)
+(defparameter *incoming-message* nil)
+
+(setq *my-connection* (new-connection "localhost" "/"))
+;; #<AMQP-1-1-0-9-1:CLIENT-CONNECTION #x278956FE>
+
+(setq *my-channel* (new-channel *my-connection*))
+;; #<CHANNEL [#<URI amqp://localhost:5672/>].1 #x278C33FE>
+
+
+(declare-exchange *my-channel* "my exchange" :direct)
+;; #<AMQP-1-1-0-9-1:EXCHANGE #x27A3C2FE>
+
+(declare-queue *my-channel* "my queue")
+;; #<AMQP-1-1-0-9-1:QUEUE #x27C8E346>
+
+(bind-queue *my-channel* "my queue" "my exchange" "my routing key")
+;; #<AMQP-1-1-0-9-1:QUEUE #x27C8E346>
+
+
+;;; - Send a message into the void:
+(setq *outgoing-message* (new-message))
+;; #<OUTGOING-MESSAGE #x27CBAFEE>
+
+
+(setf (message-id *outgoing-message*) "42"
+ (message-body *outgoing-message*) "Hello, World")
+;; "Hello, World"
+
+
+(publish *outgoing-message* *my-channel* "my exchange" "my routing key")
+;; "Hello, World"
+
+
+;;; - And get it back again:
+(consume-queue *my-channel* "my queue")
+;; #<CHANNEL [#<URI amqp://localhost:5672/>].1 #x2B5691F6>
+
+(channel-arrived-count *my-channel*)
+;; 1
+
+(setq *incoming-message* (next-message *my-channel*))
+;; #<RABBITMQ::QUEUEINGCONSUMER$DELIVERY #x2B7F9486>
+
+(values (message-body *incoming-message*)
+ (message-id *incoming-message*))
+;; "Hello, World"
+;; ""
+
+(close *my-connection* :abort t)
+
+
+;; A. REFERENCES
+;; [1] [org.levine.rabbitmq](http://www.nicklevine.org/cl-rabbit/)
+;;
+;; B. HISTORY
+;;
+;; 2007-09-21 NDL Created.
+;; 2009-02-04 james.anderson@setf.de portability
+;;
+;;
+;; 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.
+
+;;;
+;;; This file is part of the `de.setf.amqp.rabbitmq` library module.
+;;; It contains examples for simple interaction with a broker.
+;;; (c) 2010 [james anderson](mailto:james.anderson@setf.de)
+;;;
+;;; `de.setf.amqp.rabbitmq` is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, as version 3 of the License.
+;;;
+;;; `de.setf.amqp.rabbitmq` is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with `de.setf.amqp.rabbitmq`. If not, see the GNU [site](http://www.gnu.org/licenses/).
+
+
+;;; 2010-02-03 [janderson](james.anderson@setf.de)
Oops, something went wrong.

0 comments on commit 9e93b21

Please sign in to comment.