"Fossies" - the Fresh Open Source Software Archive

Member "seed7/lib/xmldom.s7i" (6 May 2015, 13500 Bytes) of package /linux/misc/seed7_05_20210223.tgz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 
    2 (********************************************************************)
    3 (*                                                                  *)
    4 (*  xmldom.s7i    Simple XML dom parser                             *)
    5 (*  Copyright (C) 2009  Thomas Mertes                               *)
    6 (*                                                                  *)
    7 (*  This file is part of the Seed7 Runtime Library.                 *)
    8 (*                                                                  *)
    9 (*  The Seed7 Runtime Library is free software; you can             *)
   10 (*  redistribute it and/or modify it under the terms of the GNU     *)
   11 (*  Lesser General Public License as published by the Free Software *)
   12 (*  Foundation; either version 2.1 of the License, or (at your      *)
   13 (*  option) any later version.                                      *)
   14 (*                                                                  *)
   15 (*  The Seed7 Runtime Library is distributed in the hope that it    *)
   16 (*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
   17 (*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
   18 (*  PURPOSE.  See the GNU Lesser General Public License for more    *)
   19 (*  details.                                                        *)
   20 (*                                                                  *)
   21 (*  You should have received a copy of the GNU Lesser General       *)
   22 (*  Public License along with this program; if not, write to the    *)
   23 (*  Free Software Foundation, Inc., 51 Franklin Street,             *)
   24 (*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
   25 (*                                                                  *)
   26 (********************************************************************)
   27 
   28 
   29 include "scanfile.s7i";
   30 include "xml_ent.s7i";
   31 include "strifile.s7i";
   32 include "html_ent.s7i";
   33 include "html.s7i";
   34 
   35 
   36 const type: attrHashType is hash [string] string;
   37 
   38 
   39 (**
   40  *  Interface type to represent XML nodes.
   41  *)
   42 const type: xmlNode is sub object interface;
   43 
   44 
   45 (**
   46  *  Get the value of a specified attribute.
   47  *)
   48 const func string: getAttrValue (in xmlNode: aNode, in string: attrName) is DYNAMIC;
   49 
   50 
   51 (**
   52  *  Get the attributes of a node as hash table.
   53  *)
   54 const func attrHashType: getAttributes (in xmlNode: aNode)               is DYNAMIC;
   55 
   56 
   57 (**
   58  *  Get the sub-nodes of a given node.
   59  *)
   60 const func array xmlNode: getSubNodes (in xmlNode: aNode)                is DYNAMIC;
   61 
   62 
   63 (**
   64  *  Get the content of a given node.
   65  *)
   66 const func string: getContent (in xmlNode: aNode)                        is DYNAMIC;
   67 
   68 
   69 const proc: writeXml (in xmlNode: aNode)                                 is DYNAMIC;
   70 const proc: writeXml (inout file: outFile, in xmlNode: aNode)            is DYNAMIC;
   71 const varfunc string:        (in xmlNode: aNode) . name                  is DYNAMIC;
   72 # const varfunc attrHashType: (in xmlNode: aNode) . attributes           is DYNAMIC;
   73 
   74 
   75 (**
   76  *  Base implementation type for xmlNode.
   77  *)
   78 const type: xmlBaseNode is new struct
   79     var integer: dummy is 0;
   80   end struct;
   81 
   82 
   83 type_implements_interface(xmlBaseNode, xmlNode);
   84 
   85 
   86 const func array xmlNode: getSubNodes (in xmlBaseNode: aBaseNode) is
   87   return (array xmlNode).value;
   88 
   89 const proc: writeXml (in xmlBaseNode: aBaseNode) is func
   90   begin
   91     writeln("xmlBaseNode");
   92   end func;
   93 
   94 const proc: writeXml (inout external_file: outFile, in xmlBaseNode: aBaseNode) is func
   95   begin
   96     writeln(outFile, "xmlBaseNode");
   97   end func;
   98 
   99 
  100 const xmlBaseNode: NULL_XML_NODE is xmlBaseNode.value;
  101 const xmlNode: (attr xmlNode) . value is NULL_XML_NODE;
  102 
  103 
  104 (**
  105  *  xmlNode implementation type representing text content.
  106  *)
  107 const type: xmlText is sub xmlBaseNode struct
  108     var string: content is "";
  109   end struct;
  110 
  111 
  112 type_implements_interface(xmlText, xmlNode);
  113 
  114 const func string: getContent (in xmlText: aText) is
  115   return aText.content;
  116 
  117 const proc: writeXml (in xmlText: aText) is func
  118   begin
  119     writeln(aText.content);
  120   end func;
  121 
  122 const proc: writeXml (inout external_file: outFile, in xmlText: aText) is func
  123   begin
  124     writeln(outFile, aText.content);
  125   end func;
  126 
  127 
  128 (**
  129  *  xmlNode implementation type representing an XML element.
  130  *)
  131 const type: xmlElement is sub xmlBaseNode struct
  132     var string: name is "";
  133     var attrHashType: attributes is attrHashType.value;
  134   end struct;
  135 
  136 
  137 type_implements_interface(xmlElement, xmlNode);
  138 
  139 const func string: getAttrValue (in xmlElement: anElement, in string: attrName) is
  140   return anElement.attributes[attrName];
  141 
  142 const func attrHashType: getAttributes (in xmlElement: anElement) is
  143   return anElement.attributes;
  144 
  145 const proc: writeXml (in xmlElement: anElement) is func
  146   local
  147     var string: attributeName is "";
  148     var string: attributeValue is "";
  149   begin
  150     write("<" <& anElement.name);
  151     for attributeName range sort(keys(anElement.attributes)) do
  152       attributeValue := anElement.attributes[attributeName];
  153       write(" " <& attributeName <& "=" <& literal(attributeValue));
  154     end for;
  155     writeln("/>");
  156   end func;
  157 
  158 const proc: writeXml (inout external_file: outFile, in xmlElement: anElement) is func
  159   local
  160     var string: attributeName is "";
  161     var string: attributeValue is "";
  162   begin
  163     write(outFile, "<" <& anElement.name);
  164     for attributeName range sort(keys(anElement.attributes)) do
  165       attributeValue := anElement.attributes[attributeName];
  166       write(outFile, " " <& attributeName <& "=" <& literal(attributeValue));
  167     end for;
  168     writeln(outFile, "/>");
  169   end func;
  170 
  171 
  172 (**
  173  *  xmlNode implementation type representing an XML element with subnodes.
  174  *)
  175 const type: xmlContainer is sub xmlElement struct
  176     var array xmlNode: subNodes is 0 times xmlNode.value;
  177   end struct;
  178 
  179 
  180 type_implements_interface(xmlContainer, xmlNode);
  181 
  182 const func array xmlNode: getSubNodes (in xmlContainer: aContainer) is
  183   return aContainer.subNodes;
  184 
  185 const proc: writeXml (in xmlContainer: aContainer) is func
  186   local
  187     var string: attributeName is "";
  188     var string: attributeValue is "";
  189     var xmlNode: subNode is xmlNode.value;
  190   begin
  191     write("<" <& aContainer.name);
  192     for attributeName range sort(keys(aContainer.attributes)) do
  193       attributeValue := aContainer.attributes[attributeName];
  194       write(" " <& attributeName <& "=" <& literal(attributeValue));
  195     end for;
  196     writeln(">");
  197     for subNode range aContainer.subNodes do
  198       # TRACE_OBJ(subNode);
  199       writeXml(subNode);
  200     end for;
  201     writeln("</" <& aContainer.name <& ">");
  202   end func;
  203 
  204 const proc: writeXml (inout external_file: outFile, in xmlContainer: aContainer) is func
  205   local
  206     var string: attributeName is "";
  207     var string: attributeValue is "";
  208     var xmlNode: subNode is xmlNode.value;
  209   begin
  210     write(outFile, "<" <& aContainer.name);
  211     for attributeName range sort(keys(aContainer.attributes)) do
  212       attributeValue := aContainer.attributes[attributeName];
  213       write(outFile, " " <& attributeName <& "=" <& literal(attributeValue));
  214     end for;
  215     writeln(outFile, ">");
  216     for subNode range aContainer.subNodes do
  217       # TRACE_OBJ(subNode);
  218       writeXml(outFile, subNode);
  219     end for;
  220     writeln(outFile, "</" <& aContainer.name <& ">");
  221   end func;
  222 
  223 
  224 #
  225 # Read functions for XML
  226 #
  227 
  228 const func xmlNode: readXmlNode (inout file: inFile, inout string: symbol) is func
  229   result
  230     var xmlNode: node is xmlNode.value;
  231   local
  232     var xmlContainer: containerElement is xmlContainer.value;
  233     var xmlElement: emptyElement is xmlElement.value;
  234     var xmlText: currentText is xmlText.value;
  235     var string: attributeName is "";
  236     var string: attributeValue is "";
  237     var string: endTagHead is "";
  238   begin
  239     # write(symbol);
  240     if startsWith(symbol, "<") then
  241       containerElement.name := symbol[2 ..];
  242       getNextXmlAttribute(inFile, attributeName, attributeValue);
  243       while attributeName <> "" do
  244         # write(" " <& attributeName <& "=" <& literal(attributeValue));
  245         containerElement.attributes @:= [attributeName]
  246             decodeXmlEntities(attributeValue, predeclaredXmlEntities);
  247         getNextXmlAttribute(inFile, attributeName, attributeValue);
  248       end while;
  249       if attributeValue = "/>" then
  250         # The XML tag ends with />
  251         # writeln("/>");
  252         emptyElement.name := containerElement.name;
  253         emptyElement.attributes := containerElement.attributes;
  254         node := toInterface(emptyElement);
  255       elsif attributeValue = ">" then
  256         # The XML tag ends with >
  257         # writeln(">");
  258         endTagHead := "</" & containerElement.name;
  259         symbol := getXmlTagHeadOrContent(inFile);
  260         while symbol <> "" and symbol <> endTagHead do
  261           containerElement.subNodes &:= [] (readXmlNode(inFile, symbol));
  262           symbol := getXmlTagHeadOrContent(inFile);
  263         end while;
  264         if symbol = endTagHead then
  265           skipXmlTag(inFile);
  266           # writeln(symbol <& ">");
  267         end if;
  268         if length(containerElement.subNodes) = 0 then
  269           # There are no subnodes: Create empty element
  270           emptyElement.name := containerElement.name;
  271           emptyElement.attributes := containerElement.attributes;
  272           node := toInterface(emptyElement);
  273         else
  274           node := toInterface(containerElement);
  275         end if;
  276       end if;
  277     else
  278       # writeln("content=" <& literal(symbol));
  279       currentText.content := decodeXmlEntities(symbol, predeclaredXmlEntities);
  280       node := toInterface(currentText);
  281     end if;
  282     # TRACE_OBJ(node); writeln;
  283   end func;
  284 
  285 
  286 (**
  287  *  Read an XML file.
  288  *  @return an xmlNode containing the contents of the XML file.
  289  *)
  290 const func xmlNode: readXml (inout file: inFile) is func
  291   result
  292     var xmlNode: node is xmlNode.value;
  293   local
  294     var string: symbol is "";
  295   begin
  296     symbol := getXmlTagHeadOrContent(inFile);
  297     while startsWith(symbol, "<?") do
  298       skipXmlTag(inFile);
  299       symbol := getXmlTagHeadOrContent(inFile);
  300     end while;
  301     node := readXmlNode(inFile, symbol);
  302     # TRACE_OBJ(node); writeln;
  303   end func;
  304 
  305 
  306 (**
  307  *  Read XML data from a string.
  308  *  @return an xmlNode containing the contents of the XML file.
  309  *)
  310 const func xmlNode: readXml (in string: xmlStri) is func
  311   result
  312     var xmlNode: node is xmlNode.value;
  313   local
  314     var file: xmlFile is STD_NULL;
  315   begin
  316     xmlFile := openStrifile(xmlStri);
  317     node := readXml(xmlFile);
  318   end func;
  319 
  320 
  321 #
  322 # Read functions for HTML
  323 #
  324 
  325 const func xmlNode: readHtmlNode (inout file: inFile, inout string: symbol) is func
  326   result
  327     var xmlNode: node is xmlNode.value;
  328   local
  329     var xmlContainer: containerElement is xmlContainer.value;
  330     var xmlElement: emptyElement is xmlElement.value;
  331     var xmlText: currentText is xmlText.value;
  332     var string: attributeName is "";
  333     var string: attributeValue is "";
  334     var string: endTagHead is "";
  335   begin
  336     # write(symbol);
  337     if startsWith(symbol, "<") then
  338       containerElement.name := symbol[2 ..];
  339       # writeln("startTag = " <& literal("<" & containerElement.name));
  340       getNextHtmlAttribute(inFile, attributeName, attributeValue);
  341       while attributeName <> "" do
  342         # write(" " <& attributeName <& "=" <& literal(attributeValue));
  343         containerElement.attributes @:= [attributeName]
  344             decodeHtmlEntities(attributeValue);
  345         getNextHtmlAttribute(inFile, attributeName, attributeValue);
  346       end while;
  347       if attributeValue = "/" or containerElement.name in voidHtmlElements then
  348         # The HTML tag ends with />
  349         # writeln("/>");
  350         emptyElement.name := containerElement.name;
  351         emptyElement.attributes := containerElement.attributes;
  352         node := toInterface(emptyElement);
  353       elsif attributeValue = "" then
  354         # The HTML tag ends with >
  355         # writeln(">");
  356         endTagHead := "</" & containerElement.name;
  357         symbol := getXmlTagHeadOrContent(inFile);
  358         while symbol <> "" and symbol[.. 2] <> "</" do
  359         # while symbol <> "" and symbol <> endTagHead do
  360           containerElement.subNodes &:= [] (readHtmlNode(inFile, symbol));
  361           symbol := getXmlTagHeadOrContent(inFile);
  362         end while;
  363         if symbol[.. 2] = "</" then
  364         # if symbol = endTagHead then
  365           skipXmlTag(inFile);
  366           # writeln(symbol <& ">");
  367         end if;
  368         if length(containerElement.subNodes) = 0 then
  369           # There are no subnodes: Create empty element
  370           emptyElement.name := containerElement.name;
  371           emptyElement.attributes := containerElement.attributes;
  372           node := toInterface(emptyElement);
  373         else
  374           node := toInterface(containerElement);
  375         end if;
  376       end if;
  377     else
  378       # writeln("content=" <& literal(symbol));
  379       currentText.content := decodeHtmlEntities(symbol);
  380       node := toInterface(currentText);
  381     end if;
  382     # TRACE_OBJ(node); writeln;
  383   end func;
  384 
  385 
  386 const func xmlNode: readHtml (inout file: inFile) is func
  387   result
  388     var xmlNode: node is xmlNode.value;
  389   local
  390     var string: symbol is "";
  391   begin
  392     symbol := getXmlTagHeadOrContent(inFile);
  393     while startsWith(symbol, "<?") do
  394       skipXmlTag(inFile);
  395       symbol := getXmlTagHeadOrContent(inFile);
  396     end while;
  397     node := readHtmlNode(inFile, symbol);
  398     # TRACE_OBJ(node); writeln;
  399   end func;
  400 
  401 
  402 const proc: for (inout xmlNode: nodeVar) range (in xmlNode: parent) do
  403               (ref proc: statements)
  404             end for                               is func
  405   begin
  406     for nodeVar range getSubNodes(parent) do
  407       statements;
  408     end for;
  409   end func;