The global state of the validator. It is
%% representated by the #xsd_state{} record.
%%
Options allow to customize the behaviour of the %% validation. %%
%%%% Possible options are : %%
%%{tab2file,boolean()}{xsdbase,filename()}{fetch_fun,FetchFun}{fetch_path,PathList}{state,State}A call to validate/2 or validate/3 must provide a well formed
%% parsed XML element #xmlElement{} and a State,
%% global_state(), which holds necessary information from
%% an already processed schema.
%% Thus validate enables reuse of the schema information and
%% therefore if one shall validate several times towards the same
%% schema it reduces time consumption.
The result, ValidElement, is the valid element that conforms to the %% post-schema-validation infoset. When the validator finds an error it %% tries to continue and reports a list of all errors found. In those cases %% an unexpected error is found it may cause a single error reason. %%
%%Usage example:
%%
%% 1>{E,_} = xmerl_scan:file("my_XML_document.xml").
%% 2>{ok,S} = xmerl_xsd:process_schema("my_XML_Schema.xsd").
%% 3>{E2,_} = xmerl_xsd:validate(E,S).
%%
Observe that E2 may differ from E if for instance there are default
%% values defined in my_XML_Schema.xsd.
.xss extension.
state2file(S=#xsd_state{schema_name=SN}) ->
state2file(S,filename:rootname(SN)).
%% @spec state2file(State,FileName) -> ok | {error,Reason}
%% State = global_state()
%% FileName = filename()
%% @doc Saves the schema state with all information of the processed
%% schema in a file. You can provide the file name for the saved
%% state. FileName is saved with the .xss extension
%% added.
state2file(S,FileName) when is_record(S,xsd_state) ->
save_xsd_state(S),
case catch ets:tab2file(S#xsd_state.table,lists:append(FileName,".xss")) of
{'EXIT',Reason} ->
{error,{[],?MODULE,Reason}};
Ret -> Ret
end.
%% @spec file2state(FileName) -> {ok,State} | {error,Reason}
%% State = global_state()
%% FileName = filename()
%% @doc Reads the schema state with all information of the processed
%% schema from a file created with state2file/[1,2]. The
%% format of this file is internal. The state can then be used
%% validating an XML document.
file2state(FileName) ->
case catch ets:file2tab(FileName) of
{ok,Tab} ->
case load_xsd_state(Tab) of
[{state,S}] when is_record(S,xsd_state) ->
xmerl_xsd_vsn_check(S);
%% {ok,S};
Other ->
{error,{[],?MODULE,{incomplete_file,FileName,Other}}}
end;
{error,Reason} ->
{error,{[],?MODULE,Reason}};
Other ->
{error,{[],?MODULE,Other}}
end.
save_xsd_state(S) ->
catch ets:insert(S#xsd_state.table,{state,S}).
load_xsd_state(Table) ->
catch ets:lookup(Table,state).
xmerl_xsd_vsn() ->
case lists:keysearch(vsn,1,xmerl_xsd:module_info(attributes)) of
{value,{_,MD5_VSN}} ->
MD5_VSN;
_ ->
undefined
end.
xmerl_xsd_vsn_check(S=#xsd_state{vsn=MD5_VSN}) ->
case [V||{vsn,V}<-xmerl_xsd:module_info(attributes)] of
[MD5_VSN] ->
{ok,S};
_ ->
{error,{[],?MODULE,{different_version_of_xmerl_xsd_module_used,
state_not_reliable}}}
end.
%% @spec process_validate(Schema,Element) -> Result
%% @equiv process_validate(Schema,Xml,[])
process_validate(Schema,Xml) ->
process_validate(Schema,Xml,[]).
%% @spec process_validate(Schema,Element,Options) -> Result
%% Schema = filename()
%% Element = XmlElement
%% Options = option_list()
%% Result = {ValidXmlElement,State} | {error,Reason}
%% Reason = [ErrorReason] | ErrorReason
%% @doc Validates a parsed well-formed XML element towards an XML
%% schema. Validates in two steps. First it processes the schema, %% saves the type and structure info in an ets table and then %% validates the element towards the schema.
%%Usage example:
%%
%% 1>{E,_} = xmerl_scan:file("my_XML_document.xml").
%% 2>{E2,_} = xmerl_xsd:validate("my_XML_Schema.xsd",E).
%%
Observe that E2 may differ from E if for instance there are default
%% values defined in my_XML_Schema.xsd.
global_state() with schema info or an
%% error reason. The error reason may be a list of several errors
%% or a single error encountered during the processing.
process_schema(Schema,Options) when is_list(Options) ->
State = initiate_state(Options,Schema),
process_schema(Schema, State);
process_schema(Schema, State=#xsd_state{fetch_fun=Fetch})->
case Fetch(Schema, State) of
{ok,{file,File},_} ->
process_schema2(xmerl_scan:file(File), State, Schema);
{ok,{string,Str},_} ->
process_schema2(xmerl_scan:string(Str), State, Schema);
{ok,[],_} ->
{error,enoent};
Err ->
Err
end.
process_schema2(Err={error,_},_,_) ->
Err;
process_schema2({SE,_},State,_Schema) ->
S1 = validate_schema(SE,State),
S2 = validate_schema_ph2(S1),
case schema_concistence_checks(S2) of
S3 = #xsd_state{errors=[]} ->
{ok,S3};
S3 ->
delete_table(S3),
return_error(S3#xsd_state.errors)
end.
%% @spec process_schemas(Schemas) -> Result
%% @equiv process_schema(Schemas,[])
process_schemas(Schemas) ->
process_schemas(Schemas,[]).
%% @spec process_schemas(Schemas,Options) -> Result
%% Schemas = [{NameSpace,filename()}|Schemas] | []
%% Result = {ok,State} | {error,Reason}
%% Reason = [ErrorReason] | ErrorReason
%% Options = option_list()
%% @doc Reads the referenced XML schemas and controls they are valid.
%% Returns the global_state() with schema info or an
%% error reason. The error reason may be a list of several errors
%% or a single error encountered during the processing.
process_schemas(Schemas=[{_,Schema}|_],Options) when is_list(Options) ->
State = initiate_state(Options,Schema),
process_schemas(Schemas, State);
process_schemas([{_NS,Schema}|Rest],State=#xsd_state{fetch_fun=Fetch}) ->
Res=
case Fetch(Schema,State) of
{ok,{file,File},_} ->
process_schema2(xmerl_scan:file(File),State,Schema);
{ok,{string,Str},_} ->
process_schema2(xmerl_scan:string(Str),State,Schema);
{ok,[],_} ->
{ok,State};
Err ->
Err
end,
case Res of
{ok,S2} ->
process_schemas(Rest,S2);
_ ->
Res
end;
process_schemas([],S) when is_record(S,xsd_state) ->
{ok,S}.
initiate_state(Opts,Schema) ->
XSDBase = filename:dirname(Schema),
{{state,S},RestOpts}=new_state(Opts),
S2 = create_tables(S),
initiate_state2(S2#xsd_state{schema_name = Schema, xsd_base=XSDBase,
fetch_fun = fun fetch/2},
RestOpts).
initiate_state2(S,[]) ->
S;
initiate_state2(S,[{tab2file,Bool}|T]) ->
initiate_state2(S#xsd_state{tab2file=Bool},T);
initiate_state2(S,[{xsdbase, XSDBase}|T]) ->
initiate_state2(S#xsd_state{xsd_base=XSDBase, external_xsd_base=true},T);
initiate_state2(S,[{fetch_fun,FetchFun}|T]) ->
initiate_state2(S#xsd_state{fetch_fun=FetchFun},T);
initiate_state2(S,[{fetch_path,FetchPath}|T]) ->
initiate_state2(S#xsd_state{fetch_path=FetchPath},T);
initiate_state2(S,[{schema_preprocessed,Bool}|T]) ->
initiate_state2(S#xsd_state{schema_preprocessed=Bool},T);
initiate_state2(S,[{target_namespace,_NS}|T]) ->
%% initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T);
initiate_state2(S,T); %% used in validation phase
initiate_state2(S,[H|T]) ->
error_msg("~w: invalid option: ~p~n",[?MODULE, H]),
initiate_state2(S,T).
validation_options(S,[{target_namespace,NS}|T]) ->
validation_options(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T);
validation_options(S,[_H|T]) ->
validation_options(S,T);
validation_options(S,[]) ->
S.
new_state(Opts) ->
XSD_VSN = xmerl_xsd_vsn(),
keysearch_delete(state,1,Opts,{state,#xsd_state{vsn=XSD_VSN}}).
%% validate_schema/2 traverses the shema element to save necessary
%% information as defined elements and types.
validate_schema(E=#xmlElement{},
S) ->
%% namespace is always a xmlNamespace record, attributs a list of
%% #xmlAttributes and content a list of #xmlElements|#xmlText|...
%% Have to save namespace nodes. Use of namespace in paths for
%% unique,key and keyref are used after the schema is processed.
S1 = S#xsd_state{targetNamespace=target_namespace(E)},
case is_already_processed(S1#xsd_state.targetNamespace,S1) of
true ->
save_namespace_definition(S1#xsd_state.targetNamespace,S1);
_ ->
S2 = S1,%save_namespace_definition(S1#xsd_state.targetNamespace,S1),
{CM,S3} = traverse_content(E,S2),
save_schema_element(CM,S3),
S3
end.
validate_schema_ph2(S=#xsd_state{derived_types=[]}) ->
S;
validate_schema_ph2(S=#xsd_state{derived_types=DT}) ->
deduce_derived_types(DT,S).
%% traverse_content/2 creates the content model of the schema.
%% content model depends on (1) the type:
%% complex type:
%% sequence, choice, all
%% simple type: no content other than characters
%% (2) minOccurs/maxOccurs attributes.
%% The schema for schemas content model is:
%% schema: ((include | import | redefine | annotation)*,
%% (((simpleType | complexType | group | attributeGroup)
%% | element | attribute | notation), annotation*)*)
%% attribute: (annotation?, simpleType?)
%% element: (annotation?, ((simpleType | complexType)?, (unique |
%% key | keyref)*))
%% complexType: (annotation?, (simpleContent | complexContent |
%% ((group | all | choice | sequence)?,
%% ((attribute | attributeGroup)*,anyAttribute?))))
%% attributeGroup:(annotation?,
%% ((attribute | attributeGroup)*, anyAttribute?))
%% group: (annotation?, (all | choice | sequence)?)
%% all: (annotation?, element*)
%% sequence: (annotation?,
%% (element | group | choice | sequence | any)*)
%% choice: (annotation?, (element | group | choice | sequence |
%% any)*)
%% any: (annotation?) any wellformed xml inside "any"
%% unique: (annotation?, (selector, field+))
%% key: (annotation?, (selector, field+))
%% keyref: (annotation?, (selector, field+))
%% selector: (annotation?)
%% field: (annotation?)
%% notation: (annotation?)
%% annotation: (appinfo | documentation)*
%% appinfo: ({any})*
%% documentation: ({any})*
%% simpleType: (annotation?, (restriction | list | union))
%% restriction: (annotation?, (simpleType?, (minExclusive |
%% minInclusive | maxExclusive | maxInclusive |
%% totalDigits | fractionDigits | length | minLength |
%% maxLength | enumeration | whiteSpace | pattern)*))
%% list: (annotation?, simpleType?)
%% union: (annotation?, simpleType*)
%% include: (annotation?)
%% import: (annotation?)
%% redefine: (annotation | (simpleType | complexType | group |
%% attributeGroup))*
traverse_content(E=#xmlElement{name=Name},S) ->
case local_name(Name) of
schema ->
Content = E#xmlElement.content,
%% S1 = S#xsd_state{targetNamespace=target_namespace(E)},
ThisNS = {"#this#",S#xsd_state.schema_name,
S#xsd_state.targetNamespace},
S2 = S#xsd_state{checked_namespace_nodes=
add_once(ThisNS,S#xsd_state.checked_namespace_nodes)},
S3 = namespace_nodes(E,S2),
S4 = element_form_default(E,S3),
S5 = attribute_form_default(E,S4),
S6 = substitution_default(finalDefault,E,S5),
S7 = substitution_default(blockDefault,E,S6),
traverse_content2(Content,S7,[]);
Err ->
exit({error,{[],?MODULE,{schema_error,Err}}})
end.
traverse_content2([],S,Acc) ->
{reverse(remove_annotation(Acc)),reset_scope(S)};
traverse_content2([El|Els],S,Acc) when is_record(El,xmlElement) ->
%% element declaration: save name, type, scope.
{Object,S2} = element_content(kind(El,S),El,S#xsd_state.scope),%% Object={Kind,Obj}
traverse_content2(Els,S2,[Object|Acc]);
traverse_content2([_T|Els],S,Acc) -> %% xmlText,xmlPI ...
traverse_content2(Els,S,Acc).
target_namespace(E) ->
case get_attribute_value(targetNamespace,E,undefined) of
URI when is_list(URI) ->
list_to_atom(URI);
URI ->
URI
end.
%% namespace_nodes/2 ->
%% NS.
namespace_nodes(#xmlElement{namespace=#xmlNamespace{nodes=NS}},
S=#xsd_state{namespace_nodes=NSN,
global_namespace_nodes=GNSN}) ->
S2 =S#xsd_state{namespace_nodes=foldl(fun add_once/2,NSN,NS)},
S2#xsd_state{global_namespace_nodes=
add_key_once(S#xsd_state.targetNamespace,1,
{S#xsd_state.targetNamespace,NS},
GNSN)}.
attribute_form_default(#xmlElement{attributes=Atts},S)->
Def=form_default(attributeFormDefault,Atts,S),
S#xsd_state{attributeFormDefault=Def}.
element_form_default(#xmlElement{attributes=Atts},S) ->
Def=form_default(elementFormDefault,Atts,S),
S#xsd_state{elementFormDefault=Def}.
form_default(Key,Atts,_S) ->
case keyNsearch(Key,#xmlAttribute.name,Atts,unqualified) of
#xmlAttribute{value=V} when is_list(V) -> list_to_atom(V);
#xmlAttribute{value=V} ->V;
_-> unqualified
end.
substitution_default(Subst = finalDefault,El,S) ->
S#xsd_state{finalDefault = substitution(Subst,El,S)};
substitution_default(Subst = blockDefault,El,S) ->
S#xsd_state{blockDefault = substitution(Subst,El,S)}.
substitution(Subst,El,_S) ->
split_by_whitespace(get_attribute_value(Subst,El,[]),[]).
%% element_content may be one of: annotation, type def(simple or
%% complex), import, unique, key, keyref, attribute def, attribute
%% group, all, group, complexContent, simpleContent, choice, sequence
element_content({attribute,S=#xsd_state{scope=Scope}},Att,Env) ->
case qualify_NCName(Att,S) of
no_name ->
Ref = attribute_ref(Att),
AttRef =
{attribute,get_QName(Ref,Att#xmlElement.namespace, %%QQQ
reset_scope(S))},
{AttRef,add_ref(S,AttRef)};
Name ->
{AttrType,S2} = attribute_type(Att,[Name|Env],S),
S3 = check_cm(attribute,allowed_content(attribute,Env),AttrType,S2),
{Attr,S4} = attribute_properties(Att#xmlElement.attributes,
#schema_attribute{type=AttrType},S3),
Object = {attribute,
Attr#schema_attribute{name=Name,scope=Scope}},
S5 = save_object(Object,S4),
{{attribute,Name},S5}
end;
element_content({element,S},El,Env) ->
%% The type of an element may be a simple or complex type (named
%% or anonymous), a referenced name or member of a substitution group.
case qualify_NCName(El,S) of
no_name ->
Ref = particle_ref(El),
{Occ,S2} = occurance(El,{1,1},S),
%% 3.3.3 bullet 2.2
S3 = element_forbidden_properties(El,S2),
S4 = element_forbidden_content(El#xmlElement.content,S3),
ElRef =
{element,
{get_QName(Ref,El#xmlElement.namespace,reset_scope(S)),
Occ}},
{ElRef,add_ref(S4,ElRef)};
Name ->
{Type,S2} = element_type(El,[Name|Env],S),
S3 = check_cm(element,allowed_content(element,Env),Type,S2),
Type2 = remove_annotation(Type),
Unique = [X||X={unique,_} <- Type2],
Key = [X||X={K,_} <- Type2,K == key orelse K==keyref],
{Occur,S4} = occurance(El,{1,1},S3),
{SE,S5} = element_properties(El#xmlElement.attributes,
#schema_element{},El,S4),
CM = remove_attributes([X||X={Y,_}<-Type2,
unique=/=Y,key=/=Y,
keyref=/=Y,annotation=/=Y]),
%% take care of key/keyref later
SE2 = SE#schema_element{name=Name,type=CM,uniqueness=Unique,
key=Key, occurance=Occur,
scope=S5#xsd_state.scope},
S6 = insert_substitutionGroup(SE2,S5),
S7 = save_object({element,SE2},S6),
{{element,{Name,Occur}},S7}
end;
element_content({complexType,S},CT,Env) ->
%% complex type definition without a name is returnd and added to
%% the content model at this level. A complex type may also contain
%% attributes or attribute group references in the end of its content.
%%?debug("complexType content: ~p~nenv: ~p~n",[CT,Env]),
{SCT,S1} = c_t_properties(CT,#schema_complex_type{},S),
{Mixed,S2} = mixed(CT,S1),
Complexity = complexity(CT#xmlElement.content),
{Object,Name,S7} =
case qualify_NCName(CT,S2) of
no_name ->
{CM,S3} = type(CT#xmlElement.content,
in_scope(anonymous,S2),[complexType|Env]),
S4 = check_cm(complexType,allowed_content(complexType,Env),CM,S3),
Name1 = get_QName('_xmerl_no_name_',CT#xmlElement.namespace,S4),
S5 = set_scope(S#xsd_state.scope,S4),
{Content,Attributes}=split_content(remove_annotation(CM)),
SCT2 = base_type(Content,SCT),
CTObj =
{complexType,
SCT2#schema_complex_type{name=Name1,
scope=S5#xsd_state.scope,
attributes=Attributes,
complexity=Complexity,
content=mixify(Mixed,Content)}},
{CTObj,Name1,S5};
Name2 ->
S3 = in_scope(Name2,S2),
S3a = push_circularity_mark({typeDef,Name2},S3),
{CM,S4} = type(CT#xmlElement.content,S3a,
[complexType|Env]),
S4a = pop_circularity_mark({typeDef,Name2},S4),
S5 = check_cm(complexType,allowed_content(complexType,Env),
CM,S4a),
S6 = set_scope(S#xsd_state.scope,S5),
{Content,Attributes}=split_content(remove_annotation(CM)),
SCT2 = base_type(Content,SCT),
{{complexType,
SCT2#schema_complex_type{name=Name2,
scope=S6#xsd_state.scope,
attributes=Attributes,
complexity=Complexity,
content=mixify(Mixed,Content)}},
Name2,S6}
end,
S8 = save_object(Object,S7),
S9 = derived_type(Object,S8),
{{complexType,Name},S9};
element_content({attributeGroup,S},AG,Env) ->
%% an attribute group always have a name or a ref, the content is
%% (annotation?,(attribute | attributGroup)*, anyAttribute?).
case qualify_NCName(AG,S) of
no_name ->
%% an attribute group ref inside complex type def or attr
%% group def ( XSD1:3.6.2).
Ref = attributeGroup_ref(AG),
AGRef =
{attributeGroup,get_QName(Ref,AG#xmlElement.namespace,%%QQQ
reset_scope(S))},
{AGRef,add_ref(S,AGRef)};
Name ->
%% must occur on top level of schema( XSD1:3.6.2). The
%% only thing needed in content are the names of all
%% attributes or referenced attribute groups.
{CM,S2} = type(AG#xmlElement.content,in_scope(Name,S),
[attributeGroup|Env]),
S2_1 = out_scope(Name,S2),
S3 = check_cm(attributeGroup,allowed_content(attributeGroup,Env),CM,S2_1),
S4 = save_object({attributeGroup,
#schema_attribute_group{name=Name,
content=keep_attributes(CM)}},S3),
{{attributeGroup,Name},S4}
end;
element_content({group,S},G,Env) ->
%% a model group associates a name with a content model. It can be
%% a reference or a definition.
%% content is one of all, choice or sequence.
case qualify_NCName(G,S) of
no_name -> % reference.
%% If reference is a recursive ref to a group with the
%% same name as this group points at the redefined valid
%% schema group. See XMLSchema part 1, section 4.2.2
%% "Schema Representation Constraint: Individual Component
%% Redefinition"
Ref = particle_ref(G),
{Occur,S2} = occurance(G,{1,1},S),
GRef =
{group,
{get_QName(Ref,G#xmlElement.namespace,reset_scope(S2)),%%QQQ
Occur}},
{GRef,add_ref(S2,GRef)};
Name -> % definition, always schema or redefine as parent
{CM,S2} = type(G#xmlElement.content,in_scope(Name,S),[group|Env]),
CM2 = recursive_redefine(Name,CM,S2),
S2_1 = out_scope(Name,S2),
S3 = check_cm(group,allowed_content(group,Env),CM2,S2_1),
S4 = save_object({group,#schema_group{name=Name,
content=remove_annotation(CM2)}},S3),
{{group,Name},S4}
end;
element_content({all,S},All,Env) ->
%% each element occurs 0 or 1 times in any order
%% {all,[{element_name,occurance}]}
%% CM = content_model(Seq#xmlElement.content,S,[all|Env]),
{Occur,S1} = occurance(All,{1,1},S),
{CM,S2} = type(All#xmlElement.content,S1,[all|Env]),
S3 = check_cm(all,allowed_content(all,Env),CM,S2),
{{all,{[X||X = {element,_} <- CM],Occur}},S3};
element_content({sequence,S},Seq,Env) ->
%% {sequence,[{element_name,occurance}]}
%% CM = content_model(Seq#xmlElement.content,S,[sequence|Env]),
{Occur,S1} = occurance(Seq,{1,1},S),
{CM,S2} = type(Seq#xmlElement.content,S1,[sequence|Env]),
S3 = check_cm(sequence,allowed_content(sequence,Env),CM,S2),
{{sequence,{remove_annotation(CM),Occur}},S3};
element_content({choice,S},Choice,Env) ->
%% allowed content: (annotation?,
%% (element | group | choice | sequence | any)*)
%% returns: {choice,[element_name]}
%% CM = content_model(Choice#xmlElement.content,S,[choice|Env]),
{Occur,S1} = occurance(Choice,{1,1},S),
{CM,S2} = type(Choice#xmlElement.content,S1,[choice|Env]),
S3 = check_cm(choice,allowed_content(choice,Env),CM,S2),
{{choice,{remove_annotation(CM),Occur}},S3};
element_content({any,S},Any,_Env) ->
{Occur,S1} = occurance(Any,{1,1},S),
NameSpace = wildcard_namespace(Any,S1),
PC = processor_contents(Any),
?debug("element_content, any: Any content:~p~n",[Any#xmlElement.content]),
Pred = fun(E=#xmlElement{}) -> case kind(E) of
annotation -> false;
_ -> true
end;
(_) ->
false
end,
S2 = case filter(Pred,Any#xmlElement.content) of
[] -> S1;
Err -> %% report error
acc_errs(S1,{error_path(Any,Any#xmlElement.name),?MODULE,
{unexpected_content_in_any,Err}})
end,
{{any,{NameSpace,Occur,PC}},S2};
element_content({IDC,S},El,Env)
when IDC==unique;IDC==key;IDC==keyref->
QName = qualify_NCName(El,reset_scope(S)),
Ref = keyrefer(IDC,El,S),
{SelField,S2} = type(El#xmlElement.content,S,[IDC|Env]),
case {[X||X={selector,_} <- SelField],[X||X={field,_} <- SelField]} of
{[Sel],Fields=[_H|_T]} ->
IDConstr = #id_constraint{category=IDC,name=QName,refer=Ref,
selector=Sel,fields=Fields},
S3=save_idc(IDC,IDConstr,S2),
{{IDC,IDConstr},S3};
Err ->
S3 = acc_errs(S2,{error_path(El,El#xmlElement.name),?MODULE,
{erroneous_content_in_identity_constraint,IDC,Err}}),
{{IDC,[]},S3}
end;
element_content({selector,S},Sel,_Env) ->
case get_attribute_value(xpath,Sel,error) of
error ->
S2 = acc_errs(S,{error_path(Sel,Sel#xmlElement.name),?MODULE,
{missing_xpath_attribute,selector}}),
{{selector,[]},S2};
XPath ->
{{selector,XPath},S}
end;
element_content({field,S},F,_Env) ->
case get_attribute_value(xpath,F,error) of
error ->
S2 = acc_errs(S,{error_path(F,F#xmlElement.name),?MODULE,
{missing_xpath_attribute,field}}),
{{field,[]},S2};
XPath ->
{{field,XPath},S}
end;
element_content({notation,S},_N,_Env) ->
{{notation,[]},S};
element_content({annotation,S},_Ann,_Env) ->
{{annotation,[]},S};
element_content({appinfo,S},_AI,_Env) ->
{{appinfo,[]},S};
element_content({documentation,S},_D,_Env) ->
{{documentation,[]},S};
element_content({simpleType,S},ST,Env) ->
Name = case qualify_NCName(ST,S) of
no_name ->
get_QName('_xmerl_no_name_',ST#xmlElement.namespace,
in_scope('_xmerl_no_name_',S));%%---
QName ->
QName
end,
{Type,S2} = type(ST#xmlElement.content,
push_circularity_mark({typeDef,Name},in_scope(Name,S)),
[simpleType|Env]),
S2_1 = pop_circularity_mark({typeDef,Name},S2),
S3 = set_scope(S#xsd_state.scope,S2_1),
S4 = check_cm(simpleType,allowed_content(simpleType,Env),Type,S3),
{BaseType,Facets} = facets(Type,S4),
Variety = variety(Type),
Final = simpleType_final(ST,S4),
Object = {simpleType,#schema_simple_type{name=Name,
base_type=BaseType,
final=Final,
facets=Facets,
variety=Variety,
content=remove_annotation(Type),
scope=S4#xsd_state.scope}},
S5 = save_object(Object,S4),
S6 = derived_type(Object,S5),
{{simpleType,Name},S6};
element_content({restriction,S},R,Env) ->
%% If complexContent, all element definitions of base type must be
%% repeated. However, attributes are inherited.
%% possible parents are simpleType or complexType (grand parent)
%% If parent is simpleType the base type is either the attribute
%% base (resolved by base_type/1) or the type defined in content.
{CM,S2} = type(R#xmlElement.content,S,[restriction|Env]),
S3 = check_cm(restriction,allowed_content(restriction,Env),CM,S2),
{BaseTypeName,CM2,S4} = restriction_base_type(R,CM,S3), %% a QName
%% S5 = add_circularity_mark(BaseTypeName,S4),
BaseTypeType = base_type_type(Env),
{{restriction,{BaseTypeName,remove_annotation(CM2)}},
add_ref(S4,{BaseTypeType,BaseTypeName})}; %% Does not return name but content model
element_content({list,S=#xsd_state{scope=Scope}},L,Env) ->
{Type,S2} = list_type(L,S,[list|Env]),
S3 = check_cm(list,allowed_content(list,Scope),Type,S2),
{{list,remove_annotation(Type)},S3};
element_content({union,S=#xsd_state{scope=Scope}},U,Env) ->
{Types,S2} = union_types(U,S,[union|Env]),
S3 = check_cm(union,allowed_content(union,Scope),Types,S2),
{{union,Types},S3};
element_content({include,S=#xsd_state{schema_name=ThisSchema,
targetNamespace=TNS}},I,_Env) ->
S2 = process_external_schema_once(I,S#xsd_state.targetNamespace,S),
{{include,[]},S2#xsd_state{schema_name=ThisSchema,targetNamespace=TNS}};
element_content({import,S=#xsd_state{schema_name=ThisSchema,
targetNamespace=ThisNameS}},I,_Env) ->
%% import unlike include and redefine may include definitions from
%% other namespaces than the target namespace of the including
%% schema.
%% namespace and schemaLocation
Namespace =
case get_attribute_value(namespace,I,undefined) of
L when is_list(L) ->
list_to_atom(L);
A -> A
end,
%% If Namespace is absent, then the import allows unqualified
%% reference to components with no target namespace.
SchemaLocation = get_attribute_value(schemaLocation,I,absent),
%% If SchemaLocation is absent, the identification of that schema
%% is leaved to the instance, application or user, via the
%% mechanisms described §4.3 in XML Schema Part 1.
S2 = process_external_schema_once(SchemaLocation,Namespace,S),
{{import,[]},S2#xsd_state{schema_name=ThisSchema,
targetNamespace=ThisNameS}};
element_content({redefine,S=#xsd_state{schema_name=ThisSchema}},RD,Env) ->
%% Must be a child of "schema" element
%% redefine of simple and complex types, groups and attribute
%% groups obtained from external files.
%% Brings in all definitions of external schema and redefines one.
%% External schema must be in same namespace as current schema or
%% no namespace.
S2 = process_external_schema_once(RD,S#xsd_state.targetNamespace,
S#xsd_state{errors=[]}),
case S2#xsd_state.errors of
[] ->
%% RedefSource = S2#xsd_state.schema_name,
S3 = S2#xsd_state{schema_name=ThisSchema,
%% global_element_source=add_once({ThisSchema,RedefSource},GES),
errors=S#xsd_state.errors},
{CM,S4} = type(RD#xmlElement.content,
S3#xsd_state{redefine=true},[redefine|Env]),
S5 = S4#xsd_state{redefine=false},
S6 = check_cm(redefine,allowed_content(redefine,Env),CM,S5),
S7 = redefine(CM,S6),
{{redefine,[]},S7};
Errs ->
S3 = S2#xsd_state{schema_name=ThisSchema,
errors=Errs++S#xsd_state.errors},
{{redefine,[]},S3}
end;
element_content({anyAttribute,S},AA,_Env) ->
%% has attributes processContents = (lax | skip | strict) : strict
%% namespace = ((##any | ##other) |
%% List of (anyURI | (##targetNamespace | ##local)) ) : ##any
NameSpace = wildcard_namespace(AA,S),
PC = processor_contents(AA),
Pred = fun(E=#xmlElement{}) -> case kind(E) of
annotation -> false;
_ -> true
end;
(_) -> false
end,
S2 =
case filter(Pred,AA#xmlElement.content) of
[] -> S;
Err -> %% report error
acc_errs(S,{error_path(AA,AA#xmlElement.name),?MODULE,
{content_in_anyAttribute,Err}})
end,
{{anyAttribute,{NameSpace,PC}},S2};
element_content({simpleContent,S},SC,Env) ->
%% only as child of complexType.
%% allowed content: (annotation?, (restriction | extension))
S2 = pre_check_cm(simpleContent,SC#xmlElement.content,mk_name(S#xsd_state.scope),S),
case filter(fun(X=#xmlElement{}) ->
case kind(X) of
restriction -> true;
extension -> true;
_ -> false
end;
(_) -> false
end,
SC#xmlElement.content) of
[E] ->
element_content(kind(E,S2),E,[simpleContent|Env]);
Err ->
{[],acc_errs(S2,{error_path(SC,SC#xmlElement.name),?MODULE,
{content_in_simpleContent,Err}})}
end;
element_content({complexContent,S},CC,Env) ->
S2 = pre_check_cm(complexContent,CC#xmlElement.content,
mk_name(S#xsd_state.scope),S),
%% the mixed attribute was fetched in the complexType element that
%% held this complexContent
case filter(fun(X=#xmlElement{}) -> case kind(X) of
restriction -> true;
extension -> true;
_ -> false
end;
(_) -> false
end,CC#xmlElement.content) of
[E] ->
element_content(kind(E,S2),E,[complexContent|Env]);
Err ->
{[],acc_errs(S2,{error_path(CC,CC#xmlElement.name),?MODULE,
{complexContent_content_failure,Err}})}
end;
element_content({extension,S},Ext,Env) ->
%% may be used in both simple and complex content with different
%% content allowed.
%% this should be returned and checked for allowed content in
%% parent, but we don't know if base type is a forward reference.
BaseType = base_type(Ext),
{CM,S2} = type(Ext#xmlElement.content,S,[extension|Env]),
S3 = check_cm(extension,allowed_content(extension,S#xsd_state.scope),CM,S2),
BaseTypeName = get_QName(BaseType,Ext#xmlElement.namespace,reset_scope(S)),%%QQQ
BaseTypeType = base_type_type(Env),
{{extension,{BaseTypeName,CM}},add_ref(S3,{BaseTypeType,BaseTypeName})};
%% The following are facets
element_content({minExclusive,S},CF,_Env) ->
Value = get_value(CF),
{{minExclusive,Value},S};
element_content({minInclusive,S},CF,_Env) ->
Value = get_value(CF),
{{minInclusive,Value},S};
element_content({maxExclusive,S},CF,_Env) ->
Value = get_value(CF),
{{maxExclusive,Value},S};
element_content({maxInclusive,S},CF,_Env) ->
Value = get_value(CF),
{{maxInclusive,Value},S};
element_content({totalDigits,S},CF,_Env) ->
Value = get_value(CF),
{{totalDigits,Value},S};
element_content({fractionDigits,S},CF,_Env) ->
Value = get_value(CF),
{{fractionDigits,Value},S};
element_content({length,S},CF,_Env) ->
Value = get_value(CF),
{{length,Value},S};
element_content({minLength,S},CF,_Env) ->
Value = get_value(CF),
{{minLength,Value},S};
element_content({maxLength,S},CF,_Env) ->
Value = get_value(CF),
{{maxLength,Value},S};
element_content({enumeration,S},CF,_Env) ->
Value = get_value(CF),
{{enumeration,Value},S};
element_content({whiteSpace,S},CF,_Env) ->
Value = get_value(CF),
{{whiteSpace,Value},S};
element_content({pattern,S},CF,_Env) ->
Value = get_value(CF),
{{pattern,Value},S};
element_content({Other,S=#xsd_state{errors=Errs}},C,_Env) ->
case Errs of
[] ->
{[],acc_errs(S,{error_path(C,C#xmlElement.name),?MODULE,
{unknown_content,Other}})};
_ ->
{[],S}
end.
type(C,S,Env) ->
type(C,S,Env,[]).
type([E=#xmlElement{}|Els],S,Env,Acc) ->
{CM,S2} = element_content(kind(E,S),E,Env),
type(Els,set_scope(S#xsd_state.scope,S2),
Env,[CM|Acc]);
type([_H|Els],S,Env,Acc) ->
type(Els,S,Env,Acc);
type([],S,_Env,Acc) ->
{flatten(reverse(Acc)),S}.
simpleUrType() ->
{anySimpleType,[]}.
%% simpleUrTypeRef() ->
%% {anySimpleType,[],'http://www.w3.org/2001/XMLSchema'}.
urType() ->
{anyType,[]}.
attribute_type(Att,Env=[Name|_],S) ->
%% The attribute type may be referenced by the type attribute or
%% explicitly defined as a simpleType inside the attribute
%% element. In the latter case the type must be saved with the
%% unique name of the scope and name attribute combined.
{CM,S2} = type(Att#xmlElement.content,in_scope(Name,S),Env),
case remove_annotation(CM) of
[] ->
case keyNsearch(type,#xmlAttribute.name,
Att#xmlElement.attributes,[]) of
#xmlAttribute{value=SimpleTypeName} -> %% a QName as string
%% This name may be a forward reference to a simple type.
TypeRef = {simpleType,get_QName(SimpleTypeName, %%QQQ
Att#xmlElement.namespace,
reset_scope(S))},
{[TypeRef],
set_scope(S#xsd_state.scope,add_ref(S2,TypeRef))};
_ -> {[{simpleType,simpleUrType()}],
set_scope(S#xsd_state.scope,S2)}
end;
Type ->
{Type,set_scope(S#xsd_state.scope,S2)}
end.
element_type(El,Env=[Name|_],S) ->
%% In the top environment of the schema there may exist: global
%% element declarations, substitution group members.
%% Other element declarations are local
{CM,S2} = type(El#xmlElement.content,in_scope(Name,S),Env),
case remove_annotation(CM) of
[] -> %% no simple or complex type definition
case {get_attribute_value(type,El,no_name),
get_attribute_value(substitutionGroup,El,undefined)} of
{no_name,SGName} when is_list(SGName) ->
QN = get_QName(SGName,El#xmlElement.namespace,reset_scope(S)),%%QQQ
case is_simple_type(QN,S2) of
true ->
exit(this_can_never_happen),
%% A substitutionGroup is an element, and
%% the type of this element is the
%% resolved type of the referenced
%% element.
TRef = {simpleType,QN},
{[TRef],
add_ref(set_scope(S#xsd_state.scope,S2),TRef)};
_ ->
{[{substitutionGroup,QN}],
set_scope(S#xsd_state.scope,S2)}
end;
{TName,_} when is_list(TName) ->
QN = get_QName(TName,El#xmlElement.namespace,reset_scope(S2)),%%QQQ
case is_simple_type(QN,S2) of
true ->
TRef={simpleType,QN},
{[TRef],
add_ref(set_scope(S#xsd_state.scope,S2),TRef)};
_ ->
TRef = {simple_or_complex_Type,QN},
{[TRef],
add_ref(set_scope(S#xsd_state.scope,S2),TRef)}
end;
_ ->
case {get_attribute_value(ref,El,no_name),
is_global_env(Env)} of
{Ref,false} when is_list(Ref) ->
%% a ref attribute references an element
{[{element,
get_QName(Ref,El#xmlElement.namespace,%%QQQ
reset_scope(S))}],
set_scope(S#xsd_state.scope,S2)};
_ ->
{[urType()],
set_scope(S#xsd_state.scope,S2)}
end
end;
%% Type ->
%% {Type,set_scope(S#xsd_state.scope,S2)}
_Type ->
{CM,set_scope(S#xsd_state.scope,S2)}
end.
%% list_type/3 -> list() | name()
list_type(L,S,Env) ->
case keyNsearch(itemType,#xmlAttribute.name,L#xmlElement.attributes,[]) of
[] ->
%% {element(1,type(L#xmlElement.content,S,Env)),S};
type(L#xmlElement.content,S,Env);
#xmlAttribute{value=V} ->
%% this type should be preliminary saved and checked after
%% the parsing of the schema.
TypeRef ={simpleType,
get_QName(V,L#xmlElement.namespace,reset_scope(S))},
{[TypeRef],add_ref(S,TypeRef)}
end.
union_types(U,S,Env) ->
{MemberTypes,S2} =
case keyNsearch(memberTypes,#xmlAttribute.name,U#xmlElement.attributes,[]) of
[] ->
{[],S};
#xmlAttribute{value = NameString} ->
Names = namestring2namelist(NameString),
UTypeRefs =
[{simpleType,get_QName(X,U#xmlElement.namespace,
reset_scope(S))}||X<-Names],
{UTypeRefs,foldl(fun(X,S_in) -> add_ref(S_in,X) end,S,UTypeRefs)}
end,
{DefinedTypes,S3} = union_types1(U#xmlElement.content,S2,Env),
{MemberTypes++DefinedTypes,S3}.
union_types1(C,S,Env) ->
union_types1(C,S,Env,[]).
union_types1([],S,_Env,Acc) ->
{Acc,S};
union_types1([C=#xmlElement{}|Cs],S,Env,Acc) ->
case element_content(kind(C,S),C,Env) of
{ST={simpleType,_},S2} ->
union_types1(Cs,S2,Env,[ST|Acc]);
{{annotation,_},S2} ->
union_types1(Cs,S2,Env,Acc);
{IllegalType,S2} ->
Err = {error_path(C,C#xmlElement.name),?MODULE,
{union_member_type_not_simpleType,IllegalType}},
union_types1(Cs,acc_errs(S2,Err),Env,Acc)
end;
union_types1([_H|T],S,Env,Acc) ->
union_types1(T,S,Env,Acc).
%% If a group in a redefine refer to itself the reference is to the
%% "old" definition of the group. See XMLSchema part 1, section 4.2.2
%% "Schema Representation Constraint: Individual Component
%% Redefinition"
recursive_redefine(Name,CM,S=#xsd_state{redefine=true}) ->
case remove_annotation(CM) of
[{MG,{C,Occ}}] ->
[{MG,{recursive_redefine2(Name,C,S),Occ}}];
_ ->
CM
end;
recursive_redefine(_,CM,_) ->
CM.
recursive_redefine2(Name,[{group,{Name,Occ}}|T],S) ->
%% Rename old group definition
case rename_redef_group(Name,S) of
failed ->
[{group,{Name,Occ}}|T];
NewName ->
[{group,{NewName,Occ}}|T]
end;
recursive_redefine2(Name,[{MG,{C,Occ}}|T],S)
when MG =:= sequence; MG =:= choice; MG=:= all; MG=:= group ->
C2 = recursive_redefine2(Name,C,S),
[{MG,{C2,Occ}}|recursive_redefine2(Name,T,S)];
recursive_redefine2(Name,[H|T],S) ->
[H|recursive_redefine2(Name,T,S)];
recursive_redefine2(_,[],_) ->
[].
rename_redef_group(Name={LN,Scope,NS},S) ->
%% Scope must be []
NewName = {LN,['#redefine'|Scope],NS},
case resolve({group,NewName},S) of
{SG=#schema_group{name=Name},_} ->
save_object({group,SG#schema_group{name=NewName}},S),
NewName;
_ ->
failed
end.
add_ref(S=#xsd_state{unchecked_references=UR},STRef={simpleType,Ref}) ->
case {is_builtin_simple_type(Ref),Ref} of
{true,_} ->
S;
{_,{'',_,_}} ->
S;
_ ->
S2 = S#xsd_state{unchecked_references=add_once(STRef,UR)},
add_circularity_ref(STRef,S2)
end;
add_ref(S=#xsd_state{unchecked_references=UR},STRef={simple_or_complex_Type,Ref}) ->
case {is_builtin_simple_type(Ref),Ref} of
{true,_} ->
S;
{_,{'',_,_}} ->
S;
{_,{anyType,_,?XSD_NAMESPACE}} ->
S;
{_,{anySimpleType,_,?XSD_NAMESPACE}} ->
S;
_ ->
S2 = S#xsd_state{unchecked_references=add_once(STRef,UR)},
add_circularity_ref(STRef,S2)
end;
add_ref(S,{complexType,{anyType,_,?XSD_NAMESPACE}}) ->
S;
add_ref(S=#xsd_state{unchecked_references=UR},Ref) ->
S2 = S#xsd_state{unchecked_references=add_once(Ref,UR)},
add_circularity_ref(Ref,S2).
%% add_ref(S=#xsd_state{unchecked_references=UR},Ref) ->
%% S#xsd_state{unchecked_references=add_once(Ref,UR)}.
%% Name of simpleType/complexType is unique within the whole
%% environment, which is checked elsewhere, so ignore the kind of type
%% for simplicity.
add_circularity_ref(Ref={Kind,To},S=#xsd_state{circularity_disallowed=CD,
redefine=false})
when Kind==simpleType;Kind==simple_or_complex_Type;Kind==complexType ->
case get_circularity_mark(Ref,S) of
[] ->
S;
From -> %% This is the node from which the graph reaches Ref
S#xsd_state{circularity_disallowed=add_once({From,{typeDef,To}},CD)}
end;
add_circularity_ref(_,S) ->
S.
get_circularity_mark({TD,_},S)
when TD==simpleType;TD==complexType;TD==simple_or_complex_Type ->
case S#xsd_state.circularity_stack of
[From={typeDef,_}|_] ->
From;
_ -> []
end;
get_circularity_mark(_,_S) ->
[].
push_circularity_mark(Mark,S=#xsd_state{circularity_stack=CS,
redefine=false}) ->
S#xsd_state{circularity_stack=[Mark|CS]};
push_circularity_mark(_,S) ->
S.
pop_circularity_mark(Mark,S=#xsd_state{redefine=false}) ->
case S#xsd_state.circularity_stack of
[Mark|Rest] ->
S#xsd_state{circularity_stack=Rest};
_ ->
S
end;
pop_circularity_mark(_,S) ->
S.
derived_type({complexType,#schema_complex_type{name=Name,content=C}},
S=#xsd_state{derived_types=DT}) ->
case {keymember(restriction,1,C),keymember(extension,1,C)} of
{false,false} ->
S;
_ ->
S#xsd_state{derived_types=[{complexType,Name}|DT]}
end;
derived_type({simpleType,#schema_simple_type{name=Name,content=C}},
S=#xsd_state{derived_types=DT}) ->
case keymember(restriction,1,C) of
true ->
S#xsd_state{derived_types=[{simpleType,Name}|DT]};
_ ->
S
end.
facets([{annotation,_}|Rest],S) ->
facets(Rest,S);
facets([{restriction,{BaseType,CM}}],_S) ->
Facets = [X||X={F,_} <- CM,is_facet(F)],
GroupFacets = group_facets(Facets),
{BaseType,GroupFacets};
facets(_,_S) ->
{undefined,[]}.
group_facets(Facets) ->
group_facets(Facets,[]).
group_facets(L=[{enumeration,_}|_Rest],Acc) ->
{Enums,Rest} = splitwith(fun({enumeration,_}) -> true;
(_) -> false
end,
L),
group_facets(Rest,[{enumeration,[X||{enumeration,X}<-Enums]}|Acc]);
group_facets([H|T],Acc) ->
group_facets(T,[H|Acc]);
group_facets([],Acc) ->
reverse(Acc).
simpleType_final(ST,_S) ->
Final = get_attribute_value(final,ST,[]),
split_by_whitespace(Final,[]).
%% A redefine may contain (simpleType | complexType | group |
%% attributeGroup)*
%%{simpleType,Name},{complexType,Name},{group,Name},{attributeGroup,Name}
redefine([CM|Rest],S) ->
S2=redefine(CM,S),
redefine(Rest,S2);
redefine(ST={Type,_Name},S)
when Type==simpleType ; Type==complexType ->
%% Get the original definition
{OriginalType,S2} = resolve(ST,S),
%% unnecessary to delete saved object, it will be overwritten.
{RedefinedType,S3} = load_redefine_object(ST,S2),
{_MergedType,S4} = merge_derived_types(OriginalType,RedefinedType,redefine,S3),
S4;
redefine(_,S) ->
%% attributeGroup and group redefines are already redefined
S.
keyrefer(keyref,El,S) ->
Ref=get_attribute_value(refer,El,undefined),
get_QName(Ref,El#xmlElement.namespace,reset_scope(S));
keyrefer(_,_,_) ->
undefined.
remove_annotation(CM) when is_list(CM) ->
[X||X = {K,_} <- CM, K=/=annotation].
remove_attributes(CM) when is_list(CM) ->
[X||X = {K,_} <- CM, K=/=attribute,K=/=anyAttribute,K=/=attributeGroup].
keep_attributes(CM) when is_list(CM) ->
[X||X = {K,_} <- CM, K==attribute orelse K==anyAttribute orelse K==attributeGroup].
split_content([{restriction,{BaseT,CM}}]) ->
{[{restriction,{BaseT,remove_attributes(CM)}}],keep_attributes(CM)};
split_content([{extension,{BaseT,CM}}]) ->
{[{extension,{BaseT,remove_attributes(remove_annotation(CM))}}],
keep_attributes(CM)};
split_content(CM) ->
{remove_attributes(CM),keep_attributes(CM)}.
restriction_base_type(R,CM,S) ->
case base_type(R) of
[] ->
case [X||X={simpleType,_}<-CM] of
[{simpleType,TypeName}] ->
{TypeName,keydelete(simpleType,1,CM),S};
Other ->
Err = {error_path(R,R#xmlElement.name),?MODULE,
{missing_base_type,restriction,Other}},
{{[],[],[]},CM,acc_errs(S,Err)}
end;
BT ->
{get_QName(BT,R#xmlElement.namespace,reset_scope(S)),CM,S}
end.
base_type([{restriction,{BaseT,_}}],SCT) ->
SCT#schema_complex_type{base_type=BaseT};
base_type([{extension,{BaseT,_}}],SCT) ->
SCT#schema_complex_type{base_type=BaseT};
base_type(_,SCT) ->
SCT.
variety([{list,_ItemType}]) ->
list;
variety([{union,_ItemType}]) ->
union;
variety(_) ->
atomic.
%% pre_check_cm/2 is for now only for simpleContent | complexContent
%% which allow content: (annotation?, (restriction | extension))
pre_check_cm(Kind,Cs=[C=#xmlElement{}|RestC],Name,S) ->
case kind(C,S) of
{annotation,_} ->
pre_check_cm2(Kind,RestC,Name,C,S,0);
{_,S2} ->
pre_check_cm2(Kind,Cs,Name,C,S2,0)
end;
pre_check_cm(Kind,[_C|Cs],Name,S) ->
pre_check_cm(Kind,Cs,Name,S);
pre_check_cm(Kind,[],Name,S) ->
Err = {[],?MODULE,{content_failure,Kind,[],Name}},
acc_errs(S,Err).
pre_check_cm2(Kind,[C=#xmlElement{}|Cs],Name,_El,S,N) ->
S2 =
case kind(C,S) of
{restriction,_} ->
S;
{extension,_} ->
S;
{Other,S1} ->
Err = {error_path(C,C#xmlElement.name),?MODULE,
{illegal_element,Kind,Other,Name}},
acc_errs(S1,Err)
end,
pre_check_cm2(Kind,Cs,Name,C,S2,N+1);
pre_check_cm2(Kind,[_H|T],Name,El,S,N) ->
pre_check_cm2(Kind,T,Name,El,S,N);
pre_check_cm2(_,[],_,_,S,N) when N==1 ->
S;
pre_check_cm2(Kind,[],Name,El,S,N) ->
Err =
case N of
0 ->
{error_path(El,El#xmlElement.name),?MODULE,
{content_failure_expected_restriction_or_extension,
Kind,Name}};
_ ->
{error_path(El,El#xmlElement.name),?MODULE,
{content_failure_only_one_restriction_or_extension_allowed,
Kind,Name}}
end,
acc_errs(S,Err).
%% check_cm(Arg1,Arg2,Arg3)
%% Arg1 - The allowed content for this type according to schema for schemas
%% Arg2 - The content model of this particular schema
check_cm(Kind,S4SCM,ContentModel,S) ->
case check_cm2(Kind,S4SCM,ContentModel,S) of
{[],_S} ->
S;
{[_,[]|_],_S} ->
S;
{_CM,S2} ->
S2;
Err ->
exit({error,{[],?MODULE,{internal_error,Err}}})
end.
check_cm2(Kind,#chain{content=S4SCM,occurance=Occ},
ContentModel,S) ->
case occurance_loop(Occ,fun check_chain/1,
[S4SCM,ContentModel,Kind,S],0) of
{ok,[]} ->
{[],S};
{ok,[S4SCMRest,CMRest|_]} ->
case all_optional(S4SCMRest) of
true ->
{CMRest,S};
_ ->
Err = {[],?MODULE,
{mandatory_component_missing,S4SCMRest,Kind}},
acc_errs(S,Err)
end;
{error,{_,_,Reason}} ->
Err = {[],?MODULE,{illegal_content,Reason,Kind}},
{ContentModel,acc_errs(S,Err)}
end;
check_cm2(Kind,#alternative{content=S4SCM,occurance=Occ},
ContentModel,S) ->
case occurance_loop(Occ,fun check_alternative/1,
[S4SCM,ContentModel,Kind,S],0) of
{ok,[]} ->
{[],S};
{ok,[_,CMRest|_]} ->
{CMRest,S};
{error,Reason} ->
{ContentModel,acc_errs(S,Reason)}
end;
check_cm2(_,{Kind,Occ},CM,S) ->
case occurance_loop(Occ,fun check_simple_cm/1,[Kind,CM],0) of
{ok,[]} ->
{[],S};
{ok,[_,CMRest|_]} ->
{CMRest,S};
{error,Reason} ->
{CM,acc_errs(S,Reason)};
Err ->
{CM,acc_errs(S,Err)}
end.
%% check_simple_cm
check_simple_cm([Kind,CM]) ->
check_simple_cm(Kind,CM).
check_simple_cm(Kind,[]) ->
{error,{[],?MODULE,{no_match,{Kind,[]}}}};
check_simple_cm(Kind,[{Kind,_}|Rest]) ->
{ok,[Kind,Rest]};
check_simple_cm(Kind,[{Other,_}|Rest])
when Kind==simpleType;Kind==complexType ->
case Other of
simple_or_complex_Type -> {ok,[Kind,Rest]};
_ -> {error,{[],?MODULE,{no_match,Other}}}
end;
check_simple_cm(_Kind,[{Other,_}|_]) ->
{error,{[],?MODULE,{no_match,Other}}}.
check_chain([S4SCM,ContentModel,Kind,S]) ->
check_chain(Kind,S4SCM,ContentModel,S).
check_chain(Kind,[S4SC|S4SCs],ChainCM=[_H|_T],
S=#xsd_state{errors=Errs}) ->
NewKind =
case S4SC of
{NK,_} -> NK;
_ -> Kind
end,
case check_cm2(NewKind,S4SC,ChainCM,S) of
{ChainCMRest,#xsd_state{errors=Errs}} ->
check_chain(Kind,S4SCs,ChainCMRest,S);
{_ChainCMRest,_S2} ->
case optional(S4SC) of
true ->
check_chain(Kind,S4SCs,ChainCM,S);
_ ->
{error,{[],?MODULE,{unmatched_mandatory_object,Kind,S4SC}}}
end
end;
check_chain(Kind,[],CM,S) ->
{ok,[[],CM,Kind,S]};
check_chain(Kind,Rest,CM,S) ->
case all_optional(Rest) of
true ->
{ok,[Rest,CM,Kind,S]}; %% or {ok,[[],CM,Kind,S]}
_ ->
{error,{[],?MODULE,{bad_match,Rest,CM}}}
end.
check_alternative([S4SC,CM,Kind,S]) ->
check_alternative(Kind,S4SC,CM,S).
check_alternative(Kind,[S4SC|S4SCs],AltCM = [_H|_T],
S=#xsd_state{errors=Err}) ->
NewKind =
case S4SC of
{NK,_} -> NK;
_ -> Kind
end,
case check_cm2(NewKind,S4SC,AltCM,S) of
{AltCMRest,#xsd_state{errors=Err}} ->
{ok,[[S4SC],AltCMRest,Kind,S]};
{AltCMRest,_S2} ->
check_alternative(Kind,S4SCs,AltCMRest,S)
end;
check_alternative(Kind,[],_AltCM,_S) ->
{error,{[],?MODULE,{no_match,Kind}}}.
%% occurance_loop keeps track of the right number of elements
%% Third argument is a list: [S4SContent,ContentModel]
%% returns {ok,Rest} where Rest is the next unmatched abstract
%% structure.
occurance_loop({Min,Max},_CheckFun,[_,[]|_Rest],N)
when Min =< N, Max >= N ->
{ok,[]};
occurance_loop(Occ={Min,Max},CheckFun,Args,N) ->
Nplus1 = N+1,
case CheckFun(Args) of
{error,{_,_,{no_match,_}}} when Min =< N, Max >= N ->
{ok,Args};
Err = {error,_} ->
Err;
{ok,Args} ->
{error,{[],?MODULE,{no_match,occurance_kind(Args)}}};
{ok,NewArgs} when Nplus1 < Max ->
occurance_loop(Occ,CheckFun,NewArgs,Nplus1);
Ret = {ok,_NewArgs} ->
Ret
end.
occurance_kind([Kind,_]) ->
Kind;
occurance_kind([_,_,Kind,_]) ->
Kind;
occurance_kind(_) ->
[].
%% if_simple_hd(S4SCM,ConstrCM)
%% when is_record(S4SCM,chain);is_record(S4SCM,alternative);is_list(S4SCM) ->
%% ConstrCM;
%% if_simple_hd(_,[H|_Tl]) ->
%% H.
%% if_simple_tl(S4SCM,_ConstrCM)
%% when is_record(S4SCM,chain);is_record(S4SCM,alternative);is_list(S4SCM) ->
%% [];
%% if_simple_tl(_,[_|Tl]) ->
%% Tl.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
count_occur({Min,Max}) ->
% {decrease(Min),decrease(Max)};
{decrease(Min),Max};
count_occur(Other) ->
Other.
decrease(I) when is_integer(I), I > 0 ->
I-1;
decrease(I) ->
I.
decrease_occurance({K,{ID,Occ}}) ->
{K,{ID,count_occur(Occ)}};
decrease_occurance(Other) ->
Other.
get_occur({_,{_,Occ={Min,_}}}) when is_integer(Min) ->
Occ;
get_occur({_,{_,Occ={Min,_},_}}) when is_integer(Min) ->
Occ;
get_occur(Other) ->
Other.
%% remove_whitespace(L=[T=#xmlText{}|Rest]) ->
%% case is_whitespace(T) of
%% true ->
%% remove_whitespace(Rest);
%% _ -> L
%% end;
%% remove_whitespace(L) ->
%% L.
optional(optional_text) ->
true;
optional({_,{0,_}}) ->
true;
optional({_,{_,{0,_}}}) ->
true; %% sequence, all or choice
optional({any,{_,{0,_},_}}) ->
true;
optional(#chain{occurance={0,_}}) ->
true;
optional(#alternative{occurance={0,_}}) ->
true;
optional(#chain{content=Content}) ->
catch is_optional_content(Content);
optional(#alternative{content=Content}) ->
catch is_optional_content(Content);
optional({all,{Content,_}}) ->
catch is_optional_content(Content);
optional(_) ->
false.
is_optional_content([H|T]) ->
case optional(H) of
true ->
is_optional_content(T);
false ->
throw(false)
end;
is_optional_content([]) ->
true.
not_optional(X) ->
case optional(X) of
true ->
false;
_ ->
true
end.
all_optional([]) ->
true;
all_optional(L) ->
case filter(fun not_optional/1,L) of
[] ->
true;
_ ->
false
end.
%% allowed_content/2 returns a representation of the allowed content
%% model for that object
allowed_content(element,_Parents) ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[#alternative{content=
[{simpleType,{1,1}},{complexType,{1,1}}],
occurance={0,1}},
#alternative{content=
[{unique,{1,1}},{key,{1,1}},{keyref,{1,1}}],
occurance={0,unbounded}}]
}]
};
allowed_content(attribute,_Parents) ->
#chain{content=[{annotation,{0,1}},{simpleType,{0,1}}]};
allowed_content(complexType,Parents) ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=
[set_occurance(allowed_content(simpleContent,Parents),{1,1}),
set_occurance(allowed_content(complexContent,Parents),{1,1}),
#chain{content=
[#alternative{content=
[{group,{1,1}},{all,{1,1}},
{choice,{1,1}},{sequence,{1,1}}],
occurance={0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},
{attributeGroup,{1,1}}],
occurance={0,unbounded}},
{anyAttribute,{0,1}}]
}
]
}
]
}
]
};
allowed_content(attributeGroup,Parents) ->
case member(simpleContent,Parents) of
true ->
{annotation,{0,1}};
_ ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},
{attributeGroup,{1,1}}],
occurance={0,unbounded}},
{anyAttribute,{0,1}}]}]}
end;
allowed_content(group,_Parents) ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=
[{all,{1,1}},{choice,{1,1}},{sequence,{1,1}}],
occurance={0,1}}]};
allowed_content(all,_Parents) ->
#chain{content=[{annotation,{0,1}},{element,{0,unbounded}}]};
allowed_content(SorC,_Parents) when SorC==sequence;SorC==choice ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=
[{element,{1,1}},{group,{1,1}},
{choice,{1,1}},{sequence,{1,1}},
{any,{1,1}}],
occurance={0,unbounded}}]};
allowed_content(E,_Parents)
when E==any;E==selector;E==field;E==notation;E==include;E==import;
E==anyAttribute ->
{annotation,{0,1}};
allowed_content(UKK,_Parents) when UKK==unique;UKK==key;UKK==keyref->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[{selector,{1,1}},{selector,{1,unbounded}}]}]};
allowed_content(annotation,_Parents) ->
#alternative{content=[{appinfo,{1,1}},{documentation,{1,1}}],
occurance={0,unbounded}};
allowed_content(E,_Parents) when E==appinfo;E==documentation ->
{any,{0,unbounded}};
allowed_content(simpleType,_Parents) ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=[{restriction,{1,1}},{list,{1,1}},
{union,{1,1}}]}]};
allowed_content(restriction,Parents) ->
case member(simpleType,Parents) of
true ->
allowed_content2(restriction,simpleType);
_ ->
case member(simpleContent,Parents) of
true ->
allowed_content2(restriction,simpleContent);
_ ->
allowed_content2(restriction,complexContent)
end
end;
allowed_content(LU,_Parent) when LU==list;LU==union ->
#chain{content=[{annotation,{0,1}},{simpleType,{0,1}}]};
allowed_content(schema,_) ->
#chain{content=
[#alternative{content=
[{include,{1,1}},{import,{1,1}},
{redefine,{1,1}},{annotation,{1,1}}],
occurance={0,1}},
#chain{content=
[#alternative{content=
[#alternative{content=
[{simpleType,{1,1}},{complexType,{1,1}},
{group,{1,1}},{attributeGroup,{1,1}}]},
{element,{1,1}},
{attribute,{1,1}},
{notation,{1,1}}]},
{annotation,{0,unbounded}}],
occurance={0,unbounded}}]};
allowed_content(redefine,_Parents) ->
#alternative{content=
[{annotation,{1,1}},
#alternative{content=
[{simpleType,{1,1}},{complexType,{1,1}},
{group,{1,1}},{attributeGroup,{1,1}}]}],
occurance={0,unbounded}};
allowed_content(E,_Parents) when E==simpleContent;
E==complexContent ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=
[{restriction,{1,1}},{extension,{1,1}}]}]};
allowed_content(extension,Parents) ->
case member(simpleContent,Parents) of
true ->
allowed_content2(extension,simpleContent);
_ ->
allowed_content2(extension,complexContent)
end;
allowed_content(minExclusive,_Parents) ->
[];
allowed_content(minInclusive,_Parents) ->
[];
allowed_content(maxExclusive,_Parents) ->
[];
allowed_content(maxInclusive,_Parents) ->
[];
allowed_content(totalDigits,_Parents) ->
[];
allowed_content(fractionDigits,_Parents) ->
[];
allowed_content(length,_Parents) ->
[];
allowed_content(minLength,_Parents) ->
[];
allowed_content(maxLength,_Parents) ->
[];
allowed_content(enumeration,_Parents) ->
[];
allowed_content(whiteSpace,_Parents) ->
[];
allowed_content(pattern,_Parents) ->
[].
allowed_content2(restriction,simpleType) ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[{simpleType,{0,1}},
#alternative{content=
[{minExclusive,{1,1}},{minInclusive,{1,1}},
{maxExclusive,{1,1}},{maxInclusive,{1,1}},
{totalDigits,{1,1}},{fractionDigits,{1,1}},
{length,{1,1}},{minLength,{1,1}},
{maxLength,{1,1}},{enumeration,{1,1}},
{whiteSpace,{1,1}},{pattern,{1,1}}],
occurance={0,unbounded}}]}]};
allowed_content2(restriction,simpleContent) ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[{simpleType,{0,1}},
#alternative{content=
[{minExclusive,{1,1}},{minInclusive,{1,1}},
{maxExclusive,{1,1}},{maxInclusive,{1,1}},
{totalDigits,{1,1}},{fractionDigits,{1,1}},
{length,{1,1}},{minLength,{1,1}},
{maxLength,{1,1}},{enumeration,{1,1}},
{whiteSpace,{1,1}},{pattern,{1,1}}],
occurance={0,unbounded}}],
occurance={0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},{attributeGroup,{1,1}}],
occurance={0,unbounded}},
{anyAttribute,{0,1}}]}]};
allowed_content2(restriction,complexContent) ->
#chain{content=
[{annotation,{0,1}},
#alternative{content=
[{group,{1,1}},{all,{1,1}},{choice,{1,1}},
{sequence,{1,1}}],
occurance={0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},{attributeGroup,{1,1}}],
occurance={0,unbounded}},
{anyAttribute,{0,1}}]}]};
allowed_content2(extension,simpleContent) ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},{attributeGroup,{1,1}}],
occurance={0,unbounded}},
{anyAttribute,{0,1}}]}]};
allowed_content2(extension,complexContent) ->
#chain{content=
[{annotation,{0,1}},
#chain{content=
[#alternative{content=
[{group,{1,1}},{all,{1,1}},{choice,{1,1}},
{sequence,{1,1}}],
occurance={0,1}},
#chain{content=
[#alternative{content=
[{attribute,{1,1}},
{attributeGroup,{1,1}}],
occurance={0,1}},
{anyAttribute,{0,1}}]}]}]}.
set_occurance(Ch = #chain{},Occ) ->
Ch#chain{occurance=Occ};
set_occurance(Alt = #alternative{},Occ) ->
Alt#alternative{occurance=Occ};
set_occurance({Name,_},Occ) when is_atom(Name) ->
{Name,Occ};
set_occurance(CM,_) ->
CM.
process_external_schema_once(E,Namespace,S) when is_record(E,xmlElement) ->
case get_attribute_value(schemaLocation,E,[]) of
[] ->
Err = {missing_schemalocation_attribute,E#xmlElement.name},
acc_errs(S,Err);
Path ->
process_external_schema_once(Path,Namespace,S)
end;
process_external_schema_once(SchemaLocation,Namespace,S) ->
case fetch_external_schema(SchemaLocation,S) of
{E=#xmlElement{},S2} ->
case is_already_processed(Namespace,S2) of
true ->
save_namespace_definition(Namespace,S2);
_ ->
S3 = save_namespace_definition(Namespace,S2),
traverse_ext_schema(E,S3#xsd_state{targetNamespace=Namespace})
end;
{_,S2} ->
S2
end.
%% process_external_schema/2 returns:
%% {ok,some_result()} | {error,reason()}
process_external_schema(Path,S) when is_list(Path) ->
case fetch_external_schema(Path,S) of
{E=#xmlElement{},S2} ->
traverse_ext_schema(E,S2);
{_,S2} ->
S2
end;
process_external_schema(absent,S) ->
S.
fetch_external_schema(Path,S) when is_list(Path) ->
FetchFun = S#xsd_state.fetch_fun,
%% {ExtXSD,S2} =
case FetchFun(Path,S) of
{ok,{file,File},_} ->
?debug("scanning file: ~p~n",[File]),
case xmerl_scan:file(File,S#xsd_state.xml_options) of
{error,Reason} ->
{error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,File,Reason}})};
{EXSD,_} ->
{EXSD,S#xsd_state{schema_name=File}}
end;
{_,{string,String},_} -> %% this is for a user defined fetch fun that returns an xml document on string format.
?debug("scanning string: ~p~n",[String]),
case xmerl_scan:string(String,S#xsd_state.xml_options) of
{error,Reason} ->
{error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,Path,Reason}})};
{EXSD,_} ->
{EXSD,S#xsd_state{schema_name=Path}}
end;
{ok,[],_} ->
{ok,S};
{_,Other,_} ->
{error,acc_errs(S,{[],?MODULE,{fetch_fun_failed,Other}})}
end;
fetch_external_schema(absent,S) ->
{ok,S}.
%% The schema name is also important here because a schema may import
%% and must include from the same namespace as the target namespace of
%% the including schema.
is_already_processed(NameSpace,#xsd_state{schema_name=SchemaName,
checked_namespace_nodes=CNS}) ->
%% case {keymember(SchemaName,2,CNS),keymember(NameSpace,3,CNS)} of
%% {true,true} ->
case keysearch(SchemaName,2,CNS) of
{_,{_,_,NameSpace}} ->
true;
_ ->
false
end.
%%
save_namespace_definition(NameSpace,
S=#xsd_state{targetNamespace=TNS,
global_namespace_nodes=GNS,
checked_namespace_nodes=CNS}) ->
%% 1) Have to find a matching namespace in the global list for
%% this schema, and get the associated prefix. 2) Then check
%% whether a schema with this prefix - namespace combinaton
%% already is checked, if so do nothing. 3a) If this namespace is
%% checked but with another prefix only add the prefix - namespace
%% pair to the checked namespace list. 3b) Otherwise add the
%% prefix - namespace pair.
{Prefix,S2} =
case keysearch(TNS,1,GNS) of
{value,{_,ImportedNodes}} ->
case keysearch(NameSpace,2,ImportedNodes) of
{value,{_P,_}} -> {_P,S};
_ -> {none,S}
end;
_ ->
Err = {[],?MODULE,{imported_namespace_wo_namespace_definition,NameSpace}},
{none,acc_errs(S,Err)}
end,
%% Instead of 2, 3a and 3b just add_once
case Prefix of
none ->
S2;
_ ->
S#xsd_state{checked_namespace_nodes=
add_once({Prefix,S#xsd_state.schema_name,NameSpace},CNS)}
end.
%% prefix_namespace_2global
%% adds {Prefix,Namespace} to the global namespace nodes list for the
%% targetnamespace. Prefix is the right one found in Nodes.
prefix_namespace_2global(Namespace,
#xmlNamespace{nodes=Nodes},
S=#xsd_state{targetNamespace=TNS,
global_namespace_nodes=GNS}) ->
case keysearch(Namespace,2,Nodes) of
{value,{Prefix,_}} ->
case keysearch(TNS,1,GNS) of
{value,{_,DefinedNamespaces}} ->
S#xsd_state{global_namespace_nodes=
keyreplace(TNS,1,GNS,
{TNS,add_once({Prefix,Namespace},
DefinedNamespaces)})};
_ ->
S#xsd_state{global_namespace_nodes=
[{TNS,[{Prefix,Namespace}|default_namespace_by_convention()]}]}
end;
_ ->
S
end;
prefix_namespace_2global(_,_,S) ->
S.
traverse_ext_schema(E,S) ->
TargetNS = target_namespace(E),
case {TargetNS,S#xsd_state.targetNamespace} of
{undefined,_} ->
traverse_ext_schema2(E,S);
{TNS,TNS} ->
traverse_ext_schema2(E,S);
_ ->
Err = {error_path(E,schema),?MODULE,{illegal_target_namespace_external_schema,E#xmlElement.name}},
acc_errs(S,Err)
end.
traverse_ext_schema2(E,S) ->
S1 = namespace_nodes(E,S),
S2 = element_form_default(E,S1),
S3 = attribute_form_default(E,S2),
S4 = substitution_default(finalDefault,E,S3),
S5 = substitution_default(blockDefault,E,S4),
{CM,S6} = traverse_content2(E#xmlElement.content,S5,[]),
%% ?debug("External schema S6:~n~p~n",[S6]),
save_schema_element(CM,S6),
S6.
attribute_properties([#xmlAttribute{name=default,value=Default}|Rest],
Attr,S) ->
attribute_properties(Rest,Attr#schema_attribute{default=Default},S);
attribute_properties([#xmlAttribute{name=fixed,value=Fixed}|Rest],Attr,S) ->
attribute_properties(Rest,Attr#schema_attribute{fixed=Fixed},S);
attribute_properties([#xmlAttribute{name=use,value=Use}|Rest],Attr,S) ->
{Use2,S2} = attribute_use(Use,S),
attribute_properties(Rest,Attr#schema_attribute{use=Use2},S2);
attribute_properties([#xmlAttribute{name=form,value=Form}|Rest],Attr,S) ->
{Form2,S2} = attribute_form(Form,S),
attribute_properties(Rest,Attr#schema_attribute{form=Form2},S2);
attribute_properties([#xmlAttribute{name=id,value=ID}|Rest],Attr,S) ->
S2 = check_and_save_ID(ID,S),
attribute_properties(Rest,Attr#schema_attribute{id=ID},S2);
attribute_properties([_H|Rest],Attr,S) ->
attribute_properties(Rest,Attr,S);
attribute_properties([],Attr,S) ->
{Attr,S}.
attribute_use(Use,S) when Use=="optional";Use=="prohibited";Use=="required" ->
{list_to_atom(Use),S};
attribute_use(Use,S) ->
{Use,acc_errs(S,{[],?MODULE,{illegal_use_value,Use}})}.
attribute_form(Form,S) when Form=="qualified";Form=="unqualified" ->
{list_to_atom(Form),S};
attribute_form(Form,S) ->
{Form,acc_errs(S,{[],?MODULE,{illegal_form_value,Form}})}.
element_properties([#xmlAttribute{name=default,value=Default}|Rest],SE,El,S) ->
case SE#schema_element.value_constraint of
{fixed,_} ->
Err = {error_path(El,schema),?MODULE,{"only one of final/default attributes allowed",
El#xmlElement.name}},
element_properties(Rest,SE,El,acc_errs(S,Err));
_ ->
element_properties(Rest,SE#schema_element{value_constraint=
{default,Default}},El,S)
end;
element_properties([#xmlAttribute{name=fixed,value=Fixed}|Rest],SE,El,S) ->
case SE#schema_element.value_constraint of
{default,_} ->
Err = {error_path(El,schema),?MODULE,
{"only one of final/default attributes allowed",
El#xmlElement.name}},
element_properties(Rest,SE,El,acc_errs(S,Err));
_ ->
element_properties(Rest,SE#schema_element{value_constraint=
{fixed,Fixed}},El,S)
end;
element_properties([#xmlAttribute{name=substitutionGroup,value=SG}|Rest],
SE,El,S) ->
SGName = get_QName(SG,El#xmlElement.namespace,reset_scope(S)),
element_properties(Rest,SE#schema_element{substitutionGroup=SGName},El,
add_ref(S,{element,SGName}));
element_properties([#xmlAttribute{name=form,value=F}|Rest],SE,El,S) ->
{Form,S2} = attribute_form(F,S),
element_properties(Rest,SE#schema_element{form=Form},El,S2);
element_properties([#xmlAttribute{name=id,value=ID}|Rest],SE,El,S) ->
S2 = check_and_save_ID(ID,S),
element_properties(Rest,SE#schema_element{id=ID},El,S2);
element_properties([#xmlAttribute{name=nillable,value=N}|Rest],SE,El,S) ->
case boolean_to_atom(N) of
error ->
element_properties(Rest,SE,El,
acc_errs(S,{error_path(El,schema),?MODULE,{illegal_nillable_value,N}}));
N_atom ->
element_properties(Rest,SE#schema_element{nillable=N_atom},El,S)
end;
element_properties([#xmlAttribute{name=abstract,value=A}|Rest],SE,El,S) ->
case boolean_to_atom(A) of
error ->
element_properties(Rest,SE,El,
acc_errs(S,{error_path(El,schema),?MODULE,{illegal_abstract_value,A}}));
A_atom ->
element_properties(Rest,SE#schema_element{abstract=A_atom},El,S)
end;
element_properties([#xmlAttribute{name=block,value=B}|Rest],SE,El,S) ->
BlockValues = split_by_whitespace(B,[]),
case legal_block_values(element,BlockValues) of
{error,Reason} ->
element_properties(Rest,SE,El,
acc_errs(S,{error_path(El,schema),?MODULE,{illegal_block_values,Reason}}));
_ ->
element_properties(Rest,SE#schema_element{block=BlockValues},El,S)
end;
element_properties([#xmlAttribute{name=final,value=F}|Rest],SE,El,S) ->
FinalValues = split_by_whitespace(F,[]),
case legal_final_values(element,FinalValues) of
{error,Reason} ->
element_properties(Rest,SE,El,
acc_errs(S,{error_path(El,schema),?MODULE,{illegal_final_values,Reason}}));
_ ->
element_properties(Rest,SE#schema_element{final=FinalValues},El,S)
end;
element_properties([_H|T],SE,El,S) ->
element_properties(T,SE,El,S);
element_properties([],SE,_El,S) ->
{SE,S}.
%% 3.3.3 bullet 2.2
%% nillable, default, fixed, form, block and type properties must be
%% absent in element with ref.
element_forbidden_properties(El,S) ->
element_forbidden_properties(El#xmlElement.attributes,El,S).
element_forbidden_properties([#xmlAttribute{name=nillable,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,nillable,V}}));
element_forbidden_properties([#xmlAttribute{name=default,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,default,V}}));
element_forbidden_properties([#xmlAttribute{name=fixed,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,fixed,V}}));
element_forbidden_properties([#xmlAttribute{name=form,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,form,V}}));
element_forbidden_properties([#xmlAttribute{name=block,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,block,V}}));
element_forbidden_properties([#xmlAttribute{name=type,value=V}|Atts],El,S) ->
element_forbidden_properties(Atts,El,acc_errs(S,{error_path(El,schema),?MODULE,{forbidden_property,type,V}}));
element_forbidden_properties([#xmlAttribute{}|Atts],El,S) ->
element_forbidden_properties(Atts,El,S);
element_forbidden_properties([],_,S) ->
S.
%% 3.3.3 bullet 2.2
%% complexType, simpleType, key, keyref and unique must be absent in
%% element with ref.
element_forbidden_content([],S) ->
S;
element_forbidden_content([El=#xmlElement{}|Els],S) ->
case kind(El) of
K when K==complexType;K==simpleType;K==key;K==keyref;K==unique ->
acc_errs(S,{error_path(El,schema),?MODULE,{element_content_must_not_contain,K,El}});
annotation ->
element_forbidden_content(Els,S);
Other ->
acc_errs(S,{error_path(El,schema),?MODULE,{illegal_element_content,Other}})
end;
element_forbidden_content([T=#xmlText{}|Rest],S) ->
case is_whitespace(T) of
true ->
element_forbidden_content(Rest,S);
_ ->
acc_errs(S,{error_path(T,schema),?MODULE,{illegal_element_content,T}})
end.
c_t_properties(El,CT,S) ->
c_t_properties(El#xmlElement.attributes,El,CT,S).
c_t_properties([#xmlAttribute{name=final,value=V}|Rest],El,CT,S) ->
FinalValues = split_by_whitespace(V,[]),
case legal_final_values(complexType,FinalValues) of
{error,Reason} ->
Err = {error_path(El,schema),?MODULE,{illegal_final_values,Reason}},
c_t_properties(Rest,El,CT,acc_errs(S,Err));
_ ->
c_t_properties(Rest,El,
CT#schema_complex_type{final=FinalValues},S)
end;
c_t_properties([#xmlAttribute{name=block,value=V}|Rest],El,CT,S) ->
BlockValues = split_by_whitespace(V,[]),
case legal_block_values(complexType,BlockValues) of
{error,Reason} ->
Err = {error_path(El,schema),?MODULE,
{illegal_block_values,Reason}},
c_t_properties(Rest,El,CT,acc_errs(S,Err));
_ ->
c_t_properties(Rest,El,CT#schema_complex_type{block=BlockValues},S)
end;
c_t_properties([#xmlAttribute{name=abstract,value=V}|Rest],El,CT,S) ->
case boolean_to_atom(V) of
error ->
Err = {error_path(El,schema),?MODULE,
{illegal_abstract_value,V}},
c_t_properties(Rest,El,CT,acc_errs(S,Err));
V_atom ->
c_t_properties(Rest,El,CT#schema_complex_type{abstract=V_atom},S)
end;
c_t_properties([_H|T],El,CT,S) ->
c_t_properties(T,El,CT,S);
c_t_properties([],_,CT,S) ->
{CT,S}.
legal_block_values(_,['#all']) ->
true;
legal_block_values(element,BlockValues) ->
list_members(BlockValues,[extension,restriction,substitution]);
legal_block_values(complexType,BlockValues) ->
list_members(BlockValues,[extension,restriction]).
legal_final_values(_,['#all']) ->
true;
legal_final_values(_,FinalValues) ->
list_members(FinalValues,[extension,restriction]).
boolean_to_atom(B) when B=="1";B=="true" ->
true;
boolean_to_atom(B) when B=="0";B=="false" ->
false;
boolean_to_atom(_) ->
error.
count_num_el(S=#xsd_state{num_el=N}) ->
S#xsd_state{num_el=N+1}.
set_num_el(S=#xsd_state{},I) when is_integer(I) ->
S#xsd_state{num_el=I};
set_num_el(S=#xsd_state{},#xsd_state{num_el=I}) ->
S#xsd_state{num_el=I}.
occurance(El=#xmlElement{attributes=Atts},{Min,Max},S) ->
AttVal=fun(#xmlAttribute{value=V},Sin) ->
case catch mk_int_or_atom(V) of
{'EXIT',_} ->
Err = {error_path(El,schema),?MODULE,
{illegal_occurance_value,V}},
{V,acc_errs(Sin,Err)};
IAV -> {IAV,Sin}
end;
(V1,Sin) -> {V1,Sin}
end,
{MinVal,S2} = AttVal(keyNsearch(minOccurs,#xmlAttribute.name,
Atts,Min),S),
{MaxVal,S3} = AttVal(keyNsearch(maxOccurs,#xmlAttribute.name,
Atts,Max),S2),
{{MinVal,MaxVal},S3}.
mk_int_or_atom(V="unbounded") ->
list_to_atom(V);
mk_int_or_atom(V) when is_list(V) ->
list_to_integer(V);
mk_int_or_atom(V) ->
V.
%% E is a complexType, possible kind of content is A)simpleContent, B)
%% complexContent or C) one or zero of 1)group,2)all,3)choice or
%% 4)sequence, followed by any number of attribute or attributeGroup
%% and finally one optional anyAttribute
mixed(E=#xmlElement{content=C},S) ->
case {get_attribute_value(mixed,E,undefined),
[Y||Y=#xmlElement{}<-C,kind(Y)==simpleContent]} of
{_,[_SCE]} ->
{false,S}; %% mixed is false in simpleContent
{undefined,_} ->
case [X||X=#xmlElement{}<-C,
kind(X)==complexContent] of
[E2] ->
%% {get_attribute_value(mixed,E2,false),S};
mixed(E2,S);
_ ->
{false,S}
end;
{M,_} when M=="1";M=="true" -> {true,S};
{M,_} when M=="0";M=="false" -> {false,S};
{M,_} ->
Err = {error_path(E,schema),?MODULE,{invalid_mixed_value,M}},
{false,acc_errs(S,Err)}
end.
mixify(false,CM) ->
CM;
mixify(true,CM) ->
mixify2(CM,[optional_text]).
mixify2([],Acc) ->
reverse(Acc);
mixify2([H|T],Acc) ->
mixify2(T,[optional_text,H|Acc]).
complexity([]) ->
undefined;
complexity([#xmlText{}|T]) ->
complexity(T);
complexity([#xmlComment{}|T]) ->
complexity(T);
complexity([H|T]) ->
case kind(H) of
simpleContent ->
simple;
complexContent ->
complex;
_ ->
complexity(T)
end.
%% Validation takes care of the following:
%% 1) a) Check that targetNamespace attribute in schema matches
%% namespace URI if the element.
%% b) If schema don't have a targetNamespace the instance element
%% must not be namespace-qualified
%% 2) a) Examine type of the element according to the schema and block
%% attributes in the element decl.
%% b) Default values and other infoset contributions are applied.
%% 3) Check the immediate attributes and contents of the element
%% comparing these against the attributes and contents
%% permitted.
%% a) simple type:
%% -verify there are no attributes or elements.
%% -verify character content matches rules for type.
%% b) complex type:
%% -verify attributes present and values ok.
%% -check subelements according to content model.
%% validate_xml/2
validate_xml(El = #xmlElement{name=Name},
S=#xsd_state{table=Tab,schemaLocations=SchemaLocations}) ->
ElQName = {_,_,Namespace} = mk_EII_QName(Name,El,S),
SchemaCM = get_schema_cm(Tab,Namespace),
case [X||X={element,{QName,Occ}} <- SchemaCM#schema.content,
cmp_name(ElQName,QName,S),
at_least_one(Occ)] of
[Obj] ->
{Object,S2} = load_object(Obj,S),
validate_xml(El,Object,S2);
_ ->
%% In case the namespace in El is not processed even
%% though it is present.
case is_already_processed(Namespace,S) of
true -> %% nothing more to do
{error,{error_path(El,Name),?MODULE,
{element_not_in_schema,[Name,ElQName,SchemaCM]}}};
_ ->
case keysearch(if_atom_to_list(Namespace),1,SchemaLocations) of
{value,{_,Location}} ->
%% namespace present by schemaLocation
%% attribute in instance.
S1 = prefix_namespace_2global(Namespace,El#xmlElement.namespace,S),
S2 = save_namespace_definition(Namespace,S1),
S3 = process_external_schema(Location,S2#xsd_state{targetNamespace=Namespace}),
validate_xml(El,S3);
_ -> %% namespace not imported in schema or instance.
{error,{error_path(El,Name),?MODULE,
{element_not_in_schema,[Name,ElQName,SchemaCM]}}}
end
end
end.
%% validate_xml/3
validate_xml(XMLEl=#xmlElement{},SEl=#schema_element{},S) ->
%% check that targetNamespace of schema matches URI of the element.
case check_target_namespace(XMLEl,S) of
ok ->
%% Extract the schemaLocation links in the instance,
%% examine type of the element according to the schema and
%% the block attributes in the element declaration
S2 = schemaLocations(XMLEl,S),
?debug("schemaLocations: ~p~n",[S2#xsd_state.schemaLocations]),
#schema_element{name=_Name,type=_Type,block=Bl} = SEl,
Block = blocking(Bl,S2#xsd_state.blockDefault), %% complex types, elements
Ret = check_element_type([XMLEl],SEl,[],Block,S2,[]),
case Ret of
{ValXML,UnvalRest,S3} ->
%% S4 = schema_concistence_checks(S3),
{ValXML,UnvalRest,S3};
_ ->
Ret
end;
_ ->
Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{target_namespace_missmatch}},
{XMLEl,[],acc_errs(S,Err)}
end.
%% check_element_type/3
%% examine type according to schema including info of block
%% attributes. If complex type do test recursively
%% 2 often
check_element_type(XML=[XMLTxt=#xmlText{}|Rest],CM=[CMEl|CMRest],Env,
Block,S,Checked) ->
%% XMLTxt is the first part of the elements content,
%% CMEl is the allowed type according to the schema
case is_whitespace(XMLTxt) of
true -> %% Ignore XMLEl
check_element_type(Rest,CM,Env,Block,S,[XMLTxt|Checked]);
_ -> %% CMEl allows optional_text or is an absent optional element
{ResolvedT,S2} = resolve(CMEl,S),
case check_text_type(XML,ResolvedT,S2) of
{error,Reason} ->
case is_optional(CMEl,S) of
true ->
check_element_type(XML,CMRest,Env,Block,S,Checked);
_ ->
check_element_type(Rest,CM,Env,Block,
acc_errs(S,Reason),Checked)
end;
{Ret,Rest2,S3} ->
check_element_type(Rest2,CMRest,Env,Block,S3,reverse(Ret,Checked))
end
end;
%% If CMEl is a sequence more than the first element of the XML list
%% may match.
check_element_type(XML=[#xmlElement{}|_],[{sequence,{CM,Occ}}|_CMRest],
Env,_Block,S,Checked) ->
?debug("calling sequence/6~n",[]),
check_sequence(XML,CM,Occ,Env,set_num_el(S,0),Checked);
check_element_type(XML=[#xmlElement{}|_],[{choice,{CM,Occ}}|_CMRest],
Env,_Block,S,Checked) ->
?debug("calling choice/6~n",[]),
check_choice(XML,CM,Occ,Env,set_num_el(S,0),Checked);
check_element_type(XML=[#xmlElement{}|_],[{all,{CM,Occ}}|_CMRest],
Env,_Block,S,Checked) ->
?debug("calling choice/6~n",[]),
check_all(XML,CM,Occ,Env,set_num_el(S,0),Checked,XML); %%LTH
%% 3 often. CMEL may be ((simpleType | complexType)?, (unique | key | keyref)*))
check_element_type(XML=[XMLEl=#xmlElement{}|_],[CMEl|CMRest],Env,
Block,S,Checked) ->
%% Three possible releations between XMLEl - CMEl:
%% (1) XMLEl matches CMEl.
%% (2) XMLEl don't matches CMEl and CMEl is optional.
%% (3) XMLEl don't matches CMEl, CMEl mandatory, - error.
%% On the other side may CMEl also match more elements in
%% Rest. This should come down to 2) next function call.
{ResolvedT,S2} = resolve(CMEl,S),
case check_element_type(XML,ResolvedT,Env,Block,S2,[]) of
{error,Reason} -> % 3
check_element_type(tl(XML),CMRest,Env,Block,
acc_errs(S,Reason),[XMLEl|Checked]);
{[],_,_} -> % 2
check_element_type(XML,CMRest,Env,Block,S,Checked);
{XMLEl2,RestXML,S3} -> % 1 This return value does not conform to the others
check_element_type(RestXML,[decrease_occurance(CMEl)|CMRest],Env,
Block,S3,XMLEl2++Checked)
end;
check_element_type([],[],_Env,_Block,S,Checked) ->
{Checked,[],S};
check_element_type([],[CMEl|CMRest],Env,Block,S,Checked) ->
case is_optional(CMEl,S) of
true ->
check_element_type([],CMRest,Env,Block,S,Checked);
_ ->
Err = {error_path(Checked,undefined),?MODULE,
{missing_mandatory_element,CMEl}},
{Checked,[],acc_errs(S,Err)}
end;
check_element_type(_XML=[],
#schema_complex_type{name=_Name,base_type=BT,
complexity=simple,
content=_C} = CT,
_Env,_Block,S,Checked) ->
%% maybe check attributes here as well.
{ResolvedType,_} = resolve({simple_or_complex_Type,BT},S),
case ResolvedType of
#schema_simple_type{} ->
{NewVal,S2} = check_type(ResolvedType,[],unapplied,S),
{NewVal,[],S2};
{simpleType,_} ->
{NewVal,S2} = check_type(ResolvedType,[],unapplied,S),
{NewVal,[],S2};
_ ->
{error,{error_path(Checked,undefined),?MODULE,
{empty_content_not_allowed,CT}}}
end;
check_element_type([],#schema_complex_type{name=_Name,block=_Bl,content=C},
_Env,_Block,S,Checked) ->
%% This type must have an empty content to be valid
case allow_empty_content(C) of
true -> {[],[],S};
false ->
{error,{error_path(Checked,undefined),?MODULE,
{empty_content_not_allowed,C}}}
end;
check_element_type(C, {anyType, _}, _Env, _Block, S, _Checked) ->
%% permitt anything
{lists:reverse(C), [], S};
check_element_type(XML=[#xmlText{}|_],Type=#schema_simple_type{},
_Env,_Block,S,_Checked) ->
check_text_type(XML,Type,S);
check_element_type(XML=[#xmlText{}|_],Type={simpleType,_NameNS},
_Env,_Block,S,_Checked) ->
check_text_type(XML,Type,S);
check_element_type(XML=[#xmlText{}|_],
#schema_complex_type{name=_Name,base_type=BT,
complexity=simple,
content=_C},Env,Block,S,Checked) ->
%% maybe check attributes here as well.
{ResolvedType,_} = resolve({simple_or_complex_Type,BT},S),
check_element_type(XML,ResolvedType,Env,Block,S,Checked);
%% single schema object
check_element_type(XML=[_H|_],
#schema_complex_type{name=Name,block=Bl,content=C},
Env,_Block,S,Checked) ->
EnvName = case Name of
{LN,_Scope,_NS} -> LN;
_ -> anonymous
end,
Block = blocking(Bl,S#xsd_state.blockDefault),
check_element_type(XML,C,[EnvName|Env],Block,name_scope(Name,S),Checked);
%% 1
check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML],
CMEl=#schema_element{name=CMName,type=Type},
Env,Block,S,Checked) ->
ElName = mk_EII_QName(Name,XMLEl,S#xsd_state{scope=element(2,CMName)}),
{Min,Max} = CMEl#schema_element.occurance,
case cmp_name(ElName,CMName,S) of %% substitutionGroup
true when S#xsd_state.num_el =< Max ->
S1 = id_constraints(CMEl,XMLEl,S),
%% If CMEl element has a substitutionGroup we have to
%% switch to the rigth element and type here.
{CMEl2,Type2,S2} =
if
ElName =:= CMName ->
{CMEl,Type,S1};
true ->
case resolve({element,ElName},S1) of
{SESub=#schema_element{type=SubType},Ssub} ->
{SESub,SubType,Ssub};
{_,Ssub} ->
{CMEl,Type,Ssub}
end
end,
{ResolvedType,S3} = resolve(Type2,XMLEl,S2),
%% What's the value of Resolve?: It must be a simpleType,
%% complexType or an identity-constraint object
XsiFactors = xsi_factors(CMEl2),
{XMLEl2,S4} = check_attributes(XMLEl,ResolvedType,
XsiFactors,S3),
S5 = check_abstract(ElName,XMLEl,CMEl,S4),
S6 = check_form(ElName,Name,XMLEl,
actual_form_value(CMEl#schema_element.form,
S5#xsd_state.elementFormDefault),
S5),
%Step into content of XML element.
{Content,_,S7} =
case
check_element_type(XMLEl2#xmlElement.content,
ResolvedType,Env,
Block,S6,Checked) of
{error,Reason} ->
{XMLEl2#xmlElement.content,[],acc_errs(S6,Reason)};
Result ={_,[],_} -> Result;
{_,UnexpectedRest,_} ->
Err = {error_path(XMLEl,Name),?MODULE,
{unexpected_rest,UnexpectedRest}},
{XMLEl2#xmlElement.content,[],
acc_errs(S6,Err)}
end,
{[XMLEl2#xmlElement{content=reverse(Content)}],
RestXML,
set_scope(S5#xsd_state.scope,set_num_el(S7,S6))};
true ->
{error,{error_path(XMLEl, Name), ?MODULE,
{element_not_suitable_with_schema, ElName, S}}};
_ when S#xsd_state.num_el >= Min ->
%% it may be a match error or an optional element not
%% present
{[], XML, S#xsd_state{num_el=0}};
_ ->
{error,{error_path(XMLEl,Name),?MODULE,
{element_not_suitable_with_schema,ElName,CMName,CMEl,S}}}
end;
check_element_type(XML,#schema_group{content=[CM]},Env,Block,S,Checked) ->
%% content may contain one of all | choice | sequence or empty
check_element_type(XML,CM,Env,Block,S,Checked);
check_element_type(XML,#schema_group{content=[]},_Env,_Block,_S,_Checked) ->
{error,{error_path(XML,undefined),?MODULE,{no_element_expected_in_group,XML}}};
check_element_type(XML=[#xmlElement{content=_Content}|_Rest],
{sequence,{Els,Occ}},Env,_Block,S,Checked) ->
?debug("calling sequence/6~n",[]),
case check_sequence(XML,Els,Occ,Env,S#xsd_state{num_el=0},Checked) of
Err = {error,_} ->
Err;
{ValidContent,Rest2,S2} ->
%% The sequence may consume more than one element
%%{ValidContent,Rest,acc_errs(S2,{sequence_unexpected_rest_objects,UnexpRest})}
{ValidContent,Rest2,S2}
end;
check_element_type(XML=[#xmlElement{}|_Rest],
{choice,{Els,Occ}},Env,_Block,S,Checked) ->
?debug("calling choice/6~n",[]),
case check_choice(XML,Els,Occ,Env,S#xsd_state{num_el=0},Checked) of
Err = {error,_} ->
Err;
{ValidContent,Rest2,S2} ->
%% The choice may consume more than one element
{ValidContent,Rest2,S2}
end;
check_element_type(XML=[E=#xmlElement{name=Name}|Rest],
Any={any,{Namespace,_Occ={Min,_},ProcessorContents}},Env,
_Block,S,_Checked) ->
?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,_Occ,ProcessorContents]),
%% ProcessorContents any of lax | strict | skip
%% lax: may validate if schema is found
%% strict: must validate
ElName = mk_EII_QName(Name,E,S),
case cmp_any_namespace(ElName,Namespace,S) of
true ->
case ProcessorContents of
skip ->
{[E],Rest,S};
lax ->
{[E],Rest,S};
%% strict when Namespace==['##local'] ->
strict ->
case member(absent,Namespace) of
true ->
%% unqualified well-formed xml is required. The
%% xml is well-formed, check that it is
%% unqualified.
Traverse =
fun(#xmlElement{nsinfo=[],
attributes=Atts,
content=C},
Sin,Fun) ->
Sin2 = Fun(Atts,Sin,Fun),
Fun(C,Sin2,Fun);
(#xmlAttribute{namespace=[]},Sin,_Fun) ->
Sin;
(#xmlText{},Sin,_Fun) -> Sin;
([H|T],Sin,Fun) ->
Sin2 = Fun(H,Sin,Fun),
Fun(T,Sin2,Fun);
([],Sin,_Fun) ->
Sin;
(El,Sin,_Fun) ->
Err = {error_path(E,Name),?MODULE,
{illegal_component_in_any,El}},
acc_errs(Sin,Err)
end,
S2 = Traverse(E,S,Traverse),
{[E],Rest,S2};
_ ->
{Result,S2}=check_any(E,Any,Env,S),
{[Result],Rest,S2}
end
end;
false when S#xsd_state.num_el >= Min ->
{[],XML,S};
_ ->
{error,{error_path(E,Name),?MODULE,{element_bad_match,E,Any,Env}}}
end;
check_element_type([],CM,_Env,_Block,S,Checked) ->
%% #schema_complex_type, any, #schema_group, anyType and lists are
%% catched above.
case CM of
#schema_simple_type{} ->
{NewVal,S2} = check_type(CM,[],unapplied,S),
{NewVal,[],S2};
{simpleType,_} ->
{NewVal,S2} = check_type(CM,[],unapplied,S),
{NewVal,[],S2};
_ ->
{error,{error_path(Checked,undefined),?MODULE,
{empty_content_not_allowed,CM}}}
end;
check_element_type([C = #xmlComment{} |Rest],CM,Env,Block,S,Checked) ->
check_element_type(Rest,CM,Env,Block,S,[C |Checked]);
check_element_type(XML,CM,_Env,_Block,S,_Checked) ->
{error,{error_path(XML,undefined),?MODULE,{match_failure,XML,CM,S}}}.
%% single xml content object and single schema object
check_text_type(XML=[#xmlText{}|_],optional_text,S) ->
% {XMLTxt,optional_text};
{XMLText,Rest} = split_xmlText(XML),
{XMLText,Rest,S};
check_text_type(XML=[Txt=#xmlText{}|_],Type={simpleType,_},S) ->
{XMLText,Rest} = split_xmlText(XML),
{NewVal,S2}=check_type(Type,flatten([X||#xmlText{value=X}<-XMLText]),unapplied,S),
{[Txt#xmlText{value=NewVal}],Rest,S2};
check_text_type(XML=[Txt=#xmlText{}|_],Type=#schema_simple_type{},S) ->
{XMLText,Rest} = split_xmlText(XML),
{NewVal,S2}=check_type(Type,flatten([X||#xmlText{value=X}<-XMLText]),unapplied,S),
{[Txt#xmlText{value=NewVal}],Rest,S2};
check_text_type([XMLTxt=#xmlText{}|_],CMEl,_S) ->
{error,{error_path(XMLTxt,undefined),?MODULE,
{cannot_contain_text,XMLTxt,CMEl}}}.
split_xmlText(XML) ->
splitwith(fun(#xmlText{}) -> true;(#xmlComment{}) -> true;(_) -> false end,XML).
%% Sequence
check_sequence([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) ->
check_sequence(Rest,Els,Occ,Env,S,[T|Checked]);
check_sequence(Seq=[_InstEl=#xmlElement{}|_],[El|Els],Occ={_Min,_Max},Env,S,Checked) ->
%% El any of (element | group | choice | sequence | any)*
{ResolvedT,S2} = resolve(El,S),
case check_element_type(Seq,ResolvedT,Env,[],count_num_el(S2),[]) of
{[],_,S3} -> %% An optional element not present or maybe content == [].
case is_optional(El,S3) of
true ->
check_sequence(Seq,Els,Occ,Env,set_num_el(S3,0),Checked);
_ ->
{error,{error_path(Checked,undefined),?MODULE,
{missing_mandatory_elements,El}}}
end;
Err={error,_Reason} ->
case {is_optional(El,S),S#xsd_state.num_el,get_occur(El)} of
{true,_,_} ->
check_sequence(Seq,Els,Occ,Env,set_num_el(S,0),Checked);
{_,N,{_Min2,Max}} when N>=Max ->
check_sequence(Seq,Els,Occ,Env,set_num_el(S,0),Checked);
_ ->
Err
end;
%% {error,_Reason} when Min==0 -> %% optional element
%% {[],Seq,S}; %% {Checked,Seq,S}
%% {error,_Reason} when S#xsd_state.num_el >= Max ->
%% %% This failure because of number limit
%% {Checked,Seq,S};
%% Err = {error,_Reason} ->
%% %% Even though this match failed
%% Err;
{Ret,UnValRest,S3} ->
%% must also take care of more elements of same name
%% decrease occurance in El for the optional measurements
%% when Seq is empty.
check_sequence(UnValRest,[decrease_occurance(El)|Els],Occ,Env,
count_num_el(set_num_el(S3,S2)),
Ret++Checked)
end;
check_sequence([C = #xmlComment{} |Rest], Els, Occ, Env, S, Checked) ->
check_sequence(Rest,Els,Occ,Env,S,[C |Checked]);
check_sequence(Rest,[],_Occ,_Env,S,Checked) ->
{Checked,Rest,set_num_el(S,0)};
check_sequence([],Els,_Occ,_Env,S,Checked) ->
case [X||X={_,Y={_,_}} <- Els,optional(Y)==false] of
[] ->
{Checked,[],set_num_el(S,0)};
MandatoryEls ->
{error,{error_path(Checked,undefined),?MODULE,
{missing_mandatory_elements,MandatoryEls}}}
end.
%%check_sequence(Seq,[],_Occ,_Env,_S,_Checked) ->
%%{error,{unmatched_elements,Seq}}.
%% Choice one alternative must occur unless all alternatives are
%% optional or the entire choice is optional.
check_choice([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) ->
case is_whitespace(T) of
true ->
check_choice(Rest,Els,Occ,Env,S,[T|Checked]);
_ ->
{error,{error_path(T,undefined),?MODULE,
{choice_missmatch,T,Els}}}
end;
check_choice(Ch=[#xmlElement{}|_],[El|Els],Occ,Env,S,Checked) ->
{ResolvedT,S2} = resolve(El,S),
case check_element_type(Ch,ResolvedT,Env,[],count_num_el(S2),[]) of
{[],_,_S3} -> %% not matched optional element
check_choice(Ch,Els,Occ,Env,S2,Checked);
{error,_Reason} -> %% This may happen but not for the
%% last alternative element unless the
%% entire choice is optional. So, just
%% continue.
case [X||X=#xmlElement{}<-Checked] of
[] ->
check_choice(Ch,Els,Occ,Env,S2,Checked);
_ ->
{Checked,Ch,set_num_el(S,0)}
end;
{Result,UnValRest,S3} -> %% in this case only more elements of
%% El may be allowed
check_choice(UnValRest,[El],Occ,Env,
count_num_el(set_num_el(S3,S)),Result++Checked)
end;
check_choice([],_,_,_,S,Checked) ->
{Checked,[],set_num_el(S,0)};
check_choice(XML,[],{0,_},_,S,Checked) ->
%% Choice is optional
{Checked,XML,set_num_el(S,0)};
check_choice(XML,[],_,_,S,Checked) ->
%% Choice has already matched something, the rest is for somthing
%% else to match.
case S#xsd_state.num_el > 0 of
true ->
{Checked,XML,set_num_el(S,0)};
_ ->
{error,{error_path(XML,undefined),?MODULE,
{no_element_matching_choice,XML}}}
end.
check_all([T=#xmlText{}|RestXML],CM,Occ,Env,S,Checked,XML) ->
case is_whitespace(T) of
true ->
check_all(RestXML,CM,Occ,Env,S,[T|Checked],XML);
_ ->
{error,{error_path(T,undefined),?MODULE,{all_missmatch,T,CM}}}
end;
check_all(XML=[E=#xmlElement{name=Name}|RestXML],CM,Occ,Env,S,
Checked,PrevXML) ->
ElName = mk_EII_QName(Name,E,S),
case search_delete_all_el(ElName,CM,S) of
{CMEl={element,_},RestCM} ->
{ResolvedT,S2} = resolve(CMEl,S),
case check_element_type(XML,ResolvedT,Env,[],S2,[]) of
{[],_,_S3} ->
Err = {error_path(E,Name),?MODULE,
{validation_error_all,ElName,CM}},
check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),
Checked,PrevXML);
{error,_} when element(1,Occ)==0 ->
{[],PrevXML,S};
{error,Reason} ->
check_all(RestXML,RestCM,Occ,Env,
acc_errs(S,Reason),[E|Checked],PrevXML);
{Result,UnValRest,S3} ->
check_all(UnValRest,RestCM,Occ,Env,
S3#xsd_state{scope=S#xsd_state.scope},
Result++Checked,PrevXML)
end;
_ when element(1,Occ) == 0 ->
{[],PrevXML,S};
_ ->
Err = {error_path(E,Name),?MODULE,
{element_not_in_all,ElName,E,CM}},
check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),[E|Checked],PrevXML)
end;
check_all([C=#xmlComment{} |RestXML], CM, Occ, Env, S, Checked, XML) ->
check_all(RestXML, CM, Occ, Env, S, [C |Checked], XML);
check_all(XML,[],_,_,S,Checked,_) ->
{Checked,XML,S};
check_all([],CM,_Occ,_,S,Checked,_PrevXML) ->
case [X||X={_,Y={_,_}} <- CM,optional(Y)==false] of
[] ->
{Checked,[],set_num_el(S,0)};
MandatoryEls ->
{error,{error_path(Checked,undefined),?MODULE,
{missing_mandatory_elements_in_all,MandatoryEls}}}
end.
check_any(E,Any,_Env,S) ->
case catch validate_xml(E,S#xsd_state{scope=[]}) of
{[Result],[],S2} ->
{Result,S2#xsd_state{scope=S#xsd_state.scope}};
{Result,[],S2} ->
{Result,S2#xsd_state{scope=S#xsd_state.scope}};
{_,_Unvalidated,S2} ->
Err = {error_path(E,undefined),?MODULE,{failed_validating,E,Any}},
{E,acc_errs(S2#xsd_state{scope=S#xsd_state.scope},Err)};
{error,Reason} ->
{E,acc_errs(S,Reason)};
{'EXIT',Reason} ->
%% {E,acc_errs(S,format_error({internal_error,Reason},E,Any,Env))}
Err = {error_path(E,undefined),?MODULE,{internal_error,Reason}},
{E,acc_errs(S,Err)}
end.
check_target_namespace(XMLEl,S) ->
case {S#xsd_state.targetNamespace,XMLEl#xmlElement.nsinfo} of
{undefined,[]} ->
ok;
{URI,{Prefix,_}} ->
NS = XMLEl#xmlElement.namespace,
case namespace(Prefix,NS,NS#xmlNamespace.default) of
URI ->
ok;
_ ->
failed
end;
{URI,_} ->
case (XMLEl#xmlElement.namespace)#xmlNamespace.default of
URI ->
ok;
_ ->
failed
end
end.
schemaLocations(El=#xmlElement{attributes=Atts},S) ->
Pred = fun(#xmlAttribute{name=schemaLocation}) -> false;
(#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false;
(_) -> true
end,
case lists:dropwhile(Pred,Atts) of
[] ->
S;
[#xmlAttribute{value=Paths}|_] ->
case string:tokens(Paths," \n\t\r") of
L when length(L) > 0 ->
case length(L) rem 2 of
0 ->
PairList =
fun([],_Fun) ->
[];
([SLNS,SLLoc|Rest],Fun) ->
[{SLNS,SLLoc}|Fun(Rest,Fun)]
end,
S#xsd_state{schemaLocations=PairList(L,PairList)};
_ ->
Err = {error_path(El,El#xmlElement.name),?MODULE,
{schemaLocation_list_failure,Paths}},
acc_errs(S,Err)
end;
_ ->
S
end;
_ ->
S
end.
blocking([],BlockDefault) ->
BlockDefault;
blocking(Block,_) ->
Block.
allow_empty_content([]) ->
true;
allow_empty_content([{restriction,{_BT,_CM=[]}}]) ->
true;
allow_empty_content([{extension,{_BT,_CM=[]}}]) ->
true;
allow_empty_content([{_,{_,{0,_}}}|Rest]) ->
allow_empty_content(Rest);
allow_empty_content([{_,{Content,_}}|Rest]) ->
case allow_empty_content(Content) of
true ->
allow_empty_content(Rest);
_ -> false
end;
allow_empty_content(_) ->
false.
empty_xml_content([]) ->
true;
empty_xml_content([H|T]) ->
case is_whitespace(H) of
true ->
empty_xml_content(T);
_ ->
false
end;
empty_xml_content(_) ->
false.
xsi_factors(#schema_element{nillable=N}) ->
[{nillable,N}].
check_xsi_factors({nil,_,?XSD_INSTANCE_NAMESPACE},
#xmlAttribute{value="true"},XsiFactors,XMLEl,S) ->
case key1search(nillable,XsiFactors,false) of
{_,true} ->
case empty_xml_content(XMLEl#xmlElement.content) of
true ->
S;
_ ->
Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{element_content_not_nil,XMLEl}},
acc_errs(S,Err)
end;
_ ->
S
end;
check_xsi_factors(_,_,_,_,S) ->
S.
check_attributes(XMLEl=#xmlElement{attributes=Atts},
#schema_complex_type{name=Name,attributes=SchemaAtts},
XsiFactors,S) ->
%% For each att in Atts check that it is allowed, and has right type.
%% For each att in CT that is required check that it exists. Apply
%% none present atts that have default values.
OldScope = S#xsd_state.scope,
SchemaAtts2 = resolve_attributeGroups(SchemaAtts,XMLEl,S),
{XMLEl2,S2}=check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
name_scope(Name,S),[]),
{XMLEl2,S2#xsd_state{scope=OldScope}};
check_attributes(XMLEl=#xmlElement{attributes=[]},_,_,S) ->
{XMLEl,S};
check_attributes(XMLEl=#xmlElement{name=N,attributes=Atts},_,XsiFactors,S) ->
Fun =
fun(AttX,S_in) ->
case reserved_attribute(AttX,XMLEl#xmlElement.namespace) of
true ->
AttQName =
mk_EII_QName(AttX#xmlAttribute.name,XMLEl,S_in),
check_xsi_factors(AttQName,AttX,XsiFactors,XMLEl,S_in);
_ ->
Err = {error_path(XMLEl,N),?MODULE,
{attribute_in_simpleType,XMLEl,AttX}},
acc_errs(S_in,Err)
end
end,
{XMLEl,foldl(Fun,S,Atts)}.
check_attributes([],[SA|SchemaAtts],XMLEl,XsiFactors,S,CheckedAtts) ->
case resolve(SA,S) of
{#schema_attribute{name=Name,use=Use,default=Def,fixed=Fix},S2} ->
case {Use,Def,Fix} of
{required,_,_} ->
Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{required_attribute_missed,XMLEl,Name}},
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
acc_errs(S2,Err),CheckedAtts);
{optional,undefined,undefined} ->
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
S2,CheckedAtts);
{optional,Default,undefined} ->
NewAtt = create_attribute(Name,Default),
check_attributes([],SchemaAtts,XMLEl,XsiFactors,S2,
[NewAtt|CheckedAtts]);
{optional,undefined,Fix} ->
NewAtt = create_attribute(Name,Def),
check_attributes([],SchemaAtts,XMLEl,XsiFactors,S2,
[NewAtt|CheckedAtts]);
{optional,Default,Fix} ->
Err = {error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{default_and_fixed_attributes_mutual_exclusive,
Name,Default,Fix}},
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
acc_errs(S2,Err),CheckedAtts);
_ ->
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
S2,CheckedAtts)
end;
{{anyAttribute,{_Namespaces,_PC}},S2} ->
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
S2,CheckedAtts);
Err ->
ErrMsg={error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{schema_error,unexpected_object,SA,Err}},
check_attributes([],SchemaAtts,XMLEl,XsiFactors,
acc_errs(S,ErrMsg),CheckedAtts)
end;
check_attributes([],[],XMLEl,_XsiFactors,S,CheckedAtts) ->
{XMLEl#xmlElement{attributes=reverse(CheckedAtts)},S};
check_attributes([Att|Atts],SchemaAtts,XMLEl,XsiFactors,
S,CheckedAtts) ->
%% AttQName = mk_EII_QName(Att#xmlAttribute.name,XMLEl,S),
{IsQ,AttQName} = mk_EII_Att_QName(Att#xmlAttribute.name,XMLEl,S),
case search_attribute(IsQ,AttQName,SchemaAtts) of
{AttObj={attribute,_},SchemaAtts2} ->
{SA,S2} = load_object(AttObj,S),
#schema_attribute{type=[AttType]} = SA,
{Val,S4} = check_type(AttType,
Att#xmlAttribute.value, unapplied,S2),
check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,S4,
[Att#xmlAttribute{value=Val}|CheckedAtts]);
{undefined,SchemaAtts2} ->
%% check for reserved attributes or anyAttribute
case reserved_attribute(Att,XMLEl#xmlElement.namespace) of
true ->
S2 = check_xsi_factors(AttQName,Att,XsiFactors,XMLEl,S),
check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
S2,[Att|CheckedAtts]);
_ ->
case check_anyAttribute(Att,SchemaAtts2,XMLEl,S) of
{error,Reason} ->
check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
acc_errs(S,Reason),CheckedAtts);
{Att2,S2} ->
check_attributes(Atts,SchemaAtts2,XMLEl,XsiFactors,
S2,[Att2|CheckedAtts])
end
end;
Other ->
Err = {[],?MODULE,{internal_error,Other}},
check_attributes(Atts,SchemaAtts,XMLEl,XsiFactors,
acc_errs(S,Err),CheckedAtts)
end.
check_anyAttribute(Att,SchemaAtts,El=#xmlElement{name=Name,namespace=NS},S) ->
case [Any||Any={anyAttribute,_}<-SchemaAtts] of
[] ->
{error,{error_path(El,Name),?MODULE,
{attribute_not_defined_in_schema,
Att#xmlAttribute.name}}};
[{_,{Namespace,PC}}|_] ->
case check_anyAttribute_namespace(Namespace,NS) of
ok ->
check_anyAttribute2(Namespace,PC,Att,NS,S);
_ ->
{error,{error_path(El,Name),?MODULE,
{disallowed_namespace,Namespace,
NS,Att#xmlAttribute.name}}}
end
end.
check_anyAttribute2(_,PC,Att,_,S) when PC==skip;PC==lax ->
{Att,S};
check_anyAttribute2(_Namespace,_,Att,_NS,S) ->
%% PC == strict
{Att,S}.
check_anyAttribute_namespace(['##any'|_],_NS) ->
ok;
check_anyAttribute_namespace([absent],_NS) ->
ok;
check_anyAttribute_namespace([NS|_],NS) ->
ok;
check_anyAttribute_namespace([{'not',NS}|_],NS) ->
false;
check_anyAttribute_namespace([_H|T],NS) ->
check_anyAttribute_namespace2(T,NS).
check_anyAttribute_namespace2([NS|_],NS) ->
ok;
check_anyAttribute_namespace2([_H|T],NS) ->
check_anyAttribute_namespace2(T,NS);
check_anyAttribute_namespace2([],_NS) ->
false.
resolve_attributeGroups(SchemaAtts,El,S) ->
resolve_attributeGroups(SchemaAtts,El,S,[],[]).
resolve_attributeGroups([AG={attributeGroup,_}|SchemaAtts],El,S,Parents,Acc) ->
case resolve(AG,S) of
{#schema_attribute_group{name=Name,content=AGC},_S2} ->
case {member(Name,Parents),S#xsd_state.redefine} of
{true,false} ->
Err = {error_path(El,El#xmlElement.name),?MODULE,
{cirkular_attributeGroup_reference,Name}},
resolve_attributeGroups(SchemaAtts,El,acc_errs(S,Err),
Parents,Acc);
{true,_} ->
resolve_attributeGroups(SchemaAtts,El,S,Parents,Acc);
_ ->
resolve_attributeGroups(AGC++[marker|SchemaAtts],
El,S,[Name|Parents],Acc)
end;
Err ->
ErrMsg={error_path(El,El#xmlElement.name),?MODULE,
{schema_error,unexpected_object,AG,Err}},
resolve_attributeGroups(SchemaAtts,El,acc_errs(S,ErrMsg),
Parents,Acc)
end;
resolve_attributeGroups([marker|T],El,S,[_P|Ps],Acc) ->
resolve_attributeGroups(T,El,S,Ps,Acc);
resolve_attributeGroups([H|T],El,S,Parents,Acc) ->
resolve_attributeGroups(T,El,S,Parents,[H|Acc]);
resolve_attributeGroups([],_,_,_,Acc) ->
Acc.
check_type(Type=#schema_simple_type{},Value,FacetS,S) ->
check_simpleType(Type,Value,FacetS,S);
check_type({simpleType,{anySimpleType,_}},Value, _FacetS,S) ->
{Value,S};
check_type({union,Types},Value,_FacetS,S) ->
check_union_types(Types,Value,S);
check_type(ST={simpleType,QName={Name,_Scope,_NS}},Value, FacetS,S) ->
case is_builtin_simple_type(QName) of
true ->
{ConstrainedValue,S2} =
constrained(QName,default_facets(FacetS,Name),Value,S),
case xmerl_xsd_type:check_simpleType(Name,ConstrainedValue,S2) of
{ok,_} when Name=='IDREF';Name=='IDREFS' ->
%% do something more
{ConstrainedValue,S2};
{ok,_} ->
{ConstrainedValue,S2};
{error,Reason} ->
?debug("Error validating type: ~p~nwith value: ~p~n",[Name,Value]),
{Value,acc_errs(S2,Reason)}
end;
_ ->
case resolve(ST,S) of
{[],S2} ->
Err = {[],?MODULE,{could_not_resolve_type,ST}},
{Value,acc_errs(S2,Err)};
{RefedST,S2} ->
check_type(RefedST,Value, unapplied,S2)
end
end;
check_type(Type,Value, _FacetS,S) ->
Err = {[],?MODULE,{could_not_check_value_for_type,Type}},
?debug("ERROR: not implemented: ~p~nfor value: ~p~n",[Type,Value]),
{Value,acc_errs(S,Err)}.
check_simpleType(#schema_simple_type{base_type=BT,final=_Final,
facets=Facets,content=Type},
Value,FacetS,S) ->
case {BT,Type} of
{{_ST,_,_},_} ->
case is_builtin_simple_type(BT) of
true ->
{ConstrainedValue,S2} =
constrained(BT,merge_facets(default_facets(FacetS,BT),Facets),Value,S),
{_,_S3} = check_type({simpleType,BT},ConstrainedValue,applied,S2);
_ ->
case resolve({simpleType,BT},S) of
{BaseST=#schema_simple_type{facets=Facets2},_} ->
check_simpleType(BaseST#schema_simple_type{facets=Facets++Facets2},Value,unapplied,S);
_ ->
Err = {[],?MODULE,{unknown_simpleType,BT}},
{Value,acc_errs(S,Err)}
end
end;
{_,[CT]} ->
{_,_S2} = check_type(CT,Value,unapplied,S)
end.
check_union_types(Types,Value,S) ->
check_union_types(Types,Types,Value,S).
check_union_types([],UT,Value,S) ->
acc_errs(S,{[],?MODULE,{value_not_valid,Value,UT}});
check_union_types([T|Ts],UT,Value,S = #xsd_state{errors=Errs}) ->
case check_type(T,Value,unapplied,S) of
{Val,S2=#xsd_state{errors=Errs}} ->
{Val,S2};
{_,_} ->
check_union_types(Ts,UT,Value,S)
end.
reserved_attribute({RA,_,?XSD_INSTANCE_NAMESPACE},_)
when RA==type;RA==nil;RA==schemaLocation;RA==noNamespaceSchemaLocation ->
true;
reserved_attribute(#xmlAttribute{name=Name},#xmlNamespace{nodes=NSNodes}) ->
NameStr = if
is_atom(Name) -> atom_to_list(Name);
true -> Name
end,
case string:tokens(NameStr,":") of
["xmlns"|_] ->
true;
[Prefix,InstAtt] when InstAtt=="type";
InstAtt=="nil";
InstAtt=="schemaLocation";
InstAtt=="noNamespaceSchemaLocation" ->
case keyNsearch(?XSD_INSTANCE_NAMESPACE,2,NSNodes,[]) of
{Prefix,_} ->
true;
_ ->
false
end;
_ ->
false
end;
reserved_attribute(_,_) ->
false.
default_facets(applied,_) ->
[];
default_facets(_,Type) ->
default_facets(Type).
default_facets({Name,_,_}) when is_list(Name) ->
%% Type already proven to be a built in simple type
default_facets(list_to_atom(Name));
default_facets({Name,_,_}) ->
default_facets(Name);
default_facets(TypeName) ->
case is_xsd_string(TypeName) of
false ->
[{whiteSpace,"collapse"}];
_ ->
[]
end.
merge_facets([],DefinedF) ->
DefinedF;
merge_facets([F={Name,_}|Rest],DefinedF) ->
%% At this moment only F has the allowed value
merge_facets(Rest,keyreplace(Name,1,DefinedF,F)).
constrained({T,_,_},Facets,Value,S) ->
FacetFuns = [facet_fun(T,F)||F<-Facets],
constrained2(FacetFuns,Value,S).
constrained2([],Value,S) ->
{Value,S};
constrained2([Facet|RestFacets],Value,S) ->
case Facet(Value) of
{error,Reason} ->
constrained2(RestFacets,Value,acc_errs(S,Reason));
{ok,NewValue} ->
constrained2(RestFacets,NewValue,S)
end.
id_constraints(CMEl,XMLEl,S) ->
S1 = check_uniqueness(CMEl#schema_element.uniqueness,
XMLEl,S),
S2 = check_keys([X||{key,X}<-CMEl#schema_element.key],XMLEl,S1),
prepare_keyrefs([X||{keyref,X}<-CMEl#schema_element.key],XMLEl,S2).
check_abstract(ElName,El,#schema_element{name=ElName,abstract=true},S) ->
acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
{abstract_element_instance,ElName}});
check_abstract(ElName,_El,#schema_element{name=ElName},S) ->
S;
check_abstract(ElName,El,#schema_element{},S) ->
{XMLEl,_S2} = load_object({element,ElName},S),
check_abstract(ElName,El,XMLEl,S).
%% Check of form compliance.
%% Globally declared elements may be qualified even though
%% elementformdefault = "unqualified".
%% If ActualFormValue = "qualified" locally defined names must be
%% explicitly or implicitly qualified.
%% check_form({LocalName,Scope,Namespace},LocalName,
%% InstanceNamespace,ActualFormDefault,S) -> NewS
check_form({LocalName,_,Namespace},LocalName,
El=#xmlElement{name=Name,namespace=NS},qualified,S) ->
case NS#xmlNamespace.default of
Namespace ->
S;
_ ->
acc_errs(S,{error_path(El,Name),?MODULE,
{qualified_name_required,LocalName}})
end;
check_form({LocalName,_,_},LocalName,_El,_ActualFormDefault,S) ->
S;
check_form({_LocalName,[],_},_QualifiedName,_El,_ActualFormDefault,S) ->
S;
check_form({_LocalName,_,_},QualifiedName,El,unqualified,S) ->
acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
{unqualified_name_required,QualifiedName}});
check_form({_LocalName,_,_},_QualifiedName,_El,_ActualFormDefault,S) ->
S.
actual_form_value(undefined,GlobalForm) ->
GlobalForm;
actual_form_value(LocalForm,_) ->
LocalForm.
check_uniqueness(undefined,_,S) ->
S;
check_uniqueness(Unique,XMLEl,S) ->
case Unique of
[{unique,#id_constraint{selector={selector,SelectorPath},
fields=Fields}}] ->
TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
case qualified_node_set(Fields,TargetNodeSet,XMLEl,S) of
{[],S1} -> S1;
{[_E],S1} -> S1;
{L,S1} when is_list(L) ->
key_sequence_uniqueness(L,XMLEl,S1)
end;
_ -> S
end.
target_node_set(SelectorPath,XMLEl,S) ->
xmerl_xpath:string(SelectorPath,XMLEl,
[{namespace,S#xsd_state.namespace_nodes}]).
qualified_node_set(Fields,Set,El,S) ->
qualified_node_set([X||{field,X} <- Fields],Set,El,S,[]).
qualified_node_set([],_Set,_El,S,Acc) ->
{Acc,S};
qualified_node_set(_,[],_El,S,Acc) ->
{Acc,S};
qualified_node_set(Paths,[QN|QNs],El,S,Acc) ->
Fun = fun(P,Sx) ->
case apply_field(P,QN,Sx) of
L when length(L) =< 1 -> % Part1:3.11.4.3
{L,Sx};
Err ->
RetErr =
{error_path(El,El#xmlElement.name),?MODULE,
{illegal_key_sequence_value,Err}},
{[],acc_errs(Sx,RetErr)}
end
end,
{KeySequence,S2} = mapfoldl(Fun,S,Paths),
case flatten(KeySequence) of
[] ->
qualified_node_set(Paths,QNs,El,S2,Acc);
KS ->
qualified_node_set(Paths,QNs,El,S2,[KS|Acc])
end.
apply_field(F,El,S) ->
%% xmerl_xpath:string returns a list
xmerl_xpath:string(F,El,[{namespace,S#xsd_state.namespace_nodes}]).
check_keys([],_XMLEl,S) ->
S;
check_keys([Key=#id_constraint{selector={selector,SelectorPath},
fields=Fields}|Keys],XMLEl,S) ->
TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
S3=
case qualified_node_set(Fields,TargetNodeSet,XMLEl,S) of
{L,S1} when length(L)==length(TargetNodeSet) ->
%% Part1: 3.11.4.4.2.1
S2 = key_sequence_uniqueness(L,XMLEl,S1),
save_key(Key#id_constraint{key_sequence=L},S2),
S2;
{Err,S1} ->
acc_errs(S1,{error_path(XMLEl,XMLEl#xmlElement.name),?MODULE,
{qualified_node_set_not_correct_for_key,Err}})
end,
check_keys(Keys,XMLEl,S3).
%% A reference to a key may occur in another environment than the key
%% was defined. Thus the key must be referenced after the whole
%% document has been processed. At this moment save the info about the
%% keyref and compare it with the key later.
prepare_keyrefs([],_XMLEl,S) ->
S;
prepare_keyrefs([KeyRef=#id_constraint{selector={selector,SelectorPath},
fields=Fields}|Rest],XMLEl,S) ->
TargetNodeSet = target_node_set(SelectorPath,XMLEl,S),
{L,S1} = qualified_node_set(Fields,TargetNodeSet,XMLEl,S),
save_keyref(KeyRef#id_constraint{key_sequence=L},S1),
prepare_keyrefs(Rest,XMLEl,S1).
%% key_sequence_uniqueness(KeySequence,XMLElement,State)
%% Each element in KeySequence has same length and is a list of one or
%% more elements. key_sequence_uniqueness/2 checks that no two
%% elements has equal values. If it detects two (or more) elements
%% that have equal first subelements it must continue comparing the
%% other subelements of those elements. It returns the state with all
%% detected errors saved.
key_sequence_uniqueness([],_,S) ->
S;
key_sequence_uniqueness([_H],_,S) ->
S;
key_sequence_uniqueness([KS=[F1|FRest]|KSs],El,S) ->
case is_key_sequence_equal(F1,KSs) of
{true,TailOfEquals} ->
S1 =
case k_s_u(FRest,TailOfEquals,S) of
true ->
acc_errs(S,{error_path(El,El#xmlElement.name),?MODULE,
{key_value_not_unique,KS}});
_ ->
S
end,
key_sequence_uniqueness(KSs,El,S1);
false ->
key_sequence_uniqueness(KSs,El,S)
end.
k_s_u([],_,_) ->
true;
k_s_u([F|Fs],KSs,S) ->
case is_key_sequence_equal(F,KSs) of
{true,TailOfEquals} ->
k_s_u(Fs,TailOfEquals,S);
_ ->
false
end.
is_key_sequence_equal(F,KSs) ->
is_key_sequence_equal(F,KSs,[]).
is_key_sequence_equal(_F,[],[]) ->
false;
is_key_sequence_equal(_F,[],Acc) ->
{true,reverse(Acc)};
is_key_sequence_equal(F,[[F1|TlF1]|Rest],Acc) ->
case is_key_el_equal(F,F1) of
true ->
is_key_sequence_equal(F,Rest,[TlF1|Acc]);
false ->
is_key_sequence_equal(F,Rest,Acc)
end.
%% This test must be more elaborated considering the equal facet
is_key_el_equal(#xmlElement{content=C1},#xmlElement{content=C2}) ->
%% content must be empty or text since elements must be of
%% simpleType
is_equal_content(C1,C2);
is_key_el_equal(#xmlAttribute{value=V1},#xmlAttribute{value=V1}) ->
true;
is_key_el_equal(_,_) ->
false.
is_equal_content([T1|Rest1],[T2|Rest2])
when is_record(T1,xmlText),is_record(T2,xmlText) ->
case is_whitespace(T1) of
true ->
case is_whitespace(T2) of
true ->
is_equal_content(Rest1,Rest2);
_ ->
is_equal_content(Rest1,[T2|Rest2])
end;
_ ->
case T1#xmlText.value==T2#xmlText.value of
true ->
is_equal_content(Rest1,Rest2);
_ ->
false
end
end;
is_equal_content([],[]) ->
true;
is_equal_content(_,_) ->
false.
schema_concistence_checks(S) ->
S2 = check_keyrefs(S),
S3 = check_references(S2),
S4 = check_substitutionGroups(S3#xsd_state.substitutionGroups,S3),
S5 = check_cyclic_defs(S4),
reset_state(S5).
reset_state(S) ->
S#xsd_state{keyrefs=[],
'IDs'=[],
unchecked_references=[],
substitutionGroups=[],
derived_types=[],
circularity_stack=[],
circularity_disallowed=[]}.
check_keyrefs(S) ->
KeyRefs = S#xsd_state.keyrefs,
%% check that a key exists with same name as each keyref
KeyExist =
fun({keyref,Name,Refer},S_in) ->
case load_key(Refer,S_in) of
Key=#id_constraint{} ->
check_keyref_cardinality(Name,
load_keyref(Name,S_in),
Key,S_in);
% S_in;
_ ->
acc_errs(S_in,{[],?MODULE,
{keyref_missed_matching_key,Refer}})
end;
(Other,S_in) ->
acc_errs(S_in,{[],?MODULE,
{keyref_unexpected_object,Other}})
end,
foldl(KeyExist, S, KeyRefs).
check_keyref_cardinality(_,KR=#id_constraint{category=keyref,fields=KeyRefFs},
K=#id_constraint{fields=KeyFs},S) ->
case length(KeyRefFs) == length(KeyFs) of
true ->
S;
_ ->
acc_errs(S,{[],?MODULE,
{cardinality_of_fields_not_equal,KR,K}})
end;
check_keyref_cardinality(Name,_,_,S) ->
acc_errs(S,{[],?MODULE,{could_not_load_keyref,Name}}).
check_references(S) when is_record(S,xsd_state) ->
check_references(S#xsd_state.unchecked_references,S).
check_references([],S) ->
S;
check_references([H|T],S) ->
check_references(T,check_reference(H,S)).
check_reference(Ref={attribute,_},S) ->
case load_object(Ref,S) of
{#schema_attribute{},S2} ->
S2;
_ ->
acc_errs(S,{[],?MODULE,{reference_undeclared,attribute,Ref}})
end;
check_reference(Ref={element,_},S) ->
case load_object(Ref,S) of
{#schema_element{},S2} ->
S2;
_ ->
acc_errs(S,{[],?MODULE,{reference_undeclared,element,Ref}})
end;
check_reference(Ref={attributeGroup,_},S) ->
case load_object(Ref,S) of
{#schema_attribute_group{},S2} ->
S2;
_ ->
acc_errs(S,{[],?MODULE,{reference_undeclared,attributeGroup,Ref}})
end;
check_reference(Ref={group,_},S) ->
case load_object(Ref,S) of
{#schema_group{},S2} -> S2;
_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,group,Ref}})
end;
check_reference(Ref={simpleType,_},S) ->
case load_object(Ref,S) of
{#schema_simple_type{},S2} -> S2;
_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,simpleType,Ref}})
end;
check_reference(Ref={complexType,_},S) ->
case load_object(Ref,S) of
{#schema_complex_type{},S2} -> S2;
_ -> acc_errs(S,{[],?MODULE,{reference_undeclared,complexType,Ref}})
end;
check_reference({simple_or_complex_Type,Ref},S=#xsd_state{errors=Errs}) ->
%% complex or simple type
case check_reference({complexType,Ref},S) of
S2=#xsd_state{errors=Errs} -> S2;
_ -> check_reference({simpleType,Ref},S)
end;
check_reference(Ref,S) ->
acc_errs(S,{[],?MODULE,{internal_error,unknown_reference,Ref}}).
%% Substitution groups should be checked for cirkular references
%% (invalid), that reference structure and type structure are
%% concistent.
check_substitutionGroups([],S) ->
S;
check_substitutionGroups(SGs,S) ->
S2 = check_substGr_acyclic(SGs,S),
S3 = check_substGr_type_structure(SGs,S2),
save_substitutionGroup(SGs,S3).
check_substGr_acyclic(SGs,S) ->
Set = sofs:family(SGs),
case catch sofs:family_to_digraph(Set, [acyclic]) of
{'EXIT',{cyclic,_}} ->
acc_errs(S,{[],?MODULE,{cyclic_substitutionGroup,SGs}});
DG ->
digraph:delete(DG),
S
end.
check_substGr_type_structure([SG|SGs],S) ->
check_substGr_type_structure(SGs,check_substGr_type_structure2(SG,S));
check_substGr_type_structure([],S) ->
S.
check_substGr_type_structure2({Head,SGMembers},S) ->
TypeCheck =
fun(SG,S_in) ->
case catch cmp_substGr_types(Head,SG,S_in) of
{'EXIT',_} ->
acc_errs(S_in,{[],?MODULE,
{substitutionGroup_error,Head,SG}});
S_out -> S_out
end
end,
foldl(TypeCheck,S,SGMembers).
cmp_substGr_types(Head,SG,S) ->
{HeadElement,S2} = load_object({element,Head},S),
{MemberElement,S3} = load_object({element,SG},S2),
case catch derived_or_equal(MemberElement#schema_element.type,
HeadElement#schema_element.type,
[],S3) of
S4=#xsd_state{} ->
S4;
_ ->
acc_errs(S3,{[],?MODULE,{internal_error,derived_or_equal,
MemberElement#schema_element.type,
HeadElement#schema_element.type}})
end.
check_cyclic_defs(S=#xsd_state{circularity_disallowed=CA}) ->
Set = sofs:relation_to_family(sofs:relation(CA)),
case catch sofs:family_to_digraph(Set, [acyclic]) of
{'EXIT',{cyclic,_}} ->
acc_errs(S,{[],?MODULE,{cyclic_definition,CA}});
DG ->
digraph:delete(DG),
S
end.
derived_or_equal(Type,Type,_Block,S) ->
S;
derived_or_equal([MemberTypeRef],[HeadTypeRef],Block,S) ->
%% HeadType has to be a
{HeadType,_} = resolve(HeadTypeRef,S),
{MemberType,_} = resolve(MemberTypeRef,S),
derived_or_equal_types(MemberType,HeadType,schema,Block,S).
derived_or_equal_types(MemT,{anyType,_},Env,Block,S) ->
case MemT of
#schema_simple_type{content=Cntnt} ->
is_derivation_blocked(Env,Block,Cntnt,S);
#schema_complex_type{content=Cntnt} ->
is_derivation_blocked(Env,Block,Cntnt,S);
_ -> S
end;
derived_or_equal_types(MemT=#schema_simple_type{name=Mem,base_type=MemBase},
#schema_simple_type{name=Head},Env,Block,S)
when Mem==Head;MemBase==Head ->
is_derivation_blocked(Env,Block,MemT#schema_simple_type.content,S);
derived_or_equal_types({simpleType,Name},
{simpleType,Name},_Env,_Block,S) ->
S;
derived_or_equal_types(#schema_simple_type{base_type=Name,content=Content},
{simpleType,Name},Env,Block,S) ->
is_derivation_blocked(Env,Block,Content,S);
derived_or_equal_types(#schema_simple_type{content=[{LoU,[Content]}]},
SimpleType,Env,Block,S) when LoU==list;LoU==union ->
{NewMemType,S2}=resolve(Content,S),
derived_or_equal_types(NewMemType,SimpleType,Env,Block,S2);
derived_or_equal_types(MemT=#schema_complex_type{name=Mem,base_type=MemBase},
#schema_complex_type{name=Head},Env,Block,S)
when Mem==Head;MemBase==Head ->
is_derivation_blocked(Env,Block,MemT#schema_complex_type.content,S);
derived_or_equal_types(MemT,HeadT,_Env,_Block,S) ->
acc_errs(S,{[],?MODULE,{type_of_element_not_derived,MemT,HeadT}}).
is_derivation_blocked(schema,_,_,S) ->
S;
is_derivation_blocked(instance,['#all'],Derivation,S) ->
acc_errs(S,{derivation_blocked,'#all',Derivation});
is_derivation_blocked(instance,[],_,S) ->
S;
is_derivation_blocked(instance,Block,C=[{Derivation,_}],S) ->
case member(Derivation,Block) of
true ->
acc_errs(S,{[],?MODULE,{derivation_blocked,Derivation,C}});
_ ->
S
end;
is_derivation_blocked(instance,_Block,_,S) ->
S.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
create_attribute(QName,Value) ->
{Name,_Scope,NSName} = QName,
#xmlAttribute{name=Name,namespace={Name,NSName},value=Value}.
%% mk_name(L), L must be a list in reversed order
mk_name(L) ->
mk_name(L,[]).
mk_name([],_Acc) ->
[];
mk_name([H],[]) ->
H;
mk_name([H],Acc) ->
list_to_atom(lists:concat([H,'_'|Acc]));
mk_name([H|T],[]) ->
mk_name(T,[H]);
mk_name([H1|T],Acc) ->
mk_name(T,[H1,'_'|Acc]).
cmp_name({LName,Scope,NS},{LName,Scope,NS},_S) ->
true;
%% substitutionGroup allows different names
cmp_name(XMLName={_,Scope,NS},CMName={_,Scope,NS},S) ->
{El,_S2} = load_object({element,XMLName},S),
cmp_SG_name(El,CMName,S);
cmp_name(_,_,_) ->
false.
cmp_SG_name(#schema_element{substitutionGroup=Name},Name,_S) ->
true;
cmp_SG_name(#schema_element{substitutionGroup=SGName},CMName,S) ->
cmp_name(SGName,CMName,S);
cmp_SG_name(_,_,_) ->
false.
%% Namespace: [{not,NS} | NS]
%%
cmp_any_namespace({_,_,EIINS},Namespace,_S) ->
case member(EIINS,Namespace) of
true ->
true;
_ ->
case keysearch(EIINS,2,Namespace) of
{value,{'not',EIINS}} ->
false;
_ ->
true
end
end.
at_least_one({_Min,Max}) when Max > 0 ->
true;
at_least_one(_) ->
false.
is_optional({element,{_,{0,_}}},_S) ->
true;
is_optional({any,{_,{0,_},_}},_S) ->
true;
is_optional({MG,{_CM,{0,_}}},_S)
when MG =:= all; MG =:= sequence; MG =:= choice ->
true;
is_optional({MG,{CM,_Occ}},S)
when MG =:= all; MG =:= sequence; MG =:= choice ->
case member(false,[is_optional(Y,S)||Y<-CM]) of
true ->
false;
_ -> true
end;
is_optional({group,{_,{0,_}}},_S) ->
true;
is_optional(G={group,_},S) ->
case resolve(G,S) of
{#schema_group{content=[]},_} ->
true;
{#schema_group{content=[CM]},_} ->
is_optional(CM,S)
end;
is_optional(_,_) ->
false.
acc_errs(S=#xsd_state{errors=Errs},ErrMsg) ->
S#xsd_state{errors=[ErrMsg|Errs]}.
%% invoked with an element/XML-node and a name of the
error_path([H|_T],Top) when H==#xmlElement{};H==#xmlText{} ->
error_path(H,Top);
error_path([_H|T],Top) ->
error_path(T,Top);
error_path(#xmlElement{parents=Ps,pos=Pos},Top) ->
error_path(Ps,Pos,Top);
error_path(#xmlAttribute{parents=Ps,pos=Pos},Top) ->
error_path(Ps,Pos,Top);
error_path(#xmlText{parents=Ps,pos=Pos},Top) ->
error_path(Ps,Pos,Top);
error_path(_,_) ->
[].
error_path([],Pos,Top) when is_integer(Pos) ->
mk_xpath_path([{Top,Pos}]);
error_path([],_,Top) ->
Top;
error_path(Nodes,_,_) ->
mk_xpath_path(Nodes).
mk_xpath_path(Nodes) ->
Slash =
fun([H1,H2|T],Fun,Acc) -> Fun([H2|T],Fun,["/",H1|Acc]);
([H1],_,Acc) -> [H1|Acc];
([],_,Acc) -> Acc
end,
flatten(Slash([lists:concat([A,"[",B,"]"])||{A,B}<-Nodes],Slash,[])).
resolve(XSDType,InstanceEl,S) ->
explicit_type(XSDType,InstanceEl,S).
resolve([H],S) ->
resolve(H,S);
resolve(Any={any,_},S) ->
{Any,S};
resolve(Any={anyAttribute,_},S) ->
{Any,S};
resolve(Any={anyType,_},S) ->
{Any,S};
resolve(Seq={sequence,_},S) ->
{Seq,S};
resolve(Choice={choice,_},S) ->
{Choice,S};
resolve({simple_or_complex_Type,QN},S) ->
%% case load_object({simpleType,QN},S) of
case resolve({simpleType,QN},S) of
Res={#schema_simple_type{},_S1} ->
Res;
{[],_S} ->
case load_object({complexType,QN},S) of
{[],_} ->
?debug("could not load object ~p~n",
[{simple_or_complex_Type,QN}]),
{[],S};
T ->
T
end;
T ->
T
end;
resolve({complexType,{anyType,_,_}},S) ->
{{anyType,[]},S};
resolve({simpleType,{anyType,_,_}},S) ->
{{anyType,[]},S};
resolve(ST={simpleType,NameNS={_,_,_}},S) ->
case load_object(ST,S) of
{[],_S} -> case is_builtin_simple_type(NameNS) of
true ->
{ST,S};
_ ->
{[],S}
end;
Obj ->
%resolve(Obj,S)
Obj
end;
resolve({substitutionGroup,QName},S) ->
%% This shall resolve to the type of the element QName
case load_object({element,QName},S) of
Ret = {[],_S} -> Ret;
{#schema_element{type=[Type]},S2} ->
case Type of
{simple_or_complex_Type,_} ->
resolve(Type,S2);
_ ->
{Type,S2}
end;
{#schema_element{type=Type},S2} ->
{Type,S2}
end;
resolve({extension,{BaseType,CM}},S) ->
case is_builtin_simple_type(BaseType) of
true ->
{{simpleType,BaseType},S};
_ ->
case resolve({simple_or_complex_Type,BaseType},S) of
{ST = #schema_simple_type{},_} ->
{ST,S}; %% any attributes in CM are already
%% propagated to the outer complex type.
{CT = #schema_complex_type{content=C},_} ->
{NewC,S2} = extend_type(C,CM,S),
{CT#schema_complex_type{content=NewC},S2};
T -> T
end
end;
resolve({restriction,{BaseType,CM}},S) ->
case is_builtin_simple_type(BaseType) of
true ->
{{simpleType,BaseType},S};
_ ->
case resolve({simple_or_complex_Type,BaseType},S) of
{ST = #schema_simple_type{content=C},_} ->
{NewContent,S2} = restrict_simple_type(C,CM,BaseType,S),
{ST#schema_simple_type{content=NewContent},S2};
%% the outer complex type.
{CT = #schema_complex_type{content=C},_} ->
{NewContent,S2} = restrict_type(C,CM,BaseType,S),
{CT#schema_complex_type{content=NewContent},S2};
T -> T
end
end;
resolve(optional_text,S) ->
{optional_text,S};
resolve(E,S) ->
?debug("resolve(~p, S)~n",[E]),
load_object(E,S).
%% explicit_type checks whether the instance element is of an explicit
%% type pointed out by xsi:type. A type refernced by xsi:type must be
%% the same as, or derived from the instance element's type. Concluded
%% from 3.4.6 section "Schema Component Constraint: Type Derivation OK
%% (Complex)".
explicit_type(XSDType,InstanceEl=#xmlElement{namespace=NS,attributes=Atts},S) ->
case get_instance_type(NS,Atts) of
false ->
resolve(XSDType,S);
{ok,Name} ->
%% Create a {name,scope,namespace}, what is scope?
%% assume scope always is at top for the referenced type.
QName = mk_EII_QName(Name,InstanceEl,S#xsd_state{scope=[]}),
%% The type referenced by "xsi:type" attribute must be a
%% legal substitution for InstanceEl: "xsi:type" is the
%% same as or a derivation from InstanceEl's type.
{XsiType,S2} = resolve({simple_or_complex_Type,QName},S),
{_Blocks,S3} = legal_substitution(InstanceEl,XsiType,S2),
%% {ResXSDType,S4} = resolve(XSDType,S3),
{XsiType,S3}
%% merge_derived_types(ResXSDType,XsiType,Blocks,xsitype,S4)
end.
get_instance_type(#xmlNamespace{nodes=Nodes},Atts) ->
case keyNsearch(?XSD_INSTANCE_NAMESPACE,2,Nodes,[]) of
{Prefix,_} ->
TypeAtt = list_to_atom(Prefix++":type"),
case keyNsearch(TypeAtt,#xmlAttribute.name,Atts,[]) of
#xmlAttribute{value=Value} ->
{ok,Value};
_ -> false
end;
_ ->
false
end.
merge_derived_types(Type1,Type2,Mode,S) ->
merge_derived_types(Type1,Type2,[],Mode,S).
merge_derived_types(Type,Type,_Blocks,_Mode,S) ->
{Type,S};
merge_derived_types(XSDType,InstType,Blocks,Mode,S) ->
case catch merge_derived_types2(XSDType,InstType,Blocks,Mode,S) of
{'EXIT',Reason} ->
{InstType,acc_errs(S,{[],?MODULE,{internal_error,merge_derived_types,Reason}})};
{error,S2} ->
{InstType,S2};
{MergedType,S2} ->
save_merged_type(MergedType,S2),
{MergedType,S2}
end.
merge_derived_types2(XSDType=#schema_complex_type{},
InstType=#schema_complex_type{},Blocks,Mode,S) ->
%% InstType is the type of the instance element that may reference
%% a type that is an extension/restriction of the XSDType.
%% Alternatively XSDType is the base type and InstType the derived
%% type or XSDType is the original type that is redefined into
%% InstType.
%%
%% complexType can turn into:
%% simpleContent | complexContent
%% simpleContent -> restriction
%% complexContent -> restriction | extension
%% of course also one of:
%% ((group | all | choice | sequence)?,
%% ((attribute | attributeGroup)*,anyAttribute?))))
%% but then it shouldn't be any difference between XSDType
%% and InstType
case InstType#schema_complex_type.content of
[{extension,{BaseTypeName,CM}}] ->
{ExtendedAtts,S2} =
extend_attributes(XSDType#schema_complex_type.attributes,
InstType#schema_complex_type.attributes,
BaseTypeName,CM,Mode,
allowed_derivation(extension,Blocks,S)),
case compare_base_types(BaseTypeName,XSDType,S2) of
ok ->
{NewContent,S3} =
extend_type(XSDType#schema_complex_type.content,CM,S2),
{InstType#schema_complex_type{attributes=ExtendedAtts,
content=NewContent},S3};
Err ->
{error,acc_errs(S2,Err)}
end;
[{restriction,{BaseTypeName,CM}}] ->
{RestrictedAtts,S2} =
restrict_attributes(XSDType#schema_complex_type.attributes,
InstType#schema_complex_type.attributes,
allowed_derivation(restriction,Blocks,S)),
case compare_base_types(BaseTypeName,XSDType,S2) of
ok ->
{NewContent,S3}=
case InstType#schema_complex_type.complexity of
simple ->
restrict_simple_type(XSDType#schema_complex_type.content,CM,BaseTypeName,S2);
_ ->
restrict_type(XSDType#schema_complex_type.content,CM,BaseTypeName,S2)
end,
{InstType#schema_complex_type{attributes=RestrictedAtts,
content=NewContent},S3};
Err ->
{error,acc_errs(S,Err)}
end;
Other ->
{error,acc_errs(S,{[],?MODULE,{unexpected_type,Other}})}
end;
merge_derived_types2(XSDType=#schema_simple_type{},
InstType=#schema_simple_type{},Blocks,_Mode,S) ->
case InstType#schema_simple_type.content of
[{restriction,{BaseTypeName,CM}}] ->
case compare_base_types(BaseTypeName,XSDType,S) of
ok ->
{NewContent,S2}=
restrict_simple_type(XSDType#schema_simple_type.content,CM,
BaseTypeName,S),
{InstType#schema_simple_type{content=NewContent},
allowed_derivation(restriction,Blocks,S2)};
Err ->
{error,allowed_derivation(restriction,Blocks,
acc_errs(S,Err))}
end;
Other ->
{error,acc_errs(S,{unexpected_type,Other})}
end;
merge_derived_types2(XSDType=#schema_simple_type{content=XSDContent},
InstType=#schema_complex_type{},Blocks,_Mode,S) ->
%% This is the way to add attributes to a simpleType
case InstType#schema_complex_type.content of
[{extension,{BaseTypeName,CM}}] ->
case compare_base_types(BaseTypeName,XSDType,S) of
ok ->
{NewContent,S2} =
if CM==[] -> {XSDContent,S};
true -> extend_type(XSDContent,CM,S)
end,
{InstType#schema_complex_type{content=NewContent},
allowed_derivation(extension,Blocks,S2)};
Err ->
{error,allowed_derivation(extension,Blocks,
acc_errs(S,Err))}
end;
[{restriction,{BaseTypeName,_CM}}]
when InstType#schema_complex_type.complexity == simple ->
case compare_base_types(BaseTypeName,XSDType,S) of
ok ->
{InstType,
allowed_derivation(restriction,Blocks,S)};
Err ->
{error,allowed_derivation(extension,Blocks,
acc_errs(S,Err))}
end;
Other ->
{error,acc_errs(S,{[],?MODULE,{unexpected_type,Other}})}
end;
merge_derived_types2(_XSDType={simpleType,BuiltInType},
InstType=#schema_complex_type{content=Content},
Blocks,_Mode,S) ->
case Content of
[{extension,{BuiltInType,CM}}] ->
{NewContent,S2} = extend_type([],CM,S),
{InstType#schema_complex_type{base_type=BuiltInType,
content=NewContent},
allowed_derivation(extension,Blocks,S2)};
[{restriction,{BuiltInType,CM}}] ->
{NewContent,S2} = restrict_simple_type([],CM,BuiltInType,S),
{InstType#schema_complex_type{base_type=BuiltInType,
content=NewContent},
allowed_derivation(restriction,Blocks,S2)};
Other ->
{error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
end;
merge_derived_types2(_XSDType={anyType,_},InstType,Blocks,_Mode,S) ->
case type_content(InstType) of
[{restriction,{_BaseTypeName,CM}}] ->
{set_type_content(InstType,CM),
allowed_derivation(restriction,Blocks,S)};
Other ->
{error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
end;
merge_derived_types2({simpleType,BuiltInType},
InstType=#schema_simple_type{content=Content},
Blocks,_Mode,S) ->
case Content of
[{restriction,{BuiltInType,CM}}] ->
{InstType#schema_simple_type{base_type=BuiltInType,
content=CM},
allowed_derivation(restriction,Blocks,S)};
Other ->
{error,acc_errs(S,{[],?MODULE,{unexpected_content,Other,InstType}})}
end;
merge_derived_types2(XSDType,InstType,Blocks,Mode,S) ->
case {variety_type(XSDType,S),variety_type(InstType,S)} of
{XSDType,InstType} ->
{error,acc_errs(S,{[],?MODULE,{unexpected_type,XSDType,InstType}})};
{_XSDType2,InstType2} ->
case allowed_derivation(substitution,Blocks,S) of
S ->
merge_derived_types2(XSDType,InstType2,Blocks,Mode,S);
S2 ->
{error,S2}
end
end.
variety_type(#schema_simple_type{variety=list,content=[{list,[Type]}]},S) ->
{VarietyType,_}=resolve(Type,S),
VarietyType;
variety_type(#schema_simple_type{variety=union,content=[{union,Types}]},S) ->
[T||{T,_}<-[resolve(VarietyType,S)||VarietyType<-Types]];
variety_type(Type,_S) ->
Type.
allowed_derivation(_Derivation,_Blocks,S) ->
%% case {member(Derivation,Blocks),member('#all',Blocks)} of
%% {true,_} ->
%% acc_errs(S,{[],?MODULE,{derivation_blocked,Blocks,Derivation}});
%% {_,true} ->
%% acc_errs(S,{[],?MODULE,{derivation_blocked,'#all',Derivation}});
%% _ ->
%% S
%% end.
S.
%% El is the instance element that has the xsi:type attribute with
%% XsiType.
legal_substitution(El=#xmlElement{name=ElName},XsiType,S) ->
%% See 3.3.6, Substitution Group OK (Transitive)
%% For ok one of following: 1) same type in El as XsiType, 2)
%% XsiType is a restriction/extension where El's type is the
%% base, 3) XsiType is a member in the substitutionGroup of
%% ElName.
QName = mk_EII_QName(ElName,El,S),
{HeadElement,_} = load_object({element,QName},S),
legal_substitution2(HeadElement,XsiType,S).
legal_substitution2(#schema_element{type=Type,block=Bl},XsiType,S) ->
{HeadType,_}=resolve(Type,S),
Block = blocking(Bl,S#xsd_state.blockDefault),
S2 = derived_or_equal_types(XsiType,HeadType,instance,Block,S),
{Block,S2}.
compare_base_types(QName,#schema_complex_type{name=QName},_S) ->
ok;
compare_base_types(QName1,#schema_complex_type{name=QName2},_S) ->
{[],?MODULE,{names_not_equal,QName1,QName2}};
compare_base_types(QName,#schema_simple_type{name=QName},_S) ->
ok;
compare_base_types(QName1,#schema_simple_type{name=QName2},_S) ->
{[],?MODULE,{names_not_equal,QName1,QName2}}.
%%compare_base_types(QName1,Other,_S) ->
%% {[],?MODULE,{miss_match_base_types,QName1,Other}}.
extend_type(Base,Extension,S) ->
extend_type(Base,Extension,[],S).
%% Content may be (attribute | attributeGroup)*, anyAttribute? if
%% it is of simpleContent or:
%% (group | all | choice | sequence)?,((attribute | attributeGroup)*,
%% anyAttribute?) if it is of complexContent
extend_type([],[],Acc,S) ->
{reverse(Acc),S};
extend_type([BaseCM|BaseRest],Ext=[{SeqCho,{Extension,Occ}}|ExtRest],Acc,S)
when SeqCho == sequence; SeqCho == choice ->
case BaseCM of
{SeqCho,{BC,_Occ}} ->
extend_type(BaseRest,ExtRest,[{SeqCho,{BC++Extension,Occ}}|Acc],S);
G = {group,{_Ref,_Occ}} ->
{ResG,S2} = resolve(G,S),
case ResG of
#schema_group{content=GC} ->
case keysearch(SeqCho,1,GC) of
{value,SCC} ->
extend_type([SCC|BaseRest],Ext,Acc,S);
_ ->
S3 = acc_errs(S2,{[],?MODULE,{illegal_content_in_extension,Ext}}),
{reverse(Acc),S3}
end;
_ ->
S3 = acc_errs(S2,{[],?MODULE,{illegal_content_in_extension,ResG}}),
{reverse(Acc),S3}
end;
_ ->
%% BaseCM may be a group that has a sequence
extend_type([BaseCM|BaseRest],ExtRest,[{SeqCho,{Extension,Occ}}|Acc],S)
end;
extend_type(BaseCM,ExtCM,Acc,S) when is_list(BaseCM),is_list(ExtCM) ->
extend_type([],[],reverse(ExtCM)++reverse(BaseCM)++Acc,S).
restrict_type(Content,CM,BaseTypeName,S) ->
restrict_type(Content,CM,BaseTypeName,[],S).
%% Restriction may appear within a 1) simpleType, 2) simpleContent or
%% 3) complexContent construct.
%% The possible content of restriction in different contexts are:
%% 1) (simpleType?, (Any facet)*)
%% 2) (simpleType?, (Any facet)*),((attribute | attributeGroup)*, anyAttribute?)
%% 3) (group | all | choice | sequence)?,
%% ((attribute | attributeGroup)*, anyAttribute?)
%% A restriction of a simpleType narrows the possible values of the
%% base type by applying facets.
%% A restriction of a complexType (simpleContent / complexContent) must
%% enumerate all elements, including the preserved ones of the base type.
%% Attributes don't have to be enumerated.
restrict_type([],[],_TypeName,Acc,S) ->
{reverse(Acc),S};
restrict_type([{restriction,{_Type,CM1}}],[],_TypeName,Acc,S) ->
{CM1++reverse(Acc),S};
restrict_type([{extension,{_Type,CM1}}],[],_TypeName,Acc,S) ->
{CM1++reverse(Acc),S};
restrict_type(BaseRest,[ST={simpleType,_Name}|RestrRest],TypeName,Acc,S) ->
%% context 1 or 2
restrict_type(BaseRest,RestrRest,TypeName,[ST|Acc],S);
restrict_type([BaseCM|BaseRest],[{SeqCho,{CM,Occ}}|RestrRest],TypeName,Acc,S)
when SeqCho == sequence; SeqCho == choice ->
%% context 3
case BaseCM of
{SeqCho,{BCM,_}} ->
case check_element_presence(CM,BCM) of
{error,Reason} ->
{reverse(Acc),acc_errs(S,Reason)};
ok ->
restrict_type(BaseRest,RestrRest,TypeName,
[{SeqCho,{CM,Occ}}|Acc],S)
end;
Other ->
{reverse(Acc),acc_errs(S,{[],?MODULE,{SeqCho,expected,Other,found}})}
end;
restrict_type(BaseRest,[Facet={F,_Val}|RestrRest],TypeName,Acc,S) ->
case is_facet(F) of
true ->
restrict_type(BaseRest,RestrRest,TypeName,[Facet|Acc],S);
_ ->
{reverse(Acc),acc_errs(S,{[],?MODULE,{does_not_support,Facet,in_restriction}})}
end.
restrict_simple_type([{restriction,{_Type,BaseCM}}],RestrCM,_TypeName,S) ->
restrict_simple_type(BaseCM,RestrCM,_TypeName,S);
restrict_simple_type(CM=[{extension,{_Type,_BaseCM}}],_RestrCM,TypeName,S) ->
{[],acc_errs(S,{[],?MODULE,{illegal_content_simple_type,CM,TypeName}})};
restrict_simple_type(BaseCM,RestrCM,TypeName,S) ->
%% all restrictions in base comes first, then check that no one of
%% the facets in the restriction attempts to redefine a fixed
%% facet in the base. Add the facets of the restriction.
{Acc,S2} =
case BaseCM of
[] -> {[],S};
_ ->
restrict_simple_type([],BaseCM,TypeName,S)
end,
%% Acc = reverse(BaseCM),
Fun = fun(X={simpleType,_},{Acc_in,S_in})->
{[X|Acc_in],S_in};
(X={LU,_},{Acc_in,S_in}) when LU==list;LU==union ->
{[X|Acc_in],S_in};
(X={F,_},{Acc_in,S_in})->
%% Fun = fun(X={F,_},{Acc_in,S_in})->
case is_facet(F) of
true ->
{[X|Acc_in],S_in};
_ ->
{Acc_in,acc_errs(S_in,{[],?MODULE,{illegal_in_restriction_of_simpleType,X}})}
end;
(X,{Acc_in,S_in}) ->
{Acc_in,acc_errs(S_in,{[],?MODULE,{illegal_in_restriction_of_simpleType,X}})}
end,
foldl(Fun,{Acc,S2},RestrCM).
check_element_presence([],_BCM) ->
ok;
check_element_presence([{element,{Name,_}}|CM],BCM) ->
case check_element_presence2(Name,BCM) of
{ok,BCM2} ->
check_element_presence(CM,BCM2);
_ ->
{error,{[],?MODULE,{element,Name,not_present_in_restriction}}}
end;
check_element_presence([_C|CM],BCM) ->
check_element_presence(CM,BCM).
check_element_presence2(Name,BCM) ->
check_element_presence2(Name,BCM,[]).
check_element_presence2({LocalName,_,NS},[{element,{{LocalName,_,NS},_}}|BCM],Acc) ->
{ok,reverse(Acc)++BCM};
check_element_presence2(Name,[E|BCM],Acc) ->
check_element_presence2(Name,BCM,[E|Acc]);
check_element_presence2(_Name,[],_Acc) ->
error.
%% A check of the extended attribute should take place here.
%%
extend_attributes(BaseAtts,[EA={attribute,Name}|ExtAtts],
BaseTypeName,CM,Mode,S) ->
NewAtts=key_replace_or_insert(Name,2,BaseAtts,EA),
extend_attributes(NewAtts,ExtAtts,BaseTypeName,CM,Mode,S);
%% Extension of wildcards should be handled as described in chapter
%% 3.4.2 and subsection "Complex Type Definition with simple content
%% Schema Component".
extend_attributes(BaseAtts,[LocalWC={anyAttribute,_NS_PC}|ExtAtts],
BaseTypeName,CM,deduce,S) ->
{CompleteWC,S2} = complete_wildcard(LocalWC,CM,S),
BaseWC = base_wildcard(BaseAtts),
{NewWC,S4} =
case BaseWC of
[] -> {CompleteWC,S2};
_ ->
if CompleteWC==LocalWC -> {BaseWC,S2};
true ->
{NS,S3} = attribute_wildcard_union(wc_ns(CompleteWC),
wc_ns(BaseWC),S2),
PC = wc_pc(CompleteWC),
{[{anyAttribute,{NS,PC}}],S3}
end
end,
NewBaseAtts = keyreplace(anyAttribute,1,BaseAtts,NewWC),
extend_attributes(NewBaseAtts,ExtAtts,BaseTypeName,CM,deduce,S4);
extend_attributes(Atts,[],_,_,_Mode,S) ->
{reverse(Atts),S}.
%% A check of the restricted attribute should take place here.
restrict_attributes(BaseAtts,[RA|RAtts],S) ->
%% NewAtts = keyreplace(Name,2,BaseAtts,EA),
{NewAtts,S2} = restrict_attribute_replace(BaseAtts,RA,S),
restrict_attributes(NewAtts,RAtts,S2);
restrict_attributes(Atts,[],S) ->
{reverse(Atts),S}.
restrict_attribute_replace(BaseAtts,EA={attribute,Name},S) ->
{keyreplace(Name,2,BaseAtts,EA),S};
restrict_attribute_replace(BaseAtts,EA={anyAttribute,{NS,_}},S) ->
case key1search(anyAttribute,BaseAtts,false) of
false ->
{BaseAtts,acc_errs(S,{invalid_derivation,EA,BaseAtts})};
{_,{BaseNS,_}} ->
S2 = wildcard_subset(BaseNS,NS,S),
{keyreplace(anyAttribute,1,BaseAtts,EA),S2}
end.
%% 3.10.6 Constraints on Wildcard Schema Components
%% Schema Component Constraint: Wildcard Subset
%% bullet 1:
wildcard_subset(['##any'],_NS,S) ->
S;
%% bullet 2:
wildcard_subset([{'not',NS}],[{'not',NS}],S) ->
S;
%% bullet 3:
%% if NS has a number of namespaces all of them must be in BaseNS,
%% if BaseNS has {not,Namespaces} neither of Namespaces must be in NS
wildcard_subset(_,[],S) ->
S;
wildcard_subset(BaseNS,NS,S) when is_list(BaseNS),is_list(NS) ->
case [X||X<-NS,member(X,BaseNS)] of
NS ->
S;
_ ->
acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
not_subset_of_base_namespace,BaseNS}})
end;
wildcard_subset(BaseNS=[{'not',BNS}],NS,S) when is_list(NS) ->
case [X||X<-BNS,member(X,NS)] of
[] ->
S;
_ ->
acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
not_subset_of_base_namespace,BaseNS}})
end;
wildcard_subset(BaseNS,NS,S) ->
acc_errs(S,{[],?MODULE,{wildcard_namespace,NS,
not_subset_of_base_namespace,BaseNS}}).
base_wildcard(BaseAtts) ->
key1search(anyAttribute,BaseAtts,[]).
complete_wildcard(LocalWC,CM,S) ->
case keysearch(attributeGroup,1,CM) of
{value,AttG={_,_Name}} ->
case resolve(AttG,S) of
{#schema_attribute_group{content=Atts},_S} ->
case keysearch(anyAttribute,1,Atts) of
{value,AA} ->
{PC,S2} =
attribute_wildcard_intersection(wc_ns(LocalWC),
wc_ns(AA),S),
{{anyAttribute,{wc_pc(LocalWC),PC}},S2};
_ -> {LocalWC,S}
end;
_ -> {LocalWC,S}
end;
_ -> {LocalWC,S}
end.
wc_ns({anyAttribute,{NS,_}})->
NS;
wc_ns(_) ->
[].
wc_pc({anyAttribute,{_,PC}})->
PC;
wc_pc(_) ->
strict.
%% Union of wildcard namespace:
%% 3.10.6 Constraints on Wildcard Schema Components
%% Schema Component Constraint: Attribute Wildcard Union
%% bullet 1
attribute_wildcard_union(NS,NS,S) ->
{NS,S};
%% bullet 2
attribute_wildcard_union(NS1,NS2,S) when NS1==['##any'];NS2==['##any'] ->
{['##any'],S};
attribute_wildcard_union(NS1,NS2,S) ->
case {keysearch('not',1,NS1),keysearch('not',1,NS2)} of
{false,false} -> %% bullet 3
{NS1 ++ [X||X<-NS2,member(X,NS1)==false],S};
{{value,{_,Set1}},{value,{_,Set2}}} -> %% bullet 4 or 1
case {lists:sort(Set1),lists:sort(Set2)} of
{L,L} -> {[{'not',L}],S};
_ -> {[{'not',[absent]}],S}
end;
_ -> %% either is a {not,NS}
case toggle_ns(NS1,NS2) of
{_O1=[absent],NS3} -> %% bullet 6
case member(absent,NS3)of
true -> {['##any'],S};
_ -> {[{'not',[absent]}],S}
end;
{O1=[O1Name],NS4} -> %% bullet 5
case member(O1Name,NS4) of
true ->
case member(absent,NS4) of
true -> {['##any'],S}; %% 5.1
_ -> {[{'not',[absent]}],S} %% 5.2
end;
_ ->
case member(absent,NS4) of
true ->
%% not expressible 5.3
Err = {[],?MODULE,{wildcard_namespace_union_not_expressible,NS1,NS2}},
{[],acc_errs(S,Err)};
_ -> {[{'not',O1}],S} %% 5.4
end
end
end
end.
%% Schema Component Constraint: Attribute Wildcard Intersection
%% bullet 1
attribute_wildcard_intersection(O1,O1,S) -> {O1,S};
%% bullet 2
attribute_wildcard_intersection(['##any'],O2,S) -> {O2,S};
attribute_wildcard_intersection(O1,['##any'],S) -> {O1,S};
%% bullet 6
attribute_wildcard_intersection([{'not',[absent]}],O2=[{'not',_}],S) -> {O2,S};
attribute_wildcard_intersection(O1=[{'not',_}],[{'not',[absent]}],S) -> {O1,S};
%% bullet 5
attribute_wildcard_intersection([{'not',NS1}],[{'not',NS2}],S) ->
case [X||X<-NS1,member(X,NS2)] of
[] -> {[],acc_errs(S,{[],?MODULE,{wildcard_namespace_intersection_not_expressible,NS1,NS2}})};
NS3 -> {[{'not',NS3}],S}
end;
%% bullet 3
attribute_wildcard_intersection([{'not',NS}],O2,S) ->
{lists:delete(absent,[X||X<-O2,member(X,NS)==false]),S};
attribute_wildcard_intersection(O1,[{'not',NS}],S) ->
{lists:delete(absent,[X||X<-O1,member(X,NS)==false]),S};
%% bullet 4
attribute_wildcard_intersection(O1,O2,S) ->
case [X||X<-O1,member(X,O2)] of
[] ->
{[absent],S};
L ->{L,S}
end.
toggle_ns(NS1,NS2=[{'not',_}]) ->
{NS2,NS1};
toggle_ns(NS1,NS2) ->
{NS1,NS2}.
deduce_derived_types([DT|DTs],S) ->
deduce_derived_types(DTs,deduce_derived_type(DT,S,[]));
deduce_derived_types([],S) ->
S.
%% deduce_derived_type
deduce_derived_type(DT={_Kind,TName},S,RefChain) ->
%% check circular references
case keymember(TName,2,RefChain) of
true ->
acc_errs(S,{[],?MODULE,{circular_reference_of_type,TName}});
_ ->
deduce_derived_type2(DT,S,[DT|RefChain])
end.
deduce_derived_type2(DT,S,RefChain) ->
{DerivedType,_} = resolve(DT,S),
case is_unmerged_type(DerivedType) of
true ->
BaseTypeRef = get_base_type(DerivedType),
{BaseType,_} = resolve({simple_or_complex_Type,BaseTypeRef},S),
BaseTypeKind =
fun(#schema_complex_type{}) -> complexType;
(_) -> simpleType
end (BaseType),
case is_unmerged_type(BaseType) of
true ->
%% both derived and not deduced
S2 = deduce_derived_type({BaseTypeKind,BaseTypeRef},S,RefChain),
case S2#xsd_state.errors==S#xsd_state.errors of
true -> deduce_derived_type2(DT,S2,RefChain);
_ -> S2
end;
_ ->
{_,S2} = merge_derived_types(BaseType,DerivedType,deduce,S),
S2
end;
_ ->
S
end.
is_unmerged_type(Type) ->
case type_content(Type) of
[{restriction,_}] -> true;
[{extension,_}] -> true;
_ -> false
end.
type_content(#schema_simple_type{content=C}) ->
C;
type_content(#schema_complex_type{content=C}) ->
C;
type_content(_) ->
[].
set_type_content(Type=#schema_simple_type{},CM) ->
Type#schema_simple_type{content=CM};
set_type_content(Type=#schema_complex_type{},CM) ->
Type#schema_complex_type{content=CM}.
get_base_type(#schema_simple_type{base_type=BT}) ->
BT;
get_base_type(#schema_complex_type{base_type=BT}) ->
BT.
in_scope({Local,_Scope,_NS},S) ->
in_scope(Local,S);
in_scope(Name,S=#xsd_state{scope=Scope}) when is_atom(Name) ->
S#xsd_state{scope=[Name|Scope]};
in_scope(Name,S=#xsd_state{scope=Scope}) when is_list(Name) ->
S#xsd_state{scope=[atom_if_shortasciilist(Name)|Scope]}.
out_scope({Local,_,_},S) ->
out_scope(atom_if_shortasciilist(Local),S);
out_scope(Name,S=#xsd_state{scope=[Name|Rest]}) ->
S#xsd_state{scope=Rest};
out_scope(_Name,S) ->
S.
name_scope({'_xmerl_no_name_',Scope,_NS},S) ->
S#xsd_state{scope=Scope};
name_scope({Name,Scope,_NS},S) ->
S#xsd_state{scope=[Name|Scope]}.
reset_scope(S) ->
S#xsd_state{scope=[]}.
set_scope(Scope,S) when is_list(Scope) ->
S#xsd_state{scope=Scope};
set_scope(_,S) ->
S.
is_global_env([_Env]) ->
true;
is_global_env(_) ->
false.
kind(#xmlElement{name=Name},S) ->
LocalName=local_name(Name),
is_a(LocalName,S).
kind(#xmlElement{name=Name}) ->
LocalName=local_name(Name),
element(1,is_a(LocalName,dummy)).
is_a(element,S) -> {element,S};
is_a(annotation,S) -> {annotation,S};
is_a(simpleType,S) -> {simpleType,S};
is_a(complexType,S) -> {complexType,S};
is_a(simpleContent,S) -> {simpleContent,S};
is_a(complexContent,S) -> {complexContent,S};
is_a(include,S) -> {include,S};
is_a(import,S) -> {import,S};
is_a(redefine,S) -> {redefine,S};
is_a(unique,S) -> {unique,S};
is_a(key,S) -> {key,S};
is_a(keyref,S) -> {keyref,S};
is_a(attribute,S) -> {attribute,S};
is_a(attributeGroup,S) -> {attributeGroup,S};
is_a(group,S) -> {group,S};
is_a(all,S) -> {all,S};
is_a(sequence,S) -> {sequence,S};
is_a(choice,S) -> {choice,S};
is_a(any,S) -> {any,S};
is_a(anyAttribute,S) -> {anyAttribute,S};
is_a(selector,S) -> {selector,S};
is_a(field,S) -> {field,S};
is_a(notation,S) -> {notation,S};
is_a(appinfo,S) -> {appinfo,S};
is_a(documentation,S) -> {documentation,S};
is_a(restriction,S) -> {restriction,S};
is_a(extension,S) -> {extension,S};
is_a(list,S) -> {list,S};
is_a(union,S) -> {union,S};
is_a(schema,S) -> {schema,S};
is_a(minExclusive,S) -> {minExclusive,S};
is_a(minInclusive,S) -> {minInclusive,S};
is_a(maxExclusive,S) -> {maxExclusive,S};
is_a(maxInclusive,S) -> {maxInclusive,S};
is_a(totalDigits,S) -> {totalDigits,S};
is_a(fractionDigits,S) -> {fractionDigits,S};
is_a(length,S) -> {length,S};
is_a(minLength,S) -> {minLength,S};
is_a(maxLength,S) -> {maxLength,S};
is_a(enumeration,S) -> {enumeration,S};
is_a(whiteSpace,S) -> {whiteSpace,S};
is_a(pattern,S) -> {pattern,S};
is_a(Name,S) when is_record(S,xsd_state) ->
{Name,acc_errs(S,{[],?MODULE,{unknown_content,Name}})};
is_a(Name,_) ->
exit({error,{internal_error,not_implemented,Name}}).
%% namespace/2 -> [token()]
%% token() -> {not,namespace_name()} | namespace_name()
%% ((##any | ##other) | List of (anyURI | (##targetNamespace | ##local)) ) : ##any
%% The result will be:
%% NSList ::= ['##any'] | [{'not',[TNS]}] | NSURIs
%% TNS ::= URI | absent
%% NSURIs ::= (URI | absent) +
%% URI ::= atomified URI-string
wildcard_namespace(E,S) ->
AttVal = get_attribute_value(namespace,E,"##any"),
ListOfVals = namestring2namelist(AttVal),
Pred = fun('##other') ->
case S#xsd_state.targetNamespace of
undefined -> {'not',[absent]};
TN -> {'not',TN}
end;
('##targetNamespace') ->
case S#xsd_state.targetNamespace of
undefined -> absent;
TN -> TN
end;
('##local') -> absent;%%'##local'; %% any well-formed xml that
%% is not qualified.
(X) -> X
end,
[X||X <- map(Pred,ListOfVals),X=/=[]].
processor_contents(Any) ->
case get_attribute_value(processContents,Any,strict) of
V when is_list(V) -> list_to_atom(V);
A -> A
end.
base_type(E) ->
get_attribute_value(base,E,[]).
base_type_type(Env) ->
case member(simpleType,Env) of
true -> simpleType;
_ -> simple_or_complex_Type
end.
attribute_ref(A) ->
get_attribute_value(ref,A,[]).
particle_ref(El) ->
get_attribute_value(ref,El,[]).
attributeGroup_ref(El) ->
get_attribute_value(ref,El,[]).
get_value(El) ->
get_attribute_value(value,El,undefined).
get_attribute_value(Key,#xmlElement{attributes=Atts},Default) ->
case keyNsearch(Key,#xmlAttribute.name,Atts,Default) of
#xmlAttribute{value=V} ->
V;
_ -> Default
end.
%% qualify_NCName/2 returns a qualified name, QName, that has
%% information of the name attribute and namespace of the XSD object.
%% The object E has a name attribute with a NCName. The Namespace
%% part of the QName is from the targetNamespace attribute of the
%% schema or the empty list.
qualify_NCName(E=#xmlElement{},S) ->
case get_local_name(E) of
[] -> no_name;
LocalName ->
Namespace =
case S#xsd_state.targetNamespace of
undefined ->
[]; %%?XSD_NAMESPACE;
TNS ->
TNS
end,
{atom_if_shortasciilist(LocalName),S#xsd_state.scope,Namespace}
end.
get_local_name(#xmlElement{attributes=Atts}) ->
case keyNsearch(name,#xmlAttribute.name,Atts,[]) of
#xmlAttribute{value=V} ->
V;
Default -> Default
end.
local_name(Name) when is_atom(Name) ->
local_name(atom_to_list(Name));
local_name(Name) when is_list(Name) ->
case splitwith(fun($:) -> false;(_)->true end,Name) of
{_,":"++LocalName} -> list_to_atom(LocalName);
_ ->
list_to_atom(Name)
end.
%% transforms "a B c" to [a,'B',c]
namestring2namelist(Str) ->
split_by_whitespace(Str,[]).
split_by_whitespace(Str,Acc) when is_list(Str),length(Str) > 0 ->
F = fun($ ) ->
false;
(_) ->
true
end,
{Str1,Rest} = splitwith(F,Str),
split_by_whitespace(string:strip(Rest),[list_to_atom(Str1)|Acc]);
split_by_whitespace(_,Acc) ->
reverse(Acc).
%% get_QName(Name,S) where Name is a QName in string format, or where
%% a QName is expected according to schema specification. If the name
%% is unqualified it is qualified with the targetNamespace of the schema
%% or with the empty list.
get_QName(Name,NS,S) when is_atom(Name) ->
get_QName(atom_to_list(Name),NS,S);
get_QName(Name,NS,#xsd_state{scope=Scope}) ->
qualified_name(Name,NS,NS#xmlNamespace.default,Scope).
qualified_name(Name,NS,Default,Scope) ->
case splitwith(fun($:) -> false;(_)->true end,Name) of
{GlobalName,":"++LocalName} -> {atom_if_shortasciilist(LocalName),Scope,
namespace(GlobalName,NS,Default)};
_ ->
{atom_if_shortasciilist(Name),Scope,Default}
end.
atom_if_shortasciilist(N) when is_list(N) ->
case catch list_to_atom(N) of
{'EXIT',_Reason} ->
%% Reason may be system_limit if N is very long, it may be
%% badarg ifN is a list of UTF characters.
N;
AN -> AN
end;
atom_if_shortasciilist(N) ->
N.
namespace("xml",_,_) -> 'http://www.w3.org/XML/1998/namespace';
namespace(Prefix,NS,Default) ->
case key1search(Prefix,NS#xmlNamespace.nodes,Default) of
{Prefix,Namespace} ->
Namespace;
Namespace -> Namespace
end.
%% mk_EII_QName/2
%% makes a name with qualified info out of an Element Information Item
%% A) If name is qualified get namespace matching prefix.
%% B) If not qualified search parents for a namespace:
%% 1) use default namespace if defined, else.
%% 2) if a parent is qualified use that namespace or
%% 3) no namespace is applied
mk_EII_QName(Name,#xmlElement{name=Me,namespace=NS,parents=P},S)
when is_list(Name) ->
mk_EII_QName(list_to_atom(Name),
#xmlElement{name=Me,namespace=NS,parents=P},S);
mk_EII_QName(Name,#xmlElement{name=Me,namespace=NS,parents=P},S) ->
Scope = S#xsd_state.scope,
NameStr = atom_to_list(Name),
case string:tokens(NameStr,":") of
["xmlns",PrefixDef] -> %% special case
{'xmlns',Scope,namespace(PrefixDef,NS,[])};
[Prefix,LocalName] -> %% A
{list_to_atom(LocalName),Scope,namespace(Prefix,NS,[])};
[_LocalName] -> %% B
{Name,Scope,mk_EII_namespace([{Me,0}|P],NS,S)}
end.
mk_EII_namespace([],#xmlNamespace{default=DefaultNS},_S) ->
DefaultNS;
%%mk_EII_namespace([{PName,_}|GrandPs],NS=#xmlNamespace{default=[]},S) ->
mk_EII_namespace([{PName,_}|GrandPs],NS,S) ->
NameStr = atom_to_list(PName),
case string:tokens(NameStr,":") of
[Prefix,_LocalName] ->
namespace(Prefix,NS,[]);
[_LocalName] ->
mk_EII_namespace(GrandPs,NS,S)
end;
mk_EII_namespace(_,NS,_S) ->
NS#xmlNamespace.default.
mk_EII_Att_QName(AttName,XMLEl,S) when is_list(AttName) ->
mk_EII_Att_QName(list_to_atom(AttName),XMLEl,S);
mk_EII_Att_QName(AttName,XMLEl,S) ->
NameStr = atom_to_list(AttName),
{member($:,NameStr),mk_EII_QName(AttName,XMLEl,S)}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% table access functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
create_tables(S=#xsd_state{table=undefined}) ->
Tid=ets:new(xmerl_schema_tab,[]),
S#xsd_state{table=Tid};
create_tables(S) ->
S.
delete_table(#xsd_state{table=Tab}) ->
catch ets:delete(Tab).
%% @hidden
print_table(#xsd_state{table=Tab}) ->
case catch ets:tab2list(Tab) of
Res when is_list(Res) ->
Res;
{'EXIT',Reason} ->
{error,{?MODULE,[],Reason}}
end;
print_table(_) ->
ok.
%save_object({name,_},S) ->
% %% already saved.
% S;
%% only simpleType asn complexType are temporary saved with
%% three-tuple key. They are loaded and merged in redefine/2.
save_object({Kind,Obj},S=#xsd_state{redefine=true})
when Kind == simpleType; Kind == complexType ->
save_in_table({Kind,redefine,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S=#xsd_state{redefine=true})
when Kind == group; Kind == attributeGroup ->
save_in_table({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S) when Kind == simpleType; Kind == complexType ->
save_unique_type({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S)
when Kind == attributeGroup; Kind == group ->
save_uniquely({Kind,object_name(Obj)},Obj,S);
save_object({Kind,Obj},S) ->
save_in_table({Kind,object_name(Obj)},Obj,S).
save_unique_type(Key={_,Name},Obj,S) ->
case resolve({simple_or_complex_Type,Name},S) of
{#schema_simple_type{},_} ->
acc_errs(S,{[],?MODULE,{type_not_uniquely_defined_in_schema,Name}});
{#schema_complex_type{},_} ->
acc_errs(S,{[],?MODULE,{type_not_uniquely_defined_in_schema,Name}});
_ ->
save_in_table(Key,Obj,S)
end.
save_uniquely(Key,Obj,S) ->
case load_object(Key,S) of
{[],_} ->
save_in_table(Key,Obj,S);
_ ->
acc_errs(S,{[],?MODULE,{not_uniquely_defined_in_schema,Key}})
end.
save_schema_element(CM,S=#xsd_state{elementFormDefault = EFD,
attributeFormDefault = AFD,
targetNamespace = TN,
finalDefault = FD,
blockDefault = BD}) ->
ElementList = [X||X = {element,_} <- CM],
%% OtherGlobalEls = other_global_elements(S,ElementList),
Schema = get_schema_cm(S#xsd_state.table,TN),
Schema2 =
case Schema == #schema{} of
true ->
Schema#schema{elementFormDefault = EFD,
attributeFormDefault = AFD,
targetNamespace = TN,
blockDefault = BD,
finalDefault = FD,
content = ElementList};
_ ->
Content = Schema#schema.content,
Schema#schema{content=[X||X<-Content,member(X,ElementList)==false]++ElementList}
end,
TN2 = case TN of
undefined -> [];
_ -> TN
end,
save_in_table({schema,TN2},Schema2,S),
save_to_file(S).
%% other_global_elements(S,ElementList) ->
%% Schema = get_schema_cm(S#xsd_state.table,S#xsd_state.targetNamespace),
%% [X||X<-Schema#schema.content,
%% member(X,ElementList) == false].
%% other_global_elements(#xsd_state{schema_name=SchemaName,
%% table = Tab,
%% global_element_source=GES},ElementList) ->
%% case [X||{Y,X}<-GES,Y==SchemaName] of
%% [] ->
%% [];
%% L -> %% All other schemas included in redefine
%% NameList = [X||{element,{X,_}}<-ElementList],
%% Contents =
%% flatten([X||#schema{content=X}<-[get_schema_cm(Tab,Y)||Y<-L]]),
%% SortFun =
%% fun({_,{A,_}},{_,{B,_}}) when A =< B ->
%% true;
%% (_,_) -> false end,
%% [X||X={element,{Y,_}}<-lists:sort(SortFun,Contents),member(Y,NameList)==false]
%% end.
save_to_file(S=#xsd_state{tab2file=true},FileName) ->
save_to_file(S#xsd_state{tab2file=FileName});
save_to_file(_,_) ->
ok.
save_to_file(S=#xsd_state{tab2file=TF}) ->
case TF of
true ->
{ok,IO}=file:open(filename:rootname(S#xsd_state.schema_name)++".tab",
[write]),
io:format(IO,"~p~n",[catch ets:tab2list(S#xsd_state.table)]),
file:close(IO);
false ->
ok;
IOFile ->
{ok,IO}=file:open(IOFile,[write]),
io:format(IO,"~p~n",[catch ets:tab2list(S#xsd_state.table)]),
file:close(IO)
end.
save_merged_type(Type=#schema_simple_type{},S) ->
resave_object({simpleType,Type},S);
save_merged_type(Type=#schema_complex_type{},S) ->
resave_object({complexType,Type},S).
resave_object({Kind,Obj},S) ->
save_in_table({Kind,object_name(Obj)},Obj,S).
save_in_table(Name,ElDef,S=#xsd_state{table=Tab}) ->
catch ets:insert(Tab,{Name,ElDef}),
S.
save_idc(key,IDConstr,S) ->
save_key(IDConstr,S);
save_idc(keyref,IDConstr,S) ->
save_keyref(IDConstr,S);
save_idc(unique,IDConstr,S) ->
save_unique(IDConstr,S).
save_key(Key,S) ->
save_object({key,Key},S),
S.
save_keyref(KeyRef=#id_constraint{category=keyref},S) ->
S1 = add_keyref(KeyRef,S),
save_object({keyref,KeyRef},S1),
S1;
save_keyref(_,S) ->
S.
save_unique(Unique,S) ->
save_object({unique,Unique},S),
S.
save_substitutionGroup([],S) ->
S;
save_substitutionGroup([{Head,Members}|SGs],S) ->
%% save {head,[members]}
save_in_table({substitutionGroup,Head},Members,S),
%% save {member,head}, an element can only be a member in one
%% substitutionGroup
lists:foreach(fun(X)->save_in_table({substitutionGroup_member,X},Head,S) end,Members),
save_substitutionGroup(SGs,S).
substitutionGroup_member(ElName,S) ->
case load_object({substitutionGroup_member,ElName},S) of
{[],_} ->
false;
{Res,_} ->
Res
end.
%% substitutionGroup_head(Head,S) ->
%% case load_object({substitutionGroup,Head},S) of
%% {[],_} ->
%% false;
%% {Res,_} ->
%% Res
%% end.
add_keyref(#id_constraint{name=Name,refer=Refer},
S=#xsd_state{keyrefs=KeyRefs}) ->
S#xsd_state{keyrefs=add_once({keyref,Name,Refer},KeyRefs)}.
load_redefine_object({Kind,Name},S) ->
load_object({Kind,redefine,Name},S).
load_object({element,{QN,Occ={Min,_}}},S) when is_integer(Min) ->
case load_object({element,QN},S) of
{SE=#schema_element{},S1} -> {SE#schema_element{occurance=Occ},S1};
Other -> Other
end;
load_object({group,{QN,_Occ={Min,_}}},S) when is_integer(Min) ->
load_object({group,QN},S);
load_object(Key,S=#xsd_state{table=Tab}) ->
case ets:lookup(Tab,Key) of
[{Key,Value}] ->
{Value,S};
[] ->
case ets:lookup(Tab,global_def(Key)) of
[{_,Value}] -> {Value,global_scope(S)};
Other -> {Other,S}
end;
Other ->
{Other,S}
end.
load_keyref(Name,S) ->
case load_object({keyref,Name},S) of
{KeyRef=#id_constraint{},_} -> KeyRef;
_ ->
[]
end.
load_key(Name,S) ->
case load_object({key,Name},S) of
{Key=#id_constraint{},_} -> Key;
_ ->
case load_object({unique,Name},S) of
{Key=#id_constraint{},_} -> Key;
_ ->
[]
end
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% END table access functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
save_ID(ID,S) ->
case member(ID,S#xsd_state.'IDs') of
true ->
acc_errs(S,{'ID_name_not_unique',ID});
_ ->
S#xsd_state{'IDs'=[ID|S#xsd_state.'IDs']}
end.
check_and_save_ID(ID,S) ->
case xmerl_xsd_type:check_simpleType('ID',ID,S) of
{ok,ID} ->
save_ID(ID,S);
_ ->
acc_errs(S,{illegal_ID_value,ID})
end.
insert_substitutionGroup(#schema_element{substitutionGroup=undefined},S) ->
S;
insert_substitutionGroup(#schema_element{name=Name,
substitutionGroup=SG},
S=#xsd_state{substitutionGroups=SGregister}) ->
case key1search(SG,SGregister,[]) of
{_,SGList} ->
S#xsd_state{substitutionGroups=
keyreplace(SG,1,SGregister,{SG,[Name|SGList]})};
_ ->
S#xsd_state{substitutionGroups=[{SG,[Name]}|SGregister]}
end.
global_scope(S=#xsd_state{}) ->
S#xsd_state{scope=[]}.
global_def({Kind,{Local,_,NS}})
when Kind==simpleType; Kind==complexType; Kind==group;
Kind==attributeGroup; Kind==element; Kind==attribute;
Kind==substitutionGroup;Kind==substitutionGroup_member->
{Kind,{Local,[],NS}};
global_def(D) -> D.
get_schema_cm(Tab,undefined) ->
get_schema_cm(Tab,[]);
get_schema_cm(Tab,[]) ->
get_schema_cm1(Tab,[]);
get_schema_cm(Tab,Namespace) ->
NoNamespaceC=get_no_namespace_content(Tab),
Schema = get_schema_cm1(Tab,Namespace),
NSC = Schema#schema.content,
Schema#schema{content=NSC++[X||X<-NoNamespaceC,member(X,NSC)==false]}.
get_schema_cm1(Tab,Namespace) ->
case catch ets:lookup(Tab,{schema,Namespace}) of
[{_,H}] ->
H;
_ ->
#schema{}
end.
get_no_namespace_content(Tab) ->
case get_schema_cm1(Tab,[]) of
#schema{content=C} ->
C;
_ -> []
end.
%% is_simple_type(Type,S) when is_atom(Type) ->
%% is_simple_type(atom_to_list(Type),S);
is_simple_type({LName,Scope,NS},S) when is_atom(LName) ->
is_simple_type({atom_to_list(LName),Scope,NS},S);
is_simple_type(QName={_,_,_},S) ->
case is_builtin_simple_type(QName) of
true ->
true;
_ ->
is_derived_simple_type(QName,S)
end.
is_derived_simple_type(QName,S) ->
%% case resolve({simple_or_complex_Type,QName},S) of
case resolve({simpleType,QName},S) of
{#schema_simple_type{},_} -> true;
_ -> false
end.
object_name(#schema_element{name=N}) ->
N;
object_name(#schema_simple_type{name=N}) ->
N;
object_name(#schema_complex_type{name=N}) ->
N;
object_name(#schema_attribute{name=N}) ->
N;
object_name(#schema_attribute_group{name=N}) ->
N;
object_name(#schema_group{name=N}) ->
N;
object_name(#id_constraint{name=N}) ->
N.
is_whitespace(#xmlText{value=V}) ->
case [X|| X <- V, whitespace(X) == false] of
[] ->
true;
_ -> false
end;
is_whitespace(_) ->
false.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fetch
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
fetch(URI,S) ->
Split = filename:split(URI),
Filename = fun([])->[];(X)->lists:last(X) end (Split),
Fullname =
case Split of %% how about Windows systems?
["file:"|Name]-> %% absolute path, see RFC2396 sect 3
%% file:/dtd_name
filename:join(["/"|Name]);
["/"|Rest] when Rest /= [] ->
%% absolute path name
URI;
["http:"|_Rest] ->
{http,URI};
[] -> %% empty systemliteral
[];
_ ->
case S#xsd_state.external_xsd_base of
true ->
filename:join(S#xsd_state.xsd_base, URI);
false ->
filename:join(S#xsd_state.xsd_base, filename:basename(URI))
end
end,
Path = path_locate(S#xsd_state.fetch_path, Filename, Fullname),
?dbg("fetch(~p) -> {file, ~p}.~n", [URI, Path]),
{ok, Path, S}.
path_locate(_, _, {http,_}=URI) ->
URI;
path_locate(_, _, []) ->
[];
path_locate([Dir|Dirs], FN, FullName) ->
F = filename:join(Dir, FN),
case file:read_file_info(F) of
{ok, #file_info{type = regular}} ->
{file,F};
_ ->
path_locate(Dirs, FN, FullName)
end;
path_locate([], _FN, FullName) ->
{file,FullName}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% return
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
return_error(Errs) ->
{error,reverse(Errs)}.
return_schema_error(Errs) ->
{error,{schema_failure,reverse(Errs)}}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% general helper functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if_atom_to_list(A) when is_atom(A) ->
atom_to_list(A);
if_atom_to_list(L) ->
L.
if_list_to_atom(L) when is_list(L) ->
list_to_atom(L);
if_list_to_atom(A) ->
A.
list_members(Members,CompleteList) ->
case [X||X<-Members,member(X,CompleteList)==false] of
[] ->
true;
L ->
{error,L}
end.
whitespace(X) when ?whitespace(X) ->
true;
whitespace(_) ->
false.
key1search(Key,List,Default) ->
case keysearch(Key,1,List) of
{value,V} -> V;
_ -> Default
end.
keyNsearch(Key,N,L,Default) ->
case keysearch(Key,N,L) of
{value,V} -> V;
_ -> Default
end.
key_replace_or_insert(Key,N,List,Tuple) ->
case keyreplace(Key,N,List,Tuple) of
List ->
[Tuple|List];
NewList ->
NewList
end.
keysearch_delete(Key,N,List,Default) ->
case keysearch(Key,N,List) of
{value,Res} ->
{Res,keydelete(Key,N,List)};
_ ->
{Default,List}
end.
search_delete_all_el(ElName,ElList,S) ->
case search_delete_all_el2(ElName,ElList,[]) of
false ->
case substitutionGroup_member(ElName,S) of
false ->
false;
Head ->
case search_delete_all_el(Head,ElList,S) of
{_,Rest} ->
{Name,_,NS} = ElName,
{{element,{Name,[],NS}},Rest};
_ ->
false
end
end;
Res ->
Res
end.
search_delete_all_el2(_ElName,[],_NoMatch) ->
false;
%% name must match defined (local scope) and referenced (global scope)
%% elements.
search_delete_all_el2({Name,Scope,NS},
[El={element,{{Name,ScopeCM,NS},_}}|Rest],
NoMatch)
when Scope == ScopeCM; ScopeCM == [] ->
{El,reverse(NoMatch)++Rest};
search_delete_all_el2(ElName,[H|T],NoMatch) ->
search_delete_all_el2(ElName,T,[H|NoMatch]).
%% Search attribute should not consider the scope. All attributes
%% allowed in this scope are in SchemaAttList.
search_attribute(true,{Name,_,Namespace},SchemaAtts) ->
case [A||A={_,{N,_,NS}}<-SchemaAtts,N==Name,NS==Namespace] of
[] ->
{undefined,SchemaAtts};
[Attr] ->
{Attr,lists:delete(Attr,SchemaAtts)}
end;
search_attribute(_,{Name,_,_},SchemaAtts) ->
case [A||A={_,{N,_,_}}<-SchemaAtts,N==Name] of
[] ->
{undefined,SchemaAtts};
[Attr] ->
{Attr,lists:delete(Attr,SchemaAtts)}
end.
error_msg(Format,Args) ->
error_logger:error_msg(Format,Args).
add_once(El,L) ->
case member(El,L) of
true ->
L;
_ ->
[El|L]
end.
add_key_once(Key,N,El,L) ->
case keymember(Key,N,L) of
true ->
L;
_ ->
[El|L]
end.
%% shema_el_pathname({Type,_},Env) ->
%% mk_path(reverse([Type|Env])).
%% xml_el_pathname(#xmlElement{name=Name,parents=Parents,pos=Pos}) ->
%% {element,mk_xml_path(Parents,Name,Pos)};
%% xml_el_pathname(#xmlAttribute{name=Name,parents=Parents,pos=Pos}) ->
%% {attribute,mk_xml_path(Parents,Name,Pos)};
%% xml_el_pathname(#xmlText{parents=Parents,pos=Pos}) ->
%% {text,mk_xml_path(Parents,text,Pos)}.
%% mk_path([]) ->
%% [];
%% mk_path(L) when is_list(L) ->
%% "/"++filename:join(L).
%% mk_xml_path(Parents,Type,Pos) ->
%% %% ?dbg("mk_xml_path: Parents = ~p~n",[Parents]),
%% {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}.
%% @spec format_error(Errors) -> Result
%% Errors = error_tuple() | [error_tuple()]
%% Result = string() | [string()]
%% @doc Formats error descriptions to human readable strings.
format_error(L) when is_list(L) ->
[format_error(X)||X<-L];
format_error({unexpected_rest,UR}) ->
io_lib:format("XML: The following content of an element didn't validate by the provided schema, ~n~p.",[UR]);
format_error({unvalidated_rest,UR}) ->
io_lib:format("XML: The following content of an element didn't validate by the provided schema, ~n~p.",[UR]);
format_error({no_schemas_provided}) ->
"Schema: Validator found no schema. A schema must be provided for validation.";
format_error({internal_error,Reason}) ->
io_lib:format("An error occured that was unforeseen, due to ~p.",[Reason]);
format_error({internal_error,Reason,Info}) ->
io_lib:format("An error occured that was unforeseen, due to ~p: ~p.",[Reason,Info]);
format_error({internal_error,Function,Info1,Info2}) ->
io_lib:format("An internal error occured in function ~p with args: ~p,~p.",[Function,Info1,Info2]);
format_error({illegal_content,Reason,Kind}) ->
io_lib:format("Schema: The schema violates the content model allowed for schemas.~nReason: ~p,~nkind of schema element: ~p.",[Reason,Kind]);
format_error({no_match,Kind}) ->
io_lib:format("Schema: The schema violates the content model allowed for schemas.~nKind of schema element: ~p.",[Kind]);
format_error({bad_match,S4SC,CM}) ->
io_lib:format("Schema: The schema missed mandatory elements ~p in ~p.",[S4SC,CM]);
format_error({unmatched_mandatory_object,SequenceEl1,SequenceEl2}) ->
io_lib:format("Schema: The schema should have had an ~p object after the ~p, but it was missing.",[SequenceEl2,SequenceEl1]);
format_error({parsing_external_schema_failed,File,Reason}) ->
io_lib:format("Schema: Parsing the referenced external schema ~p, failed due to ~p.",[File,Reason]);
format_error({fetch_fun_failed,Other}) ->
io_lib:format("Schema: Fetching this kind of external schema is not supported ~p.",
[Other]);
format_error({element_not_in_schema,[EIIName,_ElQName,_CM]}) ->
io_lib:format("XML: The XML element ~p are not present in the schema.",
[EIIName]);
format_error({missing_mandatory_element,CMEl}) ->
io_lib:format("XML: The XML file missed mandatory element(s) ~p defined in schema.",[CMEl]);
format_error({empty_content_not_allowed,C}) ->
io_lib:format("XML: The XML file missed mandatory element(s): ~p defined in schema.",[C]);
format_error({element_not_suitable_with_schema,ElName,_S}) ->
io_lib:format("XML: The XML element: ~p violates the schema, probably to many of same element.",[ElName]);
format_error({element_not_suitable_with_schema,ElName,CMName,_CMEl,_S}) ->
io_lib:format("XML: The XML element: ~p violates the schema. Schema expected element ~p.",[ElName,CMName]);
format_error({no_element_expected_in_group,XML}) ->
io_lib:format("XML: The XML element(s) ~p violates the schema. No element was expected.",[XML]);
format_error({element_bad_match,E,Any,_Env}) ->
io_lib:format("XML: XML element ~p didn't match into the namespace of schema type any ~p.",[E,Any]);
format_error({match_failure,_XML,_CM,_S}) ->
"XML: A combination of XML element(s) and schema definitions that is not known has occured. The implementation doesn't support this structure.";
format_error({cannot_contain_text,_XMLTxt,CMEl}) ->
io_lib:format("XML: The schema structure: ~p doesn't allow text",[CMEl]);
format_error({missing_mandatory_elements,MandatoryEls}) ->
io_lib:format("XML: A schema sequence has mandatory elements ~p, that were unmatched.",[MandatoryEls]);
format_error({choice_missmatch,T,Els}) ->
io_lib:format("XML: A schema choice structure with the alternatives: ~p doesn't allow the text: ~p.",[Els,T]);
format_error({no_element_matching_choice,XML}) ->
io_lib:format("XML: The choice at location: ~p had no alternative that matched the XML structure(s): ~p.",[error_path(XML,undefined),XML]);
format_error({all_missmatch,T,CM}) ->
io_lib:format("XML: The schema expected one of: ~p, but the XML content was text: ~p at the location: ~p.",[CM,T,error_path(T,undefined)]);
format_error({element_not_in_all,ElName,E,_CM}) ->
io_lib:format("XML: The element ~p at location ~p in the XML file was not allowed according to the schema.",[ElName,error_path(E,undefined)]);
format_error({missing_mandatory_elements_in_all,MandatoryEls}) ->
io_lib:format("XML: The schema elements ~p were missed in the XML file.",[MandatoryEls]);
format_error({failed_validating,E,Any}) ->
io_lib:format("XML: The element ~p at location ~p failed validation. It should hav been matched by an any schema element ~p",[E#xmlElement.name,error_path(E,undefined),Any]);
format_error({schemaLocation_list_failure,Paths}) ->
io_lib:format("XML: schemaLocation values consists of one or more pairs of URI references, separated by white space. The first is a namespace name the second a reference to a schema: ~p.",[Paths]);
format_error({element_content_not_nil,XMLEl}) ->
io_lib:format("XML: The element ~p at position ~p has content of text/elements despite the nillable attribute was true.",[XMLEl#xmlElement.name,error_path(XMLEl,undefined)]);
format_error({attribute_in_simpleType,El,Att}) ->
io_lib:format("XML: The element ~p at location ~p must not have attributes like: ~p since it according to the schema has simpleType type.",[El#xmlElement.name,error_path(El,undefined),Att]);
format_error({required_attribute_missed,El,Name}) ->
io_lib:format("XML: The schema required an attribute ~p in element at location ~p that was missing.",[Name,error_path(El,undefined)]);
format_error({default_and_fixed_attributes_mutual_exclusive,
Name,Default,Fix}) ->
io_lib:format("Schema: It is an error in the schema to assign values for both default and fix for an attribute. Attribute: ~p, default: ~p, fix: ~p.",[Name,Default,Fix]);
format_error({schema_error,unexpected_object,_SA,_Err}) ->
"Schema: An unforeseen error case occured, maybee due to an unimplemented feature.";
format_error({attribute_not_defined_in_schema,Name}) ->
io_lib:format("XML: The attribute ~p is not defined in the provided schema.",[Name]);
format_error({disallowed_namespace,Namespace,NS,Name}) ->
io_lib:format("XML: The attribute ~p is not valid because the namespace ~p is forbidden by ~p",[Name,NS,Namespace]);
format_error({cirkular_attributeGroup_reference,Name}) ->
io_lib:format("Schema: Cirkular references to attribute groups are forbidden. One was detected including ~p.",[Name]);
format_error({could_not_resolve_type,ST}) ->
io_lib:format("Schema: The simpleType ~p could not be found among the types defined by the provided schema.",[ST]);
format_error({could_not_check_value_for_type,Type}) ->
io_lib:format("XML: Checking value for type ~p is not implemented.",[Type]);
format_error({unknown_simpleType,BT}) ->
io_lib:format("Schema: The simpleType ~p could not be found among the types defined by the provided schema",[BT]);
format_error({abstract_element_instance,ElName}) ->
io_lib:format("XML: Elements defined as abstract in the schema must not be instantiated in XML: ~p.",[ElName]);
format_error({qualified_name_required,LocalName}) ->
io_lib:format("XML: Element name ~p in XML instance is not qualified, though the schema requires that.",[LocalName]);
format_error({unqualified_name_required,QualifiedName}) ->
io_lib:format("XML: Element name ~p in XML instance must be unqualified, according to schema.",[QualifiedName]);
format_error({illegal_key_sequence_value,Err}) ->
io_lib:format("XML: The 'key-sequence', (se XML-spec 3.11.4), must be a node with at most one member: ~p",[Err]);
format_error({qualified_node_set_not_correct_for_key,_Err}) ->
"Schema: The 'target node set' and 'qualified node set' (se XML-spec 3.11.4.2.1) must be equal.";
format_error({key_value_not_unique,KS}) ->
io_lib:format("Schema: Key values must be unique within the schema. This is not ~p,",[KS]);
format_error({keyref_missed_matching_key,Refer}) ->
io_lib:format("Schema: This keyref had no matching key ~p.",[Refer]);
format_error({keyref_unexpected_object,_Other}) ->
"Schema: An unforeseen error case occured, unknown failure cause.";
format_error({cardinality_of_fields_not_equal,KR,K}) ->
io_lib:format("Schema: keyref and the corresponding key must have same cardinality of their fields. Missmatch in this case keyref: ~p, key: ~p.",[KR,K]);
format_error({could_not_load_keyref,Name}) ->
io_lib:format("Schema: The schema didn't define a keyref with the name ~p.",[Name]);
format_error({reference_undeclared,Kind,Ref}) ->
io_lib:format("Schema: The schema didn't define an ~p with the name ~p.",[Kind,Ref]);
format_error({cyclic_substitutionGroup,SGs}) ->
io_lib:format("Schema: cyclic substitutionGroup was detected, substitutionGroup structure is ~p.",[SGs]);
format_error({substitutionGroup_error,Head,SG}) ->
io_lib:format("Schema: Either of substitutionGroup members ~p or ~p is not defined in the provided schema.",[Head,SG]);
format_error({cyclic_definition,CA}) ->
io_lib:format("Schema: A forbidden cicular definition was detected ~p.",[CA]);
format_error({type_of_element_not_derived,MemT,HeadT}) ->
io_lib:format("Schema: Type in substitutionGroup members should be simpleType or complexType. In this case ~p and ~p were found.",[MemT, HeadT]);
format_error({derivation_blocked,BlockTag,Derivation}) ->
io_lib:format("Derivation by ~p is blocked by the blocking tag ~p.",[Derivation,BlockTag]);
format_error({names_not_equal,QName1,QName2}) ->
io_lib:format("The type ~p seems to be derived from another type than the base type ~p",[QName2,QName1]);
%% format_error({miss_match_base_types,QName1,QName2}) ->
%% io_lib:format("Types and/or names of base type ~p and derived type ~p doesn't fit.",[QName1,QName2]);
format_error({illegal_content_in_extension,Ext}) ->
io_lib:format("The extension content ~p didn't match the content model of the provided schema.",[Ext]);
format_error({SeqCho,expected,Other,found})
when SeqCho == sequence;SeqCho == choice ->
io_lib:format("Schema: The restriction content ~p didn't match the content model of the provided schema, ~p was expected.",[SeqCho,Other]);
format_error({does_not_support,F,in_restriction}) ->
io_lib:format("Schema: The structure ~p is not supported in the implementation.",[F]);
format_error({illegal_content_simple_type,CM,TypeName}) ->
io_lib:format("Schema: ~p content is not allowed in a simpleType, as in ~p.",[CM,TypeName]);
format_error({illegal_in_restriction_of_simpleType,X}) ->
io_lib:format("Schema: The ~p content is illegal in a simpleType.",[X]);
format_error({element,Name,not_present_in_restriction}) ->
io_lib:format("Schema: In a restriction all element names of the restriction must be one of the elements of the base type. ~p is not.",[Name]);
format_error({invalid_derivation,EA,BaseAtts}) ->
io_lib:format("Schema: An anyAttribute ~p in a restricted derived type must be present among the base type attributes ~p.",[EA,BaseAtts]);
format_error({wildcard_namespace,NS,not_subset_of_base_namespace,BaseNS}) ->
io_lib:format("Schema: See XML spec. section 3.10.6. This wildcard namespace ~p is not allowed by the base namespace restrictions ~p.",[NS,BaseNS]);
format_error({wildcard_namespace_union_not_expressible,NS1,NS2}) ->
io_lib:format("Schema: See XML spec. section 3.10.6. The union of namespaces ~p and ~p is not expressible.",[NS1,NS2]);
format_error({wildcard_namespace_intersection_not_expressible,NS1,NS2}) ->
io_lib:format("Schema: See XML spec. section 3.10.6. The intersection of namespaces ~p and ~p is not expressible.",[NS1,NS2]);
format_error({circular_reference_of_type,TName}) ->
io_lib:format("Schema: An illicit circular reference involving simple/complex type ~p has been detected.",[TName]);
format_error({type_not_uniquely_defined_in_schema,Name}) ->
io_lib:format("Schema: See XML spec. section 3.4.1. Type names whether simple or complex must be unique within the schema. ~p is not.",[Name]);
format_error({not_uniquely_defined_in_schema,Key}) ->
io_lib:format("Schema: All schema objects of the same kind identified by name must be unique within the schema. ~p is not.",[Key]);
format_error({illegal_ID_value,ID}) ->
io_lib:format("The ID value ~p is not allowed as an ID value.",[ID]);
format_error({incomplete_file,_FileName,_Other}) ->
"Schema: The file containing a schema state must be produced by xmerl_xsd:state2file/[1,2].";
format_error({unexpected_content_in_any,A}) ->
io_lib:format("Schema: The any type is considered to have no content besides annotation. ~p was found.",[A]);
format_error({erroneous_content_in_identity_constraint,IDC,Err}) ->
io_lib:format("Schema: An ~p identity constraint must have one selector and one or more field in content. This case ~p",[IDC,Err]);
format_error({missing_xpath_attribute,IDCContent}) ->
io_lib:format("Schema: A ~p in a identity constraint must have a xpath attribute.",[IDCContent]);
format_error({content_in_anyAttribute,Err}) ->
io_lib:format("Schema: ~p is not allowed in anyAttribute. Content cannot be anything else than annotation.",[Err]);
format_error({content_in_simpleContent,Err}) ->
io_lib:format("Schema: Content of simpleContent can only be an optional annotation and one of restriction or extension. In this case ~p.",[Err]);
format_error({complexContent_content_failure,Err}) ->
io_lib:format("Schema: Besides an optional annotation complexContent should have one of restriction or extension. In this case ~p.",[Err]);
format_error({union_member_type_not_simpleType,IllegalType}) ->
io_lib:format("Schema: ~p is not allowed in a union. Content must be any nymber of simpleType.",[IllegalType]);
format_error({missing_base_type,restriction,_Other}) ->
"Schema: A restriction must have a base type, either assigned by the 'base' attribute or as a simpleType defined in content.";
format_error({content_failure_expected_restriction_or_extension,Kind,_}) ->
io_lib:format("Schema: A ~p had no restriction or extension in content.",[Kind]);
format_error({content_failure_only_one_restriction_or_extension_allowed,Kind,_}) ->
io_lib:format("Schema: A ~p can only have one of restriction or extension in content.",[Kind]);
format_error({mandatory_component_missing,S4SCMRest,Kind}) ->
io_lib:format("Schema: After matching a ~p the schema should have had content ~p.",[Kind,S4SCMRest]);
format_error(Err) ->
io_lib:format("~p~n",[Err]).
%% format_error(ErrMsg,E,SchemaE,Env) ->
%% ?debug("format_error: ~p~n",[ErrMsg]),
%% {ErrMsg,format_error2(E,SchemaE,Env)}.
%% format_error2(E,SchemaE,Env) ->
%% {shema_el_pathname(SchemaE,Env),
%% xml_el_pathname(E)}.
default_namespace_by_convention() ->
[{xml,'http://www.w3.org/XML/1998/namespace'}].