[cl-soap-cvs] CVS update: cl-soap/src/namespaces.lisp cl-soap/src/wsdl.lisp
Sven Van Caekenberghe
scaekenberghe at common-lisp.net
Mon Sep 12 11:24:02 UTC 2005
Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv30908/src
Modified Files:
namespaces.lisp wsdl.lisp
Log Message:
added parsing of WSDL SOAP extension elements
Date: Mon Sep 12 13:24:01 2005
Author: scaekenberghe
Index: cl-soap/src/namespaces.lisp
diff -u cl-soap/src/namespaces.lisp:1.4 cl-soap/src/namespaces.lisp:1.5
--- cl-soap/src/namespaces.lisp:1.4 Fri Sep 9 16:18:02 2005
+++ cl-soap/src/namespaces.lisp Mon Sep 12 13:24:01 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: namespaces.lisp,v 1.4 2005/09/09 14:18:02 scaekenberghe Exp $
+;;;; $Id: namespaces.lisp,v 1.5 2005/09/12 11:24:01 scaekenberghe Exp $
;;;;
;;;; Definition of some standard XML namespaces commonly needed for SOAP
;;;;
@@ -73,7 +73,7 @@
(defpackage :wsdl-soap
(:nicknames "wsdl-soap")
- (:export)
+ (:export "address" "binding" "operation" "body" "header" "fault" "headerfault")
(:documentation "Package for symbols in the WSDL Soap Bindings XML Namespace"))
(defparameter *wsdl-soap-ns* (s-xml:register-namespace +wsdl-soap-ns-uri+ "soap" :wsdl-soap))
Index: cl-soap/src/wsdl.lisp
diff -u cl-soap/src/wsdl.lisp:1.2 cl-soap/src/wsdl.lisp:1.3
--- cl-soap/src/wsdl.lisp:1.2 Fri Sep 9 16:17:37 2005
+++ cl-soap/src/wsdl.lisp Mon Sep 12 13:24:01 2005
@@ -1,8 +1,8 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: wsdl.lisp,v 1.2 2005/09/09 14:17:37 scaekenberghe Exp $
+;;;; $Id: wsdl.lisp,v 1.3 2005/09/12 11:24:01 scaekenberghe Exp $
;;;;
-;;;; The basic WSDL protocol
+;;;; The basic WSDL protocol: we parse the generic and soap specific parts
;;;;
;;;; Copyright (C) 2005 Sven Van Caekenberghe, Beta Nine BVBA. All Rights Reserved.
;;;;
@@ -13,7 +13,7 @@
(in-package :cl-soap)
-;;; Generic Soap Model
+;;; Generic WSDL Model
(defclass abstract-wsdl-definition ()
((name :accessor get-name :initarg :name :initform nil)
@@ -36,17 +36,19 @@
(defclass wsdl-port (abstract-wsdl-definition)
((binding :accessor get-binding :initarg :binding :initform nil)
- (network-address)))
+ (extension :accessor get-extension :initarg :extension :initform nil)))
(defclass wsdl-binding (abstract-wsdl-definition)
((type :accessor get-type :initarg :type :initform nil)
- (operations :accessor get-operations :initarg :operations :initform nil)))
+ (operations :accessor get-operations :initarg :operations :initform nil)
+ (extensions :accessor get-extensions :initarg :extensions :initform nil)))
(defclass wsdl-port-type (abstract-wsdl-definition)
((operations :accessor get-operations :initarg :operations :initform nil)))
(defclass wsdl-operation-element ()
- ((message :accessor get-message :initarg :message :initform nil)))
+ ((message :accessor get-message :initarg :message :initform nil)
+ (extensions :accessor get-extensions :initarg :extensions :initform nil)))
(defmethod print-object ((object wsdl-operation-element) out)
(print-unreadable-object (object out :type t :identity t)
@@ -62,7 +64,8 @@
())
(defclass wsdl-operation (abstract-wsdl-definition)
- ((elements :accessor get-elements :initarg :elements :initform nil)))
+ ((elements :accessor get-elements :initarg :elements :initform nil)
+ (extensions :accessor get-extensions :initarg :extensions :initform nil)))
(defclass wsdl-part ()
((name :accessor get-name :initarg :name :initform nil)
@@ -77,60 +80,107 @@
((parts :accessor get-parts :initarg :parts :initform nil)))
(defclass wsdl-type (abstract-wsdl-definition)
+ ;; to be finished !!!
((data-type-definitions)))
-;;; WSDL SOAP Model
+;;; WSDL SOAP Model Extension Elements
-(defclass wsdl-soap-service (wsdl-service)
- ((location)))
+(defclass wsdl-soap-address ()
+ ((location :accessor get-location :initarg :location :initform "http://localhost")))
-(defclass wsdl-soap-binding (wsdl-binding)
- ((style)
- (transport)))
-
-(defclass wsdl-soap-operation (wsdl-operation)
- ((soap-action)
- (style)))
-
-(defclass wsdl-soap-body ()
- ((parts)
- (use)
- (encoding-style)
- (namespace)))
-
-(defclass wsdl-soap-fault ()
- ((name)
- (use)
- (encoding-style)
- (namespace)))
-
-(defclass wsdl-soap-header ()
- ((message)
- (part)
- (use)
- (encoding-style)
- (namespace)))
+(defmethod print-object ((object wsdl-soap-address) out)
+ (print-unreadable-object (object out :type t :identity t)
+ (prin1 (or (get-location object) "unknown") out)))
+
+(defclass wsdl-soap-binding ()
+ ((style :accessor get-style :initarg :style :initform "document")
+ (transport :accessor get-transport :initarg :transport :initform "http://schemas.xmlsoap.org/soap/http")))
+
+(defclass wsdl-soap-operation ()
+ ((soap-action :accessor get-soap-action :initarg :soap-action :initform nil)
+ (style :accessor get-style :initarg :style :initform nil)))
+
+(defclass wsdl-soap-operation-element ()
+ ((use :accessor get-use :initarg :use :initform nil)
+ (encoding-style :accessor get-encoding-style :initarg :encoding-style :initform nil)
+ (namespace :accessor get-namespace :initarg :namespace :initform nil)))
+
+(defclass wsdl-soap-body (wsdl-soap-operation-element)
+ ((parts :accessor get-parts :initarg :parts :initform nil)))
+
+(defclass wsdl-soap-fault (wsdl-soap-operation-element)
+ ((name :accessor get-name :initarg :name :initform nil)))
+
+(defclass wsdl-soap-header (wsdl-soap-operation-element)
+ ((message :accessor get-message :initarg :message :initform nil)
+ (part :accessor get-part :initarg :part :initform nil)))
(defclass wsdl-soap-header-fault (wsdl-soap-header)
())
;; Parsing
+;; one day we should handle <import> statements ;-)
+
+(defun lxml->operation-element (lxml)
+ (let* ((attributes (lxml-get-attributes lxml))
+ (message (getf attributes :|message|))
+ (class (ecase (lxml-get-tag lxml)
+ (wsdl:|input| 'wsdl-input)
+ (wsdl:|output| 'wsdl-output)
+ (wsdl:|fault| 'wsdl-fault)))
+ (operation-element (make-instance class :message message)))
+ (loop :for element :in (rest lxml)
+ :do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation operation-element)
+ (rest element)))
+ (wsdl-soap:|body| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-body
+ :use (getf attributes :|use|)
+ :encoding-style (getf attributes :|encodingStyle|)
+ :namespace (getf attributes :|namespace|)
+ :parts (getf attributes :|parts|))
+ (get-extensions operation-element))))
+ (wsdl-soap:|fault| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-fault
+ :use (getf attributes :|use|)
+ :encoding-style (getf attributes :|encodingStyle|)
+ :namespace (getf attributes :|namespace|)
+ :name (getf attributes :|name|))
+ (get-extensions operation-element))))
+ (wsdl-soap:|header| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-header
+ :use (getf attributes :|use|)
+ :encoding-style (getf attributes :|encodingStyle|)
+ :namespace (getf attributes :|namespace|)
+ :part (getf attributes :|part|)
+ :message (getf attributes :|message|))
+ (get-extensions operation-element))))
+ (wsdl-soap:|headerfault| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-header-fault
+ :use (getf attributes :|use|)
+ :encoding-style (getf attributes :|encodingStyle|)
+ :namespace (getf attributes :|namespace|)
+ :part (getf attributes :|part|)
+ :message (getf attributes :|message|))
+ (get-extensions operation-element))))))
+ operation-element))
+
(defun lxml->operation (lxml)
(let* ((attributes (lxml-get-attributes lxml))
(name (getf attributes :|name|))
(wsdl-operation (make-instance 'wsdl-operation :name name)))
(loop :for element :in (rest lxml)
:do (case (lxml-get-tag element)
- (wsdl:|input| (push (make-instance 'wsdl-input
- :message (getf (lxml-get-attributes element) :|message|))
- (get-elements wsdl-operation)))
- (wsdl:|output| (push (make-instance 'wsdl-output
- :message (getf (lxml-get-attributes element) :|message|))
- (get-elements wsdl-operation)))
- (wsdl:|fault| (push (make-instance 'wsdl-fault
- :message (getf (lxml-get-attributes element) :|message|))
- (get-elements wsdl-operation)))))
+ (wsdl:|documentation| (setf (get-documentation wsdl-operation)
+ (rest element)))
+ (wsdl-soap:|operation| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-operation
+ :style (getf attributes :|style|)
+ :soap-action (getf attributes :|soapAction|))
+ (get-extensions wsdl-operation))))
+ ((wsdl:|input| wsdl:|output| wsdl:|fault|) (push (lxml->operation-element element)
+ (get-elements wsdl-operation)))))
wsdl-operation))
(defun lxml->port-type (lxml)
@@ -139,6 +189,8 @@
(wsdl-port-type (make-instance 'wsdl-port-type :name name)))
(loop :for element :in (rest lxml)
:do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation wsdl-port-type)
+ (rest element)))
(wsdl:|operation| (push (lxml->operation element)
(get-operations wsdl-port-type)))))
wsdl-port-type))
@@ -160,6 +212,8 @@
(wsdl-message (make-instance 'wsdl-message :name name)))
(loop :for element :in (rest lxml)
:do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation wsdl-message)
+ (rest element)))
(wsdl:|part| (push (lxml->part element)
(get-parts wsdl-message)))))
wsdl-message))
@@ -171,6 +225,13 @@
(wsdl-binding (make-instance 'wsdl-binding :name name :type type)))
(loop :for element :in (rest lxml)
:do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation wsdl-binding)
+ (rest element)))
+ (wsdl-soap:|binding| (let ((attributes (lxml-get-attributes element)))
+ (push (make-instance 'wsdl-soap-binding
+ :style (getf attributes :|style|)
+ :transport (getf attributes :|transport|))
+ (get-extensions wsdl-binding))))
(wsdl:|operation| (push (lxml->operation element)
(get-operations wsdl-binding)))))
wsdl-binding))
@@ -180,6 +241,13 @@
(name (getf attributes :|name|))
(binding (getf attributes :|binding|))
(wsdl-port (make-instance 'wsdl-port :name name :binding binding)))
+ (loop :for element :in (rest lxml)
+ :do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation wsdl-port)
+ (rest element)))
+ (wsdl-soap:|address| (setf (get-extension wsdl-port)
+ (make-instance 'wsdl-soap-address
+ :location (getf (lxml-get-attributes element) :|location|))))))
wsdl-port))
(defun lxml->service (lxml)
@@ -188,6 +256,8 @@
(wsdl-service (make-instance 'wsdl-service :name name)))
(loop :for element :in (rest lxml)
:do (case (lxml-get-tag element)
+ (wsdl:|documentation| (setf (get-documentation wsdl-service)
+ (rest element)))
(wsdl:|port| (push (lxml->port element)
(get-ports wsdl-service)))))
wsdl-service))
More information about the Cl-soap-cvs
mailing list