Commit | Line | Data |
---|---|---|
16d2ff89 MA |
1 | ;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 2010-2013 Free Software Foundation, Inc. |
16d2ff89 | 4 | |
d733e817 | 5 | ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> |
4e358705 GM |
6 | ;; Created: October 2010 |
7 | ;; Keywords: soap, web-services, comm, hypermedia | |
d733e817 | 8 | ;; Package: soap-client |
4e358705 GM |
9 | ;; Homepage: http://code.google.com/p/emacs-soap-client |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
16d2ff89 MA |
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. | |
17 | ||
4e358705 | 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
16d2ff89 MA |
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. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
4e358705 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
16d2ff89 MA |
25 | |
26 | ;;; Commentary: | |
88ae2870 | 27 | ;; |
16d2ff89 MA |
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: | |
30 | ;; | |
31 | ;; (soap-inspect *wsdl*) | |
32 | ;; | |
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. | |
35 | ;; | |
36 | ||
16d2ff89 MA |
37 | \f |
38 | ;;; Code: | |
39 | ||
88ae2870 MA |
40 | (eval-when-compile (require 'cl)) |
41 | ||
42 | (require 'soap-client) | |
43 | ||
16d2ff89 MA |
44 | ;;; sample-value |
45 | ||
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. | |
50 | ||
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))))) | |
57 | ||
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))))) | |
68 | ||
db9b177b | 69 | (defun soap-sample-value-for-simple-type (type) |
c846da43 | 70 | "Provide a sample value for TYPE which is a simple type. |
db9b177b AH |
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)))) | |
77 | ||
16d2ff89 MA |
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. | |
82 | ||
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)) | |
95 | ||
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. | |
100 | ||
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))) | |
109 | ||
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))) | |
121 | ||
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) | |
126 | ||
db9b177b AH |
127 | (put (aref (make-soap-simple-type) 0) 'soap-sample-value |
128 | 'soap-sample-value-for-simple-type) | |
129 | ||
16d2ff89 MA |
130 | (put (aref (make-soap-sequence-type) 0) 'soap-sample-value |
131 | 'soap-sample-value-for-seqence-type) | |
132 | ||
133 | (put (aref (make-soap-array-type) 0) 'soap-sample-value | |
134 | 'soap-sample-value-for-array-type) | |
135 | ||
136 | (put (aref (make-soap-message) 0) 'soap-sample-value | |
137 | 'soap-sample-value-for-message) ) | |
138 | ||
139 | ||
140 | \f | |
141 | ;;; soap-inspect | |
142 | ||
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.") | |
146 | ||
147 | (defvar soap-inspect-current-item nil | |
148 | "The current item being inspected in the *soap-inspect* buffer.") | |
149 | ||
150 | (progn | |
151 | (make-variable-buffer-local 'soap-inspect-previous-items) | |
152 | (make-variable-buffer-local 'soap-inspect-current-item)) | |
153 | ||
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")) | |
162 | ||
163 | (with-current-buffer (get-buffer-create "*soap-inspect*") | |
164 | (setq buffer-read-only t) | |
165 | (let ((inhibit-read-only t)) | |
166 | (erase-buffer) | |
88ae2870 | 167 | |
16d2ff89 MA |
168 | (when soap-inspect-current-item |
169 | (push soap-inspect-current-item | |
170 | soap-inspect-previous-items)) | |
171 | (setq soap-inspect-current-item element) | |
88ae2870 | 172 | |
16d2ff89 MA |
173 | (funcall inspect element) |
174 | ||
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)))))) | |
184 | ||
185 | ||
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) | |
194 | ||
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) | |
205 | ||
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)) | |
212 | ||
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))) | |
218 | ||
db9b177b AH |
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 "\" "))))) | |
228 | ||
16d2ff89 MA |
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))) | |
250 | ||
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))) | |
259 | ||
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"))) | |
269 | ||
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")) | |
88ae2870 | 281 | |
16d2ff89 | 282 | (insert "\n\nSample invocation:\n") |
88ae2870 MA |
283 | (let ((sample-message-value |
284 | (soap-sample-value (cdr (soap-operation-input operation)))) | |
16d2ff89 | 285 | (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation)))) |
88ae2870 MA |
286 | (let ((sample-invocation |
287 | (append funcall (mapcar 'cdr sample-message-value)))) | |
16d2ff89 MA |
288 | (pp sample-invocation (current-buffer))))) |
289 | ||
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))))) | |
299 | ||
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) | |
309 | ||
310 | (setq operations (sort operations 'string<)) | |
311 | ||
312 | (setq op-name-width (loop for o in operations maximizing (length o))) | |
313 | ||
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"))))) | |
330 | ||
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))) | |
337 | ||
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"))) | |
349 | ||
350 | (progn | |
351 | ;; Install the soap-inspect methods for our types | |
352 | ||
353 | (put (aref (make-soap-basic-type) 0) 'soap-inspect | |
354 | 'soap-inspect-basic-type) | |
355 | ||
db9b177b AH |
356 | (put (aref (make-soap-simple-type) 0) 'soap-inspect |
357 | 'soap-inspect-simple-type) | |
358 | ||
16d2ff89 MA |
359 | (put (aref (make-soap-sequence-type) 0) 'soap-inspect |
360 | 'soap-inspect-sequence-type) | |
361 | ||
362 | (put (aref (make-soap-array-type) 0) 'soap-inspect | |
363 | 'soap-inspect-array-type) | |
364 | ||
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) | |
88ae2870 | 369 | |
16d2ff89 MA |
370 | (put (aref (make-soap-port-type) 0) 'soap-inspect |
371 | 'soap-inspect-port-type) | |
372 | ||
373 | (put (aref (make-soap-binding) 0) 'soap-inspect | |
374 | 'soap-inspect-binding) | |
375 | ||
376 | (put (aref (make-soap-port) 0) 'soap-inspect | |
377 | 'soap-inspect-port) | |
378 | ||
379 | (put (aref (make-soap-wsdl) 0) 'soap-inspect | |
380 | 'soap-inspect-wsdl)) | |
381 | ||
382 | (provide 'soap-inspect) | |
383 | ;;; soap-inspect.el ends here |