# See Copyright Notice in license.html
# $Id: lom.lua,v 1.6 2005-06-09 19:18:40 tuler Exp $

#/
LICENCE

LuaExpat is free software: it can be used for both academic and commercial purposes at absolutely no cost.
There are no royalties or GNU-like "copyleft" restrictions. LuaExpat qualifies as Open Source software.
Its licenses are compatible with GPL. LuaExpat is not in the public domain and the Kepler Project keep its
copyright. The legal details are below.

The spirit of the license is that you are free to use LuaExpat for any purpose at no cost without having
to ask us. The only requirement is that if you do use LuaExpat, then you should give us credit by including
the appropriate copyright notice somewhere in your product or its documentation.

The LuaExpat library is designed and implemented by Roberto Ierusalimschy. The implementation is not derived
from licensed software.

Copyright © 2003-2007 The Kepler Project.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
documentation files (the "Software"), to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software,
and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial
portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

Ported to agena >> by alexander walz, August 02, 2012 /#

package.checkclib('xml');  # has C dynamic link library been found ?

xml.initstring :=
   'LuaExpat/XML v0.1.1 as of September 25, 2012,\noriginally written by Roberto Ierusalimschy.\n';

create table xml.aux;

local starttag := proc(p, label, xattr) is
   local stack, newelement;
   stack := xml.getcallbacks(p).stack;
   newelement := ['label' ~ label, 'xattr' ~ xattr];
   insert newelement into stack
end;


local endtag := proc(p, label) is
   local stack, element, level;
   stack := xml.getcallbacks(p).stack;
   element := purge(stack);
   assume(element.label = label);
   level := size(stack);
   insert element into stack[level]
end;


local text := proc (p, txt) is
   local stack, element, n;
   stack := xml.getcallbacks(p).stack;
   element := top(stack);
   n := size(element);
   if element[n] :: string then
      element[n] := element[n] & txt
   else
      insert txt into element
   fi
end;


local rjmethods :=
   ['StartElement' ~ starttag,
    'EndElement' ~ endtag,
    'CharacterData' ~ text,
    '_nonstrict' ~ true,
   ];


xml.decode := proc(o) is
   local c, p, status, err;
   c := rjmethods;
   c.stack := [[]]
   p := xml.new(c);
   if o :: string then
      status, err := xml.parse(p, o);
      if not status then return null, err fi
   else
      for l in o do
         status, err := xml.parse(p, l);
         if not status then return null, err fi
      od
   fi;
   status, err := xml.parse(p);
   if not status then return null, err fi;
   xml.close(p);
   return c.stack[1][1]
end


xml.aux.decodexml_convert := proc(v :: string) is  # Agena 1.6.1
   local r := tonumber(v);  # try to convert into a number or complex number
   if r = 'true' then
      r := true
   elif r = 'false' then
      r := false
   elif r = 'fail' then
      r := fail
   fi;
   return r
end;


xml.aux.decodexml := proc(x, flag) is
   if x :: string or x = null or x.label = null then
      return x
   fi;
   local r, s, t, xlabel, tlabel, rxlabel;
   create table r;
   # traverse table and collect entries
   xlabel := x.label;
   for i in '-:.' do
      xlabel := replace(xlabel, i, '_')
   od;
   r[xlabel] := xml.aux.decodexml(x[1]);  # x.label = XML tag of entry
   rxlabel := r[xlabel];
   if rxlabel = '\n' or rxlabel :: string and strings.isblank(rxlabel) then  # handle leading white spaces, Agena 1.8.0
      r[xlabel] := []
   fi
   for i from 2 to size x - 2 do
      t := x[i];  # t is the next entry
      skip when t = '\n' or t :: string and strings.isblank(t);  # handle leading white spaces, Agena 1.8.0
      tlabel := t.label;
      for i in '-:.' do
         tlabel := replace(tlabel, i, '_')
      od;
      if r[xlabel, tlabel] :: string then  # is the already tag/value already in the collection and is the entry a string ?
         r[xlabel, tlabel] := [r[xlabel, tlabel]]  # convert entry into a table
         for i to size t - 2 do
            insert xml.aux.decodexml(t[i]) into r[xlabel, tlabel]
         od
      elif r[xlabel, tlabel] = null then  # tag is not yet in collection ?
         if size t = 3 then  # only one entry ?
            r[xlabel, tlabel] := xml.aux.decodexml(t[1])
         else
            r[xlabel, tlabel] := []
            for i to size t - 2 do
               for m, n in xml.aux.decodexml(t[i]) do
                  r[xlabel, tlabel, m] := xml.aux.decodexml(n)
               od
            od
         fi
      else  # tag/value already in the collection and in a table
         local o, u, loopflag;
         create table u;
         if unassigned(flag) then
            if unassigned(r[xlabel, tlabel, 1]) then  # XXX is table a dictionary ? Agena 1.8.0 really dirty fix, but which also prevents blank strings
               r[xlabel, tlabel] := [r[xlabel, tlabel]];
               flag := true  # do not create another table but insert data instead into the present table
            fi
         fi;
         loopflag := false;  # Agena 1.8.0 fix
         for i to size t - 2 do
            o := xml.aux.decodexml(t[i], flag);
            if o :: table then  # Agena 1.8.0 fix
               loopflag := true;
               for m, n in o do
                  u[m] := xml.aux.decodexml(n)
               od
            else
               insert o into r[xlabel, tlabel]
            fi
         od;
         if loopflag then
            insert u into r[xlabel, tlabel]
         fi
      fi
   od;
   return r
end;


xml.decodexml := proc(s :: string) is
   return xml.aux.decodexml(xml.decode(s))
end;


xml.readxml := proc(fn :: string) :: table is
   local fd, L, i;
   if not(os.exists(fn)) then
      error('Error in `xml.readxml`: file does not exist.')
   fi;
   create table L;
   fd := io.open(fn);
   for keys i in io.lines(fd) do
      insert i into L
   od;
   L := join(L);
   io.close(fd);
   return xml.aux.decodexml(xml.decode(L))
end;