Mercurial > lasercutter
comparison src/clojure/contrib/lazy_xml/with_pull.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ; Copyright (c) Chris Houser, Dec 2008. 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 ; optional module to allow lazy-xml to use pull parser instead of sax | |
10 | |
11 (in-ns 'clojure.contrib.lazy-xml) | |
12 (import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory)) | |
13 | |
14 (defn- attrs [xpp] | |
15 (for [i (range (.getAttributeCount xpp))] | |
16 [(keyword (.getAttributeName xpp i)) | |
17 (.getAttributeValue xpp i)])) | |
18 | |
19 (defn- ns-decs [xpp] | |
20 (let [d (.getDepth xpp)] | |
21 (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))] | |
22 (let [prefix (.getNamespacePrefix xpp i)] | |
23 [(keyword (str "xmlns" (when prefix (str ":" prefix)))) | |
24 (.getNamespaceUri xpp i)])))) | |
25 | |
26 (defn- attr-hash [xpp] | |
27 (into {} (concat (ns-decs xpp) (attrs xpp)))) | |
28 | |
29 (defn- pull-step [xpp] | |
30 (let [step (fn [xpp] | |
31 (condp = (.next xpp) | |
32 XmlPullParser/START_TAG | |
33 (cons (struct node :start-element | |
34 (keyword (.getName xpp)) | |
35 (attr-hash xpp)) | |
36 (pull-step xpp)) | |
37 XmlPullParser/END_TAG | |
38 (cons (struct node :end-element | |
39 (keyword (.getName xpp))) | |
40 (pull-step xpp)) | |
41 XmlPullParser/TEXT | |
42 (let [text (.trim (.getText xpp))] | |
43 (if (empty? text) | |
44 (recur xpp) | |
45 (cons (struct node :characters nil nil text) | |
46 (pull-step xpp))))))] | |
47 (lazy-seq (step xpp)))) | |
48 | |
49 (def ^{:private true} factory | |
50 (doto (XmlPullParserFactory/newInstance) | |
51 (.setNamespaceAware true))) | |
52 | |
53 (defn- parse-seq-pull [s] | |
54 (let [xpp (.newPullParser factory)] | |
55 (.setInput xpp s) | |
56 (pull-step xpp))) | |
57 | |
58 (def has-pull true) |