xmerl_validate.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 659 行 · 第 1/2 页

		     Default,_S) ->
    Fun = 
	fun (X)->
		case xmerl_lib:is_namechar(X) of
		    true->
			ok;
		    false when ?whitespace(X)->
			ok;
		    false ->
			exit({error,{invalid_value_nmtokens,Name,V}})
		end
	end,
    lists:foreach(Fun,V),
    if 
	list(Default) ->
	    lists:foreach(Fun,Default);
	true -> ok
    end,
    Attr;
test_attribute_value(Ent,#xmlAttribute{name=_Name,value=V}=Attr,_Default,
		     S=#xmerl_scanner{rules_read_fun=Read}) 
  when Ent == 'ENTITY'; Ent == 'ENTITIES'->
    %% The default value is already checked
    NameListFun = 
	fun([],Acc,_) ->
		lists:reverse(Acc);
	   (Str,Acc,Fun) -> 
		{N,Str2} = scan_name(Str,[]),
		Fun(Str2,[N|Acc],Fun)
	end,
    NameList = NameListFun(V,[],NameListFun),
    VC_Entity_Name = 
	fun(X) ->
		case Read(entity,X,S) of
		    {_,external,{_,{ndata,_}}} ->
			ok;
		    _ -> exit({error,{vc_Entity_Name,X,V}})
                end
	end,
    lists:foreach(VC_Entity_Name,NameList),
    Attr;
test_attribute_value({Type,L},#xmlAttribute{value=Value}=Attr,Default,_S)
  when Type == enumeration; Type == notation ->
    ValidDefault = 
	if 
	    atom(Default) -> true;
	    true -> lists:member(list_to_atom(Default),L)
	end,
    NoDuplicatesFun =
	fun(_,_,notation) -> true;
	   ([],_,_) -> true;
	   ([H|T],F,Enum) ->
		case lists:member(H,T) of
		    true -> false;
		    _ -> F(T,F,Enum)
		end
	end,
    NoDuplicates = NoDuplicatesFun(L,NoDuplicatesFun,Type),
    case {lists:member(list_to_atom(Value),L),ValidDefault,NoDuplicates} of
	{true,true,true}->
	    Attr;
	{false,_,_} ->
	    exit({error,{attribute_value_unknow,Value,{list,L}}});
	{_,false,_} ->
	    exit({error,{attribute_default_value_unknow,Default,{list,L}}});
	{_,_,false} ->
	    exit({error,{duplicate_tokens_not_allowed,{list,L}}})
    end;
test_attribute_value(_Rule,Attr,_,_) ->
%    io:format("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]),
    Attr.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%% Contents Validation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%Element-content Models
%%%%[47] children::= (choice | seq) ('?' | '*' | '+')?
%%%%[48] cp::=       (Name | choice | seq) ('?' | '*' | '+')?
%%%%[49] choice::=  '(' S? cp ( S? '|' S? cp )+ S? ')'
%%%%[50] seq::=     '(' S? cp ( S? ',' S? cp )* S? ')'
%%%%[51] Mixed::=   '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' 
%%%%              | '(' S? '#PCDATA' S? ')' 


%% +type valid_contents([rule()],[xmlElement()])->
%%              [xmlElement() | {error,???}.
valid_contents(Rule,XMLS,Rules,S,WSActionMode)->
    case parse(Rule,XMLS,Rules,WSActionMode,S) of
	{XML_N,[]}->
	    lists:flatten(XML_N);
	{_,[#xmlElement{name=Name}|_T]} ->
	    exit({error,{element,Name,isnt_comprise_in_the_rule,Rule}});
	{_,[#xmlText{}=Txt|_T]} ->
	    exit({error,{element,text,Txt,isnt_comprise_in_the_rule,Rule}});
	{error,Reason} ->
	    {error,Reason};
	{error,Reason,N} ->
	    {error,Reason,N}
    end.

parse({'*',SubRule},XMLS,Rules,WSaction,S)->
    star(SubRule,XMLS,Rules,WSaction,[],S); 
parse({'+',SubRule},XMLS,Rules,WSaction,S) ->
    plus(SubRule,XMLS,Rules,WSaction,S);
parse({choice,CHOICE},XMLS,Rules,WSaction,S)->
    choice(CHOICE,XMLS,Rules,WSaction,S);
parse(empty,[],_Rules,_WSaction,_S) ->
    {[],[]};
parse({'?',SubRule},XMLS,Rules,_WSaction,S)->
    question(SubRule,XMLS,Rules,S);
parse({seq,List},XMLS,Rules,WSaction,S) ->
    seq(List,XMLS,Rules,WSaction,S);
parse(El_Name,[#xmlElement{name=El_Name}=XML|T],Rules,_WSaction,S) 
  when atom(El_Name)->
    case do_validation(read_rules(Rules,el_name(XML)),XML,Rules,S) of
	{error,R} ->
%	    {error,R};
	    exit(R);
	{error,R,_N}->
%	    {error,R,N};
	    exit(R);
	XML_->
	    {[XML_],T}
    end;
parse(any,Cont,Rules,_WSaction,S) ->
    case catch parse_any(Cont,Rules,S) of
	Err = {error,_} -> Err;
	ValidContents -> {ValidContents,[]}
    end;
parse(El_Name,[#xmlElement{name=Name}|_T]=S,_Rules,_WSa,_S) when atom(El_Name)->
    {error,
     {element_seq_not_conform,{wait,El_Name},{is,Name}},
     {{next,S},{act,[]}} };
parse(_El_Name,[#xmlPI{}=H|T],_Rules,_WSa,_S) ->
    {[H],T};
parse('#PCDATA',XML,_Rules,_WSa,_S)->
    %%% PCDATA it is 0 , 1 or more #xmlText{}.
    parse_pcdata(XML);
parse(El_Name,[#xmlText{}|_T]=S,_Rules,_WSa,_S)->
    {error,
     {text_in_place_of,El_Name},
     {{next,S},{act,[]}}};
parse([],_,_,_,_) ->
    {error,no_rule};
parse(Rule,[],_,_,_) ->
    {error,{no_xml_element,Rule}}.

parse_any([],_Rules,_S) ->
    [];
parse_any([H|T],Rules,S) ->
    case parse_any(H,Rules,S) of
	[Cont] ->
	   [Cont|parse_any(T,Rules,S)];
	Err -> throw(Err)
    end;
parse_any(#xmlElement{}=XML,Rules,S) ->
    case do_validation(read_rules(Rules,el_name(XML)),XML,Rules,S) of
	{error,R} ->
	    {error,R};
	{error,R,N}->
	    {error,R,N};
	XML_->
	    [XML_]
    end;
parse_any(El,_Rules,_S) ->
    [El].


%% XXX remove first function clause
% choice(_Choice,[#xmlText{}=T|R],_Rules) ->
%     {[T],R};
choice([CH|CHS],[_XML|_T]=XMLS,Rules,WSaction,S)->
    {WS,XMLS1} = whitespace_action(XMLS,ws_action(WSaction,remove)),
    case parse(CH,XMLS1,Rules,ws_action(WSaction,remove),S) of
	{error,_R} ->
	    choice(CHS,XMLS,Rules,WSaction,S);
	{error,_R,_N} ->
	    choice(CHS,XMLS,Rules,WSaction,S); %% XXX add a case {[],XML}
	{[],XMLS1} -> %% Maybe a sequence with * or ? elements that
                      %% didn't match
	    choice(CHS,XMLS1,Rules,WSaction,S);
	{Tree,XMLS2}->
	    {WS2,XMLS3} = whitespace_action(XMLS2,ws_action(WSaction,remove)),
	    {WS2++[Tree]++WS,XMLS3}
    end;
choice([],XMLS,_,WSaction,_S)->
    case whitespace_action(XMLS,ws_action(WSaction,remove)) of
	Res={_,[]} -> Res;
	_ ->
	    {error,element_unauthorize_in_choice,{{next,XMLS},{act,[]}}}
    end;
choice(_,[],_,_,_S) ->
    {[],[]}.

plus(Rule,XMLS,Rules,WSaction,S) ->
    %% 1 or more
    {WS,XMLS1}=whitespace_action(XMLS,WSaction),
    case parse(Rule,XMLS1,Rules,WSaction,S) of
	{error, Reason,_XML} ->
	    {error, Reason};
	{error, X} ->
	    {error, X};
	{Tree, XMLS2} ->
	    case star(Rule, XMLS2,Rules,WSaction,[],S) of
		{[], _} ->
		    {WS++[Tree], XMLS2};
		{Tree_1, XMLS3} ->
		    {WS++[Tree]++Tree_1, XMLS3}
	    end
    end.

star(_Rule,XML,_Rules,_WSa,Tree,_S) when length(XML)==0->
    {[Tree],[]};
star(Rule,XMLS,Rules,WSaction,Tree,S) ->
    {WS,XMLS1} = whitespace_action(XMLS,WSaction),
    case parse(Rule,XMLS1,Rules,WSaction,S) of
	{error, _E, {{next,N},{act,A}}}->
	    %%io:format("Error~p~n",[_E]),
	    {WS++Tree++A,N};
	{error, _E}->
	    %%io:format("Error~p~n",[_E]),
	    {WS++[Tree],[]};
	{Tree1,XMLS2}->
	    star(Rule,XMLS2,Rules,WSaction,Tree++WS++[Tree1],S)
    end.

question(_Rule, [],_Rules,_S) ->
    {[],[]};
question(Rule, Toks,Rules,S) ->
    %% 0 or 1
    case parse(Rule, Toks,Rules,preserve,S) of
	{error, _E, _Next}->
	    {[],Toks};
	{error, _E} ->
	    {[], Toks};
	{T,Toks1} -> 
	    {T, Toks1}
    end.

seq(H,Toks,Rules,WSaction,S)->
    case seq2(H,Toks,Rules,[],WSaction,S) of
	{error,E}->
	    {error,E};
	{error,R,N}->
	    {error,R,N};
	{Tree,Toks2}->
	    {Tree,Toks2}
    end.

seq2([],[],_,Tree,_WSa,_S)->
    {Tree,[]};
% seq2([],[#xmlElement{name=Name}|_T]=XMLS,_,Tree,_WSa,_S)->
%     {error,{sequence_finish,Name,isnt_in_the_right_place},
%      {{next,XMLS},{act,Tree}}};
seq2([],[#xmlText{}]=XML,_,Tree,_WSa,_S)->
    case whitespace_action(XML,remove) of
	{[],_} ->
	    {error,sequence_finish,{{next,XML},{act,Tree}}};
	{WS,Rest} ->
	    {WS++Tree,Rest}
    end;
seq2([],Rest,_,Tree,_WSa,_S) ->
     {WS,Rest2}=whitespace_action(Rest,remove),
    {WS++Tree,Rest2};
seq2([H|T],Toks,Rules,Tree,WSaction,S) ->
    {WS,Toks1} = whitespace_action(Toks,ws_action(WSaction,remove)),
    case parse(H,Toks1,Rules,remove,S) of %% H maybe only match parts of Toks 
	{error,Reason,_XML}->
	    {error,Reason};
	{error,E}->
	    {error,E};
	{[],Toks2}->
	    seq2(T,Toks2,Rules,Tree,WSaction,S);
	{Tree1,Toks2} when list(Tree1)->
	    seq2(T,Toks2,Rules,Tree++WS++Tree1,WSaction,S);
	{Tree1,Toks2}->
	    seq2(T,Toks2,Rules,Tree++WS++[Tree1],WSaction,S)
    end.

el_name(#xmlElement{name=Name})->
    Name.

parse_pcdata([#xmlText{}=H|T])->
    parse_pcdata(T,[H]);
parse_pcdata(H) ->
    {[],H}.

parse_pcdata([#xmlText{}=H|T],Acc)->
    parse_pcdata(T,Acc++[H]);
parse_pcdata(H,Acc) ->
    {Acc,H}.

whitespace([]) ->
    true;
whitespace([H|T]) when ?whitespace(H) ->
    whitespace(T);
whitespace(_) ->
    false.

whitespace_action(XML,remove) ->
    whitespace_remove(XML,[]);
whitespace_action(XML,_) ->
    {[],XML}.

whitespace_remove([#xmlText{value=V,type=text}=T|R]=L,Acc) ->
    case whitespace(V) of
	true ->
	    whitespace_remove(R,[T|Acc]);
	_ ->
	    {lists:reverse(Acc),L}
    end;
whitespace_remove(L,Acc) ->
    {lists:reverse(Acc),L}.

ws_action(always_preserve=A,_)  ->
    A;
ws_action(_,B) ->
    B.

scan_name(N,_) when atom(N) ->
    N;
scan_name([$\s|T],Acc) ->
    {list_to_atom(lists:reverse(Acc)),T};
scan_name([H|T],Acc) ->
    scan_name(T,[H|Acc]);
scan_name("",Acc) ->
    {list_to_atom(lists:reverse(Acc)),[]}.