/xmlbench/trunk

To get this branch, use:
bzr branch http://darksoft.org/webbzr/xmlbench/trunk

« back to all changes in this revision

Viewing changes to parse/lisp/libxml.cl

  • Committer: Suren A. Chilingaryan
  • Date: 2009-10-02 01:16:02 UTC
  • Revision ID: csa@dside.dyndns.org-20091002011602-ut1jl0go12npun6y
DOM walking for all Libxml bindings: ruby, python, perl, php, lisp

Show diffs side-by-side

added added

removed removed

Lines of Context:
parse/lisp/libxml.cl
1
 
#! /usr/bin/clisp -C -q -q
 
1
;#! /usr/bin/clisp -C -q -q
2
2
; Should be called from root account once to generate binaries for libraries
3
3
 
4
4
(load #p"/usr/share/common-lisp/source/asdf/asdf.lisp")
5
5
(push #p"/usr/share/common-lisp/systems/" asdf:*central-registry*)
6
6
(asdf:oos 'asdf:load-op :cl-libxml2)
 
7
(asdf:oos 'asdf:load-op :iterate)
 
8
 
 
9
(defvar *xpath_expr* "//*[(number(@*) or number(text())) and (count(../child::*)>3)]")
 
10
(defvar *attrs_xe* (xpath:compile-expression "./@*"))
 
11
 
 
12
(defun my-getenv (name &optional default)
 
13
    #+CMU
 
14
    (let ((x (assoc name ext:*environment-list*
 
15
                    :test #'string=)))
 
16
      (if x (cdr x) default))
 
17
    #-CMU
 
18
    (or
 
19
     #+Allegro (sys:getenv name)
 
20
     #+CLISP (ext:getenv name)
 
21
     #+ECL (si:getenv name)
 
22
     #+SBCL (sb-unix::posix-getenv name)
 
23
     #+LISPWORKS (lispworks:environment-variable name)
 
24
     default))
 
25
 
 
26
(defmacro doc_search (doc) 
 
27
    `(xpath:xpath-object-value 
 
28
        (xpath:eval-expression (xtree:root ,doc) 
 
29
            (xpath:compile-expression *xpath_expr*))))
 
30
 
 
31
(defmacro get_attrs (node)
 
32
    `(xpath:xpath-object-value 
 
33
        (xpath:eval-expression ,node *attrs_xe*)))
 
34
 
 
35
(defmacro read_text_value (node) 
 
36
    "Unconditional read from text node"
 
37
    `(read-from-string (xtree:text-content (xtree:first-child ,node))))
 
38
    
 
39
(defmacro get_text_value (node)
 
40
    `(if (and (xtree:first-child ,node) (eq :XML-TEXT-NODE (xtree:node-type (xtree:first-child ,node))))
 
41
            (if (numberp (read_text_value ,node)) (read_text_value ,node) nil) nil))
 
42
 
 
43
 
 
44
(defmacro get_attr_value (anode)
 
45
    `(get_text_value ,anode))
 
46
 
 
47
(defmacro get_attrs_value (node)
 
48
    `(let ((res nil) (attrset (get_attrs ,node))) 
 
49
        (loop for i from 0 to (- (xpath:node-set-length attrset) 1) do 
 
50
            (setf res (get_attr_value (xpath:node-set-at attrset i)))
 
51
            (if res (return))
 
52
        )
 
53
        (if res res 0)
 
54
    ))
 
55
    
 
56
(defmacro get_value (node) "Read the node value"
 
57
    `(if (get_text_value ,node) (get_text_value ,node) (get_attrs_value ,node)))
 
58
 
7
59
 
8
60
(defun parse_file (fn)
 
61
    (setf *sum* 0)
9
62
    (xtree:with-parse-document (doc (pathname fn)) 
10
 
        ()
 
63
        (if (my-getenv "walk_tree")
 
64
            (let ((nodeset (doc_search doc)))
 
65
                (loop for i from 0 to (- (xpath:node-set-length nodeset) 1) do 
 
66
                    (setf *sum* (+ *sum* (get_value (xpath:node-set-at nodeset i))))
 
67
                )
 
68
                (print *sum*)
 
69
            ))
 
70
    ))
11
71
;       (xtree:serialize doc *standard-output*)
12
 
        )
13
 
)
14
72
 
15
73
(defun parse_iteration (fn i)
16
74
    (if fn
39
97
        (parse_iteration xmlfn (+ i 1))))
40
98
 
41
99
 
 
100
(quit)