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