aboutsummaryrefslogtreecommitdiff
path: root/src/clojure/contrib/lazy_xml/with_pull.clj
blob: 7d70d479ec847155cb9a4440114d2a4f990beadc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

; optional module to allow lazy-xml to use pull parser instead of sax

(in-ns 'clojure.contrib.lazy-xml)
(import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory))

(defn- attrs [xpp]
  (for [i (range (.getAttributeCount xpp))]
    [(keyword (.getAttributeName xpp i))
     (.getAttributeValue xpp i)]))

(defn- ns-decs [xpp]
  (let [d (.getDepth xpp)]
    (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))]
      (let [prefix (.getNamespacePrefix xpp i)]
        [(keyword (str "xmlns" (when prefix (str ":" prefix))))
         (.getNamespaceUri xpp i)]))))

(defn- attr-hash [xpp]
  (into {} (concat (ns-decs xpp) (attrs xpp))))

(defn- pull-step [xpp]
  (case (.next xpp)
     XmlPullParser/START_TAG
        (lazy-cons (struct node :start-element
                           (keyword (.getName xpp))
                           (attr-hash xpp))
                   (pull-step xpp))
     XmlPullParser/END_TAG
        (lazy-cons (struct node :end-element
                           (keyword (.getName xpp)))
                   (pull-step xpp))
     XmlPullParser/TEXT
        (let [text (.trim (.getText xpp))]
          (if (seq text)
            (lazy-cons (struct node :characters nil nil text)
                       (pull-step xpp))
            (recur xpp)))))

(def #^{:private true} factory
  (doto (XmlPullParserFactory/newInstance)
    (.setNamespaceAware true)))

(defn- parse-seq-pull [s]
  (let [xpp (.newPullParser factory)]
    (.setInput xpp s)
    (pull-step xpp)))

(def has-pull true)