lisp/net/soap-inspect.el

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