GMXmlPath pascal source code


{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Xml Path implementations.                    | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2015 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMXmlPath;

interface

uses GMStrDef, GMCollections, GMIntf, GMCommon, GMXml;

type

//TNodeKind = (nkElement, nkAttribute, nkText);

  TXmlPathAxis = (xpaAncestor, xpaAncestorOrSelf, xpaAttribute, xpaChild, xpaDescendant, xpaDescendantOrSelf, xpaFollowing,
                  xpaFollowingSibling, xpaNamespace, xpaParent, xpaPreceding, xpaPrecedingSibling, xpaSelf);

//TXPathPredicate = (xppFirst, xppLast);

  TXmlPathExprStepEvalRec = record
    Axis: TXmlPathAxis;
    NodeTest: TGMString;
    Predicate: TGMString; // TXPathPredicate;
  end;


  TGMXmlPathEvaluator = class;

  IGMXmlPathEvaluator = interface(IUnknown)
    ['{1A2FA727-ACCF-4E95-933F-29F96E966411}']
    function Obj: TGMXmlPathEvaluator;
  end;

  TGMXmlPathEvaluator = class(TGMRefCountedObj, IGMXmlPathEvaluator)
   protected
    FXml: IGMXmlTree;
    FMatchingEntries: IGMIntfCollection;

    procedure IterateMatchingNodes(const AXmlPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TXmlPathExprStepEvalRec);
    procedure EvaluateNextLocationStep(const AXmlPathExpression: TGMString; AContextNode: IUnknown);
    procedure EvaluateXPathSingleExpression(const AXmlPathExpression: TGMString; AContextNode: IUnknown);

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AXml: IGMXmlTree; const AMatchingEntries: IGMIntfCollection; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TGMXmlPathEvaluator;

    procedure EvaluateXmlPathExpression(const AXmlPathExpression: TGMString; AContextNode: IUnknown);
  end;


  EGMXmlPathException = class(EGMException);


procedure EvaluateXmlPathExpression(const AXmlPathExpression: TGMString; const AXml: IGMXmlTree;
                                    const AContextNode: IUnknown; const AMatchingEntries: IGMIntfCollection);


const

  cXmlPathUnionSep = '|';
  cXmlPathStepSep = '/';

  cAxisLiterals: array [TXmlPathAxis] of TGMString = ('Ancestor','Ancestor-Or-Self', 'Attribute', 'Child', 'Descendant',
     'Descendant-Or-Self', 'Following', 'Following-Sibling', 'Namespace', 'Parent', 'Preceding', 'Preceding-Sibling', 'Self');


implementation

uses TypInfo;

resourcestring

  RStrInvalidAxisNameFmt = 'Invalid XPath axis name: "%s"';
  RStrdAxisNotImplemented = 'XPath Axis "%s" not implemented yet';
//RStrPredicatesNotImplemented = 'Predicates not implemented yet';


type

  TXmlPathAxisNameObj = class;

  IXPathAxisNameObj = interface(IUnknown)
    ['{BBB808B5-6929-449C-8D5E-5B0CC0280438}']
    function Obj: TXmlPathAxisNameObj;
  end;

  TXmlPathAxisNameObj = class(TGMNameObj, IGMGetName, IXPathAxisNameObj) // TGMRefCountedObj
   protected
    FAxis: TXmlPathAxis;
//  FName: TGMString;

   public
    constructor Create(const AAxis: TXmlPathAxis; const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TXmlPathAxisNameObj;
//  function GetName: TGMString; stdcall;
  end;


var

  vXPathAxisLiterals: IGMIntfCollection = nil;


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function XPathAxisLiterals: IGMIntfCollection;
var a: TXmlPathAxis;
begin
  if vXPathAxisLiterals = nil then
   begin
    vXPathAxisLiterals := TGMIntfArrayCollection.Create(False, True, GMCompareByName);
    for a:=Low(a) to High(a) do vXPathAxisLiterals.Add(TXmlPathAxisNameObj.Create(a, cAxisLiterals[a]));
   end;

  Result := vXPathAxisLiterals;
end;

function ParseStepEvalData(const AEvalStepExpression: TGMString; const ADefaultAxis: TXmlPathAxis; const ACaller: TObject): TXmlPathExprStepEvalRec;
var pScanAxis, pScanPredicate: PGMChar; axisName: TGMString; nameObj, foundEntry: IUnknown; axisEntry: IXPathAxisNameObj;
    len: Integer; isVerboseSyntax: Boolean;
begin
  FillByte(Result, SizeOf(Result), 0);
  Result.Axis := ADefaultAxis;
  isVerboseSyntax := False;
  //
  // Search for axis specification in verbose syntax
  //
  pScanAxis := GMStrLScan(PGMChar(AEvalStepExpression), ':', Length(AEvalStepExpression));
  if pScanAxis <> nil then
   begin
    Inc(pScanAxis);
    if pScanAxis^ = ':' then
     begin
      SetString(axisName, PGMChar(AEvalStepExpression), pScanAxis - PGMChar(AEvalStepExpression) - 1);
      nameObj := TGMNameObj.Create(axisName);
      if not XPathAxisLiterals.Find(nameObj, foundEntry) then
        raise EGMXmlPathException.ObjError(GMFormat(RStrInvalidAxisNameFmt, [axisName]), ACaller, {$I %CurrentRoutine%})
      else
        if GMQueryInterface(foundEntry, IXPathAxisNameObj, axisEntry) then Result.Axis := axisEntry.Obj.FAxis;

      Inc(pScanAxis);
      isVerboseSyntax := True;
     end;
   end;

  //
  // check for abbreviated axis syntax if no axis has been specified in verbose syntax
  //
  if not isVerboseSyntax then
   begin
    pScanAxis :=  PGMChar(AEvalStepExpression);
    if pScanAxis^ = '@' then begin Result.Axis := xpaAttribute; Inc(pScanAxis); end
    else
    if pScanAxis^ = '.' then
     begin
      Inc(pScanAxis);
      if pScanAxis^ = '.' then begin Result.Axis := xpaParent; Inc(pScanAxis); end else Result.Axis := xpaSelf;
     end;
   end;

  pScanPredicate := GMStrLScan(pScanAxis, '[', PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanAxis);
  if pScanPredicate <> nil then SetString(Result.Predicate, pScanPredicate, PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanPredicate);

//   raise EGMXmlPathException.ObjError(RStrPredicatesNotImplemented, ACAller, {$I %CurrentRoutine%});

  if pScanPredicate = nil then len := PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanAxis else len := pScanPredicate - pScanAxis;
  SetString(Result.NodeTest, pScanAxis, len);
end;

function IsNodeMatch(const ANode: IUnknown; const AEvalData: TXmlPathExprStepEvalRec): Boolean;
begin
  if AEvalData.NodeTest = '*' then Result := True else Result := GMSameText(GMGetIntfName(ANode), AEvalData.NodeTest);
end;

function IsAttributeMatch(const AAttribute: IUnknown; const AEvalData: TXmlPathExprStepEvalRec): Boolean;
begin
  if AEvalData.NodeTest = '*' then Result := True else Result := GMSameText(GMGetIntfName(AAttribute), AEvalData.NodeTest);
end;


{ ----------------------------- }
{ ---- TXmlPathAxisNameObj ---- }
{ ----------------------------- }

constructor TXmlPathAxisNameObj.Create(const AAxis: TXmlPathAxis; const AName: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FAxis := AAxis;
  FName := AName;
end;

function TXmlPathAxisNameObj.Obj: TXmlPathAxisNameObj;
begin
  Result := Self;
end;

//function TXmlPathAxisNameObj.GetName: TGMString;
//begin
//  Result := FName;
//end;


{ ----------------------------- }
{ ---- TGMXmlPathEvaluator ---- }
{ ----------------------------- }

constructor TGMXmlPathEvaluator.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
end;

constructor TGMXmlPathEvaluator.Create(const AXml: IGMXmlTree; const AMatchingEntries: IGMIntfCollection; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FXml := AXml;
  FMatchingEntries := AMatchingEntries;
end;

function TGMXmlPathEvaluator.Obj: TGMXmlPathEvaluator;
begin
  Result := Self;
end;

procedure TGMXmlPathEvaluator.IterateMatchingNodes(const AXmlPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TXmlPathExprStepEvalRec);
var ctxNode: IGMXmlNode; nodeIt: IGMIterator; unkNode: IUnknown;
  procedure ProcessAttributes(const ANode: IGMXmlNode);
  var attIt: IGMIterator; unkAtt: IUnknown; 
  begin
    if ANode = nil then Exit;
    attIt := ANode.Obj.Attributes.CreateIterator;
    while attIt.NextEntry(unkAtt) do
      if IsAttributeMatch(unkAtt, AStepEval) then FMatchingEntries.Add(unkAtt);
  end;

  procedure ProcessNodeMatch(const ANode: IUnknown);
  begin
    if Length(AXmlPathExpression) <= 0 then
     FMatchingEntries.Add(ANode)
    else
     EvaluateNextLocationStep(AXmlPathExpression, ANode);
  end;
begin
  if not GMQueryInterface(AContextNode, IGMXmlNode, ctxNode) then Exit;

  case AStepEval.Axis of
   xpaAttribute: ProcessAttributes(ctxNode);

   xpaChild:
    begin
     nodeIt := ctxNode.Obj.Subnodes.CreateIterator;
     while nodeIt.NextEntry(unkNode) do
       if IsNodeMatch(unkNode, AStepEval) then ProcessNodeMatch(unkNode);
    end;
   xpaSelf:   ProcessNodeMatch(ctxNode);
   xpaParent: ProcessNodeMatch(ctxNode.Obj.Parent);
   xpaAncestor, xpaAncestorOrSelf:
    begin
     if AStepEval.Axis = xpaAncestor then ctxNode := ctxNode.Obj.Parent;
     while ctxNode <> nil do
      begin
       ProcessNodeMatch(ctxNode);
       ctxNode := ctxNode.Obj.Parent;
      end;
    end;
   else raise EGMXmlPathException.ObjError(GMFormat(RStrdAxisNotImplemented, [GetEnumName(TypeInfo(TXmlPathAxis), Ord(AStepEval.Axis))]), Self, {$I %CurrentRoutine%});
  end;
end;

procedure TGMXmlPathEvaluator.EvaluateNextLocationStep(const AXmlPathExpression: TGMString; AContextNode: IUnknown);
var locationStepExpr, remainingExpr: TGMString; pStartCh, pChScan, pChEnd: PGMChar; dfltAxis: TXmlPathAxis; stepEval: TXmlPathExprStepEvalRec;
begin
  dfltAxis := xpachild;
  pStartCh := PGMChar(AXmlPathExpression);
  if pStartCh^ = cXmlPathStepSep then
   begin
    Inc(pStartCh);
    if pStartCh^ = cXmlPathStepSep then begin dfltAxis := xpaDescendant; Inc(pStartCh); end; // pStartCh := pStartCh + 1;
   end;

  pChScan := GMStrLScan(pStartCh, cXmlPathStepSep, PGMChar(AXmlPathExpression) + Length(AXmlPathExpression) - pStartCh);
  if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AXmlPathExpression) + Length(AXmlPathExpression);

  SetString(locationStepExpr, pStartCh, pChEnd - pStartCh);
  stepEval := ParseStepEvalData(locationStepExpr, dfltAxis, Self);

  SetString(remainingExpr, pChEnd, PGMChar(AXmlPathExpression) + Length(AXmlPathExpression) - pChEnd);

  IterateMatchingNodes(remainingExpr, AContextNode, stepEval);
end;

procedure TGMXmlPathEvaluator.EvaluateXPathSingleExpression(const AXmlPathExpression: TGMString; AContextNode: IUnknown);
begin
  if (FXml = nil) or (Length(AXmlPathExpression) <= 0) then Exit;

  if AXmlPathExpression[1] = cXmlPathStepSep then AContextNode := FXml.Obj.RootNode;

  EvaluateNextLocationStep(AXmlPathExpression, AContextNode);
end;

procedure TGMXmlPathEvaluator.EvaluateXmlPathExpression(const AXmlPathExpression: TGMString; AContextNode: IUnknown);
var expression: TGMString; pStartCh, pChScan, pChEnd: PGMChar;
begin
  if (FXml = nil) or (Length(AXmlPathExpression) <= 0) then Exit;

  if AContextNode = nil then AContextNode := FXml.Obj.RootNode;

  pStartCh := PGMChar(AXmlPathExpression);

  repeat
   pChScan := GMStrLScan(pStartCh, cXmlPathUnionSep, PGMChar(AXmlPathExpression) + Length(AXmlPathExpression) - pStartCh);

   if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AXmlPathExpression) + Length(AXmlPathExpression);

   SetString(expression, pStartCh, pChEnd - pStartCh);
// expression := GMStrip(expression); <- would prevent specifying spaces at the end
   if Length(expression) > 0 then EvaluateXPathSingleExpression(expression, AContextNode);

   pStartCh := pChEnd;
   if pChScan <> nil then Inc(pStartCh); // pStartCh := pStartCh + 1;

  until pChScan = nil;
end;


{ ---------------- }
{ ---- Global ---- }
{ ---------------- }

procedure EvaluateXmlPathExpression(const AXmlPathExpression: TGMString; const AXml: IGMXmlTree;
                                    const AContextNode: IUnknown; const AMatchingEntries: IGMIntfCollection);
var xpathEvaluator: IGMXmlPathEvaluator;
begin
  xpathEvaluator := TGMXmlPathEvaluator.Create(AXml, AMatchingEntries);
  xpathEvaluator.Obj.EvaluateXmlPathExpression(AXmlPathExpression, AContextNode);
end;


initialization

  XPathAxisLiterals; // <- Create in Main Thread!

end.