Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

lw additions; record delivery tag in basic for later use to ack message

  • Loading branch information...
commit f5a85606a8f7322fc85f033555a50630287ff531 1 parent 6dea972
james anderson authored
8 amqp-1-1-0-8-0/abstract-classes.lisp
@@ -16,10 +16,10 @@
16 16 A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
17 17 If not, see the GNU [site](http://www.gnu.org/licenses/)."))
18 18
19   -
20   -(defvar amqp-1-1-0-8-0::+protocol-version+
21   - ':amqp-1-1-0-8-0
22   - "Specifies the protocol header for the highest supported version.")
  19 +(eval-when (:compile-toplevel :load-toplevel :execute) ; lw wants this for the shared slot
  20 + (defvar amqp-1-1-0-8-0::+protocol-version+
  21 + ':amqp-1-1-0-8-0
  22 + "Specifies the protocol header for the highest supported version."))
23 23
24 24 (setf (version-protocol-header amqp-1-1-0-8-0::+protocol-version+) #(65 77 81 80 1 1 8 0))
25 25
2  amqp-1-1-0-8-0/amqp-1-1-0-8-0.asd
@@ -27,8 +27,8 @@
27 27 :version 20100111.1
28 28 :depends-on (:de.setf.amqp)
29 29 :components ((:file "package")
30   - (:file "data-wire-coding")
31 30 (:file "abstract-classes")
  31 + (:file "data-wire-coding")
32 32 (:file "classes")
33 33 (:file "device-level"))
34 34 :description
7 amqp-1-1-0-9-0/abstract-classes.lisp
@@ -18,9 +18,10 @@
18 18 If not, see the GNU [site](http://www.gnu.org/licenses/)."))
19 19
20 20
21   -(defvar amqp-1-1-0-9-0::+protocol-version+
22   - :amqp-1-1-0-9-0
23   - "Specifies the protocol header for the highest supported version.")
  21 +(eval-when (:compile-toplevel :load-toplevel :execute) ; lw wants this for the shared slot
  22 + (defvar amqp-1-1-0-9-0::+protocol-version+
  23 + :amqp-1-1-0-9-0
  24 + "Specifies the protocol header for the highest supported version."))
24 25
25 26 (setf (version-protocol-header amqp-1-1-0-9-0::+protocol-version+) #(65 77 81 80 1 1 0 9))
26 27
2  amqp-1-1-0-9-0/amqp-1-1-0-9-0.asd
@@ -27,8 +27,8 @@
27 27 :version 20100111.1
28 28 :depends-on (:de.setf.amqp)
29 29 :components ((:file "package")
30   - (:file "data-wire-coding")
31 30 (:file "abstract-classes")
  31 + (:file "data-wire-coding")
32 32 (:file "classes")
33 33 (:file "device-level"))
34 34 :description
7 amqp-1-1-0-9-1/abstract-classes.lisp
@@ -17,9 +17,10 @@
17 17 If not, see the GNU [site](http://www.gnu.org/licenses/)."))
18 18
19 19
20   -(defvar amqp-1-1-0-9-1::+protocol-version+
21   - :amqp-1-1-0-9-1
22   - "Specifies the protocol header for the highest supported version.")
  20 +(eval-when (:compile-toplevel :load-toplevel :execute) ; lw wants this for the shared slot
  21 + (defvar amqp-1-1-0-9-1::+protocol-version+
  22 + :amqp-1-1-0-9-1
  23 + "Specifies the protocol header for the highest supported version."))
23 24
24 25 (setf (version-protocol-header amqp-1-1-0-9-1::+protocol-version+) #(65 77 81 80 0 0 9 1))
25 26
2  amqp-1-1-0-9-1/amqp-1-1-0-9-1.asd
@@ -30,8 +30,8 @@
30 30 ;; conformant
31 31 ;; (:file "data-wire-coding")
32 32 ;; rabbitmq-like
33   - (:file "data-wire-coding-rmq")
34 33 (:file "abstract-classes")
  34 + (:file "data-wire-coding-rmq")
35 35 (:file "classes")
36 36 (:file "device-level"))
37 37 :description
86 commands.lisp
@@ -96,6 +96,18 @@
96 96 "Do nothing more than log the message."
97 97 class)))
98 98
  99 +;; 20110402 lw required the -ok be defined before the typecase refrence
  100 +(def-amqp-command amqp:bind-ok (class &key)
  101 + (:documentation "C<--S : Confirm bind successful.
  102 + This command appears as eventual response to a Bind, and should be processed
  103 + synchronously by a request-bind. If one appears independently, log it.
  104 + and continue.")
  105 +
  106 + (:response
  107 + (:method ((queue amqp:queue) &key)
  108 + "Simply log and continue."
  109 + queue)))
  110 +
99 111
100 112 (def-amqp-command amqp:bind (class &key ticket queue exchange routing-key no-wait arguments)
101 113 (:documentation "C-->S: Bind queue to an exchange")
@@ -128,16 +140,18 @@
128 140 queue-class)))
129 141
130 142
131   -(def-amqp-command amqp:bind-ok (class &key)
132   - (:documentation "C<--S : Confirm bind successful.
133   - This command appears as eventual response to a Bind, and should be processed
134   - synchronously by a request-bind. If one appears independently, log it.
  143 +;; 20110402 lw required the -ok be defined before the typecase refrence
  144 +(def-amqp-command amqp:cancel-ok (class &key consumer-tag)
  145 + (:documentation "C<--S : confirm a canceled consumer.
  146 + This command appears as eventual response to Cancel and should be processed
  147 + synchronously by a request-cancel. If one appears independently, log it.
135 148 and continue.")
136   -
  149 +
137 150 (:response
138   - (:method ((queue amqp:queue) &key)
  151 + (:method ((basic amqp::basic) &key consumer-tag)
  152 + (declare (ignore consumer-tag))
139 153 "Simply log and continue."
140   - queue)))
  154 + basic)))
141 155
142 156
143 157 (def-amqp-command amqp:cancel (class &rest args &key consumer-tag no-wait)
@@ -165,17 +179,27 @@ messages in between sending the cancel method and receiving the cancel-ok reply.
165 179 (amqp:body (frame) t)))))
166 180
167 181
168   -(def-amqp-command amqp:cancel-ok (class &key consumer-tag)
169   - (:documentation "C<--S : confirm a canceled consumer.
170   - This command appears as eventual response to Cancel and should be processed
171   - synchronously by a request-cancel. If one appears independently, log it.
172   - and continue.")
  182 +;; 20110402 lw required the -ok be defined before the typecase refrence
  183 +(def-amqp-command amqp:close-ok (class &key)
  184 + (:documentation "C<->S : confirm a channel or connection close close : Sync response to Close.
  185 + This command appears as the eventual response to Cancel and should be processes
  186 + synchronously together with that. I one appears independently, ignore it.")
  187 +
  188 + (:request
  189 + (:method ((class amqp:connection) &key)
  190 + (amqp::send-close-ok class)
  191 + class)
  192 +
  193 + (:method ((class amqp:channel) &key)
  194 + (amqp::send-close-ok class)
  195 + class))
173 196
174 197 (:response
175   - (:method ((basic amqp::basic) &key consumer-tag)
176   - (declare (ignore consumer-tag))
177   - "Simply log and continue."
178   - basic)))
  198 + (:method ((class amqp:connection) &key)
  199 + class)
  200 +
  201 + (:method ((class amqp:channel) &key)
  202 + class)))
179 203
180 204
181 205 (def-amqp-command amqp:close (class &key reply-code reply-text class-id method-id)
@@ -270,28 +294,6 @@ messages in between sending the cancel method and receiving the cancel-ok reply.
270 294 connection)))
271 295
272 296
273   -(def-amqp-command amqp:close-ok (class &key)
274   - (:documentation "C<->S : confirm a channel or connection close close : Sync response to Close.
275   - This command appears as the eventual response to Cancel and should be processes
276   - synchronously together with that. I one appears independently, ignore it.")
277   -
278   - (:request
279   - (:method ((class amqp:connection) &key)
280   - (amqp::send-close-ok class)
281   - class)
282   -
283   - (:method ((class amqp:channel) &key)
284   - (amqp::send-close-ok class)
285   - class))
286   -
287   - (:response
288   - (:method ((class amqp:connection) &key)
289   - class)
290   -
291   - (:method ((class amqp:channel) &key)
292   - class)))
293   -
294   -
295 297 (def-amqp-command amqp:commit (class &key)
296 298 (:documentation "C-->S : Commit the current transaction.")
297 299
@@ -442,11 +444,17 @@ messages in between sending the cancel method and receiving the cancel-ok reply.
442 444 (:method ((basic amqp:basic) &rest args &key delivery-tag &allow-other-keys)
443 445 (declare (dynamic-extent args))
444 446 (let ((channel (object-channel basic)))
  447 + (when (channel-acknowledge-messages channel)
  448 + (setf (amqp:basic-delivery-tag basic) delivery-tag))
445 449 (prog1 (apply #'device-read-content channel args)
446   - (when (channel-acknowledge-messages channel)
  450 + (when (and (channel-acknowledge-messages channel)
  451 + ;; in case the ack was managed elsewhere, set the tag to zero
  452 + (eql (amqp:basic-delivery-tag basic) delivery-tag))
  453 + (setf (amqp:basic-delivery-tag basic) 0)
447 454 (amqp::send-ack basic :delivery-tag delivery-tag)))))))
448 455
449 456
  457 +
450 458 (def-amqp-command amqp:Flow (class &key active)
451 459 (:documentation "C<->S : enable/disable flow from peer : Sync request ")
452 460
2  data-wire-coding.lisp
@@ -298,7 +298,7 @@
298 298 `(simple-array (unsigned-byte 8) (*))
299 299 `(simple-array (unsigned-byte 8) (,length))))
300 300
301   -#+(or clozure sbcl)
  301 +#+(or clozure sbcl lispworks)
302 302 ;; don't tell it more than it needs to know, otherwise shorter vectors conflict with declarations
303 303 (deftype amqp:frame-buffer (&optional length)
304 304 (declare (ignore length))
11 parameters.lisp
@@ -147,3 +147,14 @@
147 147 (eval '(+ single-float-positive-infinity single-float-negative-infinity)))
148 148 (defconstant double-float-nan
149 149 (eval '(+ double-float-positive-infinity double-float-negative-infinity)))))
  150 +
  151 +#+lispworks
  152 +(progn
  153 + (defconstant double-float-positive-infinity system::*plus-infinity-double*)
  154 + (defconstant double-float-negative-infinity system::*minus-infinity-double*)
  155 + (defconstant single-float-positive-infinity (coerce system::*plus-infinity-double* 'single-float))
  156 + (defconstant single-float-negative-infinity (coerce system::*minus-infinity-double* 'single-float))
  157 +
  158 + (defconstant single-float-nan (+ single-float-positive-infinity single-float-negative-infinity))
  159 + (defconstant double-float-nan (+ double-float-positive-infinity double-float-negative-infinity))
  160 + )

0 comments on commit f5a8560

Please sign in to comment.
Something went wrong with that request. Please try again.