/*
-----------------------------------------------------------------------------
This source file is part of OpenSpace3D
For the latest info, see http://www.openspace3d.com
Copyright (c) 2012 I-maginer
This program 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 2 of the License, or (at your option) any later
version.
This program 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
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA 02111-1307, USA, or go to
http://www.gnu.org/copyleft/lesser.txt
-----------------------------------------------------------------------------
*/
/**************************************************
XML parser library
Version: 1.0
Author: Bastien BOURINEAU / I-maginer
Last update: 03.03.2009
**************************************************/
/*! @defgroup xmlLib OpenSpace3D high level xml parser
* OpenSpace3D high level xml parser
* @{
*/
/** @} */
var iXMLdebug = 0;;
// - Structure of XML file -
struct XMLfile =
[
XMLobj : ObjSXML,
XMLpath : S,
XMLtype : S,
XMLmarks : [XMLmark r1],
XMLidref : I
] mkXMLfile;;
// - Structure of XML marks -
struct XMLmark =
[
XMLid : I,
XMLvalue : S,
XMLparams : [[S S] r1],
XMLdata : S,
XMLfather : XMLmark,
XMLsons : [XMLmark r1]
] mkXMLmark;;
fun XMLlcat (p, q)=
if p==nil
then
q
else let p -> [h nxt] in
h::XMLlcat nxt q;;
fun XMLcomp(m1, m2)= (strcmp m1.XMLvalue m2.XMLvalue) < 0;;
fun XMLlExtractList(list, e, func)=
if list == nil then
[nil nil]
else
let list -> [a n] in
let XMLlExtractList n e func -> [left right] in
if exec func with [a e] then
[a :: left right]
else
[left a :: right];;
fun XMLlSortList(l, f)=
if l == nil then
nil
else
let l -> [a n] in
let XMLlExtractList n a f -> [left right] in
XMLlcat (XMLlSortList left f) a :: (XMLlSortList right f);;
// since scol tuple management are "special" we add to copy all values
fun XMLcopyParams(l)=
let nil -> newl in
(
let sizelist l -> size in
while size > 0 do
(
let nth_list l (size -1) -> [n p] in
set newl = [n p]::newl;
set size = size -1;
);
newl;
);;
fun XMLremove_mark_list (l, elt)=
if l==nil
then
nil
else
if (hd l) == elt
then
tl l
else
(hd l)::XMLremove_mark_list tl l elt;;
/*! @ingroup xmlLib
* \brief Convert a float value to a short string
*
* Prototype: fun [F] S
*
* \param F : float value
*
* \return S : short string
**/
fun XMLgetShortFloatToString(float)= if (absf float) >. (itof (ftoi absf float)) then (ftoa float) else strcat (itoa (ftoi float)) ".0";;
/*! @ingroup xmlLib
* \brief Convert a float value to a short string with a number of decimal
*
* Prototype: fun [F I] S
*
* \param F : float value
* \param F : number of decimal
*
* \return S : short string
**/
fun XMLgetShortFloatToStringLength(float, nb)=
let if float == nil then 0.0 else float -> float in
let ftoa float -> sf in
let if nb == 0 || nb == nil then 0 else 1 + nb -> nb0 in
substr sf 0 ((strfind "." sf 0) + nb0);;
//
//ctoa 60 // <
//ctoa 62 // >
//ctoa 47 // /
fun XMLgetBoolValue(str, def)=
if str == nil then def else
if (!strcmpi strtrim str "ON") || (!strcmpi strtrim str "true") || (!strcmpi strtrim str "yes") || ((atoi str) == 1) then 1 else 0;;
/*! @ingroup xmlLib
* \brief Get the boolean value of a string
*
* Prototype: fun [S] I
*
* \param S : the boolean value "enable" "1" "on" "true" "yes"
*
* \return I : 1 if the boolean value is correct, 0 otherwise
**/
fun XMLgetBoolParam(markstr, name)=
let switchstr markstr.XMLparams name -> str in
XMLgetBoolValue str 0;;
/*! @ingroup xmlLib
* \brief Get a string boolean value
*
* Prototype: fun [I] S
*
* \param I : the boolean value
*
* \return S : "true" or "false"
**/
fun XMLgetBoolString(b)=
if b then "true" else "false";;
fun XMLmoveMarkSons(markstr, pos, to)=
set markstr.XMLsons = moveListElement markstr.XMLsons pos to;
0;;
/*! @ingroup xmlLib
* \brief Get the data of a mark node
*
* Prototype: fun [XMLmark] S
*
* \param XMLmark : the mark node
*
* \return S : the data
**/
fun XMLgetData(markstr)= markstr.XMLdata;;
/*! @ingroup xmlLib
* \brief Set the data of a mark node
*
* Prototype: fun [XMLmark S] S
*
* \param XMLmark : the mark node
* \param S : the new data
*
* \return S : the new data
**/
fun XMLsetData(markstr, data)= set markstr.XMLdata = data;;
/*! @ingroup xmlLib
* \brief Get an attribute value of a mark node
*
* Prototype: fun [XMLmark S] S
*
* \param XMLmark : the mark node
* \param S : the attribute name
*
* \return S : the attribute value
**/
fun XMLgetParam(markstr, name)= switchstr markstr.XMLparams name;;
/*! @ingroup xmlLib
* \brief Set an attribute value of a mark node
*
* Prototype: fun [XMLmark S S] I
*
* \param XMLmark : the mark node
* \param S : the attribute name
* \param S : the attribute value
*
* \return 0
**/
fun XMLsetParam(markstr, name, val)=
let 0 -> found in
(
let sizelist markstr.XMLparams -> size in
let 0 -> i in
while (i < size) && !found do
(
let nth_list markstr.XMLparams i -> param in
let param -> [pname pval] in
if strcmp pname name then nil else
(
mutate param <- [_ (strtrim val)];
set found = 1;
);
set i = i + 1;
);
// add the new param if not exist
if found then nil else
set markstr.XMLparams = XMLlcat markstr.XMLparams [name (strtrim val)]::nil;
);
0;;
// TODO test also if the current mark have the same mark name with
fun XMLgetEndMarkPos(fcont, iemark, sncmark)=
let iemark - 1 -> i in
let iemark - 1 -> i2 in
let nil -> find in
let 1 -> nbfind in
(
while (i != nil) && (find == nil) do
(
let strfindi strcatn (ctoa 60)::sncmark::" "::nil fcont i + 1 -> ismark in
//let if !strcmpi strcatn (ctoa 47)::(ctoa 62)::nil (substr fcont i + 1 2) then 1 else 0 -> noendmark in
let strfindi strcatn (ctoa 60)::(ctoa 47)::sncmark::(ctoa 62)::nil fcont i2 + 1 -> iclmark in
(
if (((ismark != nil) && (ismark < iclmark))) then // && !noendmark then
set nbfind = nbfind + 1
else
set find = iemark - 1;
set i = ismark;
set i2 = iclmark;
);
);
while (nbfind != 0) do
(
let strfindi strcatn (ctoa 60)::(ctoa 47)::sncmark::(ctoa 62)::nil fcont find + 1 -> iclmark in
(
set find = iclmark;
set nbfind = nbfind - 1;
);
);
find;
);;
fun XMLfindMark(mcont, pos)=
// find the "<" character
let strfind (ctoa 60) mcont pos -> markpos in
let (nth_char mcont markpos + 1) == 33 && (nth_char mcont markpos + 2) == 45 -> iscomment in
let (nth_char mcont markpos + 1) == 33 -> isdoctype in
let !strcmpi (substr mcont markpos 5) " ismeta in
let !strcmpi (substr mcont markpos 5) " isbase in
let !strcmpi (substr mcont markpos 3) "
isbr in
// if it is a comment "" we search the next mark after the comment end
if iscomment then XMLfindMark mcont (strfind (ctoa 60) mcont (strfind "-->" mcont markpos + 1)) else
if isdoctype || isbase || ismeta || isbr then XMLfindMark mcont (strfind (ctoa 60) mcont (strfind ">" mcont markpos + 1)) else
(
while (((strfind " ismark in
let strfind ctoa 62 fcont ismark -> iemark in
let substr fcont (ismark + 1) ((iemark - ismark) - 1) -> snmark in
let strfind " " snmark 0 -> haveparam in
let if haveparam != nil then substr snmark 0 haveparam else snmark -> sncmark in
let if (!strcmpi strcatn (ctoa 47)::(ctoa 62)::nil (substr fcont (iemark -1) 2)) || (!strcmpi strcatn "?"::(ctoa 62)::nil (substr fcont (iemark -1) 2)) then 1 else 0 -> noendmark in
let if noendmark then (iemark + 1) else XMLgetEndMarkPos fcont iemark sncmark -> iclmark in
let substr fcont (iemark + 1) ((iclmark - iemark) - 1) -> mcont in
let mkXMLmark [(set xmlfilestr.XMLidref = xmlfilestr.XMLidref + 1) sncmark nil nil father nil] -> markstr in
(
if haveparam == nil then nil else
(
if !iXMLdebug then nil else
_fooS strcat "XMLPARSER DEBUG : Mark found > " sncmark;
while haveparam != nil do
(
let strfind "=" snmark haveparam -> ppos in
let substr snmark (ppos + 1) 1 -> psep in
let substr snmark (haveparam + 1) ((ppos - haveparam) - 1) -> pname in
let strfind psep snmark ppos -> sppos in
if sppos == nil then
(
set haveparam = nil;
)
else
let strfind psep snmark (sppos + 1) -> eppos in
(
let substr snmark (sppos + 1) ((eppos - sppos) - 1) -> pval in
(
set markstr.XMLparams = [pname (strtrim (webtostr pval))]::markstr.XMLparams;
if !iXMLdebug then nil else
(
_fooS strcat "XMLPARSER DEBUG : Mark param name > " pname;
_fooS strcat "XMLPARSER DEBUG : Mark param value > " (webtostr pval);
);
set haveparam = strfind " " snmark eppos + 1;
);
);
);
set markstr.XMLparams = revertlist markstr.XMLparams;
);
if strfind " firstcdatapos in
let firstcdatapos + 9 -> ncdatapos in
let strfind "]]>" mcont firstcdatapos -> edata in
(
while ((strfind "" mcont edata +3;
);
let substr mcont firstcdatapos+9 (edata - (9 + firstcdatapos)) -> data in
set markstr.XMLdata = if (strlen data) == 0 then nil else data;
set mcont = substr mcont edata + 3 ((strlen mcont) - (edata + 3));
if !iXMLdebug then nil else
_fooS strcat "XMLPARSER DEBUG : Mark newdata > " markstr.XMLdata;
);
let XMLfindMark mcont 0 -> i in
if (i != nil) then
(
while i != nil do
(
let (XMLgetMark xmlfilestr markstr mcont i) -> [nmark epos] in
(
set markstr.XMLsons = nmark::markstr.XMLsons;
set i = XMLfindMark mcont epos;
);
);
set markstr.XMLsons = revertlist markstr.XMLsons;
0;
)
else if markstr.XMLdata != nil then nil else
(
set markstr.XMLdata = if (strlen mcont) == 0 then nil else mcont;
0;
);
if !iXMLdebug then nil else
_fooS strcatn "XMLPARSER DEBUG : Mark value > "::sncmark::" > "::markstr.XMLdata::nil;
[markstr (if noendmark then iclmark else (iclmark + (strlen (strcatn (ctoa 60)::(ctoa 47)::sncmark::(ctoa 62)::nil))))];
);;
fun XMLparse(xmlfilestr, fcont)=
let nil -> lmarkstr in
let strfind ctoa 60 fcont 0 -> i in
if (i != nil) then
(
while i != nil do
(
let (XMLgetMark xmlfilestr nil fcont i) -> [nmark epos] in
(
set lmarkstr = nmark::lmarkstr;
set i = strfind ctoa 60 fcont epos + 1;
);
);
revertlist lmarkstr;
)
else
lmarkstr;;
fun XMLtoParams(p)=
if p == nil then nil else
let hd p -> param in
let param -> [name value] in
(
mutate param <- [_ webtostr value];
XMLtoParams tl p;
);
0;;
fun XMLtoChilds(xmlfilestr, fnode, fatherstr)=
let nil -> lmarkstr in
let _GetXmlNodeChilds fnode -> lchild in
while lchild != nil do
(
let hd lchild -> node in
let _GetXmlNodeValue node -> nvalue in
let _GetXmlNodeAttributes node -> lattrib in
let _GetXmlNodeContent node -> content in
let mkXMLmark [(set xmlfilestr.XMLidref = xmlfilestr.XMLidref + 1) nvalue lattrib content fatherstr nil] -> childmarkstr in
(
XMLtoParams childmarkstr.XMLparams;
XMLtoChilds xmlfilestr node childmarkstr;
set fatherstr.XMLsons = childmarkstr::fatherstr.XMLsons;
set lchild = tl lchild;
);
);
set fatherstr.XMLsons = revertlist fatherstr.XMLsons;;
fun XMLtoMarks(xmlfilestr)=
let nil -> lmarkstr in
(
let _GetXmlRootNodes xmlfilestr.XMLobj -> lroot in
while lroot != nil do
(
let hd lroot -> node in
let _GetXmlNodeValue node -> nvalue in
let _GetXmlNodeAttributes node -> lattrib in
let _GetXmlNodeContent node -> content in
let mkXMLmark [(set xmlfilestr.XMLidref = xmlfilestr.XMLidref + 1) nvalue lattrib content nil nil] -> markstr in
(
XMLtoParams markstr.XMLparams;
XMLtoChilds xmlfilestr node markstr;
set lmarkstr = markstr::lmarkstr;
set lroot = tl lroot;
);
);
revertlist lmarkstr;
);;
fun XMLcountFathers(markstr)=
let 0 -> nb in
(
while markstr.XMLfather != nil do
(
set markstr = markstr.XMLfather;
set nb = nb + 1;
);
nb;
);;
fun XMLgetTabs(markstr)=
let "" -> tabs in
(
let XMLcountFathers markstr -> nb in
let 0 -> i in
while i < nb do
(
set tabs = strcat tabs (ctoa 9);
set i = i + 1;
);
tabs;
);;
fun XMLgetMarksWithIndex(markstr)=
let nil -> ncont in
(
set ncont = strcatn (ctoa 10)::(XMLgetTabs markstr)::"<"::markstr.XMLvalue::nil;
set ncont = strcatn ncont::" "::"markindex"::"=\""::(itoa markstr.XMLid)::"\""::nil;
let sizelist markstr.XMLparams -> size in
let 0 -> i in
while i < size do
(
let nth_list markstr.XMLparams i -> [pname pval] in
set ncont = strcatn ncont::" "::pname::"=\""::(strtrim (strtoweb pval))::"\""::nil;
set i = i + 1;
);
if (markstr.XMLdata == nil) && (markstr.XMLsons == nil) then
set ncont = strcatn ncont::" />"::nil
else if ((strfindi (ctoa 60) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 62) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 38) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 224) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 225) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 226) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 227) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 228) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 229) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 230) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 231) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 232) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 233) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 234) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 235) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 244) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 251) markstr.XMLdata 0) == nil)
then
set ncont = strcatn ncont::">"::markstr.XMLdata::nil
else
set ncont = strcatn ncont::">"::nil;
let sizelist markstr.XMLsons -> size in
let 0 -> i in
while i < size do
(
let nth_list markstr.XMLsons i -> mark in
set ncont = strcat ncont XMLgetMarksWithIndex mark;
set i = i + 1;
);
if (markstr.XMLdata == nil) && (markstr.XMLsons == nil) then
ncont
else if markstr.XMLdata != nil then
set ncont = strcatn ncont::""::markstr.XMLvalue::">"::nil
else
set ncont = strcatn ncont::(ctoa 10)::(XMLgetTabs markstr)::""::markstr.XMLvalue::">"::nil;
);;
fun XMLgetMarks(markstr)=
let nil -> ncont in
(
set ncont = strcatn (ctoa 10)::(XMLgetTabs markstr)::"<"::markstr.XMLvalue::nil;
let sizelist markstr.XMLparams -> size in
let 0 -> i in
while i < size do
(
let nth_list markstr.XMLparams i -> [pname pval] in
set ncont = strcatn ncont::" "::pname::"=\""::(strtrim (strtoweb pval))::"\""::nil;
set i = i + 1;
);
if (markstr.XMLdata == nil) && (markstr.XMLsons == nil) then
set ncont = strcatn ncont::" />"::nil
else if ((strfindi (ctoa 60) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 62) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 38) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 224) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 225) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 226) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 227) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 228) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 229) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 230) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 231) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 232) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 233) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 234) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 235) markstr.XMLdata 0) == nil)
&& ((strfindi (ctoa 244) markstr.XMLdata 0) == nil) && ((strfindi (ctoa 251) markstr.XMLdata 0) == nil)
then
set ncont = strcatn ncont::">"::markstr.XMLdata::nil
else
set ncont = strcatn ncont::">"::nil;
let sizelist markstr.XMLsons -> size in
let 0 -> i in
while i < size do
(
let nth_list markstr.XMLsons i -> mark in
set ncont = strcat ncont XMLgetMarks mark;
set i = i + 1;
);
if (markstr.XMLdata == nil) && (markstr.XMLsons == nil) then
ncont
else if markstr.XMLdata != nil then
set ncont = strcatn ncont::""::markstr.XMLvalue::">"::nil
else
set ncont = strcatn ncont::(ctoa 10)::(XMLgetTabs markstr)::""::markstr.XMLvalue::">"::nil;
);;
fun XMLaddMarkParam(markstr, paramname, value)=
if paramname == nil then nil else
set markstr.XMLparams = XMLlcat markstr.XMLparams [paramname (strtrim value)]::nil;
markstr;;
/*! @ingroup xmlLib
* \brief Add a mark node to an xml structure
*
* Prototype: fun [XMLfile S XMLmark [[S S] r1] S] XMLmark
*
* \param XMLfile : the xml structure
* \param S : the mark node value
* \param XMLmark : the parent mark node
* \param [[S S] r1] : list of [attribute value]
* \param S : mark node data
*
* \return XMLmark : the new mark node
**/
fun XMLaddMark(xmlfilestr, value, father, params, data)=
let mkXMLmark [(set xmlfilestr.XMLidref = xmlfilestr.XMLidref + 1) value nil data father nil] -> markstr in
(
let sizelist params -> size in
let 0 -> i in
while i < size do
(
let nth_list params i -> [pname pval] in
if pname == nil then nil else
set markstr.XMLparams = [pname (strtrim pval)]::markstr.XMLparams;
set i = i + 1;
);
if father == nil then
set xmlfilestr.XMLmarks = XMLlcat xmlfilestr.XMLmarks markstr::nil
else
set father.XMLsons = XMLlcat father.XMLsons markstr::nil;
markstr;
);;
/*! @ingroup xmlLib
* \brief Copy a mark node to an another parent node
*
* Prototype: fun [XMLfile XMLmark XMLmark] XMLmark
*
* \param XMLfile : the xml structure
* \param XMLmark : the mark node to copy
* \param XMLmark : the new parent mark node
*
* \return XMLmark : the new mark node
**/
fun XMLcopyMark(xmlfilestr, srcmarkstr, father)=
let srcmarkstr.XMLvalue -> value in
let XMLcopyParams srcmarkstr.XMLparams -> params in
let srcmarkstr.XMLdata -> data in
let mkXMLmark [(set xmlfilestr.XMLidref = xmlfilestr.XMLidref + 1) value params data father nil] -> markstr in
(
if father == nil then
set xmlfilestr.XMLmarks = XMLlcat xmlfilestr.XMLmarks markstr::nil
else
set father.XMLsons = XMLlcat father.XMLsons markstr::nil;
let sizelist srcmarkstr.XMLsons -> size in
let 0 -> i in
while i < size do
(
let nth_list srcmarkstr.XMLsons i -> son in
XMLcopyMark xmlfilestr son markstr;
set i = i + 1;
);
markstr;
);;
/*! @ingroup xmlLib
* \brief Delete a mark node
*
* Prototype: fun [XMLfile XMLmark] I
*
* \param XMLfile : the xml structure
* \param XMLmark : the mark node to delete
*
* \return 0
**/
fun XMLdelMark(xmlfilestr, markstr)=
if markstr.XMLfather == nil then
set xmlfilestr.XMLmarks = XMLremove_mark_list xmlfilestr.XMLmarks markstr
else
set markstr.XMLfather.XMLsons = XMLremove_mark_list markstr.XMLfather.XMLsons markstr;
0;;
/*! @ingroup xmlLib
* \brief Delete all mark node from value
*
* Prototype: fun [XMLfile markstr S] I
*
* \param XMLfile : the xml structure
* \param XMLmark : the parent mark node
* \param S : the mark node value
*
* \return 0
**/
fun XMLdelMarksFromMarkByValue(xmlfilestr, markstr, value)=
if !strcmpi markstr.XMLvalue value then
XMLdelMark xmlfilestr markstr
else nil;
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
XMLdelMarksFromMarkByValue xmlfilestr mark value;
set l = tl l;
);
0;;
/*! @ingroup xmlLib
* \brief Move a mark node to an another parent node
*
* Prototype: fun [XMLfile XMLmark XMLmark] XMLmark
*
* \param XMLfile : the xml structure
* \param XMLmark : the mark node to copy
* \param XMLmark : the new parent mark node
*
* \return XMLmark : the new mark node
**/
fun XMLmoveMark(xmlfilestr, markstr, fatherstr)=
if markstr.XMLfather == fatherstr then nil else
(
if markstr.XMLfather == nil then
set xmlfilestr.XMLmarks = XMLremove_mark_list xmlfilestr.XMLmarks markstr
else
set markstr.XMLfather.XMLsons = XMLremove_mark_list markstr.XMLfather.XMLsons markstr;
set markstr.XMLfather = fatherstr;
if markstr.XMLfather == nil then
set xmlfilestr.XMLmarks = XMLlcat xmlfilestr.XMLmarks markstr::nil
else
set markstr.XMLfather.XMLsons = XMLlcat markstr.XMLfather.XMLsons markstr::nil;
);
0;;
fun XMLgetMarkByIdFromMark(markstr, id)=
let nil -> fmark in
(
if markstr.XMLid == id then
markstr
else
(
let sizelist markstr.XMLsons -> size in
let 0 -> i in
while i < size && fmark == nil do
(
let nth_list markstr.XMLsons i -> mark in
set fmark = XMLgetMarkByIdFromMark mark id;
set i = i + 1;
);
fmark
);
);;
fun XMLgetMarkById(xmlfilestr, id)=
let nil -> fmark in
(
let sizelist xmlfilestr.XMLmarks -> size in
let 0 -> i in
while i < size && fmark == nil do
(
let nth_list xmlfilestr.XMLmarks i -> mark in
set fmark = XMLgetMarkByIdFromMark mark id;
set i = i + 1;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Search the first mark node with a value from a parent mark node, recursively
*
* Prototype: fun [XMLmark S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValueFromMark(markstr, value)=
let nil -> fmark in
(
if !strcmpi markstr.XMLvalue value then
markstr
else
(
let markstr.XMLsons -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
set fmark = XMLgetMarkByValueFromMark mark value;
set l = tl l;
);
fmark
);
);;
fun XMLgetMarkId(markstr)= markstr.XMLid;;
/*! @ingroup xmlLib
* \brief Search the first mark node with a value from a parent mark node
*
* Prototype: fun [XMLmark S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValueFromMarkSons(markstr, value)=
let nil -> fmark in
(
let markstr.XMLsons -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
if !strcmpi mark.XMLvalue value then
set fmark = mark
else nil;
set l = tl l;
);
fmark
);;
/*! @ingroup xmlLib
* \brief Search the first mark node with a value from xml structure, recursively
*
* Prototype: fun [XMLfile S] XMLmark
*
* \param XMLfile : the xml structure
* \param S : the mark node value to search
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValue(xmlfilestr, value)=
let nil -> fmark in
(
let xmlfilestr.XMLmarks -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
set fmark = XMLgetMarkByValueFromMark mark value;
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Search all marks node with a value from a parent mark node, recursively
*
* Prototype: fun [XMLmark S] [XMLmark r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return [XMLmark r1] : the list of mark node if found, nil otherwise
**/
fun XMLgetMarksByValueFromMark(markstr, value)=
let nil -> fmark in
(
if !strcmpi markstr.XMLvalue value then
set fmark = markstr::nil
else nil;
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
set fmark = XMLlcat fmark (XMLgetMarksByValueFromMark mark value);
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Search all marks node with a value from a parent mark node
*
* Prototype: fun [XMLmark S] [XMLmark r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return [XMLmark r1] : the list of mark node if found, nil otherwise
**/
fun XMLgetMarksByValueFromMarkSons(markstr, value)=
let nil -> fmark in
(
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
if !strcmpi mark.XMLvalue value then
set fmark = mark::fmark
else nil;
set l = tl l;
);
revertlist fmark;
);;
/*! @ingroup xmlLib
* \brief Search all marks node with a list of value from a parent mark node
*
* Prototype: fun [XMLmark [S r1]] [[S [XMLmark r1]] r1]
*
* \param XMLmark : the parent mark node
* \param [S r1] : the mark node values to search
*
* \return [[S [XMLmark r1]] r1] : the list of marks nodes if found, nil otherwise
**/
fun XMLgetMarksByValuesFromMarkSons(markstr, values)=
let nil -> fmarks in
let sizelist values -> nbvals in
let mktab nbvals ["" nil] -> t in
(
//init tab
let 0 -> i in
while (i < nbvals) do
(
set t.(i) = [(nth_list values i) nil];
set i = i + 1;
);
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
let 0 -> found in
let 0 -> i in
while ((i < nbvals) && (!found)) do
(
let t.(i) -> [value pl] in
(
if !strcmpi mark.XMLvalue value then
(
set t.(i) = [value mark::pl];
set found = 1;
)
else nil;
);
set i = i + 1;
);
set l = tl l;
);
let 0 -> i in
while (i < nbvals) do
(
let t.(i) -> [value pl] in
set fmarks = [value revertlist pl]::fmarks;
set i = i + 1;
);
fmarks;
);;
/*! @ingroup xmlLib
* \brief Get all marks node data's with a value from a parent mark node, recursively
*
* Prototype: fun [XMLmark S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return [S r1] : the list of data if found, nil otherwise
**/
fun XMLgetMarksDataByValueFromMark(markstr, value)=
let nil -> ldata in
(
if !strcmpi markstr.XMLvalue value then
set ldata = markstr.XMLdata::nil
else nil;
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
let (XMLgetMarksDataByValueFromMark mark value) -> fmarkstr in
set ldata = XMLlcat ldata fmarkstr;
set l = tl l;
);
ldata;
);;
/*! @ingroup xmlLib
* \brief Get all marks node data's with a value from a parent mark node
*
* Prototype: fun [XMLmark S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
*
* \return [S r1] : the list of data if found, nil otherwise
**/
fun XMLgetMarksDataByValueFromMarkSons(markstr, value)=
let nil -> ldata in
(
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
if !strcmpi mark.XMLvalue value then
set ldata = mark.XMLdata::ldata
else nil;
set l = tl l;
);
revertlist ldata;
);;
/*! @ingroup xmlLib
* \brief Get all marks node attribute value with a node value and an attribute name from a parent mark node
*
* Prototype: fun [XMLmark S S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
* \param S : the attribute name to retrieve
*
* \return [S r1] : the list of attribute values if found, nil otherwise
**/
fun XMLgetMarksParamByValueFromMarkSons(markstr, value, param)=
let nil -> ldata in
(
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
if !strcmpi mark.XMLvalue value then
set ldata = (XMLgetParam mark param)::ldata
else nil;
set l = tl l;
);
revertlist ldata;
);;
/*! @ingroup xmlLib
* \brief Search all marks node with a value from xml structure, recursively
*
* Prototype: fun [XMLfile S] [XMLmark r1]
*
* \param XMLfile : the xml structure
* \param S : the mark node value to search
*
* \return [XMLmark r1] : the list of mark node if found, nil otherwise
**/
fun XMLgetMarksByValue(xmlfilestr, value)=
let nil -> fmark in
(
let xmlfilestr.XMLmarks -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
set fmark = XMLlcat fmark (XMLgetMarksByValueFromMark mark value);
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get all marks node attribute value with an attribute name from a parent mark node, recursively
*
* Prototype: fun [XMLmark S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the attribute name to retrieve
*
* \return [S r1] : the list of attribute values if found, nil otherwise
**/
fun XMLgetMarksParamValueByParamFromMark(markstr, param)=
let nil -> fparams in
(
let XMLgetParam markstr param -> ep in
if ep != nil then
set fparams = ep::nil
else nil;
let markstr.XMLsons -> l in
while (l != nil) do
(
let hd l -> mark in
set fparams = XMLlcat fparams (XMLgetMarksParamValueByParamFromMark mark param);
set l = tl l;
);
fparams
);;
/*! @ingroup xmlLib
* \brief Get all marks node attribute value with a node value and an attribute name from a parent mark node
*
* Prototype: fun [XMLmark S S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
* \param S : the attribute name to retrieve
*
* \return [S r1] : the list of attribute values if found, nil otherwise
**/
fun XMLgetMarksParamValueByValueAndParamFromMarkSons(markstr, value, param)=
let nil -> fparams in
let XMLgetMarksByValueFromMarkSons markstr value -> l in
(
while (l != nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> ep in
if ep == nil then nil else
set fparams = ep::fparams;
set l = tl l;
);
revertlist fparams;
);;
/*! @ingroup xmlLib
* \brief Get all marks node attribute value with a node value and an attribute name from a parent mark node, recursively
*
* Prototype: fun [XMLmark S S] [S r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value to search
* \param S : the attribute name to retrieve
*
* \return [S r1] : the list of attribute values if found, nil otherwise
**/
fun XMLgetMarksParamValueByValueAndParamFromMark(markstr, value, param)=
let nil -> fparams in
let XMLgetMarksByValueFromMark markstr value -> l in
(
while (l != nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> ep in
if ep == nil then nil else
set fparams = ep::fparams;
set l = tl l;
);
revertlist fparams;
);;
/*! @ingroup xmlLib
* \brief Get all marks node attribute value with an attribute name in an xml structure, recursively
*
* Prototype: fun [XMLmark S] [S r1]
*
* \param XMLfile : the xml structure
* \param S : the attribute name to retrieve
*
* \return [S r1] : the list of attribute values if found, nil otherwise
**/
fun XMLgetMarksParamValueByParam(xmlfilestr, param)=
let nil -> fparams in
(
let xmlfilestr.XMLmarks -> l in
while (l != nil) do
(
let hd l -> mark in
set fparams = XMLlcat fparams (XMLgetMarksParamValueByParamFromMark mark param);
set l = tl l;
);
fparams;
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with an attribute name and value from a parent mark node, recursively
*
* Prototype: fun [XMLmark S S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByParamValueFromMark(markstr, param, value)=
let nil -> fmark in
let XMLgetParam markstr param -> pval in
(
if (!strcmp value pval) then
markstr
else
(
let markstr.XMLsons -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
set fmark = XMLgetMarkByParamValueFromMark mark param value;
set l = tl l;
);
fmark
);
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with an attribute name and value from a parent mark node
*
* Prototype: fun [XMLmark S S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByParamValueFromMarkSons(markstr, param, value)=
let nil -> fmark in
let XMLgetParam markstr param -> pval in
(
let markstr.XMLsons -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> nval in
if (strcmp value nval) then nil else
set fmark = mark;
set l = tl l;
);
fmark
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with an attribute name and value in an xml structure
*
* Prototype: fun [XMLfile S S] XMLmark
*
* \param XMLfile : the xml structure
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByParamValue(xmlfilestr, param, value)=
let nil -> fmark in
(
let xmlfilestr.XMLmarks -> l in
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
set fmark = XMLgetMarkByParamValueFromMark mark param value;
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with a value, and attribute name and value in an xml structure, recursively
*
* Prototype: fun [XMLfile S S S] XMLmark
*
* \param XMLfile : the xml structure
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValueAndParamValue(xmlfilestr, markval, param, value)=
let XMLgetMarksByValue xmlfilestr markval -> l in
let nil -> fmark in
(
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
if (!strcmp value pval) then
set fmark = mark
else nil;
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get all marks node with a value, and attribute name and value in an xml structure, recursively
*
* Prototype: fun [XMLfile S S S] [XMLmark r1]
*
* \param XMLfile : the xml structure
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value
*
* \return [XMLmark r1] : the list of marks node if found, nil otherwise
**/
fun XMLgetMarksByValueAndParamValue(xmlfilestr, markval, param, value)=
let XMLgetMarksByValue xmlfilestr markval -> l in
let nil -> fmark in
(
while (l != nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
if (!strcmp value pval) then
set fmark = mark::fmark
else nil;
set l = tl l;
);
fmark;
);;
fun XMLgetMarksByValueAndListParamValue(xmlfilestr, markval, lp)=
let XMLgetMarksByValue xmlfilestr markval -> l in
let nil -> fmark in
(
let sizelist lp -> size2 in
while (l != nil) do
(
let hd l -> mark in
let 0 -> i2 in
let 0 -> ret in
(
while i2 < size2 do
(
let nth_list lp i2 -> [param value] in
let XMLgetParam mark param -> pval in
if (!strcmp value pval) then
set ret = ret + 1
else nil;
set i2 = i2 + 1;
);
if ret < size2 then nil else
set fmark = mark::fmark
);
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with a value, and attribute name and value in a parent mark node, recursively
*
* Prototype: fun [XMLmark S S S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValueAndParamValueFromMark(markstr, markval, param, value)=
let XMLgetMarksByValueFromMark markstr markval -> l in
let nil -> fmark in
(
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
(
if (!strcmp value pval) then
set fmark = mark
else nil;
);
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get all marks node with a value, and attribute name and value in a parent mark node, recursively
*
* Prototype: fun [XMLmark S S S] [XMLmark r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value
*
* \return [XMLmark r1] : the list of marks node if found, nil otherwise
**/
fun XMLgetMarksByValueAndParamValueFromMark(markstr, markval, param, value)=
let XMLgetMarksByValueFromMark markstr markval -> l in
let nil -> fmark in
(
while (l != nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
if (!strcmp value pval) then
set fmark = mark::fmark
else nil;
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get all marks node which start with a value, and attribute name and value in a parent mark node, recursively
*
* Prototype: fun [XMLmark S S S] [XMLmark r1]
*
* \param XMLmark : the parent mark node
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value prefix
*
* \return [XMLmark r1] : the list of marks node if found, nil otherwise
**/
fun XMLgetMarksByValueAndParamPrefixValueFromMark(markstr, markval, param, value)=
let XMLgetMarksByValueFromMark markstr markval -> l in
let nil -> fmark in
(
while (l != nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
if (strfind value pval 0) != nil then
set fmark = mark::fmark
else nil;
set l = tl l;
);
fmark;
);;
/*! @ingroup xmlLib
* \brief Get the first mark node with a value, and attribute name and value in a parent mark node
*
* Prototype: fun [XMLmark S S S] XMLmark
*
* \param XMLmark : the parent mark node
* \param S : the mark node value
* \param S : the attribute name
* \param S : the attribute value
*
* \return XMLmark : the mark node if found, nil otherwise
**/
fun XMLgetMarkByValueAndParamValueFromMarkSons(markstr, markval, param, value)=
let XMLgetMarksByValueFromMarkSons markstr markval -> l in
let nil -> fmark in
(
while (l != nil) && (fmark == nil) do
(
let hd l -> mark in
let XMLgetParam mark param -> pval in
if (!strcmp value pval) then
set fmark = mark
else nil;
set l = tl l;
);
fmark;
);;
fun XMLserializeFromMark(markstr)= XMLgetMarks markstr;;
fun XMLserializeWithIndexFromMark(markstr)= XMLgetMarksWithIndex markstr;;
fun XMLserializeWithIndex(xmlfilestr)=
let nil -> ncont in
(
if xmlfilestr.XMLtype == nil then nil else
set ncont = strcatn ""::nil;
let sizelist xmlfilestr.XMLmarks -> size in
let 0 -> i in
while i < size do
(
let nth_list xmlfilestr.XMLmarks i -> mark in
set ncont = strcat ncont XMLgetMarksWithIndex mark;
set i = i + 1;
);
ncont;
);;
fun ParamsToXML(lp)=
let nil -> nl in
(
let sizelist lp -> size in
let 0 -> i in
while i < size do
(
let nth_list lp i -> [name value] in
set nl = [name (strtrim (strtoweb value))]::nl;
set i = i + 1;
);
revertlist nl;
);;
fun XMLSaveChilds(xmlnode, markstr)=
let sizelist markstr.XMLsons -> size in
let 0 -> i in
while i < size do
(
let nth_list markstr.XMLsons i -> mark in
let ParamsToXML mark.XMLparams -> lp in
let _AddXmlNode xmlnode mark.XMLvalue -> cnode in
(
_SetXmlNodeContent cnode mark.XMLdata;
_SetXmlNodeAttributes cnode lp;
XMLSaveChilds cnode mark;
);
set i = i + 1;
);
0;;
fun XMLstrToObj(xmlfilestr)=
let _CreateXml _channel -> xmlobj in
(
let xmlfilestr.XMLmarks -> l in
while (l != nil) do
(
let hd l -> mark in
let ParamsToXML mark.XMLparams -> lp in
let _AddXmlRootNode xmlobj mark.XMLvalue -> xmlnode in
(
_SetXmlNodeContent xmlnode mark.XMLdata;
_SetXmlNodeAttributes xmlnode lp;
XMLSaveChilds xmlnode mark;
);
set l = tl l;
);
xmlobj;
);;
fun XMLserialize(xmlfilestr)=
let XMLstrToObj xmlfilestr -> xmlobj in
let _GetXmlContent xmlobj -> content in
(
_DestroyXml xmlobj;
content;
);;
fun XMLserializeZipped(xmlfilestr)=
let XMLstrToObj xmlfilestr -> xmlobj in
let zip _GetXmlContent xmlobj -> content in
let strcat "ZXML" content -> content in
(
_DestroyXml xmlobj;
content;
);;
fun XMLsaveZipped(xmlfilestr, path)=
let XMLstrToObj xmlfilestr -> xmlobj in
let zip _GetXmlContent xmlobj -> content in
let strcat "ZXML" content -> content in
(
_DestroyXml xmlobj;
_storepack content path;
);
0;;
fun XMLSave(xmlfilestr, path)=
let XMLstrToObj xmlfilestr -> xmlobj in
(
_SaveXml xmlobj _getmodifypack path;
_DestroyXml xmlobj;
);
0;;
/*! @ingroup xmlLib
* \brief Write an Xml file from a xml structure
*
* Prototype: fun [XMLfile S] I
*
* \param XMLfile : the xml structure
* \param S : the file path
*
* \return 0
**/
fun XMLwrite(xmlfilestr, path)=
XMLSave xmlfilestr (if path == nil then xmlfilestr.XMLpath else path);
0;;
/*! @ingroup xmlLib
* \brief Write an Xml file from a xml structure with zipped content
*
* Prototype: fun [XMLfile S] I
*
* \param XMLfile : the xml structure
* \param S : the file path
*
* \return 0
**/
fun XMLwriteZipped(xmlfilestr, path)=
XMLsaveZipped xmlfilestr (if path == nil then xmlfilestr.XMLpath else path);
0;;
fun XMLloadManual(path)=
let (_checkpack path) -> pfile in
if pfile == nil then
(
_fooS strcat "XMLPARSER ERROR : file not found > " path;
nil;
)
else
(
let _getpack pfile -> fcont in
let mkXMLfile [nil path nil nil 0] -> xmlfilestr in
(
let strfindi " shp in
let strfind "?>" fcont 0 -> ehp in
if ehp == nil then nil else
(
set xmlfilestr.XMLtype = substr fcont (shp + 5) ((ehp - shp) - 5);
set fcont = substr fcont (ehp + 2) ((((strlen fcont) - 1) - ehp) -1);
);
if !iXMLdebug then nil else
_fooS strcat "XMLPARSER DEBUG : type > " xmlfilestr.XMLtype;
set xmlfilestr.XMLmarks = (XMLparse xmlfilestr fcont);
xmlfilestr;
);
);;
fun XMLloadStringManual(fcont)=
if ((fcont == nil) || (!strcmp fcont "")) then nil else
let mkXMLfile [nil nil nil nil 0] -> xmlfilestr in
(
let strfindi " shp in
let strfind "?>" fcont 0 -> ehp in
if ehp == nil then nil else
(
set xmlfilestr.XMLtype = substr fcont (shp + 5) ((ehp - shp) - 5);
set fcont = substr fcont (ehp + 2) ((((strlen fcont) - 1) - ehp) -1);
);
if !iXMLdebug then nil else
_fooS strcat "XMLPARSER DEBUG : type > " xmlfilestr.XMLtype;
set xmlfilestr.XMLmarks = (XMLparse xmlfilestr fcont);
xmlfilestr;
);;
/*! @ingroup xmlLib
* \brief Load an Xml file
*
* Prototype: fun [S] XMLfile
*
* \param S : the xml file path
*
* \return XMLfile : the loaded xml structure
**/
fun XMLload(path)=
//let getFileExt path -> ext in
let (_checkpack path) -> pfile in
if pfile == nil then
(
_fooS strcat "XMLPARSER ERROR : file not found > " path;
nil;
)
else
(
let _getpack pfile -> fcont in
let if (!strcmp "ZXML" (substr fcont 0 4)) then 1 else 0 -> iszipped in
//let _tickcount -> tick in
let if iszipped then unzip (substr fcont 4 (strlen fcont)-4) else fcont -> fcont in
let if iszipped then _OpenXmlS _channel fcont else _OpenXml _channel _checkpack path -> objxml in
//if the xml is not W3C compliant or contain error
if objxml == nil then
(
_fooS strcat "XMLPARSER WARNING : the file contain an error and will be loaded manually > " path;
XMLloadManual path;
)
else
(
let mkXMLfile [objxml path nil nil 0] -> xmlfilestr in
(
set xmlfilestr.XMLmarks = (XMLtoMarks xmlfilestr);
//if (strcmpi ext "xos") then nil else
// _DLGMessageBox _channel nil "Xml parser time" strcatn "file : "::path::"\nTime (ms) : "::(itoa (_tickcount - tick))::nil 0;
xmlfilestr;
);
);
);;
/*! @ingroup xmlLib
* \brief Load an Xml content from a string
*
* Prototype: fun [S] XMLfile
*
* \param S : the xml content
*
* \return XMLfile : the loaded xml structure
**/
fun XMLloadString(fcont)=
let if (!strcmp "ZXML" (substr fcont 0 4)) then 1 else 0 -> iszipped in
let if iszipped then unzip (substr fcont 4 (strlen fcont)-4) else fcont -> fcont in
let _OpenXmlS _channel fcont -> objxml in
//if the xml is not W3C compliant or contain error
if objxml == nil then
(
_fooS strcat "XMLPARSER WARNING : the XML content contain an error and will be loaded manually\n" fcont;
XMLloadStringManual fcont;
)
else
(
let mkXMLfile [objxml nil nil nil 0] -> xmlfilestr in
(
set xmlfilestr.XMLmarks = (XMLtoMarks xmlfilestr);
xmlfilestr;
);
);;
fun XMLdiff(xmlfilestr1, xmlfilestr2)=
XMLwrite xmlfilestr1 "tmp/xosfile1.xml";
XMLwrite xmlfilestr2 "tmp/xosfile2.xml";
let _MD5value _getpack _checkpack "tmp/xosfile1.xml" -> nsign1 in
let _MD5value _getpack _checkpack "tmp/xosfile2.xml" -> nsign2 in
(
_deletepack _checkpack "tmp/xosfile1.xml";
_deletepack _checkpack "tmp/xosfile2.xml";
strcmpi nsign1 nsign2;
);;
/*! @ingroup xmlLib
* \brief Copy an Xml structure
*
* Prototype: fun [XMLfile] XMLfile
*
* \param XMLfile : the xml structure to copy
*
* \return XMLfile : the new xml structure
**/
fun XMLcopy(xmlfilestr)= XMLloadString XMLserialize xmlfilestr;;
/*! @ingroup xmlLib
* \brief Create an empty Xml structure
*
* Prototype: fun [S S] XMLfile
*
* \param S : the xml file path
* \param S : the xml data type
*
* \return XMLfile : the new xml structure
**/
fun XMLcreate(path, type)=
let mkXMLfile [nil path type nil 0] -> xmlfilestr in
(
xmlfilestr;
);;
fun XMLsetPath(xmlfilestr, path)= set xmlfilestr.XMLpath = path;;
/*! @ingroup xmlLib
* \brief Close an Xml structure
*
* Prototype: fun [XMLfile] I
*
* \param XMLfile : the xml structure
*
* \return 0
**/
fun XMLclose(xmlfilestr)=
if (xmlfilestr.XMLobj == nil) then nil else
(
_DestroyXml xmlfilestr.XMLobj;
set xmlfilestr.XMLobj = nil;
set xmlfilestr.XMLmarks = nil;
);
0;;
/*
fun main(file)=
_showconsole;
let XMLload file -> xmlfilestr in
(
//XMLdelMark xmlfilestr
XMLaddMark xmlfilestr "test" (XMLgetMarkById xmlfilestr 6) nil "huhu";
XMLwrite xmlfilestr "tests/xml/new.xml";
);
0;;
*/