1-module(xmerl_test).
2
3-compile(export_all).
4%%-export([Function/Arity, ...]).
5
6-define(XMERL_APP,).
7
8-include("xmerl.hrl").
9
10%% Export to HTML from "simple" format
11test1() ->
12    xmerl:export_simple(simple(), xmerl_html, [{title, "Doc Title"}]).
13
14
15%% Export to XML from "simple" format
16test2() ->
17    xmerl:export_simple(simple(), xmerl_xml, [{title, "Doc Title"}]).
18
19
20%% Parse XHTML, and export result to HTML and text
21test3() ->
22    FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched,S} end,
23    {A, _} = xmerl_scan:string(html(),
24			    [{fetch_fun,FetchFun}]),
25    io:format("From xmerl_scan:string/2~n ~p~n", [A]),
26    B = xmerl:export([A], xmerl_html),
27    io:format("From xmerl:export/2 xmerl_html filter~n ~p~n", [B]),
28    C = xmerl:export([A], xmerl_text),
29    io:format("From xmerl:export/2 xmerl_text filter~n ~p~n", [C]).
30
31
32test4() ->
33    FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched, S} end,
34    {A,_} = xmerl_scan:string(xml_namespace(),
35			    [{fetch_fun,FetchFun},
36			     {namespace_conformant,true}]),
37    io:format("From xmerl_scan:string/2~n ~p~n", [A]).
38
39test5() ->
40    {ok, Cwd} = file:get_cwd(), % Assume we are in the examples dir...
41    File = Cwd ++ "/xml/xmerl.xml",
42    FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched, S} end,
43%    {Resp0,Rest0}=xmerl_eventp:stream(File,[]),
44%    io:format("Tree: ~p~n",[Resp0]),
45    {Resp1, _Rest1}=xmerl_eventp:file_sax(File, ?MODULE, undefined,
46					[{fetch_fun, FetchFun}]),
47    io:format("Using file_sax: counted ~p  paragraphs~n", [Resp1]),
48    {Resp2, _Rest2} = xmerl_eventp:stream_sax(File, ?MODULE, undefined, []),
49    io:format("Using stream_sax: counted ~p paragraphs~n", [Resp2]).
50
51test6() ->
52    FetchFun = fun(_DTDSpec, S) -> {ok, {string,""}, S} end,
53    {Doc, _} = xmerl_scan:string(xml_namespace(),
54				 [{fetch_fun, FetchFun},
55				  {namespace_conformant, true}]),
56    E = xmerl_xpath:string("child::title[position()=1]", Doc),
57    io:format("From xmerl_scan:string/2~n E=~p~n", [E]).
58
59
60simple() ->
61    [{document,
62      [{title, ["Doc Title"]},
63       {author, ["Ulf Wiger"]},
64       {section,[{heading, ["heading1"]},
65		 {'P', ["This is a paragraph of text."]},
66		 {section,[{heading, ["heading2"]},
67			   {'P', ["This is another paragraph."]},
68			   {table,[{border, ["1"]},
69				   {heading,[{col, ["head1"]},
70					     {col, ["head2"]}]},
71				   {row, [{col, ["col11"]},
72					  {col, ["col12"]}]},
73				   {row, [{col, ["col21"]},
74					  {col, ["col22"]}]}
75				  ]}
76			  ]}
77		]}
78      ]}
79    ].
80
81
82html() ->
83    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"DTD/xhtml1-strict.dtd\"><html>"
84	"<head><title>Doc Title</title><author>Ulf Wiger</author></head>"
85	"<h1>heading1</h1>"
86	"<p>This is a paragraph of text.</p>"
87	"<h2>heading2</h2>"
88	"<p>This is another paragraph.</p>"
89	"<table>"
90	"<thead><tr><td>head1</td><td>head2</td></tr></thead>"
91	"<tr><td>col11</td><td>col122</td></tr>"
92	"<tr><td>col21</td><td>col122</td></tr>"
93	"</table>"
94	"</html>".
95
96xml_namespace() ->
97    "<?xml version=\"1.0\"?>"
98	"<!-- initially, the default namespace is \"books\" -->"
99	"<book xmlns='urn:loc.gov:books' xmlns:isbn='urn:ISBN:0-395-36341-6'>"
100	"<title>Cheaper by the Dozen</title>"
101	"<isbn:number>1568491379</isbn:number>"
102	"<notes>"
103	"<!-- make HTML the default namespace for some comments -->"
104	"<p xmlns='urn:w3-org-ns:HTML'>"
105	"This is a <i>funny</i> book!"
106	"</p>"
107	"</notes>"
108	"</book>".
109
110
111%%% ============================================================================
112%%% Generic callbacks
113
114%'#text#'(Text) ->
115%    [].
116
117'#root#'(Data, Attrs, [], _E) ->
118    io:format("root... Data=~p Attrs=~p E=~p~n",[Data,Attrs,_E]),
119    [].
120
121'#element#'(Tag, Data, Attrs, _Parents, _E) ->
122    io:format("Tag=~p~n Data=~p~n Attrs=~p~n Parents=~p~n E=~p~n",
123	      [Tag, Data, Attrs, _Parents, _E]),
124    [].
125
126'#element#'(_Tag, _Data, _Attrs, CBstate) ->
127%    io:format("Tag=~p~n Data=~p~n Attrs=~p~n CBstate=~p~n",
128%	      [Tag, Data, Attrs, CBstate]),
129    CBstate.
130
131'#text#'(Text, CBstate) ->
132    io:format("Text=~p~n CBstate=~p~n",
133	      [Text, CBstate]),
134    CBstate.
135
136
137'#xml-inheritance#'() ->
138    [xmerl_html].
139
140
141
142
143%%% ============================================================================
144%%% To run these tests you must first download the testsuite from www.w3c.org
145%%% xmlconf.xml is the main test file that contains references to all the tests.
146%%% Thus parse this, export result and execute tests in the call-back functions.
147%%% Note:
148%%% - xmerl assumes all characters are represented with a single integer.
149w3cvalidate() ->
150    Tests = filename:join(filename:dirname(filename:absname(code:which(xmerl))),
151			  "../w3c/xmlconf/xmlconf.xml"),
152    TestDir = filename:dirname(Tests),
153    io:format("Looking for W3C tests at ~p~n", [Tests]),
154    {ok, Bin} = file:read_file(Tests),
155
156%    String = ucs:to_unicode(binary_to_list(Bin), 'utf-8'),
157%    case xmerl_scan:string(String, [{xmlbase, TestDir}]) of
158    case xmerl_scan:string(binary_to_list(Bin), [{xmlbase, TestDir}]) of
159	{error, Reason} ->
160	    io:format("ERROR xmerl:scan_file/2 Reason=~w~n", [Reason]);
161	{A, _Res} ->
162%     io:format("From xmerl:scan_file/2 ~n A=~p~n Res=~w~n", [A,Res]),
163	    C = xmerl:export([A], xmerl_test),
164	    io:format("From xmerl:export/2 xmerl_text filter~n ~p~n", [C])
165    end.
166
167
168'TESTSUITE'(_Data, Attrs, _Parents, _E) ->
169    _Profile = find_attribute('PROFILE', Attrs),
170%    io:format("testsuite Profile=~p~n", [Profile]),
171    [].
172
173'TESTCASES'(_Data, Attrs, _Parents, _E) ->
174    Profile = find_attribute('PROFILE', Attrs),
175    XMLbase = find_attribute('xml:base', Attrs),
176    io:format("testsuite Profile=~p~n xml:base=~p~n", [Profile, XMLbase]),
177    [].
178
179%% More info on Canonical Forms can be found at:
180%%  http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.html?content-type=text/html;%20charset=iso-8859-1
181'TEST'(Data, Attrs, _Parents, E) ->
182%    io:format("test Attrs=~p~n Parents=~p~n E=~p~n",[Attrs, _Parents, E]),
183    Id = find_attribute('ID', Attrs),
184    io:format("Test: ~p ",[Id]),
185    Entities = find_attribute('ENTITIES', Attrs), % Always handle all entities
186    Output1 = find_attribute('OUTPUT', Attrs), %
187    Output3 = find_attribute('OUTPUT3', Attrs), % FIXME!
188    Sections = find_attribute('SECTIONS', Attrs),
189    Recommendation = find_attribute('RECOMMENDATION', Attrs), % FIXME!
190    Type = find_attribute('TYPE', Attrs), % Always handle all entities
191    Version = find_attribute('VERSION', Attrs), % FIXME!
192    URI = find_attribute('URI', Attrs),
193    Namespace = find_attribute('NAMESPACE', Attrs), % FIXME!
194
195    OutputForm=
196	if
197	    Output1 =/= undefined -> Output1;
198	    true -> Output3
199	end,
200    Test = filename:join(E#xmlElement.xmlbase, URI),
201%    io:format("TEST URI=~p~n E=~p~n",[Test,E]),
202    case Type of
203	"valid" ->
204%	    io:format("Data=~p~n Attrs=~p~n Parents=~p~n Path=~p~n",
205%		      [Data, Attrs, _Parents, Test]),
206	    test_valid(Test, Data, Sections, Entities, OutputForm, Recommendation,
207		       Version, Namespace);
208	"invalid" ->
209	    test_invalid(Test, Data, Sections, Entities, OutputForm, Recommendation,
210			 Version, Namespace);
211	"not-wf" ->
212	    test_notwf(Test, Data, Sections, Entities, OutputForm, Recommendation,
213		       Version, Namespace);
214	"error" ->
215	    test_error(Test, Data, Sections, Entities, OutputForm, Recommendation,
216		       Version, Namespace)
217    end,
218    [].
219
220%% Really basic HTML font tweaks, to support highlighting
221%% some aspects of test descriptions ...
222'EM'(Data, _Attrs, _Parents, _E) ->
223    [$" |Data ++ [$"]].
224
225'B'(Data, _Attrs, _Parents, _E) ->
226   [$" |Data ++ [$"]].
227
228
229
230find_attribute(Tag,Attrs) ->
231    case xmerl_lib:find_attribute(Tag, Attrs) of
232	{value, Id} -> Id;
233	false -> undefined
234    end.
235
236
237-define(CONT, false).
238
239%%% All parsers must accept "valid" testcases.
240test_valid(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
241	   Namespace) ->
242    io:format("nonvalidating ", []),
243    case nonvalidating_parser_q(URI) of
244	{Res, Tail} when is_record(Res, xmlElement) ->
245	    case is_whitespace(Tail) of
246		true ->
247		    io:format("OK ", []),
248		    ok;
249		false ->
250		    print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
251				Recommendation,
252				Version, Namespace, Data),
253		    if
254			?CONT == false -> throw({'EXIT', failed_test});
255			true -> error
256		    end
257	    end;
258	Error ->
259	    print_error(Error, URI, Sections, Entities, OutputForm, Recommendation,
260			Version, Namespace, Data),
261	    if
262		?CONT == false -> throw({'EXIT', failed_test});
263		true -> error
264	    end
265    end,
266    io:format("validating ", []),
267    case validating_parser_q(URI) of
268	{Res2, Tail2} when is_record(Res2, xmlElement) ->
269	    case is_whitespace(Tail2) of
270		true ->
271		    io:format("OK~n", []),
272		    ok;
273		false ->
274		    print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
275				Recommendation,
276				Version, Namespace, Data),
277		    if
278			?CONT == false -> throw({'EXIT', failed_test});
279			true -> error
280		    end
281	    end;
282	Error2 ->
283	    print_error(Error2, URI, Sections, Entities, OutputForm, Recommendation,
284			Version, Namespace, Data),
285	    if
286		?CONT == false -> throw({'EXIT', failed_test});
287		true -> error
288	    end
289    end.
290
291
292%%% Nonvalidating parsers must accept "invalid" testcases, but validating ones
293%%% must reject them.
294test_invalid(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
295	     Namespace) ->
296    io:format("nonvalidating ", []),
297    case nonvalidating_parser_q(URI) of
298	{Res,Tail} when is_record(Res, xmlElement) ->
299	    case is_whitespace(Tail) of
300		true ->
301		    io:format("OK ", []),
302		    ok;
303		false ->
304		    print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
305				Recommendation,
306				Version, Namespace, Data),
307		    if
308			?CONT == false -> throw({'EXIT', failed_test});
309			true -> error
310		    end
311	    end;
312	Error ->
313	    print_error(Error, URI, Sections, Entities, OutputForm, Recommendation,
314			Version, Namespace, Data),
315	    if
316		?CONT == false -> throw({'EXIT', failed_test});
317		true -> error
318	    end
319    end,
320    io:format("validating ", []),
321    case validating_parser_q(URI) of
322	{Res2, Tail2} when is_record(Res2, xmlElement) ->
323	    case is_whitespace(Tail2) of
324		false ->
325		    io:format("OK~n", []),
326		    ok;
327		true ->
328		    print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
329				Recommendation,
330				Version, Namespace, Data),
331		    if
332			?CONT == false -> throw({'EXIT', failed_test});
333			true -> error
334		    end
335	    end;
336	{error, enoent} ->
337	    print_error("Testfile not found", URI, Sections, Entities, OutputForm,
338			Recommendation, Version, Namespace, Data),
339	    if
340		?CONT == false -> throw({'EXIT', failed_test});
341		true -> error
342	    end;
343	_Error2 ->
344	    io:format("OK~n", []),
345	    ok
346    end.
347
348%%% No parser should accept a "not-wf" testcase unless it's a nonvalidating
349%%% parser and the test contains external entities that the parser doesn't read
350test_notwf(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
351	   Namespace) ->
352    io:format("nonvalidating ", []),
353    case nonvalidating_parser_q(URI) of
354	{Res, Tail} when is_record(Res, xmlElement) ->
355	    case is_whitespace(Tail) of
356		false ->
357		    io:format("OK ", []),
358		    ok;
359		true ->
360		    print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
361				Recommendation,
362				Version, Namespace, Data),
363		    if
364			?CONT == false -> throw({'EXIT', failed_test});
365			true -> error
366		    end
367	    end;
368	{error,enoent} ->
369	    print_error("Testfile not found",URI,Sections,Entities,OutputForm,
370			Recommendation,Version,Namespace,Data),
371	    if
372		?CONT==false -> throw({'EXIT', failed_test});
373		true -> error
374	    end;
375	_Error ->
376	    io:format("OK ",[]),
377	    ok
378    end,
379    io:format("validating ",[]),
380    case validating_parser_q(URI) of
381	{Res2, Tail2} when is_record(Res2, xmlElement) ->
382	    case is_whitespace(Tail2) of
383		false ->
384		    io:format("OK~n", []),
385		    ok;
386		true ->
387		    print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
388				Recommendation,
389				Version, Namespace, Data),
390		    if
391			?CONT == false -> throw({'EXIT', failed_test});
392			true -> error
393		    end
394	    end;
395	{error,enoent} ->
396	    print_error("Testfile not found", URI, Sections, Entities, OutputForm,
397			Recommendation, Version, Namespace, Data),
398	    if
399		?CONT == false -> throw({'EXIT', failed_test});
400		true -> error
401	    end;
402	_Error2 ->
403	    io:format("OK~n", []),
404	    ok
405    end.
406
407%%% Parsers are not required to report "errors", but xmerl will always...
408test_error(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
409	   Namespace) ->
410    io:format("nonvalidating ", []),
411    case nonvalidating_parser_q(URI) of
412	{'EXIT', _Reason} ->
413	    io:format("OK ", []),
414	    ok;
415	{error, enoent} ->
416	    print_error("Testfile not found", URI, Sections, Entities, OutputForm,
417			Recommendation, Version, Namespace, Data),
418	    if
419		?CONT == false -> throw({'EXIT', failed_test});
420		true -> error
421	    end;
422	Res ->
423	    print_error(Res, URI, Sections, Entities, OutputForm, Recommendation,
424			Version, Namespace, Data),
425	    if
426		?CONT == false -> throw({'EXIT', failed_test});
427		true -> error
428	    end
429    end,
430    io:format("validating ", []),
431    case validating_parser_q(URI) of
432	{'EXIT', _Reason2} ->
433	    io:format("OK~n", []),
434	    ok;
435	{error, enoent} ->
436	    print_error("Testfile not found", URI, Sections, Entities, OutputForm,
437			Recommendation, Version, Namespace, Data),
438	    if
439		?CONT == false -> throw({'EXIT', failed_test});
440		true -> error
441	    end;
442	Res2 ->
443	    print_error(Res2, URI, Sections, Entities, OutputForm, Recommendation,
444			Version, Namespace, Data),
445	    if
446		?CONT == false -> throw({'EXIT', failed_test});
447		true -> error
448	    end
449    end.
450
451
452%%% Use xmerl as nonvalidating XML parser
453nonvalidating_parser(URI) ->
454    (catch xmerl_scan:file(URI, [])).
455
456
457%%% Use xmerl as nonvalidating XML parser
458nonvalidating_parser_q(URI) ->
459    (catch xmerl_scan:file(URI, [{quiet, true}])).
460
461
462%%% Use xmerl as validating XML parser
463validating_parser(URI) ->
464    (catch xmerl_scan:file(URI, [{validation, true}])).
465
466
467%%% Use xmerl as validating XML parser
468validating_parser_q(URI) ->
469    (catch xmerl_scan:file(URI, [{validation, true}, {quiet, true}])).
470
471
472is_whitespace([]) ->
473    true;
474is_whitespace([H |Rest]) when ?whitespace(H) ->
475    is_whitespace(Rest);
476is_whitespace(_) ->
477    false.
478
479
480print_error(Error, URI, Sections, Entities, OutputForm, Recommendation, Version,
481	    Namespace, Data) ->
482    io:format("ERROR ~p~n URI=~p~n See Section ~s~n",[Error, URI, Sections]),
483    if
484	Entities == undefined -> ok;
485	true -> io:format(" Entities  =~s~n",[Entities])
486    end,
487    if
488	OutputForm == undefined -> ok;
489	true -> io:format(" OutputForm=~s FIXME!~n",[OutputForm])
490    end,
491    if
492	Recommendation == undefined -> ok;
493	true -> io:format(" Recommendation=~s~n",[Recommendation])
494    end,
495    if
496	Version == undefined -> ok;
497	true -> io:format(" Version   =~s~n",[Version])
498    end,
499    if
500	Namespace == undefined -> ok;
501	true -> io:format(" Namespace =~s~n",[Namespace])
502    end,
503    io:format(Data).
504
505
506
507
508
509
510
511
512
513%%% ============================================================================
514%%% Callbacks for parsing of Simplified DocBook XML
515
516para(_Data, _Attrs, US) ->
517    case US of
518	Int when is_integer(Int) -> Int+1;
519	undefined -> 1
520    end.
521
522
523