diff --git a/src/DXMLPathExtensions.Utils.pas b/src/DXMLPathExtensions.Utils.pas new file mode 100644 index 0000000..88e63b0 --- /dev/null +++ b/src/DXMLPathExtensions.Utils.pas @@ -0,0 +1,336 @@ +// *************************************************************************** +// +// Delphi XML Extensions +// +// Copyright (c) 2017-2019 David Moorhouse +// +// https://github.com/fastbike/DelphiXMLExtensions +// +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + +unit DXMLPathExtensions.Utils; + + +// https://theroadtodelphi.com/2013/05/29/enabling-xpath-selectnode-selectnodes-methods-in-vcl-and-firemonkey-apps/ +// https://stackoverflow.com/questions/5383919/xpath-and-txmldocument/5384230#5384230 + + +// also parsing via the MSXML parser +// https://theroadtodelphi.com/2011/06/13/how-get-and-parse-a-manifest-of-an-external-application-using-delphi/ + +interface + +uses +{$IFDEF MSWINDOWS} + System.Win.ComObj, + Winapi.ActiveX, +{$ENDIF} + System.SysUtils, + Xml.XMLIntf, + Xml.adomxmldom, + Xml.XMLDom, + Xml.XMLDoc, + Xml.Win.msxmldom, + Winapi.msxmlIntf, + Winapi.msxml; + +function SelectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode; +function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList; +// function SelectNode(xnRoot: IXmlNode; const nodePath: WideString): IXmlNode; +// function SelectNode(xnRoot: IXmlNode; nodePath: WideString): IXmlNode; + +type + + // IXMLNodeEnumerator = interface + // ['{07C0DFE7-C4BC-4EE9-A314-9EE682123977}'] + // function GetCurrent: T; + // function MoveNext: boolean; + // property Current: T read GetCurrent; + // end; + // + // IXMLDOMNodeListPlus = interface(IXMLDOMNodeList) + // ['{8B1C5AD9-14D1-4AB4-BEE0-4E27CDC78BF1}'] + // function GetEnumerator: IXMLNodeEnumerator; + // end; + + // T1 = class helper for IXMLDOMNodeList + // + // + // + // end; + + EXPathException = class(Exception) + end; + + TXPath = class + private + class function CreateElement(ParentNode: IXMLDOMNode; const NodeName: string): IXMLDOMNode; static; + public + class function Create(Xml: string; NSURI: array of string; NSPrefixes: array of string): IXMLDOMDocument3; + class function AppendElement(ParentNode: IXMLDOMNode; const NodeName: string): IXMLDOMNode; + class function AppendAttribute(ParentNode: IXMLDOMNode; const AttributeName: string): IXMLDOMAttribute; static; + class function InsertElement(ParentNode: IXMLDOMNode; const NodeName: string): IXMLDOMNode; static; + class function InsertFirstSibling(FirstSiblingNode: IXMLDOMNode; const NodeName: String): IXMLDOMNode; static; + + class function AppendElementWithValueAttribute(ParentNode: IXMLDOMNode; const NodeName: string; AttributeValue: string) + : IXMLDOMNode; + class function InsertElementWithValueAttribute(ParentNode: IXMLDOMNode; const NodeName: string; AttributeValue: string) + : IXMLDOMNode; + class function HasTopLevelNamespace(Doc: IXMLDOMDocument3): boolean; + class function GetTopLevelNamespace(Doc: IXMLDOMDocument3): string; + + class function GetXMLPath(Node: IXMLDOMNode; Separator: string = '/'): string; + class procedure NormaliseXPath(Document: IXMLDOMDocument3; var XPath: string; Prefix: string = 'f:'); overload; + class procedure NormaliseXPath(Node: IXMLDOMNode; var XPath: string; Prefix: string = 'f:'); overload; + class function EnsureNameSpace(Body: String; NamespaceURI: string; var NamespaceAdded: boolean): string; + class function ArrayFromNodes(Nodes: IXMLDOMNodeList): TArray; + end; + +implementation + +uses + System.RegularExpressions; + +(* + function SelectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode; + var + LDomNodeSelect: IDomNodeSelect; + begin + if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then + Exit; + // or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect); + if (DefaultDOMVendor = OpenXML4Factory.Description) then + Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent; + Result := LDomNodeSelect.selectNode(nodePath); + end; *) + +function SelectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode; +var + LDomNodeSelect: IDomNodeSelect; +begin + if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then + Exit; + // or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect); + if (DefaultDOMVendor = OpenXML4Factory.Description) then + Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent; + Result := LDomNodeSelect.selectNode(nodePath); +end; + +function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList; +var + LDomNodeSelect: IDomNodeSelect; +begin + if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then + Exit; + // or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect); + if (DefaultDOMVendor = OpenXML4Factory.Description) then + Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent; + Result := LDomNodeSelect.SelectNodes(nodePath); +end; + +// From a post in Embarcadero's Delphi XML forum. +function selectNode(xnRoot: IXmlNode; const nodePath: WideString): IXmlNode; +var + intfSelect: IDomNodeSelect; + dnResult: IDOMNode; + intfDocAccess: IXmlDocumentAccess; + Doc: TXmlDocument; +begin + Result := nil; + if not Assigned(xnRoot) or not Supports(xnRoot.DOMNode, IDomNodeSelect, intfSelect) then + Exit; + dnResult := intfSelect.selectNode(nodePath); + + if Assigned(dnResult) then + begin + if Supports(xnRoot.OwnerDocument, IXmlDocumentAccess, intfDocAccess) then + Doc := intfDocAccess.DocumentObject + else + Doc := nil; + Result := TXmlNode.Create(dnResult, nil, Doc); + end; +end; + +{ TXPath } + +class function TXPath.Create(Xml: string; NSURI, NSPrefixes: array of string): IXMLDOMDocument3; +var + I: Integer; + NS: string; +begin + if Length(NSPrefixes) <> Length(NSURI) then + raise EXPathException.Create('NS prefixes must match NS URIs'); + + Result := CoDOMDocument60.Create; // Check if this is supported cross platform ? + Result.Async := False; + + { load the XML string } + Result.LoadXML(Xml.Replace(#$D#$A, '', [rfReplaceAll])); + Result.SetProperty('SelectionLanguage', 'XPath'); + + if (Result.parseError.errorCode <> 0) then + raise EXPathException.CreateFmt('Error in Xml Data. Reason is %s', [Result.parseError.reason]); + + { set the namespaces alias } + for I := 0 to Length(NSPrefixes) - 1 do + begin + if I > 0 then + NS := NS + ' '; + NS := NS + Format('xmlns:%s=%s', [NSPrefixes[I], QuotedStr(NSURI[I])]); + end; + // todo can we automatically pull all the namespaces from the document ? + Result.SetProperty('SelectionNamespaces', NS); + Result.preserveWhiteSpace := True; + Result.resolveExternals := False; (* !! important to prevent external DTD attack !! *) +end; + +class function TXPath.CreateElement(ParentNode: IXMLDOMNode; const NodeName: String): IXMLDOMNode; +var + Doc: IXMLDOMDocument3; + Namespaces: IXMLDOMSchemaCollection; + Namespace: string; +begin + Doc := ParentNode.OwnerDocument as IXMLDOMDocument3; + if TXPath.HasTopLevelNamespace(Doc) then + begin + Namespaces := Doc.Namespaces; + if Namespaces.Length > 0 then + Namespace := Namespaces.NamespaceURI[0]; + end; + Result := Doc.createNode('element', NodeName, Namespace); +end; + +class function TXPath.InsertFirstSibling(FirstSiblingNode: IXMLDOMNode; const NodeName: String): IXMLDOMNode; +begin + Result := TXPath.CreateElement(FirstSiblingNode, NodeName); + FirstSiblingNode.ParentNode.insertBefore(Result, FirstSiblingNode); +end; + +class function TXPath.InsertElement(ParentNode: IXMLDOMNode; const NodeName: String): IXMLDOMNode; +begin + Result := TXPath.CreateElement(ParentNode, NodeName); + ParentNode.insertBefore(Result, ParentNode.firstChild); +end; + +class function TXPath.InsertElementWithValueAttribute(ParentNode: IXMLDOMNode; const NodeName: string; AttributeValue: string) + : IXMLDOMNode; +begin + Result := InsertElement(ParentNode, NodeName); + AppendAttribute(Result, 'value').value := AttributeValue; +end; + +class function TXPath.AppendElement(ParentNode: IXMLDOMNode; const NodeName: String): IXMLDOMNode; +begin + Result := CreateElement(ParentNode, NodeName); + ParentNode.appendChild(Result); +end; + +class function TXPath.AppendElementWithValueAttribute(ParentNode: IXMLDOMNode; const NodeName: string; AttributeValue: string) + : IXMLDOMNode; +begin + Result := AppendElement(ParentNode, NodeName); + AppendAttribute(Result, 'value').value := AttributeValue; +end; + +class function TXPath.AppendAttribute(ParentNode: IXMLDOMNode; const AttributeName: String): IXMLDOMAttribute; +var + Doc: IXMLDOMDocument3; +begin + Doc := ParentNode.OwnerDocument as IXMLDOMDocument3; + Result := Doc.createAttribute(AttributeName); + ParentNode.attributes.setNamedItem(Result); +end; + +class function TXPath.GetTopLevelNamespace(Doc: IXMLDOMDocument3): string; +begin + Result := Doc.documentElement.NamespaceURI; +end; + +class function TXPath.HasTopLevelNamespace(Doc: IXMLDOMDocument3): boolean; +begin + Result := Doc.documentElement.NamespaceURI <> ''; +end; + +class function TXPath.GetXMLPath(Node: IXMLDOMNode; Separator: string = '/'): string; +begin + while Node <> nil do + begin + if not SameText(Node.NodeName, '#document') then + Result := Separator + Node.NodeName + Result; + Node := Node.ParentNode; + end; +end; + +class procedure TXPath.NormaliseXPath(Document: IXMLDOMDocument3; var XPath: string; Prefix: string = 'f:'); +var + NS: string; +begin + if TXPath.HasTopLevelNamespace(Document) then + begin + NS := TXPath.GetTopLevelNamespace(Document); + if not SameText(NS, 'http://hl7.org/fhir') then + raise EXPathException.CreateFmt('XML namespace for Resource must be http://hl7.org/fhir, found %s', [NS]); + end + else + begin + XPath := XPath.Replace(Prefix, ''); + end; +end; + + +class procedure TXPath.NormaliseXPath(Node: IXMLDOMNode; var XPath: string; Prefix: string = 'f:'); +begin + TXPath.NormaliseXPath(Node.ownerDocument as IXMLDOMDocument3, XPath, Prefix); +end; + +class function TXPath.EnsureNameSpace(Body: string; NamespaceURI: string; var NamespaceAdded: boolean): string; +var + Start, Stop: Integer; + Regex: TRegEx; + Matches: TMatchCollection; +begin + Regex := TRegEx.Create('(?<=\<)((?!\?).*?)(?=\>)'); + Matches := Regex.Matches(Body); + NamespaceAdded := False; // Default to no action taken + if Matches.Count > 0 then + begin + Start := Matches[0].Index; + Stop := Matches[0].Length; + Result := Copy(Body, Start, Stop); + if Pos('xmlns', Result) = 0 then + begin + NamespaceAdded := True; + Result := StringReplace(Body, '<' + Result + '>', '<' + Result + ' xmlns="' + NamespaceURI + '">', [rfIgnoreCase]); + end + else + Result := Body; + end; +end; + +class function TXPath.ArrayFromNodes(Nodes: IXMLDOMNodeList): TArray; +var + I: Integer; +begin + Assert(Nodes <> nil, 'Cannot convert nil DOM nodes to Array'); + SetLength(Result, Nodes.Length); + for I := 0 to Nodes.Length - 1 do + Result[I] := Nodes[I].nodeValue; +end; + +end. + diff --git a/src/DXMLPathExtensions.pas b/src/DXMLPathExtensions.pas new file mode 100644 index 0000000..61d77e6 --- /dev/null +++ b/src/DXMLPathExtensions.pas @@ -0,0 +1,882 @@ +// *************************************************************************** +// +// Delphi XML Extensions +// +// Copyright (c) 2017-2019 David Moorhouse +// +// https://github.com/fastbike/DelphiXMLExtensions +// +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + +unit DXMLPathExtensions; + +(* + expression: Xpath text that returns a set of Nodes + comparators: = , !=, < , <=, > , >= + logical: and, or, not + + enumeration: for Node in Expression + functions: count(expression), + + ?? exists(expression) +*) +(* XML validation + not(parent::f:contained and f:contained) + + not(exists(f:contained/*/f:meta/f:versionId)) and not(exists(f:contained/*/f:meta/f:lastUpdated)) + not(exists(for $id in f:contained/*/@id return $id[not(ancestor::f:contained/parent::*/descendant::f:reference/@value=concat('#', $id))])) + not(starts-with(f:reference/@value, '#')) or exists(ancestor::*[self::f:entry or self::f:parameter]/f:resource/f:*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, '#')]|/*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, '#')]) + + + exists(f:extension)!=exists(f:*[starts-with(local-name(.), 'value')]) + not(exists(f:code)) or exists(f:system) + not(exists(f:comparator)) + not(exists(f:code)) or exists(f:system) + + (count(f:numerator) = count(f:denominator)) and ((count(f:numerator) > 0) or (count(f:extension) > 0)) + + + + so will need to handle: + - operators: not, and, or ,equality/comparison + - enumeration: for / return + - functions: exists, concat + + + +*) + +interface + +uses + Classes, System.Generics.Collections, Winapi.msxmlIntf, System.Generics.Defaults, System.Rtti; + +type + (* + Statement + |- Expressions: takes an XPath fragment and evaluates it for an XMLNode + |- Terms / Operators / Functions + *) + + IXPathTerm = interface + ['{6082A258-04A2-4CB7-AAA9-AA17B7A09DBF}'] + end; + + TXPathTerms = TArray; + // todo: some way of iterating ? + + IXPathExpression = interface(IXPathTerm) + ['{85C694B4-7E40-4FAC-8F94-BF625D640AE2}'] + function Evaluate(Node: IXMLDOMNode): IXMLDOMNodeList; + function GetValue: string; + function IsAttribute: Boolean; + end; + + TXPathExpressions = TArray; + + TXPathExpression = class(TInterfacedObject, IXPathTerm, IXPathExpression) + private + FXPath: string; + protected + function Evaluate(Node: IXMLDOMNode): IXMLDOMNodeList; + function GetValue: string; + function IsAttribute: Boolean; + public + constructor Create(AXPath: string); + end; + + IXPathStatement = interface(IXPathTerm) + ['{38F24C3D-6BCB-4A4A-8019-0FAD8ECEB93A}'] + function Evaluate(Node: IXMLDOMNode): TValue; overload; + end; + + IXPathConstant = interface(IXPathTerm) + ['{5E4C543A-27D3-45F7-BEE8-1EDD60E272A5}'] + function GetValue: TValue; + end; + + TXPathConstant = class(TInterfacedObject, IXPathTerm, IXPathConstant) + private + FValue: TValue; + protected + function GetValue: TValue; + public + constructor Create(AValue: string); + end; + + + // TXPathStatements = TArray; + + // some xpressions can return a set of nodes + // e.g. '/*' + // others will return a single node + // e.g. '/*[0]' (or the for in enumerator ) + + // todo: need unknow ? + TComparator = (eq, ne, lt, lte, gt, gte); + + TXPathComparator = class(TInterfacedObject, IXPathStatement) + private + FComparator: TComparator; + FLeftTerm, FRightTerm: IXPathTerm; + function ComparatorFromString(AComparator: string): TComparator; + protected + function Evaluate(Node: IXMLDOMNode): TValue; overload; + public + constructor Create(AComparator: string; Args: TXPathTerms); + end; + + TUnaryOperator = (straight, negation); // maybe ++, --, += etc + + TXPathUnary = class(TInterfacedObject, IXPathStatement) + private + FUnary: TUnaryOperator; + FTerm: IXPathTerm; + function UnaryFromString(AUnary: string): TUnaryOperator; + protected + function Evaluate(Node: IXMLDOMNode): TValue; overload; + public + constructor Create(AUnary: string; Args: TXPathTerms); + end; + + TBinaryOperator = (_and, _or); + + TXPathBinary = class(TInterfacedObject, IXPathStatement) + private + FLeftTerm, FRightTerm: IXPathTerm; + FBinary: TBinaryOperator; + function BinaryFromString(ABinary: string): TBinaryOperator; + protected + function Evaluate(Node: IXMLDOMNode): TValue; overload; + public + constructor Create(ABinary: string; Args: TXPathTerms); + end; + + TXPathFunction = class(TInterfacedObject, IXPathStatement) + private + FFunction: string; + FArgs: TXPathTerms; + protected + function Evaluate(Node: IXMLDOMNode): TValue; overload; + public + constructor Create(AFunction: string; Args: TXPathTerms); + end; + + TXPathEvaluator = class(TList) + private + FContentTemplate: string; // AnsiString; + FTrimWhiteSpace: Boolean; + // procedure Error(const Msg: string); + procedure ParseInner(const S: string); + public + // constructor Create(const AContentTemplate: AnsiString); + constructor Create(const AContentTemplate: string); + procedure Compile; + property ContentTemplate: string read FContentTemplate; + property TrimWhiteSpace: Boolean read FTrimWhiteSpace write FTrimWhiteSpace; + function Evaluate(Node: IXMLDOMNode): Boolean; + end; + +implementation + +uses + SysUtils; + +{ TXPathEvaluator } + +constructor TXPathEvaluator.Create(const AContentTemplate: string); +begin + inherited Create; + FTrimWhiteSpace := True; + FContentTemplate := AContentTemplate; +end; + +// procedure TXPathEvaluator.Error(const Msg: string); +// begin +// raise Exception.Create(Msg); +// end; + +function TXPathEvaluator.Evaluate(Node: IXMLDOMNode): Boolean; +var + Statement: IXPathStatement; +begin + Result := True; + for Statement in Self do + begin + Result := Result and Statement.Evaluate(Node).AsBoolean; + end; +end; + +type + TTokenType = (tkUnknown, tkXPathExpression, tkUnary, tkBinary, tkFunction, tkParameter, tkBlank, tkComparator); + +procedure TXPathEvaluator.ParseInner(const S: string); +var + StartP: PWideChar; + P: PWideChar; + Token: string; + TokenType: TTokenType; + TermStack: TXPathTerms; + TokenStack: TStringList; + BracketLevel: Integer; + ProcessingParams: Boolean; + + procedure AddTermToStack(Expression: IXPathTerm); + var + Len: Integer; + begin + Len := Length(TermStack); + SetLength(TermStack, Len + 1); + TermStack[Len] := Expression; + end; + + procedure AddTokenToStack(Token: string); + var + TmpToken: Int64; + begin + if ProcessingParams then + TokenType := tkParameter + else if Token = '' then + exit // discard blank tokens, will be before next token + + else if SameText('=', Token) or SameText('!=', Token) or SameText('<>', Token) or SameText('<', Token) or + SameText('<=', Token) or SameText('>', Token) or SameText('>=', Token) then + TokenType := tkComparator + + else if SameText('not', Token) then + TokenType := tkUnary + else if SameText('and', Token) or SameText('or', Token) then + TokenType := tkBinary + else if SameText('exists', Token) or SameText('concat', Token) or SameText('starts-with', Token) or SameText('count', Token) + or SameText('number', Token) then + TokenType := tkFunction + else if Token.StartsWith('''') or Token.StartsWith('"') then + begin + AddTermToStack(TXPathConstant.Create(Token)); + exit; + end + else if TmpToken.TryParse(Token, TmpToken) then + begin + AddTermToStack(TXPathConstant.Create(Token)); + exit; + end + else + begin + AddTermToStack(TXPathExpression.Create(Token)); + exit; + end; + + TokenStack.AddObject(Token, TObject(TokenType)); + end; + + procedure CaptureToken(Right: PWideChar); + var + Left: PWideChar; + TokenText: string; + begin // ?? do we need to check if we are entering a function here ?? + Left := StartP; + TokenText := Copy(Left, 1, Right - Left + 1); + AddTokenToStack(TokenText); + end; + + procedure PopToken; + var + Stmt: IXPathStatement; + LTermText: string; + begin + if TokenStack.Count = 0 then + begin + TokenType := tkBlank; + LTermText := ''; + end + else + begin + LTermText := TokenStack[TokenStack.Count - 1]; + TokenType := TTokenType(TokenStack.Objects[TokenStack.Count - 1]); + TokenStack.Delete(TokenStack.Count - 1); + end; + + case TokenType of + tkUnknown: + Stmt := nil; + tkBlank, tkUnary: + begin + while Length(TermStack) < 1 do // move this to own method - on the term stack ? + begin + AddTermToStack(Last); + Remove(Last); + end; + Stmt := TXPathUnary.Create(LTermText, TermStack); + end; + tkBinary: + begin + while Length(TermStack) < 2 do + begin + AddTermToStack(Last); + Remove(Last); + end; + + // if no expressions then get statements + Stmt := TXPathBinary.Create(LTermText, TermStack); + end; + tkFunction: + begin + if (LTermText = 'starts-with') or (LTermText = 'concat') then + while Length(TermStack) < 2 do + begin + AddTermToStack(Last); + Remove(Last); + end + else if (LTermText = 'exists') or (LTermText = 'count') or (LTermText = 'number') then + while Length(TermStack) < 1 do + begin + AddTermToStack(Last); + Remove(Last); + end; + + Stmt := TXPathFunction.Create(LTermText, TermStack); + end; + tkComparator: + begin + while Length(TermStack) < 2 do + begin + AddTermToStack(Last); + Remove(Last); + end; + Stmt := TXPathComparator.Create(LTermText, TermStack); + end; + end; + if Stmt <> nil then + Add(Stmt); + SetLength(TermStack, 0); + end; + + procedure ProcessToken(AddTerm: Boolean); + var + TmpToken: Int64; + begin + if Token.StartsWith('''') or Token.StartsWith('"') then + begin + AddTermToStack(TXPathConstant.Create(Token)); + end + else if TmpToken.TryParse(Token, TmpToken) then + begin + AddTermToStack(TXPathConstant.Create(Token)); + end + else if Token <> '' then + begin + AddTermToStack(TXPathExpression.Create(Token)); + end + else + begin + if TokenStack.Count = 0 then + exit; + PopToken; + AddTerm := False; + end; + + if AddTerm then + PopToken; + end; + +begin + try + ProcessingParams := False; + BracketLevel := 0; + TokenStack := TStringList.Create; + TokenStack.Duplicates := dupAccept; + + P := PWideChar(S); + StartP := P; + while P^ <> #0 do + begin + case P^ of + '(': + if BracketLevel = 0 then + begin + CaptureToken(P - 1); + StartP := P + 1; + end; + ')': + if BracketLevel = 0 then + begin + ProcessingParams := False; + SetString(Token, StartP, P - StartP); + ProcessToken(True); + // end term + // reset start + StartP := P + 1; + end; + '[': + Inc(BracketLevel); + ']': + Dec(BracketLevel); + ',': + if BracketLevel = 0 then + begin // need to swallow spaces + ProcessingParams := True; + SetString(Token, StartP, P - StartP); + ProcessToken(False); + StartP := P + 1; + end; + ' ': + if ProcessingParams then + StartP := P + 1 + else if (BracketLevel = 0) then + begin + CaptureToken(P - 1); + StartP := P + 1; + end; + '=', '<', '>', '!': // comparators + // todo: needs to skip over predicates where just checking for a match + if (BracketLevel = 0) then + begin + // peek ahead + if P[1] in ['>', '='] then + Inc(P); + CaptureToken(P); + StartP := P + 1; + end; + end; + Inc(P); + end; + if StartP <> P then + begin + SetString(Token, StartP, P - StartP); + ProcessToken(True); + end; + + // clean up any stacked tokens + while TokenStack.Count > 0 do + PopToken; + finally + TokenStack.Free; + end; + +end; + +procedure TXPathEvaluator.Compile; +begin + Clear; + Capacity := 32; + ParseInner(ContentTemplate); +end; + +{ TXPathComparator } + +function TXPathComparator.ComparatorFromString(AComparator: string): TComparator; +begin + if SameText('=', AComparator) then + Result := eq + else if SameText('!=', AComparator) then + Result := ne + else if SameText('<>', AComparator) then + Result := ne + else if SameText('<', AComparator) then + Result := lt + else if SameText('<=', AComparator) then + Result := lte + else if SameText('>', AComparator) then + Result := gt + else if SameText('>=', AComparator) then + Result := gte + else + raise Exception.CreateFmt('Invalid comparator tokem "%s"', [AComparator]); +end; + +constructor TXPathComparator.Create(AComparator: string; Args: TXPathTerms); +begin + inherited Create; + Assert(Length(Args) = 2, 'Comparators must have two arguments'); + FLeftTerm := Args[1]; + FRightTerm := Args[0]; + FComparator := ComparatorFromString(AComparator); +end; + +function TXPathComparator.Evaluate(Node: IXMLDOMNode): TValue; +var + LeftConstant, RightConstant: IXPathConstant; + LeftExpression, RightExpression: IXPathExpression; + LeftStatement, RightStatement: IXPathStatement; + LeftNodes, RightNodes: IXMLDOMNodeList; + LeftResult, RightResult: TValue; +begin + if Supports(FLeftTerm, IXPathConstant, LeftConstant) then + begin + LeftResult := LeftConstant.GetValue; + end + else if Supports(FLeftTerm, IXPathExpression, LeftExpression) then + begin + LeftNodes := LeftExpression.Evaluate(Node); + if LeftExpression.IsAttribute then + LeftResult := string(LeftNodes[0].nodeValue) + else + LeftResult := LeftNodes.Length; + end + else if Supports(FLeftTerm, IXPathStatement, LeftStatement) then + LeftResult := LeftStatement.Evaluate(Node); + + if Supports(FRightTerm, IXPathConstant, RightConstant) then + begin + RightResult := RightConstant.GetValue; + end + else if Supports(FRightTerm, IXPathExpression, RightExpression) then + begin + RightNodes := RightExpression.Evaluate(Node); + if RightExpression.IsAttribute then + RightResult := string(RightNodes[0].nodeValue) + else + RightResult := RightNodes.Length; + end + else if Supports(FRightTerm, IXPathStatement, RightStatement) then + RightResult := RightStatement.Evaluate(Node); + + case FComparator of + eq: + begin + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInt64 = RightResult.AsInt64; + tkEnumeration: + Result := LeftResult.AsBoolean = RightResult.AsBoolean; + else + Result := LeftResult.AsString = RightResult.AsString; + end; + end; + ne: + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInt64 <> RightResult.AsInt64; + tkEnumeration: + Result := LeftResult.AsBoolean <> RightResult.AsBoolean; + else + Result := LeftResult.AsString = RightResult.AsString; + // else + // raise EProgrammerNotFound.Create('Not yet implemented'); + end; + lt: + begin + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInteger < RightResult.AsInteger; + tkFloat: + Result := LeftResult.AsExtended < RightResult.AsExtended; + else + Result := LeftResult.AsString < RightResult.AsString; + end; + end; +// Result := LeftResult.AsInteger < RightResult.AsInteger; + lte: + begin + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInteger <= RightResult.AsInteger; + tkFloat: + Result := LeftResult.AsExtended <= RightResult.AsExtended; + else + Result := LeftResult.AsString <= RightResult.AsString; + end; + end; + gt: + begin + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInteger > RightResult.AsInteger; + tkFloat: + Result := LeftResult.AsExtended > RightResult.AsExtended; + else + Result := LeftResult.AsString > RightResult.AsString; + end; + end; +// Result := LeftResult.AsInteger > RightResult.AsInteger; + gte: + begin + case LeftResult.Kind of + tkInteger, tkInt64: + Result := LeftResult.AsInteger >= RightResult.AsInteger; + tkFloat: + Result := LeftResult.AsExtended >= RightResult.AsExtended; + else + Result := LeftResult.AsString >= RightResult.AsString; + end; + end; +// Result := LeftResult.AsInteger >= RightResult.AsInteger; + end; +end; + +{ TXPathBinary } + +function TXPathBinary.BinaryFromString(ABinary: string): TBinaryOperator; +begin + if SameText('and', ABinary) then + Result := _and + // else if SameText('or', ABinary) then + else + Result := _or; +end; + +constructor TXPathBinary.Create(ABinary: string; Args: TXPathTerms); +begin + inherited Create; + Assert(Length(Args) = 2, 'Comparators must have two arguments'); + FLeftTerm := Args[0]; + FRightTerm := Args[1]; + FBinary := BinaryFromString(ABinary); +end; + +function TXPathBinary.Evaluate(Node: IXMLDOMNode): TValue; +var + LeftStatement, RightStatement: IXPathStatement; + LeftExpression, RightExpression: IXPathExpression; + LeftNodes, RightNodes: IXMLDOMNodeList; + LeftResult, RightResult: Boolean; +begin + Result := False; + LeftResult := False; + RightResult := False; + + if Supports(FLeftTerm, IXPathExpression, LeftExpression) then + begin + LeftNodes := LeftExpression.Evaluate(Node); + LeftResult := (LeftNodes <> nil) and (LeftNodes.Length > 0); + end + else if Supports(FLeftTerm, IXPathStatement, LeftStatement) then + LeftResult := LeftStatement.Evaluate(Node).AsBoolean; + + if Supports(FRightTerm, IXPathExpression, RightExpression) then + begin + RightNodes := RightExpression.Evaluate(Node); + RightResult := (RightNodes <> nil) and (RightNodes.Length > 0); + end + else if Supports(FRightTerm, IXPathStatement, RightStatement) then + RightResult := RightStatement.Evaluate(Node).AsBoolean; + + case FBinary of + _and: // logically "AND" the expressions + Result := LeftResult and RightResult; + _or: // logically "OR" the expressions + begin + Result := LeftResult or RightResult; + end; + end; +end; + +{ TXPathUnary } + +constructor TXPathUnary.Create(AUnary: string; Args: TXPathTerms); +begin + inherited Create; + Assert(Length(Args) = 1, 'Unary must have one argument'); + FTerm := Args[0]; + FUnary := UnaryFromString(AUnary); +end; + +function TXPathUnary.Evaluate(Node: IXMLDOMNode): TValue; +var + Statement: IXPathStatement; + Expression: IXPathExpression; + Nodes: IXMLDOMNodeList; +begin + Result := False; + if Supports(FTerm, IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + Result := (Nodes <> nil) and (Nodes.Length > 0); + end + else if Supports(FTerm, IXPathStatement, Statement) then + Result := Statement.Evaluate(Node); + + case FUnary of + straight: + ; // do nothing + negation: + Result := not Result.AsBoolean; + end; +end; + +function TXPathUnary.UnaryFromString(AUnary: string): TUnaryOperator; +begin + if SameText('', AUnary) then + Result := straight + // else if SameText('not', AUnary) then + else + Result := negation; +end; + +{ TXpathPathExpression } + +constructor TXPathExpression.Create(AXPath: string); +begin + inherited Create; + FXPath := AXPath; +end; + +function TXPathExpression.Evaluate(Node: IXMLDOMNode): IXMLDOMNodeList; +begin + // try + // if FXPath.StartsWith('''') then + + Result := Node.selectNodes(FXPath); + // except + // Result := nil; // should this be logged ? + // end; +end; + +function TXPathExpression.GetValue: string; +begin + Result := FXPath; +end; + +function TXPathExpression.IsAttribute: Boolean; +begin + Result := FXPath.EndsWith('@value', True); +end; + +{ TXPathFunction } + +constructor TXPathFunction.Create(AFunction: string; Args: TXPathTerms); +var + I: Integer; +begin + inherited Create; + FFunction := AFunction; + SetLength(FArgs, Length(Args)); + for I := 0 to Length(Args) - 1 do + begin + FArgs[I] := Args[I]; + end; +end; + +function TXPathFunction.Evaluate(Node: IXMLDOMNode): TValue; +var + Constant: IXPathConstant; + Statement: IXPathStatement; + Expression: IXPathExpression; + Nodes: IXMLDOMNodeList; + Match: string; +begin + Result := False; + + if SameText('exists', FFunction) then + begin + if Supports(FArgs[0], IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + Result := (Nodes <> nil) and (Nodes.Length > 0); + end + else if Supports(FArgs[0], IXPathStatement, Statement) then + Result := Statement.Evaluate(Node); + end + else if SameText('concat', FFunction) then + begin + // todo: needs refinment + if Supports(FArgs[0], IXPathConstant, Constant) then + Result := Constant.GetValue + else if Supports(FArgs[0], IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + if Supports(FArgs[1], IXPathExpression, Expression) then + begin + Match := Expression.GetValue; // strip off the quotes + Match := Match.Replace('''', '').Replace('"', ''); + if (Nodes <> nil) and (Nodes.Length = 1) then // todo: iterate through nodes ?? + Result := Pos(Match, Nodes[0].nodeValue) = 1; + end; + end; + end + else if SameText('starts-with', FFunction) then + begin + + if Supports(FArgs[0], IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + if Supports(FArgs[1], IXPathExpression, Expression) then + begin + Match := Expression.GetValue; // strip off the quotes + Match := Match.Replace('''', '').Replace('"', ''); + if (Nodes <> nil) and (Nodes.Length = 1) then // todo: iterate through nodes ?? + Result := Pos(Match, Nodes[0].nodeValue) = 1; + end + else if Supports(FArgs[1], IXPathConstant, Constant) then + begin + Match := Constant.GetValue.AsString; + Match := Match.Replace('''', '').Replace('"', ''); + if (Nodes <> nil) and (Nodes.Length = 1) then // todo: iterate through nodes ?? + Result := Pos(Match, Nodes[0].nodeValue) = 1; + end; + + end; + end + else if SameText('count', FFunction) then + begin + Result := 0; + if Supports(FArgs[0], IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + if Nodes <> nil then + Result := Nodes.Length; + end + else if Supports(FArgs[0], IXPathStatement, Statement) then + Result := Statement.Evaluate(Node); + end + else if SameText('number', FFunction) then + begin + Result := 0; + if Supports(FArgs[0], IXPathExpression, Expression) then + begin + Nodes := Expression.Evaluate(Node); + if Nodes.Length = 0 then + Result := 0 + else + begin + if string(Nodes[0].nodeValue).Contains('.') then + Result := StrToFloat(string(Nodes[0].nodeValue)) + else + Result := StrToInt64(string(Nodes[0].nodeValue)); + end; + end + else if Supports(FArgs[0], IXPathStatement, Statement) then + Result := Statement.Evaluate(Node); + end; + +end; + +{ TXPathConstant } + +constructor TXPathConstant.Create(AValue: string); +var + Tmp: Int64; +begin + inherited Create; + if AValue.StartsWith('''') or AValue.StartsWith('"') then + AValue := Copy(AValue, 2); + if AValue.EndsWith('''') or AValue.EndsWith('"') then + AValue := Copy(AValue, 1, Length(AValue) - 1); + if Tmp.TryParse(AValue, Tmp) then + FValue := Tmp + else + FValue := AValue; +end; + +function TXPathConstant.GetValue: TValue; +begin + Result := FValue; +end; + +end. + diff --git a/test/DXMLExtensionsTests.dpr b/test/DXMLExtensionsTests.dpr new file mode 100644 index 0000000..e31d247 --- /dev/null +++ b/test/DXMLExtensionsTests.dpr @@ -0,0 +1,30 @@ +program DXMLExtensionTests; +{ + + Delphi DUnit Test Project + ------------------------- + This project contains the DUnit test framework and the GUI/Console test runners. + Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options + to use the console test runner. Otherwise the GUI test runner will be used by + default. + +} + +{$IFDEF CONSOLE_TESTRUNNER} +{$APPTYPE CONSOLE} +{$ENDIF} + +uses + DUnitTestRunner, + TestuXPathExtensions in 'TestuXPathExtensions.pas', + DXMLPathExtensions in '..\DXMLPathExtensions.pas', + DXMLPathExtensions.Utils in '..\DXMLPathExtensions.Utils.pas', + TestuXMLUtils in 'TestuXMLUtils.pas'; + +{$R *.RES} + +begin + DUnitTestRunner.RunRegisteredTests; +end. + + diff --git a/test/DXMLExtensionsTests.dproj b/test/DXMLExtensionsTests.dproj new file mode 100644 index 0000000..1a2f3eb --- /dev/null +++ b/test/DXMLExtensionsTests.dproj @@ -0,0 +1,1295 @@ + + + {8E9C6577-5211-4D97-AC9E-36C6899DF34D} + 19.2 + None + True + Debug + Win32 + 1 + Console + DXMLExtensionTests.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + . + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\Source\DUnit\src;..\;$(DCC_UnitSearchPath) + _CONSOLE_TESTRUNNER;$(DCC_Define) + DXMLExtensionTests + 5129 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts + Debug + true + Base + true + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXInterBaseDriver;emsclientfiredac;tethering;DataSnapFireDAC;FireDACMSSQLDriver;bindcompfmx;DBXOracleDriver;inetdb;FmxTeeUI;fmx;FireDACIBDriver;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;ibxbindings;rtl;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;bindcomp;DBXInformixDriver;IndyIPClient;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage);$(DCC_UsePackage) + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;OmniThreadLibraryRuntime;vclactnband;vclFireDAC;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;VirtualTreesDR;FmxTeeUI;emsedge;fmx;FireDACIBDriver;fmxdae;vclib;DMVC_IDE_Expert_D103Rio;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;OmniThreadLibraryRuntime;vclactnband;vclFireDAC;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;VirtualTreesDR;FmxTeeUI;emsedge;fmx;FireDACIBDriver;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;DBXOdbcDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;emsserverresource;DbxClientDriver;FireDACDSDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + 1033 + (None) + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + DXMLExtensionTests.dpr + + + DBExpress Enterprise Data Explorer Integration + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + true + + + + + true + + + + + DXMLExtensionTests.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + False + False + False + False + True + False + + + DUnit / Delphi Win32 + GUI + + + + + 12 + + + + + + diff --git a/test/TestuXMLUtils.pas b/test/TestuXMLUtils.pas new file mode 100644 index 0000000..3308e46 --- /dev/null +++ b/test/TestuXMLUtils.pas @@ -0,0 +1,340 @@ +// *************************************************************************** +// +// Delphi XML Extensions +// +// Copyright (c) 2017-2019 David Moorhouse +// +// https://github.com/fastbike/DelphiXMLExtensions +// +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + +unit TestuXMLUtils; +{ + + Delphi DUnit Test Case + ---------------------- + This unit contains a skeleton test case class generated by the Test Case Wizard. + Modify the generated code to correctly setup and call the methods from the unit + being tested. + +} + +interface + +uses + TestFramework, Winapi.ActiveX, DXMLPathExtensions.Utils, Xml.XMLDom, System.SysUtils, + Xml.adomxmldom, Winapi.msxml, System.Win.ComObj, Xml.XMLDoc, Xml.XMLIntf, + Winapi.msxmlIntf, Xml.Win.msxmldom; + +type + // Test methods for class TXPath + + TestTXPath = class(TTestCase) + strict private + private + // FXPath: TXPath; + public + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestSimpleXPath; + + procedure TestAppendElement_Normal; + procedure TestInsertElement_Normal; + procedure TestInsertFirstSibling_Normal; + + procedure TestInsertElementWithAttribute; + + procedure TestInsertElementWithAttributeNoNS; + procedure TestInsertElementWithAttributeNoTopLevelNS; + + + + procedure TestAppenAttribute_Normal; + + procedure TestParseMalformedXML; + procedure TestResolveExternalsIsFalse; + + procedure TestParseXMLContainingEntityNode; + + + procedure TestHasTopLevelNamespace; + end; + +implementation + + +procedure TestTXPath.SetUp; +begin + // FXPath := TXPath.Create; +end; + +procedure TestTXPath.TearDown; +begin + // FXPath.Free; + // FXPath := nil; +end; + +procedure TestTXPath.TestAppenAttribute_Normal; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + // Doc.resolveExternals + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/a:Patient/a:identifier'); + Parent := Nodes[0]; + + TXPath.AppendAttribute(Parent, 'added').value := 'test'; + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + +procedure TestTXPath.TestAppendElement_Normal; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/a:Patient'); + Parent := Nodes[0]; + Node := TXPath.AppendElement(Parent, 'Test'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + +procedure TestTXPath.TestHasTopLevelNamespace; +begin + raise EProgrammerNotFound.Create('Not yet implemented'); +end; + +procedure TestTXPath.TestInsertFirstSibling_Normal; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Sibling, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/a:Patient/a:identifier'); + Sibling := Nodes[0]; + + Node := TXPath.InsertFirstSibling(Sibling, 'Test'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + +procedure TestTXPath.TestParseMalformedXML; +var + Doc: IXMLDOMDocument3; +begin + try + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + except + on E: EConvertError do + CheckTrue(Pos('Error in Xml Data', E.Message) > 0); + end; +end; + +procedure TestTXPath.TestParseXMLContainingEntityNode; +var + Doc: IXMLDOMDocument3; +begin + try + Doc := TXPath.Create('' + + '' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + except + on E: EConvertError do + CheckTrue(Pos('Error in Xml Data', E.Message) > 0); + end; +end; + +procedure TestTXPath.TestResolveExternalsIsFalse; +var + Doc: IXMLDOMDocument3; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + CheckFalse(Doc.resolveExternals); +end; + +procedure TestTXPath.TestInsertElementWithAttribute; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/a:Patient'); + Parent := Nodes[0]; + Node := TXPath.InsertElementWithValueAttribute(Parent, 'Test', 'abc'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); + +end; + +procedure TestTXPath.TestInsertElementWithAttributeNoNS; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['f']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/f:Patient'); + CheckEquals(0, Nodes.length); + + Nodes := Doc.selectNodes('Patient'); + Parent := Nodes[0]; + Node := TXPath.InsertElementWithValueAttribute(Parent, 'Test', 'abc'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + +procedure TestTXPath.TestInsertElementWithAttributeNoTopLevelNS; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['f']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/f:Patient'); + CheckEquals(0, Nodes.length); + + Nodes := Doc.selectNodes('Patient'); + Parent := Nodes[0]; + Node := TXPath.InsertElementWithValueAttribute(Parent, 'Test', 'abc'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + + +procedure TestTXPath.TestInsertElement_Normal; +var + Actual, Expected: string; + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; + Parent, Node: IXMLDOMNode; +begin + Doc := TXPath.Create('' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + Expected := '' + + '' + + ''; + Nodes := Doc.selectNodes('/a:Patient'); + Parent := Nodes[0]; + Node := TXPath.InsertElement(Parent, 'Test'); + Actual := Doc.Xml; + CheckEquals(Expected, Actual); +end; + +procedure TestTXPath.TestSimpleXPath; +// const +// { NB: order is important as they are evaluated in the order they are declared } +// SystemValues: array [0 .. 2, 0 .. 1] of string = (('official', 'https://standards.digital.health.nz/id/nhi'), +// ('official', 'urn:oid:2.16.840.1.113883.2.18.2'), ('common', 'NHI')); +var + Doc: IXMLDOMDocument3; + Nodes: IXMLDOMNodeList; +begin + // + Doc := TXPath.Create('' + + '' + + '' + + '' + + '', ['http://hl7.org/fhir'], ['a']); + + Nodes := Doc.selectNodes('/a:Patient/a:identifier/a:system[@value="NHI"]/../a:use[@value="common"]/../a:value/@value'); + CheckEquals(1, Nodes.length); + CheckEquals('ZAA0121', Nodes[0].nodeValue); + + Nodes := Doc.selectNodes + ('/a:Patient/a:identifier/a:system[@value="https://standards.digital.health.nz/id/nhi"]/../a:use[@value="official"]/../a:value/@value'); + CheckEquals(1, Nodes.length); + CheckEquals('ZAA0122', Nodes[0].nodeValue); + + Nodes := Doc.selectNodes + ('/a:Patient/a:identifier/a:system[@value="urn:oid:2.16.840.1.113883.2.18.2"]/../a:use[@value="official"]/../a:value/@value'); + CheckEquals(1, Nodes.length); + CheckEquals('ZAA0123', Nodes[0].nodeValue); + + Nodes := Doc.selectNodes('/a:Patient/a:identifier/a:use[@value="official"]/../a:value/@value'); + CheckEquals(2, Nodes.length); + CheckEquals('ZAA0122', Nodes[0].nodeValue); + CheckEquals('ZAA0123', Nodes[1].nodeValue); + +end; + +initialization + +// Register any test cases with the test runner +RegisterTest(TestTXPath.Suite); + +end. + diff --git a/test/TestuXPathExtensions.pas b/test/TestuXPathExtensions.pas new file mode 100644 index 0000000..dccb112 --- /dev/null +++ b/test/TestuXPathExtensions.pas @@ -0,0 +1,558 @@ +// *************************************************************************** +// +// Delphi XML Extensions +// +// Copyright (c) 2017-2021 David Moorhouse +// +// https://github.com/fastbike/DelphiXMLExtensions +// +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** } + +unit TestuXPathExtensions; +{ + + Delphi DUnit Test Case + ---------------------- + This unit contains a skeleton test case class generated by the Test Case Wizard. + Modify the generated code to correctly setup and call the methods from the unit + being tested. + +} + +interface + +uses + TestFramework, System.Classes, DXMLPathExtensions; + +type + // Test methods for class TXPathEvaluator + + TestXPathExtensions = class(TTestCase) + strict private + FEvaluator: TXPathEvaluator; + private + public + procedure TearDown; override; + published + procedure Test1; + procedure Test1a; + procedure Test2; + procedure Test3; + procedure Test4; + procedure Test4a; + procedure Test5; + procedure Test5a; + procedure Test5b; + procedure Test5c; + procedure Test5d; + procedure Test6; + procedure Test7; + procedure Test8; + procedure Test8a; + procedure Test8b; + procedure Test9; + procedure Test10; + procedure Test11; + procedure Test12; + procedure Test12a; + procedure Test12b; + + end; + +implementation + +uses + Winapi.msxmlIntf, DXMLPathExtensions.Utils; + +{ TestXPathExtensions } + +procedure TestXPathExtensions.TearDown; +begin + FEvaluator.Free; + +end; + +procedure TestXPathExtensions.Test1; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('not(f:contained)'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test1a; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('f:contained'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test2; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('parent::f:contained and f:contained'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test3; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('not(parent::f:contained and f:contained)'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test4; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // FEvaluator := TContentList.Create('not(exists(f:contained/*/f:meta/f:versionId)) and not(exists(f:contained/*/f:meta/f:lastUpdated))'); + FEvaluator := TXPathEvaluator.Create('not(exists(f:contained/*/f:meta/f:versionId))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test4a; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create + ('not(exists(f:contained/*/f:meta/f:versionId)) and not(exists(f:contained/*/f:meta/f:lastUpdated))'); + // FEvaluator := TContentList.Create('not(exists(f:contained/*/f:meta/f:versionId))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test5; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // single quotes + FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, ''#'')'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); + // double quotes + FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, "#")'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test5a; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // single quotes + FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, ''#'')'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); + // double quotes + FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, "#")'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test5b; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // single quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, ''#''))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); + // double quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, "#"))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test5c; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + // single quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, ''#''))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); + // double quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, "#"))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test5d; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + // single quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value,''pat''))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); + // double quotes + FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value,"pat"))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test6; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // todo: change quotes ?? + + + // FEvaluator := TXPathEvaluator.Create('exists(ancestor::*[self::f:entry or self::f:parameter]/f:resource/f:*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, "#")]|/*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, "#")])'); + + FEvaluator := TXPathEvaluator.Create + ('ancestor::*[self::f:entry or self::f:parameter]/f:resource/f:*/f:contained/f:*[f:id/@value=substring-after(/f:reference/@value, "#")]'); + + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test7; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, "#") or starts-with(//f:reference/@value, "?")'); + // FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, ''#''))'); + + + // FEvaluator := TXPathEvaluator.Create('(count(f:numerator) = count(f:denominator))');// and ((count(f:numerator) > 0) or (count(f:extension) > 0)) + // (count(f:numerator) = count(f:denominator)) and ((count(f:numerator) > 0) or (count(f:extension) > 0)) + + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test8; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // FEvaluator := TXPathEvaluator.Create('starts-with(//f:reference/@value, "#") or starts-with(//f:reference/@value, "?")'); + // FEvaluator := TXPathEvaluator.Create('not(starts-with(//f:reference/@value, ''#'') or starts-with(//f:reference/@value, "?"))'); + + FEvaluator := TXPathEvaluator.Create('(count(//f:reference) >= count(/f:subject))'); + // and ((count(f:numerator) > 0) or (count(f:extension) > 0)) + // (count(f:numerator) = count(f:denominator)) and ((count(f:numerator) > 0) or (count(f:extension) > 0)) + + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test8a; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // operand as number + FEvaluator := TXPathEvaluator.Create('(count(//f:reference) = 1)'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); + // operand as text + FEvaluator := TXPathEvaluator.Create('(count(//f:reference) = "1")'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test8b; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // comparator as non standard "not equals" + FEvaluator := TXPathEvaluator.Create('(count(//f:reference) <> 0)'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test9; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create + ('not(starts-with(f:reference/@value, "#")) or exists(ancestor::*[self::f:entry or self::f:parameter]/f:resource/f:*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, "#")]' + + '|/*/f:contained/f:*[f:id/@value=substring-after(current()/f:reference/@value, "#")])'); + + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test10; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // 'not(exists(for $id in f:contained/*/@id return $id[not(ancestor::f:contained/parent::*/descendant::f:reference/@value=concat(''#'', $id))]))' + + // this is broken as it cannot handle the first "=" symbol + FEvaluator := TXPathEvaluator.Create + ('not(exists(ancestor::f:contained/parent::*/descendant::f:reference/@value=concat("#", "123")))'); + + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test11; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := ''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + // this will fail because not allowed to contain count and type + FEvaluator := TXPathEvaluator.Create('not(f:total) or (f:type/@value = ''searchset'') or (f:type/@value = "history")'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); + + // this will pass because is allowed to contain count and type + FEvaluator := TXPathEvaluator.Create('(f:total) or (f:type/@value = ''searchset'') or (f:type/@value = "history")'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test12; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := '' + +'' + +''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('not(exists(//f:low/f:value/@value)) or not(exists(//f:high/f:value/@value)) or (number(//f:low/f:value/@value) <= number(//f:high/f:value/@value))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + +procedure TestXPathExtensions.Test12a; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := '' + +'' + +''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('not(exists(//f:low/f:value/@value)) or not(exists(//f:high/f:value/@value)) or (number(//f:low/f:value/@value) <= number(//f:high/f:value/@value))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckFalse(Actual); +end; + +procedure TestXPathExtensions.Test12b; +var + Text: string; + Doc: IXMLDOMDocument3; + Node: IXMLDOMNode; + Actual: Boolean; +begin + Text := '' + +'' + +''; + Doc := TXPath.Create(Text, ['http://hl7.org/fhir'], ['f']); + Node := Doc.documentElement; + + FEvaluator := TXPathEvaluator.Create('not(exists(//f:low/f:value/@value)) or not(exists(//f:high/f:value/@value)) or (number(//f:low/f:value/@value) <= number(//f:high/f:value/@value))'); + FEvaluator.Compile; + Actual := FEvaluator.Evaluate(Node); + CheckTrue(Actual); +end; + + +initialization + +// Register any test cases with the test runner +RegisterTests([TestXPathExtensions.Suite]); + +end. +