%%% 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 %%% . %%% %%% Author contact: w.a.de.jong@gmail.com %%% ==================================================================== %%% A couple of support functions for Erlsom %%% ==================================================================== -module(erlsom_lib). -export([convertPCData/4, makeName/2, makeName/4, nameWithoutPrefix/1, makeAttrName/2, makeTypeName/4, makeTypeName/2, makeElementName/2, makeGroupName/2, makeTypeRef/2, makeTypeRefAtom/2, makeGroupRef/2, makeElementRef/2, makeAttrRef/2, makeTagFromRef/2, makeTag/2, makeTag/3, findPrefix/2, findPrefix2/2, translateType/1, minMax/1, multMinMax/2, tagNamespace/2, listLength/1, toUnicode/1, detect_encoding/1, detectEncoding/3, findFile/4, find_xsd/4, findType/6, readImportFile/1, newTree/0, addTreeElement/3, isAncestor/3, getAncestor/2, getLeaves/2, getDescendants/2, emptyListIfUndefined/1, searchBase/2, makeQname/1, localName/1, getTargetNamespaceFromXsd/1, removePrefixes/1, unique/1]). -include("erlsom_compile.hrl"). -include("erlsom_sax.hrl"). -include("erlsom.hrl"). -include("erlsom_parse.hrl"). %% the record definitions %% debug(Text) -> io:format("lib: ~p\n", [Text]). %%debug(Text1, Text2) -> %%io:format("~p ~p\n", [Text1, Text2]). %% Convert text to the indicated type. convertPCData(Text, char, _Namespaces, _NamespaceMapping) when is_binary(Text) -> Text; convertPCData(Text, Type, Namespaces, NamespaceMapping) when is_binary(Text) -> convertPCData(erlsom_ucs:decode_utf8(Text), Type, Namespaces, NamespaceMapping); convertPCData(Text, Type, Namespaces, NamespaceMapping) -> case Type of char -> Text; atom -> list_to_atom(Text); ascii -> %% this is only used by the compiler. Names (which have to be converted to atoms later on %% in the process) have this type. try list_to_atom(Text) catch _Class:Exception -> throw(Exception) end, Text; integer -> list_to_integer(Text); bool -> case Text of "true" -> true; "false" -> false; "0" -> false; "1" -> true; _ -> throw({error, "invalid value for boolean: " ++ Text}) end; float -> list_to_float(Text); qname -> %% qname has form prefix:localname (or, if there is no prefix: localname) %% split the two parts, look up the prefix to find the uri, and put it into %% a qname record {localname, URI, prefix} (URI = undefined if there was no prefix) {Prefix, LocalName} = splitOnColon(Text), case lists:keysearch(Prefix, 3, Namespaces) of {value, #ns{uri = URI}} -> %% this is namespace qualified - now see whether a mapping applies case lists:keysearch(URI, 2, NamespaceMapping) of {value, #ns{prefix = MappedPrefix}} -> #qname{localPart = LocalName, uri = URI, prefix = Prefix, mappedPrefix = MappedPrefix}; _Else -> #qname{localPart = LocalName, uri = URI, prefix = Prefix, mappedPrefix = Prefix} end; _Else -> if Prefix == [] -> %% no prefix, no default namespace #qname{localPart = Text}; Prefix == "xml" -> %% by convention #qname{localPart = LocalName, uri = "http://www.w3.org/XML/1998/namespace", prefix = Prefix, mappedPrefix = Prefix}; true -> throw({error, "Invalid Qname: " ++ Text}) end end end. %% Tree is a data structure used to find out the relations between types. %% It is actually a forest, in the sense that there doesn't have to be %% a unique root. newTree() -> []. addTreeElement(Child, Parent, Tree) -> [{Child, Parent} | Tree]. %% find out whether Ancestor is really an Ancestor of Element. isAncestor(Element, Element, _Tree) -> true; %% added because of problem reported by Stu isAncestor(Ancestor, Element, Tree) -> case lists:keysearch(Element, 1, Tree) of {value, {_, Ancestor}} -> true; {value, {_, Parent} = Elem} -> %% remove the element, just to be sure that we don't end up in an %% endless loop. isAncestor(Ancestor, Parent, lists:delete(Elem, Tree)); _ -> false end. %% get the ancestor of this type (if any) getAncestor(Element, Tree) -> case lists:keysearch(Element, 1, Tree) of {value, {_, Ancestor}} -> {value, Ancestor}; _ -> false end. %% get all leaves (non-abstract types) of node (abstract type) getLeaves(Node, Tree) -> Children = [Child || {Child, N} <- Tree, N == Node], getLeaves(Children, [], Tree). getLeaves([], Leaves, _) -> Leaves; getLeaves([Node | T], Leaves, Tree) -> Children = [Child || {Child, N} <- Tree, N == Node], %% if Node has no children, it is a leave. case Children of [] -> getLeaves(T, [Node | Leaves], Tree); _ -> %% If Node does have children, go one level deeper %% Delete (one instance..) of Node from the tree, to prevent %% endless looping getLeaves(Children ++ T, Leaves, lists:keydelete(Node, 2, Tree)) end. %% get all descendants of Node getDescendants(Node, Tree) -> Children = [Child || {Child, N} <- Tree, N == Node], getDescendants(Children, Children, Tree). getDescendants([], Descendants, _) -> Descendants; getDescendants([Node | T], Descendants, Tree) -> Children = [Child || {Child, N} <- Tree, N == Node], %% if Node has no children, it is a leave. case Children of [] -> getDescendants(T, Descendants, Tree); _ -> %% If Node does have children, go one level deeper %% Delete (one instance..) of Node from the tree, to prevent %% endless looping getDescendants(Children ++ T, Children ++ Descendants, lists:keydelete(Node, 2, Tree)) end. minMax(undefined) -> 1; minMax("unbounded") -> unbound; minMax(Integer) -> list_to_integer(Integer). multMinMax(0, _) -> 0; multMinMax(_, 0) -> 0; multMinMax(unbound, _) -> unbound; multMinMax(_, unbound) -> unbound; multMinMax(A, B) -> A * B. %% returns the URI that belongs to a tag. %% tag is an atom 'ppp:llll' or 'llll' (ppp = prefix, llll = local name) %% namespaces is [#ns{prefix, uri}] tagNamespace(Tag, Namespaces) -> tagNamespace(atom_to_list(Tag), [], Namespaces). tagNamespace([$: | _Tail], Acc, Namespaces) -> case lists:keysearch(lists:reverse(Acc), #ns.prefix, Namespaces) of {value, #ns{uri = Uri}} -> Uri; _Other -> undefined end; tagNamespace([], _Acc, _Namespaces) -> undefined; tagNamespace([Char | Tail], Acc, Namespaces) -> tagNamespace(Tail, [Char | Acc], Namespaces). nameWithoutPrefix(Name) -> nameWithoutPrefix(Name, []). nameWithoutPrefix([$: | Tail], _Acc) -> Tail; nameWithoutPrefix([Char | Tail], Acc) -> nameWithoutPrefix(Tail, [Char | Acc]); nameWithoutPrefix([], Acc) -> lists:reverse(Acc). translateType(String) -> case String of "integer" -> 'integer'; "int" -> 'integer'; "QName" -> 'qname'; "boolean" -> 'bool'; _Else -> 'char' end. findPrefix(undefined, _Namespaces) -> []; findPrefix(Namespace, Namespaces) -> case lists:keysearch(Namespace, #ns.uri, Namespaces) of {value, #ns{prefix = undefined}} -> ""; {value, #ns{prefix = Prefix}} -> Prefix ++ ":"; _Else -> throw({error, "Namespace not found " ++ Namespace}) end. findPrefix2(undefined, _Namespaces) -> []; findPrefix2(Namespace, Namespaces) -> case lists:keysearch(Namespace, #ns.uri, Namespaces) of {value, #ns{prefix = undefined}} -> ""; {value, #ns{prefix = Prefix}} -> Prefix; _Else -> "P" end. makeTypeName(Name, Prefix) -> TypePrefix = case get(erlsom_typePrefix) of undefined -> ""; Value -> Value end, Prefix ++ TypePrefix ++ Name. makeGroupName(Name, Prefix) -> TypePrefix = case get(erlsom_groupPrefix) of undefined -> ""; Value -> Value end, Prefix ++ TypePrefix ++ Name. makeElementName(Name, Prefix) -> %% TypePrefix = case get(erlsom_elementPrefix) of %% undefined -> ""; %% Value -> Value %% end, Prefix ++ Name. makeTypeName(NameInXsd, ElementFormDefault, Path, Prefix) -> TypePrefix = case get(erlsom_typePrefix) of undefined -> ""; Value -> Value end, makeName(NameInXsd, ElementFormDefault, TypePrefix ++ Path, Prefix). makeName(NameInXsd, _ElementFormDefault = "qualified", Path, Prefix) -> Prefix ++ Path ++ NameInXsd; makeName(NameInXsd, _ElementFormDefault, Path, _Prefix) -> Path ++ NameInXsd. %% -record(schemaInfo, {targetNamespace, elementFormDefault, namespacePrefix, namespaces}). makeName(NameInXsd, #schemaInfo{elementFormDefault="qualified", targetNamespace=TNS, namespaces=NS, path=Path}) -> %% find the target namespace in NS, %% add the prefix and the path case NameInXsd of _ -> ok end, case lists:keysearch(TNS, 2, NS) of {value, #ns{prefix = undefined}} -> Path ++ NameInXsd; {value, #ns{prefix = Prefix}} -> Prefix ++ ":" ++ Path ++ NameInXsd; _Else -> if TNS == undefined -> Path ++ NameInXsd; true -> throw({error, "Namespace not found " ++ NameInXsd}) end end; makeName(NameInXsd, #schemaInfo{targetNamespace=TNS, namespaces=NS, path=[]}) -> %% elementFormDefault = unqualified (or undefined) %% since Path = [], this is a global element,and we need to add the prefix. case lists:keysearch(TNS, 2, NS) of {value, #ns{prefix = undefined}} -> NameInXsd; {value, #ns{prefix = Prefix}} -> Prefix ++ ":" ++ NameInXsd; _Else -> if TNS == undefined -> NameInXsd; true -> throw({error, "Namespace not found " ++ NameInXsd}) end end; makeName(NameInXsd, #schemaInfo{targetNamespace=TNS, namespaces=NS, path=Path}) -> %% elementFormDefault = unqualified (or undefined) %% since Path /= [], this is a local element,and we need to add the prefix and the path. case lists:keysearch(TNS, 2, NS) of {value, #ns{prefix = undefined}} -> NameInXsd; {value, #ns{prefix = Prefix}} -> Prefix ++ ":" ++ Path ++ NameInXsd; _Else -> if TNS == undefined -> Path ++ NameInXsd; true -> throw({error, "Namespace not found " ++ NameInXsd}) end end. %% -record(schemaInfo, {targetNamespace, elementFormDefault, namespacePrefix, namespaces}). makeAttrName(NameInXsd, _Info) -> NameInXsd. makeTypeRefAtom(Qname, Namespaces) -> TypeRef = makeTypeRef(Qname, Namespaces), case TypeRef of {_, _} -> TypeRef; _ -> list_to_atom(TypeRef) end. %% makeTypeRef creates a reference to a type. This can either be a type %% defined in the XSD (or an imorted XSD), or a predefined type (like %% xsd:string). %% For the predefined types special codes are returned ({'#PCDATA', ...}). %% input is a qname. %% The output includes the prefix (as found in the Namespaces list), unless the %% type is not in a particular namespace. %% If a special prefix was defined for types, this prefix is also added (after %% the namespace prefix. So the result could be P:t#MyType, for example. %% The 'type-prefix' is taken from a proces-variable (not very nice, sorry). %% TODO: should return an atom (or {'PCDATA', ...})? makeTypeRef(undefined, _) -> %% the 'ur-type': any type (and any attibute). {'#PCDATA', 'char'}; makeTypeRef(Qname = #qname{uri = NS, localPart = Local}, Namespaces) -> TypePrefix = case get(erlsom_typePrefix) of undefined -> ""; Value -> Value end, case NS of "http://www.w3.org/2001/XMLSchema" -> {'#PCDATA', translateType(Local)}; _Else -> makeRef(Qname, Namespaces, TypePrefix) end. makeElementRef(Qname, Namespaces) -> %% ElementPrefix = case get(erlsom_elementPrefix) of %% undefined -> ""; %% Value -> Value %% end, makeRef(Qname, Namespaces, ""). makeGroupRef(Qname, Namespaces) -> GroupPrefix = case get(erlsom_groupPrefix) of undefined -> ""; Value -> Value end, makeRef(Qname, Namespaces, GroupPrefix). makeAttrRef(QName, Namespaces) -> makeRef(QName, Namespaces, ""). makeTagFromRef(QName, Namespaces) -> makeRef(QName, Namespaces, ""). %% ExtraPrefix is the additional prefix to distinguish %% types, groups and elements makeRef(#qname{uri = NS, localPart = Local}, Namespaces, ExtraPrefix) -> case lists:keysearch(NS, 2, Namespaces) of {value, #ns{prefix = undefined}} -> ExtraPrefix ++ Local; %% undefined ~~ "" {value, #ns{prefix = ""}} -> ExtraPrefix ++ Local; {value, #ns{prefix = Prefix}} -> Prefix ++ ":" ++ ExtraPrefix ++ Local; _ -> if NS == undefined -> ExtraPrefix ++ Local; true -> case {NS, Local} of %% weird cases {"http://www.w3.org/XML/1998/namespace", "lang"} -> "xml:lang"; {"http://www.w3.org/XML/1998/namespace", "space"} -> "xml:space"; _ -> throw({error, "Namespace not found " ++ NS}) end end end. makeTag(NameInXsd, Prefix, _ElementFormDefault = "qualified") -> Prefix ++ NameInXsd; makeTag(NameInXsd, _Prefix, _ElementFormDefault) -> NameInXsd. makeTag(NameInXsd, #schemaInfo{targetNamespace=undefined}) -> NameInXsd; makeTag(NameInXsd, #schemaInfo{elementFormDefault="qualified", targetNamespace=TNS, namespaces=NS}) -> %% find the target namespace in NS, %% add the prefix. case lists:keysearch(TNS, 2, NS) of {value, #ns{prefix = undefined}} -> NameInXsd; {value, #ns{prefix = Prefix}} -> Prefix ++ ":" ++ NameInXsd; _Else -> if TNS == undefined -> NameInXsd; true -> throw({error, "Namespace not found " ++ TNS}) end end; makeTag(NameInXsd, _SchemaInfo) -> %% defaultElementForm = unqualified, do not add the prefix (TODO: exept for global elements and types). NameInXsd. listLength(undefined) -> 0; listLength(List) -> length(List). toUnicode(Bin) -> autodetect(Bin). findType(TypeReference, Types, Attributes, TypeHierarchy, Namespaces, NamespaceMapping) -> case lists:keysearch(TypeReference, #type.nm, Types) of {value, Value} -> case findXsiType(Attributes) of {value, XsiType} -> findDerivedType(TypeReference, XsiType, Types, TypeHierarchy, Namespaces, NamespaceMapping); _ -> Value end; _Else -> throw({error, "Type not found: " ++ atom_to_list(TypeReference)}) end. findXsiType([]) -> false; findXsiType([#attribute{localName= "type", uri = "http://www.w3.org/2001/XMLSchema-instance", value = Value}| _Tail]) -> {value, Value}; findXsiType([_| Tail]) -> findXsiType(Tail). findDerivedType(Type, XsiType, Types, TypeHierarchy, Namespaces, NamespaceMapping) -> #qname{localPart = LocalName, mappedPrefix = MappedPrefix} = convertPCData(XsiType, qname, Namespaces, NamespaceMapping), XsiTypeMapped = list_to_atom(makeTypeName(LocalName, case MappedPrefix of undefined -> ""; _ -> MappedPrefix ++ ":" end)), case isAncestor(Type, XsiTypeMapped, TypeHierarchy) of false -> throw({error, "Type not found in hierarchy: " ++ atom_to_list(Type)}); _ -> case lists:keysearch(XsiTypeMapped, #type.nm, Types) of {value, Value} -> Value; _ -> throw({error, "Derived type not found: " ++ atom_to_list(Type)}) end end. autodetect(Input) -> case detectEncoding(Input) of ucs4be -> xmerl_ucs:from_ucs4be(Input); ucs4le -> xmerl_ucs:from_ucs4le(Input); utf16be -> {Result, []} = erlsom_ucs:from_utf16be(Input), Result; utf16le -> {Result, []} = erlsom_ucs:from_utf16le(Input), Result; utf8 -> {Result, []} = erlsom_ucs:from_utf8(Input), Result; iso_8859_1 -> binary_to_list(Input) end. %% CFun = {ContinuationFunction, ContinuationState} (or undefined) detectEncoding(Xml, _CFun, CState) when is_list(Xml) -> {list, Xml, CState}; detectEncoding(Xml, CFun, CState) when is_binary(Xml) -> case Xml of <<>> -> case CFun(Xml, CState) of {<<>>, _} -> throw({error, "empty document"}); {Xml2, State2} -> {detectEncoding(Xml2), Xml2, State2} end; _ -> {detectEncoding(Xml), Xml, CState} end. %%------------------------------------------------------------------------------ %% This was copied from xmerl_lib (by Ulf Wiger), but modified to work %% on binaries in stead of lists. I also removed the option to specify %% a character set - the function only looks at the first 2 or 4 bytes. %% Finally, I changed it to not remove the byte order mark (since %% erlsom has no problem with the byte order mark). %% %% Auto detect what kind of character set we are dealing with and transform %% to Erlang integer Unicode format if found. %% Appendix F, Page 56-57, XML 1.0 W3C Recommendation 6 October 2000 %% (http://www.w3.org/TR/REC-xml) %% 00 00 00 3C ( "<" in UCS-4 big-endian) %% 3C 00 00 00 ( "<" in UCS-4 little-endian) %% FE FF (UTF-16 - big-endian Mark) %% FF FE (UTF-16 - little-endian Mark) %% 00 3C 00 3F ( " detect_encoding(list_to_binary(List)); detect_encoding(Xml) -> {detectEncoding(Xml), Xml}. %% This is the internal version %% the version detect_encoding() is there for reasons of backward %% compatibility detectEncoding(<<0,0,16#fe,16#ff, _Rest/binary>>) -> ucs4be; detectEncoding(<<16#ff,16#fe,0,0, _Rest/binary>>) -> ucs4le; detectEncoding(<<16#fe,16#ff, _Rest/binary>>) -> utf16be; detectEncoding(<<16#ff,16#fe, _Rest/binary>>) -> utf16le; detectEncoding(<<16#ef,16#bb,16#bf, _Rest/binary>>) -> utf8; %%% --- Without byte-order mark detectEncoding(<<0,0,0,16#3c, _Rest/binary>>) -> ucs4be; detectEncoding(<<16#3c,0,0,0, _Rest/binary>>) -> ucs4le; detectEncoding(<<0,16#3c,0,16#3f, _Rest/binary>>) -> utf16be; detectEncoding(<<16#3c,0,16#3f,0, _Rest/binary>>) -> utf16le; %% based on a suggestion by Tobbe: detectEncoding(<<$<,$?,$x,$m,$l, _Rest/binary>> = Content) -> detect_encoding2(Content); detectEncoding(_Input) -> %% debug("unknown encoding? Assume UTF-8"), utf8. detect_encoding2(<>) -> Variables = parse_prolog(binary_to_list(First100)), detect_encoding3(Variables); detect_encoding2(Content) -> %% < 100 characters in the XML Variables = parse_prolog(binary_to_list(Content)), detect_encoding3(Variables). detect_encoding3(Variables) -> case lists:keysearch("encoding", 1, Variables) of {value, {_, Encoding}} -> case encoding_type(Encoding) of 'utf-8' -> utf8; 'iso-8859-1' -> iso_8859_1; 'iso-8859-15' -> iso_8859_15; _ -> throw({error, "Encoding " ++ Encoding ++ " not supported"}) end; _ -> utf8 end. encoding_type(Cs) when is_list(Cs) -> case to_lower(Cs) of "iso-8859-1" -> 'iso-8859-1'; "iso_8859_1" -> 'iso-8859-1'; "iso_8859-1" -> 'iso-8859-1'; "iso8859-1" -> 'iso-8859-1'; "iso-8859-15" -> 'iso-8859-15'; "iso_8859_15" -> 'iso-8859-15'; "iso_8859-15" -> 'iso-8859-15'; "iso8859-15" -> 'iso-8859-15'; "utf-8" -> 'utf-8'; "utf_8" -> 'utf-8'; _ -> false end. to_lower(Str) when is_list(Str) -> [to_lower(C) || C <- Str]; to_lower(C) when C >= $A, C =< $Z -> C+($a-$A); to_lower(C) -> C. %% end of the code based on Tobbes code %% some code to parse the XML prolog. %% returns a list of tuples {variable, value} %% %% gives [{"version", "1.0"}, {"encoding", "utf-9"}] parse_prolog(" parse_variables(Tail, []); parse_prolog(_) -> []. parse_variables([], _Acc) -> %% error, but never mind []; parse_variables("?>" ++ _, Acc) -> Acc; parse_variables(T = [X | Tail], Acc) -> case typeOfMarkupChar(X) of namestartchar -> parse_variable(T, [], Acc); whitespace -> parse_variables(Tail, Acc); _ -> [] end. parse_variable([X| Tail], NameAcc, Acc) -> case typeOfNameChar(X) of namechar -> parse_variable(Tail, [X | NameAcc], Acc); whitespace -> parse_variable_is(Tail, lists:reverse(NameAcc), Acc); equalsign -> parse_to_quote(Tail, lists:reverse(NameAcc), Acc); _ -> [] end. parse_variable_is([X | Tail], Name, Acc) -> case typeOfNameChar(X) of whitespace -> parse_variable_is(Tail, Name, Acc); equalsign -> parse_to_quote(Tail, Name, Acc); _ -> [] end. parse_to_quote([X|Tail], Name, Acc) -> case typeOfMarkupChar(X) of whitespace -> parse_to_quote(Tail, Name, Acc); quote -> parse_value(Tail, [], Name, X, Acc); _ -> [] end. parse_value([Quote|Tail], ValueAcc, Name, Quote, Acc) -> parse_variables(Tail, [{Name, lists:reverse(ValueAcc)} | Acc]); parse_value([X|Tail], ValueAcc, Name, Quote, Acc) -> parse_value(Tail, [X | ValueAcc], Name, Quote, Acc); parse_value([], _ValueAcc, _Name, _Quote, _Acc) -> []. findFile(Namespace, Location, IncludeFiles, IncludeDirs) -> case lists:keysearch(Namespace, 1, IncludeFiles) of {value, {_, Prefix, Schema = #schemaType{}}} -> {Schema, Prefix}; {value, {_, Prefix, undefined}} -> {getFile(Location, IncludeDirs), Prefix}; {value, {_, Prefix, FileName}} -> {getFile(FileName, IncludeDirs), Prefix}; _ -> {getFile(Location, IncludeDirs), undefined} end. getFile("https://"++_ = URL, _) -> case httpc:request(URL) of {ok,{{_HTTP,200,_OK}, _Headers, Body}} -> toUnicode(Body); {ok,{{_HTTP,RC,Emsg}, _Headers, _Body}} -> error_logger:error_msg("~p: http-request got: ~p~n", [?MODULE, {RC, Emsg}]), {error, "failed to retrieve: "++URL}; {error, Reason} -> error_logger:error_msg("~p: http-request failed: ~p~n", [?MODULE, Reason]), {error, "failed to retrieve: "++URL} end; getFile(Location, IncludeDirs) -> case filelib:is_file(Location) of true -> readImportFile(Location); _ -> %% debug(IncludeDirs), findFileInDirs(Location, IncludeDirs) end. findFileInDirs(undefined, []) -> throw({error, "Include file not found (undefined)"}); findFileInDirs(Location, []) -> throw({error, "Include file not found " ++ Location}); findFileInDirs(Location, [H | T]) -> Name = filename:join([H, Location]), case filelib:is_file(Name) of true -> readImportFile(Name); _ -> findFileInDirs(Location, T) end. readImportFile(Name) -> case file:read_file(Name) of {ok, Bin} -> toUnicode(Bin); Error -> throw({error, lists:flatten(io_lib:format("Error reading include file ~p - ~p", [Name, Error]))}) end. %% Include_fun is a function that finds the files that are included or imported in %% the XSD. It should be a function that takes 4 arguments: %% - Namespace (from the XSD). This is a string or 'undefined' %% - SchemaLocation (from the XSD). This is a string or 'undefined' %% - Include_dirs. This is the value of the Include_dirs option if this option %% was passed to compile_xsd(); 'undefined' otherwise. %% - Inlcude_list. This is the value of the Include_list option if this %% option was passed to compile_xsd(); 'undefined' otherwise. %% %% Include_fun should return {XSD, Prefix}, where XSD is a XSD = string(), Prefix %% = string or 'undefined', see above. find_xsd(Namespace, Location, Include_dirs, Include_list) -> case get_url(Location) of {ok, Body} -> Prefix = prefix(Namespace), {Body, Prefix}; _ -> erlsom_lib:findFile(Namespace, Location, Include_dirs, Include_list) end. prefix(Namespace) -> Tokens = string:tokens(Namespace, "/ "), string:substr(lists:last(Tokens), 1, 5). %%% -------------------------------------------------------------------- %%% Get a file from an URL spec. %%% function created by Tobbe, copied from yaws_soap_lib %%% slightly modified %%% -------------------------------------------------------------------- get_url("http://"++_ = URL) -> case httpc:request(URL) of {ok, {{_HTTP, 200, _OK}, _Headers, Body}} -> case http_uri:parse(URL) of {ok, {_Method, _, _Host, _Port, _Path, _Qargs}} -> {ok, Body}; _ -> {error, "failed to retrieve: "++URL} end; _Error -> {error, "failed to retrieve: "++URL} end; get_url(_) -> {error, "not a URL"}. emptyListIfUndefined(undefined) -> []; emptyListIfUndefined(List) -> List. %% Note: initially there can be more than 1 element in the list with the same name (an element and a type). %% We are looking for the type. searchBase(_Name, []) -> not_found; searchBase(Name, [H = #typeInfo{typeName = Name, typeType = TypeT} | _]) when TypeT /= globalElementRefOnly -> {value, H}; searchBase(Name, [_H | T]) -> searchBase(Name, T). %% Context can be: %% name, markup %% Returns: %% whitespace, lessthan, morethan, etc, see below. typeOfNameChar(Char) -> if Char > 96 -> if Char < 123 -> namechar; Char < 127 -> char; true -> illegal end; Char > 64 -> if Char < 91 -> namechar; Char == 95 -> namechar; true -> char end; Char > 47 -> if Char < 59 -> namechar; Char == 61 -> equalsign; Char == 62 -> morethan; Char == 63 -> questionmark; true -> char end; Char > 32 -> if Char < 40 -> char; Char < 45 -> illegal; Char == 47 -> slash; true -> namechar end; Char == 32 -> whitespace; Char == 9 -> whitespace; Char == 10 -> whitespace; Char == 13 -> whitespace; true -> illegal end. %% Context can be: %% name, markup %% Returns: %% whitespace, lessthan, morethan, etc, see below. typeOfMarkupChar(Char) -> if Char == 32 -> whitespace; Char > 96 -> if Char < 123 -> namestartchar; Char < 127 -> char; true -> illegal end; Char > 64 -> if Char < 91 -> namestartchar; Char == 95 -> namestartchar; true -> char end; Char > 40 -> if Char == 47 -> slash; Char < 60 -> char; Char == 60 -> lessthan; Char == 61 -> equalsign; Char == 62 -> morethan; true -> char end; Char > 32 -> if Char == 39 -> quote; Char == 34 -> quote; Char == 38 -> ampersand; true -> char end; Char == 9 -> whitespace; Char == 10 -> whitespace; Char == 13 -> whitespace; true -> illegal end. %%% hides the definition of #qname{} makeQname(LocalName) -> #qname{localPart = LocalName}. %%% hides the definition of #qname{} localName(#qname{localPart = LocalName}) -> LocalName. %%% hides the definition of #schemaType{} getTargetNamespaceFromXsd(#schemaType{targetNamespace = TNS}) -> TNS. %% this is a hack, see erlsom_compile %% remove the type-prefix from the name removePrefixes(Name) -> {Prefix, LocalName} = splitOnColon(Name), %% now remove the typePrefix (if it exists) TypePrefix = case get(erlsom_typePrefix) of undefined -> ""; Value -> Value end, {_, WithoutTypePrefix} = lists:split(length(TypePrefix), LocalName), case Prefix of [] -> WithoutTypePrefix; _ -> Prefix ++ ":" ++ WithoutTypePrefix end. %% returns {Prefix, LocalName} splitOnColon(Text) -> PosOfColon = string:chr(Text, $:), if PosOfColon == 0 -> {[], Text}; true -> {string:substr(Text, 1, PosOfColon - 1), string:substr(Text, PosOfColon + 1)} end. %%---------------------------------------------------------------------- %% function : unique/1 %% Arguments: List - [term()] %% Returns : [term()] %% Exception: %% Effect : Remove all duplicates from the list. %%---------------------------------------------------------------------- unique([]) -> []; unique(List) -> Sorted = lists:sort(List), unique(hd(Sorted), tl(Sorted), []). unique(A, [A|R], Acc) -> unique(A, R, Acc); unique(A, [B|R], Acc) -> unique(B, R, [A|Acc]); unique(A, [], Acc) -> lists:reverse([A|Acc]).