-module(xmerl_test).
-compile(export_all).
%%-export([Function/Arity, ...]).
-define(XMERL_APP,).
-include("xmerl.hrl").
%% Export to HTML from "simple" format
test1() ->
xmerl:export_simple(simple(), xmerl_html, [{title, "Doc Title"}]).
%% Export to XML from "simple" format
test2() ->
xmerl:export_simple(simple(), xmerl_xml, [{title, "Doc Title"}]).
%% Parse XHTML, and export result to HTML and text
test3() ->
FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched,S} end,
{A, _} = xmerl_scan:string(html(),
[{fetch_fun,FetchFun}]),
io:format("From xmerl_scan:string/2~n ~p~n", [A]),
B = xmerl:export([A], xmerl_html),
io:format("From xmerl:export/2 xmerl_html filter~n ~p~n", [B]),
C = xmerl:export([A], xmerl_text),
io:format("From xmerl:export/2 xmerl_text filter~n ~p~n", [C]).
test4() ->
FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched, S} end,
{A,_} = xmerl_scan:string(xml_namespace(),
[{fetch_fun,FetchFun},
{namespace_conformant,true}]),
io:format("From xmerl_scan:string/2~n ~p~n", [A]).
test5() ->
{ok, Cwd} = file:get_cwd(), % Assume we are in the examples dir...
File = Cwd ++ "/xml/xmerl.xml",
FetchFun = fun(_DTDSpec, S) -> {ok, not_fetched, S} end,
% {Resp0,Rest0}=xmerl_eventp:stream(File,[]),
% io:format("Tree: ~p~n",[Resp0]),
{Resp1, _Rest1}=xmerl_eventp:file_sax(File, ?MODULE, undefined,
[{fetch_fun, FetchFun}]),
io:format("Using file_sax: counted ~p paragraphs~n", [Resp1]),
{Resp2, _Rest2} = xmerl_eventp:stream_sax(File, ?MODULE, undefined, []),
io:format("Using stream_sax: counted ~p paragraphs~n", [Resp2]).
test6() ->
FetchFun = fun(_DTDSpec, S) -> {ok, {string,""}, S} end,
{Doc, _} = xmerl_scan:string(xml_namespace(),
[{fetch_fun, FetchFun},
{namespace_conformant, true}]),
E = xmerl_xpath:string("child::title[position()=1]", Doc),
io:format("From xmerl_scan:string/2~n E=~p~n", [E]).
simple() ->
[{document,
[{title, ["Doc Title"]},
{author, ["Ulf Wiger"]},
{section,[{heading, ["heading1"]},
{'P', ["This is a paragraph of text."]},
{section,[{heading, ["heading2"]},
{'P', ["This is another paragraph."]},
{table,[{border, ["1"]},
{heading,[{col, ["head1"]},
{col, ["head2"]}]},
{row, [{col, ["col11"]},
{col, ["col12"]}]},
{row, [{col, ["col21"]},
{col, ["col22"]}]}
]}
]}
]}
]}
].
html() ->
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"DTD/xhtml1-strict.dtd\"><html>"
"<head><title>Doc Title</title><author>Ulf Wiger</author></head>"
"<h1>heading1</h1>"
"<p>This is a paragraph of text.</p>"
"<h2>heading2</h2>"
"<p>This is another paragraph.</p>"
"<table>"
"<thead><tr><td>head1</td><td>head2</td></tr></thead>"
"<tr><td>col11</td><td>col122</td></tr>"
"<tr><td>col21</td><td>col122</td></tr>"
"</table>"
"</html>".
xml_namespace() ->
"<?xml version=\"1.0\"?>"
"<!-- initially, the default namespace is \"books\" -->"
"<book xmlns='urn:loc.gov:books' xmlns:isbn='urn:ISBN:0-395-36341-6'>"
"<title>Cheaper by the Dozen</title>"
"<isbn:number>1568491379</isbn:number>"
"<notes>"
"<!-- make HTML the default namespace for some comments -->"
"<p xmlns='urn:w3-org-ns:HTML'>"
"This is a <i>funny</i> book!"
"</p>"
"</notes>"
"</book>".
%%% ============================================================================
%%% Generic callbacks
%'#text#'(Text) ->
% [].
'#root#'(Data, Attrs, [], _E) ->
io:format("root... Data=~p Attrs=~p E=~p~n",[Data,Attrs,_E]),
[].
'#element#'(Tag, Data, Attrs, _Parents, _E) ->
io:format("Tag=~p~n Data=~p~n Attrs=~p~n Parents=~p~n E=~p~n",
[Tag, Data, Attrs, _Parents, _E]),
[].
'#element#'(_Tag, _Data, _Attrs, CBstate) ->
% io:format("Tag=~p~n Data=~p~n Attrs=~p~n CBstate=~p~n",
% [Tag, Data, Attrs, CBstate]),
CBstate.
'#text#'(Text, CBstate) ->
io:format("Text=~p~n CBstate=~p~n",
[Text, CBstate]),
CBstate.
'#xml-inheritance#'() ->
[xmerl_html].
%%% ============================================================================
%%% To run these tests you must first download the testsuite from www.w3c.org
%%% xmlconf.xml is the main test file that contains references to all the tests.
%%% Thus parse this, export result and execute tests in the call-back functions.
%%% Note:
%%% - xmerl assumes all characters are represented with a single integer.
w3cvalidate() ->
Tests = filename:join(filename:dirname(filename:absname(code:which(xmerl))),
"../w3c/xmlconf/xmlconf.xml"),
TestDir = filename:dirname(Tests),
io:format("Looking for W3C tests at ~p~n", [Tests]),
{ok, Bin} = file:read_file(Tests),
% String = ucs:to_unicode(binary_to_list(Bin), 'utf-8'),
% case xmerl_scan:string(String, [{xmlbase, TestDir}]) of
case xmerl_scan:string(binary_to_list(Bin), [{xmlbase, TestDir}]) of
{error, Reason} ->
io:format("ERROR xmerl:scan_file/2 Reason=~w~n", [Reason]);
{A, _Res} ->
% io:format("From xmerl:scan_file/2 ~n A=~p~n Res=~w~n", [A,Res]),
C = xmerl:export([A], xmerl_test),
io:format("From xmerl:export/2 xmerl_text filter~n ~p~n", [C])
end.
'TESTSUITE'(_Data, Attrs, _Parents, _E) ->
_Profile = find_attribute('PROFILE', Attrs),
% io:format("testsuite Profile=~p~n", [Profile]),
[].
'TESTCASES'(_Data, Attrs, _Parents, _E) ->
Profile = find_attribute('PROFILE', Attrs),
XMLbase = find_attribute('xml:base', Attrs),
io:format("testsuite Profile=~p~n xml:base=~p~n", [Profile, XMLbase]),
[].
%% More info on Canonical Forms can be found at:
%% http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.html?content-type=text/html;%20charset=iso-8859-1
'TEST'(Data, Attrs, _Parents, E) ->
% io:format("test Attrs=~p~n Parents=~p~n E=~p~n",[Attrs, _Parents, E]),
Id = find_attribute('ID', Attrs),
io:format("Test: ~p ",[Id]),
Entities = find_attribute('ENTITIES', Attrs), % Always handle all entities
Output1 = find_attribute('OUTPUT', Attrs), %
Output3 = find_attribute('OUTPUT3', Attrs), % FIXME!
Sections = find_attribute('SECTIONS', Attrs),
Recommendation = find_attribute('RECOMMENDATION', Attrs), % FIXME!
Type = find_attribute('TYPE', Attrs), % Always handle all entities
Version = find_attribute('VERSION', Attrs), % FIXME!
URI = find_attribute('URI', Attrs),
Namespace = find_attribute('NAMESPACE', Attrs), % FIXME!
OutputForm=
if
Output1 =/= undefined -> Output1;
true -> Output3
end,
Test = filename:join(E#xmlElement.xmlbase, URI),
% io:format("TEST URI=~p~n E=~p~n",[Test,E]),
case Type of
"valid" ->
% io:format("Data=~p~n Attrs=~p~n Parents=~p~n Path=~p~n",
% [Data, Attrs, _Parents, Test]),
test_valid(Test, Data, Sections, Entities, OutputForm, Recommendation,
Version, Namespace);
"invalid" ->
test_invalid(Test, Data, Sections, Entities, OutputForm, Recommendation,
Version, Namespace);
"not-wf" ->
test_notwf(Test, Data, Sections, Entities, OutputForm, Recommendation,
Version, Namespace);
"error" ->
test_error(Test, Data, Sections, Entities, OutputForm, Recommendation,
Version, Namespace)
end,
[].
%% Really basic HTML font tweaks, to support highlighting
%% some aspects of test descriptions ...
'EM'(Data, _Attrs, _Parents, _E) ->
[$" |Data ++ [$"]].
'B'(Data, _Attrs, _Parents, _E) ->
[$" |Data ++ [$"]].
find_attribute(Tag,Attrs) ->
case xmerl_lib:find_attribute(Tag, Attrs) of
{value, Id} -> Id;
false -> undefined
end.
-define(CONT, false).
%%% All parsers must accept "valid" testcases.
test_valid(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
Namespace) ->
io:format("nonvalidating ", []),
case nonvalidating_parser_q(URI) of
{Res, Tail} when is_record(Res, xmlElement) ->
case is_whitespace(Tail) of
true ->
io:format("OK ", []),
ok;
false ->
print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
Error ->
print_error(Error, URI, Sections, Entities, OutputForm, Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end,
io:format("validating ", []),
case validating_parser_q(URI) of
{Res2, Tail2} when is_record(Res2, xmlElement) ->
case is_whitespace(Tail2) of
true ->
io:format("OK~n", []),
ok;
false ->
print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
Error2 ->
print_error(Error2, URI, Sections, Entities, OutputForm, Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end.
%%% Nonvalidating parsers must accept "invalid" testcases, but validating ones
%%% must reject them.
test_invalid(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
Namespace) ->
io:format("nonvalidating ", []),
case nonvalidating_parser_q(URI) of
{Res,Tail} when is_record(Res, xmlElement) ->
case is_whitespace(Tail) of
true ->
io:format("OK ", []),
ok;
false ->
print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
Error ->
print_error(Error, URI, Sections, Entities, OutputForm, Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end,
io:format("validating ", []),
case validating_parser_q(URI) of
{Res2, Tail2} when is_record(Res2, xmlElement) ->
case is_whitespace(Tail2) of
false ->
io:format("OK~n", []),
ok;
true ->
print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
{error, enoent} ->
print_error("Testfile not found", URI, Sections, Entities, OutputForm,
Recommendation, Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end;
_Error2 ->
io:format("OK~n", []),
ok
end.
%%% No parser should accept a "not-wf" testcase unless it's a nonvalidating
%%% parser and the test contains external entities that the parser doesn't read
test_notwf(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
Namespace) ->
io:format("nonvalidating ", []),
case nonvalidating_parser_q(URI) of
{Res, Tail} when is_record(Res, xmlElement) ->
case is_whitespace(Tail) of
false ->
io:format("OK ", []),
ok;
true ->
print_error({Res, Tail}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
{error,enoent} ->
print_error("Testfile not found",URI,Sections,Entities,OutputForm,
Recommendation,Version,Namespace,Data),
if
?CONT==false -> throw({'EXIT', failed_test});
true -> error
end;
_Error ->
io:format("OK ",[]),
ok
end,
io:format("validating ",[]),
case validating_parser_q(URI) of
{Res2, Tail2} when is_record(Res2, xmlElement) ->
case is_whitespace(Tail2) of
false ->
io:format("OK~n", []),
ok;
true ->
print_error({Res2, Tail2}, URI, Sections, Entities, OutputForm,
Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end;
{error,enoent} ->
print_error("Testfile not found", URI, Sections, Entities, OutputForm,
Recommendation, Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end;
_Error2 ->
io:format("OK~n", []),
ok
end.
%%% Parsers are not required to report "errors", but xmerl will always...
test_error(URI, Data, Sections, Entities, OutputForm, Recommendation, Version,
Namespace) ->
io:format("nonvalidating ", []),
case nonvalidating_parser_q(URI) of
{'EXIT', _Reason} ->
io:format("OK ", []),
ok;
{error, enoent} ->
print_error("Testfile not found", URI, Sections, Entities, OutputForm,
Recommendation, Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end;
Res ->
print_error(Res, URI, Sections, Entities, OutputForm, Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end,
io:format("validating ", []),
case validating_parser_q(URI) of
{'EXIT', _Reason2} ->
io:format("OK~n", []),
ok;
{error, enoent} ->
print_error("Testfile not found", URI, Sections, Entities, OutputForm,
Recommendation, Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end;
Res2 ->
print_error(Res2, URI, Sections, Entities, OutputForm, Recommendation,
Version, Namespace, Data),
if
?CONT == false -> throw({'EXIT', failed_test});
true -> error
end
end.
%%% Use xmerl as nonvalidating XML parser
nonvalidating_parser(URI) ->
(catch xmerl_scan:file(URI, [])).
%%% Use xmerl as nonvalidating XML parser
nonvalidating_parser_q(URI) ->
(catch xmerl_scan:file(URI, [{quiet, true}])).
%%% Use xmerl as validating XML parser
validating_parser(URI) ->
(catch xmerl_scan:file(URI, [{validation, true}])).
%%% Use xmerl as validating XML parser
validating_parser_q(URI) ->
(catch xmerl_scan:file(URI, [{validation, true}, {quiet, true}])).
is_whitespace([]) ->
true;
is_whitespace([H |Rest]) when ?whitespace(H) ->
is_whitespace(Rest);
is_whitespace(_) ->
false.
print_error(Error, URI, Sections, Entities, OutputForm, Recommendation, Version,
Namespace, Data) ->
io:format("ERROR ~p~n URI=~p~n See Section ~s~n",[Error, URI, Sections]),
if
Entities == undefined -> ok;
true -> io:format(" Entities =~s~n",[Entities])
end,
if
OutputForm == undefined -> ok;
true -> io:format(" OutputForm=~s FIXME!~n",[OutputForm])
end,
if
Recommendation == undefined -> ok;
true -> io:format(" Recommendation=~s~n",[Recommendation])
end,
if
Version == undefined -> ok;
true -> io:format(" Version =~s~n",[Version])
end,
if
Namespace == undefined -> ok;
true -> io:format(" Namespace =~s~n",[Namespace])
end,
io:format(Data).
%%% ============================================================================
%%% Callbacks for parsing of Simplified DocBook XML
para(_Data, _Attrs, US) ->
case US of
Int when is_integer(Int) -> Int+1;
undefined -> 1
end.