SystemOrganization addCategory: #'PetitXml-Core'!
SystemOrganization addCategory: #'PetitXml-Tests'!
PPCompositeParser subclass: #PPXmlGrammar
instanceVariableNames: 'comment whitespace processing nameStartChar nameChar nameToken nmToken misc document prolog element attributes content characterData attribute'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 12:46'!
attribute
"[41] Attribute ::= Name Eq AttValue"
^ self parserForAttribute: nameToken value: $" asParser negate star token! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 12:46'!
attributes
"[40] STag ::= '<' Name (S Attribute)* S? '>' "
^ ((whitespace , attribute) ==> #second) star! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 12:42'!
characterData
"[14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)"
^ $< asParser negate plus token! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 12:48'!
comment
"[15] Comment ::= ''"
^ '' asParser not , #any asParser) star , '-->' asParser! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 09:29'!
content
"[43] content ::= CharData? ((element | Reference | CDSect | PI | Comment) CharData?)*"
^ characterData optional , ((element / processing / comment) , characterData optional) star! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 09:22'!
document
"[1] document ::= prolog element Misc*"
^ self parserForDocument: prolog element: element! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 11:31'!
element
"[39] element ::= EmptyElemTag | STag content ETag"
^ (self parserForTag: nameToken attributes: attributes) / (self parserForTag: nameToken attributes: attributes content: content)! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 09:08'!
misc
"[27] Misc ::= Comment | PI | S"
^ (whitespace / comment / processing) star! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 1/26/2010 09:13'!
nameChar
"[4a] NameChar ::= NameStartChar | ""-"" | ""."" | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]"
^ PPPredicateParser on: [ :char | char = $- or: [ char = $. or: [ char = $: or: [ char = $_ or: [ char isAlphaNumeric ] ] ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 1/26/2010 09:13'!
nameStartChar
"[4] NameStartChar ::= "":"" | [A-Z] | ""_"" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]"
^ PPPredicateParser on: [ :char | char = $: or: [ char = $_ or: [ char isLetter ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:15'!
nameToken
"[5] Name ::= NameStartChar (NameChar)*"
^ (nameStartChar , nameChar star) flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 10:41'!
nameTokens
"[6] Names ::= Name (#x20 Name)*"
^ (nameToken separatedBy: $ asParser) flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:17'!
nmToken
"[7] Nmtoken ::= (NameChar)+"
^ nameChar plus flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:17'!
nmTokens
"[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*"
^ (nmToken separatedBy: $ asParser) flatten! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:52'!
parserForAttribute: aNameParser value: aValueParser
"Answer a parser that can read an XML attribute."
^ aNameParser asParser token , whitespace optional , $= asParser , whitespace optional , $" asParser , aValueParser asParser , $" asParser
==> [ :nodes | Array with: nodes first with: nodes sixth ]! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:53'!
parserForDocument: aPrologParser element: anElementParser
"Answer a parser that can read an XML document."
^ aPrologParser asParser , anElementParser asParser , misc
==> [ :nodes | Array with: nodes first with: nodes second ]! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:49'!
parserForProcessingInstruction: aTargetParser
"Answer a parser that can read an XML processing instruction."
^ '' asParser , aTargetParser asParser token , (whitespace , ('?>' asParser not , #any asParser) star token) optional , '?>' asParser
==> [ :nodes | Array with: nodes second with: (nodes third ifNotNil: [ :inner | inner second ]) ]! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 09:28'!
parserForTag: aNameParser attributes: anAttributeParser
"Answer a parser that can read empty XML tags."
^ self parserForTag: aNameParser attributes: anAttributeParser content: nil! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:59'!
parserForTag: aNameParser attributes: anAttributeParser content: aContentParser
"Answer a parser that can read the XML tags."
^ aContentParser isNil
ifTrue: [
$< asParser , aNameParser asParser token , anAttributeParser asParser , whitespace optional , '/>' asParser
==> [ :nodes | Array with: nodes second with: nodes third with: nil ] ]
ifFalse: [
$< asParser , aNameParser asParser token , anAttributeParser asParser , whitespace optional , $> asParser , aContentParser asParser ,
[ :stream | stream position ] asParser , '' asParser , aNameParser asParser token , whitespace optional , $> asParser
==> [ :nodes |
nodes second = nodes ninth
ifTrue: [ Array with: nodes second with: nodes third with: nodes sixth ]
ifFalse: [ PPFailure reason: 'Expected ' , nodes second value , '> but got ' , nodes ninth value , '>' at: nodes seventh ] ] ]! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 10:36'!
processing
"[16] PI ::= '' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
[17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))"
^ self parserForProcessingInstruction: #letter asParser plus! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 12:44'!
prolog
"[22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?"
^ (self parserForProcessingInstruction: 'xml') optional , misc
==> [ :nodes | nodes first ]! !
!PPXmlGrammar methodsFor: 'accessing' stamp: 'lr 1/26/2010 09:25'!
start
^ document end! !
!PPXmlGrammar methodsFor: 'accessing' stamp: 'lr 1/26/2010 11:45'!
tokenParser
^ PPXmlTokenParser! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 08:46'!
whitespace
"[3] S ::= (#x20 | #x9 | #xD | #xA)+"
^ #space asParser plus! !
TestResource subclass: #PPXmlResource
instanceVariableNames: 'parsers'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:55'!
allXsdDefinitions
^ (self class organization listAtCategoryNamed: #'accessing-xsd')
collect: [ :each | self perform: each ]! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
elementFormXsd
^ '
-->
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
elementReferencesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
externalAttributesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
forwardRefXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:52'!
getBalanceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
groupXsd
^ '
A price is any one of the following:
* Full Price (with amount)
* Sale Price (with amount and authorization)
* Clearance Price (with amount and authorization)
* Free (with authorization)
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
importAuxXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
importBaseXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:50'!
includeWithNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:50'!
includeWithoutNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
listXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
mixedContentXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
notationXsd
^ '
Location of the corporate logo.
Location of the corporate mascot.
'! !
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 1/26/2010 10:42'!
parserAt: aClass
^ aClass new "parsers
at: aClass name
ifAbsentPut: [ aClass new ]"! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
restrictionXsd
^ '
'! !
!PPXmlResource methodsFor: 'running' stamp: 'lr 1/7/2010 13:39'!
setUp
super setUp.
parsers := Dictionary new! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
simpleContentExtensionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
subgroupXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
unionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
unqualifiedTypesXsd
^ '
'! !
PPFlattenParser subclass: #PPXmlTokenParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlTokenParser methodsFor: 'hooks' stamp: 'lr 1/26/2010 11:44'!
create: aCollection start: aStartInteger stop: aStopInteger
^ PPToken on: aCollection start: aStartInteger stop: aStopInteger! !
TestCase subclass: #PPXmlTest
instanceVariableNames: 'result'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
PPXmlTest subclass: #PPXmlGrammarTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'TestRunner 1/7/2010 14:03'!
parserClass
^ PPXmlGrammar! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:48'!
testParseAll
self resource allXsdDefinitions
do: [ :each | self parse: each ]! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:55'!
testParseComment
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:56'!
testParseCommentWithXml
self parse: ' -->' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 12:40'!
testParseComplicated
self parse: '
' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:56'!
testParseEmptyElement
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:48'!
testParseSimple
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 11:00'!
testParseSimpleAttribute
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:57'!
testParseWithWhitsepaceAfterProlog
self parse: '
' ! !
!PPXmlTest class methodsFor: 'testing' stamp: 'lr 1/7/2010 14:01'!
isAbstract
^ self name ~= #PPXmlGrammarTest! !
!PPXmlTest class methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:40'!
packageNamesUnderTest
^ #('PetitXml')! !
!PPXmlTest class methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:41'!
resources
^ Array with: PPXmlResource! !
!PPXmlTest methodsFor: 'parsing' stamp: 'TestRunner 1/7/2010 14:42'!
parse: aString
self parse: aString rule: #start! !
!PPXmlTest methodsFor: 'parsing' stamp: 'lr 1/7/2010 13:41'!
parse: aString rule: aSymbol
| production |
production := self parser.
aSymbol = #start
ifFalse: [ production := production instVarNamed: aSymbol ].
result := production end
parse: aString asParserStream.
self
deny: result isFailure
description: 'Unable to parse ' , aString printString! !
!PPXmlTest methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:56'!
parser
^ self resource parserAt: self parserClass! !
!PPXmlTest methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:41'!
parserClass
self subclassResponsibility! !
!PPXmlTest methodsFor: 'accessing' stamp: 'TestRunner 1/7/2010 14:03'!
resource
^ PPXmlResource current! !