lisp/net/soap-inspect.el

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