Skip to content
Browse files

Baseline version that works with Clojure 1.4.0 and lein2 etc

  • Loading branch information...
0 parents commit c8061a72ca015180639610c278e309118f6b7d65 @seancorfield committed
Showing with 236 additions and 0 deletions.
  1. +3 −0 .gitignore
  2. +45 −0 README.md
  3. +11 −0 project.clj
  4. +150 −0 src/clj_soap/core.clj
  5. +27 −0 test/clj_soap/test/core.clj
3 .gitignore
@@ -0,0 +1,3 @@
+.lein-deps-sum
+.lein-failures
+/target/*
45 README.md
@@ -0,0 +1,45 @@
+# clj-soap
+
+clj-soap is SOAP server and client using Apache Axis2.
+
+This version is updated from Tetsuya Takatsuru's version to use Clojure 1.4.0 (and modern contrib).
+
+## Usage
+
+### Client
+
+You can call remote SOAP method as following:
+
+ (require '[clj-soap.core :as soap])
+ (let [client (soap/client-fn "http://... (URL for WSDL)")]
+ (client :someMethod param1 param2 ...))
+
+### Server
+
+To make SOAP service:
+
+ (require '[clj-soap.core :as soap])
+
+ ;; Defining service class
+ (soap/defservice my.some.SoapClass
+ (someMethod ^String [^Integer x ^String s]
+ (str "x is " x "\ts is " s)))
+
+ ;; Start SOAP Service
+ (serve "my.some.SoapClass")
+
+`defservice` needs to be AOT-compiled.
+For example, `lein compile` before running server.
+
+#### Type Hint
+
+SOAP services need typehints.
+`String` for arguments nad `void` for return value,
+if you don't specify typehints.
+
+## License
+
+Copyright (C) 2011 Tetsuya Takatsuru
+
+Distributed under the Eclipse Public License, the same as Clojure.
+
11 project.clj
@@ -0,0 +1,11 @@
+(defproject clj-soap "0.2.0-SNAPSHOT"
+ :description "SOAP Client and Server using Apache Axis2."
+ :url "https://bitbucket.org/taka2ru/clj-soap"
+ :dependencies [[org.clojure/clojure "1.4.0"]
+ [org.clojure/core.incubator "0.1.1"]
+ [org.apache.axis2/axis2-adb "1.6.2"]
+ [org.apache.axis2/axis2-transport-http "1.6.2"]
+ [org.apache.axis2/axis2-transport-local "1.6.2"]]
+ :source-paths ["src" "test"]
+ :aot [clj-soap.test.core])
+
150 src/clj_soap/core.clj
@@ -0,0 +1,150 @@
+(ns clj-soap.core
+ (:require [clojure.core.incubator :refer [-?>]]))
+
+;;; Defining SOAP Server
+
+(defn flatten1 [coll] (mapcat identity coll))
+
+(defn gen-class-method-decls [method-defs]
+ (flatten1
+ (letfn [(gen-decl [method-name arglist body]
+ [method-name
+ (vec (for [arg arglist] (or (:tag (meta arg)) String)))
+ (or (:tag (meta arglist)) 'void)])]
+ (for [method-def method-defs]
+ (cond
+ (vector? (second method-def))
+ (list (let [[method-name arglist & body] method-def]
+ (gen-decl method-name arglist body)))
+ (seq? (second method-def))
+ (let [[method-name & deflist] method-def]
+ (for [[arglist & body] deflist]
+ (gen-decl method-name arglist body))))))))
+
+(defn gen-method-defs [prefix method-defs]
+ (flatten1
+ (for [method-def method-defs]
+ (cond
+ (vector? (second method-def))
+ (list (let [[method-name arglist & body] method-def]
+ `(defn ~(symbol (str prefix method-name))
+ ~(vec (cons 'this arglist)) ~@body)))
+ (seq? (second method-def))
+ (let [[method-name & deflist] method-def]
+ (cons
+ `(defmulti ~(symbol (str prefix method-name))
+ (fn [~'this & args#] (vec (map class args#))))
+ (for [[arglist & body] deflist]
+ `(defmethod ~(symbol (str prefix method-name))
+ ~(vec (map #(:tag (meta %)) arglist))
+ ~(vec (cons 'this arglist)) ~@body))))))))
+
+
+(defmacro defservice
+ "Define SOAP class.
+ i.e. (defsoap some.package.KlassName (myfunc [String a int b] String (str a (* b b))))"
+ [class-name & method-defs]
+ (let [prefix (str (gensym "prefix"))]
+ `(do
+ (gen-class
+ :name ~class-name
+ :prefix ~prefix
+ :methods ~(vec (gen-class-method-decls method-defs)))
+ ~@(gen-method-defs prefix method-defs))))
+
+(defn serve
+ "Start SOAP server.
+ argument classes is list of strings of classnames."
+ [& classes]
+ (let [server (org.apache.axis2.engine.AxisServer.)]
+ (doseq [c classes]
+ (.deployService server (str c)))))
+
+;; Client call
+
+(defn axis-service-namespace [axis-service]
+ (.get (.getNamespaceMap axis-service) "ns"))
+
+(defn axis-service-operations [axis-service]
+ (iterator-seq (.getOperations axis-service)))
+
+(defn axis-op-name [axis-op]
+ (.getLocalPart (.getName axis-op)))
+
+(defn axis-op-namespace [axis-op]
+ (.getNamespaceURI (.getName axis-op)))
+
+(defn axis-op-args [axis-op]
+ (for [elem (-?> (first (filter #(= "out" (.getDirection %))
+ (iterator-seq (.getMessages axis-op))))
+ .getSchemaElement .getSchemaType
+ .getParticle .getItems .getIterator iterator-seq)]
+ {:name (.getName elem) :type (-?> elem .getSchemaType .getName keyword)}))
+
+(defn axis-op-rettype [axis-op]
+ (-?> (first (filter #(= "in" (.getDirection %))
+ (iterator-seq (.getMessages axis-op))))
+ .getSchemaElement .getSchemaType .getParticle .getItems .getIterator
+ iterator-seq first
+ .getSchemaType .getName
+ keyword))
+
+(defmulti obj->soap-str (fn [obj argtype] argtype))
+
+(defmethod obj->soap-str :integer [obj argtype] (str obj))
+(defmethod obj->soap-str :double [obj argtype] (str obj))
+(defmethod obj->soap-str :string [obj argtype] (str obj))
+(defmethod obj->soap-str :boolean [obj argtype] (str obj))
+(defmethod obj->soap-str :anyType [obj argtype] (str obj))
+
+(defmulti soap-str->obj (fn [obj argtype] argtype))
+
+(defmethod soap-str->obj :integer [soap-str argtype] (Integer/parseInt soap-str))
+(defmethod soap-str->obj :double [soap-str argtype] (Double/parseDouble soap-str))
+(defmethod soap-str->obj :string [soap-str argtype] soap-str)
+(defmethod soap-str->obj :boolean [soap-str argtype] (Boolean/parseBoolean soap-str))
+(defmethod soap-str->obj :anyType [soap-str argtype] soap-str)
+
+(defn make-client [url]
+ (doto (org.apache.axis2.client.ServiceClient. nil (java.net.URL. url) nil nil)
+ (.setOptions
+ (doto (org.apache.axis2.client.Options.)
+ (.setTo (org.apache.axis2.addressing.EndpointReference. url))))))
+
+(defn make-request [op & args]
+ (let [factory (org.apache.axiom.om.OMAbstractFactory/getOMFactory)
+ request (.createOMElement
+ factory (javax.xml.namespace.QName.
+ (axis-op-namespace op) (axis-op-name op)))
+ op-args (axis-op-args op)]
+ (doseq [[argval argtype] (map list args op-args)]
+ (.addChild request
+ (doto (.createOMElement
+ factory (javax.xml.namespace.QName. (:name argtype)))
+ (.setText (obj->soap-str argval (:type argtype))))))
+ request))
+
+(defn get-result [op retelem]
+ (let [ret-str (.getText (first (iterator-seq (.getChildElements retelem))))]
+ (soap-str->obj ret-str (axis-op-rettype op))))
+
+(defn client-call [client op & args]
+ (if (isa? (class op) org.apache.axis2.description.OutOnlyAxisOperation)
+ (.sendRobust client (.getName op) (apply make-request op args))
+ (get-result
+ op (.sendReceive client (.getName op) (apply make-request op args)))))
+
+(defn client-proxy [url]
+ (let [client (make-client url)]
+ (->> (for [op (axis-service-operations (.getAxisService client))]
+ [(keyword (axis-op-name op))
+ (fn soap-call [& args] (apply client-call client op args))])
+ (into {}))))
+
+(defn client-fn
+ "Make SOAP client function, which is called as: (x :someMethod arg1 arg2 ...)"
+ [url]
+ (let [px (client-proxy url)]
+ (fn [opname & args]
+ (apply (px opname) args))))
+
27 test/clj_soap/test/core.clj
@@ -0,0 +1,27 @@
+(ns clj-soap.test.core
+ (:use [clj-soap.core])
+ (:use [clojure.test]))
+
+(def test-value (ref false))
+
+(defservice jp.myclass.MyApp
+ (changeval [^String string] (dosync (ref-set test-value string)))
+ (hypotenuse ^Double [^Double x ^Double y] (Math/sqrt (+ (* x x) (* y y))))
+ (doubl1 (^String [^String x] (str x x))
+ (^Double [^Double x] (+ x x)))
+ (doubl2 (^Double [^Double x] (+ x x))
+ (^String [^String x] (str x x))))
+
+(deftest test-my-app
+ (serve "jp.myclass.MyApp")
+ (let [cl (client-fn "http://localhost:6060/axis2/services/MyApp?wsdl")]
+ (is (= 5.0 (cl :hypotenuse 3 4)) "SOAP call with return value")
+ (cl :changeval "piyopiyo")
+ (is (= "piyopiyo" @test-value) "SOAP call without return value")
+ ; Axis2 does not support method overloading.
+ ;(is (= 10.0 (cl :doubl1 5.0)))
+ ;(is (= "abcabc" (cl :doubl1 "abc")))
+ ;(is (= 10.0 (cl :doubl2 5.0)))
+ ;(is (= "abcabc" (cl :doubl2 "abc")))
+ ))
+

0 comments on commit c8061a7

Please sign in to comment.
Something went wrong with that request. Please try again.