A Simple(rudimentary) implementation of XPath node search (SelectSingleNode) for OpenEdge 10.2A

- DOES NOT implement Node value filtering (yet)
- Implements Positional referencing/filtering
- DOES NOT implement Attribute searching (yet)
- DOES NOT implement Multiple node result selection like SelectNodes (new function coming)

NOTE: This is a work in progress.

NOTE: You will need to declare the following global variable:
DEFINE VARIABLE recurseXPath AS LOGICAL NO-UNDO.

FUNCTION SelectSingleNode RETURNS LOGICAL (INPUT hXBaseNode AS HANDLE,INPUT xPath AS CHARACTER, OUTPUT hXNode AS HANDLE):
DEFINE VARIABLE hXCurrentNode AS HANDLE.
DEFINE VARIABLE hXChildNode AS HANDLE.
DEFINE VARIABLE childCount AS INTEGER.
DEFINE VARIABLE currentPosition AS INTEGER.
DEFINE VARIABLE startPosition AS INTEGER.
DEFINE VARIABLE endPosition AS INTEGER.
DEFINE VARIABLE iterationDone AS LOGICAL.
DEFINE VARIABLE nodeName AS CHARACTER.
DEFINE VARIABLE pathSegment AS CHARACTER.
DEFINE VARIABLE nodeFilter AS CHARACTER.
DEFINE VARIABLE fqNodeName AS CHARACTER.
DEFINE VARIABLE subPath AS CHARACTER.

CREATE X-NODEREF hXCurrentNode.
CREATE X-NODEREF hXChildNode.

IF (SUBSTRING(xPath, 1, 2) = "//") THEN DO:
recurseXPath = TRUE.
subPath = SUBSTRING(xPath, 3).
hXCurrentNode = hXBaseNode:OWNER-DOCUMENT.
END.
ELSE IF (SUBSTRING(xPath,1,2) = "..") THEN DO:
subPath = SUBSTRING(xPath, 3).
hxBaseNode:GET-PARENT(hXCurrentNode).
END.
ELSE IF (SUBSTRING(xPath,1,2) = "./") THEN DO:
subPath = SUBSTRING(xPath, 3).
hXCurrentNode = hxBaseNode.
END.
ELSE IF (SUBSTRING(xPath, 1, 1) = "/") THEN DO:
subPath = SUBSTRING(xPath, 2).
hXCurrentNode = hxBaseNode.
END.
ELSE DO:
subPath = xPath.
hXCurrentNode = hxBaseNode.
END.

iterationDone = FALSE.
pathSegment = ENTRY(1, subPath, "/").
subPath = SUBSTRING(subPath,LENGTH(pathSegment) + 1).

/* need to validate prefixes used. */
DO ON ERROR UNDO, LEAVE:
fqNodeName = ENTRY(1, pathSegment, "[").
nodeFilter = ENTRY(2, pathSegment, "[").
nodeFilter = SUBSTRING(nodeFilter, 1, LENGTH(nodeFilter) - 1).

CATCH err AS Progress.Lang.SysError:
nodeFilter = "".
fqNodeName = pathSegment.
/* LOG ERROR */
END CATCH.
END.

/* need to validate prefixes used. */
DO ON ERROR UNDO, LEAVE:
nodeName = ENTRY(2, fqNodeName, ":").
CATCH err AS Progress.Lang.SysError:
nodeName = fqNodeName.
/* LOG ERROR */
END CATCH.
END.

DO ON ERROR UNDO, LEAVE:

startPosition = 1.
endPosition = hXCurrentNode:NUM-CHILDREN.

DO currentPosition = startPosition TO endPosition:
hXCurrentNode:GET-CHILD(hXChildNode, currentPosition).
IF (hXChildNode:SUBTYPE = "ELEMENT") THEN DO:
IF (hXChildNode:NAME = fqNodeName) THEN DO:
/* apply filter */
IF (nodeFilter = "" OR (hXChildNode:CHILD-NUM = INTEGER(nodeFilter))) THEN DO:
hXCurrentNode = hXChildNode.
hxNode = hXCurrentNode.
iterationDone = TRUE.
recurseXPath = FALSE.
LEAVE.
END.
END.
IF (recurseXPath = TRUE AND hXChildNode:NUM-CHILDREN > 0) THEN DO:
DEFINE VARIABLE hxFirstChild AS HANDLE.
CREATE X-NODEREF hxFirstChild.
hXChildNode:GET-CHILD(hxFirstChild,1).

IF (hxFirstChild:SUBTYPE = "ELEMENT") THEN DO:
iterationDone = SelectSingleNode(hXChildNode, pathSegment, hxNode).
IF (hxNode:NAME = fqNodeName) THEN DO:
hXCurrentNode = hxNode.
iterationDone = TRUE.
recurseXPath = FALSE.
END.
END.
END.
END.
END.

IF (iterationDone = TRUE) THEN
DO WHILE (ENTRY(2, subPath, "/") <> ""):
RETURN SelectSingleNode(hXCurrentNode, subPath, hxNode).
END.

RETURN iterationDone.

CATCH err AS PROGRESS.Lang.SysError:
RETURN iterationDone.
END CATCH.
END.
RETURN iterationDone.
END FUNCTION.