/[de-setf-amqp]/amqp-uri.lisp
ViewVC logotype

Contents of /amqp-uri.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: 3890 byte(s)
Merge commit 'remotes/github/master' into remotes/git-svn
1 ;;; -*- Package: de.setf.amqp.implementation; -*-
2
3 (in-package :de.setf.amqp.implementation)
4
5 (document :file
6 (description "This file defines the amqp-uri class to specialize `puri:uri` for use with the 'de.setf.amqp'
7 library.")
8 (copyright
9 "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
10 "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
11 of the GNU Affero General Public License as published by the Free Software Foundation.
12
13 'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
14 implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15 See the Affero General Public License for more details.
16
17 A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
18 If not, see the GNU [site](http://www.gnu.org/licenses/).")
19
20 (long-description "The prospective, standard format for AMQP uri is described in the 0.10 version spec[1],
21 in addition to which QPID suggests to how to support unserinfo[2]. In addition to these, exchange and queue
22 values are recognized as query parameters. QPID suggests[3] a syntax for binding URLs, but its interpreation
23 of scheme values is suspect.
24
25 [1]: http://jira.amqp.org/confluence/download/attachments/720900/amqp.0-10.pdf?version=1
26 [2]: http://qpid.apache.org/url-format-proposal.html
27 [3]: http://qpid.apache.org/bindingurlformat.html"))
28
29
30 (eval-when (:compile-toplevel :load-toplevel :execute)
31 (let ((from (or (find-package :puri) (find-package :uri)
32 (error "No uri package found."))))
33 (import (mapcar #'(lambda (s) (find-symbol (string s) from))
34 '(#:uri #:uri-scheme #:uri-host #:uri-port #:uri-path #:uri-query #:uri-fragment #:uri-plist
35 #:uri-user #:uri-password #:uri-userinfo #:merge-uris))
36 *package*)))
37
38
39 (defclass amqp (uri)
40 ()
41 (:documentation "Extend the base uri class with support for exchange and queue query parameters an
42 to provide the default scheme throug a constructor."))
43
44
45 (defmethod shared-initialize ((uri amqp) (slots t) &rest initargs &key (scheme :amqp))
46 (declare (dynamic-extent initargs))
47 (apply #'call-next-method uri slots
48 :scheme scheme
49 initargs))
50
51 ;; (uri 'amqp :host "1.2.3.4" :port 100)
52
53
54 (defmethod uri-query-plist ((uri uri))
55 (or (getf (uri-plist uri) 'query-plist)
56 (setf (getf (uri-plist uri) 'query-plist)
57 (let ((string (uri-query uri)))
58 (reduce #'nconc (mapcar #'(lambda (pair)
59 (let ((eql-separator (position #\= pair)))
60 (if eql-separator
61 (list (intern (string-upcase (subseq pair 0 eql-separator)) :keyword)
62 (subseq pair (1+ eql-separator)))
63 (list (intern (string-upcase pair) :keyword) t))))
64 (split-string string "&;")))))))
65
66 (defmethod (setf uri-query-plist) (plist (uri uri))
67 (setf (getf (uri-plist uri) 'query-plist) plist))
68
69 (defmethod uri-query-parameter ((uri uri) parameter)
70 (getf (uri-query-plist uri) parameter))
71
72 (defmethod (setf uri-query-parameter) (value (uri uri) parameter)
73 (setf (getf (uri-query-plist uri) parameter) value))
74
75
76 (defmethod uri-exchange ((uri uri))
77 (uri-query-parameter uri :exchange))
78
79 (defmethod uri-queue ((uri uri))
80 (uri-query-parameter uri :queue))
81
82 (defmethod uri-virtual-host ((uri uri))
83 "Delegate to uri-path, but map a null path to '/'"
84 (or (uri-path uri) "/"))
85
86
87 #+(or )
88 (inspect (merge-uris (amqp-uri (rest (parse-amqp-uri "/asdf/qwer.txt")))
89 (amqp-uri (rest (parse-amqp-uri "amqp://test.com/xxx/yyy.zzz")))))

  ViewVC Help
Powered by ViewVC 1.1.5