diff options
Diffstat (limited to 'lib/xmerl/doc/examples/xmerl_test.erl')
| -rw-r--r-- | lib/xmerl/doc/examples/xmerl_test.erl | 522 |
1 files changed, 522 insertions, 0 deletions
diff --git a/lib/xmerl/doc/examples/xmerl_test.erl b/lib/xmerl/doc/examples/xmerl_test.erl new file mode 100644 index 0000000000..b4288431f2 --- /dev/null +++ b/lib/xmerl/doc/examples/xmerl_test.erl @@ -0,0 +1,522 @@ +-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. + + |