xpath.pp 69 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498
  1. {
  2. This file is part of the Free Component Library
  3. Implementation of the XML Path Language (XPath) for Free Pascal
  4. Copyright (c) 2000 - 2003 by
  5. Areca Systems GmbH / Sebastian Guenther, [email protected]
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit XPath;
  13. interface
  14. uses SysUtils, Classes, DOM;
  15. resourcestring
  16. { XPath variables type names }
  17. SNodeSet = 'node set';
  18. SBoolean = 'boolean';
  19. SNumber = 'number';
  20. SString = 'string';
  21. { Variable errors }
  22. SVarNoConversion = 'Conversion from %s to %s not possible';
  23. { Scanner errors }
  24. SScannerInternalError = 'Internal expression scanner error';
  25. SScannerQuotStringIsOpen = 'Ending ''"'' for string not found';
  26. SScannerAposStringIsOpen = 'Ending "''" for string not found';
  27. SScannerInvalidChar = 'Invalid character';
  28. { Parser errors }
  29. SParserExpectedLeftBracket = 'Expected ")"';
  30. SParserExpectedRightBracket = 'Expected ")"';
  31. SParserExpectedColonColor = 'Expected "::" after axis specifier';
  32. SParserExpectedBrackets = 'Expected "()" after NodeType test';
  33. SParserExpectedRightSquareBracket = 'Expected "]" after predicate';
  34. SParserInvalidPrimExpr = 'Invalid primary expression';
  35. SParserGarbageAfterExpression = 'Unrecognized input after expression';
  36. SParserInvalidNodeTest = 'Invalid node test (syntax error)';
  37. SParserExpectedVarName = 'Expected variable name after "$"';
  38. { Evaluation errors }
  39. SEvalUnknownFunction = 'Unknown function: "%s"';
  40. SEvalUnknownVariable = 'Unknown variable: "%s"';
  41. SEvalInvalidArgCount = 'Invalid number of function arguments';
  42. SEvalFunctionNotImplementedYet = 'Function "%s" has not been implemented yet'; // !!!
  43. type
  44. TXPathContext = class;
  45. TXPathEnvironment = class;
  46. TXPathVariable = class;
  47. { XPath lexical scanner }
  48. TXPathToken = ( // [28] - [38]
  49. tkInvalid,
  50. tkEndOfStream,
  51. tkIdentifier,
  52. tkString,
  53. tkNumber,
  54. tkDollar, // "$"
  55. tkLeftBracket, // "("
  56. tkRightBracket, // ")"
  57. tkAsterisk, // "*"
  58. tkPlus, // "+"
  59. tkComma, // ","
  60. tkMinus, // "-"
  61. tkDot, // "."
  62. tkDotDot, // ".."
  63. tkSlash, // "/"
  64. tkSlashSlash, // "//"
  65. tkColon, // ":"
  66. tkColonColon, // "::"
  67. tkLess, // "<"
  68. tkLessEqual, // "<="
  69. tkEqual, // "="
  70. tkNotEqual, // "!="
  71. tkGreater, // ">"
  72. tkGreaterEqual, // ">="
  73. tkAt, // "@"
  74. tkLeftSquareBracket, // "["
  75. tkRightSquareBracket, // "]"
  76. tkPipe // "|"
  77. );
  78. { XPath expression parse tree }
  79. TXPathExprNode = class
  80. public
  81. function Evaluate(AContext: TXPathContext;
  82. AEnvironment: TXPathEnvironment): TXPathVariable; virtual; abstract;
  83. end;
  84. TXPathConstantNode = class(TXPathExprNode)
  85. private
  86. FValue: TXPathVariable;
  87. public
  88. constructor Create(AValue: TXPathVariable);
  89. destructor Destroy; override;
  90. function Evaluate(AContext: TXPathContext;
  91. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  92. end;
  93. TXPathVariableNode = class(TXPathExprNode)
  94. private
  95. FName: DOMString;
  96. public
  97. constructor Create(const AName: DOMString);
  98. function Evaluate(AContext: TXPathContext;
  99. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  100. end;
  101. TXPathFunctionNode = class(TXPathExprNode)
  102. private
  103. FName: DOMString;
  104. FArgs: TList;
  105. public
  106. constructor Create(const AName: DOMString);
  107. destructor Destroy; override;
  108. function Evaluate(AContext: TXPathContext;
  109. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  110. end;
  111. TXPathNegationNode = class(TXPathExprNode)
  112. private
  113. FOperand: TXPathExprNode;
  114. public
  115. constructor Create(AOperand: TXPathExprNode);
  116. destructor Destroy; override;
  117. function Evaluate(AContext: TXPathContext;
  118. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  119. end;
  120. // Node for (binary) mathematical operation
  121. TXPathMathOp = (opAdd, opSubtract, opMultiply, opDivide, opMod);
  122. TXPathMathOpNode = class(TXPathExprNode)
  123. private
  124. FOperand1, FOperand2: TXPathExprNode;
  125. FOperator: TXPathMathOp;
  126. public
  127. constructor Create(AOperator: TXPathMathOp;
  128. AOperand1, AOperand2: TXPathExprNode);
  129. destructor Destroy; override;
  130. function Evaluate(AContext: TXPathContext;
  131. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  132. end;
  133. // Node for boolean operations
  134. TXPathBooleanOp = (opEqual, opNotEqual, opLess, opLessEqual, opGreater,
  135. opGreaterEqual, opOr, opAnd);
  136. TXPathBooleanOpNode = class(TXPathExprNode)
  137. private
  138. FOperand1, FOperand2: TXPathExprNode;
  139. FOperator: TXPathBooleanOp;
  140. public
  141. constructor Create(AOperator: TXPathBooleanOp;
  142. AOperand1, AOperand2: TXPathExprNode);
  143. destructor Destroy; override;
  144. function Evaluate(AContext: TXPathContext;
  145. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  146. end;
  147. // Node for unions (see [18])
  148. TXPathUnionNode = class(TXPathExprNode)
  149. private
  150. FOperand1, FOperand2: TXPathExprNode;
  151. public
  152. constructor Create(AOperand1, AOperand2: TXPathExprNode);
  153. destructor Destroy; override;
  154. function Evaluate(AContext: TXPathContext;
  155. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  156. end;
  157. // Filter node (for [20])
  158. TXPathFilterNode = class(TXPathExprNode)
  159. private
  160. FExpr: TXPathExprNode;
  161. FPredicates: TList;
  162. public
  163. constructor Create(AExpr: TXPathExprNode);
  164. destructor Destroy; override;
  165. function Evaluate(AContext: TXPathContext;
  166. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  167. end;
  168. // Node for location paths
  169. TAxis = (axisInvalid, axisAncestor, axisAncestorOrSelf, axisAttribute,
  170. axisChild, axisDescendant, axisDescendantOrSelf, axisFollowing,
  171. axisFollowingSibling, axisNamespace, axisParent, axisPreceding,
  172. axisPrecedingSibling, axisSelf);
  173. TNodeTestType = (ntAnyPrincipal, ntName, ntTextNode,
  174. ntCommentNode, ntPINode, ntAnyNode);
  175. TStep = class
  176. public
  177. constructor Create;
  178. destructor Destroy; override;
  179. NextStep: TStep;
  180. Axis: TAxis;
  181. NodeTestType: TNodeTestType;
  182. NodeTestString: DOMString;
  183. Predicates: TList;
  184. end;
  185. TXPathLocationPathNode = class(TXPathExprNode)
  186. private
  187. FFirstStep: TStep;
  188. FIsAbsolutePath: Boolean;
  189. public
  190. constructor Create(AIsAbsolutePath: Boolean);
  191. function Evaluate(AContext: TXPathContext;
  192. AEnvironment: TXPathEnvironment): TXPathVariable; override;
  193. end;
  194. TNodeSet = TList;
  195. { Exceptions }
  196. EXPathEvaluationError = class(Exception);
  197. procedure EvaluationError(const Msg: String);
  198. procedure EvaluationError(const Msg: String; const Args: array of const);
  199. type
  200. { XPath variables and results classes }
  201. TXPathVariable = class
  202. protected
  203. FRefCount: Integer;
  204. procedure Error(const Msg: String; const Args: array of const);
  205. public
  206. class function TypeName: String; virtual; abstract;
  207. procedure Release;
  208. function AsNodeSet: TNodeSet; virtual;
  209. function AsBoolean: Boolean; virtual;
  210. function AsNumber: Extended; virtual;
  211. function AsText: DOMString; virtual;
  212. end;
  213. TXPathNodeSetVariable = class(TXPathVariable)
  214. private
  215. FValue: TNodeSet;
  216. public
  217. constructor Create(AValue: TNodeSet);
  218. destructor Destroy; override;
  219. class function TypeName: String; override;
  220. function AsNodeSet: TNodeSet; override;
  221. function AsText: DOMString; override;
  222. property Value: TNodeSet read FValue;
  223. end;
  224. TXPathBooleanVariable = class(TXPathVariable)
  225. private
  226. FValue: Boolean;
  227. public
  228. constructor Create(AValue: Boolean);
  229. class function TypeName: String; override;
  230. function AsBoolean: Boolean; override;
  231. function AsNumber: Extended; override;
  232. function AsText: DOMString; override;
  233. property Value: Boolean read FValue;
  234. end;
  235. TXPathNumberVariable = class(TXPathVariable)
  236. private
  237. FValue: Extended;
  238. public
  239. constructor Create(AValue: Extended);
  240. class function TypeName: String; override;
  241. function AsBoolean: Boolean; override;
  242. function AsNumber: Extended; override;
  243. function AsText: DOMString; override;
  244. property Value: Extended read FValue;
  245. end;
  246. TXPathStringVariable = class(TXPathVariable)
  247. private
  248. FValue: DOMString;
  249. public
  250. constructor Create(const AValue: DOMString);
  251. class function TypeName: String; override;
  252. function AsBoolean: Boolean; override;
  253. function AsNumber: Extended; override;
  254. function AsText: DOMString; override;
  255. property Value: DOMString read FValue;
  256. end;
  257. { XPath lexical scanner }
  258. TXPathScannerState = class
  259. private
  260. FCurData: PChar;
  261. FCurToken: TXPathToken;
  262. FCurTokenString: DOMString;
  263. FDoUnget: Boolean;
  264. end;
  265. TXPathScanner = class
  266. private
  267. FExpressionString, FCurData: PChar; // !!!: Change to PWideChar in future
  268. FCurToken: TXPathToken;
  269. FCurTokenString: DOMString;
  270. FDoUnget: Boolean;
  271. procedure Error(const Msg: String);
  272. procedure Error(const Msg: String; const Args: array of const);
  273. public
  274. constructor Create(const AExpressionString: DOMString);
  275. function NextToken: TXPathToken;
  276. procedure UngetToken;
  277. function SaveState: TXPathScannerState;
  278. procedure RestoreState(AState: TXPathScannerState);
  279. property CurToken: TXPathToken read FCurToken;
  280. property CurTokenString: DOMString read FCurTokenString;
  281. end;
  282. { XPath context }
  283. TXPathContext = class
  284. public
  285. constructor Create(AContextNode: TDOMNode;
  286. AContextPosition, AContextSize: Integer);
  287. ContextNode: TDOMNode;
  288. ContextPosition: Integer;
  289. ContextSize: Integer;
  290. end;
  291. { XPath environments (not defined in XPath standard: an environment contains
  292. the variables and functions, which are part of the context in the official
  293. standard). }
  294. TXPathVarList = TList;
  295. TXPathFunction = function(Context: TXPathContext; Args: TXPathVarList):
  296. TXPathVariable of object;
  297. TXPathEnvironment = class
  298. private
  299. FFunctions: TList;
  300. FVariables: TList;
  301. function GetFunctionCount: Integer;
  302. function GetVariableCount: Integer;
  303. function GetFunction(Index: Integer): TXPathFunction;
  304. function GetFunction(const AName: String): TXPathFunction;
  305. function GetVariable(Index: Integer): TXPathVariable;
  306. function GetVariable(const AName: String): TXPathVariable;
  307. protected
  308. // XPath Core Function Library:
  309. function xpLast(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  310. function xpPosition(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  311. function xpCount(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  312. function xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  313. function xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  314. function xpNamespaceURI(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  315. function xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  316. function xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  317. function xpConcat(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  318. function xpStartsWith(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  319. function xpContains(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  320. function xpSubstringBefore(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  321. function xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  322. function xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  323. function xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  324. function xpNormalizeSpace(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  325. function xpTranslate(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  326. function xpBoolean(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  327. function xpNot(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  328. function xpTrue(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  329. function xpFalse(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  330. function xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  331. function xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  332. function xpSum(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  333. function xpFloor(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  334. function xpCeiling(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  335. function xpRound(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  336. public
  337. constructor Create;
  338. destructor Destroy; override;
  339. function GetFunctionIndex(const AName: String): Integer;
  340. function GetVariableIndex(const AName: String): Integer;
  341. procedure AddFunction(const AName: String; AFunction: TXPathFunction);
  342. procedure AddVariable(const AName: String; AVariable: TXPathVariable);
  343. procedure RemoveFunction(Index: Integer);
  344. procedure RemoveFunction(const AName: String);
  345. procedure RemoveVariable(Index: Integer);
  346. procedure RemoveVariable(const AName: String);
  347. property FunctionCount: Integer read GetFunctionCount;
  348. property VariableCount: Integer read GetVariableCount;
  349. property Functions[Index: Integer]: TXPathFunction read GetFunction;
  350. property FunctionsByName[const AName: String]: TXPathFunction
  351. read GetFunction;
  352. property Variables[Index: Integer]: TXPathVariable read GetVariable;
  353. property VariablesByName[const AName: String]: TXPathVariable read GetVariable;
  354. end;
  355. { XPath expressions }
  356. TXPathExpression = class
  357. private
  358. FRootNode: TXPathExprNode;
  359. public
  360. { CompleteExpresion specifies wether the parser should check for gargabe
  361. after the recognised part. True => Throw exception if there is garbage }
  362. constructor Create(AScanner: TXPathScanner; CompleteExpression: Boolean);
  363. function Evaluate(AContextNode: TDOMNode): TXPathVariable;
  364. function Evaluate(AContextNode: TDOMNode;
  365. AEnvironment: TXPathEnvironment): TXPathVariable;
  366. end;
  367. function EvaluateXPathExpression(const AExpressionString: DOMString;
  368. AContextNode: TDOMNode): TXPathVariable;
  369. // ===================================================================
  370. // ===================================================================
  371. implementation
  372. { Helper functions }
  373. function NodeToText(Node: TDOMNode): DOMString;
  374. var
  375. Child: TDOMNode;
  376. begin
  377. case Node.NodeType of
  378. DOCUMENT_NODE, DOCUMENT_FRAGMENT_NODE, ELEMENT_NODE:
  379. begin
  380. SetLength(Result, 0);
  381. Child := Node.FirstChild;
  382. while Assigned(Child) do
  383. begin
  384. Result := Result + NodeToText(Child);
  385. Child := Child.NextSibling;
  386. end;
  387. end;
  388. ATTRIBUTE_NODE, PROCESSING_INSTRUCTION_NODE, COMMENT_NODE, TEXT_NODE,
  389. CDATA_SECTION_NODE, ENTITY_REFERENCE_NODE:
  390. Result := Node.NodeValue;
  391. end;
  392. // !!!: What to do with 'namespace nodes'?
  393. end;
  394. { XPath parse tree classes }
  395. constructor TXPathConstantNode.Create(AValue: TXPathVariable);
  396. begin
  397. inherited Create;
  398. FValue := AValue;
  399. end;
  400. destructor TXPathConstantNode.Destroy;
  401. begin
  402. FValue.Free;
  403. inherited Destroy;
  404. end;
  405. function TXPathConstantNode.Evaluate(AContext: TXPathContext;
  406. AEnvironment: TXPathEnvironment): TXPathVariable;
  407. begin
  408. Result := FValue;
  409. Inc(Result.FRefCount);
  410. end;
  411. constructor TXPathVariableNode.Create(const AName: DOMString);
  412. begin
  413. inherited Create;
  414. FName := AName;
  415. end;
  416. function TXPathVariableNode.Evaluate(AContext: TXPathContext;
  417. AEnvironment: TXPathEnvironment): TXPathVariable;
  418. begin
  419. Result := AEnvironment.VariablesByName[FName];
  420. if not Assigned(Result) then
  421. EvaluationError(SEvalUnknownVariable, [FName]);
  422. end;
  423. constructor TXPathFunctionNode.Create(const AName: DOMString);
  424. begin
  425. inherited Create;
  426. FName := AName;
  427. FArgs := TList.Create;
  428. end;
  429. destructor TXPathFunctionNode.Destroy;
  430. var
  431. i: Integer;
  432. begin
  433. for i := 0 to FArgs.Count - 1 do
  434. TXPathExprNode(FArgs[i]).Free;
  435. FArgs.Free;
  436. inherited Destroy;
  437. end;
  438. function TXPathFunctionNode.Evaluate(AContext: TXPathContext;
  439. AEnvironment: TXPathEnvironment): TXPathVariable;
  440. var
  441. Fn: TXPathFunction;
  442. Args: TXPathVarList;
  443. i: Integer;
  444. begin
  445. Fn := AEnvironment.FunctionsByName[FName];
  446. if not Assigned(Fn) then
  447. EvaluationError(SEvalUnknownFunction, [FName]);
  448. Args := TXPathVarList.Create;
  449. try
  450. for i := 0 to FArgs.Count - 1 do
  451. Args.Add(TXPathExprNode(FArgs[i]).Evaluate(AContext, AEnvironment));
  452. Result := Fn(AContext, Args);
  453. finally
  454. Args.Free;
  455. end;
  456. end;
  457. constructor TXPathNegationNode.Create(AOperand: TXPathExprNode);
  458. begin
  459. inherited Create;
  460. FOperand := AOperand;
  461. end;
  462. destructor TXPathNegationNode.Destroy;
  463. begin
  464. FOperand.Free;
  465. inherited Destroy;
  466. end;
  467. function TXPathNegationNode.Evaluate(AContext: TXPathContext;
  468. AEnvironment: TXPathEnvironment): TXPathVariable;
  469. var
  470. OpResult: TXPathVariable;
  471. begin
  472. OpResult := FOperand.Evaluate(AContext, AEnvironment);
  473. try
  474. Result := TXPathNumberVariable.Create(-OpResult.AsNumber);
  475. finally
  476. OpResult.Release;
  477. end;
  478. end;
  479. constructor TXPathMathOpNode.Create(AOperator: TXPathMathOp;
  480. AOperand1, AOperand2: TXPathExprNode);
  481. begin
  482. inherited Create;
  483. FOperator := AOperator;
  484. FOperand1 := AOperand1;
  485. FOperand2 := AOperand2;
  486. end;
  487. destructor TXPathMathOpNode.Destroy;
  488. begin
  489. FOperand1.Free;
  490. FOperand2.Free;
  491. inherited Destroy;
  492. end;
  493. function TXPathMathOpNode.Evaluate(AContext: TXPathContext;
  494. AEnvironment: TXPathEnvironment): TXPathVariable;
  495. var
  496. Op1Result, Op2Result: TXPathVariable;
  497. Op1, Op2, NumberResult: Extended;
  498. begin
  499. Op1Result := FOperand1.Evaluate(AContext, AEnvironment);
  500. try
  501. Op2Result := FOperand2.Evaluate(AContext, AEnvironment);
  502. try
  503. Op1 := Op1Result.AsNumber;
  504. Op2 := Op2Result.AsNumber;
  505. case FOperator of
  506. opAdd:
  507. NumberResult := Op1 + Op2;
  508. opSubtract:
  509. NumberResult := Op1 - Op2;
  510. opMultiply:
  511. NumberResult := Op1 * Op2;
  512. opDivide:
  513. NumberResult := Op1 / Op2;
  514. opMod:
  515. NumberResult := Trunc(Op1) mod Trunc(Op2);
  516. end;
  517. finally
  518. Op2Result.Release;
  519. end;
  520. finally
  521. Op1Result.Release;
  522. end;
  523. Result := TXPathNumberVariable.Create(NumberResult);
  524. end;
  525. constructor TXPathBooleanOpNode.Create(AOperator: TXPathBooleanOp;
  526. AOperand1, AOperand2: TXPathExprNode);
  527. begin
  528. inherited Create;
  529. FOperator := AOperator;
  530. FOperand1 := AOperand1;
  531. FOperand2 := AOperand2;
  532. end;
  533. destructor TXPathBooleanOpNode.Destroy;
  534. begin
  535. FOperand1.Free;
  536. FOperand2.Free;
  537. inherited Destroy;
  538. end;
  539. function TXPathBooleanOpNode.Evaluate(AContext: TXPathContext;
  540. AEnvironment: TXPathEnvironment): TXPathVariable;
  541. var
  542. Op1, Op2: TXPathVariable;
  543. function EvalEqual: Boolean;
  544. var
  545. i, j: Integer;
  546. NodeSet1, NodeSet2: TNodeSet;
  547. s: DOMString;
  548. begin
  549. // !!!: Doesn't handle nodesets yet!
  550. if Op1.InheritsFrom(TXPathNodeSetVariable) then
  551. begin
  552. NodeSet1 := Op1.AsNodeSet;
  553. if Op2.InheritsFrom(TXPathNodeSetVariable) then
  554. begin
  555. NodeSet2 := Op2.AsNodeSet;
  556. for i := 0 to NodeSet1.Count - 1 do
  557. begin
  558. s := NodeToText(TDOMNode(NodeSet1[i]));
  559. for j := 0 to NodeSet2.Count - 1 do
  560. if s = NodeToText(TDOMNode(NodeSet2[j])) then
  561. begin
  562. Result := True;
  563. exit;
  564. end;
  565. end;
  566. end else
  567. begin
  568. s := Op2.AsText;
  569. for i := 0 to NodeSet1.Count - 1 do
  570. begin
  571. if NodeToText(TDOMNode(NodeSet1[i])) = s then
  572. begin
  573. Result := True;
  574. exit;
  575. end;
  576. end;
  577. end;
  578. Result := False;
  579. end else if Op2.InheritsFrom(TXPathNodeSetVariable) then
  580. begin
  581. s := Op1.AsText;
  582. for i := 0 to NodeSet2.Count - 1 do
  583. if s = NodeToText(TDOMNode(NodeSet2[i])) then
  584. begin
  585. Result := True;
  586. exit;
  587. end;
  588. Result := False;
  589. end else if Op1.InheritsFrom(TXPathBooleanVariable) or
  590. Op2.InheritsFrom(TXPathBooleanVariable) then
  591. Result := Op1.AsBoolean = Op2.AsBoolean
  592. else if Op1.InheritsFrom(TXPathNumberVariable) or
  593. Op2.InheritsFrom(TXPathNumberVariable) then
  594. Result := Op1.AsNumber = Op2.AsNumber
  595. else
  596. Result := Op1.AsText = Op2.AsText; // !!!: Attention with Unicode!
  597. end;
  598. var
  599. BoolResult: Boolean;
  600. begin
  601. Op1 := FOperand1.Evaluate(AContext, AEnvironment);
  602. try
  603. Op2 := FOperand2.Evaluate(AContext, AEnvironment);
  604. try
  605. case FOperator of
  606. opEqual:
  607. BoolResult := EvalEqual;
  608. opNotEqual:
  609. BoolResult := not EvalEqual;
  610. opLess:
  611. BoolResult := Op1.AsNumber < Op2.AsNumber;
  612. opLessEqual:
  613. BoolResult := Op1.AsNumber <= Op2.AsNumber;
  614. opGreater:
  615. BoolResult := Op1.AsNumber > Op2.AsNumber;
  616. opGreaterEqual:
  617. BoolResult := Op1.AsNumber >= Op2.AsNumber;
  618. opOr:
  619. BoolResult := Op1.AsBoolean or Op2.AsBoolean;
  620. opAnd:
  621. BoolResult := Op1.AsBoolean and Op2.AsBoolean;
  622. end;
  623. finally
  624. Op2.Release;
  625. end;
  626. finally
  627. Op1.Release;
  628. end;
  629. Result := TXPathBooleanVariable.Create(BoolResult);
  630. end;
  631. constructor TXPathUnionNode.Create(AOperand1, AOperand2: TXPathExprNode);
  632. begin
  633. inherited Create;
  634. FOperand1 := AOperand1;
  635. FOperand2 := AOperand2;
  636. end;
  637. destructor TXPathUnionNode.Destroy;
  638. begin
  639. FOperand1.Free;
  640. FOperand2.Free;
  641. inherited Destroy;
  642. end;
  643. function TXPathUnionNode.Evaluate(AContext: TXPathContext;
  644. AEnvironment: TXPathEnvironment): TXPathVariable;
  645. var
  646. Op1Result, Op2Result: TXPathVariable;
  647. NodeSet, NodeSet2: TNodeSet;
  648. CurNode: Pointer;
  649. i, j: Integer;
  650. DoAdd: Boolean;
  651. begin
  652. Op1Result := FOperand1.Evaluate(AContext, AEnvironment);
  653. try
  654. Op2Result := FOperand2.Evaluate(AContext, AEnvironment);
  655. try
  656. NodeSet := Op1Result.AsNodeSet;
  657. NodeSet2 := Op2Result.AsNodeSet;
  658. try
  659. for i := 0 to NodeSet2.Count - 1 do
  660. begin
  661. DoAdd := True;
  662. CurNode := NodeSet2[i];
  663. for j := 0 to NodeSet.Count - 1 do
  664. if NodeSet[j] = CurNode then
  665. begin
  666. DoAdd := False;
  667. break;
  668. end;
  669. if DoAdd then
  670. NodeSet.Add(CurNode);
  671. end;
  672. finally
  673. NodeSet2.Free;
  674. end;
  675. finally
  676. Op2Result.Release;
  677. end;
  678. finally
  679. Op1Result.Release;
  680. end;
  681. Result := TXPathNodeSetVariable.Create(NodeSet);
  682. end;
  683. constructor TXPathFilterNode.Create(AExpr: TXPathExprNode);
  684. begin
  685. inherited Create;
  686. FExpr := AExpr;
  687. FPredicates := TList.Create;
  688. end;
  689. destructor TXPathFilterNode.Destroy;
  690. var
  691. i: Integer;
  692. begin
  693. for i := 0 to FPredicates.Count - 1 do
  694. TXPathExprNode(FPredicates[i]).Free;
  695. FPredicates.Free;
  696. inherited Destroy;
  697. end;
  698. function TXPathFilterNode.Evaluate(AContext: TXPathContext;
  699. AEnvironment: TXPathEnvironment): TXPathVariable;
  700. var
  701. ExprResult, PredicateResult: TXPathVariable;
  702. NodeSet, NewNodeSet: TNodeSet;
  703. i, j: Integer;
  704. CurContextNode: TDOMNode;
  705. NewContext: TXPathContext;
  706. DoAdd: Boolean;
  707. begin
  708. ExprResult := FExpr.Evaluate(AContext, AEnvironment);
  709. NewContext := nil;
  710. NewNodeSet := nil;
  711. try
  712. NodeSet := ExprResult.AsNodeSet;
  713. NewContext := TXPathContext.Create(nil, 0, NodeSet.Count);
  714. NewNodeSet := TNodeSet.Create;
  715. try
  716. for i := 0 to NodeSet.Count - 1 do
  717. begin
  718. CurContextNode := TDOMNode(NodeSet[i]);
  719. NewContext.ContextNode := CurContextNode;
  720. Inc(NewContext.ContextPosition);
  721. DoAdd := True;
  722. for j := 0 to FPredicates.Count - 1 do
  723. begin
  724. PredicateResult := TXPathExprNode(FPredicates[j]).Evaluate(NewContext,
  725. AEnvironment);
  726. try
  727. if PredicateResult.InheritsFrom(TXPathNumberVariable) then
  728. begin
  729. if PredicateResult.AsNumber <> i + 1 then
  730. begin
  731. DoAdd := False;
  732. break;
  733. end;
  734. end else if not PredicateResult.AsBoolean then
  735. begin
  736. DoAdd := False;
  737. break;
  738. end;
  739. finally
  740. PredicateResult.Release;
  741. end;
  742. end;
  743. if DoAdd then
  744. NewNodeSet.Add(CurContextNode);
  745. end;
  746. except
  747. NewNodeSet.Free;
  748. raise;
  749. end;
  750. Result := TXPathNodeSetVariable.Create(NewNodeSet);
  751. finally
  752. NewContext.Free;
  753. ExprResult.Release;
  754. end;
  755. end;
  756. constructor TStep.Create;
  757. begin
  758. inherited Create;
  759. Predicates := TList.Create;
  760. end;
  761. destructor TStep.Destroy;
  762. var
  763. i: Integer;
  764. begin
  765. for i := 0 to Predicates.Count - 1 do
  766. TXPathExprNode(Predicates[i]).Free;
  767. Predicates.Free;
  768. inherited Free;
  769. end;
  770. constructor TXPathLocationPathNode.Create(AIsAbsolutePath: Boolean);
  771. begin
  772. inherited Create;
  773. FIsAbsolutePath := AIsAbsolutePath;
  774. end;
  775. function TXPathLocationPathNode.Evaluate(AContext: TXPathContext;
  776. AEnvironment: TXPathEnvironment): TXPathVariable;
  777. var
  778. ResultNodeSet: TNodeSet;
  779. procedure EvaluateStep(AStep: TStep; AContext: TXPathContext);
  780. var
  781. StepNodes: TList;
  782. procedure DoNodeTest(Node: TDOMNode);
  783. var
  784. i: Integer;
  785. DoAdd: Boolean;
  786. begin
  787. case AStep.NodeTestType of
  788. ntAnyPrincipal:
  789. // !!!: Probably this isn't ready for namespace support yet
  790. if (AStep.Axis <> axisAttribute) and
  791. (Node.NodeType <> ELEMENT_NODE) then
  792. exit;
  793. ntName:
  794. if Node.NodeName <> AStep.NodeTestString then
  795. exit;
  796. ntTextNode:
  797. if not Node.InheritsFrom(TDOMCharacterData) then
  798. exit;
  799. ntCommentNode:
  800. if Node.NodeType <> COMMENT_NODE then
  801. exit;
  802. ntPINode:
  803. if Node.NodeType <> PROCESSING_INSTRUCTION_NODE then
  804. exit;
  805. end;
  806. DoAdd := True;
  807. for i := 0 to StepNodes.Count - 1 do
  808. if TDOMNode(StepNodes[i]) = Node then
  809. begin
  810. DoAdd := False;
  811. break;
  812. end;
  813. if DoAdd then
  814. StepNodes.Add(Node);
  815. end;
  816. procedure AddDescendants(CurNode: TDOMNode);
  817. var
  818. Child: TDOMNode;
  819. begin
  820. Child := CurNode.FirstChild;
  821. while Assigned(Child) do
  822. begin
  823. DoNodeTest(Child);
  824. AddDescendants(Child);
  825. Child := Child.NextSibling;
  826. end;
  827. end;
  828. var
  829. Node, Node2: TDOMNode;
  830. Attr: TDOMNamedNodeMap;
  831. i, j, k: Integer;
  832. DoAdd: Boolean;
  833. NewContext: TXPathContext;
  834. NewStepNodes: TNodeSet;
  835. Predicate: TXPathExprNode;
  836. PredicateResult: TXPathVariable;
  837. begin
  838. StepNodes := TList.Create;
  839. // !!!: Protect this with an try/finally block
  840. case AStep.Axis of
  841. axisAncestor:
  842. begin
  843. Node := AContext.ContextNode.ParentNode;
  844. while Assigned(Node) do
  845. begin
  846. DoNodeTest(Node);
  847. Node := Node.ParentNode;
  848. end;
  849. end;
  850. axisAncestorOrSelf:
  851. begin
  852. Node := AContext.ContextNode;
  853. repeat
  854. DoNodeTest(Node);
  855. Node := Node.ParentNode;
  856. until not Assigned(Node);
  857. end;
  858. axisAttribute:
  859. begin
  860. Attr := AContext.ContextNode.Attributes;
  861. if Assigned(Attr) then
  862. for i := 0 to Attr.Length - 1 do
  863. DoNodeTest(Attr[i]);
  864. end;
  865. axisChild:
  866. begin
  867. Node := AContext.ContextNode.FirstChild;
  868. while Assigned(Node) do
  869. begin
  870. DoNodeTest(Node);
  871. Node := Node.NextSibling;
  872. end;
  873. end;
  874. axisDescendant:
  875. AddDescendants(AContext.ContextNode);
  876. axisDescendantOrSelf:
  877. begin
  878. DoNodeTest(AContext.ContextNode);
  879. AddDescendants(AContext.ContextNode);
  880. end;
  881. axisFollowing:
  882. begin
  883. Node := AContext.ContextNode;
  884. repeat
  885. Node2 := Node.NextSibling;
  886. while Assigned(Node2) do
  887. begin
  888. DoNodeTest(Node2);
  889. AddDescendants(Node2);
  890. Node := Node.NextSibling;
  891. end;
  892. Node := Node.ParentNode;
  893. until not Assigned(Node);
  894. end;
  895. axisFollowingSibling:
  896. begin
  897. Node := AContext.ContextNode.NextSibling;
  898. while Assigned(Node) do
  899. begin
  900. DoNodeTest(Node);
  901. Node := Node.NextSibling;
  902. end;
  903. end;
  904. {axisNamespace: !!!: Not supported yet}
  905. axisParent:
  906. if Assigned(AContext.ContextNode.ParentNode) then
  907. DoNodeTest(AContext.ContextNode);
  908. axisPreceding:
  909. begin
  910. Node := AContext.ContextNode;
  911. repeat
  912. Node2 := Node.PreviousSibling;
  913. while Assigned(Node2) do
  914. begin
  915. DoNodeTest(Node2);
  916. AddDescendants(Node2);
  917. Node := Node.PreviousSibling;
  918. end;
  919. Node := Node.ParentNode;
  920. until not Assigned(Node);
  921. end;
  922. axisPrecedingSibling:
  923. begin
  924. Node := AContext.ContextNode.PreviousSibling;
  925. while Assigned(Node) do
  926. begin
  927. DoNodeTest(Node);
  928. Node := Node.PreviousSibling;
  929. end;
  930. end;
  931. axisSelf:
  932. DoNodeTest(AContext.ContextNode);
  933. end;
  934. { Filter the nodes of this step using the predicates: The current
  935. node set (StepNodes) is filtered, all passed nodes will be added
  936. to NewStepNodes. After one filter has been applied, NewStepNodes
  937. gets copied to StepNodes, and the next filter will be processed.
  938. The final result will then be passed to the next step, or added
  939. to the result of the LocationPath if this is the last step. }
  940. for i := 0 to AStep.Predicates.Count - 1 do
  941. begin
  942. NewContext := TXPathContext.Create(nil, 0, StepNodes.Count);
  943. NewStepNodes := nil;
  944. try
  945. NewStepNodes := TNodeSet.Create;
  946. Predicate := TXPathExprNode(AStep.Predicates[i]);
  947. for j := 0 to StepNodes.Count - 1 do
  948. begin
  949. Node := TDOMNode(StepNodes[j]);
  950. NewContext.ContextNode := Node;
  951. Inc(NewContext.ContextPosition);
  952. PredicateResult := Predicate.Evaluate(NewContext, AEnvironment);
  953. try
  954. if (PredicateResult.InheritsFrom(TXPathNumberVariable) and
  955. (PredicateResult.AsNumber = j + 1)) or
  956. PredicateResult.AsBoolean then
  957. NewStepNodes.Add(Node);
  958. finally
  959. PredicateResult.Release;
  960. end;
  961. end;
  962. finally
  963. NewContext.Free;
  964. StepNodes.Free;
  965. StepNodes := NewStepNodes;
  966. end;
  967. end;
  968. if Assigned(AStep.NextStep) then
  969. begin
  970. NewContext := TXPathContext.Create(nil, 0, StepNodes.Count);
  971. try
  972. for i := 0 to StepNodes.Count - 1 do
  973. begin
  974. NewContext.ContextNode := TDOMNode(StepNodes[i]);
  975. Inc(NewContext.ContextPosition);
  976. EvaluateStep(AStep.NextStep, NewContext);
  977. end;
  978. finally
  979. NewContext.Free;
  980. end;
  981. end else
  982. begin
  983. // Only add nodes to result if it isn't duplicate
  984. for i := 0 to StepNodes.Count - 1 do
  985. begin
  986. Node := TDOMNode(StepNodes[i]);
  987. DoAdd := True;
  988. for j := 0 to ResultNodeSet.Count - 1 do
  989. if TDOMNode(ResultNodeSet[j]) = Node then
  990. begin
  991. DoAdd := False;
  992. break;
  993. end;
  994. if DoAdd then
  995. ResultNodeSet.Add(Node);
  996. end;
  997. end;
  998. StepNodes.Free;
  999. end;
  1000. var
  1001. NewContext: TXPathContext;
  1002. begin
  1003. ResultNodeSet := TNodeSet.Create;
  1004. try
  1005. if FIsAbsolutePath then
  1006. begin
  1007. NewContext := TXPathContext.Create(AContext.ContextNode.OwnerDocument,
  1008. 1, 1);
  1009. try
  1010. EvaluateStep(FFirstStep, NewContext);
  1011. finally
  1012. NewContext.Free;
  1013. end;
  1014. end else
  1015. EvaluateStep(FFirstStep, AContext);
  1016. except
  1017. ResultNodeSet.Free;
  1018. raise;
  1019. end;
  1020. Result := TXPathNodeSetVariable.Create(ResultNodeSet);
  1021. end;
  1022. { Exceptions }
  1023. procedure EvaluationError(const Msg: String);
  1024. begin
  1025. raise EXPathEvaluationError.Create(Msg) at get_caller_addr(get_frame);
  1026. end;
  1027. procedure EvaluationError(const Msg: String; const Args: array of const);
  1028. begin
  1029. raise EXPathEvaluationError.CreateFmt(Msg, Args)
  1030. at get_caller_addr(get_frame);
  1031. end;
  1032. { TXPathVariable and derived classes}
  1033. procedure TXPathVariable.Release;
  1034. begin
  1035. if FRefCount <= 0 then
  1036. Free
  1037. else
  1038. Dec(FRefCount);
  1039. end;
  1040. function TXPathVariable.AsNodeSet: TNodeSet;
  1041. begin
  1042. Error(SVarNoConversion, [TypeName, TXPathNodeSetVariable.TypeName]);
  1043. Result := nil;
  1044. end;
  1045. function TXPathVariable.AsBoolean: Boolean;
  1046. begin
  1047. Error(SVarNoConversion, [TypeName, TXPathBooleanVariable.TypeName]);
  1048. Result := False;
  1049. end;
  1050. function TXPathVariable.AsNumber: Extended;
  1051. begin
  1052. Error(SVarNoConversion, [TypeName, TXPathNumberVariable.TypeName]);
  1053. Result := 0;
  1054. end;
  1055. function TXPathVariable.AsText: DOMString;
  1056. begin
  1057. Error(SVarNoConversion, [TypeName, TXPathStringVariable.TypeName]);
  1058. SetLength(Result, 0);
  1059. end;
  1060. procedure TXPathVariable.Error(const Msg: String; const Args: array of const);
  1061. begin
  1062. raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame);
  1063. end;
  1064. constructor TXPathNodeSetVariable.Create(AValue: TNodeSet);
  1065. begin
  1066. inherited Create;
  1067. FValue := AValue;
  1068. end;
  1069. destructor TXPathNodeSetVariable.Destroy;
  1070. begin
  1071. FValue.Free;
  1072. inherited Destroy;
  1073. end;
  1074. class function TXPathNodeSetVariable.TypeName: String;
  1075. begin
  1076. Result := SNodeSet;
  1077. end;
  1078. function TXPathNodeSetVariable.AsNodeSet: TNodeSet;
  1079. begin
  1080. Result := FValue;
  1081. end;
  1082. function TXPathNodeSetVariable.AsText: DOMString;
  1083. begin
  1084. if FValue.Count = 0 then
  1085. SetLength(Result, 0)
  1086. else
  1087. Result := NodeToText(TDOMNode(FValue[0]));
  1088. end;
  1089. constructor TXPathBooleanVariable.Create(AValue: Boolean);
  1090. begin
  1091. inherited Create;
  1092. FValue := AValue;
  1093. end;
  1094. class function TXPathBooleanVariable.TypeName: String;
  1095. begin
  1096. Result := SBoolean;
  1097. end;
  1098. function TXPathBooleanVariable.AsBoolean: Boolean;
  1099. begin
  1100. Result := FValue;
  1101. end;
  1102. function TXPathBooleanVariable.AsNumber: Extended;
  1103. begin
  1104. if FValue then
  1105. Result := 1
  1106. else
  1107. Result := 0;
  1108. end;
  1109. function TXPathBooleanVariable.AsText: DOMString;
  1110. begin
  1111. if FValue then
  1112. Result := 'true' // Do not localize!
  1113. else
  1114. Result := 'false'; // Do not localize!
  1115. end;
  1116. constructor TXPathNumberVariable.Create(AValue: Extended);
  1117. begin
  1118. inherited Create;
  1119. FValue := AValue;
  1120. end;
  1121. class function TXPathNumberVariable.TypeName: String;
  1122. begin
  1123. Result := SNumber;
  1124. end;
  1125. function TXPathNumberVariable.AsBoolean: Boolean;
  1126. begin
  1127. // !!!: What about NaNs and so on?
  1128. if FValue = 0 then
  1129. Result := False
  1130. else
  1131. Result := True;
  1132. end;
  1133. function TXPathNumberVariable.AsNumber: Extended;
  1134. begin
  1135. Result := FValue;
  1136. end;
  1137. function TXPathNumberVariable.AsText: DOMString;
  1138. begin
  1139. Result := FloatToStr(FValue);
  1140. end;
  1141. constructor TXPathStringVariable.Create(const AValue: DOMString);
  1142. begin
  1143. inherited Create;
  1144. FValue := AValue;
  1145. end;
  1146. class function TXPathStringVariable.TypeName: String;
  1147. begin
  1148. Result := SString;
  1149. end;
  1150. function TXPathStringVariable.AsBoolean: Boolean;
  1151. begin
  1152. Result := Length(FValue) > 0;
  1153. end;
  1154. function TXPathStringVariable.AsNumber: Extended;
  1155. begin
  1156. Result := StrToFloat(FValue);
  1157. end;
  1158. function TXPathStringVariable.AsText: DOMString;
  1159. begin
  1160. Result := FValue;
  1161. end;
  1162. { XPath lexical scanner }
  1163. constructor TXPathScanner.Create(const AExpressionString: DOMString);
  1164. begin
  1165. inherited Create;
  1166. FExpressionString := PChar(AExpressionString);
  1167. FCurData := FExpressionString;
  1168. end;
  1169. function TXPathScanner.NextToken: TXPathToken;
  1170. procedure GetNumber;
  1171. var
  1172. HasDot: Boolean;
  1173. begin
  1174. HasDot := Pos('.', FCurTokenString) > 0;
  1175. while (FCurData[1] in ['0'..'9']) or ((FCurData[1] = '.') and not HasDot) do
  1176. begin
  1177. Inc(FCurData);
  1178. FCurTokenString := FCurTokenString + FCurData[0];
  1179. if FCurData[0] = '.' then
  1180. HasDot := True;
  1181. end;
  1182. Result := tkNumber;
  1183. end;
  1184. const
  1185. IdentifierChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-', '_'];
  1186. begin
  1187. if FDoUnget then
  1188. begin
  1189. FDoUnget := False;
  1190. Result := FCurToken;
  1191. exit;
  1192. end;
  1193. if FCurToken = tkEndOfStream then
  1194. begin
  1195. Result := tkEndOfStream;
  1196. exit;
  1197. end;
  1198. { No, we cannot use a lookup table here, as future
  1199. versions will use WideStrings -sg }
  1200. // Skip whitespace
  1201. while FCurData[0] in [#9, #10, #12, #13, ' '] do
  1202. Inc(FCurData);
  1203. FCurTokenString := FCurData[0];
  1204. case FCurData[0] of
  1205. #0:
  1206. Result := tkEndOfStream;
  1207. '!':
  1208. if FCurData[1] = '=' then
  1209. begin
  1210. Inc(FCurData);
  1211. Result := tkNotEqual;
  1212. end;
  1213. '"':
  1214. begin
  1215. SetLength(FCurTokenString, 0);
  1216. Inc(FCurData);
  1217. while FCurData[0] <> '"' do
  1218. begin
  1219. if FCurData[0] = #0 then
  1220. Error(SScannerQuotStringIsOpen);
  1221. FCurTokenString := FCurTokenString + FCurData[0];
  1222. Inc(FCurData);
  1223. end;
  1224. Result := tkString;
  1225. end;
  1226. '$':
  1227. Result := tkDollar;
  1228. '''':
  1229. begin
  1230. SetLength(FCurTokenString, 0);
  1231. Inc(FCurData);
  1232. while FCurData[0] <> '''' do
  1233. begin
  1234. if FCurData[0] = #0 then
  1235. Error(SScannerAposStringIsOpen);
  1236. FCurTokenString := FCurTokenString + FCurData[0];
  1237. Inc(FCurData);
  1238. end;
  1239. Result := tkString;
  1240. end;
  1241. '(':
  1242. Result := tkLeftBracket;
  1243. ')':
  1244. Result := tkRightBracket;
  1245. '*':
  1246. Result := tkAsterisk;
  1247. '+':
  1248. Result := tkPlus;
  1249. ',':
  1250. Result := tkComma;
  1251. '-':
  1252. Result := tkMinus;
  1253. '.':
  1254. if FCurData[1] = '.' then
  1255. begin
  1256. Inc(FCurData);
  1257. Result := tkDotDot;
  1258. end else if FCurData[1] in ['0'..'9'] then
  1259. GetNumber
  1260. else
  1261. Result := tkDot;
  1262. '/':
  1263. if FCurData[1] = '/' then
  1264. begin
  1265. Inc(FCurData);
  1266. Result := tkSlashSlash;
  1267. end else
  1268. Result := tkSlash;
  1269. '0'..'9':
  1270. GetNumber;
  1271. ':':
  1272. if FCurData[1] = ':' then
  1273. begin
  1274. Inc(FCurData);
  1275. Result := tkColonColon;
  1276. end else
  1277. Result := tkColon;
  1278. '<':
  1279. if FCurData[1] = '=' then
  1280. begin
  1281. Inc(FCurData);
  1282. Result := tkLessEqual;
  1283. end else
  1284. Result := tkLess;
  1285. '=':
  1286. Result := tkEqual;
  1287. '>':
  1288. if FCurData[1] = '=' then
  1289. begin
  1290. Inc(FCurData);
  1291. Result := tkGreaterEqual;
  1292. end else
  1293. Result := tkGreater;
  1294. '@':
  1295. Result := tkAt;
  1296. 'A'..'Z', 'a'..'z':
  1297. begin
  1298. Result := tkIdentifier;
  1299. while FCurData[1] in IdentifierChars do
  1300. begin
  1301. Inc(FCurData);
  1302. FCurTokenString := FCurTokenString + FCurData[0];
  1303. end;
  1304. end;
  1305. '[':
  1306. Result := tkLeftSquareBracket;
  1307. ']':
  1308. Result := tkRightSquareBracket;
  1309. '|':
  1310. Result := tkPipe;
  1311. else
  1312. Error(SScannerInvalidChar);
  1313. end;
  1314. // We have processed at least one character now; eat it:
  1315. if Result <> tkEndOfStream then
  1316. Inc(FCurData);
  1317. FCurToken := Result;
  1318. end;
  1319. procedure TXPathScanner.UngetToken;
  1320. begin
  1321. if FDoUnget then
  1322. Error(SScannerInternalError, ['Tried to unget token a second time']);
  1323. FDoUnget := True;
  1324. end;
  1325. function TXPathScanner.SaveState: TXPathScannerState;
  1326. begin
  1327. Result := TXPathScannerState.Create;
  1328. Result.FCurData := FCurData;
  1329. Result.FCurToken := FCurToken;
  1330. Result.FCurTokenString := FCurTokenString;
  1331. Result.FDoUnget := FDoUnget;
  1332. end;
  1333. procedure TXPathScanner.RestoreState(AState: TXPathScannerState);
  1334. begin
  1335. FCurData := AState.FCurData;
  1336. FCurToken := AState.FCurToken;
  1337. FCurTokenString := AState.FCurTokenString;
  1338. FDoUnget := AState.FDoUnget;
  1339. AState.Free;
  1340. end;
  1341. procedure TXPathScanner.Error(const Msg: String);
  1342. begin
  1343. raise Exception.Create(Msg) at get_caller_addr(get_frame);
  1344. end;
  1345. procedure TXPathScanner.Error(const Msg: String; const Args: array of const);
  1346. begin
  1347. raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame);
  1348. end;
  1349. { TXPathContext }
  1350. constructor TXPathContext.Create(AContextNode: TDOMNode;
  1351. AContextPosition, AContextSize: Integer);
  1352. begin
  1353. inherited Create;
  1354. ContextNode := AContextNode;
  1355. ContextPosition := AContextPosition;
  1356. ContextSize := AContextSize;
  1357. end;
  1358. { TXPathEnvironment }
  1359. type
  1360. PFunctionInfo = ^TFunctionInfo;
  1361. TFunctionInfo = record
  1362. Name: String;
  1363. Fn: TXPathFunction;
  1364. end;
  1365. PVariableInfo = ^TVariableInfo;
  1366. TVariableInfo = record
  1367. Name: String;
  1368. Variable: TXPathVariable;
  1369. end;
  1370. constructor TXPathEnvironment.Create;
  1371. begin
  1372. inherited Create;
  1373. FFunctions := TList.Create;
  1374. FVariables := TList.Create;
  1375. // Add the functions of the XPath Core Function Library
  1376. // Node set functions
  1377. AddFunction('last', @xpLast);
  1378. AddFunction('position', @xpPosition);
  1379. AddFunction('count', @xpCount);
  1380. AddFunction('id', @xpId);
  1381. AddFunction('local-name', @xpLocalName);
  1382. AddFunction('namespace-uri', @xpNamespaceURI);
  1383. AddFunction('name', @xpName);
  1384. // String functions
  1385. AddFunction('string', @xpString);
  1386. AddFunction('concat', @xpConcat);
  1387. AddFunction('starts-with', @xpStartsWith);
  1388. AddFunction('contains', @xpContains);
  1389. AddFunction('substring-before', @xpSubstringBefore);
  1390. AddFunction('substring-after', @xpSubstringAfter);
  1391. AddFunction('substring', @xpSubstring);
  1392. AddFunction('string-length', @xpStringLength);
  1393. AddFunction('normalize-space', @xpNormalizeSpace);
  1394. AddFunction('translate', @xpTranslate);
  1395. // Boolean functions
  1396. AddFunction('boolean', @xpBoolean);
  1397. AddFunction('not', @xpNot);
  1398. AddFunction('true', @xpTrue);
  1399. AddFunction('false', @xpFalse);
  1400. AddFunction('lang', @xpLang);
  1401. // Number functions
  1402. AddFunction('number', @xpNumber);
  1403. AddFunction('sum', @xpSum);
  1404. AddFunction('floor', @xpFloor);
  1405. AddFunction('ceiling', @xpCeiling);
  1406. AddFunction('round', @xpRound);
  1407. end;
  1408. destructor TXPathEnvironment.Destroy;
  1409. var
  1410. i: Integer;
  1411. FunctionInfo: PFunctionInfo;
  1412. VariableInfo: PVariableInfo;
  1413. begin
  1414. for i := 0 to FFunctions.Count - 1 do
  1415. begin
  1416. FunctionInfo := PFunctionInfo(FFunctions[i]);
  1417. FreeMem(FunctionInfo);
  1418. end;
  1419. FFunctions.Free;
  1420. for i := 0 to FVariables.Count - 1 do
  1421. begin
  1422. VariableInfo := PVariableInfo(FVariables[i]);
  1423. FreeMem(VariableInfo);
  1424. end;
  1425. FVariables.Free;
  1426. inherited Destroy;
  1427. end;
  1428. function TXPathEnvironment.GetFunctionIndex(const AName: String): Integer;
  1429. var
  1430. i: Integer;
  1431. begin
  1432. for i := 0 to FFunctions.Count - 1 do
  1433. if PFunctionInfo(FFunctions[i])^.Name = AName then
  1434. begin
  1435. Result := i;
  1436. exit;
  1437. end;
  1438. Result := -1;
  1439. end;
  1440. function TXPathEnvironment.GetVariableIndex(const AName: String): Integer;
  1441. var
  1442. i: Integer;
  1443. begin
  1444. for i := 0 to FVariables.Count - 1 do
  1445. if PVariableInfo(FFunctions[i])^.Name = AName then
  1446. begin
  1447. Result := i;
  1448. exit;
  1449. end;
  1450. Result := -1;
  1451. end;
  1452. procedure TXPathEnvironment.AddFunction(const AName: String; AFunction: TXPathFunction);
  1453. var
  1454. NewFunctionInfo: PFunctionInfo;
  1455. begin
  1456. // !!!: Prevent the addition of duplicate functions
  1457. New(NewFunctionInfo);
  1458. NewFunctionInfo^.Name := AName;
  1459. NewFunctionInfo^.Fn := AFunction;
  1460. FFunctions.Add(NewFunctionInfo);
  1461. end;
  1462. procedure TXPathEnvironment.AddVariable(const AName: String; AVariable: TXPathVariable);
  1463. var
  1464. NewVariableInfo: PVariableInfo;
  1465. begin
  1466. // !!!: Prevent the addition of duplicate variables
  1467. New(NewVariableInfo);
  1468. NewVariableInfo^.Name := AName;
  1469. NewVariableInfo^.Variable := AVariable;
  1470. FVariables.Add(NewVariableInfo);
  1471. end;
  1472. procedure TXPathEnvironment.RemoveFunction(Index: Integer);
  1473. var
  1474. FunctionInfo: PFunctionInfo;
  1475. begin
  1476. FunctionInfo := PFunctionInfo(FFunctions[Index]);
  1477. Dispose(FunctionInfo);
  1478. FFunctions.Delete(Index);
  1479. end;
  1480. procedure TXPathEnvironment.RemoveFunction(const AName: String);
  1481. var
  1482. i: Integer;
  1483. begin
  1484. for i := 0 to FFunctions.Count - 1 do
  1485. if PFunctionInfo(FFunctions[i])^.Name = AName then
  1486. begin
  1487. RemoveFunction(i);
  1488. exit;
  1489. end;
  1490. end;
  1491. procedure TXPathEnvironment.RemoveVariable(Index: Integer);
  1492. var
  1493. VariableInfo: PVariableInfo;
  1494. begin
  1495. VariableInfo := PVariableInfo(FVariables[Index]);
  1496. Dispose(VariableInfo);
  1497. FVariables.Delete(Index);
  1498. end;
  1499. procedure TXPathEnvironment.RemoveVariable(const AName: String);
  1500. var
  1501. Index: Integer;
  1502. begin
  1503. Index := GetVariableIndex(AName);
  1504. if Index >= 0 then
  1505. RemoveVariable(Index);
  1506. end;
  1507. function TXPathEnvironment.GetFunctionCount: Integer;
  1508. begin
  1509. Result := FFunctions.Count;
  1510. end;
  1511. function TXPathEnvironment.GetVariableCount: Integer;
  1512. begin
  1513. Result := FVariables.Count;
  1514. end;
  1515. function TXPathEnvironment.GetFunction(Index: Integer): TXPathFunction;
  1516. begin
  1517. Result := PFunctionInfo(FFunctions[Index])^.Fn;
  1518. end;
  1519. function TXPathEnvironment.GetFunction(const AName: String): TXPathFunction;
  1520. var
  1521. i: Integer;
  1522. begin
  1523. for i := 0 to FFunctions.Count - 1 do
  1524. if PFunctionInfo(FFunctions[i])^.Name = AName then
  1525. begin
  1526. Result := PFunctionInfo(FFunctions[i])^.Fn;
  1527. exit;
  1528. end;
  1529. Result := nil;
  1530. end;
  1531. function TXPathEnvironment.GetVariable(Index: Integer): TXPathVariable;
  1532. begin
  1533. Result := PVariableInfo(FVariables[Index])^.Variable;
  1534. end;
  1535. function TXPathEnvironment.GetVariable(const AName: String): TXPathVariable;
  1536. var
  1537. i: Integer;
  1538. begin
  1539. for i := 0 to FVariables.Count - 1 do
  1540. if PFunctionInfo(FVariables[i])^.Name = AName then
  1541. begin
  1542. Result := PVariableInfo(FVariables[i])^.Variable;
  1543. exit;
  1544. end;
  1545. Result := nil;
  1546. end;
  1547. function TXPathEnvironment.xpLast(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1548. begin
  1549. if Args.Count <> 0 then
  1550. EvaluationError(SEvalInvalidArgCount);
  1551. Result := TXPathNumberVariable.Create(Context.ContextSize);
  1552. end;
  1553. function TXPathEnvironment.xpPosition(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1554. begin
  1555. if Args.Count <> 0 then
  1556. EvaluationError(SEvalInvalidArgCount);
  1557. Result := TXPathNumberVariable.Create(Context.ContextPosition);
  1558. end;
  1559. function TXPathEnvironment.xpCount(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1560. begin
  1561. if Args.Count <> 1 then
  1562. EvaluationError(SEvalInvalidArgCount);
  1563. Result := TXPathNumberVariable.Create(TXPathVariable(Args[0]).AsNodeSet.Count);
  1564. end;
  1565. function TXPathEnvironment.xpId(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1566. begin
  1567. if Args.Count <> 1 then
  1568. EvaluationError(SEvalInvalidArgCount);
  1569. EvaluationError(SEvalFunctionNotImplementedYet, ['id']); // !!!
  1570. end;
  1571. function TXPathEnvironment.xpLocalName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1572. begin
  1573. if Args.Count > 1 then
  1574. EvaluationError(SEvalInvalidArgCount);
  1575. EvaluationError(SEvalFunctionNotImplementedYet, ['local-name']); // !!!
  1576. end;
  1577. function TXPathEnvironment.xpNamespaceURI(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1578. begin
  1579. if Args.Count > 1 then
  1580. EvaluationError(SEvalInvalidArgCount);
  1581. EvaluationError(SEvalFunctionNotImplementedYet, ['namespace-uri']); // !!!
  1582. end;
  1583. function TXPathEnvironment.xpName(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1584. var
  1585. NodeSet: TNodeSet;
  1586. begin
  1587. if Args.Count <> 1 then
  1588. EvaluationError(SEvalInvalidArgCount);
  1589. NodeSet := TXPathVariable(Args[0]).AsNodeSet;
  1590. if NodeSet.Count = 0 then
  1591. Result := TXPathStringVariable.Create('')
  1592. else
  1593. // !!!: Probably not really correct regarding namespaces...
  1594. Result := TXPathStringVariable.Create(TDOMNode(NodeSet[0]).NodeName);
  1595. end;
  1596. function TXPathEnvironment.xpString(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1597. var
  1598. s: String;
  1599. begin
  1600. if Args.Count > 1 then
  1601. EvaluationError(SEvalInvalidArgCount);
  1602. if Args.Count = 0 then
  1603. s := NodeToText(Context.ContextNode)
  1604. else
  1605. s := TXPathVariable(Args[0]).AsText;
  1606. Result := TXPathStringVariable.Create(s);
  1607. end;
  1608. function TXPathEnvironment.xpConcat(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1609. var
  1610. i: Integer;
  1611. s: DOMString;
  1612. begin
  1613. if Args.Count < 2 then
  1614. EvaluationError(SEvalInvalidArgCount);
  1615. SetLength(s, 0);
  1616. for i := 0 to Args.Count - 1 do
  1617. s := s + TXPathVariable(Args[i]).AsText;
  1618. Result := TXPathStringVariable.Create(s);
  1619. end;
  1620. function TXPathEnvironment.xpStartsWith(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1621. begin
  1622. if Args.Count <> 2 then
  1623. EvaluationError(SEvalInvalidArgCount);
  1624. EvaluationError(SEvalFunctionNotImplementedYet, ['namespace-uri']); // !!!
  1625. end;
  1626. function TXPathEnvironment.xpContains(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1627. begin
  1628. if Args.Count <> 2 then
  1629. EvaluationError(SEvalInvalidArgCount);
  1630. EvaluationError(SEvalFunctionNotImplementedYet, ['contains']); // !!!
  1631. end;
  1632. function TXPathEnvironment.xpSubstringBefore(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1633. begin
  1634. if Args.Count <> 2 then
  1635. EvaluationError(SEvalInvalidArgCount);
  1636. EvaluationError(SEvalFunctionNotImplementedYet, ['substring-before']); // !!!
  1637. end;
  1638. function TXPathEnvironment.xpSubstringAfter(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1639. begin
  1640. if Args.Count <> 1 then
  1641. EvaluationError(SEvalInvalidArgCount);
  1642. EvaluationError(SEvalFunctionNotImplementedYet, ['substring-after']); // !!!
  1643. end;
  1644. function TXPathEnvironment.xpSubstring(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1645. begin
  1646. if (Args.Count < 2) or (Args.Count > 3) then
  1647. EvaluationError(SEvalInvalidArgCount);
  1648. EvaluationError(SEvalFunctionNotImplementedYet, ['substring']); // !!!
  1649. end;
  1650. function TXPathEnvironment.xpStringLength(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1651. var
  1652. s: DOMString;
  1653. begin
  1654. if Args.Count < 1 then
  1655. EvaluationError(SEvalInvalidArgCount);
  1656. if Args.Count = 0 then
  1657. s := NodeToText(Context.ContextNode)
  1658. else
  1659. s := TXPathVariable(Args[0]).AsText;
  1660. Result := TXPathNumberVariable.Create(Length(s));
  1661. end;
  1662. function TXPathEnvironment.xpNormalizeSpace(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1663. begin
  1664. if Args.Count < 1 then
  1665. EvaluationError(SEvalInvalidArgCount);
  1666. EvaluationError(SEvalFunctionNotImplementedYet, ['normalize-space']); // !!!
  1667. end;
  1668. function TXPathEnvironment.xpTranslate(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1669. begin
  1670. if Args.Count <> 3 then
  1671. EvaluationError(SEvalInvalidArgCount);
  1672. EvaluationError(SEvalFunctionNotImplementedYet, ['translate']); // !!!
  1673. end;
  1674. function TXPathEnvironment.xpBoolean(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1675. begin
  1676. if Args.Count <> 1 then
  1677. EvaluationError(SEvalInvalidArgCount);
  1678. Result := TXPathBooleanVariable.Create(TXPathVariable(Args[0]).AsBoolean);
  1679. end;
  1680. function TXPathEnvironment.xpNot(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1681. begin
  1682. if Args.Count <> 1 then
  1683. EvaluationError(SEvalInvalidArgCount);
  1684. Result := TXPathBooleanVariable.Create(not TXPathVariable(Args[0]).AsBoolean);
  1685. end;
  1686. function TXPathEnvironment.xpTrue(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1687. begin
  1688. if Args.Count <> 0 then
  1689. EvaluationError(SEvalInvalidArgCount);
  1690. Result := TXPathBooleanVariable.Create(True);
  1691. end;
  1692. function TXPathEnvironment.xpFalse(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1693. begin
  1694. if Args.Count <> 0 then
  1695. EvaluationError(SEvalInvalidArgCount);
  1696. Result := TXPathBooleanVariable.Create(False);
  1697. end;
  1698. function TXPathEnvironment.xpLang(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1699. begin
  1700. if Args.Count <> 1 then
  1701. EvaluationError(SEvalInvalidArgCount);
  1702. EvaluationError(SEvalFunctionNotImplementedYet, ['lang']); // !!!
  1703. end;
  1704. function TXPathEnvironment.xpNumber(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1705. begin
  1706. if Args.Count > 1 then
  1707. EvaluationError(SEvalInvalidArgCount);
  1708. EvaluationError(SEvalFunctionNotImplementedYet, ['number']); // !!!
  1709. end;
  1710. function TXPathEnvironment.xpSum(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1711. begin
  1712. if Args.Count <> 1 then
  1713. EvaluationError(SEvalInvalidArgCount);
  1714. EvaluationError(SEvalFunctionNotImplementedYet, ['sum']); // !!!
  1715. end;
  1716. function TXPathEnvironment.xpFloor(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1717. begin
  1718. if Args.Count <> 1 then
  1719. EvaluationError(SEvalInvalidArgCount);
  1720. EvaluationError(SEvalFunctionNotImplementedYet, ['floor']); // !!!
  1721. end;
  1722. function TXPathEnvironment.xpCeiling(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1723. begin
  1724. if Args.Count <> 1 then
  1725. EvaluationError(SEvalInvalidArgCount);
  1726. EvaluationError(SEvalFunctionNotImplementedYet, ['ceiling']); // !!!
  1727. end;
  1728. function TXPathEnvironment.xpRound(Context: TXPathContext; Args: TXPathVarList): TXPathVariable;
  1729. begin
  1730. if Args.Count <> 1 then
  1731. EvaluationError(SEvalInvalidArgCount);
  1732. EvaluationError(SEvalFunctionNotImplementedYet, ['round']); // !!!
  1733. end;
  1734. { TXPathExpression }
  1735. constructor TXPathExpression.Create(AScanner: TXPathScanner;
  1736. CompleteExpression: Boolean);
  1737. function ParseLocationPath: TXPathLocationPathNode; forward; // [1]
  1738. function ParsePrimaryExpr: TXPathExprNode; forward; // [15]
  1739. function ParseUnionExpr: TXPathExprNode; forward; // [18]
  1740. function ParsePathExpr: TXPathExprNode; forward; // [19]
  1741. function ParseFilterExpr: TXPathExprNode; forward; // [20]
  1742. function ParseOrExpr: TXPathExprNode; forward; // [21]
  1743. function ParseAndExpr: TXPathExprNode; forward; // [22]
  1744. function ParseEqualityExpr: TXPathExprNode; forward; // [23]
  1745. function ParseRelationalExpr: TXPathExprNode; forward; // [24]
  1746. function ParseAdditiveExpr: TXPathExprNode; forward; // [25]
  1747. function ParseMultiplicativeExpr: TXPathExprNode; forward; // [26]
  1748. function ParseUnaryExpr: TXPathExprNode; forward; // [27]
  1749. procedure Error(const Msg: String);
  1750. begin
  1751. raise Exception.Create(Msg) at get_caller_addr(get_frame);
  1752. end;
  1753. procedure Error(const Msg: String; const Args: array of const);
  1754. begin
  1755. raise Exception.CreateFmt(Msg, Args) at get_caller_addr(get_frame);
  1756. end;
  1757. function ParseLocationPath: TXPathLocationPathNode; // [1]
  1758. var
  1759. IsAbsolute, NeedColonColon: Boolean;
  1760. FirstStep, CurStep, NextStep: TStep;
  1761. begin
  1762. IsAbsolute := False;
  1763. CurStep := nil;
  1764. case AScanner.NextToken of
  1765. tkSlash: // [2] AbsoluteLocationPath, first case
  1766. begin
  1767. IsAbsolute := True;
  1768. if not (AScanner.NextToken in
  1769. [tkDot, tkDotDot, tkAsterisk, tkAt, tkIdentifier]) then
  1770. begin
  1771. AScanner.UngetToken;
  1772. exit;
  1773. end;
  1774. AScanner.UngetToken;
  1775. end;
  1776. tkSlashSlash: // [10] AbbreviatedAbsoluteLocationPath
  1777. begin
  1778. IsAbsolute := True;
  1779. CurStep := TStep.Create;
  1780. CurStep.Axis := axisDescendantOrSelf;
  1781. CurStep.NodeTestType := ntAnyNode;
  1782. end;
  1783. else
  1784. begin
  1785. AScanner.UngetToken;
  1786. IsAbsolute := False;
  1787. end;
  1788. end;
  1789. // Parse [3] RelativeLocationPath
  1790. FirstStep := CurStep;
  1791. while True do
  1792. begin
  1793. NextStep := TStep.Create;
  1794. if Assigned(CurStep) then
  1795. CurStep.NextStep := NextStep
  1796. else
  1797. FirstStep := NextStep;
  1798. CurStep := NextStep;
  1799. // Parse [4] Step
  1800. case AScanner.NextToken of
  1801. tkDot: // [12] Abbreviated step, first case
  1802. begin
  1803. CurStep.Axis := axisSelf;
  1804. CurStep.NodeTestType := ntAnyNode;
  1805. end;
  1806. tkDotDot: // [12] Abbreviated step, second case
  1807. begin
  1808. CurStep.Axis := axisParent;
  1809. CurStep.NodeTestType := ntAnyNode;
  1810. end;
  1811. else
  1812. begin
  1813. AScanner.UngetToken;
  1814. // Parse [5] AxisSpecifier
  1815. case AScanner.NextToken of
  1816. tkAt: // [13] AbbreviatedAxisSpecifier
  1817. CurStep.Axis := axisAttribute;
  1818. tkIdentifier: // [5] AxisName '::'
  1819. begin
  1820. // Check for [6] AxisName
  1821. NeedColonColon := True;
  1822. if AScanner.CurTokenString = 'ancestor' then
  1823. CurStep.Axis := axisAncestor
  1824. else if AScanner.CurTokenString = 'ancestor-or-self' then
  1825. CurStep.Axis := axisAncestorOrSelf
  1826. else if AScanner.CurTokenString = 'attribute' then
  1827. CurStep.Axis := axisAttribute
  1828. else if AScanner.CurTokenString = 'child' then
  1829. CurStep.Axis := axisChild
  1830. else if AScanner.CurTokenString = 'descendant' then
  1831. CurStep.Axis := axisDescendant
  1832. else if AScanner.CurTokenString = 'descendant-or-self' then
  1833. CurStep.Axis := axisDescendantOrSelf
  1834. else if AScanner.CurTokenString = 'following' then
  1835. CurStep.Axis := axisFollowing
  1836. else if AScanner.CurTokenString = 'following-sibling' then
  1837. CurStep.Axis := axisFollowingSibling
  1838. else if AScanner.CurTokenString = 'namespace' then
  1839. CurStep.Axis := axisNamespace
  1840. else if AScanner.CurTokenString = 'parent' then
  1841. CurStep.Axis := axisParent
  1842. else if AScanner.CurTokenString = 'preceding' then
  1843. CurStep.Axis := axisPreceding
  1844. else if AScanner.CurTokenString = 'preceding-sibling' then
  1845. CurStep.Axis := axisPrecedingSibling
  1846. else if AScanner.CurTokenString = 'self' then
  1847. CurStep.Axis := axisSelf
  1848. else
  1849. begin
  1850. NeedColonColon := False;
  1851. AScanner.UngetToken;
  1852. CurStep.Axis := axisChild;
  1853. end;
  1854. if NeedColonColon and (AScanner.NextToken <> tkColonColon) then
  1855. Error(SParserExpectedColonColor);
  1856. end;
  1857. else
  1858. begin
  1859. AScanner.UngetToken;
  1860. CurStep.Axis := axisChild;
  1861. end;
  1862. end;
  1863. // Parse [7] NodeTest
  1864. case AScanner.NextToken of
  1865. tkAsterisk: // [37] NameTest, first case
  1866. CurStep.NodeTestType := ntAnyPrincipal;
  1867. tkIdentifier:
  1868. begin
  1869. // Check for case [38] NodeType
  1870. if AScanner.CurTokenString = 'comment' then
  1871. begin
  1872. if (AScanner.NextToken <> tkLeftBracket) or
  1873. (AScanner.NextToken <> tkRightBracket) then
  1874. Error(SParserExpectedBrackets);
  1875. CurStep.NodeTestType := ntCommentNode;
  1876. end else if AScanner.CurTokenString = 'text' then
  1877. begin
  1878. if (AScanner.NextToken <> tkLeftBracket) or
  1879. (AScanner.NextToken <> tkRightBracket) then
  1880. Error(SParserExpectedBrackets);
  1881. CurStep.NodeTestType := ntTextNode;
  1882. end else if AScanner.CurTokenString = 'processing-instruction' then
  1883. begin
  1884. if (AScanner.NextToken <> tkLeftBracket) or
  1885. (AScanner.NextToken <> tkRightBracket) then
  1886. Error(SParserExpectedBrackets);
  1887. CurStep.NodeTestType := ntPINode;
  1888. end else if AScanner.CurTokenString = 'node' then
  1889. begin
  1890. if (AScanner.NextToken <> tkLeftBracket) or
  1891. (AScanner.NextToken <> tkRightBracket) then
  1892. Error(SParserExpectedBrackets);
  1893. CurStep.NodeTestType := ntAnyNode;
  1894. end else // [37] NameTest, second or third case
  1895. begin
  1896. // !!!: Doesn't support namespaces yet
  1897. // (this will have to wait until the DOM unit supports them)
  1898. CurStep.NodeTestType := ntName;
  1899. CurStep.NodeTestString := AScanner.CurTokenString;
  1900. end;
  1901. end;
  1902. else
  1903. Error(SParserInvalidNodeTest);
  1904. end;
  1905. // Parse predicates
  1906. while AScanner.NextToken = tkLeftSquareBracket do
  1907. begin
  1908. CurStep.Predicates.Add(ParseOrExpr);
  1909. if AScanner.NextToken <> tkRightSquareBracket then
  1910. Error(SParserExpectedRightSquareBracket);
  1911. end;
  1912. AScanner.UngetToken;
  1913. end;
  1914. end;
  1915. // Continue with parsing of [3] RelativeLocationPath
  1916. if AScanner.NextToken = tkSlashSlash then
  1917. begin
  1918. // Found abbreviated step ("//" for "descendant-or-self::node()")
  1919. NextStep := TStep.Create;
  1920. CurStep.NextStep := NextStep;
  1921. CurStep := NextStep;
  1922. CurStep.Axis := axisDescendantOrSelf;
  1923. CurStep.NodeTestType := ntAnyNode;
  1924. end else if AScanner.CurToken <> tkSlash then
  1925. begin
  1926. AScanner.UngetToken;
  1927. break;
  1928. end;
  1929. end;
  1930. Result := TXPathLocationPathNode.Create(IsAbsolute);
  1931. TXPathLocationPathNode(Result).FFirstStep := FirstStep;
  1932. end;
  1933. function ParsePrimaryExpr: TXPathExprNode; // [15]
  1934. var
  1935. IsFirstArg: Boolean;
  1936. begin
  1937. case AScanner.NextToken of
  1938. tkDollar: // [36] Variable reference
  1939. begin
  1940. if AScanner.NextToken <> tkIdentifier then
  1941. Error(SParserExpectedVarName);
  1942. Result := TXPathVariableNode.Create(AScanner.CurTokenString);
  1943. end;
  1944. tkLeftBracket:
  1945. begin
  1946. Result := ParseOrExpr;
  1947. if AScanner.NextToken <> tkRightBracket then
  1948. Error(SParserExpectedRightBracket);
  1949. end;
  1950. tkString: // [29] Literal
  1951. Result := TXPathConstantNode.Create(
  1952. TXPathStringVariable.Create(AScanner.CurTokenString));
  1953. tkNumber: // [30] Number
  1954. Result := TXPathConstantNode.Create(
  1955. TXPathNumberVariable.Create(StrToFloat(AScanner.CurTokenString)));
  1956. tkIdentifier: // [16] Function call
  1957. begin
  1958. Result := TXPathFunctionNode.Create(AScanner.CurTokenString);
  1959. if AScanner.NextToken <> tkLeftBracket then
  1960. Error(SParserExpectedLeftBracket);
  1961. // Parse argument list
  1962. IsFirstArg := True;
  1963. while AScanner.NextToken <> tkRightBracket do
  1964. begin
  1965. if IsFirstArg then
  1966. begin
  1967. IsFirstArg := False;
  1968. AScanner.UngetToken;
  1969. end else
  1970. if AScanner.CurToken <> tkComma then
  1971. Error(SParserExpectedRightBracket);
  1972. TXPathFunctionNode(Result).FArgs.Add(ParseOrExpr);
  1973. end;
  1974. end;
  1975. else
  1976. Error(SParserInvalidPrimExpr);
  1977. end;
  1978. end;
  1979. function ParseUnionExpr: TXPathExprNode; // [18]
  1980. begin
  1981. Result := ParsePathExpr;
  1982. while True do
  1983. if AScanner.NextToken = tkPipe then
  1984. Result := TXPathUnionNode.Create(Result, ParsePathExpr)
  1985. else
  1986. begin
  1987. AScanner.UngetToken;
  1988. break;
  1989. end;
  1990. end;
  1991. function ParsePathExpr: TXPathExprNode; // [19]
  1992. var
  1993. ScannerState: TXPathScannerState;
  1994. IsFunctionCall: Boolean;
  1995. begin
  1996. // Try to detect wether a LocationPath [1] or a FilterExpr [20] follows
  1997. IsFunctionCall := False;
  1998. if (AScanner.NextToken = tkIdentifier) and
  1999. (AScanner.CurTokenString <> 'comment') and
  2000. (AScanner.CurTokenString <> 'text') and
  2001. (AScanner.CurTokenString <> 'processing-instruction') and
  2002. (AScanner.CurTokenString <> 'node') then
  2003. begin
  2004. ScannerState := AScanner.SaveState;
  2005. if AScanner.NextToken = tkLeftBracket then
  2006. IsFunctionCall := True;
  2007. AScanner.RestoreState(ScannerState);
  2008. end;
  2009. if IsFunctionCall or (AScanner.CurToken in
  2010. [tkDollar, tkLeftBracket, tkString, tkNumber]) then
  2011. begin
  2012. // second, third or fourth case of [19]
  2013. AScanner.UngetToken;
  2014. Result := ParseFilterExpr;
  2015. // !!!: Doesn't handle "/" or "//" plus RelativeLocationPath yet!
  2016. end else
  2017. begin
  2018. AScanner.UngetToken;
  2019. Result := ParseLocationPath;
  2020. end;
  2021. end;
  2022. function ParseFilterExpr: TXPathExprNode; // [20]
  2023. var
  2024. IsFirst: Boolean;
  2025. begin
  2026. Result := ParsePrimaryExpr;
  2027. // Parse predicates
  2028. IsFirst := True;
  2029. while AScanner.NextToken = tkLeftSquareBracket do
  2030. begin
  2031. if IsFirst then
  2032. begin
  2033. Result := TXPathFilterNode.Create(Result);
  2034. IsFirst := False;
  2035. end;
  2036. TXPathFilterNode(Result).FPredicates.Add(ParseOrExpr);
  2037. if AScanner.NextToken <> tkRightSquareBracket then
  2038. Error(SParserExpectedRightSquareBracket);
  2039. end;
  2040. AScanner.UngetToken;
  2041. end;
  2042. function ParseOrExpr: TXPathExprNode; // [21]
  2043. begin
  2044. Result := ParseAndExpr;
  2045. while True do
  2046. if (AScanner.NextToken = tkIdentifier) and
  2047. (AScanner.CurTokenString = 'or') then
  2048. Result := TXPathBooleanOpNode.Create(opOr, Result, ParseAndExpr)
  2049. else
  2050. begin
  2051. AScanner.UngetToken;
  2052. break;
  2053. end;
  2054. end;
  2055. function ParseAndExpr: TXPathExprNode; // [22]
  2056. begin
  2057. Result := ParseEqualityExpr;
  2058. while True do
  2059. if (AScanner.NextToken = tkIdentifier) and
  2060. (AScanner.CurTokenString = 'and') then
  2061. Result := TXPathBooleanOpNode.Create(opAnd, Result, ParseEqualityExpr)
  2062. else
  2063. begin
  2064. AScanner.UngetToken;
  2065. break;
  2066. end;
  2067. end;
  2068. function ParseEqualityExpr: TXPathExprNode; // [23]
  2069. begin
  2070. Result := ParseRelationalExpr;
  2071. while True do
  2072. case AScanner.NextToken of
  2073. tkEqual:
  2074. Result := TXPathBooleanOpNode.Create(opEqual, Result,
  2075. ParseRelationalExpr);
  2076. tkNotEqual:
  2077. Result := TXPathBooleanOpNode.Create(opNotEqual, Result,
  2078. ParseRelationalExpr);
  2079. else
  2080. begin
  2081. AScanner.UngetToken;
  2082. break;
  2083. end;
  2084. end;
  2085. end;
  2086. function ParseRelationalExpr: TXPathExprNode; // [24]
  2087. begin
  2088. Result := ParseAdditiveExpr;
  2089. while True do
  2090. case AScanner.NextToken of
  2091. tkLess:
  2092. Result := TXPathBooleanOpNode.Create(opLess, Result,
  2093. ParseAdditiveExpr);
  2094. tkLessEqual:
  2095. Result := TXPathBooleanOpNode.Create(opLessEqual, Result,
  2096. ParseAdditiveExpr);
  2097. tkGreater:
  2098. Result := TXPathBooleanOpNode.Create(opGreater, Result,
  2099. ParseAdditiveExpr);
  2100. tkGreaterEqual:
  2101. Result := TXPathBooleanOpNode.Create(opGreaterEqual, Result,
  2102. ParseAdditiveExpr);
  2103. else
  2104. begin
  2105. AScanner.UngetToken;
  2106. break;
  2107. end;
  2108. end;
  2109. end;
  2110. function ParseAdditiveExpr: TXPathExprNode; // [25]
  2111. begin
  2112. Result := ParseMultiplicativeExpr;
  2113. while True do
  2114. case AScanner.NextToken of
  2115. tkPlus:
  2116. Result := TXPathMathOpNode.Create(opAdd, Result,
  2117. ParseMultiplicativeExpr);
  2118. tkMinus:
  2119. Result := TXPathMathOpNode.Create(opSubtract, Result,
  2120. ParseMultiplicativeExpr);
  2121. else
  2122. begin
  2123. AScanner.UngetToken;
  2124. break;
  2125. end;
  2126. end;
  2127. end;
  2128. function ParseMultiplicativeExpr: TXPathExprNode; // [26]
  2129. begin
  2130. Result := ParseUnaryExpr;
  2131. while True do
  2132. case AScanner.NextToken of
  2133. tkAsterisk:
  2134. Result := TXPathMathOpNode.Create(opMultiply, Result,
  2135. ParseUnaryExpr);
  2136. tkIdentifier:
  2137. if AScanner.CurTokenString = 'div' then
  2138. Result := TXPathMathOpNode.Create(opDivide, Result,
  2139. ParseUnaryExpr)
  2140. else if AScanner.CurTokenString = 'mod' then
  2141. Result := TXPathMathOpNode.Create(opMod, Result,
  2142. ParseUnaryExpr)
  2143. else
  2144. begin
  2145. AScanner.UngetToken;
  2146. break;
  2147. end;
  2148. else
  2149. begin
  2150. AScanner.UngetToken;
  2151. break;
  2152. end;
  2153. end;
  2154. end;
  2155. function ParseUnaryExpr: TXPathExprNode; // [27]
  2156. var
  2157. NegCount: Integer;
  2158. begin
  2159. NegCount := 0;
  2160. while AScanner.NextToken = tkMinus do
  2161. Inc(NegCount);
  2162. AScanner.UngetToken;
  2163. Result := ParseUnionExpr;
  2164. if Odd(NegCount) then
  2165. Result := TXPathNegationNode.Create(Result);
  2166. end;
  2167. begin
  2168. inherited Create;
  2169. FRootNode := ParseOrExpr;
  2170. if CompleteExpression and (AScanner.NextToken <> tkEndOfStream) then
  2171. Error(SParserGarbageAfterExpression);
  2172. end;
  2173. function TXPathExpression.Evaluate(AContextNode: TDOMNode): TXPathVariable;
  2174. var
  2175. Environment: TXPathEnvironment;
  2176. begin
  2177. Environment := TXPathEnvironment.Create;
  2178. try
  2179. Result := Evaluate(AContextNode, Environment);
  2180. finally
  2181. Environment.Free;
  2182. end;
  2183. end;
  2184. function TXPathExpression.Evaluate(AContextNode: TDOMNode;
  2185. AEnvironment: TXPathEnvironment): TXPathVariable;
  2186. var
  2187. Context: TXPathContext;
  2188. begin
  2189. if Assigned(FRootNode) then
  2190. begin
  2191. Context := TXPathContext.Create(AContextNode, 1, 1);
  2192. try
  2193. Result := FRootNode.Evaluate(Context, AEnvironment);
  2194. finally
  2195. Context.Free;
  2196. end;
  2197. end else
  2198. Result := nil;
  2199. end;
  2200. function EvaluateXPathExpression(const AExpressionString: DOMString;
  2201. AContextNode: TDOMNode): TXPathVariable;
  2202. var
  2203. Scanner: TXPathScanner;
  2204. Expression: TXPathExpression;
  2205. begin
  2206. Scanner := TXPathScanner.Create(AExpressionString);
  2207. try
  2208. Expression := TXPathExpression.Create(Scanner, True);
  2209. try
  2210. Result := Expression.Evaluate(AContextNode);
  2211. finally
  2212. Expression.Free;
  2213. end;
  2214. finally
  2215. Scanner.Free;
  2216. end;
  2217. end;
  2218. end.