include "scanfile.s7i";
include "xml_ent.s7i";
include "strifile.s7i";
include "html_ent.s7i";
include "html.s7i";
const type: attrHashType is hash [string] string;
const type: xmlNode is sub object interface;
const func string: getAttrValue (in xmlNode: aNode, in string: attrName) is DYNAMIC;
const func attrHashType: getAttributes (in xmlNode: aNode) is DYNAMIC;
const func array xmlNode: getSubNodes (in xmlNode: aNode) is DYNAMIC;
const func string: getContent (in xmlNode: aNode) is DYNAMIC;
const proc: writeXml (inout file: outFile, in xmlNode: aNode) is DYNAMIC;
const varfunc string: (in xmlNode: aNode) . name is DYNAMIC;
const proc: writeXml (in xmlNode: aNode) is func
begin
writeXml(OUT, aNode);
end func;
const type: xmlBaseNode is new struct
var integer: dummy is 0;
end struct;
type_implements_interface(xmlBaseNode, xmlNode);
const func array xmlNode: getSubNodes (in xmlBaseNode: aBaseNode) is
return (array xmlNode).value;
const proc: writeXml (inout external_file: outFile, in xmlBaseNode: aBaseNode) is func
begin
writeln(outFile, "xmlBaseNode");
end func;
const xmlBaseNode: NULL_XML_NODE is xmlBaseNode.value;
const xmlNode: (attr xmlNode) . value is NULL_XML_NODE;
const type: xmlText is sub xmlBaseNode struct
var string: content is "";
end struct;
type_implements_interface(xmlText, xmlNode);
const func string: getContent (in xmlText: aText) is
return aText.content;
const proc: writeXml (inout external_file: outFile, in xmlText: aText) is func
local
var char: ch is ' '
begin
for ch range aText.content do
if ch = '<' then
write("<");
elsif ch = '&' then
write("&");
else
write(ch);
end if;
end for;
writeln(outFile);
end func;
const type: xmlElement is sub xmlBaseNode struct
var string: name is "";
var attrHashType: attributes is attrHashType.value;
end struct;
type_implements_interface(xmlElement, xmlNode);
const func string: getAttrValue (in xmlElement: anElement, in string: attrName) is
return anElement.attributes[attrName];
const func attrHashType: getAttributes (in xmlElement: anElement) is
return anElement.attributes;
const proc: writeXml (inout external_file: outFile, in xmlElement: anElement) is func
local
var string: attributeName is "";
var string: attributeValue is "";
begin
write(outFile, "<" <& anElement.name);
for attributeName range sort(keys(anElement.attributes)) do
attributeValue := anElement.attributes[attributeName];
write(outFile, " " <& attributeName <& "=" <& literal(attributeValue));
end for;
writeln(outFile, " />");
end func;
const type: xmlContainer is sub xmlElement struct
var array xmlNode: subNodes is 0 times xmlNode.value;
end struct;
type_implements_interface(xmlContainer, xmlNode);
const func array xmlNode: getSubNodes (in xmlContainer: aContainer) is
return aContainer.subNodes;
const proc: writeXml (inout external_file: outFile, in xmlContainer: aContainer) is func
local
var string: attributeName is "";
var string: attributeValue is "";
var xmlNode: subNode is xmlNode.value;
begin
write(outFile, "<" <& aContainer.name);
for attributeName range sort(keys(aContainer.attributes)) do
attributeValue := aContainer.attributes[attributeName];
write(outFile, " " <& attributeName <& "=" <& literal(attributeValue));
end for;
writeln(outFile, ">");
for subNode range aContainer.subNodes do
writeXml(outFile, subNode);
end for;
writeln(outFile, "</" <& aContainer.name <& ">");
end func;
const func xmlNode: readXmlNode (inout file: inFile, inout string: symbol) is func
result
var xmlNode: node is xmlNode.value;
local
var xmlContainer: containerElement is xmlContainer.value;
var xmlElement: emptyElement is xmlElement.value;
var xmlText: currentText is xmlText.value;
var string: attributeName is "";
var string: attributeValue is "";
var string: endTagHead is "";
begin
if startsWith(symbol, "<") then
containerElement.name := symbol[2 ..];
getNextXmlAttribute(inFile, attributeName, attributeValue);
while attributeName <> "" do
containerElement.attributes @:= [attributeName]
decodeXmlEntities(attributeValue, predeclaredXmlEntities);
getNextXmlAttribute(inFile, attributeName, attributeValue);
end while;
if attributeValue = "/>" then
emptyElement.name := containerElement.name;
emptyElement.attributes := containerElement.attributes;
node := toInterface(emptyElement);
elsif attributeValue = ">" then
endTagHead := "</" & containerElement.name;
symbol := getXmlTagHeadOrContent(inFile);
while symbol <> "" and symbol <> endTagHead do
containerElement.subNodes &:= [] (readXmlNode(inFile, symbol));
symbol := getXmlTagHeadOrContent(inFile);
end while;
if symbol = endTagHead then
skipXmlTag(inFile);
end if;
if length(containerElement.subNodes) = 0 then
emptyElement.name := containerElement.name;
emptyElement.attributes := containerElement.attributes;
node := toInterface(emptyElement);
else
node := toInterface(containerElement);
end if;
end if;
else
currentText.content := decodeXmlEntities(symbol, predeclaredXmlEntities);
node := toInterface(currentText);
end if;
end func;
const func xmlNode: readXml (inout file: inFile) is func
result
var xmlNode: node is xmlNode.value;
local
var string: symbol is "";
begin
symbol := getXmlTagHeadOrContent(inFile);
while startsWith(symbol, "<?") do
skipXmlTag(inFile);
symbol := getXmlTagHeadOrContent(inFile);
end while;
node := readXmlNode(inFile, symbol);
end func;
const func xmlNode: readXml (in string: xmlStri) is func
result
var xmlNode: node is xmlNode.value;
local
var file: xmlFile is STD_NULL;
begin
xmlFile := openStriFile(xmlStri);
node := readXml(xmlFile);
end func;
const proc: for (inout xmlNode: nodeVar) range (in xmlNode: parent) do
(ref proc: statements)
end for is func
begin
for nodeVar range getSubNodes(parent) do
statements;
end for;
end func;