diff --git a/fcl/xml/Makefile b/fcl/xml/Makefile index 9697a8be4a..6b6fe981ac 100644 --- a/fcl/xml/Makefile +++ b/fcl/xml/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2003/01/14] +# Don't edit, this file is generated by FPCMake Version 1.1 [2003/03/16] # default: all MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx @@ -204,7 +204,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=fcl -override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite +override TARGET_UNITS+=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite xpath override INSTALL_FPCPACKAGE=y override COMPILER_OPTIONS+=-S2h override COMPILER_TARGETDIR+=../$(OS_TARGET) diff --git a/fcl/xml/Makefile.fpc b/fcl/xml/Makefile.fpc index 230533e431..2c545f417f 100644 --- a/fcl/xml/Makefile.fpc +++ b/fcl/xml/Makefile.fpc @@ -6,7 +6,7 @@ main=fcl [target] -units=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite +units=sax dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite xpath [compiler] options=-S2h diff --git a/fcl/xml/xpath.pp b/fcl/xml/xpath.pp new file mode 100644 index 0000000000..83dbddc0c3 --- /dev/null +++ b/fcl/xml/xpath.pp @@ -0,0 +1,2507 @@ +{ + $Id$ + This file is part of the Free Component Library + + Implementation of the XML Path Language (XPath) for Free Pascal + Copyright (c) 2000 - 2003 by + Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +unit XPath; + +interface + +uses SysUtils, Classes, DOM; + +resourcestring + { XPath variables type names } + SNodeSet = 'node set'; + SBoolean = 'boolean'; + SNumber = 'number'; + SString = 'string'; + + { Variable errors } + SVarNoConversion = 'Conversion from %s to %s not possible'; + + { Scanner errors } + SScannerInternalError = 'Internal expression scanner error'; + SScannerQuotStringIsOpen = 'Ending ''"'' for string not found'; + SScannerAposStringIsOpen = 'Ending "''" for string not found'; + SScannerInvalidChar = 'Invalid character'; + + { Parser errors } + SParserExpectedLeftBracket = 'Expected ")"'; + SParserExpectedRightBracket = 'Expected ")"'; + SParserExpectedColonColor = 'Expected "::" after axis specifier'; + SParserExpectedBrackets = 'Expected "()" after NodeType test'; + SParserExpectedRightSquareBracket = 'Expected "]" after predicate'; + SParserInvalidPrimExpr = 'Invalid primary expression'; + SParserGarbageAfterExpression = 'Unrecognized input after expression'; + SParserInvalidNodeTest = 'Invalid node test (syntax error)'; + SParserExpectedVarName = 'Expected variable name after "$"'; + + { Evaluation errors } + SEvalUnknownFunction = 'Unknown function: "%s"'; + SEvalUnknownVariable = 'Unknown variable: "%s"'; + SEvalInvalidArgCount = 'Invalid number of function arguments'; + SEvalFunctionNotImplementedYet = 'Function "%s" has not been implemented yet'; // !!! + +type + + TXPathContext = class; + TXPathEnvironment = class; + TXPathVariable = class; + + +{ XPath lexical scanner } + + TXPathToken = ( // [28] - [38] + tkInvalid, + tkEndOfStream, + tkIdentifier, + tkString, + tkNumber, + tkDollar, // "$" + tkLeftBracket, // "(" + tkRightBracket, // ")" + tkAsterisk, // "*" + tkPlus, // "+" + tkComma, // "," + tkMinus, // "-" + tkDot, // "." + tkDotDot, // ".." + tkSlash, // "/" + tkSlashSlash, // "//" + tkColon, // ":" + tkColonColon, // "::" + tkLess, // "<" + tkLessEqual, // "<=" + tkEqual, // "=" + tkNotEqual, // "!=" + tkGreater, // ">" + tkGreaterEqual, // ">=" + tkAt, // "@" + tkLeftSquareBracket, // "[" + tkRightSquareBracket, // "]" + tkPipe // "|" + ); + + +{ XPath expression parse tree } + + TXPathExprNode = class + public + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; virtual; abstract; + end; + + + TXPathConstantNode = class(TXPathExprNode) + private + FValue: TXPathVariable; + public + constructor Create(AValue: TXPathVariable); + destructor Destroy; override; + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + TXPathVariableNode = class(TXPathExprNode) + private + FName: DOMString; + public + constructor Create(const AName: DOMString); + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + TXPathFunctionNode = class(TXPathExprNode) + private + FName: DOMString; + FArgs: TList; + public + constructor Create(const AName: DOMString); + 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; + + + // Node for (binary) mathematical operation + + TXPathMathOp = (opAdd, opSubtract, opMultiply, opDivide, opMod); + + TXPathMathOpNode = class(TXPathExprNode) + private + FOperand1, FOperand2: TXPathExprNode; + FOperator: TXPathMathOp; + public + constructor Create(AOperator: TXPathMathOp; + AOperand1, AOperand2: TXPathExprNode); + destructor Destroy; override; + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + // Node for boolean operations + + TXPathBooleanOp = (opEqual, opNotEqual, opLess, opLessEqual, opGreater, + opGreaterEqual, opOr, opAnd); + + TXPathBooleanOpNode = class(TXPathExprNode) + private + FOperand1, FOperand2: TXPathExprNode; + FOperator: TXPathBooleanOp; + public + constructor Create(AOperator: TXPathBooleanOp; + AOperand1, AOperand2: TXPathExprNode); + destructor Destroy; override; + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + // Node for unions (see [18]) + + TXPathUnionNode = class(TXPathExprNode) + private + FOperand1, FOperand2: TXPathExprNode; + public + constructor Create(AOperand1, AOperand2: TXPathExprNode); + destructor Destroy; override; + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + // Filter node (for [20]) + + TXPathFilterNode = class(TXPathExprNode) + private + FExpr: TXPathExprNode; + FPredicates: TList; + 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); + + TNodeTestType = (ntAnyPrincipal, ntName, ntTextNode, + ntCommentNode, ntPINode, ntAnyNode); + + TStep = class + public + constructor Create; + destructor Destroy; override; + NextStep: TStep; + Axis: TAxis; + NodeTestType: TNodeTestType; + NodeTestString: DOMString; + Predicates: TList; + end; + + TXPathLocationPathNode = class(TXPathExprNode) + private + FFirstStep: TStep; + FIsAbsolutePath: Boolean; + public + constructor Create(AIsAbsolutePath: Boolean); + function Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; override; + end; + + + TNodeSet = TList; + +{ 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; + function AsNumber: Extended; virtual; + function AsText: DOMString; virtual; + 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; + 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; + + +{ XPath lexical scanner } + + TXPathScannerState = class + private + FCurData: PChar; + FCurToken: TXPathToken; + FCurTokenString: DOMString; + FDoUnget: Boolean; + end; + + TXPathScanner = class + private + FExpressionString, FCurData: PChar; // !!!: Change to PWideChar in future + FCurToken: TXPathToken; + FCurTokenString: DOMString; + FDoUnget: Boolean; + procedure Error(const Msg: String); + procedure Error(const Msg: String; const Args: array of const); + public + constructor Create(const AExpressionString: DOMString); + function NextToken: TXPathToken; + procedure UngetToken; + function SaveState: TXPathScannerState; + procedure RestoreState(AState: TXPathScannerState); + property CurToken: TXPathToken read FCurToken; + property CurTokenString: DOMString read FCurTokenString; + end; + + +{ XPath context } + + TXPathContext = class + public + constructor Create(AContextNode: TDOMNode; + AContextPosition, AContextSize: Integer); + ContextNode: TDOMNode; + ContextPosition: Integer; + ContextSize: 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 = TList; + + TXPathFunction = function(Context: TXPathContext; Args: TXPathVarList): + TXPathVariable of object; + + TXPathEnvironment = class + private + FFunctions: TList; + FVariables: TList; + 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(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(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpStartsWith(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpContains(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpSubstringBefore(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpNormalizeSpace(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpTranslate(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpBoolean(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpNot(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpTrue(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpFalse(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpSum(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpFloor(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpCeiling(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; + function xpRound(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); + function Evaluate(AContextNode: TDOMNode): TXPathVariable; + function Evaluate(AContextNode: TDOMNode; + AEnvironment: TXPathEnvironment): TXPathVariable; + end; + + +function EvaluateXPathExpression(const AExpressionString: DOMString; + AContextNode: TDOMNode): TXPathVariable; + + +// =================================================================== +// =================================================================== + +implementation + +{ 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 + Result := Result + NodeToText(Child); + Child := Child.NextSibling; + end; + end; + ATTRIBUTE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE, TEXT_NODE, + CDATA_SECTION_NODE, ENTITY_REFERENCE_NODE: + Result := Node.NodeValue; + end; + // !!!: What to do with 'namespace nodes'? +end; + + +{ XPath parse tree classes } + +constructor TXPathConstantNode.Create(AValue: TXPathVariable); +begin + inherited Create; + FValue := AValue; +end; + +destructor TXPathConstantNode.Destroy; +begin + FValue.Free; + 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(SEvalUnknownVariable, [FName]); +end; + + +constructor TXPathFunctionNode.Create(const AName: DOMString); +begin + inherited Create; + FName := AName; + FArgs := TList.Create; +end; + +destructor TXPathFunctionNode.Destroy; +var + i: Integer; +begin + for i := 0 to FArgs.Count - 1 do + TXPathExprNode(FArgs[i]).Free; + FArgs.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(SEvalUnknownFunction, [FName]); + + Args := TXPathVarList.Create; + try + for i := 0 to FArgs.Count - 1 do + Args.Add(TXPathExprNode(FArgs[i]).Evaluate(AContext, AEnvironment)); + Result := Fn(AContext, Args); + 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; + + +constructor TXPathMathOpNode.Create(AOperator: TXPathMathOp; + AOperand1, AOperand2: TXPathExprNode); +begin + inherited Create; + FOperator := AOperator; + FOperand1 := AOperand1; + FOperand2 := AOperand2; +end; + +destructor TXPathMathOpNode.Destroy; +begin + FOperand1.Free; + FOperand2.Free; + inherited Destroy; +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: + NumberResult := Trunc(Op1) mod Trunc(Op2); + end; + finally + Op2Result.Release; + end; + finally + Op1Result.Release; + end; + Result := TXPathNumberVariable.Create(NumberResult); +end; + + +constructor TXPathBooleanOpNode.Create(AOperator: TXPathBooleanOp; + AOperand1, AOperand2: TXPathExprNode); +begin + inherited Create; + FOperator := AOperator; + FOperand1 := AOperand1; + FOperand2 := AOperand2; +end; + +destructor TXPathBooleanOpNode.Destroy; +begin + FOperand1.Free; + FOperand2.Free; + inherited Destroy; +end; + +function TXPathBooleanOpNode.Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; +var + Op1, Op2: TXPathVariable; + + function EvalEqual: Boolean; + var + i, j: Integer; + NodeSet1, NodeSet2: TNodeSet; + s: DOMString; + begin + // !!!: Doesn't handle nodesets yet! + if Op1.InheritsFrom(TXPathNodeSetVariable) then + begin + NodeSet1 := Op1.AsNodeSet; + if Op2.InheritsFrom(TXPathNodeSetVariable) then + begin + NodeSet2 := Op2.AsNodeSet; + for i := 0 to NodeSet1.Count - 1 do + begin + s := NodeToText(TDOMNode(NodeSet1[i])); + for j := 0 to NodeSet2.Count - 1 do + if s = NodeToText(TDOMNode(NodeSet2[j])) then + begin + Result := True; + exit; + end; + end; + end else + begin + s := Op2.AsText; + for i := 0 to NodeSet1.Count - 1 do + begin + if NodeToText(TDOMNode(NodeSet1[i])) = s then + begin + Result := True; + exit; + end; + end; + end; + Result := False; + end else if Op2.InheritsFrom(TXPathNodeSetVariable) then + begin + s := Op1.AsText; + for i := 0 to NodeSet2.Count - 1 do + if s = NodeToText(TDOMNode(NodeSet2[i])) then + begin + Result := True; + exit; + end; + Result := False; + end else if Op1.InheritsFrom(TXPathBooleanVariable) or + Op2.InheritsFrom(TXPathBooleanVariable) then + Result := Op1.AsBoolean = Op2.AsBoolean + else if Op1.InheritsFrom(TXPathNumberVariable) or + Op2.InheritsFrom(TXPathNumberVariable) then + Result := Op1.AsNumber = Op2.AsNumber + else + Result := Op1.AsText = Op2.AsText; // !!!: Attention with Unicode! + end; + +var + BoolResult: Boolean; +begin + Op1 := FOperand1.Evaluate(AContext, AEnvironment); + try + Op2 := FOperand2.Evaluate(AContext, AEnvironment); + try + case FOperator of + opEqual: + BoolResult := EvalEqual; + opNotEqual: + BoolResult := not EvalEqual; + opLess: + BoolResult := Op1.AsNumber < Op2.AsNumber; + opLessEqual: + BoolResult := Op1.AsNumber <= Op2.AsNumber; + opGreater: + BoolResult := Op1.AsNumber > Op2.AsNumber; + opGreaterEqual: + BoolResult := Op1.AsNumber >= Op2.AsNumber; + opOr: + BoolResult := Op1.AsBoolean or Op2.AsBoolean; + opAnd: + BoolResult := Op1.AsBoolean and Op2.AsBoolean; + end; + finally + Op2.Release; + end; + finally + Op1.Release; + end; + Result := TXPathBooleanVariable.Create(BoolResult); +end; + + +constructor TXPathUnionNode.Create(AOperand1, AOperand2: TXPathExprNode); +begin + inherited Create; + FOperand1 := AOperand1; + FOperand2 := AOperand2; +end; + +destructor TXPathUnionNode.Destroy; +begin + FOperand1.Free; + FOperand2.Free; + inherited Destroy; +end; + +function TXPathUnionNode.Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; +var + Op1Result, Op2Result: TXPathVariable; + NodeSet, NodeSet2: TNodeSet; + CurNode: Pointer; + i, j: Integer; + DoAdd: Boolean; +begin + Op1Result := FOperand1.Evaluate(AContext, AEnvironment); + try + Op2Result := FOperand2.Evaluate(AContext, AEnvironment); + try + NodeSet := Op1Result.AsNodeSet; + NodeSet2 := Op2Result.AsNodeSet; + try + for i := 0 to NodeSet2.Count - 1 do + begin + DoAdd := True; + CurNode := NodeSet2[i]; + for j := 0 to NodeSet.Count - 1 do + if NodeSet[j] = CurNode then + begin + DoAdd := False; + break; + end; + if DoAdd then + NodeSet.Add(CurNode); + end; + finally + NodeSet2.Free; + end; + finally + Op2Result.Release; + end; + finally + Op1Result.Release; + end; + Result := TXPathNodeSetVariable.Create(NodeSet); +end; + + +constructor TXPathFilterNode.Create(AExpr: TXPathExprNode); +begin + inherited Create; + FExpr := AExpr; + FPredicates := TList.Create; +end; + +destructor TXPathFilterNode.Destroy; +var + i: Integer; +begin + for i := 0 to FPredicates.Count - 1 do + TXPathExprNode(FPredicates[i]).Free; + FPredicates.Free; + inherited Destroy; +end; + +function TXPathFilterNode.Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; +var + ExprResult, PredicateResult: TXPathVariable; + NodeSet, NewNodeSet: TNodeSet; + i, j: Integer; + CurContextNode: TDOMNode; + NewContext: TXPathContext; + DoAdd: Boolean; +begin + ExprResult := FExpr.Evaluate(AContext, AEnvironment); + NewContext := nil; + NewNodeSet := nil; + try + NodeSet := ExprResult.AsNodeSet; + NewContext := TXPathContext.Create(nil, 0, NodeSet.Count); + NewNodeSet := TNodeSet.Create; + try + for i := 0 to NodeSet.Count - 1 do + begin + CurContextNode := TDOMNode(NodeSet[i]); + NewContext.ContextNode := CurContextNode; + Inc(NewContext.ContextPosition); + DoAdd := True; + for j := 0 to FPredicates.Count - 1 do + begin + PredicateResult := TXPathExprNode(FPredicates[j]).Evaluate(NewContext, + AEnvironment); + try + if PredicateResult.InheritsFrom(TXPathNumberVariable) then + begin + if PredicateResult.AsNumber <> i + 1 then + begin + DoAdd := False; + break; + end; + end else if not PredicateResult.AsBoolean then + begin + DoAdd := False; + break; + end; + finally + PredicateResult.Release; + end; + end; + if DoAdd then + NewNodeSet.Add(CurContextNode); + end; + except + NewNodeSet.Free; + raise; + end; + Result := TXPathNodeSetVariable.Create(NewNodeSet); + finally + NewContext.Free; + ExprResult.Release; + end; +end; + + +constructor TStep.Create; +begin + inherited Create; + Predicates := TList.Create; +end; + +destructor TStep.Destroy; +var + i: Integer; +begin + for i := 0 to Predicates.Count - 1 do + TXPathExprNode(Predicates[i]).Free; + Predicates.Free; + inherited Free; +end; + +constructor TXPathLocationPathNode.Create(AIsAbsolutePath: Boolean); +begin + inherited Create; + FIsAbsolutePath := AIsAbsolutePath; +end; + +function TXPathLocationPathNode.Evaluate(AContext: TXPathContext; + AEnvironment: TXPathEnvironment): TXPathVariable; +var + ResultNodeSet: TNodeSet; + + procedure EvaluateStep(AStep: TStep; AContext: TXPathContext); + var + StepNodes: TList; + + procedure DoNodeTest(Node: TDOMNode); + var + i: Integer; + DoAdd: Boolean; + begin + case AStep.NodeTestType of + ntAnyPrincipal: + // !!!: Probably this isn't ready for namespace support yet + if (AStep.Axis <> axisAttribute) and + (Node.NodeType <> ELEMENT_NODE) then + exit; + ntName: + if Node.NodeName <> AStep.NodeTestString then + exit; + ntTextNode: + if not Node.InheritsFrom(TDOMCharacterData) then + exit; + ntCommentNode: + if Node.NodeType <> COMMENT_NODE then + exit; + ntPINode: + if Node.NodeType <> PROCESSING_INSTRUCTION_NODE then + exit; + end; + DoAdd := True; + for i := 0 to StepNodes.Count - 1 do + if TDOMNode(StepNodes[i]) = Node then + begin + DoAdd := False; + break; + end; + if DoAdd then + StepNodes.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; + + var + Node, Node2: TDOMNode; + Attr: TDOMNamedNodeMap; + i, j, k: Integer; + DoAdd: Boolean; + + NewContext: TXPathContext; + NewStepNodes: TNodeSet; + Predicate: TXPathExprNode; + PredicateResult: TXPathVariable; + + begin + StepNodes := TList.Create; + // !!!: Protect this with an try/finally block + case AStep.Axis of + axisAncestor: + begin + Node := AContext.ContextNode.ParentNode; + while Assigned(Node) do + begin + DoNodeTest(Node); + Node := Node.ParentNode; + end; + end; + axisAncestorOrSelf: + begin + Node := AContext.ContextNode; + repeat + DoNodeTest(Node); + Node := Node.ParentNode; + until not Assigned(Node); + end; + axisAttribute: + begin + Attr := AContext.ContextNode.Attributes; + if Assigned(Attr) then + for i := 0 to Attr.Length - 1 do + DoNodeTest(Attr[i]); + end; + axisChild: + begin + Node := AContext.ContextNode.FirstChild; + while Assigned(Node) do + begin + DoNodeTest(Node); + Node := Node.NextSibling; + end; + end; + axisDescendant: + AddDescendants(AContext.ContextNode); + axisDescendantOrSelf: + begin + DoNodeTest(AContext.ContextNode); + AddDescendants(AContext.ContextNode); + end; + axisFollowing: + begin + Node := AContext.ContextNode; + repeat + Node2 := Node.NextSibling; + while Assigned(Node2) do + begin + DoNodeTest(Node2); + AddDescendants(Node2); + Node := Node.NextSibling; + end; + Node := Node.ParentNode; + until not Assigned(Node); + end; + axisFollowingSibling: + begin + Node := AContext.ContextNode.NextSibling; + while Assigned(Node) do + begin + DoNodeTest(Node); + Node := Node.NextSibling; + end; + end; + {axisNamespace: !!!: Not supported yet} + axisParent: + if Assigned(AContext.ContextNode.ParentNode) then + DoNodeTest(AContext.ContextNode); + axisPreceding: + begin + Node := AContext.ContextNode; + repeat + Node2 := Node.PreviousSibling; + while Assigned(Node2) do + begin + DoNodeTest(Node2); + AddDescendants(Node2); + Node := Node.PreviousSibling; + end; + Node := Node.ParentNode; + until not Assigned(Node); + end; + axisPrecedingSibling: + begin + Node := AContext.ContextNode.PreviousSibling; + while Assigned(Node) do + begin + DoNodeTest(Node); + Node := Node.PreviousSibling; + end; + end; + axisSelf: + DoNodeTest(AContext.ContextNode); + end; + + + { Filter the nodes of this step using the predicates: The current + node set (StepNodes) is filtered, all passed nodes will be added + to NewStepNodes. After one filter has been applied, NewStepNodes + gets copied to StepNodes, and the next filter will be processed. + The final result will then be passed to the next step, or added + to the result of the LocationPath if this is the last step. } + + for i := 0 to AStep.Predicates.Count - 1 do + begin + NewContext := TXPathContext.Create(nil, 0, StepNodes.Count); + NewStepNodes := nil; + try + NewStepNodes := TNodeSet.Create; + Predicate := TXPathExprNode(AStep.Predicates[i]); + for j := 0 to StepNodes.Count - 1 do + begin + Node := TDOMNode(StepNodes[j]); + NewContext.ContextNode := Node; + Inc(NewContext.ContextPosition); + PredicateResult := Predicate.Evaluate(NewContext, AEnvironment); + try + if (PredicateResult.InheritsFrom(TXPathNumberVariable) and + (PredicateResult.AsNumber = j + 1)) or + PredicateResult.AsBoolean then + NewStepNodes.Add(Node); + finally + PredicateResult.Release; + end; + end; + finally + NewContext.Free; + StepNodes.Free; + StepNodes := NewStepNodes; + end; + end; + + if Assigned(AStep.NextStep) then + begin + NewContext := TXPathContext.Create(nil, 0, StepNodes.Count); + try + for i := 0 to StepNodes.Count - 1 do + begin + NewContext.ContextNode := TDOMNode(StepNodes[i]); + Inc(NewContext.ContextPosition); + EvaluateStep(AStep.NextStep, NewContext); + end; + finally + NewContext.Free; + end; + end else + begin + // Only add nodes to result if it isn't duplicate + for i := 0 to StepNodes.Count - 1 do + begin + Node := TDOMNode(StepNodes[i]); + DoAdd := True; + for j := 0 to ResultNodeSet.Count - 1 do + if TDOMNode(ResultNodeSet[j]) = Node then + begin + DoAdd := False; + break; + end; + if DoAdd then + ResultNodeSet.Add(Node); + end; + end; + + StepNodes.Free; + end; + +var + NewContext: TXPathContext; +begin + ResultNodeSet := TNodeSet.Create; + try + if FIsAbsolutePath then + begin + NewContext := TXPathContext.Create(AContext.ContextNode.OwnerDocument, + 1, 1); + try + EvaluateStep(FFirstStep, NewContext); + finally + NewContext.Free; + end; + end else + EvaluateStep(FFirstStep, AContext); + 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(SVarNoConversion, [TypeName, TXPathNodeSetVariable.TypeName]); + Result := nil; +end; + +function TXPathVariable.AsBoolean: Boolean; +begin + Error(SVarNoConversion, [TypeName, TXPathBooleanVariable.TypeName]); + Result := False; +end; + +function TXPathVariable.AsNumber: Extended; +begin + Error(SVarNoConversion, [TypeName, TXPathNumberVariable.TypeName]); + Result := 0; +end; + +function TXPathVariable.AsText: String; +begin + Error(SVarNoConversion, [TypeName, TXPathStringVariable.TypeName]); + SetLength(Result, 0); +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; + +function TXPathNodeSetVariable.TypeName: String; +begin + Result := SNodeSet; +end; + +function TXPathNodeSetVariable.AsNodeSet: TNodeSet; +begin + Result := FValue; +end; + +function TXPathNodeSetVariable.AsText: DOMString; +begin + if FValue.Count = 0 then + SetLength(Result, 0) + else + Result := NodeToText(TDOMNode(FValue[0])); +end; + + +constructor TXPathBooleanVariable.Create(AValue: Boolean); +begin + inherited Create; + FValue := AValue; +end; + +function TXPathBooleanVariable.TypeName: String; +begin + Result := SBoolean; +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; + +function TXPathNumberVariable.TypeName: String; +begin + Result := SNumber; +end; + +function TXPathNumberVariable.AsBoolean: Boolean; +begin + // !!!: What about NaNs and so on? + if FValue = 0 then + Result := False + else + Result := True; +end; + +function TXPathNumberVariable.AsNumber: Extended; +begin + Result := FValue; +end; + +function TXPathNumberVariable.AsText: DOMString; +begin + Result := FloatToStr(FValue); +end; + + +constructor TXPathStringVariable.Create(const AValue: DOMString); +begin + inherited Create; + FValue := AValue; +end; + +function TXPathStringVariable.TypeName: String; +begin + Result := SString; +end; + +function TXPathStringVariable.AsBoolean: Boolean; +begin + Result := Length(FValue) > 0; +end; + +function TXPathStringVariable.AsNumber: Extended; +begin + Result := StrToFloat(FValue); +end; + +function TXPathStringVariable.AsText: DOMString; +begin + Result := FValue; +end; + + +{ XPath lexical scanner } + +constructor TXPathScanner.Create(const AExpressionString: DOMString); +begin + inherited Create; + FExpressionString := PChar(AExpressionString); + FCurData := FExpressionString; +end; + +function TXPathScanner.NextToken: TXPathToken; + + procedure GetNumber; + var + HasDot: Boolean; + begin + HasDot := Pos('.', FCurTokenString) > 0; + while (FCurData[1] in ['0'..'9']) or ((FCurData[1] = '.') and not HasDot) do + begin + Inc(FCurData); + FCurTokenString := FCurTokenString + FCurData[0]; + if FCurData[0] = '.' then + HasDot := True; + end; + Result := tkNumber; + end; + +const + IdentifierChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-', '_']; +begin + if FDoUnget then + begin + FDoUnget := False; + Result := FCurToken; + exit; + end; + + if FCurToken = tkEndOfStream then + begin + Result := tkEndOfStream; + exit; + end; + + { No, we cannot use a lookup table here, as future + versions will use WideStrings -sg } + + // Skip whitespace + while FCurData[0] in [#9, #10, #12, #13, ' '] do + Inc(FCurData); + + FCurTokenString := FCurData[0]; + + case FCurData[0] of + #0: + Result := tkEndOfStream; + '!': + if FCurData[1] = '=' then + begin + Inc(FCurData); + Result := tkNotEqual; + end; + '"': + begin + SetLength(FCurTokenString, 0); + Inc(FCurData); + while FCurData[0] <> '"' do + begin + if FCurData[0] = #0 then + Error(SScannerQuotStringIsOpen); + FCurTokenString := FCurTokenString + FCurData[0]; + Inc(FCurData); + end; + Result := tkString; + end; + '$': + Result := tkDollar; + '''': + begin + SetLength(FCurTokenString, 0); + Inc(FCurData); + while FCurData[0] <> '''' do + begin + if FCurData[0] = #0 then + Error(SScannerAposStringIsOpen); + FCurTokenString := FCurTokenString + FCurData[0]; + Inc(FCurData); + end; + Result := tkString; + 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] in ['0'..'9'] then + GetNumber + else + Result := tkDot; + '/': + if FCurData[1] = '/' then + begin + Inc(FCurData); + Result := tkSlashSlash; + end else + Result := tkSlash; + '0'..'9': + GetNumber; + ':': + if FCurData[1] = ':' then + begin + Inc(FCurData); + Result := tkColonColon; + end else + Result := tkColon; + '<': + 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; + 'A'..'Z', 'a'..'z': + begin + Result := tkIdentifier; + while FCurData[1] in IdentifierChars do + begin + Inc(FCurData); + FCurTokenString := FCurTokenString + FCurData[0]; + end; + end; + '[': + Result := tkLeftSquareBracket; + ']': + Result := tkRightSquareBracket; + '|': + Result := tkPipe; + else + Error(SScannerInvalidChar); + end; + + // We have processed at least one character now; eat it: + if Result <> tkEndOfStream then + Inc(FCurData); + + FCurToken := Result; +end; + +procedure TXPathScanner.UngetToken; +begin + if FDoUnget then + Error(SScannerInternalError, ['Tried to unget token a second time']); + FDoUnget := True; +end; + +function TXPathScanner.SaveState: TXPathScannerState; +begin + Result := TXPathScannerState.Create; + Result.FCurData := FCurData; + Result.FCurToken := FCurToken; + Result.FCurTokenString := FCurTokenString; + Result.FDoUnget := FDoUnget; +end; + +procedure TXPathScanner.RestoreState(AState: TXPathScannerState); +begin + FCurData := AState.FCurData; + FCurToken := AState.FCurToken; + FCurTokenString := AState.FCurTokenString; + FDoUnget := AState.FDoUnget; + AState.Free; +end; + +procedure TXPathScanner.Error(const Msg: String); +begin + raise Exception.Create(Msg) at get_caller_addr(get_frame); +end; + +procedure TXPathScanner.Error(const Msg: String; const Args: array of const); +begin + raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame); +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 := TList.Create; + FVariables := TList.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(SEvalInvalidArgCount); + Result := TXPathNumberVariable.Create(Context.ContextSize); +end; + +function TXPathEnvironment.xpPosition(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 0 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathNumberVariable.Create(Context.ContextPosition); +end; + +function TXPathEnvironment.xpCount(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathNumberVariable.Create(TXPathVariable(Args[0]).AsNodeSet.Count); +end; + +function TXPathEnvironment.xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['id']); // !!! +end; + +function TXPathEnvironment.xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count > 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['local-name']); // !!! +end; + +function TXPathEnvironment.xpNamespaceURI(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count > 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['namespace-uri']); // !!! +end; + +function TXPathEnvironment.xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +var + NodeSet: TNodeSet; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + NodeSet := TXPathVariable(Args[0]).AsNodeSet; + if NodeSet.Count = 0 then + Result := TXPathStringVariable.Create('') + else + // !!!: Probably not really correct regarding namespaces... + Result := TXPathStringVariable.Create(TDOMNode(NodeSet[0]).NodeName); +end; + +function TXPathEnvironment.xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +var + s: String; +begin + if Args.Count > 1 then + EvaluationError(SEvalInvalidArgCount); + 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(SEvalInvalidArgCount); + 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; +begin + if Args.Count <> 2 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['namespace-uri']); // !!! +end; + +function TXPathEnvironment.xpContains(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 2 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['contains']); // !!! +end; + +function TXPathEnvironment.xpSubstringBefore(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 2 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['substring-before']); // !!! +end; + +function TXPathEnvironment.xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['substring-after']); // !!! +end; + +function TXPathEnvironment.xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if (Args.Count < 2) or (Args.Count > 3) then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['substring']); // !!! +end; + +function TXPathEnvironment.xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +var + s: DOMString; +begin + if Args.Count < 1 then + EvaluationError(SEvalInvalidArgCount); + 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; +begin + if Args.Count < 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['normalize-space']); // !!! +end; + +function TXPathEnvironment.xpTranslate(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 3 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['translate']); // !!! +end; + +function TXPathEnvironment.xpBoolean(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathBooleanVariable.Create(TXPathVariable(Args[0]).AsBoolean); +end; + +function TXPathEnvironment.xpNot(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathBooleanVariable.Create(not TXPathVariable(Args[0]).AsBoolean); +end; + +function TXPathEnvironment.xpTrue(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 0 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathBooleanVariable.Create(True); +end; + +function TXPathEnvironment.xpFalse(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 0 then + EvaluationError(SEvalInvalidArgCount); + Result := TXPathBooleanVariable.Create(False); +end; + +function TXPathEnvironment.xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['lang']); // !!! +end; + +function TXPathEnvironment.xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count > 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['number']); // !!! +end; + +function TXPathEnvironment.xpSum(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['sum']); // !!! +end; + +function TXPathEnvironment.xpFloor(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['floor']); // !!! +end; + +function TXPathEnvironment.xpCeiling(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['ceiling']); // !!! +end; + +function TXPathEnvironment.xpRound(Context: TXPathContext; Args: TXPathVarList): TXPathVariable; +begin + if Args.Count <> 1 then + EvaluationError(SEvalInvalidArgCount); + EvaluationError(SEvalFunctionNotImplementedYet, ['round']); // !!! +end; + + + +{ TXPathExpression } + +constructor TXPathExpression.Create(AScanner: TXPathScanner; + CompleteExpression: Boolean); + + function ParseLocationPath: TXPathLocationPathNode; forward; // [1] + function ParsePrimaryExpr: TXPathExprNode; forward; // [15] + function ParseUnionExpr: TXPathExprNode; forward; // [18] + function ParsePathExpr: TXPathExprNode; forward; // [19] + function ParseFilterExpr: TXPathExprNode; forward; // [20] + function ParseOrExpr: TXPathExprNode; forward; // [21] + function ParseAndExpr: TXPathExprNode; forward; // [22] + function ParseEqualityExpr: TXPathExprNode; forward; // [23] + function ParseRelationalExpr: TXPathExprNode; forward; // [24] + function ParseAdditiveExpr: TXPathExprNode; forward; // [25] + function ParseMultiplicativeExpr: TXPathExprNode; forward; // [26] + function ParseUnaryExpr: TXPathExprNode; forward; // [27] + + procedure Error(const Msg: String); + begin + raise Exception.Create(Msg) at get_caller_addr(get_frame); + end; + + procedure Error(const Msg: String; const Args: array of const); + begin + raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame); + end; + + function ParseLocationPath: TXPathLocationPathNode; // [1] + var + IsAbsolute, NeedColonColon: Boolean; + FirstStep, CurStep, NextStep: TStep; + begin + IsAbsolute := False; + CurStep := nil; + + case AScanner.NextToken of + tkSlash: // [2] AbsoluteLocationPath, first case + begin + IsAbsolute := True; + if not (AScanner.NextToken in + [tkDot, tkDotDot, tkAsterisk, tkAt, tkIdentifier]) then + begin + AScanner.UngetToken; + exit; + end; + AScanner.UngetToken; + end; + tkSlashSlash: // [10] AbbreviatedAbsoluteLocationPath + begin + IsAbsolute := True; + CurStep := TStep.Create; + CurStep.Axis := axisDescendantOrSelf; + CurStep.NodeTestType := ntAnyNode; + end; + else + begin + AScanner.UngetToken; + IsAbsolute := False; + end; + end; + + // Parse [3] RelativeLocationPath + FirstStep := CurStep; + while True do + begin + NextStep := TStep.Create; + if Assigned(CurStep) then + CurStep.NextStep := NextStep + else + FirstStep := NextStep; + CurStep := NextStep; + + // Parse [4] Step + case AScanner.NextToken of + tkDot: // [12] Abbreviated step, first case + begin + CurStep.Axis := axisSelf; + CurStep.NodeTestType := ntAnyNode; + end; + tkDotDot: // [12] Abbreviated step, second case + begin + CurStep.Axis := axisParent; + CurStep.NodeTestType := ntAnyNode; + end; + else + begin + AScanner.UngetToken; + + // Parse [5] AxisSpecifier + case AScanner.NextToken of + tkAt: // [13] AbbreviatedAxisSpecifier + CurStep.Axis := axisAttribute; + tkIdentifier: // [5] AxisName '::' + begin + // Check for [6] AxisName + NeedColonColon := True; + if AScanner.CurTokenString = 'ancestor' then + CurStep.Axis := axisAncestor + else if AScanner.CurTokenString = 'ancestor-or-self' then + CurStep.Axis := axisAncestorOrSelf + else if AScanner.CurTokenString = 'attribute' then + CurStep.Axis := axisAttribute + else if AScanner.CurTokenString = 'child' then + CurStep.Axis := axisChild + else if AScanner.CurTokenString = 'descendant' then + CurStep.Axis := axisDescendant + else if AScanner.CurTokenString = 'descendant-or-self' then + CurStep.Axis := axisDescendantOrSelf + else if AScanner.CurTokenString = 'following' then + CurStep.Axis := axisFollowing + else if AScanner.CurTokenString = 'following-sibling' then + CurStep.Axis := axisFollowingSibling + else if AScanner.CurTokenString = 'namespace' then + CurStep.Axis := axisNamespace + else if AScanner.CurTokenString = 'parent' then + CurStep.Axis := axisParent + else if AScanner.CurTokenString = 'preceding' then + CurStep.Axis := axisPreceding + else if AScanner.CurTokenString = 'preceding-sibling' then + CurStep.Axis := axisPrecedingSibling + else if AScanner.CurTokenString = 'self' then + CurStep.Axis := axisSelf + else + begin + NeedColonColon := False; + AScanner.UngetToken; + CurStep.Axis := axisChild; + end; + if NeedColonColon and (AScanner.NextToken <> tkColonColon) then + Error(SParserExpectedColonColor); + end; + else + begin + AScanner.UngetToken; + CurStep.Axis := axisChild; + end; + end; + + // Parse [7] NodeTest + case AScanner.NextToken of + tkAsterisk: // [37] NameTest, first case + CurStep.NodeTestType := ntAnyPrincipal; + tkIdentifier: + begin + // Check for case [38] NodeType + if AScanner.CurTokenString = 'comment' then + begin + if (AScanner.NextToken <> tkLeftBracket) or + (AScanner.NextToken <> tkRightBracket) then + Error(SParserExpectedBrackets); + CurStep.NodeTestType := ntCommentNode; + end else if AScanner.CurTokenString = 'text' then + begin + if (AScanner.NextToken <> tkLeftBracket) or + (AScanner.NextToken <> tkRightBracket) then + Error(SParserExpectedBrackets); + CurStep.NodeTestType := ntTextNode; + end else if AScanner.CurTokenString = 'processing-instruction' then + begin + if (AScanner.NextToken <> tkLeftBracket) or + (AScanner.NextToken <> tkRightBracket) then + Error(SParserExpectedBrackets); + CurStep.NodeTestType := ntPINode; + end else if AScanner.CurTokenString = 'node' then + begin + if (AScanner.NextToken <> tkLeftBracket) or + (AScanner.NextToken <> tkRightBracket) then + Error(SParserExpectedBrackets); + CurStep.NodeTestType := ntAnyNode; + end else // [37] NameTest, second or third case + begin + // !!!: Doesn't support namespaces yet + // (this will have to wait until the DOM unit supports them) + CurStep.NodeTestType := ntName; + CurStep.NodeTestString := AScanner.CurTokenString; + end; + end; + else + Error(SParserInvalidNodeTest); + end; + + // Parse predicates + while AScanner.NextToken = tkLeftSquareBracket do + begin + CurStep.Predicates.Add(ParseOrExpr); + if AScanner.NextToken <> tkRightSquareBracket then + Error(SParserExpectedRightSquareBracket); + end; + AScanner.UngetToken; + end; + end; + + // Continue with parsing of [3] RelativeLocationPath + if AScanner.NextToken = tkSlashSlash then + begin + // Found abbreviated step ("//" for "descendant-or-self::node()") + NextStep := TStep.Create; + CurStep.NextStep := NextStep; + CurStep := NextStep; + CurStep.Axis := axisDescendantOrSelf; + CurStep.NodeTestType := ntAnyNode; + end else if AScanner.CurToken <> tkSlash then + begin + AScanner.UngetToken; + break; + end; + end; + + Result := TXPathLocationPathNode.Create(IsAbsolute); + TXPathLocationPathNode(Result).FFirstStep := FirstStep; + end; + + function ParsePrimaryExpr: TXPathExprNode; // [15] + var + IsFirstArg: Boolean; + begin + case AScanner.NextToken of + tkDollar: // [36] Variable reference + begin + if AScanner.NextToken <> tkIdentifier then + Error(SParserExpectedVarName); + Result := TXPathVariableNode.Create(AScanner.CurTokenString); + end; + tkLeftBracket: + begin + Result := ParseOrExpr; + if AScanner.NextToken <> tkRightBracket then + Error(SParserExpectedRightBracket); + end; + tkString: // [29] Literal + Result := TXPathConstantNode.Create( + TXPathStringVariable.Create(AScanner.CurTokenString)); + tkNumber: // [30] Number + Result := TXPathConstantNode.Create( + TXPathNumberVariable.Create(StrToFloat(AScanner.CurTokenString))); + tkIdentifier: // [16] Function call + begin + Result := TXPathFunctionNode.Create(AScanner.CurTokenString); + if AScanner.NextToken <> tkLeftBracket then + Error(SParserExpectedLeftBracket); + // Parse argument list + IsFirstArg := True; + while AScanner.NextToken <> tkRightBracket do + begin + if IsFirstArg then + begin + IsFirstArg := False; + AScanner.UngetToken; + end else + if AScanner.CurToken <> tkComma then + Error(SParserExpectedRightBracket); + TXPathFunctionNode(Result).FArgs.Add(ParseOrExpr); + end; + end; + else + Error(SParserInvalidPrimExpr); + end; + end; + + function ParseUnionExpr: TXPathExprNode; // [18] + begin + Result := ParsePathExpr; + while True do + if AScanner.NextToken = tkPipe then + Result := TXPathUnionNode.Create(Result, ParsePathExpr) + else + begin + AScanner.UngetToken; + break; + end; + end; + + function ParsePathExpr: TXPathExprNode; // [19] + var + ScannerState: TXPathScannerState; + IsFunctionCall: Boolean; + begin + // Try to detect wether a LocationPath [1] or a FilterExpr [20] follows + + IsFunctionCall := False; + if (AScanner.NextToken = tkIdentifier) and + (AScanner.CurTokenString <> 'comment') and + (AScanner.CurTokenString <> 'text') and + (AScanner.CurTokenString <> 'processing-instruction') and + (AScanner.CurTokenString <> 'node') then + begin + ScannerState := AScanner.SaveState; + if AScanner.NextToken = tkLeftBracket then + IsFunctionCall := True; + AScanner.RestoreState(ScannerState); + end; + + if IsFunctionCall or (AScanner.CurToken in + [tkDollar, tkLeftBracket, tkString, tkNumber]) then + begin + // second, third or fourth case of [19] + AScanner.UngetToken; + Result := ParseFilterExpr; + // !!!: Doesn't handle "/" or "//" plus RelativeLocationPath yet! + end else + begin + AScanner.UngetToken; + Result := ParseLocationPath; + end; + end; + + function ParseFilterExpr: TXPathExprNode; // [20] + var + IsFirst: Boolean; + begin + Result := ParsePrimaryExpr; + // Parse predicates + IsFirst := True; + while AScanner.NextToken = tkLeftSquareBracket do + begin + if IsFirst then + begin + Result := TXPathFilterNode.Create(Result); + IsFirst := False; + end; + TXPathFilterNode(Result).FPredicates.Add(ParseOrExpr); + if AScanner.NextToken <> tkRightSquareBracket then + Error(SParserExpectedRightSquareBracket); + end; + AScanner.UngetToken; + end; + + function ParseOrExpr: TXPathExprNode; // [21] + begin + Result := ParseAndExpr; + while True do + if (AScanner.NextToken = tkIdentifier) and + (AScanner.CurTokenString = 'or') then + Result := TXPathBooleanOpNode.Create(opOr, Result, ParseAndExpr) + else + begin + AScanner.UngetToken; + break; + end; + end; + + function ParseAndExpr: TXPathExprNode; // [22] + begin + Result := ParseEqualityExpr; + while True do + if (AScanner.NextToken = tkIdentifier) and + (AScanner.CurTokenString = 'and') then + Result := TXPathBooleanOpNode.Create(opAnd, Result, ParseEqualityExpr) + else + begin + AScanner.UngetToken; + break; + end; + end; + + function ParseEqualityExpr: TXPathExprNode; // [23] + begin + Result := ParseRelationalExpr; + while True do + case AScanner.NextToken of + tkEqual: + Result := TXPathBooleanOpNode.Create(opEqual, Result, + ParseRelationalExpr); + tkNotEqual: + Result := TXPathBooleanOpNode.Create(opNotEqual, Result, + ParseRelationalExpr); + else + begin + AScanner.UngetToken; + break; + end; + end; + end; + + function ParseRelationalExpr: TXPathExprNode; // [24] + begin + Result := ParseAdditiveExpr; + while True do + case AScanner.NextToken of + tkLess: + Result := TXPathBooleanOpNode.Create(opLess, Result, + ParseAdditiveExpr); + tkLessEqual: + Result := TXPathBooleanOpNode.Create(opLessEqual, Result, + ParseAdditiveExpr); + tkGreater: + Result := TXPathBooleanOpNode.Create(opGreater, Result, + ParseAdditiveExpr); + tkGreaterEqual: + Result := TXPathBooleanOpNode.Create(opGreaterEqual, Result, + ParseAdditiveExpr); + else + begin + AScanner.UngetToken; + break; + end; + end; + end; + + function ParseAdditiveExpr: TXPathExprNode; // [25] + begin + Result := ParseMultiplicativeExpr; + while True do + case AScanner.NextToken of + tkPlus: + Result := TXPathMathOpNode.Create(opAdd, Result, + ParseMultiplicativeExpr); + tkMinus: + Result := TXPathMathOpNode.Create(opSubtract, Result, + ParseMultiplicativeExpr); + else + begin + AScanner.UngetToken; + break; + end; + end; + end; + + function ParseMultiplicativeExpr: TXPathExprNode; // [26] + begin + Result := ParseUnaryExpr; + while True do + case AScanner.NextToken of + tkAsterisk: + Result := TXPathMathOpNode.Create(opMultiply, Result, + ParseUnaryExpr); + tkIdentifier: + if AScanner.CurTokenString = 'div' then + Result := TXPathMathOpNode.Create(opDivide, Result, + ParseUnaryExpr) + else if AScanner.CurTokenString = 'mod' then + Result := TXPathMathOpNode.Create(opMod, Result, + ParseUnaryExpr) + else + begin + AScanner.UngetToken; + break; + end; + else + begin + AScanner.UngetToken; + break; + end; + end; + end; + + function ParseUnaryExpr: TXPathExprNode; // [27] + var + NegCount: Integer; + begin + NegCount := 0; + while AScanner.NextToken = tkMinus do + Inc(NegCount); + AScanner.UngetToken; + + Result := ParseUnionExpr; + + if Odd(NegCount) then + Result := TXPathNegationNode.Create(Result); + end; + +begin + inherited Create; + FRootNode := ParseOrExpr; + if CompleteExpression and (AScanner.NextToken <> tkEndOfStream) then + Error(SParserGarbageAfterExpression); +end; + +function TXPathExpression.Evaluate(AContextNode: TDOMNode): TXPathVariable; +var + Environment: TXPathEnvironment; +begin + Environment := TXPathEnvironment.Create; + try + Result := Evaluate(AContextNode, Environment); + finally + Environment.Free; + end; +end; + +function TXPathExpression.Evaluate(AContextNode: TDOMNode; + AEnvironment: TXPathEnvironment): TXPathVariable; +var + Context: TXPathContext; +begin + if Assigned(FRootNode) then + begin + Context := TXPathContext.Create(AContextNode, 1, 1); + try + Result := FRootNode.Evaluate(Context, AEnvironment); + finally + Context.Free; + end; + end else + Result := nil; +end; + + +function EvaluateXPathExpression(const AExpressionString: DOMString; + AContextNode: TDOMNode): TXPathVariable; +var + Scanner: TXPathScanner; + Expression: TXPathExpression; +begin + Scanner := TXPathScanner.Create(AExpressionString); + try + Expression := TXPathExpression.Create(Scanner, True); + try + Result := Expression.Evaluate(AContextNode); + finally + Expression.Free; + end; + finally + Scanner.Free; + end; +end; + +end. + + +{ + $Log$ + Revision 1.1 2003-03-16 22:10:57 sg + * Added XPath unit + +}