SystemOrganization addCategory: #'PetitXPath-Core'! SystemOrganization addCategory: #'PetitXPath-Tests'! PPCompositeParser subclass: #PPXPathContext instanceVariableNames: 'node nodeset size index variables functions' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Core'! !PPXPathContext methodsFor: 'filtering' stamp: 'lr 3/29/2010 09:25'! axis: aSymbol "Filter the current nodeset of the receiver using the axis aSymbol." nodeset := nodeset inject: self emptyNodeset into: [ :result :each | result addAll: (each perform: aSymbol) ]! ! !PPXPathContext methodsFor: 'copying' stamp: 'lr 3/29/2010 09:39'! copyWith: aNode ^ self shallowCopy postCopyWith: aNode! ! !PPXPathContext methodsFor: 'private' stamp: 'lr 3/29/2010 09:25'! emptyNodeset ^ IdentityDictionary new! ! !PPXPathContext methodsFor: 'querying' stamp: 'lr 3/29/2010 09:50'! functionNamed: aString ifAbsent: aBlock ^ functions at: aString ifAbsent: aBlock! ! !PPXPathContext methodsFor: 'initialization' stamp: 'lr 3/29/2010 09:41'! initializeOn: aNode node := aNode. nodeset := self emptyNodeset. nodeset add: aNode. size := index := 1. variables := Dictionary new. functions := Dictionary new! ! !PPXPathContext methodsFor: 'copying' stamp: 'lr 3/29/2010 09:39'! postCopyWith: aNode size := nodeset size. index := nodeset identityIndexOf: aNode. nodeset := self emptyNodeset. nodeset add: (node := aNode)! ! !PPXPathContext methodsFor: 'filtering' stamp: 'lr 3/29/2010 09:34'! predicate: aBlock "Filter the current nodeset with the predicate aBlock." nodeset := nodeset inject: self emptyNodeset into: [ :set :each | | result | result := aBlock value: (self copyWith: each). result ifTrue: [ set add: each ]. set ]! ! !PPXPathContext methodsFor: 'as yet unclassified' stamp: 'lr 3/29/2010 08:45'! reset axis := #childNodes. predicates := OrderedCollection new! ! !PPXPathContext methodsFor: 'as yet unclassified' stamp: 'lr 3/29/2010 08:45'! result ! ! !PPXPathContext methodsFor: 'accessing' stamp: 'lr 3/29/2010 09:49'! subcontexts "Answer a collection of subcontexts of the current nodeset." ^ nodeset collect: [ :node | self copyWith: node ]! ! !PPXPathContext methodsFor: 'querying' stamp: 'lr 3/29/2010 09:49'! variableNamed: aString ifAbsent: aBlock ^ variables at: aString ifAbsent: aBlock! ! 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 doubleDot singleDot nodeType processingInstruction nameTest nodeTest nodeTypeName axisSpecifierName' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Core'! !PPXPathGrammar methodsFor: 'grammar-path' 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' stamp: 'lr 3/28/2010 17:09'! axisSpecifier ^ axisSpecifierName , '::' asParser token! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 17:21'! axisSpecifierName "[6] AxisName ::= 'ancestor' | 'ancestor-or-self' | 'attribute' | 'child' | 'descendant' | 'descendant-or-self' | 'following' | 'following-sibling' | 'namespace' | 'parent' | 'preceding' | 'preceding-sibling' | 'self'" ^ 'ancestor' asParser token / 'ancestor-or-self' asParser token / 'attribute' asParser token / 'child' asParser token / 'descendant' asParser token / 'descendant-or-self' asParser token / 'following' asParser token / 'following-sibling' asParser token / 'namespace' asParser token / 'parent' asParser token / 'preceding' asParser token / 'preceding-sibling' 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-path' stamp: 'lr 3/28/2010 18:35'! locationPath "[1] LocationPath ::= RelativeLocationPath | AbsoluteLocationPath" ^ relativeLocationPath / absoluteLocationPath! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 15:52'! nameTest "[37] NameTest ::= '*' | NCName ':' '*' | QName" ^ $* asParser / (identifier , ':*' asParser) / identifier! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 15:47'! nodeTest ^ nodeType / processingInstruction / nameTest! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 16:08'! nodeType ^ nodeTypeName , leftParenthesis , rightParenthesis! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 15:52'! nodeTypeName "[38] NodeType ::= 'comment' | 'text' | 'processing-instruction' | 'node'" ^ 'comment' asParser token / 'text' asParser token / 'processing-instruction' asParser token / 'node' asParser token! ! !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/28/2010 18:41'! pathExpression "[19] PathExpr ::= LocationPath | FilterExpr | FilterExpr '/' RelativeLocationPath | FilterExpr '//' RelativeLocationPath" ^ (filterExpression , ((doubleSlash token / singleSlash token) , relativeLocationPath) optional) / (locationPath)! ! !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' stamp: 'lr 3/28/2010 15:50'! processingInstruction ^ leftParenthesis , literal , rightParenthesis! ! !PPXPathGrammar methodsFor: 'grammar-path' 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-path' stamp: 'lr 3/28/2010 18:43'! step ^ axisSpecifier optional , nodeTest , predicate star! ! !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/28/2010 18:17'! variable "[36] VariableReference ::= '$' QName" ^ $$ asParser , identifier token! ! !PPXPathGrammar methodsFor: 'grammar' stamp: 'lr 3/28/2010 12:47'! xpath ^ spaces , expression , spaces! ! PPXPathGrammar subclass: #PPXPathParser instanceVariableNames: '' classVariableNames: 'Axes Operations Types' 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/28/2010 17:35'! initialize self initializeAxes. self initializeOperations. self initializeTypes! ! !PPXPathParser class methodsFor: 'initialization' stamp: 'lr 3/28/2010 17:33'! initializeAxes Axes := Dictionary new. Axes at: 'ancestor' put: [ :node | node ancestorNodes ]; at: 'ancestor-or-self' put: [ :node | node withAncestorNodes ]; at: 'attribute' put: [ :node | node attributes ]; at: 'child' put: [ :node | node childNodes ]; at: 'descendant' put: [ :node | node descendantNodes ]; at: 'descendant-or-self' put: [ :node | node withDescendantNodes ]; at: 'following' put: [ :node | node followingNodes ]; at: 'following-sibling' put: [ :node | node followingSiblingNodes ]; at: 'parent' put: [ :node | node parentNode ]; at: 'preceding' put: [ :node | node precedingNodes ]; at: 'preceding-sibling' put: [ :node | node precedingSiblingNodes ]; at: 'self' put: [ :node | node ]! ! !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: 'initialization' stamp: 'lr 3/28/2010 17:33'! initializeTypes Types := Dictionary new. Types at: 'text' put: [ :node | node isText ]; at: 'node' put: [ :node | node isElement ]; at: 'comment' put: [ :node | node isComment ]; at: 'processing-instruction' put: [ :node | node isProcessing ]! ! !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' stamp: 'lr 3/28/2010 17:15'! axisSpecifier ^ super axisSpecifier ==> #first! ! !PPXPathParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 17:33'! axisSpecifierName ^ super axisSpecifierName ==> [ :token | Axes at: token value ifAbsent: [ PPFailure reason: 'Invalid axis: ' , token value at: token start ] ]! ! !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' stamp: 'lr 3/28/2010 17:15'! nodeType ^ super nodeType ==> #first! ! !PPXPathParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 17:33'! nodeTypeName ^ super nodeTypeName ==> [ :token | Types at: token value ifAbsent: [ PPFailure reason: 'Invalid type: ' , token value at: token start ] ]! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/28/2010 18:17'! number ^ super number ==> [ :token | token value asNumber ]! ! !PPXPathParser methodsFor: 'grammar-primary' stamp: 'lr 3/29/2010 09:59'! predicate ^ super predicate ==> [ :nodes | [ :context | context predicate: nodes second ] ]! ! !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/29/2010 09:58'! variable ^ super variable ==> [ :nodes | | ident | ident := nodes second value. [ :context | context variableNamed: ident ifAbsent: [ self error: 'Unknown variable: ' , ident ] ] ]! ! !PPXPathParser methodsFor: 'grammar' stamp: 'lr 3/28/2010 18:44'! xpath ^ super xpath ==> #second! ! TestResource subclass: #PPXPathResource instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Tests'! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:49'! ancestorNodes "Selects all ancestors (parent, grandparent, etc.) of the current node." | result current | current := self parentNode. result := OrderedCollection new. [ current notNil ] whileTrue: [ result addLast: current. current := current parentNode ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:52'! descendantNodes "Selects all descendants (children, grandchildren, etc.) of the current node." | current result | result := OrderedCollection new. self childNodes do: [ :each | result addAll: each withDescendantNodes ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/29/2010 13:37'! followingNodes "Selects everything in the document after the closing tag of the current node." | current result | current := self. result := OrderedCollection new. [ current notNil ] whileTrue: [ current followingSiblingNodes do: [ :each | result addAll: each withDescendantNodes ]. current := current parentNode ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:55'! followingSiblingNodes "Selects all siblings after the current node." | current result | current := self nextSibling. result := OrderedCollection new. [ current isNil ] whileFalse: [ result addLast: current. current := current nextSibling ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/29/2010 13:34'! precedingNodes "Selects everything in the document that is before the start tag of the current node." | current result | current := self. result := OrderedCollection new. [ current notNil ] whileTrue: [ current precedingSiblingNodes do: [ :each | result addAll: each withDescendantNodes ]. current := current parentNode ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:56'! precedingSiblingNodes "Selects all siblings before the current node." | current result | current := self previousSibling. result := OrderedCollection new. [ current isNil ] whileFalse: [ result addFirst: current. current := current previousSibling ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:52'! withAncestorNodes "Selects all ancestors (parent, grandparent, etc.) of the current node and the current node itself." | current result | current := self. result := OrderedCollection new. [ current notNil ] whileTrue: [ result addLast: current. current := current parentNode ]. ^ result asArray! ! !PPXmlNode methodsFor: '*petitxpath-accessing' stamp: 'lr 3/28/2010 16:52'! withDescendantNodes "Selects all descendants (children, grandchildren, etc.) of the current node and the current node itself." | current result | result := OrderedCollection new. self nodesDo: [ :each | result addLast: each ]. ^ result asArray! ! TestCase subclass: #PPXPathBookstoreTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Tests'! TestCase subclass: #PPXmlXPathGrammarTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitXPath-Tests'! !PPXmlXPathGrammarTest methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:30'! parser ^ self resource parserAt: self parserClass! ! !PPXmlXPathGrammarTest methodsFor: 'accessing' stamp: 'lr 3/28/2010 18:31'! parserClass ^ PPXmlXPathGrammar! ! PPXPathParser initialize!