readXml.pl 4.52 KB
Newer Older
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% A very simple XML parser used for reading primitive specification files:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- module(readXml,[parseXml/2]).

:- use_module(prologbasics).
:- use_module(basics).

% The XML parser:
% Argument 1: XML string
% Argument 2: XML documents, i.e., list with elements of the form
% - pcdata(String)
% - element(Tag,Attrs,XmlDocs) where Tag is an atom and each attribute
%   has the form Name=Value (Name is an atom and Value a string)
parseXml(S,Doc) :-
	scanXmlString(S,XTs),
	parseXmlTokens(XTs,nothing,Doc,[]).

parseXmlTokens([],nothing,[],[]).
parseXmlTokens([pcdata(S)|XTs],Stop,[pcdata(US)|XEs],Rem) :-
	parseXmlTokens(XTs,Stop,XEs,Rem),
	xmlUnquoteSpecials(S,US).
parseXmlTokens([element([60,47|EN],Atts,Cont)|XTs],Stop,XEs,Rem) :- !,
	(EN=Stop
	 -> % stop token reached
	    XEs=[], Rem=XTs
	  ; parseXmlTokens(XTs,Stop,NewXEs,Rem),
	    atom_codes(Tag,[47|EN]),
	    XEs=[element(Tag,Atts,Cont)|NewXEs]).
parseXmlTokens([element([60|EN],Atts,_)|XTs],Stop,
	       [element(Tag,Atts,XEs1)|XEs2],XTs2) :- !,
	parseXmlTokens(XTs,EN,XEs1,XTs1),
	parseXmlTokens(XTs1,Stop,XEs2,XTs2),
	atom_codes(Tag,EN).
parseXmlTokens([element(EN,Atts,Cont)|XTs],Stop,
	       [element(Tag,Atts,Cont)|XEs1],XTs1) :- !,
	parseXmlTokens(XTs,Stop,XEs1,XTs1),
	atom_codes(Tag,EN).


% scan an XML string into list of XML tokens:
scanXmlString(S,XTs) :- dropBlanks(S,SB), scanXml(SB,XTs).

scanXml([],[]) :- !.
scanXml([60|S],XTs) :- !, scanXmlElem(S,XTs).
scanXml(S,[pcdata(Txt)|XTs]) :- scanXmlText(S,S1,Txt), scanXml(S1,XTs).

scanXmlText([],[],[]).
scanXmlText([60|S],[60|S],[]) :- !.
scanXmlText([C|S],S2,Txt) :- isSpace(C), !,
	dropBlanks(S,S1),
	scanXmlText(S1,S2,RTxt),
	(RTxt=[] -> Txt=[] ; Txt=[32|RTxt]).
scanXmlText([C|S],S1,[C|Txt]) :- scanXmlText(S,S1,Txt).

% scan an XML element:
scanXmlElem([],[]).
scanXmlElem([33,45,45|S],XTs) :- !, % [33,45,45] = "!--"
	scanXmlComment(S,XTs).
scanXmlElem([33|S],XTs) :- !, % [33] = "!"
	scanXmlCData(S,XTs).
scanXmlElem([63|S],XTs) :- !, % [63] = "?"
	scanXmlProcInstr(S,XTs).
scanXmlElem([C|S],XTs) :- scanXmlElemName([C],S,XTs).

scanXmlElemName(EN,[],[element([60|EN],[],[])]).
scanXmlElemName(EN,[62|S],[element([60|EN],[],[])|XTs]) :- !,
	scanXmlString(S,XTs).
scanXmlElemName(EN,[47,62|S],[element(EN,[],[])|XTs]) :- !, % [47,62] = "/>"
	scanXmlString(S,XTs).
scanXmlElemName(EN,[C|S],[Elem|XTs]) :- isSpace(C), !,
	dropBlanks(S,S1),
	parseXmlAttrs(S1,S2,Attrs),
	(S2=[47,62|S3] -> scanXmlString(S3,XTs), Elem=element(EN,Attrs,[])
	  ; S2=[_|S3], scanXmlString(S3,XTs), Elem=element([60|EN],Attrs,[])).
scanXmlElemName(EN,[C|S],XTs) :-
	append(EN,[C],ENC),
	scanXmlElemName(ENC,S,XTs).

parseXmlAttrs([],[],[]).
parseXmlAttrs([C|Cs],Cs4,[(Tag=UVal)|Attrs]) :- isAlpha(C), !,
	append(TagS,[61,34|Cs1],Cs), !, % 61 = '='
	append(Val,[34|Cs2],Cs1), !, % 34 = '"'
	atom_codes(Tag,[C|TagS]),
	xmlUnquoteSpecials(Val,UVal),
	dropBlanks(Cs2,Cs3),
	parseXmlAttrs(Cs3,Cs4,Attrs).
parseXmlAttrs(Cs,Cs,[]).


% scan (and drop) an XML comment:
scanXmlComment([],[]).
scanXmlComment([45,45,62|S],XTs) :- !, % [45,45,62] = "-->"
	scanXmlString(S,XTs).
scanXmlComment([_|S],XTs) :- scanXmlComment(S,XTs).

% todo: improve
scanXmlCData([],[]).
scanXmlCData([62|S],XTs) :- !, scanXmlString(S,XTs).
scanXmlCData([_|S],XTs) :- scanXmlCData(S,XTs).

% scan (and drop) an XML processing instructions:
scanXmlProcInstr([],[]).
scanXmlProcInstr([63,62|S],XTs) :- !, % [63,62] = "?>"
	scanXmlString(S,XTs).
scanXmlProcInstr([_|S],XTs) :- scanXmlProcInstr(S,XTs).


dropBlanks([C|T],TB) :- isSpace(C), !, dropBlanks(T,TB).
dropBlanks(T,T).

isSpace(32).
isSpace(10).
isSpace(13).

isAlpha(C) :- C >= 65, C =< 90.
isAlpha(C) :- C >= 97, C =< 122.

% unquote special characters (<,>,&,',") in an XML string:
xmlUnquoteSpecials([],[]).
xmlUnquoteSpecials([38|Cs],UCs) :- !, % 38 = '&'
	append(Special,[59|Cs1],Cs), !, % 59 = ';'
	xmlUnquoteSpecial(Special,Cs1,UCs).
xmlUnquoteSpecials([C|Cs],[C|UCs]) :- xmlUnquoteSpecials(Cs,UCs).

xmlUnquoteSpecial("lt",Cs,[60|UCs]) :- !, xmlUnquoteSpecials(Cs,UCs).
xmlUnquoteSpecial("gt",Cs,[62|UCs]) :- !, xmlUnquoteSpecials(Cs,UCs).
xmlUnquoteSpecial("amp",Cs,[38|UCs]) :- !, xmlUnquoteSpecials(Cs,UCs).
xmlUnquoteSpecial("quot",Cs,[34|UCs]) :- !, xmlUnquoteSpecials(Cs,UCs).
xmlUnquoteSpecial("apos",Cs,[39|UCs]) :- !, xmlUnquoteSpecials(Cs,UCs).
xmlUnquoteSpecial(Special,Cs,AllUCs) :-
	append([38],Special,AmpSpecial),
Michael Hanus's avatar
Michael Hanus committed
134
	append(AmpSpecial,[59],QuoteSpecial),
135
136
	xmlUnquoteSpecials(Cs,UCs),
	append(QuoteSpecial,UCs,AllUCs).