Permalink
Switch branches/tags
Find file
9b3f910 May 30, 2016
@willemdj @kostis @arcusfelis
788 lines (721 sloc) 32 KB
%%% Copyright (C) 2006 - 2008 Willem de Jong
%%%
%%% This file is part of Erlsom.
%%%
%%% Erlsom is free software: you can redistribute it and/or modify
%%% it under the terms of the GNU Lesser General Public License as
%%% published by the Free Software Foundation, either version 3 of
%%% the License, or (at your option) any later version.
%%%
%%% Erlsom is distributed in the hope that it will be useful,
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
%%% GNU Lesser General Public License for more details.
%%%
%%% You should have received a copy of the GNU Lesser General Public
%%% License along with Erlsom. If not, see
%%% <http://www.gnu.org/licenses/>.
%%%
%%% Author contact: w.a.de.jong@gmail.com
%%% ====================================================================
%%% translates a data structure of a pre-defined form to an XML document.
%%% ====================================================================
%%% This is the companion of erlsom_parse, which performs the inverse operation.
%%% Both modules use the same 'model' that descibes the translation, see the
%%% introduction to erlsom_parse for the definition of this model.
-module(erlsom_write).
-export([write/2,
write/3]).
-include("erlsom_parse.hrl").
-include("erlsom.hrl").
%% debug(Text) ->
%% io:format("write: ~p\n", [Text]).
%% Returns the XML document. {ok, Document}
write(Struct, Model) ->
write(Struct, Model, []).
write(Struct, Model = #model{tps = Types}, Options) ->
%% start with _document type.
case lists:keysearch('_document', 2, Types) of
{value, #type{els = [Head | _Tail], mxd = Mixed}} ->
CurrentValue = Struct,
ResultWithThisElement =
processElementValues([CurrentValue], Head,
[], 0, Model, {[], 0}, Mixed),
%% debug(ResultWithThisElement);
case proplists:get_value(output, Options, list) of
list ->
{ok, unicode:characters_to_list(ResultWithThisElement)};
chardata ->
{ok, ResultWithThisElement};
binary ->
{ok, unicode:characters_to_binary(ResultWithThisElement)}
end;
_Else ->
{error, "Model should have _document type"}
end.
struct2xml(_Struct, [], ResultSoFar, _Model, _Namespaces, _Mixed) ->
lists:reverse(ResultSoFar);
%% Struct = {RecordType, value, ...}
%% Processes whatever is INSIDE the tags (= the values of the struct), one by one, from the first
struct2xml(Struct,
_StructModel = [ModelForThisElement = #el{alts = Alternatives, mn = Min, mx = Max, nr = SequenceNr,
nillable = Nillable} | NextElements],
ResultSoFar, Model = #model{nss = Namespaces}, DeclaredNamespaces,
Mixed) ->
%% Which alternative has been selected follows from the value of this element
CurrentValue = element(SequenceNr, Struct),
%% value = tuple => subtype
%% value = list of chars (integers) => text
%% value = list (not string) of:
%% tuples => subtypes, element has maxOccurs > 1 OR alternative has maxOccurs > 1
%% strings =>
%% lists => element has maxOccurs > 1 AND alternative has maxOccurs > 1
%% value == undefined -> no value provided
%% etc.
%% debug(CurrentValue),
if
(Max == 1) and (Mixed /= true) ->
case CurrentValue of
undefined ->
if
Min > 0 ->
Tags = [Alt#alt.tag || Alt <- Alternatives],
Error = lists:flatten(io_lib:format("No value provided for non-optional element ~p~n", [Tags])),
throw({error, Error});
true -> ok
end,
ResultForThisElement = [];
nil ->
if
Nillable /= true -> throw({error, "nil value provided for non-nillable element"});
true -> ok
end,
ResultForThisElement = printNilValue(Alternatives, Namespaces, DeclaredNamespaces);
{nil, AttrValues} ->
if
Nillable /= true -> throw({error, "nil value provided for non-nillable element"});
true -> ok
end,
ResultForThisElement = printNilValue(Alternatives, AttrValues, Model, Namespaces, DeclaredNamespaces);
[V1 | _] ->
case V1 of
_ when is_integer(V1) -> %% CurrentValue is a string
ResultForThisElement = printValue(CurrentValue, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
_ when is_tuple(V1) ->
%% debug("alternative with MaxOccurs > 1"),
ResultForThisElement = processAlternatives(CurrentValue, Alternatives, Model, DeclaredNamespaces,
Mixed)
end;
#qname{} ->
ResultForThisElement = printValue(CurrentValue, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
_ when is_tuple(CurrentValue) ->
%% debug("subtype"),
ResultForThisElement =
processElementValues([CurrentValue], ModelForThisElement, [], 0, Model, DeclaredNamespaces, Mixed);
_ when is_binary(CurrentValue) ->
ResultForThisElement = printValue(CurrentValue, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
_ ->
%% debug("simple type"),
ResultForThisElement = printValue(CurrentValue, Alternatives, Namespaces, DeclaredNamespaces, Mixed)
end;
true -> %% CurrentValue is a list, because Element has maxOccurs > 1.
if
is_list(CurrentValue); CurrentValue == undefined -> true;
true -> throw({error, "value has to be a list"})
end,
if
CurrentValue == undefined ->
ResultForThisElement = [];
true ->
ResultForThisElement = processElementValues(CurrentValue, ModelForThisElement, [], 0, Model,
DeclaredNamespaces, Mixed)
end
end,
%% process remaining elements
struct2xml(Struct, NextElements, [ResultForThisElement | ResultSoFar], Model, DeclaredNamespaces, Mixed).
processElementValues([],
_ModelForThisElement = #el{mn = Min},
ResultSoFar, Counter, _Model, _DeclaredNamespaces,
_Mixed) ->
if
Counter < Min ->
throw({error, "Not enough values provided"});
true ->
lists:reverse(ResultSoFar)
end;
%% ElementValues can be:
%%
%% FirstElement can be:
%% - a tuple
%% - for a value
%% - a string (list)
%% - for a value
%% - a list of tuples:
%% - for a sequence (or all, no need to distinguish) where the element has more values
%% - for a choice where the selected alternative has maxOccurs > 1
%% - a list of lists
%% - for a choice with maxOccurs > 1 and an alternative with maxOccurs > 1
%% - it could in theory be a list of lists of lists (etc.)? But not now, since choice in choice is
%% not supported.
%% - nil
%% - for a nillable element without attributes - even though it is not clear how useful this is
%% - {nil, Record}
%% - for a nillable element with attributes
processElementValues([V1 | NextValues],
ModelForThisElement = #el{alts = Alternatives, mx = Max, nillable=Nillable},
ResultSoFar, Counter, Model = #model{nss = Namespaces}, DeclaredNamespaces, Mixed) ->
%% debug("procesElementValues, counter = " ++ integer_to_list(Counter)),
{Case, IncreaseCounter} =
case V1 of
[] -> %% "", string of 0 characters
{listOfStrings, 1};
_ when is_list(V1) ->
V11 = hd(V1),
case V11 of
#qname{} ->
throw({error, "wrong type in value"});
_ when is_tuple(V11) ->
{listOfTuples, 1};
_ when is_integer(V11) ->
if
Mixed == true ->
{mixed, 0};
true ->
%% debug("element w. MaxOccurs > 1; 1st value is a string"),
{listOfStrings, 1}
end;
_ ->
throw({error, "wrong type in value"})
end;
_ when is_binary(V1) ->
if
Mixed == true ->
{mixed, 0};
true ->
%% debug("element w. MaxOccurs > 1; 1st value is a string"),
{listOfStrings, 1}
end;
#qname{} ->
%% debug("element w. MaxOccurs > 1, (1st value is a qname)."),
{qname, 1};
{nil, _Record} ->
if
Nillable /= true -> throw({error, "nil value provided for non-nillable element"});
true -> {V1, 1} %% {{nil, Values}, 1} -- a bit tricky
end;
_ when is_tuple(V1) ->
%% debug("element w. MaxOccurs > 1, (1st value is a subtype)"),
{tuple, 1};
nil ->
if
Nillable /= true -> throw({error, "nil value provided for non-nillable element"});
true -> {nil, 1}
end;
_ ->
%% debug("element w. MaxOccurs > 1, (1st value is a simple type)"),
{simpleType, 1}
end,
if
Counter + IncreaseCounter > Max -> %% if Max == unbound the result of the test is false!
throw({error, "Too many values provided"});
true -> true
end,
ResultForThisElement =
case Case of
listOfTuples ->
processAlternatives(V1, Alternatives, Model, DeclaredNamespaces, Mixed);
mixed ->
erlsom_lib:xmlString(V1);
listOfStrings ->
printValue(V1, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
qname ->
printValue(V1, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
tuple ->
processSubType(V1, Alternatives, Model, DeclaredNamespaces, Mixed);
simpleType ->
printValue(V1, Alternatives, Namespaces, DeclaredNamespaces, Mixed);
nil ->
printNilValue(Alternatives, Namespaces, DeclaredNamespaces);
{nil, Record} ->
printNilValue(Alternatives, Record, Model, Namespaces, DeclaredNamespaces)
end,
processElementValues(NextValues, ModelForThisElement, [ResultForThisElement | ResultSoFar], Counter + IncreaseCounter,
Model, DeclaredNamespaces, Mixed).
%% returns a string that represents the value
processSubType(Value, Alternatives, Model = #model{tps = Types}, DeclaredNamespaces,
Mixed) ->
%% RecordType can be an instantiated abstract type
RecordType = element(1, Value),
{Alternative, Abstract} = findAlternative(RecordType, Alternatives, Model),
TypeRecord = findType(RecordType, Types),
processAlternativeValue(Value, 1, Alternative, TypeRecord, Model, DeclaredNamespaces, Abstract, Mixed).
processAlternatives(Values = [Value | _], Alternatives, Model = #model{tps = Types}, DeclaredNamespaces,
Mixed) ->
%% See which alternative this is
RecordType = element(1, Value),
{Alternative, Abstract} = findAlternative(RecordType, Alternatives, Model),
TypeRecord = findType(RecordType, Types),
processAlternativeValues(Values, 0, Alternative, TypeRecord, Model, DeclaredNamespaces, Abstract, [], Mixed).
processAlternativeValues([], Count, #alt{mn = Min}, _Type, _Model, _Ns, _Abstract, Acc, _Mixed) ->
if
Count < Min -> throw({error, "not enough values"});
true -> lists:reverse(Acc)
end;
processAlternativeValues([V1 | Tail], Count, Alternative, Type, Model, Ns, Abstract, Acc, Mixed) ->
processAlternativeValues(Tail, Count + 1, Alternative, Type, Model, Ns, Abstract,
[processAlternativeValue(V1, Count, Alternative, Type, Model, Ns, Abstract, Mixed) | Acc], Mixed).
processAlternativeValue(Value, Count,
#alt{tag = Tag, rl = RealElement, mx = MaxAlt},
#type{els = Elements, atts = Attributes, typeName = Name, mxd = MixedChild},
Model = #model{nss = Namespaces, any_attribs = AnyAtts},
DeclaredNamespaces,
Abstract,
MixedParent) ->
Mixed =
case MixedParent of
true ->
case RealElement of
true -> MixedChild;
simple -> MixedChild;
_ -> MixedParent %% 'non-real' elements (groups) inherit this property
end;
_ -> MixedChild
end,
if
Count > MaxAlt -> throw({error, "too many values"});
true -> true
end,
TagAsText = atom_to_list(Tag),
if
RealElement ->
%% proces the attributes
{AttributesString, NewDeclaredNamespaces} = processAttributes(Value, [], Attributes, Namespaces, DeclaredNamespaces),
%% process anyAttributes
%% for now we don't check whether 'anyAttributes' are allowed!
{AnyAttributesString, DeclaredNamespaces2} =
case AnyAtts of
true ->
processAnyAttributes(element(2, Value), [], Namespaces, NewDeclaredNamespaces);
_ ->
{"", NewDeclaredNamespaces}
end,
{AnyAttrPlusXsiTypeString, DeclaredNamespaces3} =
case Abstract of
false -> {AnyAttributesString, DeclaredNamespaces2};
_ ->
XsiType = [" xsi:type=\"", atom_to_list(Name), "\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\""],
{[AnyAttributesString, XsiType], DeclaredNamespaces2}
end,
%% deal with namespaces (that is, see if they have to be declared here)
{NamespacesString, NewDeclaredNamespaces4, Extra_prefix} = processNamespaces(TagAsText, Namespaces, DeclaredNamespaces3),
ResultForThisElement = struct2xml(Value, Elements, [], Model, NewDeclaredNamespaces4, Mixed),
AllAttrs = [NamespacesString, AttributesString, AnyAttrPlusXsiTypeString],
printTag([Extra_prefix, TagAsText], AllAttrs, ResultForThisElement);
true ->
struct2xml(Value, Elements, [], Model, DeclaredNamespaces, Mixed)
end.
printTag(TagAsText, AllAttrs, []) ->
%% Short tag
[$<, TagAsText, AllAttrs, "/>"];
printTag(TagAsText, AllAttrs, Content) ->
%% Open, close tags
[$<, TagAsText, AllAttrs, ">", Content, "</", TagAsText, $>].
findType(TypeName, Types) ->
case lists:keysearch(TypeName, #type.nm, Types) of
{value, Type} -> Type;
_ -> throw({error, "Something wrong with the Model"})
end.
findAlternative(RecordType, Alternatives, Model) ->
findAlternative(RecordType, Alternatives, Model, false).
findAlternative(RecordType, Alternatives, #model{th = TypeHierarchy} = Model, Abstract) ->
case lists:keysearch(RecordType, #alt.tp, Alternatives) of
{value, Alternative} -> {Alternative, Abstract};
_ ->
%% see whether this is an '#any' type
case Alternatives of
[#alt{tag='#any', anyInfo = #anyInfo{ns = AltNs}}] when AltNs /= "##other" ->
AnyAlternatives = Alternatives ++ erlsom_lib:documentAlternatives(Model),
findAlternative(RecordType, AnyAlternatives, Model, Abstract);
_ ->
%% see whether an ancestor in the type hierarchy is among the alternatives
case erlsom_lib:getAncestor(RecordType, TypeHierarchy) of
{value, Ancestor} ->
findAlternative(Ancestor, Alternatives, Model, true);
_ ->
throw({error, "Struct doesn't match model: recordtype not expected: " ++ atom_to_list(RecordType)})
end
end
end.
%% Attribute is a tuple {Name, SequenceNr, Optional, Type}
processAttributes(_Struct, ResultSoFar, [], _Namespaces, DeclaredNamespaces) ->
{ResultSoFar, DeclaredNamespaces};
processAttributes(Struct, ResultSoFar, [#att{nm = Name,
nr = SequenceNr,
opt = Optional,
tp = Type} | Rest], Namespaces, DeclaredNamespaces) ->
NameAsString = atom_to_list(Name),
{NamespacesString, NewDeclaredNamespaces, _Extra_prefix} = processNamespaces(NameAsString, Namespaces, DeclaredNamespaces),
AttributeValue = element(SequenceNr, Struct),
case AttributeValue of
undefined ->
if
Optional ->
processAttributes(Struct, ResultSoFar, Rest, Namespaces, DeclaredNamespaces);
true ->
throw({error, "No value provided for mandatory attribute " ++ atom_to_list(Name)})
end;
_Defined ->
case Type of
String when String == char; String == ascii ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = erlsom_lib:xmlString(AttributeValue);
integer ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = try integer_to_list(AttributeValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected Integer"})
end;
bool ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = case AttributeValue of
true -> "true";
false -> "false";
_ -> throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected boolean"})
end;
float ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = try float_to_xml(AttributeValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected Float"})
end;
atom ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = try atom_to_list(AttributeValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected Atom"})
end;
qname ->
{CharValue, NamespacesString2, DeclaredNamespaces2} =
try writeQnameAttValue(AttributeValue, NamespacesString, Namespaces, NewDeclaredNamespaces)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected qname, got " ++
lists:flatten(io_lib:format("~p",[AttributeValue]))})
end;
{integer, Subtype} ->
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = try
erlsom_lib:check_int(Subtype, AttributeValue),
integer_to_list(AttributeValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type in attribute " ++ atom_to_list(Name) ++ ", expected " ++ atom_to_list(Subtype)})
end;
_Else ->
throw({error, "unknown type in model: " ++lists:flatten(io_lib:format("~p",[Type]))}),
DeclaredNamespaces2 = NewDeclaredNamespaces,
NamespacesString2 = NamespacesString,
CharValue = []
end,
%% NamespacesString is "" or " xmlns...".
ResultWithThisAttribute = [ResultSoFar, NamespacesString2, " ", NameAsString, "=\"", CharValue, "\""],
processAttributes(Struct, ResultWithThisAttribute, Rest, Namespaces, DeclaredNamespaces2)
end.
%% returns:
%% {AttributeValue, NamespacesString, NewDeclaredNamespaces}
%% -record(qname, {uri, localPart, prefix, mappedPrefix}).
writeQnameAttValue(#qname{uri = Uri, localPart = LP, mappedPrefix = MP}, NamespacesString, Namespaces,
DeclaredNamespaces = {NamespacesList, Counter}) ->
case Uri of
None when None == []; None == undefined ->
{LP, NamespacesString, DeclaredNamespaces};
_ ->
%% see whether the namespace has been defined. If not, then this has to be done.
case lists:keysearch(Uri, 2, NamespacesList) of
{value, {Prefix, _Uri}} -> %% already declared
{[Prefix, ":", LP], NamespacesString, DeclaredNamespaces};
_ ->
%% see whether a prefix was specified
case lists:keysearch(Uri, #ns.uri, Namespaces) of
{value, #ns{prefix = Prefix2}} ->
{[Prefix2, ":", LP], [NamespacesString, " xmlns:", Prefix2, "=\"", Uri, "\""],
{[{Prefix2, Uri} | NamespacesList], Counter}};
_ ->
{[MP, ":", LP], [NamespacesString, " xmlns:", MP, "=\"", Uri, "\""],
{[{MP, Uri} | NamespacesList], Counter}}
end
end
end.
processAnyAttributes(undefined, Acc, _Namespaces, DeclaredNamespaces) ->
{Acc, DeclaredNamespaces};
processAnyAttributes([], Acc, _Namespaces, DeclaredNamespaces) ->
{Acc, DeclaredNamespaces};
processAnyAttributes([{{Name, Uri}, Value} | Tail], Acc, Namespaces, DeclaredNamespaces) ->
case Uri of
[] ->
processAnyAttributes(Tail, [Acc, " ", Name, "=\"", decodeIfRequired(Value), "\""],
Namespaces, DeclaredNamespaces);
_Other ->
%% the "xsi:nil=true" is not written, because it is inserted in another way.
case {Name, Uri, Value} of
{"nil", "http://www.w3.org/2001/XMLSchema-instance", "true"} ->
processAnyAttributes(Tail, Acc, Namespaces, DeclaredNamespaces);
{"nil", "http://www.w3.org/2001/XMLSchema-instance", "1"} ->
processAnyAttributes(Tail, Acc, Namespaces, DeclaredNamespaces);
_ ->
%% get prefix +, if relevant, NS declaration text
{PrefixedName, DeclaredNamespaces2} = processAnyNamespaces(Name, Uri, Namespaces, DeclaredNamespaces),
processAnyAttributes(Tail, [Acc, " ", PrefixedName, "=\"", decodeIfRequired(Value), "\""],
Namespaces, DeclaredNamespaces2)
end
end.
%% see if the tag references a namespace. If so, see whether
%% this namespace has been declared.
%%
%% Namespaces is of the form {Prefix, URI}
%% DeclaredNamespaces = [Prefix]
%%
%% returns {NameSpacesString, NewDeclaredNamespaces}, where
%% NamespacesString is the declaration (if required), and
%% NewDeclaredNamespaces is the new list of declared
%% namespaces.
processNamespaces(Tag, Namespaces, DeclaredNamespaces = {NamespacesList, Counter}) ->
%% look for ':' in the tag
%% debug(Tag),
%% debug(DeclaredNamespaces),
Prefix = case string:tokens(Tag, ":") of
[Pf, _LName] ->
Pf;
[_LName] ->
undefined;
_ ->
throw({error, "Tag " ++ Tag ++ " is not of form [prefix:]localName"})
end,
%% IF
%% prefix is 'undefined' AND
%% namespace for 'undefined' exists AND
%% elementFormDefault (efd) for this ns is 'unqualified' AND
%% the namespace has not be been declared at a higher level
%% THEN
%% put a prefix anyway - make one up. (for now: use "erlsom").
%% declaredNamespaces = [{Prefix, Uri}]
case lists:keysearch(Prefix, 1, NamespacesList) of
{value, _} -> %% already declared
{[], DeclaredNamespaces, ""};
_Else ->
%% find prefix in Model
case lists:keysearch(Prefix, #ns.prefix, lists:reverse(Namespaces)) of
{value, #ns{uri = Uri, efd = qualified}} ->
Xmlns = case Prefix of
undefined -> " xmlns";
_ -> [" xmlns:", Prefix]
end,
{[Xmlns, "=\"", Uri, "\""], {[{Prefix, Uri} | NamespacesList], Counter}, ""};
{value, #ns{uri = Uri, efd = unqualified}} ->
case Prefix of
undefined ->
Xmlns = " xmlns:erlsom",
Additional_pf = "erlsom:";
_ ->
Xmlns = [" xmlns:", Prefix],
Additional_pf = ""
end,
{[Xmlns, "=\"", Uri, "\""], {[{Prefix, Uri} | NamespacesList], Counter}, Additional_pf};
_ ->
case Prefix of
undefined -> {[], DeclaredNamespaces, ""};
"xml" -> {[], DeclaredNamespaces, ""};
_ -> throw({error, "Inconsistency in model: namespace is not declared - " ++ Prefix})
end
end
end.
processAnyNamespaces(Name, Uri, Namespaces, {NamespacesList, Counter} = DeclaredNamespaces ) ->
case lists:keysearch(Uri, 2, NamespacesList) of
{value, {Prefix, _}} -> %% already declared
{[Prefix, ":", Name], DeclaredNamespaces};
_Else ->
%% find Uri in Model
case lists:keysearch(Uri, #ns.uri, Namespaces) of
{value, #ns{prefix = ModelPrefix}} ->
ThePrefix = ModelPrefix;
_Else ->
%% make up a prefix, using counter
ThePrefix = "pre" ++ integer_to_list(Counter +1)
end,
PrefixName = [" xmlns:", ThePrefix, "=\"", Uri, "\" ", ThePrefix, ":", Name],
{PrefixName,
{[{ThePrefix, Uri} | NamespacesList], Counter + 1}}
end.
printValue(CurrentValue, Alternatives, Namespaces,
DeclaredNamespaces = {NamespacesList, _Counter}, Mixed) ->
case CurrentValue of
#qname{localPart = LocalName, prefix = Prefix, uri = Uri} ->
case lists:keysearch({'#PCDATA', qname}, #alt.tp, Alternatives) of
{value, #alt{tag = Tag, rl = RealElement}} -> %% Print Tags if RealElement
%% see whether this namespace was already declared
{PrintPrefix, NsDecl} = printPrefix(Uri, Prefix, NamespacesList, Namespaces),
TextValue = case PrintPrefix of
undefined -> erlsom_lib:xmlString(LocalName);
_ -> erlsom_lib:xmlString(PrintPrefix ++ ":" ++ LocalName)
end,
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces, NsDecl);
_Else ->
throw({error, "Type of value (qname) does not match model"++lists:flatten(io_lib:format("Value = --> ~p <--]",[CurrentValue]))})
end;
_B when is_list(CurrentValue); is_binary(CurrentValue) ->
if
Mixed == true ->
erlsom_lib:xmlString(CurrentValue); %% Note: values for (non-mixed) elements have to be of the
%% form {type, Value} within mixed types
true ->
case lists:keysearch({'#PCDATA', char}, #alt.tp, Alternatives) of
{value, #alt{tag = Tag, rl = RealElement}} -> %% Print Tags if RealElement
TextValue = erlsom_lib:xmlString(CurrentValue),
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces);
_Else ->
throw({error, "Type of value (list) does not match model"++lists:flatten(io_lib:format("Value = --> ~p <-- Expected ~p",[CurrentValue,Alternatives]))})
end
end;
_C when is_integer(CurrentValue) ->
%% is an integer also a float?
case lists:keysearch({'#PCDATA', integer}, #alt.tp, Alternatives) of
{value, #alt{tag = Tag, rl = RealElement}} ->
TextValue = try integer_to_list(CurrentValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type"})
end,
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces);
_Else ->
try convert_int_subtype(CurrentValue, Alternatives) of
{ok, #alt{tag = Tag, rl = RealElement}, Converted} ->
printElement(Converted, Tag, RealElement, Namespaces, DeclaredNamespaces);
_ ->
throw({error, "Type of value (integer) does not match model"++
lists:flatten(io_lib:format("Value = --> ~p <--]",[CurrentValue]))})
catch
_AnyClass:_Any ->
throw({error, "Wrong Type"})
end
end;
_D when is_float(CurrentValue);
CurrentValue =:= 'NaN';
CurrentValue =:= 'INF';
CurrentValue =:= '-INF' ->
%% is an integer also a float?
case lists:keysearch({'#PCDATA', float}, #alt.tp, Alternatives) of
{value, #alt{tag = Tag, rl = RealElement}} ->
TextValue = try float_to_xml(CurrentValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type"})
end,
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces);
_Else ->
throw({error, "Type of value (float) does not match model"++lists:flatten(io_lib:format("Value = --> ~p <--]",[CurrentValue]))})
end;
_E when CurrentValue == true; CurrentValue == false ->
case lists:keysearch({'#PCDATA', bool}, #alt.tp, Alternatives) of
{value, #alt{tag = Tag, rl = RealElement}} ->
TextValue = try atom_to_list(CurrentValue)
catch
_AnyClass:_Any ->
throw({error, "Wrong Type"})
end,
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces);
_Else ->
throw({error, "Type of value (atom) does not match model"++lists:flatten(io_lib:format("Value = --> ~p <--]",[CurrentValue]))})
end;
_Else ->
throw({error, "Type of value not valid for XML structure"++lists:flatten(io_lib:format("Value = --> ~p <--]",[CurrentValue]))})
end.
%% see if there is an {integer, subtype} alternative,
%% test the value
convert_int_subtype(_Value, []) ->
error;
convert_int_subtype(Value, [#alt{tp = {'#PCDATA', {integer, Subtype}}} = Alt | _T]) ->
erlsom_lib:check_int(Subtype, Value),
Converted = integer_to_list(Value),
{ok, Alt, Converted};
convert_int_subtype(Value, [_H | T]) ->
convert_int_subtype(Value, T).
printNilValue([#alt{tag= Tag}], Namespaces, DeclaredNamespaces) ->
printElement("", Tag, true, Namespaces, DeclaredNamespaces,
" xsi:nil=\"true\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"");
printNilValue(_Alternatives, _, _) ->
throw({error, "Nillable cannot be a choice"}).
printNilValue([#alt{tag=Tag, tp = RecordType}], Value, #model{tps = Types, any_attribs = AnyAtts}, Namespaces, DeclaredNamespaces) ->
TypeRecord = findType(RecordType, Types),
Attributes = TypeRecord#type.atts,
%% proces the attributes
{AttributesString, NewDeclaredNamespaces} = processAttributes(Value, [], Attributes, Namespaces, DeclaredNamespaces),
%% process anyAttributes
%% for now we don't check whether 'anyAttributes' are allowed!
{AnyAttributesString, DeclaredNamespaces2} =
case AnyAtts of
true ->
processAnyAttributes(element(2, Value), [], Namespaces, NewDeclaredNamespaces);
_ ->
{"", NewDeclaredNamespaces}
end,
%% deal with namespaces (that is, see if they have to be declared here)
TagAsText = atom_to_list(Tag),
{NamespacesString, _DeclaredNamespaces3, Extra_prefix} = processNamespaces(TagAsText, Namespaces, DeclaredNamespaces2),
%% print startTag
StartTag = [$<, Extra_prefix, TagAsText, NamespacesString, AttributesString, AnyAttributesString,
" xsi:nil=\"true\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\">"],
%% print end tag
EndTag = ["</", atom_to_list(Tag), ">"],
[StartTag, EndTag].
printPrefix(undefined, Prefix, _NamespacesList, _Namespaces) ->
{Prefix, []};
printPrefix(Uri, Prefix, NamespacesList, Namespaces) ->
case lists:keysearch(Uri, 2, NamespacesList) of
{value, {Prefix2, _Uri}} -> %% already declared
{Prefix2, []};
_ ->
%% see whether a prefix was specified
PrintedPrefix = case lists:keysearch(Uri, #ns.uri, Namespaces) of
{value, #ns{prefix = Prefix3}} ->
Prefix3;
_ ->
Prefix
end,
Xmlns = case PrintedPrefix of
undefined -> " xmlns";
_ -> [" xmlns:", Prefix]
end,
{PrintedPrefix, [Xmlns, "=\"", Uri, "\""]}
end.
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces, QnameNs) ->
if
RealElement ->
TagAsText = atom_to_list(Tag),
%% this function is only used in 'leaves' of the struct, so we don't need to store the
%% new declared namespaces (since those would apply only to child-elements, of
%% which there are none)
{NamespacesString, _, Extra_prefix} = processNamespaces(TagAsText, Namespaces, DeclaredNamespaces),
[$<, Extra_prefix, TagAsText, NamespacesString, QnameNs, $>, TextValue, "</", Extra_prefix, TagAsText, $>];
true ->
TextValue
end.
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces) ->
printElement(TextValue, Tag, RealElement, Namespaces, DeclaredNamespaces, []).
decodeIfRequired(Text) when is_binary(Text) ->
erlsom_ucs:decode_utf8(Text);
decodeIfRequired(Text) ->
Text.
float_to_xml('NaN') -> "NaN";
float_to_xml('INF') -> "INF";
float_to_xml('-INF') -> "-INF";
float_to_xml(Float) ->
io_lib:format("~e", [Float]).