12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498 |
- {
- 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, [email protected]
- 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: DOMString;
- 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;
- class 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;
- class 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;
- class 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;
- class 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.
|