SystemOrganization addCategory: #'PetitXPath-Core'! SystemOrganization addCategory: #'PetitXPath-Tests'! PPCompositeParser subclass: #PPXPathGrammar instanceVariableNames: 'pathExpression locationPath relativeLocationPath primaryExpression xpath spaces expression filterExpression predicate absoluteLocationPath step identifier axisSpecifier literal number function variable digits group leftBracket rightBracket leftParenthesis rightParenthesis doubleSlash singleSlash argumentSeparator axisSpecifierName axisAbbreviation axis typeAbbreviation type typeComment typeNode typeText typeProcessing typeName' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Core'! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 18:37'! absoluteLocationPath ^ singleSlash , relativeLocationPath optional! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:27'! argumentSeparator ^ $, asParser token! ! !PPXPathGrammar methodsFor: 'grammar-axis' stamp: 'lr 3/31/2010 11:40'! axis ^ axisAbbreviation / axisSpecifier! ! !PPXPathGrammar methodsFor: 'grammar-axis' stamp: 'lr 3/31/2010 11:39'! axisAbbreviation ^ '..' asParser token / $. asParser token / $/ asParser token / $@ asParser token! ! !PPXPathGrammar methodsFor: 'grammar-axis' stamp: 'lr 3/28/2010 17:09'! axisSpecifier ^ axisSpecifierName , '::' asParser token! ! !PPXPathGrammar methodsFor: 'grammar-axis' stamp: 'lr 3/31/2010 13:34'! axisSpecifierName "[6] AxisName ::= 'ancestor' | 'ancestor-or-self' | 'attribute' | 'child' | 'descendant' | 'descendant-or-self' | 'following' | 'following-sibling' | 'namespace' | 'parent' | 'preceding' | 'preceding-sibling' | 'self'" ^ 'ancestor-or-self' asParser token / 'ancestor' asParser token / 'attribute' asParser token / 'child' asParser token / 'descendant-or-self' asParser token / 'descendant' asParser token / 'following-sibling' asParser token / 'following' asParser token / 'namespace' asParser token / 'parent' asParser token / 'preceding-sibling' asParser token / 'preceding' asParser token / 'self' asParser token! ! !PPXPathGrammar methodsFor: 'callbacks' stamp: 'lr 3/28/2010 17:29'! binaryOperation: aToken with: aFirstObject and: aSecondObject ^ Array with: aToken with: aFirstObject with: aSecondObject! ! !PPXPathGrammar methodsFor: 'private' stamp: 'lr 3/28/2010 15:07'! digits "[31] Digits ::= [0-9]+" ^ #digit asParser plus! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:44'! doubleDot ^ '..' asParser token! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:19'! doubleSlash ^ '//' asParser token! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 17:29'! expression ^ PPExpressionParser new term: pathExpression; group: [ :g | g left: $| asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g prefix: $- asParser token do: [ :op :a | self unaryOperation: op with: a ] ]; group: [ :g | g left: $* asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: 'div' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: 'mod' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g left: $+ asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: $- asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g left: $< asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: $> asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: '<=' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: '>=' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g left: $= asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ]. g left: '!!=' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g left: 'and' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; group: [ :g | g left: 'or' asParser token do: [ :a :op :b | self binaryOperation: op with: a and: b ] ]; yourself! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 17:23'! filterExpression "[20] FilterExpr ::= PrimaryExpr | FilterExpr Predicate" ^ primaryExpression , predicate star! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 18:21'! function ^ identifier token , leftParenthesis token , (expression separatedBy: argumentSeparator token) , rightParenthesis token! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 15:21'! group ^ leftParenthesis , expression , rightParenthesis! ! !PPXPathGrammar methodsFor: 'private' stamp: 'lr 3/28/2010 15:34'! identifier ^ #letter asParser , #word asParser star! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:18'! leftBracket ^ $[ asParser token! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:18'! leftParenthesis ^ $( asParser token! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 15:45'! literal "[29] Literal ::= '""' [^""]* '""' | ""'"" [^']* ""'""" ^ ($" asParser , $" asParser negate star flatten , $" asParser) / ($' asParser , $' asParser negate star flatten , $' asParser)! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 18:35'! locationPath "[1] LocationPath ::= RelativeLocationPath | AbsoluteLocationPath" ^ relativeLocationPath / absoluteLocationPath! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 15:23'! number "[30] Number ::= Digits ('.' Digits?)? | '.' Digits" ^ ((digits , ($. asParser , digits optional) optional) / ($. asParser , digits)) token! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/31/2010 14:16'! pathExpression "[19] PathExpr ::= LocationPath | FilterExpr | FilterExpr '/' RelativeLocationPath | FilterExpr '//' RelativeLocationPath" ^ singleSlash token , relativeLocationPath! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 17:23'! predicate "[8] Predicate ::= '[' PredicateExpr ']'" ^ leftBracket , expression , rightBracket! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 15:17'! primaryExpression ^ variable / group / literal / number / function! ! !PPXPathGrammar methodsFor: 'grammar-expr' stamp: 'lr 3/28/2010 18:37'! relativeLocationPath "[3] RelativeLocationPath ::= Step | RelativeLocationPath '/' Step | AbbreviatedRelativeLocationPath " ^ step separatedBy: singleSlash ! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:19'! rightBracket ^ $] asParser token! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 16:27'! rightParenthesis ^ $) asParser token! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:44'! singleDot ^ $. asParser token! ! !PPXPathGrammar methodsFor: 'tokens' stamp: 'lr 3/28/2010 15:26'! singleSlash ^ $/ asParser token! ! !PPXPathGrammar methodsFor: 'grammar-misc' stamp: 'lr 3/28/2010 12:48'! spaces ^ #space asParser star! ! !PPXPathGrammar methodsFor: 'accessing' stamp: 'lr 3/28/2010 12:47'! start ^ xpath end! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/31/2010 13:13'! step ^ axis optional , type , predicate star! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:14'! type ^ typeAbbreviation / typeComment / typeNode / typeText / typeProcessing / typeName! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:12'! typeAbbreviation ^ $* asParser token! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:12'! typeComment ^ 'comment' asParser token , leftParenthesis , rightParenthesis! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:23'! typeName ^ identifier token! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:12'! typeNode ^ 'node' asParser token , leftParenthesis , rightParenthesis! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:12'! typeProcessing ^ 'processing-instruction' asParser token , leftParenthesis , literal optional , rightParenthesis! ! !PPXPathGrammar methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:13'! typeText ^ 'text' asParser token , leftParenthesis , rightParenthesis! ! !PPXPathGrammar methodsFor: 'callbacks' stamp: 'lr 3/28/2010 17:30'! unaryOperation: aToken with: anObject ^ Array with: aToken with: anObject! ! !PPXPathGrammar methodsFor: 'grammar-primary' stamp: 'lr 3/31/2010 13:23'! variable "[36] VariableReference ::= '$' QName" ^ ($$ asParser , identifier) token! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/31/2010 14:14'! xpath ^ spaces , expression , spaces ==> #second! ! PPXPathGrammar subclass: #PPXPathParser instanceVariableNames: '' classVariableNames: 'AxisMap NameMap' poolDictionaries: '' category: 'PetitXPath-Core'! !PPXPathParser class methodsFor: 'coercion' stamp: 'lr 3/28/2010 17:56'! boolean: anObject (anObject isNumber) ifTrue: [ ^ anObject isZero not ]. (anObject isCollection) ifTrue: [ ^ anObject isEmpty not ]. (anObject == true or: [ anObject == false ]) ifTrue: [ ^ anObject ]. ^ anObject notNil! ! !PPXPathParser class methodsFor: 'initialization' stamp: 'lr 3/31/2010 13:18'! initialize self initializeAxisMap. self initializeNameMap! ! !PPXPathParser class methodsFor: 'initialization' stamp: 'lr 3/31/2010 10:35'! initializeAxisMap AxisMap := Dictionary new. AxisMap at: '.' put: #selfAxis; at: '..' put: #parentAxis; at: '/' put: #descendantAxis; at: '@' put: #attributeAxis; at: 'ancestor' put: #ancestorAxis; at: 'ancestor-or-self' put: #ancestorOrSelfAxis; at: 'attribute' put: #attributeAxis; at: 'child' put: #childAxis; at: 'descendant' put: #descendantAxis; at: 'descendant-or-self' put: #descendantOrSelfAxis; at: 'following' put: #followingAxis; at: 'following-sibling' put: #followingSiblingAxis; at: 'parent' put: #parentAxis; at: 'preceding' put: #precedingAxis; at: 'preceding-sibling' put: #precedingSiblingAxis; at: 'self' put: #selfAxis! ! !PPXPathParser class methodsFor: 'initialization' stamp: 'lr 3/28/2010 17:55'! initializeOperations Operations := Dictionary new. Operations at: '|' put: [ :a :b | ]; at: '-' put: [ :a | (self number: a) negated ]; at: '*' put: [ :a :b | (self number: a) * (self number: b) ]; at: 'div' put: [ :a :b | (self number: a) / (self number: b) ]; at: 'mod' put: [ :a :b | (self number: a) \\ (self number: b) ]; at: '+' put: [ :a :b | (self number: a) + (self number: b) ]; at: '-' put: [ :a :b | (self number: a) - (self number: b) ]; at: '<' put: [ :a :b | (self number: a) < (self number: b) ]; at: '>' put: [ :a :b | (self number: a) > (self number: b) ]; at: '<=' put: [ :a :b | (self number: a) <= (self number: b) ]; at: '>=' put: [ :a :b | (self number: a) >= (self number: b) ]; at: '=' put: [ :a :b | a = b ]; at: '!!=' put: [ :a :b | a ~= b ]; at: 'and' put: [ :a :b | (self boolean: a) and: [ self boolean: b ] ]; at: 'or' put: [ :a :b | (self boolean: a) or: [ self boolean: b ] ]! ! !PPXPathParser class methodsFor: 'coercion' stamp: 'lr 3/28/2010 17:57'! number: anObject (anObject isNumber) ifTrue: [ ^ anObject ]. ^ (self string: anObject) asNumber! ! !PPXPathParser class methodsFor: 'coercion' stamp: 'lr 3/28/2010 17:56'! string: anObject (anObject isString) ifTrue: [ ^ anObject ]. (anObject isNumber or: [ anObject == true or: [ anObject == false ] ]) ifTrue: [ ^ anObject printString ]. ^ anObject printString! ! !PPXPathParser methodsFor: 'grammar-axis' stamp: 'lr 3/31/2010 11:41'! axis ^ super axis ==> [ :token | AxisMap at: token value ifAbsent: [ PPFailure reason: 'Unknown axis specifier: ' , token value at: token start ] ]! ! !PPXPathParser methodsFor: 'grammar-axis' stamp: 'lr 3/28/2010 17:15'! axisSpecifier ^ super axisSpecifier ==> #first! ! !PPXPathParser methodsFor: 'callbacks' stamp: 'lr 3/28/2010 19:35'! binaryOperation: aToken with: aFirstObject and: aSecondObject ^ Operations at: aToken value ifAbsent: [ PPFailure reason: 'Invalid operation: ' , aToken value at: aToken start ]! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/29/2010 13:24'! function ^ super function ==> [ :nodes | | ident args | ident := nodes first value. args := nodes third reject: [ :each | each isKindOf: PPToken ]. [ :context | | func vals | func := context functionNamed: ident ifAbsent: [ self error: 'Unknown function: ' , ident ]. func numArgs = args size ifFalse: [ self error: 'Invalid number of arguments: ' , ident ]. func replace: [ :node | func valueWithArguments: (args collect: [ :arg | context copyWith: node ]) ] ] ]! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 18:17'! group ^ super group ==> #second! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 18:16'! literal ^ super literal ==> #second! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 18:17'! number ^ super number ==> [ :token | token value asNumber ]! ! !PPXPathParser methodsFor: 'grammar-expr' stamp: 'lr 3/31/2010 23:30'! pathExpression ^ super pathExpression ==> #second! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/29/2010 09:59'! predicate ^ super predicate ==> [ :nodes | [ :context | context predicate: nodes second ] ]! ! !PPXPathParser methodsFor: 'grammar-expr' stamp: 'lr 4/1/2010 15:12'! relativeLocationPath ^ super relativeLocationPath ==> [ :nodes | | steps | steps := nodes reject: [ :each | each class = PPToken ]. [ :context | | contexts | contexts := Array with: context. steps do: [ :block | contexts := contexts gather: [ :each | block value: each. each subcontexts ] ]. contexts collect: [ :each | each node ] ] ]! ! !PPXPathParser methodsFor: 'grammar' stamp: 'lr 4/1/2010 15:11'! step ^ super step ==> [ :nodes | | axis name predicates | axis := nodes first ifNil: [ #childAxis ]. name := nodes second. predicates := nodes third. [ :context | name value: (axis value: context) ] ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:17'! typeAbbreviation ^ super typeAbbreviation ==> [ :token | #nodeType ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:17'! typeComment ^ super typeComment ==> [ :token | #commentType ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:12'! typeName ^ super typeName ==> [ :token | [ :context | context nodeType: token value ] ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:17'! typeNode ^ super typeNode ==> [ :token | #nodeType ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 4/1/2010 16:10'! typeProcessing ^ super typeProcessing map: [ :token :open :arg :close | arg isNil ifTrue: [ #processingType ] ifFalse: [ [ :context | context processingType: arg ] ] ]! ! !PPXPathParser methodsFor: 'grammar-type' stamp: 'lr 3/31/2010 13:17'! typeText ^ super typeText ==> [ :token | #textType ]! ! !PPXPathParser methodsFor: 'callbacks' stamp: 'lr 3/28/2010 19:35'! unaryOperation: aToken with: anObject ^ Operations at: aToken value ifAbsent: [ PPFailure reason: 'Invalid operation: ' , aToken value at: aToken start ]! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/31/2010 13:23'! variable ^ super variable ==> [ :token | | ident | ident := token value allButFirst. [ :context | context variableNamed: ident ifAbsent: [ self error: 'Unknown variable: ' , ident ] ] ]! ! !PPXmlNode methodsFor: '*petitxpath' stamp: 'lr 4/1/2010 15:17'! xpath: aString | xpath | xpath := PPXPathParser parse: aString onError: [ :err | self error: err printString ]. ^ xpath value: (PPXPathContext on: self) ! ! Object subclass: #PPXPathContext instanceVariableNames: 'owner node nodeset position length variables functions' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Core'! !PPXPathContext class methodsFor: 'instance creation' stamp: 'lr 3/29/2010 18:14'! on: anXmlNode ^ self basicNew initializeOn: anXmlNode! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:37'! ancestorAxis "The ancestor axis contains the ancestors of the context node; the ancestors of the context node consist of the parent of context node and the parent's parent and so on; thus, the ancestor axis will always include the root node, unless the context node is the root node." | current | current := node parentNode. nodeset := OrderedCollection new. [ current isNil ] whileTrue: [ nodeset addLast: current. current := current parentNode ]! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:37'! ancestorOrSelfAxis "The ancestor-or-self axis contains the context node and the ancestors of the context node; thus, the ancestor axis will always include the root node." | current | current := node. nodeset := OrderedCollection new. [ current isNil ] whileTrue: [ nodeset addLast: current. current := current parentNode ]! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:20'! attributeAxis "The attribute axis contains the attributes of the context node; the axis will be empty unless the context node is an element" nodeset := node attributes! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:13'! childAxis "The child axis contains the children of the context node." nodeset := node childNodes! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:00'! commentType "Select all nodes of type comment." nodeset := nodeset select: [ :each | each isComment ]! ! !PPXPathContext methodsFor: 'copying' stamp: 'lr 3/29/2010 09:39'! copyWith: aNode ^ self shallowCopy postCopyWith: aNode! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:52'! descendantAxis "The descendant axis contains the descendants of the context node; a descendant is a child or a child of a child and so on; thus the descendant axis never contains attribute or namespace nodes." nodeset := OrderedCollection new. self recurse: node childNodes do: [ :each | nodeset addLast: each. each childNodes ]! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:52'! descendantOrSelfAxis "The descendant-or-self axis contains the context node and the descendants of the context node" nodeset := OrderedCollection with: self. self recurse: node childNodes do: [ :each | nodeset addLast: each. each childNodes ]! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:50'! followingAxis "The following axis contains all nodes in the same document as the context node that are after the context node in document order, excluding any descendants and excluding attribute nodes and namespace nodes." self error: 'Not implemented yet'! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:31'! followingSiblingAxis "The following-sibling axis contains all the following siblings of the context node; if the context node is an attribute node or namespace node, the following-sibling axis is empty." | parent index | nodeset := #(). node isAttribute ifTrue: [ ^ self ]. parent := node parentNode ifNil: [ ^ self ]. index := parent childNodes identityIndexOf: self ifAbsent: [ ^ self ]. nodeset := node childNodes copyFrom: index + 1 to: parent childNodes size! ! !PPXPathContext methodsFor: 'querying' stamp: 'lr 3/29/2010 18:15'! functionNamed: aString ifAbsent: aBlock "Return the function named aString, evaluate aBlock if not present." ^ functions at: aString ifAbsent: aBlock! ! !PPXPathContext methodsFor: 'initialization' stamp: 'lr 3/29/2010 18:13'! initializeOn: aNode node := aNode. position := length := 1. variables := Dictionary new. functions := Dictionary new! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 3/29/2010 18:11'! length "Answer the size of nodeset the receiver was created from." ^ length! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:24'! namespaceAxis "The namespace axis contains the namespace nodes of the context node; the axis will be empty unless the context node is an element." nodeset := #()! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 3/29/2010 18:14'! node "Answer the context node of the receiver." ^ node! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:12'! nodeType "Select all nodes of any type whatsoever. Nothing to do here."! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:11'! nodeType: aString "Select all nodes with the type aString." nodeset := nodeset select: [ :each | (each isElement or: [ each isAttribute ]) and: [ each name qualifiedName = aString ] ]! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 3/29/2010 19:16'! nodeset "Answer the current nodeset of the receiver." ^ nodeset! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:16'! parentAxis "The parent axis contains the parent of the context node, if there is one." | parent | parent := node parentNode. nodeset := parent isNil ifTrue: [ Array new ] ifFalse: [ Array with: parent ]! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 3/29/2010 18:11'! position "Answer the position in the nodeset the receiver was created from." ^ position! ! !PPXPathContext methodsFor: 'copying' stamp: 'lr 3/29/2010 18:12'! postCopyWith: aNode node := aNode. length := nodeset size. position := nodeset identityIndexOf: node. nodeset := nil! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:51'! precedingAxis "The preceding axis contains all nodes in the same document as the context node that are before the context node in document order, excluding any ancestors and excluding attribute nodes and namespace nodes." self error: 'Not implemented yet'! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:31'! precedingSiblingAxis "The preceding-sibling axis contains all the preceding siblings of the context node; if the context node is an attribute node or namespace node, the preceding-sibling axis is empty." | parent index | nodeset := #(). node isAttribute ifTrue: [ ^ self ]. parent := node parentNode ifNil: [ ^ self ]. index := parent childNodes identityIndexOf: self ifAbsent: [ ^ self ]. nodeset := node childNodes copyFrom: 1 to: index - 1! ! !PPXPathContext methodsFor: 'printing' stamp: 'lr 3/29/2010 18:13'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' on: '; print: self node! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:12'! processingType "Select all nodes of type processing instruction." nodeset := nodeset select: [ :each | each isProcessing ]! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:12'! processingType: aString "Select all nodes of type processing instruction with aString." nodeset := nodeset select: [ :each | each isProcessing and: [ each target = aString ] ]! ! !PPXPathContext methodsFor: 'private' stamp: 'lr 3/30/2010 21:47'! recurse: aCollection do: aBlock "Recurse into aCollection and evaluate aBlock for each element, continue with the resulting collection." aCollection do: [ :each | self recurse: (aBlock value: each) do: aBlock ]! ! !PPXPathContext methodsFor: 'actions-axis' stamp: 'lr 3/30/2010 21:24'! selfAxis "The self axis contains just the context node itself." nodeset := Array with: node! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 4/1/2010 15:11'! subcontexts "Answer a collection of subcontexts." ^ nodeset collect: [ :each | self copyWith: each ]! ! !PPXPathContext methodsFor: 'actions-type' stamp: 'lr 3/31/2010 12:00'! textType "Select all nodes of type text." nodeset := nodeset select: [ :each | each isText ]! ! !PPXPathContext methodsFor: 'querying' stamp: 'lr 3/29/2010 18:15'! variableNamed: aString ifAbsent: aBlock "Return the variable named aString, evaluate aBlock if not present." ^ variables at: aString ifAbsent: aBlock! ! TestCase subclass: #PPXPathBookstoreTest instanceVariableNames: '' classVariableNames: 'BookstoreDocument' poolDictionaries: '' category: 'PetitXPath-Tests'! !PPXPathBookstoreTest class methodsFor: 'initialization' stamp: 'lr 4/1/2010 16:08'! initialize BookstoreDocument := PPXmlParser parse: ' Everyday Italian Giada De Laurentiis 2005 30.00 Harry Potter J K. Rowling 2005 29.99 XQuery Kick Start James McGovern Per Bothner Kurt Cagle James Linn Vaidyanathan Nagarajan 2003 49.99 Learning XML Erik T. Ray 2003 39.95 '! ! !PPXPathBookstoreTest methodsFor: 'accessing' stamp: 'lr 4/1/2010 15:53'! assert: aString gives: aBlockOrArray | query result | query := PPXPathParser parse: aString onError: [ :err | self error: err printString ]. result := query value: (PPXPathContext on: BookstoreDocument). aBlockOrArray isBlock ifTrue: [ aBlockOrArray value: result ] ifFalse: [ self assert: result size = aBlockOrArray size. result with: aBlockOrArray do: [ :a :b | self assert: a == b ] ]! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 3/29/2010 18:53'! testAllAttributes self assert: 'attribute::*' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 3/29/2010 18:55'! testAllBookAncestors self assert: 'ancestor::book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 3/31/2010 13:21'! testAllBookAncestorsOrSelf self assert: 'ancestor-or-self::book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 3/29/2010 18:54'! testAllBookChildren self assert: 'child::book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 3/29/2010 18:55'! testAllBookDescendents self assert: 'descendant::book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 4/1/2010 15:50'! testAllChildren self assert: '/child::*' gives: BookstoreDocument childNodes! ! !PPXPathBookstoreTest methodsFor: 'testing-unknown' stamp: 'lr 3/29/2010 19:01'! testAllElements self assert: '//*' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 4/1/2010 15:54'! testAllLangAttributes self assert: '//*/attribute::lang' gives: [ :result | self assert: (result size = 4). self assert: (result allSatisfy: [ :each | each isAttribute ]) ]! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 4/1/2010 15:54'! testAllNodeChildren self assert: '/child::node()' gives: BookstoreDocument childNodes! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 4/1/2010 15:55'! testAllPriceGrandchildren self assert: '/child::*/child::price' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-axis' stamp: 'lr 4/1/2010 15:57'! testAllTextChildren self assert: '//text()' gives: [ :result | self assert: (result size = 20). self assert: (result allSatisfy: [ :each | each isText ]) ]! ! !PPXPathBookstoreTest methodsFor: 'testing' stamp: 'lr 3/29/2010 18:50'! testAllThePrices self assert: '/bookstore/book/price/text()' gives: #('30.00' '29.99' '49.99' '39.95')! ! !PPXPathBookstoreTest methodsFor: 'testing' stamp: 'lr 3/29/2010 18:50'! testAllTheTitles self assert: '/bookstore/book/title' gives: #('Everyday Italian' 'Harry Potter' 'XQuery Kick Start' 'Learning XML')! ! !PPXPathBookstoreTest methodsFor: 'testing-unknown' stamp: 'lr 3/29/2010 19:02'! testAllTitleAndPrices self assert: '//title | //price' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-unknown' stamp: 'lr 3/29/2010 19:02'! testAllTitleAndPricesOfBook self assert: '//book/title | //book/price' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-unknown' stamp: 'lr 3/29/2010 19:02'! testAllTitlesWithAttributes self assert: '//title[@*]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:58'! testBookDeepElements self assert: '/bookstore//book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:58'! testBookElements self assert: '/bookstore/book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:58'! testBookElementsDeep self assert: '//book' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:57'! testBookstoreChildren self assert: 'bookstore' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:57'! testBookstoreRoot self assert: '/bookstore' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 3/29/2010 18:59'! testDeepLanguageAttributes self assert: '//@lang' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 19:00'! testExpensiveBooks self assert: '/bookstore/book[price>35.00]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 18:59'! testFirstBook self assert: '/bookstore/book[1]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 19:00'! testFirstTwoBook self assert: '/bookstore/book[position()<3]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 18:59'! testLastBook self assert: '/bookstore/book[last()]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing' stamp: 'lr 3/29/2010 18:50'! testPriceNodes35 self assert: '/bookstore/book[price>35]/price' gives: #('49.99' '39.95')! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 18:59'! testSecondLastBook self assert: '/bookstore/book[last()-1]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing' stamp: 'lr 3/29/2010 18:50'! testTiltleOfFirstBook self assert: '/bookstore/book[1]/title' gives: #('Everyday Italian')! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 19:01'! testTitleOfExpensiveBooks self assert: '/bookstore/book[price>35.00]/title' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing' stamp: 'lr 3/29/2010 18:50'! testTitlesOfPrice35 self assert: '/bookstore/book[price>35]/title' gives: #('XQuery Kick Start' 'Learning XML')! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 19:00'! testTitlesWithLang self assert: '//title[@lang]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-predicates' stamp: 'lr 3/29/2010 19:00'! testTitlesWithLangEng self assert: '//title[@lang="eng"]' gives: #()! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:12'! testTypeAbbr self assert: '//*' gives: [ :result | self assert: result size = 77 ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:02'! testTypeComment self assert: '//comment()' gives: [ :result | self assert: result size = 1. self assert: result first isComment ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:08'! testTypeNode self assert: '//node()' gives: [ :result | self assert: result size = 77 ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:11'! testTypeProcessing self assert: '//processing-instruction()' gives: [ :result | self assert: result size = 1. self assert: (result allSatisfy: [ :each | each isProcessing ]) ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:11'! testTypeProcessingArg self assert: '//processing-instruction("xml")' gives: [ :result | self assert: (result size = 1). self assert: (result allSatisfy: [ :each | each isProcessing ]) ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:11'! testTypeProcessingUnknown self assert: '//processing-instruction("foo")' gives: [ :result | self assert: result isEmpty ]! ! !PPXPathBookstoreTest methodsFor: 'testing-type' stamp: 'lr 4/1/2010 16:12'! testTypeText self assert: '//text()' gives: [ :result | self assert: result size = 50. self assert: (result allSatisfy: [ :each | each isText ]) ]! ! !PPXPathBookstoreTest methodsFor: 'testing-unknown' stamp: 'lr 3/29/2010 19:01'! testUnknownChildren self assert: '/bookstore/*' gives: #()! ! TestCase subclass: #PPXPathGrammarTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Tests'! !PPXPathGrammarTest class methodsFor: 'accessing' stamp: 'lr 4/1/2010 15:19'! packageNamesUnderTest ^ #('PetitXPath')! ! !PPXPathGrammarTest methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:30'! parser ^ self resource parserAt: self parserClass! ! !PPXPathGrammarTest methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:31'! parserClass ^ PPXmlXPathGrammar! ! PPXPathParser initialize! PPXPathBookstoreTest initialize!