lisp/net/soap-inspect.el

   1 ;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures
   2
   3 ;; Copyright (C) 2010-2012  Free Software Foundation, Inc.
   4
   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
  10
  11 ;; This file is part of GNU Emacs.
  12
  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.
  17
  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.
  22
  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/>.
  25
  26 ;;; Commentary:
  27 ;;
  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
  37 \f
  38 ;;; Code:
  39
  40 (eval-when-compile (require 'cl))
  41
  42 (require 'soap-client)
  43
  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
  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))))
  77
  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
 127   (put (aref (make-soap-simple-type) 0) 'soap-sample-value
 128        'soap-sample-value-for-simple-type)
 129
 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)
 167
 168         (when soap-inspect-current-item
 169           (push soap-inspect-current-item
 170                 soap-inspect-previous-items))
 171         (setq soap-inspect-current-item element)
 172
 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
 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
 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"))
 281
 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)))))
 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
 356   (put (aref (make-soap-simple-type) 0) 'soap-inspect
 357        'soap-inspect-simple-type)
 358
 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)
 369
 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