{ ********************************************************************** 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.