diff options
Diffstat (limited to 'xml-stream-writer.clj')
| -rw-r--r-- | xml-stream-writer.clj | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/xml-stream-writer.clj b/xml-stream-writer.clj new file mode 100644 index 00000000..7566ac46 --- /dev/null +++ b/xml-stream-writer.clj @@ -0,0 +1,225 @@ +;;; xml-stream-writer.clj -- Clojure interface to XMLStreamWriter + +;; by Stuart Sierra <mail@stuartsierra.com> +;; Version 1; April 21, 2008 + +;; THIS IS AN 'ALPHA' RELEASE AND THE API IS SUBJECT TO CHANGE. + + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file defines a Clojure interface to the StAX XML writer API, +;; defined in javax.xml.stream.XMLOutputStream, included with the JDK +;; since version 6. +;; +;; The main entry point is the 'with-xml-output' macro, which takes +;; one argument, an open java.io.Writer, and a body. This macro opens +;; a new XMLStreamWriter on the given output stream and ensures that +;; all document tags are closed. It does NOT close the underlying +;; Writer. +;; +;; Within the body of 'with-xml-output', certain forms will be +;; translated into XML: +;; +;; "This is a string." => This is a string. +;; [:foo "this & that"] => <foo>this & that</foo> +;; [:foo] => <foo/> +;; +;; Attributes are specified as maps: +;; +;; [:foo {:bar "this & that"}] => <foo bar="this & that"/> +;; +;; Declare XML namespace prefixes inside 'emit-xml' with +;; (xmlns prefix uri), where 'prefix' is a keyword. +;; +;; Once a namespace has been declared, create elements in that +;; namespace by using a 2-element vector [prefix localname] as the tag +;; name: +;; +;; (with-xml-output *out* +;; (xmlns :me "http://xmlns.com/mine") +;; [[:me :foo] "content"]) +;; +;; => <me:foo xmlns:me="http://xmlns.com/mine">content</me:foo> +;; +;; Same with attributes: +;; +;; (with-xml-output *out* +;; (xmlns :me "http://xmlns.com/mine") +;; [:foo {[:me bar] "value"}]) +;; +;; => <foo me:bar="value" xmlns:me="http://xmlns.com/mine"/> +;; +;; Undeclared namespaces will get an auto-generated prefix: +;; +;; (with-xml-output *out* [["http://myns.com/" :foo]]) +;; +;; => <zdef18:foo xmlns:zdef18="http://myns.com/"/> +;; +;; Normal function calls and symbols may be placed in the body of +;; 'with-xml-output'; they will be evaluated normally and their return +;; values will be included as text in the XML output. To avoid adding +;; text to the output, functions should return nil. +;; +;; To emit XML tags from a function without creating a new +;; XMLStreamWriter, use the 'emit-xml' macro: +;; +;; (defn foo [name] (emit-xml [:mytag {:id name}])) +;; +;; (with-xml-output *out* +;; [:root (foo 24) (foo 24)]) +;; +;; => <root><mytag id="24"/><mytag id="24"/></root> +;; +;; To create the default XML declaration (version 1.0 and UTF-8 +;; encoding), use the (xmldecl) macro: +;; +;; (with-xml-output *out* (xmldecl)) +;; +;; => <?xml version="1.0" encoding="UTF-8"?> +;; + + + +(clojure/in-ns 'xml-stream-writer) +(clojure/refer 'clojure) + +(import '(javax.xml.stream XMLOutputFactory)) + +(defn- to-name [x] + (cond + (keyword? x) (name x) + (string? x) x + (symbol? x) (name x) + true (str x))) + +(def + *xml-output-factory* + (let [factory (XMLOutputFactory.newInstance)] + (. factory setProperty + "javax.xml.stream.isRepairingNamespaces" true) + factory)) + +(def *xml-stream-writer*) + +(def *xmlns-prefixes*) + +(def *xml-indent* nil) + +(def *xml-tag-depth*) + +(defn apply-indent [] + (when *xml-indent* + (. *xml-stream-writer* writeCharacters "\n") + (dotimes i (* *xml-indent* *xml-tag-depth*) + (. *xml-stream-writer* writeCharacters " ")))) + +(defn start-tag + ([name] + (apply-indent) + (set! *xml-tag-depth* (inc *xml-tag-depth*)) + (. *xml-stream-writer* + writeStartElement (to-name name))) + ([namespace name] + (apply-indent) + (set! *xml-tag-depth* (inc *xml-tag-depth*)) + (. *xml-stream-writer* + writeStartElement namespace (to-name name)))) + +(defn empty-tag + ([name] + (. *xml-stream-writer* + writeEmptyElement (to-name name))) + ([namespace name] + (. *xml-stream-writer* + writeEmptyElement namespace (to-name name)))) + +(defn xml-attr + ([name value] + (. *xml-stream-writer* writeAttribute (to-name name) value)) + ([namespace name value] + (. *xml-stream-writer* writeAttribute namespace (to-name name) value))) + +(defn xml-text [t] + (when t + (apply-indent) + (. *xml-stream-writer* writeCharacters (str t)))) + +(defn end-tag [] + (set! *xml-tag-depth* (dec *xml-tag-depth*)) + (apply-indent) + (. *xml-stream-writer* writeEndElement)) + +(defn entity [name] + (. *xml-stream-writer* writeEntityRef (to-name name))) + +(def emit-form) + +(defn resolve-xmlns [x] + (if (keyword? x) + (*xmlns-prefixes* x) + x)) + +(defn- emit-tag [form] + (if (or (= 1 (count form)) + (and (= 2 (count form)) + (map? (second form)))) ; is the element empty? + (apply list 'do + (let [tag (first form)] + (if (vector? tag) ; is the element namespaced? + (list 'empty-tag (list 'resolve-xmlns (first tag)) (second tag)) + (list 'empty-tag tag))) + (map emit-form (rest form))) ; still have to handle attributes + (apply list 'do + (let [tag (first form)] ; non-empty element + (if (vector? tag) ; is the element namespaced? + (list 'start-tag (list 'resolve-xmlns (first tag)) (second tag)) + (list 'start-tag tag))) + (concat (map emit-form (rest form)) + (list '(end-tag)))))) + +(defn- emit-xml-attr [name-value] + (let [[name value] name-value] + (if (vector? name) + (list 'xml-attr (first name) (second name) value) + (list 'xml-attr name value)))) + +(defn- emit-xml-attrs [xml-attr-map] + (apply list 'do + (map emit-xml-attr xml-attr-map))) + +(defn- emit-form [form] + (cond + (vector? form) (emit-tag form) + (map? form) (emit-xml-attrs form) + true `(xml-text ~form))) + +(defmacro xmldecl [] + '(. *xml-stream-writer* writeStartDocument "UTF-8" "1.0")) + +(defmacro xmlns [prefix namespace] + `(sync nil + (set! *xmlns-prefixes* (assoc *xmlns-prefixes* ~prefix ~namespace)) + (. *xml-stream-writer* setPrefix ~(to-name prefix) ~namespace))) + +(defmacro emit-xml [& forms] + `(do ~@(map emit-form forms))) + +(defmacro with-xml-output [writer & body] + `(binding [*xml-stream-writer* + (. *xml-output-factory* createXMLStreamWriter ~writer) + *xmlns-prefixes* {} + *xml-tag-depth* 0] + (try + (emit-xml ~@body) + (finally + (. *xml-stream-writer* writeEndDocument) + (. *xml-stream-writer* close) + nil)))) |