mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-31 09:21:43 +01:00
2982 lines
77 KiB
ObjectPascal
2982 lines
77 KiB
ObjectPascal
{
|
|
**********************************************************************
|
|
This file is part of LazUtils.
|
|
It is based on the xpath unit of the Free Component Library.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the license.
|
|
**********************************************************************
|
|
|
|
Implementation of the XML Path Language (XPath) for Free Pascal
|
|
Copyright (c) 2000 - 2003 by
|
|
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
|
|
|
|
}
|
|
|
|
{$mode objfpc}
|
|
{$H+}
|
|
|
|
unit laz2_xpath;
|
|
|
|
interface
|
|
|
|
uses
|
|
Math, SysUtils, Classes, LazUtilsStrConsts,
|
|
laz2_DOM, laz2_xmlutils;
|
|
|
|
type
|
|
TXPathContext = class;
|
|
TXPathEnvironment = class;
|
|
TXPathVariable = class;
|
|
|
|
|
|
{ XPath lexical scanner }
|
|
|
|
TXPathToken = ( // [28] - [38]
|
|
tkInvalid,
|
|
tkEndOfStream,
|
|
tkIdentifier,
|
|
tkNSNameTest, // NCName:*
|
|
tkString,
|
|
tkNumber,
|
|
tkVariable, // $QName
|
|
tkLeftBracket, // "("
|
|
tkRightBracket, // ")"
|
|
tkAsterisk, // "*"
|
|
tkPlus, // "+"
|
|
tkComma, // ","
|
|
tkMinus, // "-"
|
|
tkDot, // "."
|
|
tkDotDot, // ".."
|
|
tkSlash, // "/"
|
|
tkSlashSlash, // "//"
|
|
tkColonColon, // "::"
|
|
tkLess, // "<"
|
|
tkLessEqual, // "<="
|
|
tkEqual, // "="
|
|
tkNotEqual, // "!="
|
|
tkGreater, // ">"
|
|
tkGreaterEqual, // ">="
|
|
tkAt, // "@"
|
|
tkLeftSquareBracket, // "["
|
|
tkRightSquareBracket, // "]"
|
|
tkPipe // "|"
|
|
);
|
|
|
|
TXPathKeyword = (
|
|
// axis names
|
|
xkNone, xkAncestor, xkAncestorOrSelf, xkAttribute, xkChild,
|
|
xkDescendant, xkDescendantOrSelf, xkFollowing, xkFollowingSibling,
|
|
xkNamespace, xkParent, xkPreceding, xkPrecedingSibling, xkSelf,
|
|
// node tests
|
|
xkComment, xkText, xkProcessingInstruction, xkNode,
|
|
// operators
|
|
xkAnd, xkOr, xkDiv, xkMod,
|
|
// standard functions
|
|
xkLast, xkPosition, xkCount, xkId, xkLocalName, xkNamespaceUri,
|
|
xkName, xkString, xkConcat, xkStartsWith, xkContains,
|
|
xkSubstringBefore, xkSubstringAfter, xkSubstring,
|
|
xkStringLength, xkNormalizeSpace, xkTranslate, xkBoolean,
|
|
xkNot, xkTrue, xkFalse, xkLang, xkNumber, xkSum, xkFloor,
|
|
xkCeiling, xkRound
|
|
);
|
|
|
|
{ XPath expression parse tree }
|
|
|
|
TXPathExprNode = class
|
|
protected
|
|
function EvalPredicate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): Boolean;
|
|
public
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; virtual; abstract;
|
|
end;
|
|
|
|
TXPathNodeArray = array of TXPathExprNode;
|
|
|
|
TXPathConstantNode = class(TXPathExprNode)
|
|
private
|
|
FValue: TXPathVariable;
|
|
public
|
|
constructor Create(AValue: TXPathVariable);
|
|
destructor Destroy; override;
|
|
function Evaluate({%H-}AContext: TXPathContext;
|
|
{%H-}AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
TXPathVariableNode = class(TXPathExprNode)
|
|
private
|
|
FName: DOMString;
|
|
public
|
|
constructor Create(const AName: DOMString);
|
|
function Evaluate({%H-}AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
TXPathFunctionNode = class(TXPathExprNode)
|
|
private
|
|
FName: DOMString;
|
|
FArgs: TXPathNodeArray;
|
|
public
|
|
constructor Create(const AName: DOMString; const Args: TXPathNodeArray);
|
|
destructor Destroy; override;
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
TXPathNegationNode = class(TXPathExprNode)
|
|
private
|
|
FOperand: TXPathExprNode;
|
|
public
|
|
constructor Create(AOperand: TXPathExprNode);
|
|
destructor Destroy; override;
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
// common ancestor for binary operations
|
|
|
|
TXPathBinaryNode = class(TXPathExprNode)
|
|
protected
|
|
FOperand1, FOperand2: TXPathExprNode;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
// Node for (binary) mathematical operation
|
|
|
|
TXPathMathOp = (opAdd, opSubtract, opMultiply, opDivide, opMod);
|
|
|
|
TXPathMathOpNode = class(TXPathBinaryNode)
|
|
private
|
|
FOperator: TXPathMathOp;
|
|
public
|
|
constructor Create(AOperator: TXPathMathOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
// Node for comparison operations
|
|
|
|
TXPathCompareOp = (opEqual, opNotEqual, opLess, opLessEqual, opGreater,
|
|
opGreaterEqual);
|
|
|
|
TXPathCompareNode = class(TXPathBinaryNode)
|
|
private
|
|
FOperator: TXPathCompareOp;
|
|
public
|
|
constructor Create(AOperator: TXPathCompareOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
// Node for boolean operations (and, or)
|
|
|
|
TXPathBooleanOp = (opOr, opAnd);
|
|
|
|
TXPathBooleanOpNode = class(TXPathBinaryNode)
|
|
private
|
|
FOperator: TXPathBooleanOp;
|
|
public
|
|
constructor Create(AOperator: TXPathBooleanOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
// Node for unions (see [18])
|
|
|
|
TXPathUnionNode = class(TXPathBinaryNode)
|
|
public
|
|
constructor Create(AOperand1, AOperand2: TXPathExprNode);
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
TNodeSet = TFPList;
|
|
|
|
// Filter node (for [20])
|
|
|
|
TXPathFilterNode = class(TXPathExprNode)
|
|
private
|
|
FLeft: TXPathExprNode;
|
|
FPredicates: TXPathNodeArray;
|
|
procedure ApplyPredicates(Nodes: TNodeSet; AEnvironment: TXPathEnvironment);
|
|
public
|
|
constructor Create(AExpr: TXPathExprNode);
|
|
destructor Destroy; override;
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
|
|
// Node for location paths
|
|
|
|
TAxis = (axisInvalid, axisAncestor, axisAncestorOrSelf, axisAttribute,
|
|
axisChild, axisDescendant, axisDescendantOrSelf, axisFollowing,
|
|
axisFollowingSibling, axisNamespace, axisParent, axisPreceding,
|
|
axisPrecedingSibling, axisSelf, axisRoot);
|
|
|
|
TNodeTestType = (ntAnyPrincipal, ntName, ntTextNode,
|
|
ntCommentNode, ntPINode, ntAnyNode);
|
|
|
|
TStep = class(TXPathFilterNode)
|
|
private
|
|
procedure SelectNodes(ANode: TDOMNode; out ResultNodes: TNodeSet);
|
|
public
|
|
Axis: TAxis;
|
|
NodeTestType: TNodeTestType;
|
|
NodeTestString: DOMString;
|
|
NSTestString: DOMString;
|
|
constructor Create(aAxis: TAxis; aTest: TNodeTestType);
|
|
function Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable; override;
|
|
end;
|
|
|
|
{ Exceptions }
|
|
|
|
EXPathEvaluationError = class(Exception);
|
|
|
|
procedure EvaluationError(const Msg: String);
|
|
procedure EvaluationError(const Msg: String; const Args: array of const);
|
|
|
|
|
|
type
|
|
|
|
{ XPath variables and results classes }
|
|
|
|
TXPathVariable = class
|
|
protected
|
|
FRefCount: Integer;
|
|
procedure Error(const Msg: String; const Args: array of const);
|
|
public
|
|
class function TypeName: String; virtual; abstract;
|
|
procedure Release;
|
|
function AsNodeSet: TNodeSet; virtual;
|
|
function AsBoolean: Boolean; virtual; abstract;
|
|
function AsNumber: Extended; virtual; abstract;
|
|
function AsText: DOMString; virtual; abstract;
|
|
end;
|
|
|
|
TXPathNodeSetVariable = class(TXPathVariable)
|
|
private
|
|
FValue: TNodeSet;
|
|
public
|
|
constructor Create(AValue: TNodeSet);
|
|
destructor Destroy; override;
|
|
class function TypeName: String; override;
|
|
function AsNodeSet: TNodeSet; override;
|
|
function AsText: DOMString; override;
|
|
function AsBoolean: Boolean; override;
|
|
function AsNumber: Extended; override;
|
|
property Value: TNodeSet read FValue;
|
|
end;
|
|
|
|
TXPathBooleanVariable = class(TXPathVariable)
|
|
private
|
|
FValue: Boolean;
|
|
public
|
|
constructor Create(AValue: Boolean);
|
|
class function TypeName: String; override;
|
|
function AsBoolean: Boolean; override;
|
|
function AsNumber: Extended; override;
|
|
function AsText: DOMString; override;
|
|
property Value: Boolean read FValue;
|
|
end;
|
|
|
|
TXPathNumberVariable = class(TXPathVariable)
|
|
private
|
|
FValue: Extended;
|
|
public
|
|
constructor Create(AValue: Extended);
|
|
class function TypeName: String; override;
|
|
function AsBoolean: Boolean; override;
|
|
function AsNumber: Extended; override;
|
|
function AsText: DOMString; override;
|
|
property Value: Extended read FValue;
|
|
end;
|
|
|
|
TXPathStringVariable = class(TXPathVariable)
|
|
private
|
|
FValue: DOMString;
|
|
public
|
|
constructor Create(const AValue: DOMString);
|
|
class function TypeName: String; override;
|
|
function AsBoolean: Boolean; override;
|
|
function AsNumber: Extended; override;
|
|
function AsText: DOMString; override;
|
|
property Value: DOMString read FValue;
|
|
end;
|
|
|
|
TXPathNSResolver = class
|
|
protected
|
|
FNode: TDOMNode;
|
|
public
|
|
constructor Create(aNode: TDOMNode);
|
|
function LookupNamespaceURI(const aPrefix: DOMString): DOMString; virtual;
|
|
end;
|
|
|
|
{ XPath lexical scanner }
|
|
|
|
TXPathScanner = class
|
|
private
|
|
FExpressionString, FCurData: DOMPChar;
|
|
FCurToken: TXPathToken;
|
|
FCurTokenString: DOMString;
|
|
FTokenStart: DOMPChar;
|
|
FTokenLength: Integer;
|
|
FPrefixLength: Integer;
|
|
FTokenId: TXPathKeyword;
|
|
FResolver: TXPathNSResolver;
|
|
procedure Error(const Msg: String);
|
|
procedure ParsePredicates(var Dest: TXPathNodeArray);
|
|
function ParseStep: TStep; // [4]
|
|
function ParseNodeTest(axis: TAxis): TStep; // [7]
|
|
function ParsePrimaryExpr: TXPathExprNode; // [15]
|
|
function ParseFunctionCall: TXPathExprNode; // [16]
|
|
function ParseUnionExpr: TXPathExprNode; // [18]
|
|
function ParsePathExpr: TXPathExprNode; // [19]
|
|
function ParseFilterExpr: TXPathExprNode; // [20]
|
|
function ParseOrExpr: TXPathExprNode; // [21]
|
|
function ParseAndExpr: TXPathExprNode; // [22]
|
|
function ParseEqualityExpr: TXPathExprNode; // [23]
|
|
function ParseRelationalExpr: TXPathExprNode; // [24]
|
|
function ParseAdditiveExpr: TXPathExprNode; // [25]
|
|
function ParseMultiplicativeExpr: TXPathExprNode; // [26]
|
|
function ParseUnaryExpr: TXPathExprNode; // [27]
|
|
function GetToken: TXPathToken;
|
|
function ScanQName: Boolean;
|
|
public
|
|
constructor Create(const AExpressionString: DOMString);
|
|
function NextToken: TXPathToken;
|
|
function PeekToken: TXPathToken;
|
|
function SkipToken(tok: TXPathToken): Boolean;
|
|
property CurToken: TXPathToken read FCurToken;
|
|
property CurTokenString: DOMString read FCurTokenString;
|
|
end;
|
|
|
|
|
|
{ XPath context }
|
|
|
|
TXPathContext = class
|
|
public
|
|
ContextNode: TDOMNode;
|
|
ContextPosition: Integer;
|
|
ContextSize: Integer;
|
|
|
|
constructor Create(AContextNode: TDOMNode;
|
|
AContextPosition, AContextSize: Integer);
|
|
end;
|
|
|
|
|
|
{ XPath environments (not defined in XPath standard: an environment contains
|
|
the variables and functions, which are part of the context in the official
|
|
standard). }
|
|
|
|
TXPathVarList = TFPList;
|
|
|
|
TXPathFunction = function(Context: TXPathContext; Args: TXPathVarList):
|
|
TXPathVariable of object;
|
|
|
|
TXPathEnvironment = class
|
|
private
|
|
FFunctions: TFPList;
|
|
FVariables: TFPList;
|
|
function GetFunctionCount: Integer;
|
|
function GetVariableCount: Integer;
|
|
function GetFunction(Index: Integer): TXPathFunction;
|
|
function GetFunction(const AName: String): TXPathFunction;
|
|
function GetVariable(Index: Integer): TXPathVariable;
|
|
function GetVariable(const AName: String): TXPathVariable;
|
|
protected
|
|
// XPath Core Function Library:
|
|
function xpLast(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpPosition(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpCount({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpNamespaceURI(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpConcat({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpStartsWith({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpContains({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpSubstringBefore({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpSubstringAfter({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpSubstring({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpNormalizeSpace(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpTranslate({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpBoolean({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpNot({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpTrue({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpFalse({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpSum({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpFloor({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpCeiling({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
function xpRound({%H-}Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function GetFunctionIndex(const AName: String): Integer;
|
|
function GetVariableIndex(const AName: String): Integer;
|
|
procedure AddFunction(const AName: String; AFunction: TXPathFunction);
|
|
procedure AddVariable(const AName: String; AVariable: TXPathVariable);
|
|
procedure RemoveFunction(Index: Integer);
|
|
procedure RemoveFunction(const AName: String);
|
|
procedure RemoveVariable(Index: Integer);
|
|
procedure RemoveVariable(const AName: String);
|
|
property FunctionCount: Integer read GetFunctionCount;
|
|
property VariableCount: Integer read GetVariableCount;
|
|
property Functions[Index: Integer]: TXPathFunction read GetFunction;
|
|
property FunctionsByName[const AName: String]: TXPathFunction
|
|
read GetFunction;
|
|
property Variables[Index: Integer]: TXPathVariable read GetVariable;
|
|
property VariablesByName[const AName: String]: TXPathVariable read GetVariable;
|
|
end;
|
|
|
|
|
|
{ XPath expressions }
|
|
|
|
TXPathExpression = class
|
|
private
|
|
FRootNode: TXPathExprNode;
|
|
public
|
|
{ CompleteExpresion specifies wether the parser should check for gargabe
|
|
after the recognised part. True => Throw exception if there is garbage }
|
|
constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean;
|
|
AResolver: TXPathNSResolver = nil);
|
|
destructor Destroy; override;
|
|
function Evaluate(AContextNode: TDOMNode): TXPathVariable;
|
|
function Evaluate(AContextNode: TDOMNode;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
end;
|
|
|
|
|
|
function EvaluateXPathExpression(const AExpressionString: DOMString;
|
|
AContextNode: TDOMNode; AResolver: TXPathNSResolver = nil): TXPathVariable;
|
|
|
|
|
|
// ===================================================================
|
|
// ===================================================================
|
|
|
|
implementation
|
|
|
|
const
|
|
XPathKeywords: array [TXPathKeyword] of DOMPChar = (
|
|
'',
|
|
#08'ancestor',
|
|
#16'ancestor-or-self',
|
|
#09'attribute',
|
|
#05'child',
|
|
#10'descendant',
|
|
#18'descendant-or-self',
|
|
#09'following',
|
|
#17'following-sibling',
|
|
#09'namespace',
|
|
#06'parent',
|
|
#09'preceding',
|
|
#17'preceding-sibling',
|
|
#04'self',
|
|
#07'comment',
|
|
#04'text',
|
|
#22'processing-instruction',
|
|
#04'node',
|
|
#03'and',
|
|
#02'or',
|
|
#03'div',
|
|
#03'mod',
|
|
#04'last',
|
|
#08'position',
|
|
#05'count',
|
|
#02'id',
|
|
#10'local-name',
|
|
#13'namespace-uri',
|
|
#04'name',
|
|
#06'string',
|
|
#06'concat',
|
|
#11'starts-with',
|
|
#08'contains',
|
|
#16'substring-before',
|
|
#15'substring-after',
|
|
#09'substring',
|
|
#13'string-length',
|
|
#15'normalize-space',
|
|
#09'translate',
|
|
#07'boolean',
|
|
#03'not',
|
|
#04'true',
|
|
#05'false',
|
|
#04'lang',
|
|
#06'number',
|
|
#03'sum',
|
|
#05'floor',
|
|
#07'ceiling',
|
|
#05'round'
|
|
);
|
|
|
|
{ The following code is not very maintainable because it was hand-ported from
|
|
C code generated by gperf. Unless a tool like gperf is ported or modified to
|
|
generate Pascal, modifying it will be painful.
|
|
The good side is that one shouldn't ever need to modify it. }
|
|
|
|
MaxHash = 55;
|
|
|
|
KeywordIndex: array[0..MaxHash-1] of TXPathKeyword = (
|
|
xkNone, xkNone,
|
|
xkId,
|
|
xkNone, xkNone, xkNone,
|
|
xkString,
|
|
xkSum,
|
|
xkParent,
|
|
xkSubstring,
|
|
xkNone,
|
|
xkComment,
|
|
xkName,
|
|
xkStringLength,
|
|
xkNumber,
|
|
xkSubstringAfter,
|
|
xkSubstringBefore,
|
|
xkNamespace,
|
|
xkFloor,
|
|
xkNormalizeSpace,
|
|
xkSelf,
|
|
xkNamespaceUri,
|
|
xkPreceding,
|
|
xkOr,
|
|
xkPosition,
|
|
xkText,
|
|
xkProcessingInstruction,
|
|
xkConcat,
|
|
xkLast,
|
|
xkContains,
|
|
xkPrecedingSibling,
|
|
xkAncestor,
|
|
xkFalse,
|
|
xkLocalName,
|
|
xkCount,
|
|
xkLang,
|
|
xkFollowing,
|
|
xkDescendant,
|
|
xkNode,
|
|
xkAncestorOrSelf,
|
|
xkBoolean,
|
|
xkNot,
|
|
xkStartsWith,
|
|
xkAnd,
|
|
xkFollowingSibling,
|
|
xkDescendantOrSelf,
|
|
xkChild,
|
|
xkTrue,
|
|
xkCeiling,
|
|
xkMod,
|
|
xkDiv,
|
|
xkRound,
|
|
xkNone,
|
|
xkAttribute,
|
|
xkTranslate
|
|
);
|
|
|
|
AssoValues: array[97..122] of Byte = (
|
|
10, 31, 0, 13, 30, 11, 55, 55, 0, 41,
|
|
55, 10, 16, 4, 21, 2, 55, 17, 0, 14,
|
|
34, 29, 34, 55, 7, 55
|
|
);
|
|
|
|
function LookupXPathKeyword(p: DOMPChar; Len: Integer): TXPathKeyword;
|
|
var
|
|
hash: Integer;
|
|
p1: DOMPChar;
|
|
begin
|
|
result := xkNone;
|
|
hash := Len;
|
|
if Len >= 1 then
|
|
begin
|
|
if (p^ >= 'a') and (p^ <= 'y') then
|
|
Inc(hash, AssoValues[ord(p^)])
|
|
else
|
|
Exit;
|
|
if Len > 2 then
|
|
if (p[2] >= 'a') and (p[2] <= 'y') then
|
|
Inc(hash, AssoValues[ord(p[2])+1])
|
|
else
|
|
Exit;
|
|
end;
|
|
if (hash >= 0) and (hash <= MaxHash) then
|
|
begin
|
|
p1 := XPathKeywords[KeywordIndex[hash]];
|
|
if (ord(p1^) = Len) and
|
|
CompareMem(p, p1+1, Len*sizeof(DOMChar)) then
|
|
Result := KeywordIndex[hash];
|
|
end;
|
|
end;
|
|
|
|
const
|
|
AxisNameKeywords = [xkAncestor..xkSelf];
|
|
AxisNameMap: array[xkAncestor..xkSelf] of TAxis = (
|
|
axisAncestor, axisAncestorOrSelf, axisAttribute, axisChild,
|
|
axisDescendant, axisDescendantOrSelf, axisFollowing,
|
|
axisFollowingSibling, axisNamespace, axisParent, axisPreceding,
|
|
axisPrecedingSibling, axisSelf
|
|
);
|
|
NodeTestKeywords = [xkComment..xkNode];
|
|
NodeTestMap: array[xkComment..xkNode] of TNodeTestType = (
|
|
ntCommentNode, ntTextNode, ntPINode, ntAnyNode
|
|
);
|
|
|
|
{ Helper functions }
|
|
|
|
function NodeToText(Node: TDOMNode): DOMString;
|
|
var
|
|
Child: TDOMNode;
|
|
begin
|
|
case Node.NodeType of
|
|
DOCUMENT_NODE, DOCUMENT_FRAGMENT_NODE{, ELEMENT_NODE}:
|
|
begin
|
|
SetLength(Result, 0);
|
|
Child := Node.FirstChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
if Result <> '' then
|
|
Result := Result + LineEnding;
|
|
Result := Result + NodeToText(Child);
|
|
Child := Child.NextSibling;
|
|
end;
|
|
end;
|
|
ELEMENT_NODE:
|
|
Result := Node.TextContent;
|
|
ATTRIBUTE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE, TEXT_NODE,
|
|
CDATA_SECTION_NODE, ENTITY_REFERENCE_NODE:
|
|
Result := Node.NodeValue;
|
|
else Result := '';
|
|
end;
|
|
// !!!: What to do with 'namespace nodes'?
|
|
end;
|
|
|
|
function StrToNumber(const s: DOMString): Extended;
|
|
var
|
|
Code: Integer;
|
|
begin
|
|
Val(s, Result, Code);
|
|
{$push}
|
|
{$r-,q-}
|
|
if Code <> 0 then
|
|
Result := NaN;
|
|
{$pop}
|
|
end;
|
|
|
|
function GetNodeLanguage(aNode: TDOMNode): DOMString;
|
|
var
|
|
Attr: TDomAttr;
|
|
begin
|
|
Result := '';
|
|
if aNode = nil then
|
|
Exit;
|
|
case aNode.NodeType of
|
|
ELEMENT_NODE: begin
|
|
Attr := TDomElement(aNode).GetAttributeNode('xml:lang');
|
|
if Assigned(Attr) then
|
|
Result := Attr.Value
|
|
else
|
|
Result := GetNodeLanguage(aNode.ParentNode);
|
|
end;
|
|
TEXT_NODE, CDATA_SECTION_NODE, ENTITY_REFERENCE_NODE,
|
|
PROCESSING_INSTRUCTION_NODE, COMMENT_NODE:
|
|
Result := GetNodeLanguage(aNode.ParentNode);
|
|
ATTRIBUTE_NODE:
|
|
Result := GetNodeLanguage(TDOMAttr(aNode).OwnerElement);
|
|
end;
|
|
end;
|
|
|
|
procedure AddNodes(var Dst: TXPathNodeArray; const Src: array of TXPathExprNode;
|
|
var Count: Integer);
|
|
var
|
|
L: Integer;
|
|
begin
|
|
if Count > 0 then
|
|
begin
|
|
L := Length(Dst);
|
|
SetLength(Dst, L + Count);
|
|
Move(Src[0], Dst[L], Count*sizeof(TObject));
|
|
Count := 0;
|
|
end;
|
|
end;
|
|
|
|
{ XPath parse tree classes }
|
|
|
|
function TXPathExprNode.EvalPredicate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): Boolean;
|
|
var
|
|
resvar: TXPathVariable;
|
|
begin
|
|
resvar := Evaluate(AContext, AEnvironment);
|
|
try
|
|
if resvar.InheritsFrom(TXPathNumberVariable) then
|
|
Result := resvar.AsNumber = AContext.ContextPosition // TODO: trunc/round?
|
|
else
|
|
Result := resvar.AsBoolean;
|
|
finally
|
|
resvar.Release;
|
|
end;
|
|
end;
|
|
|
|
constructor TXPathConstantNode.Create(AValue: TXPathVariable);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
destructor TXPathConstantNode.Destroy;
|
|
begin
|
|
FValue.Release;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathConstantNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
begin
|
|
Result := FValue;
|
|
Inc(Result.FRefCount);
|
|
end;
|
|
|
|
|
|
constructor TXPathVariableNode.Create(const AName: DOMString);
|
|
begin
|
|
inherited Create;
|
|
FName := AName;
|
|
end;
|
|
|
|
function TXPathVariableNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
begin
|
|
Result := AEnvironment.VariablesByName[FName];
|
|
if not Assigned(Result) then
|
|
EvaluationError(lrsEvalUnknownVariable, [FName]);
|
|
end;
|
|
|
|
|
|
constructor TXPathFunctionNode.Create(const AName: DOMString; const Args: TXPathNodeArray);
|
|
begin
|
|
inherited Create;
|
|
FName := AName;
|
|
FArgs := Args;
|
|
end;
|
|
|
|
destructor TXPathFunctionNode.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Low(FArgs) to High(FArgs) do
|
|
FArgs[i].Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathFunctionNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
Fn: TXPathFunction;
|
|
Args: TXPathVarList;
|
|
i: Integer;
|
|
begin
|
|
Fn := AEnvironment.FunctionsByName[FName];
|
|
if not Assigned(Fn) then
|
|
EvaluationError(lrsEvalUnknownFunction, [FName]);
|
|
|
|
Args := TXPathVarList.Create;
|
|
try
|
|
for i := Low(FArgs) to High(FArgs) do
|
|
Args.Add(FArgs[i].Evaluate(AContext, AEnvironment));
|
|
Result := Fn(AContext, Args);
|
|
for i := Low(FArgs) to High(FArgs) do
|
|
TXPathVariable(Args[i]).Release;
|
|
finally
|
|
Args.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
constructor TXPathNegationNode.Create(AOperand: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FOperand := AOperand;
|
|
end;
|
|
|
|
destructor TXPathNegationNode.Destroy;
|
|
begin
|
|
FOperand.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathNegationNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
OpResult: TXPathVariable;
|
|
begin
|
|
OpResult := FOperand.Evaluate(AContext, AEnvironment);
|
|
try
|
|
Result := TXPathNumberVariable.Create(-OpResult.AsNumber);
|
|
finally
|
|
OpResult.Release;
|
|
end;
|
|
end;
|
|
|
|
destructor TXPathBinaryNode.Destroy;
|
|
begin
|
|
FOperand1.Free;
|
|
FOperand2.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
constructor TXPathMathOpNode.Create(AOperator: TXPathMathOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FOperator := AOperator;
|
|
FOperand1 := AOperand1;
|
|
FOperand2 := AOperand2;
|
|
end;
|
|
|
|
function TXPathMathOpNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
Op1Result, Op2Result: TXPathVariable;
|
|
Op1, Op2, NumberResult: Extended;
|
|
begin
|
|
Op1Result := FOperand1.Evaluate(AContext, AEnvironment);
|
|
try
|
|
Op2Result := FOperand2.Evaluate(AContext, AEnvironment);
|
|
try
|
|
Op1 := Op1Result.AsNumber;
|
|
Op2 := Op2Result.AsNumber;
|
|
case FOperator of
|
|
opAdd:
|
|
NumberResult := Op1 + Op2;
|
|
opSubtract:
|
|
NumberResult := Op1 - Op2;
|
|
opMultiply:
|
|
NumberResult := Op1 * Op2;
|
|
opDivide:
|
|
NumberResult := Op1 / Op2;
|
|
opMod: if IsNan(Op1) or IsNan(Op2) then
|
|
{$push}
|
|
{$r-,q-}
|
|
NumberResult := NaN
|
|
{$pop}
|
|
else
|
|
NumberResult := Trunc(Op1) mod Trunc(Op2);
|
|
end;
|
|
finally
|
|
Op2Result.Release;
|
|
end;
|
|
finally
|
|
Op1Result.Release;
|
|
end;
|
|
Result := TXPathNumberVariable.Create(NumberResult);
|
|
end;
|
|
|
|
const
|
|
reverse: array[TXPathCompareOp] of TXPathCompareOp = (
|
|
opEqual, opNotEqual,
|
|
opGreaterEqual, //opLess
|
|
opGreater, //opLessEqual
|
|
opLessEqual, //opGreater
|
|
opLess //opGreaterEqual
|
|
);
|
|
|
|
function CmpNumbers(const n1, n2: Extended; op: TXPathCompareOp): Boolean;
|
|
begin
|
|
result := (op = opNotEqual);
|
|
if IsNan(n1) or IsNan(n2) then
|
|
Exit; // NaNs are not equal
|
|
case op of
|
|
// TODO: should CompareValue() be used here?
|
|
opLess: result := n1 < n2;
|
|
opLessEqual: result := n1 <= n2;
|
|
opGreater: result := n1 > n2;
|
|
opGreaterEqual: result := n1 >= n2;
|
|
else
|
|
if IsInfinite(n1) or IsInfinite(n2) then
|
|
result := n1 = n2
|
|
else
|
|
result := SameValue(n1, n2);
|
|
result := result xor (op = opNotEqual);
|
|
end;
|
|
end;
|
|
|
|
function CmpStrings(const s1, s2: DOMString; op: TXPathCompareOp): Boolean;
|
|
begin
|
|
case op of
|
|
opEqual: result := s1 = s2;
|
|
opNotEqual: result := s1 <> s2;
|
|
else
|
|
result := CmpNumbers(StrToNumber(s1), StrToNumber(s2), op);
|
|
end;
|
|
end;
|
|
|
|
function CmpNodesetWithString(ns: TNodeSet; const s: DOMString; op: TXPathCompareOp): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to ns.Count - 1 do
|
|
begin
|
|
if CmpStrings(NodeToText(TDOMNode(ns[i])), s, op) then
|
|
exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function CmpNodesetWithNumber(ns: TNodeSet; const n: Extended; op: TXPathCompareOp): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to ns.Count - 1 do
|
|
begin
|
|
if CmpNumbers(StrToNumber(NodeToText(TDOMNode(ns[i]))), n, op) then
|
|
exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function CmpNodesetWithBoolean(ns: TNodeSet; b: Boolean; op: TXPathCompareOp): Boolean;
|
|
begin
|
|
// TODO: handles only equality
|
|
result := ((ns.Count <> 0) = b) xor (op = opNotEqual);
|
|
end;
|
|
|
|
function CmpNodesets(ns1, ns2: TNodeSet; op: TXPathCompareOp): Boolean;
|
|
var
|
|
i, j: Integer;
|
|
s: DOMString;
|
|
begin
|
|
Result := True;
|
|
for i := 0 to ns1.Count - 1 do
|
|
begin
|
|
s := NodeToText(TDOMNode(ns1[i]));
|
|
for j := 0 to ns2.Count - 1 do
|
|
if CmpStrings(s, NodeToText(TDOMNode(ns2[j])), op) then
|
|
exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
constructor TXPathCompareNode.Create(AOperator: TXPathCompareOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FOperator := AOperator;
|
|
FOperand1 := AOperand1;
|
|
FOperand2 := AOperand2;
|
|
end;
|
|
|
|
function TXPathCompareNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
Op1, Op2: TXPathVariable;
|
|
BoolResult: Boolean;
|
|
nsnum: Integer;
|
|
begin
|
|
Op1 := FOperand1.Evaluate(AContext, AEnvironment);
|
|
try
|
|
Op2 := FOperand2.Evaluate(AContext, AEnvironment);
|
|
try
|
|
nsnum := ord(Op1 is TXPathNodeSetVariable) or
|
|
(ord(Op2 is TXPathNodeSetVariable) shl 1);
|
|
case nsnum of
|
|
0: begin // neither op is a nodeset
|
|
if (FOperator in [opEqual, opNotEqual]) then
|
|
begin
|
|
if (Op1 is TXPathBooleanVariable) or (Op2 is TXPathBooleanVariable) then
|
|
BoolResult := (Op1.AsBoolean = Op2.AsBoolean) xor (FOperator = opNotEqual)
|
|
else if (Op1 is TXPathNumberVariable) or (Op2 is TXPathNumberVariable) then
|
|
BoolResult := CmpNumbers(Op1.AsNumber, Op2.AsNumber, FOperator)
|
|
else
|
|
BoolResult := (Op1.AsText = Op2.AsText) xor (FOperator = opNotEqual);
|
|
end
|
|
else
|
|
BoolResult := CmpNumbers(Op1.AsNumber, Op2.AsNumber, FOperator);
|
|
end;
|
|
|
|
1: // Op1 is nodeset
|
|
if Op2 is TXPathNumberVariable then
|
|
BoolResult := CmpNodesetWithNumber(Op1.AsNodeSet, Op2.AsNumber, FOperator)
|
|
else if Op2 is TXPathStringVariable then
|
|
BoolResult := CmpNodesetWithString(Op1.AsNodeSet, Op2.AsText, FOperator)
|
|
else
|
|
BoolResult := CmpNodesetWithBoolean(Op1.AsNodeSet, Op2.AsBoolean, FOperator);
|
|
|
|
2: // Op2 is nodeset
|
|
if Op1 is TXPathNumberVariable then
|
|
BoolResult := CmpNodesetWithNumber(Op2.AsNodeSet, Op1.AsNumber, reverse[FOperator])
|
|
else if Op1 is TXPathStringVariable then
|
|
BoolResult := CmpNodesetWithString(Op2.AsNodeSet, Op1.AsText, reverse[FOperator])
|
|
else
|
|
BoolResult := CmpNodesetWithBoolean(Op2.AsNodeSet, Op1.AsBoolean, reverse[FOperator]);
|
|
|
|
else // both ops are nodesets
|
|
BoolResult := CmpNodesets(Op1.AsNodeSet, Op2.AsNodeSet, FOperator);
|
|
end;
|
|
finally
|
|
Op2.Release;
|
|
end;
|
|
finally
|
|
Op1.Release;
|
|
end;
|
|
Result := TXPathBooleanVariable.Create(BoolResult);
|
|
end;
|
|
|
|
constructor TXPathBooleanOpNode.Create(AOperator: TXPathBooleanOp;
|
|
AOperand1, AOperand2: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FOperator := AOperator;
|
|
FOperand1 := AOperand1;
|
|
FOperand2 := AOperand2;
|
|
end;
|
|
|
|
function TXPathBooleanOpNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
res: Boolean;
|
|
Op1, Op2: TXPathVariable;
|
|
begin
|
|
{ don't evaluate second arg if result is determined by first one }
|
|
Op1 := FOperand1.Evaluate(AContext, AEnvironment);
|
|
try
|
|
res := Op1.AsBoolean;
|
|
finally
|
|
Op1.Release;
|
|
end;
|
|
if not (((FOperator = opAnd) and (not res)) or ((FOperator = opOr) and res)) then
|
|
begin
|
|
Op2 := FOperand2.Evaluate(AContext, AEnvironment);
|
|
try
|
|
case FOperator of
|
|
opAnd: res := res and Op2.AsBoolean;
|
|
opOr: res := res or Op2.AsBoolean;
|
|
end;
|
|
finally
|
|
Op2.Release;
|
|
end;
|
|
end;
|
|
Result := TXPathBooleanVariable.Create(res);
|
|
end;
|
|
|
|
constructor TXPathUnionNode.Create(AOperand1, AOperand2: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FOperand1 := AOperand1;
|
|
FOperand2 := AOperand2;
|
|
end;
|
|
|
|
function TXPathUnionNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
Op1Result, Op2Result: TXPathVariable;
|
|
NodeSet, NodeSet2: TNodeSet;
|
|
CurNode: Pointer;
|
|
i: Integer;
|
|
begin
|
|
// TODO: result must be sorted by document order, i.e. 'a|b' yields the
|
|
// same nodeset as 'b|a'
|
|
Op1Result := FOperand1.Evaluate(AContext, AEnvironment);
|
|
try
|
|
Op2Result := FOperand2.Evaluate(AContext, AEnvironment);
|
|
try
|
|
NodeSet := Op1Result.AsNodeSet;
|
|
NodeSet2 := Op2Result.AsNodeSet;
|
|
for i := 0 to NodeSet2.Count - 1 do
|
|
begin
|
|
CurNode := NodeSet2[i];
|
|
if NodeSet.IndexOf(CurNode) < 0 then
|
|
NodeSet.Add(CurNode);
|
|
end;
|
|
finally
|
|
Op2Result.Release;
|
|
end;
|
|
finally
|
|
Result := Op1Result;
|
|
end;
|
|
end;
|
|
|
|
|
|
constructor TXPathFilterNode.Create(AExpr: TXPathExprNode);
|
|
begin
|
|
inherited Create;
|
|
FLeft := AExpr;
|
|
end;
|
|
|
|
destructor TXPathFilterNode.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FLeft.Free;
|
|
for i := 0 to High(FPredicates) do
|
|
FPredicates[i].Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathFilterNode.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
NodeSet: TNodeSet;
|
|
begin
|
|
Result := FLeft.Evaluate(AContext, AEnvironment);
|
|
NodeSet := Result.AsNodeSet;
|
|
ApplyPredicates(NodeSet, AEnvironment);
|
|
end;
|
|
|
|
|
|
constructor TStep.Create(aAxis: TAxis; aTest: TNodeTestType);
|
|
begin
|
|
Axis := aAxis;
|
|
NodeTestType := aTest;
|
|
end;
|
|
|
|
procedure TStep.SelectNodes(ANode: TDOMNode; out ResultNodes: TNodeSet);
|
|
var
|
|
Node, Node2: TDOMNode;
|
|
Attr: TDOMNamedNodeMap;
|
|
i: Integer;
|
|
|
|
procedure DoNodeTest(Node: TDOMNode);
|
|
begin
|
|
case NodeTestType of
|
|
ntAnyPrincipal:
|
|
// !!!: Probably this isn't ready for namespace support yet
|
|
if (Axis <> axisAttribute) and
|
|
(Node.NodeType <> ELEMENT_NODE) then
|
|
exit;
|
|
ntName:
|
|
if NSTestString <> '' then
|
|
begin
|
|
if Node.namespaceURI <> NSTestString then
|
|
exit;
|
|
if (NodeTestString <> '') and (Node.localName <> NodeTestString) then
|
|
exit;
|
|
end
|
|
else if Node.NodeName <> NodeTestString then
|
|
exit;
|
|
ntTextNode:
|
|
if not Node.InheritsFrom(TDOMText) then
|
|
exit;
|
|
ntCommentNode:
|
|
if Node.NodeType <> COMMENT_NODE then
|
|
exit;
|
|
ntPINode:
|
|
if (Node.NodeType <> PROCESSING_INSTRUCTION_NODE) or
|
|
((NodeTestString <> '') and (Node.nodeName <> NodeTestString)) then
|
|
exit;
|
|
end;
|
|
if ResultNodes.IndexOf(Node) < 0 then
|
|
ResultNodes.Add(Node);
|
|
end;
|
|
|
|
procedure AddDescendants(CurNode: TDOMNode);
|
|
var
|
|
Child: TDOMNode;
|
|
begin
|
|
Child := CurNode.FirstChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
DoNodeTest(Child);
|
|
AddDescendants(Child);
|
|
Child := Child.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure AddDescendantsReverse(CurNode: TDOMNode);
|
|
var
|
|
Child: TDOMNode;
|
|
begin
|
|
Child := CurNode.LastChild;
|
|
while Assigned(Child) do
|
|
begin
|
|
AddDescendantsReverse(Child);
|
|
DoNodeTest(Child);
|
|
Child := Child.PreviousSibling;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ResultNodes := TNodeSet.Create;
|
|
case Axis of
|
|
axisAncestor:
|
|
begin
|
|
// TODO: same check needed for XPATH_NAMESPACE_NODE
|
|
if ANode.nodeType = ATTRIBUTE_NODE then
|
|
Node := TDOMAttr(ANode).ownerElement
|
|
else
|
|
Node := ANode.ParentNode;
|
|
while Assigned(Node) do
|
|
begin
|
|
DoNodeTest(Node);
|
|
Node := Node.ParentNode;
|
|
end;
|
|
end;
|
|
axisAncestorOrSelf:
|
|
begin
|
|
DoNodeTest(ANode);
|
|
// TODO: same check needed for XPATH_NAMESPACE_NODE
|
|
if ANode.nodeType = ATTRIBUTE_NODE then
|
|
Node := TDOMAttr(ANode).ownerElement
|
|
else
|
|
Node := ANode.ParentNode;
|
|
while Assigned(Node) do
|
|
begin
|
|
DoNodeTest(Node);
|
|
Node := Node.ParentNode;
|
|
end;
|
|
end;
|
|
axisAttribute:
|
|
begin
|
|
Attr := ANode.Attributes;
|
|
if Assigned(Attr) then
|
|
for i := 0 to Attr.Length - 1 do
|
|
DoNodeTest(Attr[i]);
|
|
end;
|
|
axisChild:
|
|
begin
|
|
Node := ANode.FirstChild;
|
|
while Assigned(Node) do
|
|
begin
|
|
DoNodeTest(Node);
|
|
Node := Node.NextSibling;
|
|
end;
|
|
end;
|
|
axisDescendant:
|
|
AddDescendants(ANode);
|
|
axisDescendantOrSelf:
|
|
begin
|
|
DoNodeTest(ANode);
|
|
AddDescendants(ANode);
|
|
end;
|
|
axisFollowing:
|
|
begin
|
|
Node := ANode;
|
|
repeat
|
|
Node2 := Node.NextSibling;
|
|
while Assigned(Node2) do
|
|
begin
|
|
DoNodeTest(Node2);
|
|
AddDescendants(Node2);
|
|
Node2 := Node2.NextSibling;
|
|
end;
|
|
Node := Node.ParentNode;
|
|
until not Assigned(Node);
|
|
end;
|
|
axisFollowingSibling:
|
|
begin
|
|
Node := ANode.NextSibling;
|
|
while Assigned(Node) do
|
|
begin
|
|
DoNodeTest(Node);
|
|
Node := Node.NextSibling;
|
|
end;
|
|
end;
|
|
{axisNamespace: !!!: Not supported yet}
|
|
axisParent:
|
|
if ANode.NodeType=ATTRIBUTE_NODE then
|
|
begin
|
|
if Assigned(TDOMAttr(ANode).OwnerElement) then
|
|
DoNodeTest(TDOMAttr(ANode).OwnerElement);
|
|
end
|
|
else if Assigned(ANode.ParentNode) then
|
|
DoNodeTest(ANode.ParentNode);
|
|
axisPreceding:
|
|
begin
|
|
Node := ANode;
|
|
repeat
|
|
Node2 := Node.PreviousSibling;
|
|
while Assigned(Node2) do
|
|
begin
|
|
AddDescendantsReverse(Node2);
|
|
DoNodeTest(Node2);
|
|
Node2 := Node2.PreviousSibling;
|
|
end;
|
|
Node := Node.ParentNode;
|
|
until not Assigned(Node);
|
|
end;
|
|
axisPrecedingSibling:
|
|
begin
|
|
Node := ANode.PreviousSibling;
|
|
while Assigned(Node) do
|
|
begin
|
|
DoNodeTest(Node);
|
|
Node := Node.PreviousSibling;
|
|
end;
|
|
end;
|
|
axisSelf:
|
|
DoNodeTest(ANode);
|
|
axisRoot:
|
|
if ANode.nodeType = DOCUMENT_NODE then
|
|
ResultNodes.Add(ANode)
|
|
else
|
|
ResultNodes.Add(ANode.ownerDocument);
|
|
end;
|
|
end;
|
|
|
|
{ Filter the nodes of this step using the predicates: The current
|
|
node set is filtered, nodes not passing the filter are replaced
|
|
by nil. After one filter has been applied, Nodes is packed, and
|
|
the next filter will be processed. }
|
|
|
|
procedure TXPathFilterNode.ApplyPredicates(Nodes: TNodeSet; AEnvironment: TXPathEnvironment);
|
|
var
|
|
i, j: Integer;
|
|
NewContext: TXPathContext;
|
|
begin
|
|
for i := 0 to High(FPredicates) do
|
|
begin
|
|
NewContext := TXPathContext.Create(nil, 0, Nodes.Count);
|
|
try
|
|
for j := 0 to Nodes.Count - 1 do
|
|
begin
|
|
NewContext.ContextPosition := j+1;
|
|
NewContext.ContextNode := TDOMNode(Nodes[j]);
|
|
if not FPredicates[i].EvalPredicate(NewContext, AEnvironment) then
|
|
Nodes[j] := nil;
|
|
end;
|
|
Nodes.Pack;
|
|
finally
|
|
NewContext.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TStep.Evaluate(AContext: TXPathContext;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
ResultNodeSet: TNodeSet;
|
|
LeftResult: TXPathVariable;
|
|
i: Integer;
|
|
|
|
procedure EvaluateStep(AContextNode: TDOMNode);
|
|
var
|
|
StepNodes: TFPList;
|
|
Node: TDOMNode;
|
|
i: Integer;
|
|
begin
|
|
SelectNodes(AContextNode, StepNodes);
|
|
try
|
|
ApplyPredicates(StepNodes, AEnvironment);
|
|
if Axis in [axisAncestor, axisAncestorOrSelf,
|
|
axisPreceding, axisPrecedingSibling] then
|
|
for i := StepNodes.Count - 1 downto 0 do
|
|
begin
|
|
Node := TDOMNode(StepNodes[i]);
|
|
if ResultNodeSet.IndexOf(Node) < 0 then
|
|
ResultNodeSet.Add(Node);
|
|
end
|
|
else for i := 0 to StepNodes.Count - 1 do
|
|
begin
|
|
Node := TDOMNode(StepNodes[i]);
|
|
if ResultNodeSet.IndexOf(Node) < 0 then
|
|
ResultNodeSet.Add(Node);
|
|
end;
|
|
finally
|
|
StepNodes.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ResultNodeSet := TNodeSet.Create;
|
|
try
|
|
if Assigned(FLeft) then
|
|
begin
|
|
LeftResult := FLeft.Evaluate(AContext, AEnvironment);
|
|
try
|
|
with LeftResult.AsNodeSet do
|
|
for i := 0 to Count-1 do
|
|
EvaluateStep(TDOMNode(Items[i]));
|
|
finally
|
|
LeftResult.Release;
|
|
end;
|
|
end
|
|
else
|
|
EvaluateStep(AContext.ContextNode);
|
|
except
|
|
ResultNodeSet.Free;
|
|
raise;
|
|
end;
|
|
Result := TXPathNodeSetVariable.Create(ResultNodeSet);
|
|
end;
|
|
|
|
{ Exceptions }
|
|
|
|
procedure EvaluationError(const Msg: String);
|
|
begin
|
|
raise EXPathEvaluationError.Create(Msg) at get_caller_addr(get_frame);
|
|
end;
|
|
|
|
procedure EvaluationError(const Msg: String; const Args: array of const);
|
|
begin
|
|
raise EXPathEvaluationError.CreateFmt(Msg, Args)
|
|
at get_caller_addr(get_frame);
|
|
end;
|
|
|
|
|
|
{ TXPathVariable and derived classes}
|
|
|
|
procedure TXPathVariable.Release;
|
|
begin
|
|
if FRefCount <= 0 then
|
|
Free
|
|
else
|
|
Dec(FRefCount);
|
|
end;
|
|
|
|
function TXPathVariable.AsNodeSet: TNodeSet;
|
|
begin
|
|
Error(lrsVarNoConversion, [TypeName, TXPathNodeSetVariable.TypeName]);
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TXPathVariable.Error(const Msg: String; const Args: array of const);
|
|
begin
|
|
raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame);
|
|
end;
|
|
|
|
|
|
constructor TXPathNodeSetVariable.Create(AValue: TNodeSet);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
destructor TXPathNodeSetVariable.Destroy;
|
|
begin
|
|
FValue.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
class function TXPathNodeSetVariable.TypeName: String;
|
|
begin
|
|
Result := lrsNodeSet;
|
|
end;
|
|
|
|
function TXPathNodeSetVariable.AsNodeSet: TNodeSet;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TXPathNodeSetVariable.AsText: DOMString;
|
|
begin
|
|
if FValue.Count = 0 then
|
|
Result := ''
|
|
else
|
|
Result := NodeToText(TDOMNode(FValue.First));
|
|
end;
|
|
|
|
function TXPathNodeSetVariable.AsBoolean: Boolean;
|
|
begin
|
|
Result := FValue.Count <> 0;
|
|
end;
|
|
|
|
function TXPathNodeSetVariable.AsNumber: Extended;
|
|
begin
|
|
Result := StrToNumber(AsText);
|
|
end;
|
|
|
|
constructor TXPathBooleanVariable.Create(AValue: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
class function TXPathBooleanVariable.TypeName: String;
|
|
begin
|
|
Result := lrsBoolean;
|
|
end;
|
|
|
|
function TXPathBooleanVariable.AsBoolean: Boolean;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TXPathBooleanVariable.AsNumber: Extended;
|
|
begin
|
|
if FValue then
|
|
Result := 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TXPathBooleanVariable.AsText: DOMString;
|
|
begin
|
|
if FValue then
|
|
Result := 'true' // Do not localize!
|
|
else
|
|
Result := 'false'; // Do not localize!
|
|
end;
|
|
|
|
|
|
constructor TXPathNumberVariable.Create(AValue: Extended);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
class function TXPathNumberVariable.TypeName: String;
|
|
begin
|
|
Result := lrsNumber;
|
|
end;
|
|
|
|
function TXPathNumberVariable.AsBoolean: Boolean;
|
|
begin
|
|
Result := not (IsNan(FValue) or IsZero(FValue));
|
|
end;
|
|
|
|
function TXPathNumberVariable.AsNumber: Extended;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
function TXPathNumberVariable.AsText: DOMString;
|
|
var
|
|
frec: TFloatRec;
|
|
i, nd, reqlen: Integer;
|
|
P: DOMPChar;
|
|
begin
|
|
FloatToDecimal(frec, FValue, fvExtended, 17, 9999);
|
|
|
|
if frec.Exponent = -32768 then
|
|
begin
|
|
Result := 'NaN'; // do not localize
|
|
Exit;
|
|
end
|
|
else if frec.Exponent = 32767 then
|
|
begin
|
|
if frec.Negative then
|
|
Result := '-Infinity' // do not localize
|
|
else
|
|
Result := 'Infinity'; // do not localize
|
|
Exit;
|
|
end
|
|
else if frec.Digits[0] = #0 then
|
|
begin
|
|
Result := '0';
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
nd := StrLen(@frec.Digits[0]);
|
|
reqlen := nd + ord(frec.Negative); // maybe minus sign
|
|
if frec.Exponent > nd then
|
|
Inc(reqlen, frec.Exponent - nd) // add this much zeroes at the right
|
|
else if frec.Exponent < nd then
|
|
begin
|
|
Inc(reqlen); // decimal point
|
|
if frec.Exponent <= 0 then
|
|
Inc(reqlen, 1 - frec.Exponent); // zeroes at the left + one more for the int part
|
|
end;
|
|
SetLength(Result, reqlen);
|
|
P := DOMPChar(Result);
|
|
if frec.Negative then
|
|
begin
|
|
P^ := '-';
|
|
Inc(P);
|
|
end;
|
|
if frec.Exponent <= 0 then // value less than 1, put zeroes at left
|
|
begin
|
|
for i := 0 to 1-frec.Exponent do
|
|
P[i] := '0';
|
|
P[1] := '.';
|
|
for i := 0 to nd-1 do
|
|
P[i+2-frec.Exponent] := DOMChar(ord(frec.Digits[i]));
|
|
end
|
|
else if frec.Exponent > nd then // large integer, put zeroes at right
|
|
begin
|
|
for i := 0 to nd-1 do
|
|
P[i] := DOMChar(ord(frec.Digits[i]));
|
|
for i := nd to reqlen-1-ord(frec.Negative) do
|
|
P[i] := '0';
|
|
end
|
|
else // 0 < exponent <= digits, insert decimal point into middle
|
|
begin
|
|
for i := 0 to frec.Exponent-1 do
|
|
P[i] := DOMChar(ord(frec.Digits[i]));
|
|
if frec.Exponent < nd then
|
|
begin
|
|
P[frec.Exponent] := '.';
|
|
for i := frec.Exponent to nd-1 do
|
|
P[i+1] := DOMChar(ord(frec.Digits[i]));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
constructor TXPathStringVariable.Create(const AValue: DOMString);
|
|
begin
|
|
inherited Create;
|
|
FValue := AValue;
|
|
end;
|
|
|
|
class function TXPathStringVariable.TypeName: String;
|
|
begin
|
|
Result := lrsString;
|
|
end;
|
|
|
|
function TXPathStringVariable.AsBoolean: Boolean;
|
|
begin
|
|
Result := Length(FValue) > 0;
|
|
end;
|
|
|
|
function TXPathStringVariable.AsNumber: Extended;
|
|
begin
|
|
Result := StrToNumber(FValue);
|
|
end;
|
|
|
|
function TXPathStringVariable.AsText: DOMString;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
|
|
{ XPath lexical scanner }
|
|
|
|
constructor TXPathScanner.Create(const AExpressionString: DOMString);
|
|
begin
|
|
inherited Create;
|
|
FExpressionString := DOMPChar(AExpressionString);
|
|
FCurData := FExpressionString;
|
|
NextToken;
|
|
end;
|
|
|
|
function TXPathScanner.PeekToken: TXPathToken;
|
|
var
|
|
save: DOMPChar;
|
|
begin
|
|
save := FCurData;
|
|
Result := GetToken;
|
|
FCurData := save;
|
|
end;
|
|
|
|
function TXPathScanner.NextToken: TXPathToken;
|
|
begin
|
|
Result := GetToken;
|
|
FCurToken := Result;
|
|
if Result in [tkIdentifier, tkNSNameTest, tkNumber, tkString, tkVariable] then
|
|
SetString(FCurTokenString, FTokenStart, FTokenLength);
|
|
if Result = tkIdentifier then
|
|
FTokenId := LookupXPathKeyword(FTokenStart, FTokenLength)
|
|
else
|
|
FTokenId := xkNone;
|
|
end;
|
|
|
|
function TXPathScanner.SkipToken(tok: TXPathToken): Boolean; { inline? }
|
|
begin
|
|
Result := (FCurToken = tok);
|
|
if Result then
|
|
NextToken;
|
|
end;
|
|
|
|
// TODO: no surrogate pairs/XML 1.1 support yet
|
|
function TXPathScanner.ScanQName: Boolean;
|
|
var
|
|
p: DOMPChar;
|
|
begin
|
|
FPrefixLength := 0;
|
|
p := FCurData;
|
|
repeat
|
|
if (Byte(p^) in namingBitmap[NamePages[hi(Word(p^))]]) then
|
|
Inc(p)
|
|
else
|
|
begin
|
|
// either the first char of name is bad (it may be a colon),
|
|
// or a colon is not followed by a valid NameStartChar
|
|
Result := False;
|
|
Break;
|
|
end;
|
|
|
|
while Byte(p^) in NamingBitmap[NamePages[$100+hi(Word(p^))]] do
|
|
Inc(p);
|
|
|
|
Result := True;
|
|
if (p^ <> ':') or (p[1] = ':') or (FPrefixLength > 0) then
|
|
Break;
|
|
// first colon, and not followed by another one -> remember its position
|
|
FPrefixLength := p-FTokenStart;
|
|
Inc(p);
|
|
until False;
|
|
FCurData := p;
|
|
FTokenLength := p-FTokenStart;
|
|
end;
|
|
|
|
function TXPathScanner.GetToken: TXPathToken;
|
|
|
|
procedure GetNumber(HasDot: Boolean);
|
|
begin
|
|
FTokenLength := 1;
|
|
while ((FCurData[1] >= '0') and (FCurData[1] <= '9')) or ((FCurData[1] = '.') and not HasDot) do
|
|
begin
|
|
Inc(FCurData);
|
|
Inc(FTokenLength);
|
|
if FCurData[0] = '.' then
|
|
HasDot := True;
|
|
end;
|
|
Result := tkNumber;
|
|
end;
|
|
|
|
var
|
|
Delim: DOMChar;
|
|
begin
|
|
// Skip whitespace
|
|
while (FCurData[0] < #255) and (char(ord(FCurData[0])) in [#9, #10, #13, ' ']) do
|
|
Inc(FCurData);
|
|
|
|
FTokenStart := FCurData;
|
|
FTokenLength := 0;
|
|
Result := tkInvalid;
|
|
|
|
case FCurData[0] of
|
|
#0:
|
|
Result := tkEndOfStream;
|
|
'!':
|
|
if FCurData[1] = '=' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkNotEqual;
|
|
end;
|
|
'"', '''':
|
|
begin
|
|
Delim := FCurData^;
|
|
Inc(FCurData);
|
|
FTokenStart := FCurData;
|
|
while FCurData[0] <> Delim do
|
|
begin
|
|
if FCurData[0] = #0 then
|
|
Error(lrsScannerUnclosedString);
|
|
Inc(FCurData);
|
|
end;
|
|
FTokenLength := FCurData-FTokenStart;
|
|
Result := tkString;
|
|
end;
|
|
'$':
|
|
begin
|
|
Inc(FCurData);
|
|
Inc(FTokenStart);
|
|
if ScanQName then
|
|
Result := tkVariable
|
|
else
|
|
Error(lrsScannerExpectedVarName);
|
|
Exit;
|
|
end;
|
|
'(':
|
|
Result := tkLeftBracket;
|
|
')':
|
|
Result := tkRightBracket;
|
|
'*':
|
|
Result := tkAsterisk;
|
|
'+':
|
|
Result := tkPlus;
|
|
',':
|
|
Result := tkComma;
|
|
'-':
|
|
Result := tkMinus;
|
|
'.':
|
|
if FCurData[1] = '.' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkDotDot;
|
|
end else if (FCurData[1] >= '0') and (FCurData[1] <= '9') then
|
|
GetNumber(True)
|
|
else
|
|
Result := tkDot;
|
|
'/':
|
|
if FCurData[1] = '/' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkSlashSlash;
|
|
end else
|
|
Result := tkSlash;
|
|
'0'..'9':
|
|
GetNumber(False);
|
|
':':
|
|
if FCurData[1] = ':' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkColonColon;
|
|
end;
|
|
'<':
|
|
if FCurData[1] = '=' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkLessEqual;
|
|
end else
|
|
Result := tkLess;
|
|
'=':
|
|
Result := tkEqual;
|
|
'>':
|
|
if FCurData[1] = '=' then
|
|
begin
|
|
Inc(FCurData);
|
|
Result := tkGreaterEqual;
|
|
end else
|
|
Result := tkGreater;
|
|
'@':
|
|
Result := tkAt;
|
|
'[':
|
|
Result := tkLeftSquareBracket;
|
|
']':
|
|
Result := tkRightSquareBracket;
|
|
'|':
|
|
Result := tkPipe;
|
|
else
|
|
if ScanQName then
|
|
begin
|
|
Result := tkIdentifier;
|
|
Exit;
|
|
end
|
|
else if FPrefixLength > 0 then
|
|
begin
|
|
if FCurData^ = '*' then
|
|
begin
|
|
Inc(FCurData);
|
|
Dec(FTokenLength); // exclude ':'
|
|
Result := tkNSNameTest;
|
|
Exit;
|
|
end
|
|
else
|
|
Error(lrsScannerMalformedQName);
|
|
end;
|
|
end;
|
|
|
|
if Result = tkInvalid then
|
|
Error(lrsScannerInvalidChar);
|
|
// We have processed at least one character now; eat it:
|
|
if Result > tkEndOfStream then
|
|
Inc(FCurData);
|
|
end;
|
|
|
|
procedure TXPathScanner.Error(const Msg: String);
|
|
begin
|
|
raise Exception.Create(Msg) at get_caller_addr(get_frame);
|
|
end;
|
|
|
|
procedure TXPathScanner.ParsePredicates(var Dest: TXPathNodeArray);
|
|
var
|
|
Buffer: array[0..15] of TXPathExprNode;
|
|
I: Integer;
|
|
begin
|
|
I := 0;
|
|
// accumulate nodes in local buffer, then add all at once
|
|
// this reduces amount of ReallocMem's
|
|
while SkipToken(tkLeftSquareBracket) do
|
|
begin
|
|
Buffer[I] := ParseOrExpr;
|
|
Inc(I);
|
|
if I > High(Buffer) then
|
|
AddNodes(Dest, Buffer, I); // will reset I to zero
|
|
if not SkipToken(tkRightSquareBracket) then
|
|
Error(lrsParserExpectedRightSquareBracket);
|
|
end;
|
|
AddNodes(Dest, Buffer, I);
|
|
end;
|
|
|
|
function TXPathScanner.ParseStep: TStep; // [4]
|
|
var
|
|
Axis: TAxis;
|
|
begin
|
|
if CurToken = tkDot then // [12] Abbreviated step, first case
|
|
begin
|
|
NextToken;
|
|
Result := TStep.Create(axisSelf, ntAnyNode);
|
|
end
|
|
else if CurToken = tkDotDot then // [12] Abbreviated step, second case
|
|
begin
|
|
NextToken;
|
|
Result := TStep.Create(axisParent, ntAnyNode);
|
|
end
|
|
else // Parse [5] AxisSpecifier
|
|
begin
|
|
if CurToken = tkAt then // [13] AbbreviatedAxisSpecifier
|
|
begin
|
|
Axis := axisAttribute;
|
|
NextToken;
|
|
end
|
|
else if (CurToken = tkIdentifier) and (PeekToken = tkColonColon) then // [5] AxisName '::'
|
|
begin
|
|
if FTokenId in AxisNameKeywords then
|
|
Axis := AxisNameMap[FTokenId]
|
|
else
|
|
Error(lrsParserBadAxisName);
|
|
NextToken; // skip identifier and the '::'
|
|
NextToken;
|
|
end
|
|
else
|
|
Axis := axisChild;
|
|
|
|
Result := ParseNodeTest(Axis);
|
|
ParsePredicates(Result.FPredicates);
|
|
end;
|
|
end;
|
|
|
|
function TXPathScanner.ParseNodeTest(Axis: TAxis): TStep; // [7]
|
|
var
|
|
nodeType: TNodeTestType;
|
|
nodeName: DOMString;
|
|
nsURI: DOMString;
|
|
begin
|
|
nodeName := '';
|
|
nsURI := '';
|
|
if CurToken = tkAsterisk then // [37] NameTest, first case
|
|
begin
|
|
nodeType := ntAnyPrincipal;
|
|
NextToken;
|
|
end
|
|
else if CurToken = tkNSNameTest then // [37] NameTest, second case
|
|
begin
|
|
if Assigned(FResolver) then
|
|
nsURI := FResolver.lookupNamespaceURI(CurTokenString);
|
|
if nsURI = '' then
|
|
// !! localization disrupted by DOM exception specifics
|
|
raise EDOMNamespace.Create('TXPathScanner.ParseStep');
|
|
NextToken;
|
|
nodeType := ntName;
|
|
end
|
|
else if CurToken = tkIdentifier then
|
|
begin
|
|
// Check for case [38] NodeType
|
|
if PeekToken = tkLeftBracket then
|
|
begin
|
|
if FTokenId in NodeTestKeywords then
|
|
begin
|
|
nodeType := NodeTestMap[FTokenId];
|
|
if FTokenId = xkProcessingInstruction then
|
|
begin
|
|
NextToken;
|
|
if NextToken = tkString then
|
|
begin
|
|
nodeName := CurTokenString;
|
|
NextToken;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
NextToken;
|
|
NextToken;
|
|
end;
|
|
if CurToken <> tkRightBracket then
|
|
Error(lrsParserExpectedRightBracket);
|
|
NextToken;
|
|
end
|
|
else
|
|
Error(lrsParserBadNodeType);
|
|
end
|
|
else // [37] NameTest, third case
|
|
begin
|
|
nodeType := ntName;
|
|
if FPrefixLength > 0 then
|
|
begin
|
|
if Assigned(FResolver) then
|
|
nsURI := FResolver.lookupNamespaceURI(Copy(CurTokenString, 1, FPrefixLength));
|
|
if nsURI = '' then
|
|
raise EDOMNamespace.Create('TXPathScanner.ParseStep');
|
|
nodeName := Copy(CurTokenString, FPrefixLength+2, MaxInt);
|
|
end
|
|
else
|
|
nodeName := CurTokenString;
|
|
NextToken;
|
|
end;
|
|
end
|
|
else
|
|
Error(lrsParserInvalidNodeTest);
|
|
|
|
Result := TStep.Create(Axis, nodeType);
|
|
Result.NodeTestString := nodeName;
|
|
Result.NSTestString := nsURI;
|
|
end;
|
|
|
|
function TXPathScanner.ParsePrimaryExpr: TXPathExprNode; // [15]
|
|
begin
|
|
case CurToken of
|
|
tkVariable: // [36] Variable reference
|
|
Result := TXPathVariableNode.Create(CurTokenString);
|
|
tkLeftBracket:
|
|
begin
|
|
NextToken;
|
|
Result := ParseOrExpr;
|
|
if CurToken <> tkRightBracket then
|
|
Error(lrsParserExpectedRightBracket);
|
|
end;
|
|
tkString: // [29] Literal
|
|
Result := TXPathConstantNode.Create(
|
|
TXPathStringVariable.Create(CurTokenString));
|
|
tkNumber: // [30] Number
|
|
Result := TXPathConstantNode.Create(
|
|
TXPathNumberVariable.Create(StrToNumber(CurTokenString)));
|
|
tkIdentifier: // [16] Function call
|
|
Result := ParseFunctionCall;
|
|
else
|
|
Error(lrsParserInvalidPrimExpr);
|
|
Result := nil; // satisfy compiler
|
|
end;
|
|
NextToken;
|
|
end;
|
|
|
|
function TXPathScanner.ParseFunctionCall: TXPathExprNode;
|
|
var
|
|
Name: DOMString;
|
|
Args: TXPathNodeArray;
|
|
Buffer: array[0..15] of TXPathExprNode;
|
|
I: Integer;
|
|
begin
|
|
Name := CurTokenString;
|
|
I := 0;
|
|
if NextToken <> tkLeftBracket then
|
|
Error(lrsParserExpectedLeftBracket);
|
|
NextToken;
|
|
// Parse argument list
|
|
Args:=nil;
|
|
if CurToken <> tkRightBracket then
|
|
repeat
|
|
Buffer[I] := ParseOrExpr;
|
|
Inc(I);
|
|
if I > High(Buffer) then
|
|
AddNodes(Args, Buffer, I);
|
|
until not SkipToken(tkComma);
|
|
if CurToken <> tkRightBracket then
|
|
Error(lrsParserExpectedRightBracket);
|
|
|
|
AddNodes(Args, Buffer, I);
|
|
Result := TXPathFunctionNode.Create(Name, Args);
|
|
end;
|
|
|
|
function TXPathScanner.ParseUnionExpr: TXPathExprNode; // [18]
|
|
begin
|
|
Result := ParsePathExpr;
|
|
while SkipToken(tkPipe) do
|
|
Result := TXPathUnionNode.Create(Result, ParsePathExpr);
|
|
end;
|
|
|
|
function AddStep(Left: TXPathExprNode; Right: TStep): TXPathExprNode;
|
|
begin
|
|
Right.FLeft := Left;
|
|
Result := Right;
|
|
end;
|
|
|
|
function TXPathScanner.ParsePathExpr: TXPathExprNode; // [19]
|
|
var
|
|
tok: TXPathToken;
|
|
begin
|
|
Result := nil;
|
|
// Try to detect whether a LocationPath [1] or a FilterExpr [20] follows
|
|
if ((CurToken = tkIdentifier) and (PeekToken = tkLeftBracket) and
|
|
not (FTokenId in NodeTestKeywords)) or
|
|
(CurToken in [tkVariable, tkLeftBracket, tkString, tkNumber]) then
|
|
begin
|
|
// second, third or fourth case of [19]
|
|
Result := ParseFilterExpr;
|
|
if SkipToken(tkSlash) then { do nothing }
|
|
else if SkipToken(tkSlashSlash) then
|
|
Result := AddStep(Result, TStep.Create(axisDescendantOrSelf, ntAnyNode))
|
|
else
|
|
Exit;
|
|
end
|
|
else if CurToken in [tkSlash, tkSlashSlash] then
|
|
begin
|
|
tok := CurToken;
|
|
NextToken;
|
|
Result := TStep.Create(axisRoot, ntAnyNode);
|
|
if tok = tkSlashSlash then
|
|
Result := AddStep(Result, TStep.Create(axisDescendantOrSelf, ntAnyNode))
|
|
else if not (CurToken in [tkDot, tkDotDot, tkAt, tkAsterisk, tkIdentifier, tkNSNameTest]) then
|
|
Exit; // allow '/' alone
|
|
end;
|
|
|
|
// Continue with parsing of [3] RelativeLocationPath
|
|
repeat
|
|
Result := AddStep(Result, ParseStep);
|
|
if CurToken = tkSlashSlash then
|
|
begin
|
|
NextToken;
|
|
// Found abbreviated step ("//" for "descendant-or-self::node()")
|
|
Result := AddStep(Result, TStep.Create(axisDescendantOrSelf, ntAnyNode));
|
|
end
|
|
else if not SkipToken(tkSlash) then
|
|
break;
|
|
until False;
|
|
end;
|
|
|
|
function TXPathScanner.ParseFilterExpr: TXPathExprNode; // [20]
|
|
begin
|
|
Result := ParsePrimaryExpr;
|
|
// Parse predicates
|
|
if CurToken = tkLeftSquareBracket then
|
|
begin
|
|
Result := TXPathFilterNode.Create(Result);
|
|
ParsePredicates(TXPathFilterNode(Result).FPredicates);
|
|
end;
|
|
end;
|
|
|
|
function TXPathScanner.ParseOrExpr: TXPathExprNode; // [21]
|
|
begin
|
|
Result := ParseAndExpr;
|
|
while FTokenId = xkOr do
|
|
begin
|
|
NextToken;
|
|
Result := TXPathBooleanOpNode.Create(opOr, Result, ParseAndExpr);
|
|
end;
|
|
end;
|
|
|
|
function TXPathScanner.ParseAndExpr: TXPathExprNode; // [22]
|
|
begin
|
|
Result := ParseEqualityExpr;
|
|
while FTokenId = xkAnd do
|
|
begin
|
|
NextToken;
|
|
Result := TXPathBooleanOpNode.Create(opAnd, Result, ParseEqualityExpr);
|
|
end;
|
|
end;
|
|
|
|
function TXPathScanner.ParseEqualityExpr: TXPathExprNode; // [23]
|
|
var
|
|
op: TXPathCompareOp;
|
|
begin
|
|
Result := ParseRelationalExpr;
|
|
repeat
|
|
case CurToken of
|
|
tkEqual: op := opEqual;
|
|
tkNotEqual: op := opNotEqual;
|
|
else
|
|
Break;
|
|
end;
|
|
NextToken;
|
|
Result := TXPathCompareNode.Create(op, Result, ParseRelationalExpr);
|
|
until False;
|
|
end;
|
|
|
|
function TXPathScanner.ParseRelationalExpr: TXPathExprNode; // [24]
|
|
var
|
|
op: TXPathCompareOp;
|
|
begin
|
|
Result := ParseAdditiveExpr;
|
|
repeat
|
|
case CurToken of
|
|
tkLess: op := opLess;
|
|
tkLessEqual: op := opLessEqual;
|
|
tkGreater: op := opGreater;
|
|
tkGreaterEqual: op := opGreaterEqual;
|
|
else
|
|
Break;
|
|
end;
|
|
NextToken;
|
|
Result := TXPathCompareNode.Create(op, Result, ParseAdditiveExpr);
|
|
until False;
|
|
end;
|
|
|
|
function TXPathScanner.ParseAdditiveExpr: TXPathExprNode; // [25]
|
|
var
|
|
op: TXPathMathOp;
|
|
begin
|
|
Result := ParseMultiplicativeExpr;
|
|
repeat
|
|
case CurToken of
|
|
tkPlus: op := opAdd;
|
|
tkMinus: op := opSubtract;
|
|
else
|
|
Break;
|
|
end;
|
|
NextToken;
|
|
Result := TXPathMathOpNode.Create(op, Result, ParseMultiplicativeExpr);
|
|
until False;
|
|
end;
|
|
|
|
function TXPathScanner.ParseMultiplicativeExpr: TXPathExprNode; // [26]
|
|
var
|
|
op: TXPathMathOp;
|
|
begin
|
|
Result := ParseUnaryExpr;
|
|
repeat
|
|
case CurToken of
|
|
tkAsterisk:
|
|
op := opMultiply;
|
|
tkIdentifier:
|
|
if FTokenId = xkDiv then
|
|
op := opDivide
|
|
else if FTokenId = xkMod then
|
|
op := opMod
|
|
else
|
|
break;
|
|
else
|
|
break;
|
|
end;
|
|
NextToken;
|
|
Result := TXPathMathOpNode.Create(op, Result, ParseUnaryExpr);
|
|
until False;
|
|
end;
|
|
|
|
function TXPathScanner.ParseUnaryExpr: TXPathExprNode; // [27]
|
|
var
|
|
NegCount: Integer;
|
|
begin
|
|
NegCount := 0;
|
|
while SkipToken(tkMinus) do
|
|
Inc(NegCount);
|
|
Result := ParseUnionExpr;
|
|
|
|
if Odd(NegCount) then
|
|
Result := TXPathNegationNode.Create(Result);
|
|
end;
|
|
|
|
{ TXPathContext }
|
|
|
|
constructor TXPathContext.Create(AContextNode: TDOMNode;
|
|
AContextPosition, AContextSize: Integer);
|
|
begin
|
|
inherited Create;
|
|
ContextNode := AContextNode;
|
|
ContextPosition := AContextPosition;
|
|
ContextSize := AContextSize;
|
|
end;
|
|
|
|
|
|
{ TXPathEnvironment }
|
|
|
|
type
|
|
PFunctionInfo = ^TFunctionInfo;
|
|
TFunctionInfo = record
|
|
Name: String;
|
|
Fn: TXPathFunction;
|
|
end;
|
|
|
|
PVariableInfo = ^TVariableInfo;
|
|
TVariableInfo = record
|
|
Name: String;
|
|
Variable: TXPathVariable;
|
|
end;
|
|
|
|
|
|
constructor TXPathEnvironment.Create;
|
|
begin
|
|
inherited Create;
|
|
FFunctions := TFPList.Create;
|
|
FVariables := TFPList.Create;
|
|
|
|
// Add the functions of the XPath Core Function Library
|
|
|
|
// Node set functions
|
|
AddFunction('last', @xpLast);
|
|
AddFunction('position', @xpPosition);
|
|
AddFunction('count', @xpCount);
|
|
AddFunction('id', @xpId);
|
|
AddFunction('local-name', @xpLocalName);
|
|
AddFunction('namespace-uri', @xpNamespaceURI);
|
|
AddFunction('name', @xpName);
|
|
// String functions
|
|
AddFunction('string', @xpString);
|
|
AddFunction('concat', @xpConcat);
|
|
AddFunction('starts-with', @xpStartsWith);
|
|
AddFunction('contains', @xpContains);
|
|
AddFunction('substring-before', @xpSubstringBefore);
|
|
AddFunction('substring-after', @xpSubstringAfter);
|
|
AddFunction('substring', @xpSubstring);
|
|
AddFunction('string-length', @xpStringLength);
|
|
AddFunction('normalize-space', @xpNormalizeSpace);
|
|
AddFunction('translate', @xpTranslate);
|
|
// Boolean functions
|
|
AddFunction('boolean', @xpBoolean);
|
|
AddFunction('not', @xpNot);
|
|
AddFunction('true', @xpTrue);
|
|
AddFunction('false', @xpFalse);
|
|
AddFunction('lang', @xpLang);
|
|
// Number functions
|
|
AddFunction('number', @xpNumber);
|
|
AddFunction('sum', @xpSum);
|
|
AddFunction('floor', @xpFloor);
|
|
AddFunction('ceiling', @xpCeiling);
|
|
AddFunction('round', @xpRound);
|
|
end;
|
|
|
|
destructor TXPathEnvironment.Destroy;
|
|
var
|
|
i: Integer;
|
|
FunctionInfo: PFunctionInfo;
|
|
VariableInfo: PVariableInfo;
|
|
begin
|
|
for i := 0 to FFunctions.Count - 1 do
|
|
begin
|
|
FunctionInfo := PFunctionInfo(FFunctions[i]);
|
|
FreeMem(FunctionInfo);
|
|
end;
|
|
FFunctions.Free;
|
|
for i := 0 to FVariables.Count - 1 do
|
|
begin
|
|
VariableInfo := PVariableInfo(FVariables[i]);
|
|
FreeMem(VariableInfo);
|
|
end;
|
|
FVariables.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetFunctionIndex(const AName: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FFunctions.Count - 1 do
|
|
if PFunctionInfo(FFunctions[i])^.Name = AName then
|
|
begin
|
|
Result := i;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetVariableIndex(const AName: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FVariables.Count - 1 do
|
|
if PVariableInfo(FFunctions[i])^.Name = AName then
|
|
begin
|
|
Result := i;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TXPathEnvironment.AddFunction(const AName: String; AFunction: TXPathFunction);
|
|
var
|
|
NewFunctionInfo: PFunctionInfo;
|
|
begin
|
|
// !!!: Prevent the addition of duplicate functions
|
|
New(NewFunctionInfo);
|
|
NewFunctionInfo^.Name := AName;
|
|
NewFunctionInfo^.Fn := AFunction;
|
|
FFunctions.Add(NewFunctionInfo);
|
|
end;
|
|
|
|
procedure TXPathEnvironment.AddVariable(const AName: String; AVariable: TXPathVariable);
|
|
var
|
|
NewVariableInfo: PVariableInfo;
|
|
begin
|
|
// !!!: Prevent the addition of duplicate variables
|
|
New(NewVariableInfo);
|
|
NewVariableInfo^.Name := AName;
|
|
NewVariableInfo^.Variable := AVariable;
|
|
FVariables.Add(NewVariableInfo);
|
|
end;
|
|
|
|
procedure TXPathEnvironment.RemoveFunction(Index: Integer);
|
|
var
|
|
FunctionInfo: PFunctionInfo;
|
|
begin
|
|
FunctionInfo := PFunctionInfo(FFunctions[Index]);
|
|
Dispose(FunctionInfo);
|
|
FFunctions.Delete(Index);
|
|
end;
|
|
|
|
procedure TXPathEnvironment.RemoveFunction(const AName: String);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FFunctions.Count - 1 do
|
|
if PFunctionInfo(FFunctions[i])^.Name = AName then
|
|
begin
|
|
RemoveFunction(i);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TXPathEnvironment.RemoveVariable(Index: Integer);
|
|
var
|
|
VariableInfo: PVariableInfo;
|
|
begin
|
|
VariableInfo := PVariableInfo(FVariables[Index]);
|
|
Dispose(VariableInfo);
|
|
FVariables.Delete(Index);
|
|
end;
|
|
|
|
procedure TXPathEnvironment.RemoveVariable(const AName: String);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := GetVariableIndex(AName);
|
|
if Index >= 0 then
|
|
RemoveVariable(Index);
|
|
end;
|
|
|
|
function TXPathEnvironment.GetFunctionCount: Integer;
|
|
begin
|
|
Result := FFunctions.Count;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetVariableCount: Integer;
|
|
begin
|
|
Result := FVariables.Count;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetFunction(Index: Integer): TXPathFunction;
|
|
begin
|
|
Result := PFunctionInfo(FFunctions[Index])^.Fn;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetFunction(const AName: String): TXPathFunction;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FFunctions.Count - 1 do
|
|
if PFunctionInfo(FFunctions[i])^.Name = AName then
|
|
begin
|
|
Result := PFunctionInfo(FFunctions[i])^.Fn;
|
|
exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetVariable(Index: Integer): TXPathVariable;
|
|
begin
|
|
Result := PVariableInfo(FVariables[Index])^.Variable;
|
|
end;
|
|
|
|
function TXPathEnvironment.GetVariable(const AName: String): TXPathVariable;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FVariables.Count - 1 do
|
|
if PFunctionInfo(FVariables[i])^.Name = AName then
|
|
begin
|
|
Result := PVariableInfo(FVariables[i])^.Variable;
|
|
exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TXPathEnvironment.xpLast(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 0 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathNumberVariable.Create(Context.ContextSize);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpPosition(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 0 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathNumberVariable.Create(Context.ContextPosition);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpCount(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathNumberVariable.Create(TXPathVariable(Args[0]).AsNodeSet.Count);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
i: Integer;
|
|
ResultSet: TNodeSet;
|
|
TheArg: TXPathVariable;
|
|
doc: TDOMDocument;
|
|
|
|
procedure AddId(ns: TNodeSet; const s: DOMString);
|
|
var
|
|
Head, Tail, L: Integer;
|
|
Token: DOMString;
|
|
Element: TDOMNode;
|
|
begin
|
|
Head := 1;
|
|
L := Length(s);
|
|
|
|
while Head <= L do
|
|
begin
|
|
while (Head <= L) and IsXmlWhiteSpace(@s[Head]) do
|
|
Inc(Head);
|
|
|
|
Tail := Head;
|
|
while (Tail <= L) and not IsXmlWhiteSpace(@s[Tail]) do
|
|
Inc(Tail);
|
|
SetString(Token, @s[Head], Tail - Head);
|
|
Element := doc.GetElementById(Token);
|
|
if Assigned(Element) then
|
|
ns.Add(Element);
|
|
|
|
Head := Tail;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
// TODO: probably have doc as member of Context
|
|
if Context.ContextNode.NodeType = DOCUMENT_NODE then
|
|
doc := TDOMDocument(Context.ContextNode)
|
|
else
|
|
doc := Context.ContextNode.OwnerDocument;
|
|
|
|
ResultSet := TNodeSet.Create;
|
|
TheArg := TXPathVariable(Args[0]);
|
|
if TheArg is TXPathNodeSetVariable then
|
|
begin
|
|
with TheArg.AsNodeSet do
|
|
for i := 0 to Count-1 do
|
|
AddId(ResultSet, NodeToText(TDOMNode(Items[i])));
|
|
end
|
|
else
|
|
AddId(ResultSet, TheArg.AsText);
|
|
Result := TXPathNodeSetVariable.Create(ResultSet);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
n: TDOMNode;
|
|
NodeSet: TNodeSet;
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
n := nil;
|
|
if Args.Count = 0 then
|
|
n := Context.ContextNode
|
|
else
|
|
begin
|
|
NodeSet := TXPathVariable(Args[0]).AsNodeSet;
|
|
if NodeSet.Count > 0 then
|
|
n := TDOMNode(NodeSet[0]);
|
|
end;
|
|
s := '';
|
|
if Assigned(n) then
|
|
begin
|
|
case n.NodeType of
|
|
ELEMENT_NODE,ATTRIBUTE_NODE:
|
|
with TDOMNode_NS(n) do
|
|
s := Copy(NSI.QName^.Key, NSI.PrefixLen+1, MaxInt);
|
|
PROCESSING_INSTRUCTION_NODE:
|
|
s := TDOMProcessingInstruction(n).Target;
|
|
// TODO: NAMESPACE_NODE: must return prefix part
|
|
end;
|
|
end;
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpNamespaceURI(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
n: TDOMNode;
|
|
NodeSet: TNodeSet;
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
n := nil;
|
|
if Args.Count = 0 then
|
|
n := Context.ContextNode
|
|
else
|
|
begin
|
|
NodeSet := TXPathVariable(Args[0]).AsNodeSet;
|
|
if NodeSet.Count > 0 then
|
|
n := TDOMNode(NodeSet[0]);
|
|
end;
|
|
if Assigned(n) then
|
|
s := n.namespaceUri
|
|
else
|
|
s := '';
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
n: TDOMNode;
|
|
NodeSet: TNodeSet;
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
n := nil;
|
|
if Args.Count = 0 then
|
|
n := Context.ContextNode
|
|
else
|
|
begin
|
|
NodeSet := TXPathVariable(Args[0]).AsNodeSet;
|
|
if NodeSet.Count > 0 then
|
|
n := TDOMNode(NodeSet[0]);
|
|
end;
|
|
s := '';
|
|
if Assigned(n) then
|
|
begin
|
|
case n.NodeType of
|
|
ELEMENT_NODE,ATTRIBUTE_NODE:
|
|
s := TDOMNode_NS(n).NSI.QName^.Key;
|
|
PROCESSING_INSTRUCTION_NODE:
|
|
s := TDOMProcessingInstruction(n).Target;
|
|
// TODO: NAMESPACE_NODE: must return prefix part
|
|
end;
|
|
end;
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
if Args.Count = 0 then
|
|
s := NodeToText(Context.ContextNode)
|
|
else
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpConcat(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
i: Integer;
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count < 2 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
SetLength(s, 0);
|
|
for i := 0 to Args.Count - 1 do
|
|
s := s + TXPathVariable(Args[i]).AsText;
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpStartsWith(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s1, s2: DOMString;
|
|
res: Boolean;
|
|
begin
|
|
if Args.Count <> 2 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
s1 := TXPathVariable(Args[0]).AsText;
|
|
s2 := TXPathVariable(Args[1]).AsText;
|
|
if s2 = '' then
|
|
res := True
|
|
else
|
|
res := Pos(s2, s1) = 1;
|
|
Result := TXPathBooleanVariable.Create(res);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpContains(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s1, s2: DOMString;
|
|
res: Boolean;
|
|
begin
|
|
if Args.Count <> 2 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
s1 := TXPathVariable(Args[0]).AsText;
|
|
s2 := TXPathVariable(Args[1]).AsText;
|
|
if s2 = '' then
|
|
res := True
|
|
else
|
|
res := Pos(s2, s1) <> 0;
|
|
Result := TXPathBooleanVariable.Create(res);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpSubstringBefore(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s, substr: DOMString;
|
|
begin
|
|
if Args.Count <> 2 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
substr := TXPathVariable(Args[1]).AsText;
|
|
Result := TXPathStringVariable.Create(Copy(s, 1, Pos(substr, s)-1));
|
|
end;
|
|
|
|
function TXPathEnvironment.xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s, substr: DOMString;
|
|
i: Integer;
|
|
begin
|
|
if Args.Count <> 2 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
substr := TXPathVariable(Args[1]).AsText;
|
|
i := Pos(substr, s);
|
|
if i <> 0 then
|
|
Result := TXPathStringVariable.Create(Copy(s, i + Length(substr), MaxInt))
|
|
else
|
|
Result := TXPathStringVariable.Create('');
|
|
end;
|
|
|
|
function TXPathEnvironment.xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s: DOMString;
|
|
i, n1, n2: Integer;
|
|
e1, e2: Extended;
|
|
empty: Boolean;
|
|
begin
|
|
if (Args.Count < 2) or (Args.Count > 3) then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
e1 := TXPathVariable(Args[1]).AsNumber;
|
|
n1 := 1; // satisfy compiler
|
|
n2 := MaxInt;
|
|
empty := IsNaN(e1) or IsInfinite(e1);
|
|
if not empty then
|
|
n1 := floor(0.5 + e1);
|
|
if Args.Count = 3 then
|
|
begin
|
|
e2 := TXPathVariable(Args[2]).AsNumber;
|
|
if IsNaN(e2) or (IsInfinite(e2) and (e2 < 0)) then
|
|
empty := True
|
|
else if not IsInfinite(e2) then
|
|
n2 := floor(0.5 + e2);
|
|
end;
|
|
i := Max(n1, 1);
|
|
if empty then
|
|
n2 := -1
|
|
else if n2 < MaxInt then
|
|
n2 := n2 + (n1 - i);
|
|
Result := TXPathStringVariable.Create(Copy(s, i, n2));
|
|
end;
|
|
|
|
function TXPathEnvironment.xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s: DOMString;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
if Args.Count = 0 then
|
|
s := NodeToText(Context.ContextNode)
|
|
else
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
Result := TXPathNumberVariable.Create(Length(s));
|
|
end;
|
|
|
|
function TXPathEnvironment.xpNormalizeSpace(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
s: DOMString;
|
|
p: DOMPChar;
|
|
i: Integer;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
if Args.Count = 0 then
|
|
s := NodeToText(Context.ContextNode)
|
|
else
|
|
s := TXPathVariable(Args[0]).AsText;
|
|
UniqueString(s);
|
|
p := DOMPChar(s);
|
|
for i := 1 to Length(s) do
|
|
begin
|
|
if (p^ = #10) or (p^ = #13) or (p^ = #9) then
|
|
p^ := #32;
|
|
Inc(p);
|
|
end;
|
|
NormalizeSpaces(s);
|
|
Result := TXPathStringVariable.Create(s);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpTranslate(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
S: DOMString;
|
|
begin
|
|
if Args.Count <> 3 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
S := TXPathVariable(Args[0]).AsText;
|
|
TranslateUTF8Chars(S, TXPathVariable(Args[1]).AsText, TXPathVariable(Args[2]).AsText);
|
|
Result := TXPathStringVariable.Create(S);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpBoolean(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathBooleanVariable.Create(TXPathVariable(Args[0]).AsBoolean);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpNot(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathBooleanVariable.Create(not TXPathVariable(Args[0]).AsBoolean);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpTrue(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 0 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathBooleanVariable.Create(True);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpFalse(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count <> 0 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
Result := TXPathBooleanVariable.Create(False);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
L: Integer;
|
|
TheArg, NodeLang: DOMString;
|
|
res: Boolean;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
TheArg := TXPathVariable(Args[0]).AsText;
|
|
NodeLang := GetNodeLanguage(Context.ContextNode);
|
|
|
|
L := Length(TheArg);
|
|
res := (L <= Length(NodeLang)) and
|
|
(XUStrLIComp(DOMPChar(NodeLang), DOMPChar(TheArg), L) = 0) and
|
|
((L = Length(NodeLang)) or (NodeLang[L+1] = '-'));
|
|
|
|
Result := TXPathBooleanVariable.Create(res);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
begin
|
|
if Args.Count > 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
if Args.Count = 0 then
|
|
Result := TXPathNumberVariable.Create(StrToNumber(NodeToText(Context.ContextNode)))
|
|
else
|
|
Result := TXPathNumberVariable.Create(TXPathVariable(Args[0]).AsNumber);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpSum(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
i: Integer;
|
|
ns: TNodeSet;
|
|
sum: Extended;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
ns := TXPathVariable(Args[0]).AsNodeSet;
|
|
sum := 0.0;
|
|
for i := 0 to ns.Count-1 do
|
|
sum := sum + StrToNumber(NodeToText(TDOMNode(ns[i])));
|
|
Result := TXPathNumberVariable.Create(sum);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpFloor(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
n: Extended;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
n := TXPathVariable(Args[0]).AsNumber;
|
|
if not IsNan(n) then
|
|
n := floor(n);
|
|
Result := TXPathNumberVariable.Create(n);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpCeiling(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
n: Extended;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
n := TXPathVariable(Args[0]).AsNumber;
|
|
if not IsNan(n) then
|
|
n := ceil(n);
|
|
Result := TXPathNumberVariable.Create(n);
|
|
end;
|
|
|
|
function TXPathEnvironment.xpRound(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
|
|
var
|
|
num: Extended;
|
|
begin
|
|
if Args.Count <> 1 then
|
|
EvaluationError(lrsEvalInvalidArgCount);
|
|
num := TXPathVariable(Args[0]).AsNumber;
|
|
if not (IsNan(num) or IsInfinite(num)) then
|
|
num := floor(0.5 + num);
|
|
Result := TXPathNumberVariable.Create(num);
|
|
end;
|
|
|
|
{ TXPathNSResolver }
|
|
|
|
constructor TXPathNSResolver.Create(aNode: TDOMNode);
|
|
begin
|
|
inherited Create;
|
|
FNode := aNode;
|
|
end;
|
|
|
|
function TXPathNSResolver.LookupNamespaceURI(const aPrefix: DOMString): DOMString;
|
|
begin
|
|
if assigned(FNode) then
|
|
result := FNode.LookupNamespaceURI(aPrefix)
|
|
else
|
|
result := '';
|
|
end;
|
|
|
|
|
|
{ TXPathExpression }
|
|
|
|
constructor TXPathExpression.Create(AScanner: TXPathScanner;
|
|
CompleteExpression: Boolean; AResolver: TXPathNSResolver);
|
|
begin
|
|
inherited Create;
|
|
AScanner.FResolver := AResolver;
|
|
FRootNode := AScanner.ParseOrExpr;
|
|
if CompleteExpression and (AScanner.CurToken <> tkEndOfStream) then
|
|
EvaluationError(lrsParserGarbageAfterExpression);
|
|
end;
|
|
|
|
function TXPathExpression.Evaluate(AContextNode: TDOMNode): TXPathVariable;
|
|
var
|
|
Environment: TXPathEnvironment;
|
|
begin
|
|
Environment := TXPathEnvironment.Create;
|
|
try
|
|
Result := Evaluate(AContextNode, Environment);
|
|
finally
|
|
Environment.Free;
|
|
end;
|
|
end;
|
|
|
|
destructor TXPathExpression.Destroy;
|
|
begin
|
|
FRootNode.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TXPathExpression.Evaluate(AContextNode: TDOMNode;
|
|
AEnvironment: TXPathEnvironment): TXPathVariable;
|
|
var
|
|
Context: TXPathContext;
|
|
mask: TFPUExceptionMask;
|
|
begin
|
|
if Assigned(FRootNode) then
|
|
begin
|
|
mask := GetExceptionMask;
|
|
SetExceptionMask(mask + [exInvalidOp, exZeroDivide]);
|
|
Context := TXPathContext.Create(AContextNode, 1, 1);
|
|
try
|
|
Result := FRootNode.Evaluate(Context, AEnvironment);
|
|
finally
|
|
Context.Free;
|
|
SetExceptionMask(mask);
|
|
end;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
function EvaluateXPathExpression(const AExpressionString: DOMString;
|
|
AContextNode: TDOMNode; AResolver: TXPathNSResolver): TXPathVariable;
|
|
var
|
|
Scanner: TXPathScanner;
|
|
Expression: TXPathExpression;
|
|
begin
|
|
Scanner := TXPathScanner.Create(AExpressionString);
|
|
try
|
|
Expression := TXPathExpression.Create(Scanner, True, AResolver);
|
|
try
|
|
Result := Expression.Evaluate(AContextNode);
|
|
finally
|
|
Expression.Free;
|
|
end;
|
|
finally
|
|
Scanner.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|