├── src ├── test │ ├── resources │ │ ├── secret.txt │ │ ├── public │ │ │ └── cljs-tests │ │ │ │ └── index.html │ │ └── clojure │ │ │ └── data │ │ │ └── xml │ │ │ ├── cljs_testsuite.clj │ │ │ └── cljs_repl_nashorn.clj │ ├── clojure │ │ └── clojure │ │ │ └── data │ │ │ └── xml │ │ │ ├── test_equiv.cljc │ │ │ ├── test_utils.clj │ │ │ ├── test_pprint.clj │ │ │ ├── test_process.cljc │ │ │ ├── test_cljs.clj │ │ │ ├── test_entities.clj │ │ │ ├── test_seq_tree.clj │ │ │ ├── test_names.clj │ │ │ ├── test_sexp.clj │ │ │ ├── test_pu.cljc │ │ │ ├── test_parse.clj │ │ │ └── test_emit.clj │ └── clojurescript │ │ └── clojure │ │ └── data │ │ └── xml │ │ ├── test_cljs_basic.cljs │ │ ├── cljs_repls.clj │ │ ├── test_cljs.cljs │ │ └── test_cljs_extended.cljs └── main │ ├── clojure │ ├── data_readers.cljc │ └── clojure │ │ └── data │ │ ├── xml │ │ ├── js │ │ │ ├── name.cljs │ │ │ └── dom.cljs │ │ ├── jvm │ │ │ ├── pprint.clj │ │ │ ├── name.clj │ │ │ ├── parse.clj │ │ │ └── emit.clj │ │ ├── protocols.cljc │ │ ├── process.clj │ │ ├── impl.clj │ │ ├── prxml.clj │ │ ├── tree.clj │ │ ├── pu_map.cljc │ │ ├── event.clj │ │ ├── name.cljc │ │ └── node.cljc │ │ ├── xml.cljs │ │ └── xml.clj │ ├── clojurescript │ └── xmlns │ │ └── http%3A%2F%2Fwww │ │ └── w3 │ │ ├── org%2F2000%2Fxmlns%2F.cljc │ │ └── org%2FXML%2F1998%2Fnamespace.cljc │ └── resources │ └── clojure │ └── data │ └── xml │ └── spec.cljc ├── webpack.config.js ├── .github └── workflows │ ├── snapshot.yml │ ├── doc-build.yml │ ├── release.yml │ └── test.yml ├── .gitignore ├── dxml-nashorn.global.js ├── package.json ├── CONTRIBUTING.md ├── project.clj ├── CHANGES.md ├── pom.xml ├── LICENSE ├── epl-v10.html └── README.md /src/test/resources/secret.txt: -------------------------------------------------------------------------------- 1 | root_password 2 | -------------------------------------------------------------------------------- /src/main/clojure/data_readers.cljc: -------------------------------------------------------------------------------- 1 | {xml/ns clojure.data.xml.name/uri-symbol 2 | xml/element clojure.data.xml.node/tagged-element} 3 | -------------------------------------------------------------------------------- /src/test/resources/public/cljs-tests/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /webpack.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | entry: "./dxml-nashorn.global.js", 3 | output: { 4 | filename: "dxml-nashorn.generated.js", 5 | path: "./src/test/resources/" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /.github/workflows/snapshot.yml: -------------------------------------------------------------------------------- 1 | name: Snapshot on demand 2 | 3 | on: [workflow_dispatch] 4 | 5 | jobs: 6 | call-snapshot: 7 | uses: clojure/build.ci/.github/workflows/snapshot.yml@master 8 | secrets: inherit 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target/ 2 | modules/xml/target/ 3 | modules/xml.pull-parser/target/ 4 | *~ 5 | /out/ 6 | /node_modules/ 7 | /nashorn_code_cache/ 8 | /figwheel_server.log 9 | /.nrepl-port 10 | /.cljs_nashorn_repl/ 11 | .idea/ 12 | *.iml 13 | -------------------------------------------------------------------------------- /dxml-nashorn.global.js: -------------------------------------------------------------------------------- 1 | global.console = { 2 | log: print, 3 | warn: print, 4 | error: print 5 | }; 6 | global.xmldom = require("xmldom"); 7 | global.DOMParser = global.xmldom.DOMParser; 8 | global.XMLSerializer = global.xmldom.XMLSerializer; 9 | -------------------------------------------------------------------------------- /.github/workflows/doc-build.yml: -------------------------------------------------------------------------------- 1 | 2 | name: Build API Docs 3 | 4 | on: 5 | workflow_dispatch: 6 | 7 | jobs: 8 | call-doc-build-workflow: 9 | uses: clojure/build.ci/.github/workflows/doc-build.yml@master 10 | with: 11 | project: clojure/data.xml 12 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | 3 | "scripts": { 4 | "build": "webpack" 5 | } 6 | 7 | , "devDependencies": { 8 | "webpack": "2.1.0-beta.27", 9 | "xmldom" : "0.1.27" 10 | "domino" : "" 11 | } 12 | , "name": "dxml-nashorn-api" 13 | } 14 | -------------------------------------------------------------------------------- /src/main/clojurescript/xmlns/http%3A%2F%2Fwww/w3/org%2F2000%2Fxmlns%2F.cljc: -------------------------------------------------------------------------------- 1 | (ns xmlns.http%3A%2F%2Fwww.w3.org%2F2000%2Fxmlns%2F 2 | "Require - able uri namespace for the `xmlns` prefix. 3 | This uri is special, in that it is predefined in every xml 4 | vocabulary and has the prefix `xmlns` reserved for it, which cannot 5 | be redefined" 6 | {:fixed-prefix "xmlns"}) 7 | 8 | -------------------------------------------------------------------------------- /src/main/clojurescript/xmlns/http%3A%2F%2Fwww/w3/org%2FXML%2F1998%2Fnamespace.cljc: -------------------------------------------------------------------------------- 1 | (ns xmlns.http%3A%2F%2Fwww.w3.org%2FXML%2F1998%2Fnamespace 2 | "Require - able uri namespace for the `xml` prefix. 3 | This uri is special, in that it is predefined in every xml 4 | vocabulary and has the prefix `xml` reserved for it, which cannot 5 | be redefined" 6 | {:fixed-prefix "xml"}) 7 | 8 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This is a [Clojure contrib] project. 2 | 3 | Under the Clojure contrib [guidelines], this project cannot accept 4 | pull requests. All patches must be submitted via [JIRA]. 5 | 6 | See [Contributing] on the Clojure website for 7 | more information on how to contribute. 8 | 9 | [Clojure contrib]: https://clojure.org/community/contrib_libs 10 | [Contributing]: https://clojure.org/community/contributing 11 | [JIRA]: https://jira.atlassian.net/browse/DXML 12 | [guidelines]: https://clojure.org/community/contrib_howto 13 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release on demand 2 | 3 | on: 4 | workflow_dispatch: 5 | inputs: 6 | releaseVersion: 7 | description: "Version to release" 8 | required: true 9 | snapshotVersion: 10 | description: "Snapshot version after release" 11 | required: true 12 | 13 | jobs: 14 | call-release: 15 | uses: clojure/build.ci/.github/workflows/release.yml@master 16 | with: 17 | releaseVersion: ${{ github.event.inputs.releaseVersion }} 18 | snapshotVersion: ${{ github.event.inputs.snapshotVersion }} 19 | secrets: inherit -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_equiv.cljc: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-equiv 2 | (:require [clojure.data.xml :refer [element qname]] 3 | [clojure.test :refer [deftest is are testing]])) 4 | 5 | (deftest test-node-equivalence 6 | (are [repr1 repr2] (and (is (= repr1 repr2)) 7 | (is (= (hash repr1) (hash repr2)))) 8 | (element :foo) {:tag :foo :attrs {} :content []} 9 | (element (qname "DAV:" "foo")) {:tag (qname "DAV:" "foo") :attrs {} :content []} 10 | (element :foo {:a "b"}) {:tag :foo :attrs {:a "b"} :content []} 11 | (element :foo {:a "b"} "a" "b") {:tag :foo :attrs {:a "b"} :content ["a" "b"]})) 12 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test 2 | 3 | on: [push] 4 | 5 | jobs: 6 | test: 7 | strategy: 8 | matrix: 9 | os: [ubuntu-latest] # macOS-latest, windows-latest] 10 | java-version: ["8"] 11 | clojure-version: ["1.9.0", "1.10.3", "1.11.4", "1.12.3"] 12 | runs-on: ${{ matrix.os }} 13 | steps: 14 | - uses: actions/checkout@v3 15 | - name: Set up Java 16 | uses: actions/setup-java@v3 17 | with: 18 | java-version: ${{ matrix.java-version }} 19 | distribution: 'temurin' 20 | cache: 'maven' 21 | - name: Build with Maven 22 | run: mvn -ntp -B -Dclojure.version=${{ matrix.clojure-version }} clean test 23 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojure/data.xml "0-UE-DEVELOPMENT" 2 | :source-paths ["src/main/clojure" "src/main/clojurescript"] 3 | :test-paths ["src/test/clojure" "src/test/clojurescript"] 4 | :resource-paths ["src/main/resources" "src/test/resources" "target/gen-resources"] 5 | :dependencies [[org.clojure/clojure "1.10.3"] 6 | [org.clojure/clojurescript "1.10.439"] 7 | [cider/piggieback "0.5.3"] 8 | [org.clojure/tools.nrepl "0.2.13"] 9 | [org.clojure/test.check "1.1.1"] 10 | [figwheel-sidecar "0.5.17"] 11 | [binaryage/devtools "0.9.10"] 12 | [org.openjdk.nashorn/nashorn-core "15.3"]] 13 | :repl-options {:nrepl-middleware [cider.piggieback/wrap-cljs-repl]}) 14 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_utils.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for emit to print XML text." 10 | :author "Chris Houser"} 11 | clojure.data.xml.test-utils 12 | (:require [clojure.data.xml :as xml :refer [parse]])) 13 | 14 | (defn test-stream [x] 15 | (java.io.ByteArrayInputStream. (.getBytes x "UTF-8"))) 16 | 17 | (def lazy-parse* (comp parse test-stream)) 18 | 19 | 20 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_pprint.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for emit to print XML text." 10 | :author "Herwig Hochleitner"} 11 | clojure.data.xml.test-pprint 12 | (:require 13 | [clojure.string :as str] 14 | [clojure.test :refer :all] 15 | [clojure.data.xml :refer :all])) 16 | 17 | (def xml 18 | "") 19 | 20 | (def indented-xml 21 | (str 22 | "" 23 | "\n" 24 | " 25 | 26 | 27 | ")) 28 | 29 | (deftest test-indent 30 | (is (= (str/replace indented-xml #"\n" (System/lineSeparator)) 31 | (indent-str (parse-str xml))))) 32 | 33 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/js/name.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.js.name 10 | (:require [clojure.data.xml.protocols :refer [AsQName qname-uri qname-local]] 11 | [clojure.string :as str])) 12 | 13 | (def parse-qname 14 | (memoize (partial re-matches #"(?:\{([^}]+)\})?([^{]*)"))) 15 | 16 | (defn decode-uri [ns] 17 | (js/decodeURIComponent ns)) 18 | 19 | (defn encode-uri [uri] 20 | (js/encodeURIComponent uri)) 21 | 22 | (extend-protocol AsQName 23 | string 24 | (qname-local [s] 25 | (let [[_ _ local] (parse-qname s)] 26 | local)) 27 | (qname-uri [s] 28 | (let [[_ uri _] (parse-qname s)] 29 | uri))) 30 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_process.cljc: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-process 2 | (:require [clojure.data.xml :refer [element qname element? 3 | #?@(:clj [element-nss aggregate-xmlns 4 | find-xmlns])]] 5 | [clojure.test :refer [deftest is]] 6 | [clojure.walk :as w] 7 | [clojure.string :as str] 8 | [clojure.data.xml.pu-map :as pu])) 9 | 10 | (def test-data 11 | (element 12 | :foo nil 13 | (with-meta (element :bar {:xmlns "MOO:"} "some" "content") 14 | {:clojure.data.xml/nss (pu/merge-prefix-map nil {"p" "PAR:"})}) 15 | "more content" 16 | (element (qname "GOO:" "ho") {(qname "GEE:" "hi") "ma"} "ii") 17 | "end")) 18 | 19 | #? 20 | (:clj 21 | (deftest process 22 | (is (= (find-xmlns test-data) #{"" "GEE:" "GOO:"})) 23 | (let [nss (set (vals (:p->u (element-nss (aggregate-xmlns test-data)))))] 24 | (is (every? #(contains? nss %) ["GEE:" "GOO:"]))))) 25 | 26 | (deftest walk-test 27 | (is (= {:tag :FOO, :attrs {}, :content ()} 28 | (w/postwalk (fn [e] 29 | (if (element? e) 30 | (update e :tag (comp keyword str/upper-case name)) 31 | e)) 32 | (element :foo))))) 33 | -------------------------------------------------------------------------------- /src/test/clojurescript/clojure/data/xml/test_cljs_basic.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-cljs-basic 2 | (:require 3 | [cljs.test :as test :refer [deftest is are]] 4 | [clojure.data.xml :as xml :refer [parse-str emit-str element element-data element-node]] 5 | [clojure.data.xml.node :as node] 6 | [clojure.data.xml.js.dom :as dom])) 7 | 8 | (comment 9 | 10 | (= (xml/element :foo) 11 | (xml/parse-str "")) 12 | 13 | (xml/element-data (xml/element-node (xml/element :foo))) 14 | 15 | ) 16 | 17 | (deftest roundtrips 18 | (are [dxml xml] (do (is (= dxml (xml/parse-str xml))) 19 | (is (= dxml (xml/parse-str (xml/emit-str dxml))))) 20 | (xml/element :foo) "" 21 | (xml/element :xmlns.DAV%3A/foo) "" 22 | (xml/element :foo {} (xml/cdata "" 23 | (xml/element :foo {} (xml/xml-comment " bar> ")) "")) 24 | 25 | (deftest printing 26 | (are [node ps] (is (= ps (pr-str node))) 27 | (xml/element :foo) "#xml/element{:tag :foo}" 28 | (xml/element :foo {:a "2"}) "#xml/element{:tag :foo, :attrs {:a \"2\"}}" 29 | (xml/element :foo {} (xml/element :bar)) "#xml/element{:tag :foo, :content [#xml/element{:tag :bar}]}" 30 | (xml/element :foo {} "bar") "#xml/element{:tag :foo, :content [\"bar\"]}")) 31 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/jvm/pprint.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.jvm.pprint 10 | (:import 11 | (javax.xml.transform Transformer OutputKeys TransformerFactory) 12 | (java.io Writer StringReader StringWriter) 13 | (javax.xml.transform.stream StreamSource StreamResult))) 14 | 15 | (defn ^Transformer indenting-transformer [] 16 | (doto (-> (TransformerFactory/newInstance) .newTransformer) 17 | (.setOutputProperty OutputKeys/INDENT "yes") 18 | (.setOutputProperty OutputKeys/METHOD "xml") 19 | (.setOutputProperty "{http://xml.apache.org/xslt}indent-amount" "2") 20 | ;; print newline after preamble 21 | (.setOutputProperty OutputKeys/DOCTYPE_PUBLIC "yes"))) 22 | 23 | (defn indent-xml 24 | [xml-str ^Writer writer] 25 | (let [source (-> xml-str StringReader. StreamSource.) 26 | result (StreamResult. writer)] 27 | (.transform (indenting-transformer) source result))) 28 | 29 | 30 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/protocols.cljc: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.protocols) 10 | 11 | ;; XML names can be any data type that has at least a namespace uri and a name slot 12 | 13 | (defprotocol AsQName 14 | (qname-local [qname] "Get the name for this qname") 15 | (qname-uri [qname] "Get the namespace uri for this qname")) 16 | 17 | (defprotocol EventGeneration 18 | "Protocol for generating new events based on element type" 19 | (gen-event [item] 20 | "Function to generate an event for e.") 21 | (next-events [item next-items] 22 | "Returns the next set of events that should occur after e. next-events are the 23 | events that should be generated after this one is complete.")) 24 | 25 | (defprotocol AsElements 26 | (as-elements [expr] "Return a seq of elements represented by an expression.")) 27 | 28 | (defprotocol AsXmlString 29 | (xml-str [node] "Serialize atribute value or content node")) 30 | -------------------------------------------------------------------------------- /src/test/clojurescript/clojure/data/xml/cljs_repls.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.cljs-repls 2 | (:require 3 | [cljs.repl :as repl] 4 | [clojure.data.xml.cljs-repl-nashorn :as repl-nh] 5 | [cider.piggieback :as pback] 6 | [cljs.closure :as closure] 7 | [figwheel-sidecar.repl-api :refer [start-figwheel! stop-figwheel! cljs-repl]])) 8 | 9 | (defn nashorn-env [] 10 | (let [{:as env :keys [engine]} (repl-nh/repl-env)] 11 | (repl-nh/eval-resource engine "dxml-nashorn.generated.js" true) 12 | env)) 13 | 14 | (def handle-redirect (constantly {:status 307 :headers {"Location" "/cljs-tests/index.html"}})) 15 | 16 | (defn repl-figwheel! [] 17 | (start-figwheel! 18 | {:figwheel-options 19 | {:http-server-root "public" 20 | :ring-handler `handle-redirect} 21 | :all-builds 22 | [{:id "tests" 23 | :source-paths ["src/main/clojure" "src/test/clojure" "src/test/clojurescript"] 24 | :figwheel {:on-jsload "clojure.data.xml.test-cljs/-main"} 25 | :compiler {:main 'clojure.data.xml.test-cljs 26 | :preloads '[devtools.preload] 27 | :output-to "target/gen-resources/public/cljs-tests/main.js" 28 | :output-dir "target/gen-resources/public/cljs-tests/output" 29 | :asset-path "output" 30 | :source-map true}}]}) 31 | (cljs-repl)) 32 | 33 | (defn repl-piggieback! [] 34 | (pback/cljs-repl (nashorn-env))) 35 | 36 | (defn repl-main! [] 37 | (repl/repl (nashorn-env))) 38 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/jvm/name.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.jvm.name 10 | (:require (clojure.data.xml 11 | [protocols :refer [AsQName qname-uri qname-local]]) 12 | [clojure.string :as str]) 13 | (:import java.io.Writer 14 | (javax.xml.namespace NamespaceContext QName) 15 | (java.net URLEncoder URLDecoder))) 16 | 17 | (set! *warn-on-reflection* true) 18 | 19 | (extend-protocol AsQName 20 | QName 21 | (qname-local [qname] (.getLocalPart qname)) 22 | (qname-uri [qname] (.getNamespaceURI qname))) 23 | 24 | (def ^QName parse-qname 25 | (memoize 26 | (fn [s] 27 | ;; TODO weakly memoize this? 28 | (QName/valueOf s)))) 29 | 30 | (extend-protocol AsQName 31 | String 32 | (qname-local [s] 33 | (.getLocalPart (parse-qname s))) 34 | (qname-uri [s] 35 | (.getNamespaceURI (parse-qname s)))) 36 | 37 | (definline decode-uri [^String ns] 38 | `(URLDecoder/decode ~ns "UTF-8")) 39 | 40 | (definline encode-uri [^String uri] 41 | `(URLEncoder/encode ~uri "UTF-8")) 42 | -------------------------------------------------------------------------------- /src/test/clojurescript/clojure/data/xml/test_cljs.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-cljs 2 | (:require [cljs.test :as test] 3 | [clojure.data.xml :as xml] 4 | clojure.data.xml.test-cljs-basic 5 | clojure.data.xml.test-cljs-extended 6 | clojure.data.xml.test-equiv 7 | clojure.data.xml.test-pu 8 | clojure.data.xml.test-process)) 9 | 10 | (def ^:dynamic *results*) 11 | 12 | (defmethod test/report [::test/default :end-run-tests] 13 | [m] 14 | (assert (nil? *results*)) 15 | (set! *results* m)) 16 | 17 | (defn ^:export -main-nashorn [] 18 | (set! *print-newline* false) 19 | (set! *print-fn* js/print) 20 | (set! *print-err-fn* js/print) 21 | (binding [*results* nil] 22 | (println "Running Basic Tests") 23 | (test/run-tests 'clojure.data.xml.test-cljs-basic 24 | 'clojure.data.xml.test-equiv 25 | 'clojure.data.xml.test-pu 26 | 'clojure.data.xml.test-process) 27 | (pr-str *results*))) 28 | 29 | (defn ^:export -main [] 30 | (binding [*results* nil] 31 | (println "Running Basic Tests") 32 | (test/run-tests 'clojure.data.xml.test-cljs-basic 33 | 'clojure.data.xml.test-pu) 34 | (println "Extending DOM Objects and running again + extended tests") 35 | (xml/extend-dom-as-data!) 36 | (test/testing "with extended native dom" 37 | (test/run-tests 'clojure.data.xml.test-cljs-basic 38 | 'clojure.data.xml.test-cljs-extended 39 | 'clojure.data.xml.test-equiv)) 40 | *results*)) 41 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_cljs.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Clojurescript tests for data.xml"} 10 | clojure.data.xml.test-cljs 11 | (:require 12 | [clojure.test :refer :all])) 13 | 14 | (deftest clojurescript-test-suite 15 | (try 16 | (require 'clojure.data.xml.cljs-testsuite) 17 | (eval '(clojure.data.xml.cljs-testsuite/run-testsuite! "target/cljs-test-nashorn")) 18 | (catch Exception e 19 | (if (or (neg? (compare ((juxt :major :minor) *clojure-version*) 20 | [1 8])) 21 | (neg? (compare (System/getProperty "java.runtime.version") 22 | "1.8"))) 23 | (println "WARN: ignoring cljs testsuite error on clojure < 1.8 or jdk < 1.8" 24 | *clojure-version* (System/getProperty "java.runtime.name") 25 | (System/getProperty "java.vm.version") (System/getProperty "java.runtime.version") 26 | \newline (str e)) 27 | (do (println "ERROR: cljs nashorn test suite should be able to run on clojure >= 1.8 and jdk >= 1.8" 28 | *clojure-version* (System/getProperty "java.runtime.name") 29 | (System/getProperty "java.vm.version") (System/getProperty "java.runtime.version")) 30 | (throw e)))))) 31 | -------------------------------------------------------------------------------- /src/test/resources/clojure/data/xml/cljs_testsuite.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.cljs-testsuite 2 | (:require 3 | [clojure.test :refer :all] 4 | [cljs.repl :as repl] 5 | [clojure.data.xml.cljs-repl-nashorn :as repl-nh] 6 | [cljs.closure :as closure] 7 | [cljs.build.api :as bapi] 8 | [clojure.string :as str] 9 | [clojure.java.io :as io]) 10 | (:import 11 | java.nio.file.Files 12 | java.nio.file.attribute.FileAttribute)) 13 | 14 | (defn tempdir [] 15 | (str (Files/createTempDirectory 16 | "cljs-nashorn-" (into-array FileAttribute [])))) 17 | 18 | (defn compile-testsuite! [dir] 19 | (let [out (io/file dir "tests.js") 20 | inputs ["src/main/clojure" "src/test/clojure" "src/test/clojurescript"]] 21 | (println "INFO" "Compiling cljs testsuite from" inputs "into" (str out)) 22 | (bapi/build (apply bapi/inputs inputs) 23 | {:output-to (str out) 24 | :output-dir dir 25 | :main 'clojure.data.xml.test-cljs 26 | :optimizations :advanced 27 | :pseudo-names true 28 | :pretty-print true 29 | :preamble ["dxml-nashorn.generated.js"]}))) 30 | 31 | (defn run-testsuite! [dir] 32 | (System/setProperty "nashorn.persistent.code.cache" "target/nashorn_code_cache") 33 | (let [engine (repl-nh/create-engine)] 34 | (compile-testsuite! dir) 35 | (println "INFO" "Running cljs tests in nashorn with persistent code cache in" (System/getProperty "nashorn.persistent.code.cache")) 36 | (.eval engine (io/reader (io/file dir "tests.js"))) 37 | (let [{:as res :keys [fail error]} (read-string (.eval engine "clojure.data.xml.test_cljs._main_nashorn()"))] 38 | (is (and (zero? fail) (zero? error)) 39 | (pr-str res))))) 40 | 41 | (comment 42 | 43 | (def td (tempdir)) 44 | (def engine (:engine (repl-nh/repl-env))) 45 | (run-testsuite! td) 46 | (.eval engine (io/reader (io/file td "tests.reopt.js"))) 47 | (.eval engine "clojure.data.xml.test_cljs._main()") 48 | 49 | ) 50 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_entities.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Test that external entities are not resolved by default, see https://www.owasp.org/index.php/XML_External_Entity_(XXE)_Processing" 10 | :author "Carlo Sciolla"} 11 | clojure.data.xml.test-entities 12 | (:require [clojure.java.io :as io] 13 | [clojure.test :refer :all] 14 | [clojure.data.xml :refer :all])) 15 | 16 | (defn vulnerable-input 17 | "Creates an XML with an external entity referring to the given URL" 18 | [file-url] 19 | (str "" 20 | "" 22 | " ]>" 23 | "&xxe;")) 24 | 25 | (defn secret-file 26 | "Returns the URL to the secret file containing the server root password" 27 | [] 28 | (io/resource "secret.txt")) 29 | 30 | (defn parse-vulnerable-file 31 | "Parses the vulnerable file, optionally passing the given options to the parser" 32 | ([] (parse-str (vulnerable-input (secret-file)))) 33 | ([& options] (apply parse-str (vulnerable-input (secret-file)) options))) 34 | 35 | (deftest prevent-xxe-by-default 36 | (testing "To prevent XXE attacks, exernal entities by default resolve to nil" 37 | (let [parsed (parse-vulnerable-file) 38 | expected {:tag :foo 39 | :attrs {} 40 | :content ()}] 41 | (is (= expected parsed))))) 42 | 43 | (deftest allow-external-entities-if-required 44 | (testing "If explicitly enabled, external entities are property resolved" 45 | (let [parsed (parse-vulnerable-file :supporting-external-entities true) 46 | expected {:tag :foo 47 | :attrs {} 48 | :content ["root_password\n"]}] 49 | (is (= expected parsed))))) 50 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/process.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.process 10 | (:require [clojure.data.xml.event :refer [element-nss] :as evt] 11 | [clojure.data.xml.name :as name :refer [gen-prefix *gen-prefix-counter* qname-uri]] 12 | [clojure.data.xml.node :refer [element] :as node] 13 | [clojure.data.xml.tree :refer [flatten-elements] :as tree] 14 | [clojure.string :as str] 15 | [clojure.data.xml.pu-map :as pu])) 16 | 17 | (defn- reduce-tree 18 | "Optimized reducer for in-order traversal of nodes, with reduce-like accumulator" 19 | [f init xml] 20 | (loop [result init 21 | {:as tree [child & next-children :as children] :content} xml 22 | [parent & next-parents :as parents] ()] 23 | (if (seq children) 24 | (recur (f result tree) 25 | child 26 | (concat next-children parents)) 27 | (if (seq parents) 28 | (recur (f result tree) 29 | parent 30 | next-parents) 31 | (f result tree))))) 32 | 33 | (defn- qname-uri-xf [xf] 34 | (fn [s el] 35 | (if (map? el) 36 | (reduce-kv 37 | (fn [s attr _] (xf s (qname-uri attr))) 38 | (xf s (qname-uri (:tag el))) 39 | (:attrs el)) 40 | s))) 41 | 42 | (defn find-xmlns 43 | "Find all xmlns occuring in a root" 44 | [xml] 45 | (persistent! 46 | (reduce-tree (qname-uri-xf conj!) 47 | (transient #{}) xml))) 48 | 49 | (defn aggregate-xmlns 50 | "Put all occurring xmlns into the root" 51 | [xml] 52 | (with-meta 53 | xml {:clojure.data.xml/nss 54 | (binding [*gen-prefix-counter* 0] 55 | (-> (fn [tm uri] 56 | (pu/assoc! tm (gen-prefix) uri)) 57 | qname-uri-xf 58 | (reduce-tree (pu/transient pu/EMPTY) xml) 59 | pu/persistent!))})) 60 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml 10 | (:require-macros 11 | [clojure.data.xml.impl :refer [export-api]]) 12 | (:require 13 | [clojure.data.xml.name :as name] 14 | [clojure.data.xml.node :as node] 15 | [clojure.data.xml.js.dom :as dom] 16 | [clojure.data.xml.protocols :refer [AsQName]])) 17 | 18 | (export-api 19 | name/parse-qname name/qname-uri name/qname-local name/qname name/as-qname name/uri-symbol name/symbol-uri 20 | node/element* node/element node/cdata node/xml-comment node/element? 21 | dom/extend-dom-as-data! dom/element-node dom/element-data) 22 | 23 | ;;;; ## TODO event-seq 24 | ;; This probably won't happen due to js' non-blocking semantics 25 | ;; Instead, for clojurescript, the machinery around event-seq could be implemented 26 | ;; as a transducer stack, such that a push-based source for parser events, like sax-js, 27 | ;; could be used. 28 | 29 | ;; TODO parse (use goog StringBuffer?) 30 | 31 | (defn parse-str 32 | "Use DOMParser to parse xml string" 33 | ;; TODO detect browser specific parsererror tags 34 | ;; see http://stackoverflow.com/questions/11563554/how-do-i-detect-xml-parsing-errors-when-using-javascripts-domparser-in-a-cross 35 | [s & {:keys [content-type on-error raw] 36 | :or {content-type "text/xml" 37 | on-error #(throw (ex-info "XML parser error" {:doc % :input s}))}}] 38 | (let [dom (. (js/DOMParser.) 39 | (parseFromString s content-type)) 40 | doc (.-documentElement dom)] 41 | (cond (= "parsererror" (.-nodeName doc)) 42 | (on-error doc) 43 | raw doc 44 | :else (element-data doc)))) 45 | 46 | ;; TODO emit (use goog StringBuffer?) 47 | 48 | (defn emit-str 49 | "Use XMLSerializer to render an xml string" 50 | [e & {:keys []}] 51 | (. (js/XMLSerializer.) 52 | (serializeToString 53 | (element-node e)))) 54 | 55 | -------------------------------------------------------------------------------- /src/test/clojurescript/clojure/data/xml/test_cljs_extended.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-cljs-extended 2 | (:require 3 | [cljs.test :as test :refer [deftest is are]] 4 | [clojure.data.xml :as xml :refer [parse-str emit-str element element-data element-node]] 5 | [clojure.data.xml.node :as node] 6 | [clojure.data.xml.js.dom :as dom])) 7 | 8 | (comment 9 | 10 | (= (xml/element :foo) 11 | (xml/element-node (xml/element :foo))) 12 | (= (xml/element-node (xml/element :foo)) 13 | (xml/element :foo)) 14 | 15 | (= (xml/element-node (xml/element :foo)) 16 | {:tag :foo :attrs {} :content []}) 17 | 18 | (= {:tag :foo :attrs {} :content []} 19 | (xml/element-node (xml/element :foo))) 20 | 21 | (= {:lala "1" :oo "a"} (:attrs (xml/element-node (xml/element :foo {:lala "1" :oo "a"})))) 22 | (= {} (:attrs (xml/element-node (xml/element :foo)))) 23 | 24 | (= ["a"] (:content (xml/element-node (xml/element :foo {} "a")))) 25 | 26 | (= (xml/element :foo {} "a") 27 | (xml/element-node (xml/element :foo {} "a"))) 28 | 29 | (= (xml/element :foo {} "a") 30 | {:tag :foo :attrs {} :content ["a"]}) 31 | 32 | (= (xml/element :foo {} "a") 33 | (xml/element :foo {} "a")) 34 | 35 | (= () []) 36 | 37 | ( (:content (xml/element-node (xml/element :foo)))) 38 | 39 | (= ["a"] (dom/node-list ["a"])) 40 | (= [] (dom/node-list [])) 41 | 42 | PersistentArrayMap 43 | PersistentVector 44 | 45 | (xml/emit-str (xml/element "{DAV:}name" {})) 46 | (xml/parse-str "") 47 | (meta (xml/parse-str "")) 48 | 49 | (= (element-node (xml/element :xmlns.DAV%3A/foo)) 50 | (xml/parse-str "" :raw true) 51 | ) 52 | 53 | (.log js/console (element-node (xml/element :xmlns.DAV%3A/foo))) 54 | (xml/emit-str (element-node (xml/element :xmlns.DAV%3A/foo))) 55 | (xml/emit-str (xml/parse-str "" :raw true)) 56 | 57 | ) 58 | 59 | (deftest extended-equalities 60 | (are [dxml xml] (do (is (= dxml (xml/parse-str xml :raw true))) 61 | (is (= (element-node dxml) (xml/parse-str (xml/emit-str dxml)))) 62 | (is (= (element-node dxml) (xml/parse-str xml :raw true))) 63 | (is (= (element-node dxml) (xml/parse-str (xml/emit-str dxml) :raw true)))) 64 | (xml/element :foo) "" 65 | (xml/element :xmlns.DAV%3A/foo) "")) 66 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_seq_tree.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for seq-tree, building a lazy tree from lazy seq." 10 | :author "Chris Houser"} 11 | clojure.data.xml.test-seq-tree 12 | (:require [clojure.test :refer :all] 13 | [clojure.data.xml.tree :refer [seq-tree]]) 14 | (:import (java.lang.ref WeakReference))) 15 | 16 | (def tt 17 | (partial #'seq-tree #(when (= %1 :<) (vector %2)) #{:>} str)) 18 | 19 | (deftest example 20 | (is (= '(("1" "2" [("3" [("4")])] "5") 6) 21 | (tt [1 2 :< 3 :< 4 :> :> 5 :> 6])))) 22 | 23 | (defn limit [& args] 24 | (tt (concat args (lazy-seq (throw (Exception. "not lazy enough")))))) 25 | 26 | (deftest lazy-top-level 27 | (is (= '() (take 0 (first (limit 1))))) ; should do better! 28 | (is (= '("1") (take 1 (first (limit 1))))) 29 | (is (= '("1" "2") (take 2 (first (limit 1 2))))) 30 | (is (= '("1" "2" "3") (take 3 (first (limit 1 2 3)))))) 31 | 32 | (deftest lazy-top-level2 33 | (is (= "1" (reduce nth (limit 1) [0 0]))) 34 | (is (= "2" (reduce nth (limit 1 2) [0 1]))) 35 | (is (= "3" (reduce nth (limit 1 2 3) [0 2])))) 36 | 37 | (deftest lazy-child 38 | (is (coll? (reduce nth (limit 1 :<) [0 1 0]))) 39 | (is (= "2" (reduce nth (limit 1 :< 2) [0 1 0 0]))) 40 | (is (= "2" (reduce nth (limit 1 :< 2 :>) [0 1 0 0]))) 41 | (is (= "3" (reduce nth (limit 1 :< 2 :> 3) [0 2])))) 42 | 43 | (deftest lazy-end-of-tree 44 | (is (= 3 (count (first (limit 1 :< 2 :> 3 :>))))) 45 | (is (= 3 (count (first (limit 1 :< 2 :> 3 :> 4)))))) 46 | 47 | (deftest release-head-top 48 | (let [input (range 10) 49 | input-ref (WeakReference. input) 50 | output (doall (drop 5 (first (tt input))))] 51 | (System/gc) 52 | (is (= nil (.get input-ref))) 53 | output)) 54 | 55 | (deftest release-head-nested-late 56 | (let [input (list 1 2 :< 3 4 5 :>) 57 | input-ref (WeakReference. input) 58 | output (doall (drop 2 (first (tt input))))] 59 | (System/gc) 60 | (is (= nil (.get input-ref))) 61 | output)) 62 | 63 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/impl.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.impl 10 | "Shared private code for data.xml namespaces" 11 | {:author "Herwig Hochleitner"} 12 | (:import 13 | [java.util Base64] 14 | [java.nio.charset StandardCharsets])) 15 | 16 | (defn- var-form? [form] 17 | (and (seq? form) (= 'var (first form)))) 18 | 19 | (defn- export-form [var-name] 20 | (let [is-var (var-form? var-name) 21 | vsym (symbol (name (if is-var (second var-name) var-name)))] 22 | `[(def ~vsym ~var-name) 23 | (alter-meta! (var ~vsym) 24 | (constantly (assoc (meta ~(if is-var 25 | var-name 26 | `(var ~var-name))) 27 | :wrapped-by (var ~vsym))))])) 28 | 29 | (defmacro export-api 30 | "This creates vars, that take their (local) name, value and metadata from another var" 31 | [& names] 32 | (cons 'do (mapcat export-form names))) 33 | 34 | (defmacro static-case 35 | "Variant of case where keys are evaluated at compile-time" 36 | [val & cases] 37 | `(case ~val 38 | ~@(mapcat (fn [[field thunk]] 39 | [(eval field) thunk]) 40 | (partition 2 cases)) 41 | ~@(when (odd? (count cases)) 42 | [(last cases)]))) 43 | 44 | (defmacro extend-protocol-fns 45 | "Helper to many types to a protocol with a method map, similar to extend" 46 | [proto & types+mmaps] 47 | (assert (zero? (mod (count types+mmaps) 2))) 48 | (let [gen-extend (fn [type mmap] (list `extend type proto mmap))] 49 | `(do ~@(for [[type mmap] (partition 2 types+mmaps)] 50 | (if (coll? type) 51 | (let [mm (gensym "mm-")] 52 | `(let [~mm ~mmap] 53 | ~@(map gen-extend type (repeat mm)))) 54 | (gen-extend type mmap)))))) 55 | 56 | (defmacro compile-if 57 | "Evaluate `exp` and if it returns logical true and doesn't error, expand to 58 | `then`. Else expand to `else`. 59 | 60 | see clojure.core.reducers" 61 | [exp then else] 62 | (if (try (eval exp) 63 | (catch Throwable _ false)) 64 | `(do ~then) 65 | `(do ~else))) 66 | 67 | (defn b64-encode [^bytes ba] 68 | (let [encoder (Base64/getEncoder)] 69 | (String. (.encode encoder ba) StandardCharsets/ISO_8859_1))) -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_names.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.test-names 2 | (:require [clojure.data.xml :refer :all] 3 | [clojure.test :refer :all])) 4 | 5 | (alias-uri 6 | :U "uri-u:" 7 | :D "DAV:" 8 | 'V "uri-v:" 9 | "W" "uri-w:") 10 | 11 | (deftest test-types 12 | (are [vals values] (every? true? (for [v values] 13 | (is (= vals [(qname-uri v) (qname-local v)]) 14 | (str "Interpreted QName: " (pr-str v))))) 15 | ["" "name"] ["name" :name (parse-qname "name")] 16 | ["uri-u:" "name"] [::U/name "{uri-u:}name" (parse-qname "{uri-u:}name") (as-qname "{uri-u:}name")] 17 | ["uri-v:" "vname"] [::V/vname "{uri-v:}vname" (parse-qname "{uri-v:}vname")] 18 | ["uri-w:" "wname"] [::W/wname "{uri-w:}wname" (parse-qname "{uri-w:}wname")] 19 | ["http://www.w3.org/XML/1998/namespace" "name"] [:xml/name] 20 | ["http://www.w3.org/2000/xmlns/" "name"] [:xmlns/name])) 21 | 22 | 23 | (deftest test-emit-raw 24 | (are [node result] (= (emit-str node) result) 25 | {:tag ::D/limit :attrs {:xmlns/D "DAV:"} 26 | :content [{:tag ::D/nresults :content ["100"]}]} 27 | "100")) 28 | 29 | (deftest test-parse-raw 30 | (testing "includes namespace in tags when namespace-aware is true" 31 | (is (= (element ::D/limit {} 32 | (element ::D/nresults nil "100")) 33 | (parse-str "100")))) 34 | (testing "leaves namespace off tags when namespace-aware is false" 35 | (is (= (element :limit {:xmlns.http%3A%2F%2Fwww.w3.org%2F2000%2Fxmlns%2F/D "DAV:"} 36 | (element :nresults nil "100")) 37 | (parse-str "100" 38 | :namespace-aware false))))) 39 | 40 | (deftest qnames 41 | (is (= (qname "foo") (as-qname :foo)))) 42 | 43 | (deftest test-gen-prefix 44 | (are [node] (= (parse-str (emit-str node)) node) 45 | (element ::D/limit {::V/moo "gee"} 46 | (element ::D/nresults nil "100")))) 47 | 48 | (deftest test-reassign-prefix 49 | (are [node reparsed] (= (parse-str (emit-str node)) reparsed) 50 | (element ::D/limit {:xmlns/D "DAV:"} 51 | ;; because of outer binding, "uri-v:" will be bound to 52 | ;; generated xmlns:a instead of xmlns:D 53 | (element ::V/other {:xmlns/D "uri-v:"})) 54 | (element ::D/limit {} (element ::V/other)))) 55 | 56 | (deftest test-preserve-empty-ns 57 | (are [el] (= el (parse-str (emit-str (assoc-in el [:attrs :xmlns] "DAV:")))) 58 | (element :top-level) 59 | (element ::D/local-root {} 60 | (element :top-level)))) 61 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/prxml.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.prxml 10 | (:require 11 | [clojure.data.xml.protocols :refer [AsElements as-elements]] 12 | [clojure.data.xml.node :refer [cdata xml-comment element* element]])) 13 | 14 | (defn sexp-element [tag attrs child] 15 | (cond 16 | (= :-cdata tag) (cdata (first child)) 17 | (= :-comment tag) (xml-comment (first child)) 18 | :else (element* tag attrs (mapcat as-elements child)))) 19 | 20 | (extend-protocol AsElements 21 | clojure.lang.IPersistentVector 22 | (as-elements [v] 23 | (let [[tag & [attrs & after-attrs :as content]] v 24 | [attrs content] (if (map? attrs) 25 | [(into {} (for [[k v] attrs] 26 | [k (str v)])) 27 | after-attrs] 28 | [{} content])] 29 | [(sexp-element tag attrs content)])) 30 | 31 | clojure.lang.ISeq 32 | (as-elements [s] 33 | (mapcat as-elements s)) 34 | 35 | clojure.lang.Keyword 36 | (as-elements [k] 37 | [(element k)]) 38 | 39 | java.lang.String 40 | (as-elements [s] 41 | [s]) 42 | 43 | nil 44 | (as-elements [_] nil) 45 | 46 | java.lang.Object 47 | (as-elements [o] 48 | [(str o)])) 49 | 50 | (defn sexps-as-fragment 51 | "Convert a compact prxml/hiccup-style data structure into the more formal 52 | tag/attrs/content format. A seq of elements will be returned, which may 53 | not be suitable for immediate use as there is no root element. See also 54 | sexp-as-element. 55 | 56 | The format is [:tag-name attr-map? content*]. Each vector opens a new tag; 57 | seqs do not open new tags, and are just used for inserting groups of elements 58 | into the parent tag. A bare keyword not in a vector creates an empty element. 59 | 60 | To provide XML conversion for your own data types, extend the AsElements 61 | protocol to them." 62 | ([] nil) 63 | ([sexp] (as-elements sexp)) 64 | ([sexp & sexps] (mapcat as-elements (cons sexp sexps)))) 65 | 66 | (defn sexp-as-element 67 | "Convert a single sexp into an Element" 68 | [sexp] 69 | (let [[root & more] (sexps-as-fragment sexp)] 70 | (when more 71 | (throw 72 | (IllegalArgumentException. 73 | "Cannot have multiple root elements; try creating a fragment instead"))) 74 | root)) 75 | 76 | 77 | -------------------------------------------------------------------------------- /src/main/resources/clojure/data/xml/spec.cljc: -------------------------------------------------------------------------------- 1 | (ns clojure.data.xml.spec 2 | (:require [clojure.spec :as s] 3 | [#?(:cljs cljs.spec.impl.gen :clj clojure.spec.gen) :as gen] 4 | clojure.test.check.generators 5 | [clojure.data.xml :as xml] 6 | [clojure.data.xml.name :as name] 7 | [clojure.data.xml.name :as node] 8 | #?@(:cljs [[clojure.data.xml.js.dom :as dom]]) 9 | [clojure.string :as str])) 10 | 11 | (s/def ::qname-conformer 12 | (s/and (s/conformer 13 | (fn [qn] 14 | (try {:uri (name/qname-uri qn) 15 | :local (name/qname-local qn)} 16 | (catch :default e 17 | (.error js/console e "Could not conform to qname:" qn) 18 | ::s/invalid))) 19 | (fn [{:keys [uri local] :as arg}] 20 | (.log js/console arg) 21 | (name/qname uri local))) 22 | #(not (str/blank? (:local %))))) 23 | 24 | (s/def ::name/qname 25 | (-> 26 | (s/or 27 | :global (s/or :kw (s/and simple-keyword? ::qname-conformer) 28 | :str (s/and string? ::qname-conformer #(str/blank? (:uri %)))) 29 | :qualified (s/or :kw (s/and qualified-keyword? ::qname-conformer) 30 | :str (s/and string? ::qname-conformer))) 31 | (s/with-gen 32 | #(gen/fmap (fn [[uri local]] 33 | (name/qname uri local)) 34 | (gen/tuple (gen/fmap (fn [s] (when-not (str/blank? s) 35 | (str "urn:" s))) 36 | (gen/string-alphanumeric)) 37 | (gen/fmap (partial str "G") (gen/string-alphanumeric))))))) 38 | 39 | 40 | (s/def ::node/Element 41 | (s/keys :req-un [::node/tag] 42 | :opt-un [::node/attrs ::node/content])) 43 | 44 | #?(:cljs 45 | (do (s/def ::dom/Element (s/with-gen (partial instance? dom/Element) 46 | #(gen/fmap dom/element-node (s/gen ::node/Element)))) 47 | (s/def ::dom/Text (s/with-gen (partial instance? dom/Text) 48 | #(gen/fmap dom/text-node (gen/string-ascii)))))) 49 | 50 | (s/def ::xml/Element 51 | #?(:clj ::node/Element 52 | :cljs (s/or :dom ::dom/Element 53 | :rec ::node/Element))) 54 | 55 | (s/def ::xml/Text 56 | (s/or :blank (s/with-gen str/blank? #(s/gen #{"" nil})) 57 | :str string? 58 | #?@(:cljs [:text ::dom/Text]))) 59 | 60 | (s/def ::xml/Node 61 | (s/or :text ::xml/Text 62 | :elem ::xml/Element)) 63 | 64 | (s/def ::node/tag ::name/qname) 65 | (s/def ::node/attrs (s/map-of ::name/qname string? 66 | :conform-keys true)) 67 | (s/def ::node/content 68 | (s/coll-of ::xml/Node)) 69 | 70 | 71 | (comment 72 | 73 | (s/conform 74 | (s/coll-of ::name/qname) 75 | [:foo :xmlns/foo]) 76 | 77 | (require '[clojure.spec.gen :as gen]) 78 | 79 | (s/exercise ::name/qname) 80 | 81 | ) 82 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 0.2.0-alpha10 2 | 3 | - Fix reflection warnings in clojure.data.xml.name (DXML-66) 4 | 5 | ## 0.2.0-alpha9 6 | 7 | - Update parent pom, depend on Clojure 1.9.0 8 | 9 | ## 0.2.0-alpha8 10 | 11 | - When parsing, only include namespace in tags when :namespace-aware is true 12 | 13 | ## 0.2.0-alpha7 14 | 15 | - Replace data.codec with using Base64, now in the JDK 16 | - Opt out of namespace awareness in the event-seq function by passing :namespace-aware mapped to a truthy value in the opts map 17 | 18 | ## 0.2.0-alpha6 19 | 20 | - ClojureScript implementation fixes and tests 21 | 22 | ## 0.2.0-alpha5 23 | 24 | - Fix error check for builtin prefixes DXML-49 25 | - Remove reflection cases DXML-46 26 | 27 | ## 0.2.0-alpha3 28 | 29 | - Minimum requirement is now clojure 1.7.0 30 | - Print newline after preamble when pretty-printing (DXML-35) 31 | - Serialize built-in data types in XML Schema (DXML-27) 32 | - Reimplement namespace context tracking, due to bug in JDK 33 | - Various fixes in documentation and error messages (DXML-39) 34 | - Emit empty tags for elements with no content (DXML-25) 35 | - Add clojure.data.xml/element? predicate 36 | - Support empty protocol function on Element deftypes (DXML-44) 37 | - Reflection cleanup (DXML-42) 38 | 39 | ## 0.2.0-alpha2 40 | 41 | - qname function now returns canonical (keyword) names 42 | - Remove QName defrecord from Clojurescript 43 | - Rename canonical-name to as-qname 44 | - Remove to-qname 45 | - xml nodes now implement map equality 46 | 47 | ## 0.2.0-alpha1 48 | 49 | - Define uniform mapping of xml namespaces to clojure namespaces via percent-encoding 50 | - Remove declare-ns and alias-ns 51 | - Introduce alias-uri 52 | - Clojurescript support 53 | - data.xml now requires Clojure 1.5.0+ (due to percent-sign in keywords) 54 | - Preserve whitespace by default 55 | 56 | ## 0.1.0-beta3 57 | 58 | - Fix emitter to keep non-namespaced xml names out of any set default namespace 59 | - Add support for location info in parser 60 | 61 | ## 0.1.0-beta2 62 | 63 | - Add support for emitting DOCTYPEs (DXML-10) 64 | - Fix issue emitting sibling namespaces (DXML-33) 65 | - Fix issue printing defaulted namespaces (DXML-30) 66 | 67 | ## 0.1.0-beta1 68 | 69 | - Add support for XML namespaces (DXML-4) 70 | - Fix pull-seq so it produces character events that work with emit-events (DXML-28) 71 | - Removed docs and references to JDK 1.5, data.xml now requires 1.6+ 72 | - data.xml now requires Clojure 1.4.0+ 73 | 74 | ## 0.0.8 75 | 76 | - Remove relection warnings in emit-cdata (DXML-16) 77 | - Added an EPL license file (DXML-19) 78 | - Fixed bug in the handling of CData end tags (DXML-17) 79 | - Added support for emitting booleans and numbers (DXML-14) 80 | 81 | ## 0.0.7 82 | 83 | - Fixed bug with args to the indentation function (DXML-7) 84 | - Strings now supported as tag names, previously was only kewords (DXML-8) 85 | - Add CDATA and comments support to sexp-as-element (DXML-11) 86 | - data.xml now properly handles CDATA records that contain an embedded ]]> 87 | by breaking it into two CDATA sections (DXML-12) 88 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_sexp.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for reading [:tag {:attr 'value} body*] as XML." 10 | :author "Alan Malloy"} 11 | clojure.data.xml.test-sexp 12 | (:require 13 | [clojure.test :refer :all] 14 | [clojure.data.xml :refer :all] 15 | [clojure.data.xml.test-utils :refer (test-stream lazy-parse*)])) 16 | 17 | (deftest as-element 18 | (let [xml-input "" 19 | sexp-input [:tag {:attr "value"} :body]] 20 | (is (= (lazy-parse* xml-input) 21 | (sexp-as-element sexp-input))))) 22 | 23 | (deftest as-fragment 24 | (let [input (list [:tag1 "stuff"] 25 | [:tag2 "other"])] 26 | (is (= (sexps-as-fragment input) 27 | (map sexp-as-element input))) 28 | (is (thrown? Exception (sexp-as-element input))))) 29 | 30 | (deftest with-cdata 31 | (let [xml-input (element :tag {:attr "value"} 32 | (element :body {} (cdata "not parsed " 49 | (let [xml-input (element :tag {:attr "value"} 50 | (element :body {} 51 | (cdata "not parsed more not parsed more not parsed } str 35 | [1 2 :< 3 :< 4 :> :> 5 :> 6]) 36 | ;=> ((\"1\" \"2\" [(\"3\" [(\"4\")])] \"5\") 6)" 37 | [parent exit? node coll] 38 | (lazy-seq 39 | (when-let [[event] (seq coll)] 40 | (let [more (rest coll)] 41 | (if (exit? event) 42 | (cons nil more) 43 | (let [tree (seq-tree parent exit? node more)] 44 | (if-let [p (parent event (lazy-seq (first tree)))] 45 | (let [subtree (seq-tree parent exit? node (lazy-seq (rest tree)))] 46 | (cons (cons p (lazy-seq (first subtree))) 47 | (lazy-seq (rest subtree)))) 48 | (cons (cons (node event) (lazy-seq (first tree))) 49 | (lazy-seq (rest tree)))))))))) 50 | 51 | ;; # Break circular dependency of emitter-parser common infrastructure 52 | 53 | ;; "Parse" events off the in-memory representation 54 | 55 | (defn flatten-elements 56 | "Flatten a collection of elements to an event seq" 57 | [elements] 58 | (when (seq elements) 59 | (lazy-seq 60 | (let [e (first elements)] 61 | (cons (gen-event e) 62 | (flatten-elements (next-events e (rest elements)))))))) 63 | 64 | ;; "Emit" events to the in-memory representation 65 | 66 | (defn event-tree 67 | "Returns a lazy tree of Element objects for the given seq of Event 68 | objects. See source-seq and parse." 69 | [events] 70 | (ffirst 71 | (seq-tree event-element event-exit? event-node events))) 72 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | data.xml 4 | 0.2.1-SNAPSHOT 5 | data.xml 6 | jar 7 | Functions to parse XML into lazy sequences and lazy trees and emit these as text 8 | 9 | 10 | Chouser 11 | chouser@n01se.net 12 | https://chouser.n01se.net 13 | -5 14 | 15 | 16 | Alan Malloy 17 | amalloy@4clojure.com 18 | -8 19 | 20 | 21 | Ryan Senior 22 | senior.ryan@gmail.com 23 | -6 24 | 25 | 26 | Herwig Hochleitner 27 | herwig@bendlas.net 28 | +1 29 | 30 | 31 | 32 | 33 | org.clojure 34 | pom.contrib 35 | 1.3.0 36 | 37 | 38 | 39 | 40 | openjdk-nashorn 41 | 42 | [15,18) 43 | 44 | 45 | 46 | org.openjdk.nashorn 47 | nashorn-core 48 | 15.3 49 | test 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | org.clojure 58 | test.check 59 | 1.1.1 60 | test 61 | 62 | 63 | org.clojure 64 | clojurescript 65 | 1.10.439 66 | test 67 | 68 | 69 | 70 | 71 | 72 | 73 | ${project.basedir}/src/test/resources 74 | 75 | 76 | ${project.basedir}/src/test/clojurescript 77 | 78 | 79 | 80 | 81 | 82 | 84 | 1.9.0 85 | 86 | 87 | 88 | 89 | 90 | clojars.org 91 | https://clojars.org/repo 92 | 93 | 94 | 95 | 96 | scm:git:git@github.com:clojure/data.xml.git 97 | scm:git:git@github.com:clojure/data.xml.git 98 | git@github.com:clojure/data.xml.git 99 | HEAD 100 | 101 | 102 | 103 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/pu_map.cljc: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.pu-map 10 | "Provides a bidirectional mapping for keeping track of prefix->uri mappings in xml namespaces. 11 | 12 | This has the semantics of a basic key -> multiple values map + two special features, both of which are dictated by the xml standard: 13 | 14 | - instead of a special dissoc, there is assoc to empty string or nil 15 | - there are two fixed, unique mappings: 16 | - \"xml\" <-> [\"http://www.w3.org/2000/xmlns/\"] 17 | - \"xmlns\" <-> [\"http://www.w3.org/XML/1998/namespace\"]" 18 | (:require [clojure.data.xml.name :as name] 19 | [clojure.string :as str] 20 | [clojure.core :as core]) 21 | (:refer-clojure :exclude [assoc! dissoc! transient persistent! get assoc merge])) 22 | 23 | (def prefix-map :p->u) 24 | (def uri-map :u->ps) 25 | 26 | ;; TODO replace this with a deftype for memory savings 27 | (def EMPTY {:u->ps {name/xml-uri ["xml"] 28 | name/xmlns-uri ["xmlns"]} 29 | :p->u {"xml" name/xml-uri 30 | "xmlns" name/xmlns-uri}}) 31 | 32 | ;; TODO implement valid? with internal consistency check 33 | 34 | (defn transient [pu] 35 | (let [{:keys [u->ps p->u] :as pu*} 36 | (or pu EMPTY)] 37 | (assert (and u->ps p->u) (str "Not a pu-map " (pr-str pu*))) 38 | (core/assoc! (core/transient {}) 39 | :p->u (core/transient p->u) 40 | :u->ps (core/transient u->ps)))) 41 | 42 | (defn persistent! [put] 43 | (core/persistent! 44 | (core/assoc! put 45 | :p->u (core/persistent! (core/get put :p->u)) 46 | :u->ps (core/persistent! (core/get put :u->ps))))) 47 | 48 | (defn- assoc-uri! [u->ps uri prefix] 49 | (core/assoc! u->ps uri 50 | (if-let [ps (core/get u->ps uri)] 51 | (conj ps prefix) 52 | [prefix]))) 53 | 54 | (defn- dissoc-uri! [u->ps uri prefix] 55 | (if-let [ps (seq (remove #{prefix} (core/get u->ps uri)))] 56 | (core/assoc! u->ps uri (vec ps)) 57 | (core/dissoc! u->ps uri))) 58 | 59 | (defn assoc! [{:as put :keys [p->u u->ps]} prefix uri] 60 | (name/legal-xmlns-binding! prefix uri) 61 | (let [prefix* (str prefix) 62 | prev-uri (core/get p->u prefix*)] 63 | (core/assoc! put 64 | :p->u (if (str/blank? uri) 65 | (core/dissoc! p->u prefix*) 66 | (core/assoc! p->u prefix* uri)) 67 | :u->ps (if (str/blank? uri) 68 | (dissoc-uri! u->ps prev-uri prefix*) 69 | (cond 70 | (= uri prev-uri) u->ps 71 | (not prev-uri) (assoc-uri! u->ps uri prefix*) 72 | :else (-> u->ps 73 | (dissoc-uri! prev-uri prefix*) 74 | (assoc-uri! uri prefix*))))))) 75 | 76 | (defn get [{:keys [p->u]} prefix] 77 | (core/get p->u (str prefix))) 78 | 79 | (defn get-prefixes [{:keys [u->ps]} uri] 80 | (core/get u->ps uri)) 81 | 82 | (def get-prefix (comp first get-prefixes)) 83 | 84 | (defn assoc [put & {:as kvs}] 85 | (persistent! 86 | (reduce-kv assoc! (transient put) kvs))) 87 | 88 | (defn reduce-diff 89 | "A high-performance diffing operation, that reduces f over changed and removed prefixes" 90 | [f s 91 | {ppu :p->u} 92 | {pu :p->u}] 93 | (let [s (reduce-kv (fn [s p _] 94 | (if (contains? pu p) 95 | s (f s p ""))) 96 | s ppu) 97 | s (reduce-kv (fn [s p u] 98 | (if (= u (core/get ppu p)) 99 | s (f s p u))) 100 | s pu)] 101 | s)) 102 | 103 | (defn merge-prefix-map 104 | "Merge a prefix map into pu-map" 105 | [pu pm] 106 | (persistent! (reduce-kv assoc! (transient pu) pm))) 107 | 108 | (defn merge 109 | "Merge two pu-maps, left to right" 110 | [pu {:keys [:p->u]}] 111 | (merge-prefix-map pu p->u)) 112 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/event.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.event 10 | "Data type for xml pull events" 11 | {:author "Herwig Hochleitner"} 12 | (:require [clojure.data.xml.protocols :refer 13 | [EventGeneration gen-event next-events xml-str]] 14 | [clojure.data.xml.name :refer [separate-xmlns]] 15 | [clojure.data.xml.node :refer [element* cdata xml-comment]] 16 | [clojure.data.xml.impl :refer [extend-protocol-fns compile-if]] 17 | [clojure.data.xml.pu-map :as pu]) 18 | (:import (clojure.data.xml.node Element CData Comment) 19 | (clojure.lang Sequential IPersistentMap Keyword) 20 | (java.net URI URL) 21 | (java.util Date) 22 | (javax.xml.namespace QName))) 23 | 24 | (definline element-nss* [element] 25 | `(get (meta ~element) :clojure.data.xml/nss pu/EMPTY)) 26 | 27 | (defn element-nss 28 | "Get xmlns environment from element" 29 | [{:keys [attrs] :as element}] 30 | (separate-xmlns 31 | attrs #(pu/merge-prefix-map (element-nss* element) %2))) 32 | 33 | ; Represents a parse event. 34 | (defrecord StartElementEvent [tag attrs nss location-info]) 35 | (defrecord EmptyElementEvent [tag attrs nss location-info]) 36 | (defrecord CharsEvent [str]) 37 | (defrecord CDataEvent [str]) 38 | (defrecord CommentEvent [str]) 39 | (defrecord QNameEvent [qn]) 40 | 41 | ;; EndElementEvent doesn't have any data, so make it a singleton 42 | (deftype EndElementEvent []) 43 | (def end-element-event (EndElementEvent.)) 44 | (defn ->EndElementEvent [] end-element-event) 45 | 46 | ;; Event Generation for stuff to show up in generated xml 47 | 48 | (let [second-arg #(do %2) 49 | elem-event-generation 50 | {:gen-event (fn elem-gen-event [{:keys [tag attrs content] :as element}] 51 | (separate-xmlns 52 | attrs #((if (seq content) 53 | ->StartElementEvent ->EmptyElementEvent) 54 | tag %1 (pu/merge-prefix-map (element-nss* element) %2) nil))) 55 | :next-events (fn elem-next-events [{:keys [tag content]} next-items] 56 | (if (seq content) 57 | (list* content end-element-event next-items) 58 | next-items))} 59 | string-event-generation {:gen-event (comp ->CharsEvent #'xml-str) 60 | :next-events second-arg} 61 | qname-event-generation {:gen-event ->QNameEvent 62 | :next-events second-arg}] 63 | (extend-protocol-fns 64 | EventGeneration 65 | (StartElementEvent EmptyElementEvent EndElementEvent CharsEvent CDataEvent CommentEvent) 66 | {:gen-event identity 67 | :next-events second-arg} 68 | (String Boolean Number (Class/forName "[B") Date URI URL nil) 69 | string-event-generation 70 | (Keyword QName) qname-event-generation 71 | CData 72 | {:gen-event (comp ->CDataEvent :content) 73 | :next-events second-arg} 74 | Comment 75 | {:gen-event (comp ->CommentEvent :content) 76 | :next-events second-arg} 77 | (IPersistentMap Element) elem-event-generation) 78 | (compile-if 79 | (Class/forName "java.time.Instant") 80 | (extend java.time.Instant 81 | EventGeneration 82 | string-event-generation) 83 | nil)) 84 | 85 | (extend-protocol EventGeneration 86 | Sequential 87 | (gen-event [coll] 88 | (gen-event (first coll))) 89 | (next-events [coll next-items] 90 | (if-let [r (seq (rest coll))] 91 | (cons (next-events (first coll) r) next-items) 92 | (next-events (first coll) next-items)))) 93 | 94 | ;; Node Generation for events 95 | 96 | (defn event-element [event contents] 97 | (when (or (instance? StartElementEvent event) 98 | (instance? EmptyElementEvent event)) 99 | (element* (:tag event) (:attrs event) contents 100 | (if-let [loc (:location-info event)] 101 | {:clojure.data.xml/location-info loc 102 | :clojure.data.xml/nss (:nss event)} 103 | {:clojure.data.xml/nss (:nss event)})))) 104 | 105 | (defn event-node [event] 106 | (cond 107 | (instance? CharsEvent event) (:str event) 108 | (instance? CDataEvent event) (cdata (:str event)) 109 | (instance? CommentEvent event) (xml-comment (:str event)) 110 | :else (throw (ex-info "Illegal argument, not an event object" {:event event})))) 111 | 112 | (defn event-exit? [event] 113 | (identical? end-element-event event)) 114 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_parse.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for XML parsing functions." 10 | :author "Chris Houser"} 11 | clojure.data.xml.test-parse 12 | (:require 13 | [clojure.test :refer :all] 14 | [clojure.data.xml :refer [parse-str element]] 15 | [clojure.data.xml.test-utils :refer [test-stream lazy-parse*]])) 16 | 17 | (deftest simple 18 | (let [input "This is bold test" 19 | expected (element :html {} (element :body {:bg "red"} 20 | "This is " (element :b {} "bold") " test"))] 21 | (is (= expected (lazy-parse* input))))) 22 | 23 | (deftest deep 24 | (let [input (str "" 25 | " t1t2" 26 | " t3t4" 27 | " t5t6" 28 | " t7" 29 | " t8t10t11" 30 | " t12t13t14" 31 | "") 32 | expected (element :a {:h "1", :i "2", :j "3"} 33 | " t1" (element :b {:k "4"} "t2") 34 | " t3" (element :c {} "t4") 35 | " t5" (element :d {} "t6") 36 | " t7" (element :e {:l "5" :m "6"} 37 | " t8" (element :f {} "t10") "t11") 38 | " t12" (element :g {} "t13") "t14")] 39 | (is (= expected (lazy-parse* input))) 40 | (is (= expected (parse-str input))))) 41 | 42 | (deftest test-xml-with-whitespace 43 | (let [input (str "\n123\n1 2 3\n\n") 44 | expected (element :a {} 45 | "\n" 46 | (element :b {:with-attr "s p a c e"} "123") 47 | "\n" 48 | (element :c {} "1 2 3") 49 | "\n\n")] 50 | (is (= expected (lazy-parse* input))))) 51 | 52 | (deftest test-cdata-parse 53 | (let [input "]]>" 54 | expected (element :cdata {} (element :is {} 55 | (element :here {} 56 | "")))] 57 | (is (= expected (lazy-parse* input))))) 58 | 59 | (deftest test-comment-parse 60 | (let [input "there" 61 | expected (element :comment {} (element :is {} 62 | (element :here {} 63 | "there")))] 64 | (is (= expected (lazy-parse* input))))) 65 | 66 | (deftest test-parsing-processing-instructions 67 | (let [input " 68 | 69 | With Stuff" 70 | expected (element :ATag {} "With Stuff")] 71 | (is (= expected (parse-str input))))) 72 | 73 | (deftest test-parsing-doctypes 74 | (let [input " 76 |

Heading Stuff

" 77 | expected (element :html {} 78 | (element :h1 {} "Heading Stuff"))] 79 | (is (= expected (parse-str input))))) 80 | 81 | (deftest test-coalescing 82 | (let [input ""] 83 | (is (= ["\nfoo bar\n\nbaz\n"] (:content (parse-str input)))) 84 | (is (= ["\nfoo bar\n" "\nbaz\n"] (:content 85 | (parse-str input :coalescing false)))))) 86 | 87 | (deftest test-location-meta 88 | (let [input "\n" 89 | location-meta (comp :clojure.data.xml/location-info meta)] 90 | ;the numbers look 1 based 91 | (is (= 1 (-> input parse-str location-meta :line-number))) 92 | (is (= 1 (-> input parse-str location-meta :column-number))) 93 | (is (= 1 (-> input parse-str :content first location-meta :line-number))) 94 | (is (= 4 (-> input parse-str :content first location-meta :column-number))) 95 | (is (= 2 (-> input (parse-str :skip-whitespace true) :content second location-meta :line-number))) 96 | (is (nil? (-> input 97 | (parse-str :location-info false) 98 | location-meta))))) 99 | 100 | (deftest test-ignorable-whitespace 101 | ;; FIXME implement clojure.lang.MapEquivalence for records 102 | (clojure.lang.APersistentMap/mapEquals 103 | (parse-str " 104 | 106 | 107 | 108 | 109 | 110 | 111 | ]> 112 | 113 | lookupSymbol 114 | 115 | 116 | 117 | 118 | Clojure XML <3 119 | 120 | 121 | 122 | 123 | ") 124 | {:tag :methodCall, :attrs {}, :content 125 | [{:tag :methodName, :attrs {}, :content 126 | ["lookupSymbol"]} 127 | {:tag :params, :attrs {}, :content 128 | [{:tag :param, :attrs {}, :content 129 | [{:tag :value, :attrs {}, :content 130 | [{:tag :string, :attrs {}, :content 131 | ["\n Clojure XML <3 \n "]}]}]}]}]})) 132 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/jvm/parse.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.jvm.parse 10 | (:require [clojure.string :as str] 11 | [clojure.data.xml.event :refer 12 | [->StartElementEvent ->EmptyElementEvent ->EndElementEvent 13 | ->CharsEvent ->CDataEvent ->CommentEvent]] 14 | [clojure.data.xml.impl :refer 15 | [static-case]] 16 | [clojure.data.xml.name :refer 17 | [qname]] 18 | [clojure.data.xml.pu-map :as pu]) 19 | (:import 20 | (java.io InputStream Reader) 21 | (javax.xml.stream 22 | XMLInputFactory XMLStreamReader XMLStreamConstants) 23 | (clojure.data.xml.event EndElementEvent))) 24 | 25 | (def ^{:private true} input-factory-props 26 | {:allocator XMLInputFactory/ALLOCATOR 27 | :coalescing XMLInputFactory/IS_COALESCING 28 | :namespace-aware XMLInputFactory/IS_NAMESPACE_AWARE 29 | :replacing-entity-references XMLInputFactory/IS_REPLACING_ENTITY_REFERENCES 30 | :supporting-external-entities XMLInputFactory/IS_SUPPORTING_EXTERNAL_ENTITIES 31 | :validating XMLInputFactory/IS_VALIDATING 32 | :reporter XMLInputFactory/REPORTER 33 | :resolver XMLInputFactory/RESOLVER 34 | :support-dtd XMLInputFactory/SUPPORT_DTD}) 35 | 36 | (defn- attr-prefix [^XMLStreamReader sreader index] 37 | (let [p (.getAttributePrefix sreader index)] 38 | (when-not (str/blank? p) 39 | p))) 40 | 41 | (defn- attr-hash [^XMLStreamReader sreader] 42 | (persistent! 43 | (reduce (fn [tr i] 44 | (assoc! tr (qname (.getAttributeNamespace sreader i) 45 | (.getAttributeLocalName sreader i) 46 | (.getAttributePrefix sreader i)) 47 | (.getAttributeValue sreader i))) 48 | (transient {}) 49 | (range (.getAttributeCount sreader))))) 50 | 51 | (defn- nss-hash [^XMLStreamReader sreader parent-hash] 52 | (pu/persistent! 53 | (reduce (fn [tr ^long i] 54 | (pu/assoc! tr 55 | (.getNamespacePrefix sreader i) 56 | (.getNamespaceURI ^XMLStreamReader sreader i))) 57 | (pu/transient parent-hash) 58 | (range (.getNamespaceCount sreader))))) 59 | 60 | (defn- location-hash 61 | [^XMLStreamReader sreader] 62 | (when-let [location (.getLocation sreader)] 63 | {:character-offset (.getCharacterOffset location) 64 | :column-number (.getColumnNumber location) 65 | :line-number (.getLineNumber location)})) 66 | 67 | ; Note, sreader is mutable and mutated here in pull-seq, but it's 68 | ; protected by a lazy-seq so it's thread-safe. 69 | (defn pull-seq 70 | "Creates a seq of events. The XMLStreamConstants/SPACE clause below doesn't seem to 71 | be triggered by the JDK StAX parser, but is by others. Leaving in to be more complete." 72 | [^XMLStreamReader sreader {:keys [include-node? location-info skip-whitespace namespace-aware] :as opts} ns-envs] 73 | (lazy-seq 74 | (loop [] 75 | (let [location (when location-info 76 | (location-hash sreader))] 77 | (static-case 78 | (.next sreader) 79 | XMLStreamConstants/START_ELEMENT 80 | (if (include-node? :element) 81 | (let [ns-env (nss-hash sreader (or (first ns-envs) pu/EMPTY)) 82 | tag (qname (when namespace-aware (.getNamespaceURI sreader)) 83 | (.getLocalName sreader) 84 | (.getPrefix sreader)) 85 | attrs (attr-hash sreader) 86 | next-events (pull-seq sreader opts (cons ns-env ns-envs))] 87 | ;; Can't emit EmptyElementEvent here, since 88 | ;; for seq-tree node and exit? are mutually exclusive 89 | (cons (->StartElementEvent tag attrs ns-env location) 90 | next-events)) 91 | (recur)) 92 | XMLStreamConstants/END_ELEMENT 93 | (if (include-node? :element) 94 | (do (assert (seq ns-envs) "Balanced end") 95 | (cons (->EndElementEvent) 96 | (pull-seq sreader opts (rest ns-envs)))) 97 | (recur)) 98 | XMLStreamConstants/CHARACTERS 99 | (if-let [text (and (include-node? :characters) 100 | (not (and skip-whitespace 101 | (.isWhiteSpace sreader))) 102 | (.getText sreader))] 103 | (if (zero? (.length ^CharSequence text)) 104 | (recur) 105 | (cons (->CharsEvent text) 106 | (pull-seq sreader opts ns-envs))) 107 | (recur)) 108 | XMLStreamConstants/COMMENT 109 | (if (include-node? :comment) 110 | (cons (->CommentEvent (.getText sreader)) 111 | (pull-seq sreader opts ns-envs)) 112 | (recur)) 113 | XMLStreamConstants/END_DOCUMENT 114 | nil 115 | ;; Consume and ignore comments, spaces, processing instructions etc 116 | (recur)))))) 117 | 118 | (defn- make-input-factory ^XMLInputFactory [props] 119 | (let [fac (XMLInputFactory/newInstance)] 120 | (doseq [[k v] props 121 | :when (contains? input-factory-props k) 122 | :let [prop (input-factory-props k)]] 123 | (.setProperty fac prop v)) 124 | fac)) 125 | 126 | (defn make-stream-reader [props source] 127 | (let [fac (make-input-factory props)] 128 | (cond 129 | (instance? Reader source) (.createXMLStreamReader fac ^Reader source) 130 | (instance? InputStream source) (.createXMLStreamReader fac ^InputStream source) 131 | :else (throw (IllegalArgumentException. 132 | "source should be java.io.Reader or java.io.InputStream"))))) 133 | 134 | (defn string-source [s] 135 | (java.io.StringReader. s)) 136 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Functions to parse XML into lazy sequences and lazy trees and 10 | emit these as text." 11 | :author "Chris Houser"} 12 | 13 | clojure.data.xml 14 | 15 | (:require 16 | (clojure.data.xml 17 | [process :as process] 18 | [impl :refer [export-api]] 19 | [node :as node] 20 | [prxml :as prxml] 21 | [name :as name] 22 | [event :as event]) 23 | (clojure.data.xml.jvm 24 | [pprint :refer 25 | [indent-xml]] 26 | [parse :refer 27 | [pull-seq string-source make-stream-reader]] 28 | [emit :refer 29 | [write-document string-writer]]) 30 | 31 | [clojure.data.xml.tree :refer 32 | [event-tree flatten-elements]])) 33 | 34 | (export-api node/element* node/element node/cdata node/xml-comment node/element? 35 | prxml/sexp-as-element prxml/sexps-as-fragment event/element-nss 36 | name/alias-uri name/parse-qname name/qname-uri 37 | name/qname-local name/qname name/as-qname name/uri-symbol name/symbol-uri 38 | name/uri-file name/print-uri-file-command! 39 | process/find-xmlns process/aggregate-xmlns) 40 | 41 | (def ^:private ^:const parser-opts-arg 42 | '{:keys [include-node? location-info 43 | coalescing supporting-external-entities 44 | allocator namespace-aware replacing-entity-references 45 | validating reporter resolver support-dtd] 46 | :or {include-node? #{:element :characters} 47 | location-info true 48 | coalescing true 49 | supporting-external-entities false}}) 50 | 51 | (defn event-seq 52 | "Parses an XML input source into a lazy sequence of pull events. 53 | 54 | Input source can be a java.io.InputStream or java.io.Reader 55 | 56 | Options: 57 | 58 | :include-node? subset of #{:element :characters :comment}, default #{:element :characters} 59 | :location-info pass false to skip generating location meta data, default true 60 | 61 | See https://docs.oracle.com/javase/8/docs/api/javax/xml/stream/XMLInputFactory.html 62 | for documentation on xml options. These are the defaults: 63 | 64 | {:allocator nil ; XMLInputFactory/ALLOCATOR 65 | :coalescing true ; XMLInputFactory/IS_COALESCING 66 | :namespace-aware true ; XMLInputFactory/IS_NAMESPACE_AWARE 67 | :replacing-entity-references true ; XMLInputFactory/IS_REPLACING_ENTITY_REFERENCES 68 | :supporting-external-entities false ; XMLInputFactory/IS_SUPPORTING_EXTERNAL_ENTITIES 69 | :validating false ; XMLInputFactory/IS_VALIDATING 70 | :reporter nil ; XMLInputFactory/REPORTER 71 | :resolver nil ; XMLInputFactory/RESOLVER 72 | :support-dtd true ; XMLInputFactory/SUPPORT_DTD 73 | }" 74 | {:arglists (list ['source parser-opts-arg])} 75 | [source opts] 76 | (let [props* (merge {:include-node? #{:element :characters} 77 | :coalescing true 78 | :supporting-external-entities false 79 | :location-info true 80 | :namespace-aware true} 81 | opts)] 82 | (pull-seq (make-stream-reader props* source) 83 | props* 84 | nil))) 85 | 86 | (defn parse 87 | "Parses an XML input source into a a tree of Element records. 88 | The element tree is realized lazily, so huge XML files can be streamed through a depth-first tree walk. 89 | 90 | Input source can be a java.io.InputStream or java.io.Reader 91 | 92 | Options: 93 | 94 | :include-node? subset of #{:element :characters :comment}, default #{:element :characters} 95 | :location-info pass false to skip generating location meta data, default true 96 | 97 | See https://docs.oracle.com/javase/8/docs/api/javax/xml/stream/XMLInputFactory.html 98 | for documentation on xml options. These are the defaults: 99 | 100 | {:allocator nil ; XMLInputFactory/ALLOCATOR 101 | :coalescing true ; XMLInputFactory/IS_COALESCING 102 | :namespace-aware true ; XMLInputFactory/IS_NAMESPACE_AWARE 103 | :replacing-entity-references true ; XMLInputFactory/IS_REPLACING_ENTITY_REFERENCES 104 | :supporting-external-entities false ; XMLInputFactory/IS_SUPPORTING_EXTERNAL_ENTITIES 105 | :validating false ; XMLInputFactory/IS_VALIDATING 106 | :reporter nil ; XMLInputFactory/REPORTER 107 | :resolver nil ; XMLInputFactory/RESOLVER 108 | :support-dtd true ; XMLInputFactory/SUPPORT_DTD 109 | }" 110 | {:arglists (list ['source '& parser-opts-arg])} 111 | [source & {:as opts}] 112 | (event-tree (event-seq source opts))) 113 | 114 | (defn parse-str 115 | "Parses an XML String into a a tree of Element records. 116 | 117 | Options: 118 | 119 | :include-node? subset of #{:element :characters :comment}, default #{:element :characters} 120 | :location-info pass false to skip generating location meta data, default true 121 | 122 | See https://docs.oracle.com/javase/8/docs/api/javax/xml/stream/XMLInputFactory.html 123 | for documentation on xml options. These are the defaults: 124 | 125 | {:allocator nil ; XMLInputFactory/ALLOCATOR 126 | :coalescing true ; XMLInputFactory/IS_COALESCING 127 | :namespace-aware true ; XMLInputFactory/IS_NAMESPACE_AWARE 128 | :replacing-entity-references true ; XMLInputFactory/IS_REPLACING_ENTITY_REFERENCES 129 | :supporting-external-entities false ; XMLInputFactory/IS_SUPPORTING_EXTERNAL_ENTITIES 130 | :validating false ; XMLInputFactory/IS_VALIDATING 131 | :reporter nil ; XMLInputFactory/REPORTER 132 | :resolver nil ; XMLInputFactory/RESOLVER 133 | :support-dtd true ; XMLInputFactory/SUPPORT_DTD 134 | }" 135 | {:arglists (list ['string '& parser-opts-arg])} 136 | [s & opts] 137 | (apply parse (string-source s) opts)) 138 | 139 | (defn emit 140 | "Prints the given Element tree as XML text to stream. 141 | Options: 142 | :encoding Character encoding to use 143 | :doctype Document type (DOCTYPE) declaration to use" 144 | [e writer & {:as opts}] 145 | (write-document writer (flatten-elements [e]) opts)) 146 | 147 | (defn emit-str 148 | "Emits the Element to String and returns it. 149 | Options: 150 | :encoding Character encoding to use 151 | :doctype Document type (DOCTYPE) declaration to use" 152 | ([e & opts] 153 | (let [sw (string-writer)] 154 | (apply emit e sw opts) 155 | (str sw)))) 156 | 157 | (defn indent 158 | "Emits the XML and indents the result. WARNING: this is slow 159 | it will emit the XML and read it in again to indent it. Intended for 160 | debugging/testing only." 161 | [e writer & opts] 162 | (indent-xml (apply emit-str e opts) writer)) 163 | 164 | (defn indent-str 165 | "Emits the XML and indents the result. Writes the results to a String and returns it" 166 | [e & opts] 167 | (let [sw (string-writer)] 168 | (apply indent e sw opts) 169 | (str sw))) 170 | 171 | ;; TODO implement ~normalize to simulate an emit-parse roundtrip 172 | ;; in terms of xmlns environment and keywords vs qnames 173 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/name.cljc: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.name 10 | #?@(:clj [(:require [clojure.string :as str] 11 | [clojure.data.xml.jvm.name :as jvm] 12 | (clojure.data.xml 13 | [impl :refer [export-api]] 14 | [protocols :as protocols :refer [AsQName]])) 15 | (:import (clojure.lang Namespace Keyword))] 16 | :cljs [(:require-macros 17 | [clojure.data.xml.impl :refer [export-api]]) 18 | (:require [clojure.string :as str] 19 | [clojure.data.xml.js.name :as jsn] 20 | [clojure.data.xml.protocols :as protocols :refer [AsQName]]) 21 | (:import (goog.string StringBuffer))])) 22 | 23 | (export-api 24 | #?@(:clj [jvm/parse-qname jvm/encode-uri jvm/decode-uri] 25 | :cljs [jsn/parse-qname jsn/encode-uri jsn/decode-uri])) 26 | 27 | ;; protocol functions can be redefined by extend-*, so we wrap 28 | ;; protocols/qname-uri protocols/qname-local within regular fns 29 | 30 | (defn uri-symbol [uri] 31 | (symbol (encode-uri (str "xmlns." uri)))) 32 | 33 | (defn symbol-uri [ss] 34 | (let [du (decode-uri (str ss))] 35 | (if (.startsWith du "xmlns.") 36 | (subs du 6) 37 | (throw (ex-info "Uri symbol not valid" {:sym ss}))))) 38 | 39 | (defn qname-uri 40 | "Get the namespace uri for this qname" 41 | [v] 42 | (protocols/qname-uri v)) 43 | 44 | (defn qname-local 45 | "Get the name for this qname" 46 | [v] 47 | (protocols/qname-local v)) 48 | 49 | (defn qname 50 | ([local] (qname "" local)) 51 | ([uri local] (keyword (when-not (str/blank? uri) 52 | (encode-uri (str "xmlns." uri))) 53 | local)) 54 | ([uri local _prefix] (qname uri local))) 55 | 56 | ;; The empty string shall be equal to nil for xml names 57 | (defn namespaced? [qn] 58 | (not (str/blank? (qname-uri qn)))) 59 | 60 | (defn- clj-ns-name [ns] 61 | (cond (instance? Namespace ns) (ns-name ns) 62 | (keyword? ns) (name ns) 63 | :else (str ns))) 64 | 65 | ;; xmlns attributes get special treatment. they go into metadata, don't contribute to equality 66 | (def xmlns-uri "http://www.w3.org/2000/xmlns/") 67 | ;; TODO find out if xml prefixed names need any special treatment too 68 | (def xml-uri "http://www.w3.org/XML/1998/namespace") 69 | 70 | (extend-protocol AsQName 71 | Keyword 72 | (qname-local [kw] (name kw)) 73 | (qname-uri [kw] 74 | (if-let [ns (namespace kw)] 75 | (if (.startsWith ns "xmlns.") 76 | (decode-uri (subs ns 6)) 77 | (case ns 78 | "xmlns" xmlns-uri 79 | "xml" xml-uri 80 | (throw (ex-info "Keyword ns is not an xmlns. Needs to be in the form :xmlns./" 81 | {:kw kw})))) 82 | ""))) 83 | 84 | (defn as-qname [n] 85 | (qname (qname-uri n) (qname-local n))) 86 | 87 | (defn uri-file 88 | "Dummy file name for :require'ing xmlns uri" 89 | [uri] 90 | (str (str/replace (name (uri-symbol uri)) 91 | "." "/") 92 | ".cljc")) 93 | 94 | (defn print-uri-file-command! 95 | "Shell command to create a dummy file for xmlns. Execute from a source root." 96 | [uri] 97 | (println "echo \"(ns" (str (uri-symbol uri) ")\" >") (uri-file uri))) 98 | 99 | #?(:clj 100 | (defn alias-uri 101 | "Define a Clojure namespace aliases for xmlns uris. 102 | 103 | This sets up the current namespace for reading qnames denoted with 104 | Clojure's ::alias/keywords reader feature. 105 | 106 | 107 | ## Example 108 | (alias-uri :D \"DAV:\") 109 | ; similar in effect to 110 | ;; (require '[xmlns.DAV%3A :as D]) 111 | ; but required namespace is auto-created 112 | ; henceforth, shorthand keywords can be used 113 | {:tag ::D/propfind} 114 | ; ::D/propfind will be expanded to :xmlns.DAV%3A/propfind 115 | ; in the current namespace by the reader 116 | 117 | ## Clojurescript support 118 | Currently, namespaces can't be auto-created in Clojurescript. 119 | Dummy files for aliased uris have to exist. Have a look at `uri-file` and `print-uri-file-command!` to create those." 120 | {:arglists '([& {:as alias-nss}])} 121 | [& ans] 122 | (loop [[a n & rst :as ans] ans] 123 | (when (seq ans) 124 | (let [xn (uri-symbol n) 125 | al (symbol (clj-ns-name a))] 126 | (create-ns xn) 127 | (alias al xn) 128 | (recur rst)))))) 129 | 130 | (defn xmlns-attr? 131 | "Is this qname an xmlns declaration?" 132 | [qn] 133 | (let [uri (qname-uri qn)] 134 | (or (= xmlns-uri uri) 135 | (and (str/blank? uri) 136 | (= "xmlns" (qname-local qn)))))) 137 | 138 | (defn xmlns-attr-prefix [qn] 139 | (let [uri (qname-uri qn)] 140 | (if (str/blank? uri) 141 | (do (when-not (= "xmlns" (qname-local qn)) 142 | (throw (ex-info "Not an xmlns-attr name" {:qname qn}))) 143 | "") 144 | (do (when-not (= xmlns-uri uri) 145 | (throw (ex-info "Not an xmlns-attr name" {:qname qn}))) 146 | (qname-local qn))))) 147 | 148 | (defn legal-xmlns-binding! [prefix uri] 149 | (when (not= (= "xml" prefix) 150 | (= xml-uri uri)) 151 | (throw (ex-info (str "The xmlns binding for prefix `xml` is fixed to `" xml-uri "`") 152 | {:attempted-mapping {:prefix prefix :uri uri}}))) 153 | (when (not= (= "xmlns" prefix) 154 | (= xmlns-uri uri)) 155 | (throw (ex-info (str "The xmlns binding for prefix `xmlns` is fixed to `" xmlns-uri "`") 156 | {:attempted-mapping {:prefix prefix :uri uri}})))) 157 | 158 | (defn separate-xmlns 159 | "Call cont with two args: attributes and xmlns attributes" 160 | [attrs cont] 161 | (loop [attrs* (transient {}) 162 | xmlns* (transient {}) 163 | [qn :as attrs'] (keys attrs)] 164 | (if (seq attrs') 165 | (let [val (get attrs qn)] 166 | (if (xmlns-attr? qn) 167 | (let [prefix (xmlns-attr-prefix qn)] 168 | (legal-xmlns-binding! prefix val) 169 | (recur attrs* 170 | (assoc! xmlns* prefix val) 171 | (next attrs'))) 172 | (recur (assoc! attrs* qn val) 173 | xmlns* 174 | (next attrs')))) 175 | (cont (persistent! attrs*) (persistent! xmlns*))))) 176 | 177 | ;(set! *warn-on-reflection* true) 178 | 179 | #?(:clj (def ^:private ^"[C" prefix-alphabet 180 | (char-array 181 | (map char 182 | (range (int \a) (inc (int \z)))))) 183 | :cljs (def ^:private prefix-alphabet 184 | (apply str (map js/String.fromCharCode 185 | (range (.charCodeAt "a" 0) 186 | (inc (.charCodeAt "z" 0))))))) 187 | 188 | (def ^{:dynamic true 189 | :doc "Thread local counter for a single document"} 190 | *gen-prefix-counter*) 191 | 192 | (defn gen-prefix 193 | "Generates an xml prefix. 194 | Zero-arity can only be called, when *gen-prefix-counter* is bound and will increment it." 195 | ([] (let [c *gen-prefix-counter*] 196 | #?(:cljs (when (undefined? c) 197 | (throw (ex-info "Not bound: *gen-prefix-counter*" {:v #'*gen-prefix-counter*})))) 198 | (set! *gen-prefix-counter* (inc c)) 199 | (gen-prefix c))) 200 | ([n] 201 | (let [cnt (alength prefix-alphabet) 202 | sb #?(:clj (StringBuilder.) :cljs (StringBuffer.))] 203 | (loop [n* n] 204 | (let [ch (mod n* cnt) 205 | n** (quot n* cnt)] 206 | (.append sb (aget prefix-alphabet ch)) 207 | (if (pos? n**) 208 | (recur n**) 209 | (str sb))))))) 210 | 211 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/node.cljc: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.node 10 | "Data types for xml nodes: Element, CData and Comment" 11 | {:author "Herwig Hochleitner"} 12 | (:require [clojure.data.xml.name :refer [as-qname]]) 13 | #?(:clj (:import (clojure.lang IHashEq IObj ILookup IKeywordLookup Counted 14 | Associative Seqable IPersistentMap 15 | APersistentMap RT MapEquivalence MapEntry) 16 | (java.io Serializable Writer) 17 | (java.util Map Iterator)))) 18 | 19 | ;; Parsed data format 20 | ;; Represents a node of an XML tree 21 | 22 | ;; We implement a custom deftype for elements 23 | ;; it is similar to (defrecord Element [tag attrs content]) 24 | ;; but we override its hash and equality to be compatible with 25 | ;; clojure's hash-maps 26 | ;; see https://clojure.atlassian.net/browse/CLJ-2084 27 | ;; also, elements don't have an extmap and degrade to hash-maps also 28 | ;; when assoc'ing unknown keys 29 | 30 | ;; FIXME hash caching cannot be used: https://clojure.atlassian.net/browse/CLJ-2092 31 | 32 | #? 33 | (:clj 34 | (deftype ElementIterator [el ^:volatile-mutable fields] 35 | Iterator 36 | (hasNext [_] (boolean (seq fields))) 37 | (next [_] 38 | (let [f (first fields)] 39 | (set! fields (next fields)) 40 | (MapEntry. f (get el f)))))) 41 | 42 | (deftype Element [tag attrs content meta] 43 | 44 | ;; serializing/cloning, hashing, equality, iteration 45 | 46 | #?@ 47 | (:clj 48 | [Serializable 49 | MapEquivalence 50 | IHashEq 51 | (hasheq [this] (APersistentMap/mapHasheq this)) 52 | Iterable 53 | (iterator [this] (ElementIterator. this '(:tag :attrs :content)))] 54 | :cljs 55 | [ICloneable 56 | (-clone [_] (Element. tag attrs content meta)) 57 | IHash 58 | (-hash [this] (hash-unordered-coll this)) 59 | IEquiv 60 | (-equiv [this other] (or (identical? this other) 61 | ^boolean (js/cljs.core.equiv_map this other))) 62 | IIterable 63 | (-iterator [this] (RecordIter. 0 this 3 [:tag :attrs :content] (nil-iter)))]) 64 | Object 65 | (toString [_] 66 | (let [qname (as-qname tag)] 67 | (apply str (concat ["<" qname] 68 | (mapcat (fn [[n a]] 69 | [" " (as-qname n) "=" (pr-str a)]) 70 | attrs) 71 | (if (seq content) 72 | (concat [">"] content [""]) 73 | ["/>"]))))) 74 | #?@(:clj 75 | [(hashCode [this] (APersistentMap/mapHash this)) 76 | (equals [this other] (APersistentMap/mapEquals this other)) 77 | IPersistentMap 78 | (equiv [this other] (APersistentMap/mapEquals this other))]) 79 | 80 | ;; Main collection interfaces, that are included in IPersistentMap, 81 | ;; but are separate protocols in cljs 82 | 83 | #?(:cljs ILookup) 84 | (#?(:clj valAt :cljs -lookup) [this k] 85 | (#?(:clj .valAt :cljs -lookup) 86 | this k nil)) 87 | (#?(:clj valAt :cljs -lookup) [this k nf] 88 | (case k 89 | :tag tag 90 | :attrs attrs 91 | :content content 92 | nf)) 93 | #?(:cljs ICounted) 94 | (#?(:clj count :cljs -count) [this] 3) 95 | #?(:cljs ICollection) 96 | (#?(:clj cons :cljs -conj) [this entry] 97 | (conj (with-meta {:tag tag :attrs attrs :content content} meta) 98 | entry)) 99 | #?(:cljs IAssociative) 100 | (#?(:clj assoc :cljs -assoc) [this k v] 101 | (case k 102 | :tag (Element. v attrs content meta) 103 | :attrs (Element. tag v content meta) 104 | :content (Element. tag attrs v meta) 105 | (with-meta {:tag tag :attrs attrs :content content k v} meta))) 106 | #?(:cljs IMap) 107 | (#?(:clj without :cljs -dissoc) [this k] 108 | (with-meta 109 | (case k 110 | :tag {:attrs attrs :content content} 111 | :attrs {:tag tag :content content} 112 | :content {:tag tag :attrs attrs} 113 | this) 114 | meta)) 115 | #?@(:cljs 116 | [ISeqable 117 | (-seq [this] 118 | (seq [[:tag tag] [:attrs attrs] [:content content]]))] 119 | :clj 120 | [(seq [this] (iterator-seq (.iterator this)))]) 121 | 122 | #?(:clj (empty [_] (Element. tag {} [] {}))) 123 | #?@(:cljs 124 | [IEmptyableCollection 125 | (-empty [_] (Element. tag {} [] {}))]) 126 | 127 | ;; j.u.Map and included interfaces 128 | #?@(:clj 129 | [Map 130 | (entrySet [this] (set this)) 131 | (values [this] (vals this)) 132 | (keySet [this] (set (keys this))) 133 | (get [this k] (.valAt this k)) 134 | (containsKey [this k] (case k (:tag :attrs :content) true false)) 135 | (containsValue [this v] (boolean (some #{v} (vals this)))) 136 | (isEmpty [this] false) 137 | (size [this] 3)]) 138 | 139 | ;; Metadata interface 140 | 141 | #?(:clj IObj :cljs IMeta) 142 | (#?(:clj meta :cljs -meta) [this] meta) 143 | #?(:cljs IWithMeta) 144 | (#?(:clj withMeta :cljs -with-meta) [this next-meta] 145 | (Element. tag attrs content next-meta)) 146 | 147 | ;; cljs printing is protocol-based 148 | 149 | #?@ 150 | (:cljs 151 | [IPrintWithWriter 152 | (-pr-writer [this writer opts] 153 | (-write writer "#xml/element{:tag ") 154 | (pr-writer tag writer opts) 155 | (when-not (empty? attrs) 156 | (-write writer ", :attrs ") 157 | (pr-writer attrs writer opts)) 158 | (when-not (empty? content) 159 | (-write writer ", :content ") 160 | (pr-sequential-writer writer pr-writer "[" " " "]" opts content)) 161 | (-write writer "}"))])) 162 | 163 | ;; clj printing is a multimethod 164 | 165 | #? 166 | (:clj 167 | (defmethod print-method Element [{:keys [tag attrs content]} ^Writer writer] 168 | (.write writer "#xml/element{:tag ") 169 | (print-method tag writer) 170 | (when-not (empty? attrs) 171 | (.write writer ", :attrs ") 172 | (print-method attrs writer)) 173 | (when-not (empty? content) 174 | (.write writer ", :content [") 175 | (print-method (first content) writer) 176 | (doseq [c (next content)] 177 | (.write writer " ") 178 | (print-method c writer)) 179 | (.write writer "]")) 180 | (.write writer "}"))) 181 | 182 | (defrecord CData [content]) 183 | (defrecord Comment [content]) 184 | 185 | (defn element* 186 | "Create an xml element from a content collection and optional metadata" 187 | ([tag attrs content meta] 188 | (Element. tag (or attrs {}) (remove nil? content) meta)) 189 | ([tag attrs content] 190 | (Element. tag (or attrs {}) (remove nil? content) nil))) 191 | 192 | #?(:clj 193 | ;; Compiler macro for inlining the two constructors 194 | (alter-meta! #'element* assoc :inline 195 | (fn 196 | ([tag attrs content meta] 197 | `(Element. ~tag (or ~attrs {}) (remove nil? ~content) ~meta)) 198 | ([tag attrs content] 199 | `(Element. ~tag (or ~attrs {}) (remove nil? ~content) nil))))) 200 | 201 | (defn element 202 | "Create an xml Element from content varargs" 203 | ([tag] (element* tag nil nil)) 204 | ([tag attrs] (element* tag attrs nil)) 205 | ([tag attrs & content] (element* tag attrs content))) 206 | 207 | (defn cdata 208 | "Create a CData node" 209 | [content] 210 | (CData. content)) 211 | 212 | (defn xml-comment 213 | "Create a Comment node" 214 | [content] 215 | (Comment. content)) 216 | 217 | (defn map->Element [{:keys [tag attrs content] :as el}] 218 | (element* tag attrs content (meta el))) 219 | 220 | (defn tagged-element [el] 221 | (cond (map? el) (map->Element el) 222 | ;; TODO support hiccup syntax 223 | :else (throw (ex-info "Unsupported element representation" 224 | {:element el})))) 225 | 226 | (defn element? [el] 227 | (and (map? el) (some? (:tag el)))) 228 | -------------------------------------------------------------------------------- /src/test/resources/clojure/data/xml/cljs_repl_nashorn.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Rich Hickey. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | ;; cljs repl nashorn update to support the openjdk nashorn package in 10 | ;; JDK versions greater than 15. 11 | ;; 12 | ;; Adapted from 13 | ;; https://raw.githubusercontent.com/clojure/clojurescript/r1.10.439/src/main/clojure/cljs/repl/nashorn.clj. 14 | 15 | (ns clojure.data.xml.cljs-repl-nashorn 16 | (:require [clojure.java.io :as io] 17 | [clojure.string :as string] 18 | [clojure.stacktrace] 19 | [clojure.data.json :as json] 20 | [cljs.analyzer :as ana] 21 | [cljs.env :as env] 22 | [cljs.util :as util] 23 | [cljs.repl :as repl] 24 | [cljs.cli :as cli] 25 | [cljs.compiler :as comp] 26 | [cljs.closure :as closure] 27 | [cljs.stacktrace :as st]) 28 | (:import [javax.script ScriptEngine ScriptEngineManager ScriptException ScriptEngineFactory])) 29 | 30 | (def engine-name 31 | (util/compile-if (Class/forName "org.openjdk.nashorn.api.scripting.NashornException") 32 | (do 33 | (import 'org.openjdk.nashorn.api.scripting.NashornException) 34 | "OpenJDK Nashorn") 35 | (do 36 | (import 'jdk.nashorn.api.scripting.NashornException) 37 | "Oracle Nashorn"))) 38 | 39 | (do 40 | (do 41 | ;; Implementation 42 | 43 | (defn create-engine 44 | ([] (create-engine nil)) 45 | ([{:keys [code-cache] :or {code-cache true}}] 46 | (let [args (when code-cache ["-pcc"]) 47 | factories (.getEngineFactories (ScriptEngineManager.)) 48 | factory (get (zipmap (map #(.getEngineName %) factories) factories) engine-name)] 49 | (if-let [engine (if-not (empty? args) 50 | (.getScriptEngine ^ScriptEngineFactory factory (into-array args)) 51 | (.getScriptEngine ^ScriptEngineFactory factory))] 52 | (let [context (.getContext engine)] 53 | (.setWriter context *out*) 54 | (.setErrorWriter context *err*) 55 | engine) 56 | (throw (IllegalArgumentException. 57 | "Cannot find the Nashorn script engine, use a JDK version 8 or higher.")))))) 58 | 59 | (defn eval-str [^ScriptEngine engine ^String s] 60 | (.eval engine s)) 61 | 62 | (defn eval-resource 63 | "Evaluate a file on the classpath in the engine." 64 | [engine path debug] 65 | (let [r (io/resource path)] 66 | (eval-str engine (slurp r)) 67 | (when debug (println "loaded: " path)))) 68 | 69 | (defn init-engine [engine {:keys [output-dir] :as opts} debug] 70 | (eval-str engine (format "var CLJS_DEBUG = %s;" (boolean debug))) 71 | (eval-str engine (format "var CLJS_OUTPUT_DIR = \"%s\";" output-dir)) 72 | (eval-resource engine "goog/base.js" debug) 73 | (eval-resource engine "goog/deps.js" debug) 74 | (eval-resource engine "cljs/bootstrap_nashorn.js" debug) 75 | (eval-str engine 76 | (format "goog.global.CLOSURE_UNCOMPILED_DEFINES = %s;" 77 | (json/write-str (:closure-defines opts)))) 78 | engine) 79 | 80 | (defn tear-down-engine [engine] 81 | (eval-str engine "nashorn_tear_down();")) 82 | 83 | (defn load-js-file [engine file] 84 | (eval-str engine (format "nashorn_load(\"%s\");" file))) 85 | 86 | ;; Create a minimal build of Clojurescript from the core library. 87 | ;; Copied from clj.cljs.repl.node. 88 | (defn bootstrap-repl [engine output-dir opts] 89 | (env/ensure 90 | (let [deps-file ".nashorn_repl_deps.js" 91 | core (io/resource "cljs/core.cljs") 92 | core-js (closure/compile core 93 | (assoc opts :output-file 94 | (closure/src-file->target-file 95 | core (dissoc opts :output-dir)))) 96 | deps (closure/add-dependencies opts core-js)] 97 | ;; output unoptimized code and the deps file 98 | ;; for all compiled namespaces 99 | (apply closure/output-unoptimized 100 | (assoc opts :output-to (.getPath (io/file output-dir deps-file))) 101 | deps) 102 | ;; load the deps file so we can goog.require cljs.core etc. 103 | (load-js-file engine deps-file)))) 104 | 105 | (defn load-ns [engine ns] 106 | (eval-str engine 107 | (format "goog.require(\"%s\");" (comp/munge (first ns))))) 108 | 109 | ;; Nashorn script stacktraces have a relative path which includes the output-dir 110 | (defn- strip-file-name [^String file-name output-dir] 111 | (let [with-slash (str output-dir "/")] 112 | (if (.startsWith file-name with-slash) 113 | (string/replace-first file-name with-slash "") 114 | file-name))) 115 | 116 | (def repl-filename "") 117 | 118 | (defrecord NashornEnv [engine debug] 119 | repl/IReplEnvOptions 120 | (-repl-options [this] 121 | {:output-dir ".cljs_nashorn_repl" 122 | :target :nashorn}) 123 | repl/IJavaScriptEnv 124 | (-setup [this {:keys [output-dir bootstrap output-to] :as opts}] 125 | (init-engine engine opts debug) 126 | (let [env (ana/empty-env)] 127 | (if output-to 128 | (load-js-file engine output-to) 129 | (bootstrap-repl engine output-dir opts)) 130 | (repl/evaluate-form this env repl-filename 131 | '(.require js/goog "cljs.core")) 132 | ;; monkey-patch goog.isProvided_ to suppress useless errors 133 | (repl/evaluate-form this env repl-filename 134 | '(set! js/goog.isProvided_ (fn [ns] false))) 135 | ;; monkey-patch goog.require to be more sensible 136 | (repl/evaluate-form this env repl-filename 137 | '(do 138 | (set! *loaded-libs* #{"cljs.core"}) 139 | (set! (.-require js/goog) 140 | (fn [name reload] 141 | (when (or (not (contains? *loaded-libs* name)) reload) 142 | (set! *loaded-libs* (conj (or *loaded-libs* #{}) name)) 143 | (js/CLOSURE_IMPORT_SCRIPT 144 | (if (some? goog/debugLoader_) 145 | (.getPathFromDeps_ goog/debugLoader_ name) 146 | (goog.object/get (.. js/goog -dependencies_ -nameToPath) name)))))))))) 147 | (-evaluate [{engine :engine :as this} filename line js] 148 | (when debug (println "Evaluating: " js)) 149 | (try 150 | {:status :success 151 | :value (if-let [r (eval-str engine js)] (.toString r) "")} 152 | (catch ScriptException e 153 | (let [^Throwable root-cause (clojure.stacktrace/root-cause e)] 154 | {:status :exception 155 | :value (.getMessage root-cause) 156 | :stacktrace (NashornException/getScriptStackString root-cause)})) 157 | (catch Throwable e 158 | (let [^Throwable root-cause (clojure.stacktrace/root-cause e)] 159 | {:status :exception 160 | :value (.getMessage root-cause) 161 | :stacktrace 162 | (apply str 163 | (interpose "\n" 164 | (map str 165 | (.getStackTrace root-cause))))})))) 166 | (-load [{engine :engine :as this} ns url] 167 | (load-ns engine ns)) 168 | (-tear-down [this] 169 | (tear-down-engine engine)) 170 | repl/IParseStacktrace 171 | (-parse-stacktrace [this frames-str ret opts] 172 | (st/parse-stacktrace this frames-str 173 | (assoc ret :ua-product :nashorn) opts)) 174 | repl/IParseError 175 | (-parse-error [_ err _] 176 | (update-in err [:stacktrace] 177 | (fn [st] 178 | (string/join "\n" (drop 1 (string/split st #"\n"))))))) 179 | 180 | (defn repl-env* [{:keys [debug] :as opts}] 181 | (let [engine (create-engine opts)] 182 | (merge 183 | (NashornEnv. engine debug) 184 | opts))) 185 | 186 | (defn repl-env 187 | "Create a Nashorn repl-env for use with the repl/repl* method in Clojurescript." 188 | [& {:as opts}] 189 | (repl-env* opts)) 190 | 191 | ;; ------------------------------------------------------------------------- 192 | ;; Command Line Support 193 | 194 | (defn -main [& args] 195 | (apply cli/main repl-env args))) 196 | 197 | ) 198 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/jvm/emit.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.jvm.emit 10 | "JVM implementation of the emitter details" 11 | {:author "Herwig Hochleitner"} 12 | (:require (clojure.data.xml 13 | [name :refer [qname-uri qname-local separate-xmlns gen-prefix *gen-prefix-counter*]] 14 | [pu-map :as pu] 15 | [protocols :refer [AsXmlString xml-str]] 16 | [impl :refer [extend-protocol-fns b64-encode compile-if]] 17 | event) 18 | [clojure.string :as str]) 19 | (:import (java.io OutputStreamWriter Writer StringWriter) 20 | (java.nio.charset Charset) 21 | (java.util.logging Logger Level) 22 | (javax.xml.namespace NamespaceContext QName) 23 | (javax.xml.stream XMLStreamWriter XMLOutputFactory) 24 | (javax.xml.transform OutputKeys Transformer 25 | TransformerFactory) 26 | (clojure.data.xml.event StartElementEvent EmptyElementEvent EndElementEvent CharsEvent CDataEvent CommentEvent QNameEvent) 27 | (clojure.lang BigInt) 28 | (java.net URI URL) 29 | (java.util Date) 30 | (java.text DateFormat SimpleDateFormat))) 31 | 32 | (def logger (Logger/getLogger "clojure.data.xml")) 33 | 34 | (defprotocol EventEmit 35 | (emit-event [event ^XMLStreamWriter writer prefix-uri-stack])) 36 | 37 | (defn check-stream-encoding [^OutputStreamWriter stream xml-encoding] 38 | (when (not= (Charset/forName xml-encoding) (Charset/forName (.getEncoding stream))) 39 | (throw (ex-info (str "Output encoding of writer (" (.getEncoding stream) 40 | ") doesn't match declaration (" 41 | xml-encoding ")") 42 | {:stream-encoding (.getEncoding stream) 43 | :declared-encoding xml-encoding})))) 44 | 45 | (defn- prefix-for [qn pu] 46 | (or (pu/get-prefix pu (qname-uri qn)) 47 | (throw (ex-info "Auto-generating prefixes is not supported for content-qnames. Please declare all URIs used in content qnames." 48 | {:qname qn 49 | :uri (qname-uri qn)})))) 50 | 51 | (defn- attr-str [value pu] 52 | (if (or (keyword? value) (instance? QName value)) 53 | (str (prefix-for value pu) ":" (qname-local value)) 54 | (xml-str value))) 55 | 56 | (defn- emit-attrs [^XMLStreamWriter writer pu attrs] 57 | (reduce-kv 58 | (fn [_ attr value] 59 | (let [uri (qname-uri attr) 60 | local (qname-local attr)] 61 | (if (str/blank? uri) 62 | (.writeAttribute writer local (attr-str value pu)) 63 | (.writeAttribute writer (pu/get-prefix pu uri) uri local (attr-str value pu)))) 64 | _) 65 | nil attrs)) 66 | 67 | (defn- emit-ns-attrs [^XMLStreamWriter writer parent-pu pu] 68 | (pu/reduce-diff 69 | (fn [_ pf uri] 70 | (if (str/blank? pf) 71 | (.writeDefaultNamespace writer uri) 72 | (.writeNamespace writer pf uri)) 73 | _) 74 | nil parent-pu pu)) 75 | 76 | (defn- compute-prefix [tpu uri suggested] 77 | (or (pu/get-prefix tpu uri) 78 | (loop [prefix (or suggested (gen-prefix))] 79 | (if (pu/get tpu prefix) 80 | (recur (gen-prefix)) 81 | prefix)))) 82 | 83 | (defn- compute-pu [pu elem-pu attr-uris tag-uri tag-local] 84 | (let [tpu (pu/transient pu) 85 | ;; add namespaces from current environment 86 | tpu (reduce-kv (fn [tpu ns-attr uri] 87 | (assert (string? ns-attr) (pr-str ns-attr uri)) 88 | (pu/assoc! tpu 89 | (compute-prefix tpu uri ns-attr) 90 | uri)) 91 | tpu (pu/prefix-map elem-pu)) 92 | ;; add implicit namespaces used by tag, attrs 93 | tpu (reduce (fn [tpu uri] 94 | (pu/assoc! tpu (compute-prefix tpu uri nil) uri)) 95 | tpu (if (str/blank? tag-uri) 96 | attr-uris 97 | (cons tag-uri attr-uris))) 98 | ;; rename default namespace, if tag is global (not in a namespace) 99 | tpu (if-let [uri (and (str/blank? tag-uri) 100 | (pu/get tpu ""))] 101 | (do 102 | (when (.isLoggable ^Logger logger Level/FINE) 103 | (.log ^Logger logger Level/FINE 104 | (format "Default `xmlns=\"%s\"` had to be replaced with a `xmlns=\"\"` because of global element `%s`" 105 | uri tag-local))) 106 | (-> tpu 107 | (pu/assoc! "" "") 108 | (as-> tpu (pu/assoc! tpu (compute-prefix tpu uri nil) uri)))) 109 | tpu)] 110 | (pu/persistent! tpu))) 111 | 112 | (defn- emit-start-tag [{:keys [attrs nss tag]} ^XMLStreamWriter writer prefix-uri-stack empty] 113 | (let [uri (qname-uri tag) 114 | local (qname-local tag) 115 | parent-pu (first prefix-uri-stack) 116 | pu (compute-pu parent-pu nss (map qname-uri (keys attrs)) uri local)] 117 | (if empty 118 | (do (if (str/blank? uri) 119 | (.writeEmptyElement writer local) 120 | (.writeEmptyElement writer (pu/get-prefix pu uri) local uri)) 121 | (emit-ns-attrs writer parent-pu pu) 122 | (emit-attrs writer pu attrs) 123 | prefix-uri-stack) 124 | (do (if (str/blank? uri) 125 | (.writeStartElement writer local) 126 | (.writeStartElement writer (pu/get-prefix pu uri) local uri)) 127 | (emit-ns-attrs writer parent-pu pu) 128 | (emit-attrs writer pu attrs) 129 | (cons pu prefix-uri-stack))))) 130 | 131 | (defn- emit-cdata [^String cdata-str ^XMLStreamWriter writer] 132 | (when-not (str/blank? cdata-str) 133 | (let [idx (.indexOf cdata-str "]]>")] 134 | (if (= idx -1) 135 | (.writeCData writer cdata-str ) 136 | (do 137 | (.writeCData writer (subs cdata-str 0 (+ idx 2))) 138 | (recur (subs cdata-str (+ idx 2)) writer)))))) 139 | 140 | (extend-protocol EventEmit 141 | StartElementEvent 142 | (emit-event [ev writer pu-stack] (emit-start-tag ev writer pu-stack false)) 143 | EmptyElementEvent 144 | (emit-event [ev writer pu-stack] (emit-start-tag ev writer pu-stack true)) 145 | EndElementEvent 146 | (emit-event [ev writer pu-stack] 147 | (assert (next pu-stack) "balanced tags") 148 | (.writeEndElement ^XMLStreamWriter writer) 149 | (next pu-stack)) 150 | CharsEvent 151 | (emit-event [{:keys [str]} writer s] (.writeCharacters ^XMLStreamWriter writer str) s) 152 | CDataEvent 153 | (emit-event [{:keys [str]} writer s] (emit-cdata str writer) s) 154 | CommentEvent 155 | (emit-event [{:keys [str]} writer s] (.writeComment ^XMLStreamWriter writer str) s) 156 | QNameEvent 157 | (emit-event [{:keys [qn]} ^XMLStreamWriter writer pu-stack] 158 | (.writeCharacters writer (prefix-for qn (first pu-stack))) 159 | (.writeCharacters writer ":") 160 | (.writeCharacters writer (qname-local qn)) 161 | pu-stack)) 162 | 163 | (def ^:private ^ThreadLocal thread-local-utc-date-format 164 | ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access. 165 | ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335 166 | (proxy [ThreadLocal] [] 167 | (initialValue [] 168 | (doto (SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00") 169 | ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT) 170 | (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))))) 171 | 172 | (extend-protocol-fns 173 | AsXmlString 174 | String {:xml-str identity} 175 | (Boolean Byte Character Short Integer Long Float Double 176 | BigInteger BigDecimal BigInt URI URL nil) {:xml-str str}) 177 | 178 | (extend-protocol AsXmlString 179 | (Class/forName "[B") 180 | (xml-str [ba] (b64-encode ba)) 181 | Date 182 | (xml-str [d] (let [^DateFormat utc-format (.get thread-local-utc-date-format)] 183 | (.format utc-format d))) 184 | clojure.lang.Ratio 185 | (xml-str [r] (str (.decimalValue r)))) 186 | 187 | (compile-if 188 | (Class/forName "java.time.Instant") 189 | (extend-protocol AsXmlString 190 | java.time.Instant 191 | (xml-str [i] (xml-str (Date/from i)))) 192 | nil) 193 | 194 | ;; Writers 195 | 196 | (defn write-document 197 | "Writes the given event seq as XML text to writer. 198 | Options: 199 | :encoding Character encoding to use 200 | :doctype Document type (DOCTYPE) declaration to use" 201 | [^Writer swriter events opts] 202 | (binding [*gen-prefix-counter* 0] 203 | (let [^XMLStreamWriter writer (-> (XMLOutputFactory/newInstance) 204 | (.createXMLStreamWriter swriter))] 205 | 206 | (when (instance? OutputStreamWriter swriter) 207 | (check-stream-encoding swriter (or (:encoding opts) "UTF-8"))) 208 | 209 | (.writeStartDocument writer (or (:encoding opts) "UTF-8") "1.0") 210 | (when-let [doctype (:doctype opts)] 211 | (.writeDTD writer doctype)) 212 | (reduce #(emit-event %2 writer %1) [pu/EMPTY] events) 213 | (.writeEndDocument writer) 214 | swriter))) 215 | 216 | (defn string-writer [] 217 | (StringWriter.)) 218 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/data/xml/js/dom.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey and contributors. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.data.xml.js.dom 10 | (:require 11 | [clojure.data.xml.name :refer [qname-uri qname-local qname xmlns-uri]] 12 | [clojure.data.xml.node :as node])) 13 | 14 | (def doc 15 | (.. (js/DOMParser.) 16 | (parseFromString "" "text/xml"))) 17 | 18 | (defn text-node 19 | "Create a Text node" 20 | [s] 21 | (.createTextNode doc s)) 22 | 23 | (defn element* 24 | "Create an xml element from a content collection and optional metadata" 25 | ([tag attrs content meta] 26 | (let [el (element* tag attrs content)] 27 | (specify! el 28 | IMeta 29 | (-meta [_] meta) 30 | IWithMeta 31 | (-with-meta [_ meta] 32 | (specify el 33 | IMeta 34 | (-meta [_] meta) 35 | IWithMeta 36 | (-with-meta [_ meta] 37 | (-with-meta el meta))))) 38 | el)) 39 | ([tag attrs content] 40 | (let [el (.createElementNS doc (qname-uri tag) (qname-local tag))] 41 | (reduce-kv (fn [_ k v] 42 | (let [uri (qname-uri k)] 43 | (if (= uri "http://www.w3.org/2000/xmlns/") 44 | (.setAttribute el (str "xmlns:" (qname-local k)) v) 45 | (.setAttributeNS el uri (qname-local k) v)))) 46 | nil attrs) 47 | (reduce (fn [_ n] 48 | (.appendChild el (if (string? n) 49 | (text-node n) 50 | n))) 51 | nil content) 52 | el))) 53 | 54 | (defn element 55 | "Create an xml Element from content varargs" 56 | ([tag] (element* tag nil nil)) 57 | ([tag attrs] (element* tag attrs nil)) 58 | ([tag attrs & content] (element* tag attrs content))) 59 | 60 | (defn cdata 61 | "Create a CData node" 62 | [content] 63 | (.createCDATASection doc content)) 64 | 65 | (defn xml-comment 66 | "Create a Comment node" 67 | [content] 68 | (.createComment doc content)) 69 | 70 | (declare element-node) 71 | 72 | (defn node-list 73 | "Create a NodeList" 74 | [elements] 75 | (let [f (.createDocumentFragment doc)] 76 | (doseq [el elements] 77 | (.appendChild f (element-node el))) 78 | (.-childNodes f))) 79 | 80 | ;; ## Types 81 | 82 | ;; we get these from reflection, to only depend only on js/DOMParser and js/XMLSerializer 83 | ;; these can easily be provided in nashorn, ... 84 | 85 | (def Text (type (text-node ""))) 86 | (def Element (type (element :e))) 87 | (def NamedNodeMap (type (.-attributes (element :e)))) 88 | (def NodeList (type (node-list []))) 89 | (def Attr (type (aget (.-attributes (element :e {:a "1"})) 0))) 90 | (def CData (type (cdata ""))) 91 | (def Comment (type (xml-comment ""))) 92 | 93 | ;; ## Coercions 94 | 95 | ;; ## -> DOM 96 | 97 | (defn element-node 98 | "Coerce xml elements to dom nodes" 99 | [el] 100 | (cond 101 | (string? el) (text-node el) 102 | (instance? node/CData el) (cdata (:content el)) 103 | (instance? node/Comment el) (xml-comment (:content el)) 104 | (instance? Element el) el 105 | (instance? CData el) el 106 | (instance? Comment el) el 107 | ;; stupid xmldom, (some? (.-item el)) 108 | #_(instance? NodeList el) 109 | (some? (.-item el)) el 110 | (instance? Text el) el 111 | (satisfies? ILookup el) (element* (:tag el) 112 | (:attrs el) 113 | (map element-node (:content el))) 114 | (satisfies? ISequential el) (node-list el) 115 | :else (throw (ex-info "Cannot coerce" {:form el})))) 116 | 117 | ;; ## -> DATA 118 | 119 | (defn- dom-element-tag [el] 120 | (qname (.-namespaceURI el) 121 | (.-localName el))) 122 | 123 | (defn- xmlns-attr? [a] 124 | (identical? xmlns-uri (.-namespaceURI a))) 125 | (def remove-xmlns-attrs-xf (remove xmlns-attr?)) 126 | (def remove-xmlns-attrs (partial into {} remove-xmlns-attrs-xf)) 127 | (def filter-xmlns-attrs-xf (filter xmlns-attr?)) 128 | (def filter-xmlns-attrs (partial into {} filter-xmlns-attrs-xf)) 129 | 130 | (defn dom-element-attrs 131 | ([el] (dom-element-attrs remove-xmlns-attrs-xf el)) 132 | ([xf el] 133 | (transduce 134 | xf 135 | (completing 136 | (fn [ta attr-node] 137 | (assoc! ta 138 | (dom-element-tag attr-node) 139 | (.-value attr-node))) 140 | persistent!) 141 | (transient {}) 142 | (array-seq el)))) 143 | 144 | (declare element-data) 145 | 146 | (defn- node-list-vec [nl] 147 | (into [] (map element-data) (array-seq nl))) 148 | 149 | (defn- as-node [n] 150 | (if (instance? Text n) 151 | (.-nodeValue n) ;; .-data 152 | n)) 153 | 154 | (defn element-data 155 | "Coerce xml elements to element maps / content vectors" 156 | [el] 157 | (cond 158 | (instance? Comment el) 159 | (node/xml-comment (.-data el)) 160 | (instance? CData el) 161 | (node/cdata (.-data el)) 162 | (instance? Text el) 163 | (.-nodeValue el) 164 | (instance? Element el) 165 | (node/element* (dom-element-tag el) 166 | (dom-element-attrs (.-attributes el)) 167 | (node-list-vec (.-childNodes el)) 168 | {:clojure.data.xml/nss (dom-element-attrs 169 | filter-xmlns-attrs-xf 170 | (.-attributes el))}) 171 | ;;(instance? NamedNodeMap el) 172 | (.-getNamedItemNS el) 173 | (dom-element-attrs el) 174 | (instance? NodeList el) (node-list-vec el) 175 | (string? el) el 176 | (satisfies? ILookup el) el 177 | (satisfies? ISequential el) el 178 | :else (throw (ex-info "Element cannot be converted to data" {:element el})))) 179 | 180 | (defn extend-dom-as-data! [] 181 | (extend-type Element 182 | IMap 183 | IMeta 184 | (-meta [el] 185 | {:clojure.data.xml/nss (filter-xmlns-attrs 186 | (.-attributes el))}) 187 | ILookup 188 | (-lookup 189 | ([el k] 190 | (case k 191 | :tag (dom-element-tag el) 192 | :attrs (.-attributes el) 193 | :content (.-childNodes el) 194 | (throw (ex-info "XML tag has no key" {:key k :el el})))) 195 | ([el k nf] 196 | #_(println "Element" k "=>" (case k 197 | :tag (dom-element-tag el) 198 | :attrs (.-attributes el) 199 | :content (.-childNodes el) 200 | nf)) 201 | (case k 202 | :tag (dom-element-tag el) 203 | :attrs (remove-xmlns-attrs (.-attributes el)) 204 | :content (.-childNodes el) 205 | nf))) 206 | ICounted 207 | (-count [nm] 3) 208 | IEquiv 209 | (-equiv [el0 el1] 210 | (if false #_(instance? Element el1) 211 | (do 212 | ;; we can't use .isEqualNode, since that has bugs with namespaces 213 | (.log js/console el0 el1) 214 | (println 'isEqualNode (.isEqualNode el0 el1)) 215 | (.isEqualNode el0 el1)) 216 | (and (= (:tag el0) (:tag el1)) 217 | (= (:attrs el0) (:attrs el1)) 218 | (= (:content el0) (:content el1)))))) 219 | (extend-type NamedNodeMap 220 | IMap 221 | ISeqable 222 | (-seq [nm] (array-seq nm)) 223 | ILookup 224 | (-lookup 225 | ([attrs attr] 226 | (if-let [i (.getNamedItemNS attrs (qname-uri attr) (qname-local attr))] 227 | (.-value i) 228 | nil)) 229 | ([attrs attr not-found] 230 | #_(println "Attrs" attr "=>" (if-let [i (.getNamedItemNS attrs (qname-uri attr) (qname-local attr))] 231 | (.-value i) 232 | not-found)) 233 | (if-let [i (.getNamedItemNS attrs (qname-uri attr) (qname-local attr))] 234 | (.-value i) 235 | not-found))) 236 | ICounted 237 | (-count [nm] (reduce (fn [acc attr] 238 | (if (xmlns-attr? attr) 239 | acc 240 | (inc acc))) 241 | 0 nm)) 242 | IKVReduce 243 | (-kv-reduce [nm f init] 244 | (reduce (fn [acc attr] 245 | (if (xmlns-attr? attr) 246 | acc 247 | (f acc (dom-element-tag attr) (.-value attr)))) 248 | init nm)) 249 | IEquiv 250 | (-equiv [nm0 nm1] 251 | #_(println "NamedNodeMap.-equiv" (identical? nm0 nm1) (count nm0) (count nm1)) 252 | (or (identical? nm0 nm1) 253 | (and (identical? (count nm0) (count nm1)) 254 | (reduce-kv (fn [_ qn v] 255 | #_(println "=" v 'qn qn '(get nm1 qn "") (get nm1 qn "")) 256 | (or (identical? v (get nm1 qn "")) 257 | (reduced false))) 258 | true nm0))))) 259 | (extend-type NodeList 260 | ;specify! (.. (node-list []) -constructor -prototype) 261 | ISeqable 262 | (-seq [nl] (seq (map as-node (array-seq nl)))) 263 | ISequential 264 | ICounted 265 | (-count [nl] (alength nl)) 266 | IIndexed 267 | (-nth 268 | ([nl n] 269 | (as-node (aget nl n))) 270 | ([nl n nf] 271 | (if (and (<= 0 n) (< n (alength nl))) 272 | (as-node (aget nl n)) 273 | nf))) 274 | IEquiv 275 | (-equiv [nl0 nl1] 276 | #_(println "NodeList.-equiv") 277 | (or (identical? nl0 nl1) 278 | (and (identical? (count nl0) (count nl1)) 279 | (reduce (fn [_ n] 280 | (or (= (nth nl0 n) (nth nl1 n)) 281 | (reduced false))) 282 | true (range (count nl0))))))) 283 | (extend-type Text 284 | IEquiv 285 | (-equiv [t0 t1] 286 | (identical? (.-nodeValue t0) 287 | (if (instance? Text t1) 288 | (.-nodeValue t1) 289 | t1)))) 290 | (extend-type Attr 291 | ISeqable 292 | (-seq [attr] (array-seq #js[(key attr) (key attr)])) 293 | IMapEntry 294 | (-key [attr] (dom-element-tag attr)) 295 | (-val [attr] (.-value attr)) 296 | ISequential 297 | ICounted 298 | (-count [_] 2) 299 | IIndexed 300 | (-nth 301 | ([attr n] (case n 302 | 0 (key attr) 303 | 1 (val attr))) 304 | ([attr n nf] 305 | (case n 306 | 0 (dom-element-tag attr) 307 | 1 (.-value attr) 308 | nf)))) 309 | {'Text Text 310 | 'Element Element 311 | 'NamedNodeMap NamedNodeMap 312 | 'NodeList NodeList}) 313 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | 206 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/data/xml/test_emit.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Tests for emit to print XML text." 10 | :author "Chris Houser"} 11 | clojure.data.xml.test-emit 12 | (:require 13 | [clojure.string :as str] 14 | [clojure.test :refer :all] 15 | [clojure.data.xml :refer :all] 16 | [clojure.data.xml.test-utils :refer [test-stream lazy-parse*]] 17 | [clojure.data.xml.impl :refer [compile-if]] 18 | [clojure.data.xml.name :as name] 19 | [clojure.data.xml.pu-map :as pu]) 20 | (:import (javax.xml.namespace QName))) 21 | 22 | (def deep-tree 23 | (lazy-parse* (str "" 24 | " t1t2" 25 | " t3t4" 26 | " t5t6" 27 | " t7" 28 | " t8t10t11" 29 | " t12t13t14" 30 | ""))) 31 | 32 | (deftest test-defaults 33 | (testing "basic parsing" 34 | (let [expect (str "" 35 | "" 36 | " t1t2" 37 | " t3t4" 38 | " t5t6" 39 | " t7" 40 | " t8t10t11" 41 | " t12t13t14" 42 | "")] 43 | (is (= expect (emit-str deep-tree))))) 44 | 45 | (testing "namespaced defaults" 46 | (let [expect (str "done")] 47 | (is (= expect (emit-str 48 | (element "{DAV:}bar" {"{DAV:}item" 1 :xmlns/D "DAV:"} 49 | [(element "{DAV:}baz" {:xmlns.DAV%3A/item 2} "done")])))) 50 | (is (= expect (emit-str 51 | {:tag "{DAV:}bar" :attrs {"{DAV:}item" 1 :xmlns/D "DAV:"} 52 | :content [{:tag "{DAV:}baz" :attrs {:xmlns.DAV%3A/item 2} :content "done"}]})))))) 53 | 54 | (deftest mixed-quotes 55 | (is (= (lazy-parse* 56 | (str "" 57 | "")) 59 | (lazy-parse* 60 | (emit-str (element :mixed 61 | {:single "'single'quotes'here" 62 | :double "\"double\"quotes\"here\""})))))) 63 | 64 | (defn emit-char-seq [xml-tree encoding] 65 | (with-open [bos (java.io.ByteArrayOutputStream.) 66 | stream (java.io.OutputStreamWriter. bos encoding)] 67 | (emit xml-tree stream :encoding encoding) 68 | (.flush stream) 69 | (map #(if (pos? %) (char %) %) (.toByteArray bos)))) 70 | 71 | (deftest encoding 72 | (let [input-tree 73 | (lazy-parse* "Übercool")] 74 | (is (= (concat "" 75 | "" [-61 -100] "bercool") 76 | (emit-char-seq input-tree "UTF-8"))) 77 | (is (= (concat "" 78 | "" [-36] "bercool") 79 | (emit-char-seq input-tree "ISO-8859-1"))))) 80 | 81 | (deftest encoding-assertion 82 | (is (thrown? Exception 83 | (let [stream (java.io.ByteArrayOutputStream.)] 84 | (binding [*out* (java.io.OutputStreamWriter. stream "UTF-8")] 85 | (emit (element :foo) *out* :encoding "ISO-8859-1")))))) 86 | 87 | (deftest doctype 88 | (let [input-tree 89 | (lazy-parse* "cool") 90 | doctype-html "" 91 | doctype-html-401-transitional 92 | "" 93 | doctype-xhtml-10-strict 94 | ""] 95 | (is (= (str "" 96 | doctype-html 97 | "cool") 98 | (emit-str input-tree :doctype doctype-html))) 99 | (is (= (str "" 100 | doctype-html-401-transitional 101 | "cool") 102 | (emit-str input-tree :doctype doctype-html-401-transitional))) 103 | (is (= (str "" 104 | doctype-xhtml-10-strict 105 | "cool") 106 | (emit-str input-tree :doctype doctype-xhtml-10-strict))))) 107 | 108 | (deftest emitting-cdata 109 | (testing "basic cdata" 110 | (is (= (str "" 111 | "]]>") 112 | (emit-str (element :cdata-stuff {} 113 | (cdata "")))))) 114 | (testing "cdata with ]]> chars" 115 | (is (= (str "" 116 | "]]]]>]]>") 117 | (emit-str (element :cdata-stuff {} 118 | (cdata "]]>")))))) 119 | (testing "cdata with ]]> chars and newlines" 120 | (is (= (str "" 121 | "\n\n\n]]]]>]]>") 122 | (emit-str (element :cdata-stuff {} 123 | (cdata "\n\n\n]]>"))))))) 124 | 125 | (deftest emitting-cdata-with-embedded-end 126 | (is (= (str "" 127 | "]]]]>]]>") 128 | (emit-str (element :cdata-stuff {} 129 | (cdata "]]>"))))) ) 130 | 131 | (deftest emitting-comment 132 | (is (= (str "" 133 | "comment not here") 134 | (emit-str (element :comment-stuff {} 135 | "comment " 136 | (xml-comment " goes here ") 137 | " not here"))))) 138 | 139 | (deftest test-indent 140 | (let [nested-xml (lazy-parse* (str "foo")) 141 | expect (-> "\n \n \n foo\n \n \n\n" 142 | (str/replace #"\n" (System/lineSeparator))) 143 | sw (java.io.StringWriter.) 144 | _ (indent nested-xml sw) 145 | result (.toString sw)] 146 | (is (= expect 147 | (subs result (.indexOf result "")))))) 148 | 149 | (deftest test-indent-str 150 | (let [nested-xml (lazy-parse* (str "foo")) 151 | expect (-> "\n \n \n foo\n \n \n\n" 152 | (str/replace #"\n" (System/lineSeparator))) 153 | result (indent-str nested-xml)] 154 | (is (= expect (subs result (.indexOf result "")))))) 155 | 156 | (deftest test-indent-str-with-doctype 157 | (let [nested-xml (lazy-parse* (str "foo")) 158 | doctype "" 159 | expect (-> "\n\n \n \n foo\n \n \n\n" 160 | (str/replace #"\n" (System/lineSeparator))) 161 | result (indent-str nested-xml :doctype doctype) 162 | offset-dt (.indexOf result "" offset-dt))] 164 | (is (= expect (subs result offset-res))))) 165 | 166 | (defmacro are-serializable [group-description extra-attrs & {:as data-strings}] 167 | `(testing ~group-description 168 | (testing "in content" 169 | ~@(for [[data string] data-strings] 170 | `(is (= (parse-str (emit-str (element :e ~extra-attrs ~string))) 171 | (parse-str (emit-str (element :e ~extra-attrs ~data))))))) 172 | (testing "in attrs" 173 | ~@(for [[data string] data-strings] 174 | `(is (= (emit-str (element :e ~(assoc extra-attrs :a string))) 175 | (emit-str (element :e ~(assoc extra-attrs :a data))))))))) 176 | 177 | (deftest test-datatypes 178 | ;; https://www.w3.org/TR/xmlschema-2/#built-in-datatypes 179 | (testing "serializing" 180 | (are-serializable 181 | "booleans" {} 182 | true "true" 183 | false "false") 184 | (are-serializable 185 | "numbers" {} 186 | 1 "1" 187 | 1.2 "1.2" 188 | 3/4 "0.75" 189 | (int 0) "0" 190 | (float 1.4) "1.4" 191 | 1.25M "1.25" 192 | (BigInteger. "42424242424242424242424242424242") "42424242424242424242424242424242" 193 | 42424242424242424242424242424242 "42424242424242424242424242424242") 194 | (are-serializable 195 | "byte-arrays" {} 196 | (byte-array [0 1 2 3 4]) "AAECAwQ=") 197 | (are-serializable 198 | "uris" {} 199 | (java.net.URI. "S:l") "S:l" 200 | (java.net.URL. "http://foo") "http://foo") 201 | (are-serializable 202 | "dates" {} 203 | (java.util.Date. 0) "1970-01-01T00:00:00.000-00:00") 204 | (compile-if 205 | (Class/forName "java.time.Instant") 206 | (are-serializable 207 | "instants" {} 208 | (java.time.Instant/ofEpochMilli 0) "1970-01-01T00:00:00.000-00:00") 209 | nil) 210 | (are-serializable 211 | "qnames" {:xmlns/p "U:"} 212 | :xmlns.U%3A/qn "p:qn" 213 | (QName. "U:" "qn") "p:qn") 214 | (testing "qnames generated" 215 | (is (thrown? Exception (emit-str (element :e {} :xmlns.U%3A/qn)))) 216 | (is (thrown? Exception (emit-str (element :e {:a :xmlns.U%3A/qn})))) 217 | (is (thrown? Exception (emit-str (element :e {} (QName. "U:" "qn"))))) 218 | (is (thrown? Exception (emit-str (element :e {:a (QName. "U:" "qn")}))))))) 219 | 220 | (deftest test-event-seq-emit 221 | (is (= "123" 222 | (emit-str (event-seq (java.io.StringReader. "123") {}))))) 223 | 224 | (deftest test-sibling-xmlns 225 | (let [el (element (as-qname "{NS1}top") {} 226 | (element (as-qname "{NS2}foo")) 227 | (element (as-qname "{NS2}bar")))] 228 | (is (= (parse-str (emit-str el)) el)))) 229 | 230 | (alias-uri :xml name/xml-uri) 231 | 232 | (deftest test-default-xmlns 233 | (let [nss-meta (comp :clojure.data.xml/nss meta)] 234 | (is (= (pu/merge-prefix-map nil {"" "NS"}) 235 | (nss-meta (parse-str "")) 236 | (nss-meta (parse-str (emit-str (parse-str ""))))))) 237 | (is (thrown? Exception (emit-str {:tag :el :attrs {(name/qname name/xmlns-uri "xml") "foo"}}))) 238 | (is (thrown? Exception (emit-str {:tag :el :attrs {(name/qname name/xmlns-uri "xmlns") "foo"}}))) 239 | (is (thrown? Exception (emit-str {:tag :el :attrs {:xmlns/xml "foo"}}))) 240 | (is (thrown? Exception (emit-str {:tag :el :attrs {:xmlns/xmlns "foo"}}))) 241 | (is (thrown? Exception (parse-str "")) 242 | "TODO: find out if this is standard conforming, or a bug in StAX") 243 | (is (= (emit-str {:tag :el :attrs {:xmlns/xmlns "http://www.w3.org/2000/xmlns/"}}) 244 | "")) 245 | (is (= (emit-str {:tag :el :attrs {:xmlns/xml "http://www.w3.org/XML/1998/namespace" ::xml/lang "en"}}) 246 | "")) 247 | (is (= (emit-str {:tag :el :attrs {:xml/lang "en"}}) 248 | ""))) 249 | 250 | (deftest test-empty-elements 251 | (is (= (emit-str {:tag :a :content []}) "")) 252 | (is (= (emit-str {:tag :a :content [""]}) ""))) 253 | 254 | (deftest test-roundtrip 255 | (is (= (emit-str (with-meta (parse-str "") 256 | nil)) 257 | "")) 258 | (is (= (emit-str (parse-str "")) 259 | "")) 260 | (is (= (emit-str (parse-str "")) 261 | "")) 262 | ; builtins 263 | (is (= (emit-str (parse-str "")) 264 | "")) 265 | (is (thrown? Exception (parse-str "")) 266 | "TODO: find out if this is standard conforming, or a bug in StAX")) 267 | -------------------------------------------------------------------------------- /epl-v10.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Eclipse Public License - Version 1.0 8 | 25 | 26 | 27 | 28 | 29 | 30 |

Eclipse Public License - v 1.0

31 | 32 |

THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.

36 | 37 |

1. DEFINITIONS

38 | 39 |

"Contribution" means:

40 | 41 |

a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and

43 |

b) in the case of each subsequent Contributor:

44 |

i) changes to the Program, and

45 |

ii) additions to the Program;

46 |

where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.

54 | 55 |

"Contributor" means any person or entity that distributes 56 | the Program.

57 | 58 |

"Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.

61 | 62 |

"Program" means the Contributions distributed in accordance 63 | with this Agreement.

64 | 65 |

"Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.

67 | 68 |

2. GRANT OF RIGHTS

69 | 70 |

a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.

76 | 77 |

b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.

88 | 89 |

c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.

101 | 102 |

d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.

105 | 106 |

3. REQUIREMENTS

107 | 108 |

A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:

110 | 111 |

a) it complies with the terms and conditions of this 112 | Agreement; and

113 | 114 |

b) its license agreement:

115 | 116 |

i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;

120 | 121 |

ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;

124 | 125 |

iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and

128 | 129 |

iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.

133 | 134 |

When the Program is made available in source code form:

135 | 136 |

a) it must be made available under this Agreement; and

137 | 138 |

b) a copy of this Agreement must be included with each 139 | copy of the Program.

140 | 141 |

Contributors may not remove or alter any copyright notices contained 142 | within the Program.

143 | 144 |

Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.

147 | 148 |

4. COMMERCIAL DISTRIBUTION

149 | 150 |

Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.

172 | 173 |

For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.

183 | 184 |

5. NO WARRANTY

185 | 186 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.

197 | 198 |

6. DISCLAIMER OF LIABILITY

199 | 200 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

208 | 209 |

7. GENERAL

210 | 211 |

If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.

216 | 217 |

If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.

223 | 224 |

All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.

232 | 233 |

Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.

252 | 253 |

This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.

258 | 259 | 260 | 261 | 262 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # data.xml 2 | 3 | [data.xml](https://github.com/clojure/data.xml) is a Clojure library for reading and writing XML data. This 4 | library is the successor to 5 | [lazy-xml](https://clojure.github.io/clojure-contrib/lazy-xml-api.html). 6 | data.xml has the following features: 7 | 8 | * Parses XML documents into Clojure data structures 9 | * Emits XML from Clojure data structures 10 | * No additional dependencies if using JDK >= 1.6 11 | * Uses StAX internally 12 | * lazy - should allow parsing and emitting of large XML documents 13 | 14 | ## API Reference 15 | 16 | Generated API docs for data.xml are available [here](https://clojure.github.io/data.xml). 17 | 18 | ## Bugs 19 | 20 | Please report bugs using JIRA [here](https://clojure.atlassian.net/browse/DXML). 21 | 22 | ## Installation 23 | 24 | Latest stable release: `0.0.8` 25 | 26 | Latest preview release: `0.2.0-alpha9` 27 | 28 | (The main features of the `0.2.0` series are XML Namespace support and Clojurescript support) 29 | 30 | * [All Released Versions](https://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22data.xml%22) 31 | 32 | * [Development Snapshot Versions](https://oss.sonatype.org/index.html#nexus-search;gav~org.clojure~data.xml~~~) 33 | 34 | ### Maven 35 | For Maven projects, add the following XML in your `pom.xml`'s `` section: 36 | 37 | For stable: 38 | 39 | 40 | org.clojure 41 | data.xml 42 | 0.0.8 43 | 44 | 45 | --- 46 | 47 | For preview: 48 | 49 | 50 | org.clojure 51 | data.xml 52 | 0.2.0-alpha9 53 | 54 | 55 | ### Leiningen 56 | Add the following to the `project.clj` dependencies: 57 | 58 | For stable: 59 | 60 | [org.clojure/data.xml "0.0.8"] 61 | 62 | --- 63 | 64 | For preview: 65 | 66 | [org.clojure/data.xml "0.2.0-alpha9"] 67 | 68 | ### [CLI/`deps.edn`](https://clojure.org/reference/deps_and_cli) 69 | 70 | Add the following to the `deps.edn` dependencies: 71 | ```clojure 72 | ;; for stable version: 73 | org.clojure/data.xml {:mvn/version "0.0.8"} 74 | 75 | ;; for preview version: 76 | org.clojure/data.xml {:mvn/version "0.2.0-alpha9"} 77 | ``` 78 | 79 | ## Examples 80 | 81 | The examples below assume you have added a `:refer` for data.xml: 82 | 83 | (require '[clojure.data.xml :as xml]) 84 | 85 | data.xml supports parsing and emitting XML. The parsing functions will 86 | read XML from a 87 | [Reader](https://docs.oracle.com/javase/8/docs/api/java/io/Reader.html) 88 | or 89 | [InputStream](https://docs.oracle.com/javase/8/docs/api/java/io/InputStream.html). 90 | 91 | (let [input-xml (java.io.StringReader. " 92 | The baz value")] 93 | (xml/parse input-xml)) 94 | 95 | #xml/element{:tag :foo, 96 | :content [#xml/element{:tag :bar, 97 | :content [#xml/element{:tag :baz, 98 | :content ["The baz value"]}]}]} 99 | 100 | The data is returned as defrecords and can be manipulated using the 101 | normal clojure data structure functions. Additional parsing options 102 | can be passed via key pairs: 103 | 104 | (xml/parse-str "" :coalescing false) 105 | #xml/element{:tag :a, :content ["\nfoo bar\n" "\nbaz\n"]} 106 | 107 | XML elements can be created using the typical defrecord constructor 108 | functions or the element function used below or just a plain map with :tag :attrs :content keys, and written using a 109 | [java.io.Writer](https://docs.oracle.com/javase/8/docs/api/java/io/Writer.html).: 110 | 111 | (let [tags (xml/element :foo {:foo-attr "foo value"} 112 | (xml/element :bar {:bar-attr "bar value"} 113 | (xml/element :baz {} "The baz value")))] 114 | (with-open [out-file (java.io.FileWriter. "/tmp/foo.xml")] 115 | (xml/emit tags out-file))) 116 | 117 | ;;-> Writes XML to /tmp/foo.xml 118 | 119 | The same can also be expressed using a more Hiccup-like style of defining the elements using sexp-as-element: 120 | 121 | (= (xml/element :foo {:foo-attr "foo value"} 122 | (xml/element :bar {:bar-attr "bar value"} 123 | (xml/element :baz {} "The baz value"))) 124 | (xml/sexp-as-element 125 | [:foo {:foo-attr "foo value"} 126 | [:bar {:bar-attr "bar value"} 127 | [:baz {} "The baz value"]]])) 128 | ;;-> true 129 | 130 | Comments and CDATA can also be emitted as an S-expression with the special tag names :-cdata and :-comment: 131 | 132 | (= (xml/element :tag {:attr "value"} 133 | (xml/element :body {} (xml/cdata "not parsed true 136 | 137 | XML can be "round tripped" through the library: 138 | 139 | (let [tags (xml/element :foo {:foo-attr "foo value"} 140 | (xml/element :bar {:bar-attr "bar value"} 141 | (xml/element :baz {} "The baz value")))] 142 | (with-open [out-file (java.io.FileWriter. "/tmp/foo.xml")] 143 | (xml/emit tags out-file)) 144 | (with-open [input (java.io.FileInputStream. "/tmp/foo.xml")] 145 | (xml/parse input))) 146 | 147 | #xml/element{:tag :foo, :attrs {:foo-attr "foo value"}...} 148 | 149 | There are also some string based functions that are useful for 150 | debugging. 151 | 152 | (let [tags (xml/element :foo {:foo-attr "foo value"} 153 | (xml/element :bar {:bar-attr "bar value"} 154 | (xml/element :baz {} "The baz value")))] 155 | (= tags (xml/parse-str (xml/emit-str tags)))) 156 | 157 | true 158 | 159 | Indentation is supported, but should be treated as a debugging feature 160 | as it's likely to be pretty slow: 161 | 162 | (print (xml/indent-str (xml/element :foo {:foo-attr "foo value"} 163 | (xml/element :bar {:bar-attr "bar value"} 164 | (xml/element :baz {} "The baz value1") 165 | (xml/element :baz {} "The baz value2") 166 | (xml/element :baz {} "The baz value3"))))) 167 | 168 | 169 | 170 | 171 | The baz value1 172 | The baz value2 173 | The baz value3 174 | 175 | 176 | 177 | CDATA can be emitted: 178 | 179 | (xml/emit-str (xml/element :foo {} 180 | (xml/cdata ""))) 181 | 182 | ;; newlines added for readability, not in actual output 183 | " 184 | ]]>" 185 | 186 | But will be read as regular character data: 187 | 188 | (xml/parse-str (xml/emit-str (xml/element :foo {} 189 | (xml/cdata "")))) 190 | 191 | #xml/element{:tag :foo, :content [""]} 192 | 193 | Comments can also be emitted: 194 | 195 | (xml/emit-str 196 | (xml/element :foo {} 197 | (xml/xml-comment "Just a goes here") 198 | (xml/element :bar {} "and another element"))) 199 | 200 | ;; newlines added for readability, not in actual output 201 | " 202 | and another element" 203 | 204 | But are ignored when read: 205 | 206 | (xml/emit-str 207 | (xml/parse-str 208 | (xml/emit-str (xml/element :foo {} 209 | (xml/xml-comment "Just a goes here") 210 | (xml/element :bar {} "and another element"))))) 211 | 212 | ;; newlines added for readability, not in actual output 213 | " 214 | and another element" 215 | 216 | ## Namespace Support 217 | 218 | XML Namespaced names (QNames) are encoded into clojure keywords, by percent-encoding the (XML) namespace: `{http://www.w3.org/1999/xhtml}head` is encoded in data.xml as `:http%3A%2F%2Fwww.w3.org%2F1999%2Fxhtml/head`. 219 | 220 | Below is an example of parsing an XHTML document: 221 | 222 | (xml/parse-str " 223 | ") 224 | 225 | #xml/element{:tag :xmlns.http%3A%2F%2Fwww.w3.org%2F1999%2Fxhtml/html} 226 | 227 | Emitting namespaced XML is usually done by using `alias-uri` in combination with clojure's built-in `::kw-ns/shorthands`: 228 | 229 | ;; this needs to be at the top level of your code (parallel to defns) 230 | ;; or subsequent ::xh/ ... will throw "Invalid token" 231 | (xml/alias-uri 'xh "http://www.w3.org/1999/xhtml") 232 | 233 | (xml/emit-str {:tag ::xh/html 234 | :content [{:tag ::xh/head} {:tag ::xh/body :content ["DOCUMENT"]}]}) 235 | 236 | 237 | 238 | 239 | DOCUMENT 240 | 241 | 242 | To emit namespaced tags without prefixes, you can also set the default xmlns at the root (it's important that the uris match!!): 243 | 244 | ;; at top level 245 | (xml/alias-uri 'xh "http://www.w3.org/1999/xhtml") 246 | 247 | ;; top-level element should set xmlns that matches 248 | (xml/emit-str 249 | (xml/element ::xh/html 250 | {:xmlns "http://www.w3.org/1999/xhtml"} 251 | (xml/element ::xh/head) 252 | (xml/element ::xh/body {} "DOCUMENT"))) 253 | 254 | ;; newlines and indents added for readability, not in actual output 255 | " 256 | 257 | 258 | DOCUMENT 259 | " 260 | 261 | Same example, but using the more concise hiccup style (same output): 262 | 263 | ;; at top level 264 | (xml/alias-uri 'xh "http://www.w3.org/1999/xhtml") 265 | 266 | (xml/emit-str 267 | (xml/sexp-as-element 268 | [::xh/html {:xmlns "http://www.w3.org/1999/xhtml"} 269 | [::xh/head] 270 | [::xh/body "DOCUMENT"]])) 271 | 272 | It is also allowable to use `javax.xml.namespace.QName` instances, as well as strings with the informal `{ns}n` encoding. 273 | 274 | (xml/emit-str {:tag (xml/qname "http://www.w3.org/1999/xhtml" "html")}) 275 | (xml/emit-str {:tag "{http://www.w3.org/1999/xhtml}html"}) 276 | 277 | ;; newlines added for readability, not in actual output 278 | 279 | 280 | 281 | ### Namespace Prefixes 282 | 283 | Prefixes are mostly an artifact of xml serialisation. They can be 284 | customized by explicitly declaring them as attributes in the `xmlns` 285 | kw-namespace: 286 | 287 | (xml/emit-str 288 | (xml/element (xml/qname "http://www.w3.org/1999/xhtml" "title") 289 | {:xmlns/foo "http://www.w3.org/1999/xhtml"} 290 | "Example title")) 291 | 292 | ;; newlines added for readability, not in actual output 293 | " 294 | Example title" 295 | 296 | Not specifying a namespace prefix will results in a prefix being generated: 297 | 298 | (xml/emit-str 299 | (xml/element ::xh/title 300 | {} 301 | "Example title")) 302 | 303 | ;; newlines added for readability, not in actual output 304 | " 305 | Example title" 306 | 307 | The above example auto assigns prefixes for the namespaces used. In 308 | this case it was named `a` by the emitter. Emitting several nested 309 | tags with the same namespace will use one prefix: 310 | 311 | (xml/emit-str 312 | (xml/element ::xh/html 313 | {} 314 | (xml/element ::xh/head 315 | {} 316 | (xml/element ::xh/title 317 | {} 318 | "Example title")))) 319 | 320 | ;; newlines and indents added for readability, not in actual output 321 | " 322 | 323 | 324 | Example title" 325 | 326 | Note that the jdk QName ignores namespace prefixes for equality, but allows to preserve them for emitting. 327 | 328 | (= (xml/parse-str "Example title") 329 | (xml/parse-str "Example title")) 330 | 331 | In data.xml prefix mappings are (by default) retained in metadata on a tag record. If there is no metadata, new prefixes will be generated when emitting. 332 | 333 | (xml/emit-str (xml/parse-str "")) 334 | 335 | ## Location information as meta 336 | 337 | By default the parser attaches location information as element meta, 338 | `:character-offset`, `:column-number` and `:line-number` are available under 339 | the `:clojure.data.xml/location-info` key: 340 | 341 | (deftest test-location-meta 342 | (let [input "\n" 343 | location-meta (comp :clojure.data.xml/location-info meta)] 344 | (is (= 1 (-> input xml/parse-str location-meta :line-number))))) 345 | 346 | To elide location information, pass `:location-info false` to the parser: 347 | 348 | (xml/parse-str your-input :location-info false) 349 | 350 | ## Clojurescript support 351 | 352 | The Clojurescript implementation uses the same namespace as the Clojure one `clojure.data.xml`. 353 | 354 | ### Native DOM support 355 | 356 | data.xml can directly work with native dom nodes. 357 | 358 | - To parse into DOM objects, call parse with `:raw true` 359 | - To use DOM objects like regular persistent maps, call `(extend-dom-as-data!)`. 360 | This extends the native dom node prototypes to Clojurescript collection protocols, such that you can treat them as data.xml parse trees. 361 | - To coerce to native dom use `element-node` 362 | - To coerce to records use `element-data` 363 | 364 | ### Missing Features, Patches Welcome 365 | 366 | #### Streaming 367 | 368 | data.xml on Clojurescript doesn't currently support streaming, hence only the `*-str` variants of `parse`/`emit` are implemented. Those are just wrappers for browser's native xml parsing/printing. 369 | 370 | Pull parsing doesn't seem the right solution for Clojurescript, because when code cannot block, the parser has no way of waiting on its input. For this reason, parsing in Clojurescript cannot be based around `event-seq`. 371 | 372 | Push parsing, on the other hand should not pose a problem, because when data arrives in a callback, it can be pushed on into the parser. Fortunately, clojure already has a nice push-based pendant for lazy sequences: transducers. 373 | 374 | #### Utilities 375 | 376 | Some utilities, like `process/*-xmlns`, `prxml/sexp-as-*`, `indent` aren't yet implemented. 377 | 378 | #### Immutable updates for dom types 379 | 380 | Make `extend-dom-as-data!` also support assoc, ... on dom nodes. 381 | 382 | #### Feel free to pick a [ticket](https://clojure.atlassian.net/browse/DXML) to work on 383 | 384 | ## License 385 | 386 | Licensed under the [Eclipse Public License](https://opensource.org/license/epl-1-0/). 387 | 388 | ## Developer Information 389 | 390 | * [GitHub project](https://github.com/clojure/data.xml) 391 | * [Bug Tracker](https://clojure.atlassian.net/browse/DXML) 392 | * [Continuous Integration](https://github.com/clojure/data.xml/actions/workflows/test.yml) 393 | 394 | ## Contributing 395 | 396 | All contributions need to be made via patches attached to tickets in 397 | [JIRA](https://clojure.atlassian.net/browse/DXML). Check the 398 | [Contributing to Clojure](https://clojure.org/community/contributing) page for 399 | more information. 400 | --------------------------------------------------------------------------------