Merge from origin/emacs-24
[emacs.git] / lisp / net / soap-inspect.el
blob2f9cdcb393e6c1c2d2746529aac33d830750a049
1 ;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures
3 ;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
5 ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
6 ;; Created: October 2010
7 ;; Keywords: soap, web-services, comm, hypermedia
8 ;; Package: soap-client
9 ;; Homepage: http://code.google.com/p/emacs-soap-client
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;;; Commentary:
28 ;; This package provides an inspector for a WSDL document loaded with
29 ;; `soap-load-wsdl' or `soap-load-wsdl-from-url'. To use it, evaluate:
31 ;; (soap-inspect *wsdl*)
33 ;; This will pop-up the inspector buffer. You can click on ports, operations
34 ;; and types to explore the structure of the wsdl document.
38 ;;; Code:
40 (eval-when-compile (require 'cl))
42 (require 'soap-client)
44 ;;; sample-value
46 (defun soap-sample-value (type)
47 "Provide a sample value for TYPE, a WSDL type.
48 A sample value is a LISP value which soap-client.el will accept
49 for encoding it using TYPE when making SOAP requests.
51 This is a generic function, depending on TYPE a specific function
52 will be called."
53 (let ((sample-value (get (aref type 0) 'soap-sample-value)))
54 (if sample-value
55 (funcall sample-value type)
56 (error "Cannot provide sample value for type %s" (aref type 0)))))
58 (defun soap-sample-value-for-basic-type (type)
59 "Provide a sample value for TYPE which is a basic type.
60 This is a specific function which should not be called directly,
61 use `soap-sample-value' instead."
62 (case (soap-basic-type-kind type)
63 (string "a string value")
64 (boolean t) ; could be nil as well
65 ((long int) (random 4200))
66 ;; TODO: we need better sample values for more types.
67 (t (format "%s" (soap-basic-type-kind type)))))
69 (defun soap-sample-value-for-simple-type (type)
70 "Provide a sample value for TYPE which is a simple type.
71 This is a specific function which should not be called directly,
72 use `soap-sample-value' instead."
73 (let ((enumeration (soap-simple-type-enumeration type)))
74 (if (> (length enumeration) 1)
75 (elt enumeration (random (length enumeration)))
76 (soap-sample-value-for-basic-type type))))
78 (defun soap-sample-value-for-seqence-type (type)
79 "Provide a sample value for TYPE which is a sequence type.
80 Values for sequence types are ALISTS of (slot-name . VALUE) for
81 each sequence element.
83 This is a specific function which should not be called directly,
84 use `soap-sample-value' instead."
85 (let ((sample-value nil))
86 (dolist (element (soap-sequence-type-elements type))
87 (push (cons (soap-sequence-element-name element)
88 (soap-sample-value (soap-sequence-element-type element)))
89 sample-value))
90 (when (soap-sequence-type-parent type)
91 (setq sample-value
92 (append (soap-sample-value (soap-sequence-type-parent type))
93 sample-value)))
94 sample-value))
96 (defun soap-sample-value-for-array-type (type)
97 "Provide a sample value for TYPE which is an array type.
98 Values for array types are LISP vectors of values which are
99 array's element type.
101 This is a specific function which should not be called directly,
102 use `soap-sample-value' instead."
103 (let* ((element-type (soap-array-type-element-type type))
104 (sample1 (soap-sample-value element-type))
105 (sample2 (soap-sample-value element-type)))
106 ;; Our sample value is a vector of two elements, but any number of
107 ;; elements are permissible
108 (vector sample1 sample2 '&etc)))
110 (defun soap-sample-value-for-message (message)
111 "Provide a sample value for a WSDL MESSAGE.
112 This is a specific function which should not be called directly,
113 use `soap-sample-value' instead."
114 ;; NOTE: parameter order is not considered.
115 (let (sample-value)
116 (dolist (part (soap-message-parts message))
117 (push (cons (car part)
118 (soap-sample-value (cdr part)))
119 sample-value))
120 (nreverse sample-value)))
122 (progn
123 ;; Install soap-sample-value methods for our types
124 (put (aref (make-soap-basic-type) 0) 'soap-sample-value
125 'soap-sample-value-for-basic-type)
127 (put (aref (make-soap-simple-type) 0) 'soap-sample-value
128 'soap-sample-value-for-simple-type)
130 (put (aref (make-soap-sequence-type) 0) 'soap-sample-value
131 'soap-sample-value-for-seqence-type)
133 (put (aref (make-soap-array-type) 0) 'soap-sample-value
134 'soap-sample-value-for-array-type)
136 (put (aref (make-soap-message) 0) 'soap-sample-value
137 'soap-sample-value-for-message) )
141 ;;; soap-inspect
143 (defvar soap-inspect-previous-items nil
144 "A stack of previously inspected items in the *soap-inspect* buffer.
145 Used to implement the BACK button.")
147 (defvar soap-inspect-current-item nil
148 "The current item being inspected in the *soap-inspect* buffer.")
150 (progn
151 (make-variable-buffer-local 'soap-inspect-previous-items)
152 (make-variable-buffer-local 'soap-inspect-current-item))
154 (defun soap-inspect (element)
155 "Inspect a SOAP ELEMENT in the *soap-inspect* buffer.
156 The buffer is populated with information about ELEMENT with links
157 to its sub elements. If ELEMENT is the WSDL document itself, the
158 entire WSDL can be inspected."
159 (let ((inspect (get (aref element 0) 'soap-inspect)))
160 (unless inspect
161 (error "Soap-inspect: no inspector for element"))
163 (with-current-buffer (get-buffer-create "*soap-inspect*")
164 (setq buffer-read-only t)
165 (let ((inhibit-read-only t))
166 (erase-buffer)
168 (when soap-inspect-current-item
169 (push soap-inspect-current-item
170 soap-inspect-previous-items))
171 (setq soap-inspect-current-item element)
173 (funcall inspect element)
175 (unless (null soap-inspect-previous-items)
176 (insert "\n\n")
177 (insert-text-button
178 "[back]"
179 'type 'soap-client-describe-back-link
180 'item element)
181 (insert "\n"))
182 (goto-char (point-min))
183 (pop-to-buffer (current-buffer))))))
186 (define-button-type 'soap-client-describe-link
187 'face 'italic
188 'help-echo "mouse-2, RET: describe item"
189 'follow-link t
190 'action (lambda (button)
191 (let ((item (button-get button 'item)))
192 (soap-inspect item)))
193 'skip t)
195 (define-button-type 'soap-client-describe-back-link
196 'face 'italic
197 'help-echo "mouse-2, RET: browse the previous item"
198 'follow-link t
199 'action (lambda (button)
200 (let ((item (pop soap-inspect-previous-items)))
201 (when item
202 (setq soap-inspect-current-item nil)
203 (soap-inspect item))))
204 'skip t)
206 (defun soap-insert-describe-button (element)
207 "Insert a button to inspect ELEMENT when pressed."
208 (insert-text-button
209 (soap-element-fq-name element)
210 'type 'soap-client-describe-link
211 'item element))
213 (defun soap-inspect-basic-type (basic-type)
214 "Insert information about BASIC-TYPE into the current buffer."
215 (insert "Basic type: " (soap-element-fq-name basic-type))
216 (insert "\nSample value\n")
217 (pp (soap-sample-value basic-type) (current-buffer)))
219 (defun soap-inspect-simple-type (simple-type)
220 "Insert information about SIMPLE-TYPE into the current buffer"
221 (insert "Simple type: " (soap-element-fq-name simple-type) "\n")
222 (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n")
223 (let ((enumeration (soap-simple-type-enumeration simple-type)))
224 (when (> (length enumeration) 1)
225 (insert "Valid values: ")
226 (dolist (e enumeration)
227 (insert "\"" e "\" ")))))
229 (defun soap-inspect-sequence-type (sequence)
230 "Insert information about SEQUENCE into the current buffer."
231 (insert "Sequence type: " (soap-element-fq-name sequence) "\n")
232 (when (soap-sequence-type-parent sequence)
233 (insert "Parent: ")
234 (soap-insert-describe-button
235 (soap-sequence-type-parent sequence))
236 (insert "\n"))
237 (insert "Elements: \n")
238 (dolist (element (soap-sequence-type-elements sequence))
239 (insert "\t" (symbol-name (soap-sequence-element-name element))
240 "\t")
241 (soap-insert-describe-button
242 (soap-sequence-element-type element))
243 (when (soap-sequence-element-multiple? element)
244 (insert " multiple"))
245 (when (soap-sequence-element-nillable? element)
246 (insert " optional"))
247 (insert "\n"))
248 (insert "Sample value:\n")
249 (pp (soap-sample-value sequence) (current-buffer)))
251 (defun soap-inspect-array-type (array)
252 "Insert information about the ARRAY into the current buffer."
253 (insert "Array name: " (soap-element-fq-name array) "\n")
254 (insert "Element type: ")
255 (soap-insert-describe-button
256 (soap-array-type-element-type array))
257 (insert "\nSample value:\n")
258 (pp (soap-sample-value array) (current-buffer)))
260 (defun soap-inspect-message (message)
261 "Insert information about MESSAGE into the current buffer."
262 (insert "Message name: " (soap-element-fq-name message) "\n")
263 (insert "Parts:\n")
264 (dolist (part (soap-message-parts message))
265 (insert "\t" (symbol-name (car part))
266 " type: ")
267 (soap-insert-describe-button (cdr part))
268 (insert "\n")))
270 (defun soap-inspect-operation (operation)
271 "Insert information about OPERATION into the current buffer."
272 (insert "Operation name: " (soap-element-fq-name operation) "\n")
273 (let ((input (soap-operation-input operation)))
274 (insert "\tInput: " (symbol-name (car input)) " (" )
275 (soap-insert-describe-button (cdr input))
276 (insert ")\n"))
277 (let ((output (soap-operation-output operation)))
278 (insert "\tOutput: " (symbol-name (car output)) " (")
279 (soap-insert-describe-button (cdr output))
280 (insert ")\n"))
282 (insert "\n\nSample invocation:\n")
283 (let ((sample-message-value
284 (soap-sample-value (cdr (soap-operation-input operation))))
285 (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation))))
286 (let ((sample-invocation
287 (append funcall (mapcar 'cdr sample-message-value))))
288 (pp sample-invocation (current-buffer)))))
290 (defun soap-inspect-port-type (port-type)
291 "Insert information about PORT-TYPE into the current buffer."
292 (insert "Port-type name: " (soap-element-fq-name port-type) "\n")
293 (insert "Operations:\n")
294 (loop for o being the hash-values of
295 (soap-namespace-elements (soap-port-type-operations port-type))
296 do (progn
297 (insert "\t")
298 (soap-insert-describe-button (car o)))))
300 (defun soap-inspect-binding (binding)
301 "Insert information about BINDING into the current buffer."
302 (insert "Binding: " (soap-element-fq-name binding) "\n")
303 (insert "\n")
304 (insert "Bound operations:\n")
305 (let* ((ophash (soap-binding-operations binding))
306 (operations (loop for o being the hash-keys of ophash
307 collect o))
308 op-name-width)
310 (setq operations (sort operations 'string<))
312 (setq op-name-width (loop for o in operations maximizing (length o)))
314 (dolist (op operations)
315 (let* ((bound-op (gethash op ophash))
316 (soap-action (soap-bound-operation-soap-action bound-op))
317 (use (soap-bound-operation-use bound-op)))
318 (unless soap-action
319 (setq soap-action ""))
320 (insert "\t")
321 (soap-insert-describe-button (soap-bound-operation-operation bound-op))
322 (when (or use (not (equal soap-action "")))
323 (insert (make-string (- op-name-width (length op)) ?\s))
324 (insert " (")
325 (insert soap-action)
326 (when use
327 (insert " " (symbol-name use)))
328 (insert ")"))
329 (insert "\n")))))
331 (defun soap-inspect-port (port)
332 "Insert information about PORT into the current buffer."
333 (insert "Port name: " (soap-element-name port) "\n"
334 "Service URL: " (soap-port-service-url port) "\n"
335 "Binding: ")
336 (soap-insert-describe-button (soap-port-binding port)))
338 (defun soap-inspect-wsdl (wsdl)
339 "Insert information about WSDL into the current buffer."
340 (insert "WSDL Origin: " (soap-wsdl-origin wsdl) "\n")
341 (insert "Ports:")
342 (dolist (p (soap-wsdl-ports wsdl))
343 (insert "\n--------------------\n")
344 ;; (soap-insert-describe-button p)
345 (soap-inspect-port p))
346 (insert "\n--------------------\nNamespace alias table:\n")
347 (dolist (a (soap-wsdl-alias-table wsdl))
348 (insert "\t" (car a) " => " (cdr a) "\n")))
350 (progn
351 ;; Install the soap-inspect methods for our types
353 (put (aref (make-soap-basic-type) 0) 'soap-inspect
354 'soap-inspect-basic-type)
356 (put (aref (make-soap-simple-type) 0) 'soap-inspect
357 'soap-inspect-simple-type)
359 (put (aref (make-soap-sequence-type) 0) 'soap-inspect
360 'soap-inspect-sequence-type)
362 (put (aref (make-soap-array-type) 0) 'soap-inspect
363 'soap-inspect-array-type)
365 (put (aref (make-soap-message) 0) 'soap-inspect
366 'soap-inspect-message)
367 (put (aref (make-soap-operation) 0) 'soap-inspect
368 'soap-inspect-operation)
370 (put (aref (make-soap-port-type) 0) 'soap-inspect
371 'soap-inspect-port-type)
373 (put (aref (make-soap-binding) 0) 'soap-inspect
374 'soap-inspect-binding)
376 (put (aref (make-soap-port) 0) 'soap-inspect
377 'soap-inspect-port)
379 (put (aref (make-soap-wsdl) 0) 'soap-inspect
380 'soap-inspect-wsdl))
382 (provide 'soap-inspect)
383 ;;; soap-inspect.el ends here