if not modules then modules = { } end modules ['l-xml'] = { version = 1.001, comment = "this module is the basis for the lxml-* ones", author = "Hans Hagen, PRAGMA-ADE, Hasselt NL", copyright = "PRAGMA ADE / ConTeXt Development Team", license = "see context related readme files" } -- RJ: key=value ... lpeg.Ca(lpeg.Cc({}) * (pattern-producing-key-and-value / rawset)^0) -- some code may move to l-xmlext --[[ldx--
The parser used here is inspired by the variant discussed in the lua book, but
handles comment and processing instructions, has a different structure, provides
parent access; a first version used different tricky but was less optimized to we
went this route. First we had a find based parser, now we have an
Expecially the lpath code is experimental, we will support some of xpath, but
only things that make sense for us; as compensation it is possible to hook in your
own functions. Apart from preprocessing content for
Beware, the interface may change. For instance at, ns, tg, dt may get more verbose names. Once the code is stable we will also remove some tracing and optimize the code.
--ldx]]-- xml = xml or { } tex = tex or { } xml.trace_lpath = false xml.trace_print = false xml.trace_remap = false local format, concat = string.format, table.concat --~ local pairs, next, type = pairs, next, type -- todo: some things per xml file, liek namespace remapping --[[ldx--First a hack to enable namespace resolving. A namespace is characterized by
a
The next function associates a namespace prefix with an
The next function also registers a namespace, but this time we map a
given namespace prefix onto a registered one, using the given
Next we provide a way to turn an
A namespace in an element can be remapped onto the registered
one efficiently by using the
This version uses
Next comes the parser. The rather messy doctype definition comes in many
disguises so it is no surprice that later on have to dedicate quite some
The code may look a bit complex but this is mostly due to the fact that we resolve namespaces and attach metatables. There is only one public function:
An optional second boolean argument tells this function not to create a root element.
--ldx]]-- xml.strip_cm_and_dt = false -- an extra global flag, in case we have many includes do -- not just one big nested table capture (lpeg overflow) local remove, nsremap, resolvens = table.remove, xml.xmlns, xml.resolvens local stack, top, dt, at, xmlns, errorstr, entities = {}, {}, {}, {}, {}, nil, {} local mt = { __tostring = xml.text } function xml.check_error(top,toclose) return "" end local strip = false local cleanup = false function xml.set_text_cleanup(fnc) cleanup = fnc end local function add_attribute(namespace,tag,value) if tag == "xmlns" then xmlns[#xmlns+1] = resolvens(value) at[tag] = value elseif namespace == "xmlns" then xml.checkns(tag,value) at["xmlns:" .. tag] = value else at[tag] = value end end local function add_begin(spacing, namespace, tag) if #spacing > 0 then dt[#dt+1] = spacing end local resolved = (namespace == "" and xmlns[#xmlns]) or nsremap[namespace] or namespace top = { ns=namespace or "", rn=resolved, tg=tag, at=at, dt={}, __p__ = stack[#stack] } setmetatable(top, mt) dt = top.dt stack[#stack+1] = top at = { } end local function add_end(spacing, namespace, tag) if #spacing > 0 then dt[#dt+1] = spacing end local toclose = remove(stack) top = stack[#stack] if #stack < 1 then errorstr = format("nothing to close with %s %s", tag, xml.check_error(top,toclose) or "") elseif toclose.tg ~= tag then -- no namespace check errorstr = format("unable to close %s with %s %s", toclose.tg, tag, xml.check_error(top,toclose) or "") end dt = top.dt dt[#dt+1] = toclose if at.xmlns then remove(xmlns) end end local function add_empty(spacing, namespace, tag) if #spacing > 0 then dt[#dt+1] = spacing end local resolved = (namespace == "" and xmlns[#xmlns]) or nsremap[namespace] or namespace top = stack[#stack] dt = top.dt local t = { ns=namespace or "", rn=resolved, tg=tag, at=at, dt={}, __p__ = top } dt[#dt+1] = t setmetatable(t, mt) at = { } if at.xmlns then remove(xmlns) end end local function add_text(text) if cleanup and #text > 0 then dt[#dt+1] = cleanup(text) else dt[#dt+1] = text end end local function add_special(what, spacing, text) if #spacing > 0 then dt[#dt+1] = spacing end if strip and (what == "@cm@" or what == "@dt@") then -- forget it else dt[#dt+1] = { special=true, ns="", tg=what, dt={text} } end end local function set_message(txt) errorstr = "garbage at the end of the file: " .. txt:gsub("([ \n\r\t]*)","") end local P, S, R, C, V = lpeg.P, lpeg.S, lpeg.R, lpeg.C, lpeg.V local space = S(' \r\n\t') local open = P('<') local close = P('>') local squote = S("'") local dquote = S('"') local equal = P('=') local slash = P('/') local colon = P(':') local valid = R('az', 'AZ', '09') + S('_-.') local name_yes = C(valid^1) * colon * C(valid^1) local name_nop = C(P(true)) * C(valid^1) local name = name_yes + name_nop local utfbom = P('\000\000\254\255') + P('\255\254\000\000') + P('\255\254') + P('\254\255') + P('\239\187\191') -- no capture local spacing = C(space^0) local justtext = C((1-open)^1) local somespace = space^1 local optionalspace = space^0 local value = (squote * C((1 - squote)^0) * squote) + (dquote * C((1 - dquote)^0) * dquote) local attribute = (somespace * name * optionalspace * equal * optionalspace * value) / add_attribute local attributes = attribute^0 local text = justtext / add_text local balanced = P { "[" * ((1 - S"[]") + V(1))^0 * "]" } -- taken from lpeg manual, () example local emptyelement = (spacing * open * name * attributes * optionalspace * slash * close) / add_empty local beginelement = (spacing * open * name * attributes * optionalspace * close) / add_begin local endelement = (spacing * open * slash * name * optionalspace * close) / add_end local begincomment = open * P("!--") local endcomment = P("--") * close local begininstruction = open * P("?") local endinstruction = P("?") * close local begincdata = open * P("![CDATA[") local endcdata = P("]]") * close local someinstruction = C((1 - endinstruction)^0) local somecomment = C((1 - endcomment )^0) local somecdata = C((1 - endcdata )^0) function entity(k,v) entities[k] = v end local begindoctype = open * P("!DOCTYPE") local enddoctype = close local beginset = P("[") local endset = P("]") local doctypename = C((1-somespace)^0) local elementdoctype = optionalspace * P("Packaging data in an xml like table is done with the following function. Maybe it will go away (when not used). --ldx]]-- function xml.is_valid(root) return root and root.dt and root.dt[1] and type(root.dt[1]) == "table" and not root.dt[1].er end function xml.package(tag,attributes,data) local ns, tg = tag:match("^(.-):?([^:]+)$") local t = { ns = ns, tg = tg, dt = data or "", at = attributes or {} } setmetatable(t, mt) return t end function xml.is_valid(root) return root and not root.error end xml.error_handler = (logs and logs.report) or (input and input.report) or print end --[[ldx--We cannot load an
When we inject new elements, we need to convert strings to valid trees, which is what the next function does.
--ldx]]-- function xml.toxml(data) if type(data) == "string" then local root = { xml.convert(data,true) } return (#root > 1 and root) or root[1] else return data end end --[[ldx--For copying a tree we use a dedicated function instead of the generic table copier. Since we know what we're dealing with we can speed up things a bit. The second argument is not to be used!
--ldx]]-- do function copy(old,tables) if old then tables = tables or { } local new = { } if not tables[old] then tables[old] = new end for k,v in pairs(old) do new[k] = (type(v) == "table" and (tables[v] or copy(v, tables))) or v end local mt = getmetatable(old) if mt then setmetatable(new,mt) end return new else return { } end end xml.copy = copy end --[[ldx--In
At the cost of some 25% runtime overhead you can first convert the tree to a string and then handle the lot.
--ldx]]-- function xml.tostring(root) -- 25% overhead due to collecting if root then if type(root) == 'string' then return root elseif next(root) then -- next is faster than type (and >0 test) local result = { } serialize(root,function(s) result[#result+1] = s end) return concat(result,"") end end return "" end end --[[ldx--The next function operated on the content only and needs a handle function that accepts a string.
--ldx]]-- function xml.string(e,handle) if not handle or (e.special and e.tg ~= "@rt@") then -- nothing elseif e.tg then local edt = e.dt if edt then for i=1,#edt do xml.string(edt[i],handle) end end else handle(e) end end --[[ldx--How you deal with saving data depends on your preferences. For a 40 MB database file the timing on a 2.3 Core Duo are as follows (time in seconds):
The save function is given below.
--ldx]]-- function xml.save(root,name) local f = io.open(name,"w") if f then xml.serialize(root,function(s) f:write(s) end) f:close() end end --[[ldx--A few helpers:
--ldx]]-- function xml.body(root) return (root.ri and root.dt[root.ri]) or root end function xml.text(root) return (root and xml.tostring(root)) or "" end function xml.content(root) -- bugged return (root and root.dt and xml.tostring(root.dt)) or "" end --[[ldx--The next helper erases an element but keeps the table as it is, and since empty strings are not serialized (effectively) it does not harm. Copying the table would take more time. Usage:
The next helper assigns a tree (or string). Usage:
We've now arrived at an intersting part: accessing the tree using a subset
of
An
Access to the root and data table makes it possible to construct insert and delete functions.
--ldx]]-- do local functions = xml.functions functions.contains = string.find functions.find = string.find functions.upper = string.upper functions.lower = string.lower functions.number = tonumber functions.boolean = toboolean functions.oneof = function(s,...) -- slow local t = {...} for i=1,#t do if s == t[i] then return true end end return false end functions.error = function(str) xml.error_handler("unknown function in lpath expression",str) return false end functions.text = function(root,k,n) -- unchecked, maybe one deeper local t = type(t) if t == "string" then return t else -- todo n local rdt = root.dt return (rdt and rdt[k]) or root[k] or "" end end functions.name = function(root,k,n) -- way too fuzzy local found if not k or not n then local ns, tg = root.rn or root.ns or "", root.tg if not tg then for i=1,#root do local e = root[i] if type(e) == "table" then found = e break end end elseif ns ~= "" then return ns .. ":" .. tg else return tg end elseif n == 0 then local e = root[k] if type(e) ~= "table" then found = e end elseif n < 0 then for i=k-1,1,-1 do local e = root[i] if type(e) == "table" then if n == -1 then found = e break else n = n + 1 end end end else --~ print(k,n,#root) for i=k+1,#root,1 do local e = root[i] if type(e) == "table" then if n == 1 then found = e break else n = n - 1 end end end end if found then local ns, tg = found.rn or found.ns or "", found.tg if ns ~= "" then return ns .. ":" .. tg else return tg end else return "" end end local function traverse(root,pattern,handle,reverse,index,parent,wildcard) -- multiple only for tags, not for namespaces if not root then -- error return false elseif pattern == false then -- root handle(root,root.dt,root.ri) return false elseif pattern == true then -- wildcard local rootdt = root.dt if rootdt then local start, stop, step = 1, #rootdt, 1 if reverse then start, stop, step = stop, start, -1 end for k=start,stop,step do if handle(root,rootdt,root.ri or k) then return false end if not traverse(rootdt[k],true,handle,reverse) then return false end end end return false elseif root.dt then index = index or 1 local action = pattern[index] local command = action[1] if command == 29 then -- fast case /oeps local rootdt = root.dt for k=1,#rootdt do local e = rootdt[k] local tg = e.tg if e.tg then local ns = e.rn or e.ns local ns_a, tg_a = action[3], action[4] local matched = (ns_a == "*" or ns == ns_a) and (tg_a == "*" or tg == tg_a) if not action[2] then matched = not matched end if matched then if handle(root,rootdt,k) then return false end end end end elseif command == 11 then -- parent local ep = root.__p__ or parent if index < #pattern then if not traverse(ep,pattern,handle,reverse,index+1,root) then return false end elseif handle(root,rootdt,k) then return false end else if (command == 16 or command == 12) and index == 1 then -- initial -- wildcard = true wildcard = command == 16 -- ok? index = index + 1 action = pattern[index] command = action and action[1] or 0 -- something is wrong end if command == 11 then -- parent local ep = root.__p__ or parent if index < #pattern then if not traverse(ep,pattern,handle,reverse,index+1,root) then return false end elseif handle(root,rootdt,k) then return false end else local rootdt = root.dt local start, stop, step, n, dn = 1, #rootdt, 1, 0, 1 if command == 30 then if action[5] < 0 then start, stop, step = stop, start, -1 dn = -1 end elseif reverse and index == #pattern then start, stop, step = stop, start, -1 end local idx = 0 for k=start,stop,step do -- we used to have functions for all but a case is faster local e = rootdt[k] local ns, tg = e.rn or e.ns, e.tg if tg then idx = idx + 1 if command == 30 then local ns_a, tg_a = action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end if matched then n = n + dn if n == action[5] then if index == #pattern then if handle(root,rootdt,root.ri or k) then return false end else if not traverse(e,pattern,handle,reverse,index+1,root) then return false end end break end elseif wildcard then if not traverse(e,pattern,handle,reverse,index,root,true) then return false end end else local matched, multiple = false, false if command == 20 then -- match local ns_a, tg_a = action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end elseif command == 21 then -- match one of multiple = true for i=3,#action,2 do local ns_a, tg_a = action[i], action[i+1] if (ns_a == "*" or ns == ns_a) and (tg == "*" or tg == tg_a) then matched = true break end end if not action[2] then matched = not matched end elseif command == 22 then -- eq local ns_a, tg_a = action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end matched = matched and e.at[action[6]] == action[7] elseif command == 23 then -- ne local ns_a, tg_a = action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end matched = mached and e.at[action[6]] ~= action[7] elseif command == 24 then -- one of eq multiple = true for i=3,#action-2,2 do local ns_a, tg_a = action[i], action[i+1] if (ns_a == "*" or ns == ns_a) and (tg == "*" or tg == tg_a) then matched = true break end end if not action[2] then matched = not matched end matched = matched and e.at[action[#action-1]] == action[#action] elseif command == 25 then -- one of ne multiple = true for i=3,#action-2,2 do local ns_a, tg_a = action[i], action[i+1] if (ns_a == "*" or ns == ns_a) and (tg == "*" or tg == tg_a) then matched = true break end end if not action[2] then matched = not matched end matched = matched and e.at[action[#action-1]] ~= action[#action] elseif command == 27 then -- has attribute local ns_a, tg_a = action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end matched = matched and e.at[action[5]] elseif command == 28 then -- has value local edt, ns_a, tg_a = e.dt, action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end matched = matched and edt and edt[1] == action[5] elseif command == 31 then local edt, ns_a, tg_a = e.dt, action[3], action[4] if tg == tg_a then matched = ns_a == "*" or ns == ns_a elseif tg_a == '*' then matched, multiple = ns_a == "*" or ns == ns_a, true else matched = false end if not action[2] then matched = not matched end if matched then matched = action[6](functions,idx,e.at or { },edt[1],rootdt,k) end end if matched then -- combine tg test and at test if index == #pattern then if handle(root,rootdt,root.ri or k) then return false end if wildcard then if multiple then if not traverse(e,pattern,handle,reverse,index,root,true) then return false end else -- maybe or multiple; anyhow, check on (section|title) vs just section and title in example in lxml if not traverse(e,pattern,handle,reverse,index,root) then return false end end end else if not traverse(e,pattern,handle,reverse,index+1,root) then return false end end elseif command == 14 then -- any if index == #pattern then if handle(root,rootdt,root.ri or k) then return false end else if not traverse(e,pattern,handle,reverse,index+1,root) then return false end end elseif command == 15 then -- many if index == #pattern then if handle(root,rootdt,root.ri or k) then return false end else if not traverse(e,pattern,handle,reverse,index+1,root,true) then return false end end -- not here : 11 elseif command == 11 then -- parent local ep = e.__p__ or parent if index < #pattern then if not traverse(ep,pattern,handle,reverse,root,index+1) then return false end elseif handle(root,rootdt,k) then return false end elseif command == 40 and e.special and tg == "@pi@" then -- pi local pi = action[2] if pi ~= "" then local pt = e.dt[1] if pt and pt:find(pi) then if handle(root,rootdt,k) then return false end end elseif handle(root,rootdt,k) then return false end elseif wildcard then if not traverse(e,pattern,handle,reverse,index,root,true) then return false end end end else -- not here : 11 if command == 11 then -- parent local ep = e.__p__ or parent if index < #pattern then if not traverse(ep,pattern,handle,reverse,index+1,root) then return false end elseif handle(root,rootdt,k) then return false end break -- else loop end end end end end end return true end xml.traverse = traverse end --[[ldx--Next come all kind of locators and manipulators. The most generic function here
is
For splitting the filter function from the path specification, we can use string matching or lpeg matching. Here the difference in speed is neglectable but the lpeg variant is more robust.
--ldx]]-- -- not faster but hipper ... although ... i can't get rid of the trailing / in the path local P, S, R, C, V, Cc = lpeg.P, lpeg.S, lpeg.R, lpeg.C, lpeg.V, lpeg.Cc local slash = P('/') local name = (R("az","AZ","--","__"))^1 local path = C(((1-slash)^0 * slash)^1) local argument = P { "(" * C(((1 - S("()")) + V(1))^0) * ")" } local action = Cc(1) * path * C(name) * argument local attribute = Cc(2) * path * P('@') * C(name) local direct = Cc(3) * Cc("../*") * slash^0 * C(name) * argument local parser = direct + action + attribute local filters = xml.filters local attribute_filter = xml.filters.attributes local default_filter = xml.filters.default -- todo: also hash, could be gc'd function xml.filter(root,pattern) local kind, a, b, c = parser:match(pattern) --~ if xml.trace_lpath then --~ print(pattern,kind,a,b,c) --~ end if kind == 1 or kind == 3 then return (filters[b] or default_filter)(root,a,c) elseif kind == 2 then return attribute_filter(root,a,b) else return default_filter(root,pattern) end end --~ slightly faster, but first we need a proper test file --~ --~ local hash = { } --~ --~ function xml.filter(root,pattern) --~ local h = hash[pattern] --~ if not h then --~ local kind, a, b, c = parser:match(pattern) --~ if kind == 1 then --~ h = { kind, filters[b] or default_filter, a, b, c } --~ elseif kind == 2 then --~ h = { kind, attribute_filter, a, b, c } --~ else --~ h = { kind, default_filter, a, b, c } --~ end --~ hash[pattern] = h --~ end --~ local kind = h[1] --~ if kind == 1 then --~ return h[2](root,h[2],h[4]) --~ elseif kind == 2 then --~ return h[2](root,h[2],h[3]) --~ else --~ return h[2](root,pattern) --~ end --~ end --[[ldx--The following functions collect elements and texts.
--ldx]]-- -- still somewhat bugged function xml.collect_elements(root, pattern, ignorespaces) local rr, dd = { }, { } traverse(root, lpath(pattern), function(r,d,k) local dk = d and d[k] if dk then if ignorespaces and type(dk) == "string" and dk:find("[^%S]") then -- ignore else local n = #rr+1 rr[n], dd[n] = r, dk end end end) return dd, rr end function xml.collect_texts(root, pattern, flatten) local t = { } -- no r collector traverse(root, lpath(pattern), function(r,d,k) if d then local ek = d[k] local tx = ek and ek.dt if flatten then if tx then t[#t+1] = xml.tostring(tx) or "" else t[#t+1] = "" end else t[#t+1] = tx or "" end else t[#t+1] = "" end end) return t end function xml.collect_tags(root, pattern, nonamespace) local t = { } xml.traverse(root, xml.lpath(pattern), function(r,d,k) local dk = d and d[k] if dk and type(dk) == "table" then local ns, tg = e.ns, e.tg if nonamespace then t[#t+1] = tg -- if needed we can return an extra table elseif ns == "" then t[#t+1] = tg else t[#t+1] = ns .. ":" .. tg end end end) return #t > 0 and {} end --[[ldx--Often using an iterators looks nicer in the code than passing handler
functions. The
Which will print all the titles in the document. The iterator variant takes 1.5 times the runtime of the function variant which is due to the overhead in creating the wrapper. So, instead of:
We use the function variants in the filters.
--ldx]]-- local wrap, yield = coroutine.wrap, coroutine.yield function xml.elements(root,pattern,reverse) return wrap(function() traverse(root, lpath(pattern), yield, reverse) end) end function xml.elements_only(root,pattern,reverse) return wrap(function() traverse(root, lpath(pattern), function(r,d,k) yield(d[k]) end, reverse) end) end function xml.each_element(root, pattern, handle, reverse) local ok traverse(root, lpath(pattern), function(r,d,k) ok = true handle(r,d,k) end, reverse) return ok end function xml.process_elements(root, pattern, handle) traverse(root, lpath(pattern), function(r,d,k) local dkdt = d[k].dt if dkdt then for i=1,#dkdt do local v = dkdt[i] if v.tg then handle(v) end end end end) end function xml.process_attributes(root, pattern, handle) traverse(root, lpath(pattern), function(r,d,k) local ek = d[k] local a = ek.at or { } handle(a) if next(a) then -- next is faster than type (and >0 test) ek.at = a else ek.at = nil end end) end --[[ldx--We've now arrives at the functions that manipulate the tree.
--ldx]]-- function xml.inject_element(root, pattern, element, prepend) if root and element then local matches, collect = { }, nil if type(element) == "string" then element = convert(element,true) end if element then collect = function(r,d,k) matches[#matches+1] = { r, d, k, element } end traverse(root, lpath(pattern), collect) for i=1,#matches do local m = matches[i] local r, d, k, element, edt = m[1], m[2], m[3], m[4], nil if element.ri then element = element.dt[element.ri].dt else element = element.dt end if r.ri then edt = r.dt[r.ri].dt else edt = d and d[k] and d[k].dt end if edt then local be, af if prepend then be, af = xml.copy(element), edt else be, af = edt, xml.copy(element) end for i=1,#af do be[#be+1] = af[i] end if r.ri then r.dt[r.ri].dt = be else d[k].dt = be end else -- r.dt = element.dt -- todo end end end end end -- todo: copy ! function xml.insert_element(root, pattern, element, before) -- todo: element als functie if root and element then if pattern == "/" then xml.inject_element(root, pattern, element, before) else local matches, collect = { }, nil if type(element) == "string" then element = convert(element,true) end if element and element.ri then element = element.dt[element.ri] end if element then collect = function(r,d,k) matches[#matches+1] = { r, d, k, element } end traverse(root, lpath(pattern), collect) for i=#matches,1,-1 do local m = matches[i] local r, d, k, element = m[1], m[2], m[3], m[4] if not before then k = k + 1 end if element.tg then table.insert(d,k,element) -- untested elseif element.dt then for _,v in ipairs(element.dt) do -- i added table.insert(d,k,v) k = k + 1 end end end end end end end xml.insert_element_after = xml.insert_element xml.insert_element_before = function(r,p,e) xml.insert_element(r,p,e,true) end xml.inject_element_after = xml.inject_element xml.inject_element_before = function(r,p,e) xml.inject_element(r,p,e,true) end function xml.delete_element(root, pattern) local matches, deleted = { }, { } local collect = function(r,d,k) matches[#matches+1] = { r, d, k } end traverse(root, lpath(pattern), collect) for i=#matches,1,-1 do local m = matches[i] deleted[#deleted+1] = table.remove(m[2],m[3]) end return deleted end function xml.replace_element(root, pattern, element) if type(element) == "string" then element = convert(element,true) end if element and element.ri then element = element.dt[element.ri] end if element then traverse(root, lpath(pattern), function(rm, d, k) d[k] = element.dt -- maybe not clever enough end) end end local function load_data(name) -- == io.loaddata local f, data = io.open(name), "" if f then data = f:read("*all",'b') -- 'b' ? f:close() end return data end function xml.include(xmldata,pattern,attribute,recursive,loaddata) -- parse="text" (default: xml), encoding="" (todo) -- attribute = attribute or 'href' pattern = pattern or 'include' loaddata = loaddata or load_data local function include(r,d,k) local ek, name = d[k], nil if not attribute or attribute == "" then local ekdt = ek.dt name = (type(ekdt) == "table" and ekdt[1]) or ekdt end if not name then if ek.at then for a in (attribute or "href"):gmatch("([^|]+)") do name = ek.at[a] if name then break end end end end local data = (name and name ~= "" and loaddata(name)) or "" if data == "" then xml.empty(d,k) elseif ek.at["parse"] == "text" then -- for the moment hard coded d[k] = xml.escaped(data) else local xi = xml.convert(data) if not xi then xml.empty(d,k) else if recursive then xml.include(xi,pattern,attribute,recursive,loaddata) end xml.assign(d,k,xi) end end end xml.each_element(xmldata, pattern, include) end function xml.strip_whitespace(root, pattern) traverse(root, lpath(pattern), function(r,d,k) local dkdt = d[k].dt if dkdt then -- can be optimized local t = { } for i=1,#dkdt do local str = dkdt[i] if type(str) == "string" and str:find("^[ \n\r\t]*$") then -- stripped else t[#t+1] = str end end d[k].dt = t end end) end function xml.rename_space(root, oldspace, newspace) -- fast variant local ndt = #root.dt local rename = xml.rename_space for i=1,ndt or 0 do local e = root[i] if type(e) == "table" then if e.ns == oldspace then e.ns = newspace if e.rn then e.rn = newspace end end local edt = e.dt if edt then rename(edt, oldspace, newspace) end end end end function xml.remap_tag(root, pattern, newtg) traverse(root, lpath(pattern), function(r,d,k) d[k].tg = newtg end) end function xml.remap_namespace(root, pattern, newns) traverse(root, lpath(pattern), function(r,d,k) d[k].ns = newns end) end function xml.check_namespace(root, pattern, newns) traverse(root, lpath(pattern), function(r,d,k) local dk = d[k] if (not dk.rn or dk.rn == "") and dk.ns == "" then dk.rn = newns end end) end function xml.remap_name(root, pattern, newtg, newns, newrn) traverse(root, lpath(pattern), function(r,d,k) local dk = d[k] dk.tg = newtg dk.ns = newns dk.rn = newrn end) end function xml.filters.found(root,pattern,check_content) local found = false traverse(root, lpath(pattern), function(r,d,k) if check_content then local dk = d and d[k] found = dk and dk.dt and next(dk.dt) and true else found = true end return true end) return found end end --[[ldx--Here are a few synonyms.
--ldx]]-- xml.filters.position = xml.filters.index xml.count = xml.filters.count xml.index = xml.filters.index xml.position = xml.filters.index xml.first = xml.filters.first xml.last = xml.filters.last xml.found = xml.filters.found xml.each = xml.each_element xml.process = xml.process_element xml.strip = xml.strip_whitespace xml.collect = xml.collect_elements xml.all = xml.collect_elements xml.insert = xml.insert_element_after xml.inject = xml.inject_element_after xml.after = xml.insert_element_after xml.before = xml.insert_element_before xml.delete = xml.delete_element xml.replace = xml.replace_element --[[ldx--The following helper functions best belong to the
We provide (at least here) two entity handlers. The more extensive
resolver consults a hash first, tries to convert to