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
|
# Quick and dirty SNOBOL4/Snocone DOM-like XML parser
struct tag {type, params, lastp, children, last, parent}
struct param {name, value}
word = SPAN("_0123456789" && &LCASE)
xml = (("<!--" && ARB && "-->") $ *ITEM(children(current),last(current) = last(current) + 1) |
"<" && word $ *type(current = ITEM(children(current),last(current) = last(current) + 1) =
tag(NULL, ARRAY(10), 0, ARRAY(10), 0, current)) &&
ARBNO(SPAN(" ") && word $ *name(ITEM(params(current), lastp(current) = lastp(current) + 1) = param()) &&
ARBNO(" ") && "=" && ARBNO(" ") && ("'"|'"') $ st && BREAK(*st) $ *value(ITEM(params(current),lastp(current))) && *st) &&
(">" | "/>" && *godown()) | "</" && word $ tag_name && ">" && *(tag_name :: type(current)) && *godown() |
(BREAK("<") | REM) $ *ITEM(children(current),last(current) = last(current) + 1)) && (RPOS(0) | *xml)
procedure godown() {
current = parent(current); return
}
# recursive function to produce a XML tree from a TAG data structure
procedure node_to_xml(node) i {
if(type(node) :!: NULL) {
node_to_xml = node_to_xml && "<" && type(node)
for(i=1, i <= lastp(node), i=i+1)
node_to_xml = node_to_xml && " " && name(ITEM(params(node), i)) && '="' && value(ITEM(params(node), i)) && '"'
if(last(node) == 0)
node_to_xml = node_to_xml && "/>"
else
node_to_xml = node_to_xml && ">"
}
for(i=1, i <= last(node), i=i+1)
if(DATATYPE(ITEM(children(node),i)) :: "TAG")
node_to_xml = node_to_xml && node_to_xml(ITEM(children(node),i))
else
node_to_xml = node_to_xml && ITEM(children(node),i)
if(type(node) :!: NULL && last(node) > 0)
node_to_xml = node_to_xml && "</" && type(node) && ">"
}
# TEST CODE
current = tag(NULL, NULL, NULL, ARRAY(10), 0, NULL)
'<test arg1="a1" arg2="a2">hgg<br/>jklhg<b><!-- Kommentar -->Bold text</b></test>' ? xml
test_tag = ITEM(children(current),1)
OUTPUT = type(test_tag)
OUTPUT = name(ITEM(params(test_tag),2))
OUTPUT = ITEM(children(test_tag),1)
b_tag = ITEM(children(test_tag),4)
OUTPUT = ITEM(children(b_tag),1)
OUTPUT = ITEM(children(b_tag),2)
type(test_tag) = "neu"
OUTPUT = node_to_xml(current)
|