[squeak-dev] Squeak 4.6: XML-Parser-bf.37.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Jun 5 20:16:51 UTC 2015
Chris Muller uploaded a new version of XML-Parser to project Squeak 4.6:
http://source.squeak.org/squeak46/XML-Parser-bf.37.mcz
==================== Summary ====================
Name: XML-Parser-bf.37
Author: bf
Time: 8 December 2014, 2:16:57.135 am
UUID: 47f3a2f8-de17-43b8-96f8-beef7a7c8200
Ancestors: XML-Parser-fbs.36
Restore timestamps lost in assignment conversion.
==================== Snapshot ====================
SystemOrganization addCategory: #'XML-Parser'!
----- Method: String>>applyLanguageInfomation: (in category '*xml-parser') -----
applyLanguageInfomation: languageEnvironment
| leadingChar |
leadingChar := languageEnvironment leadingChar.
self withIndexDo: [:each :idx |
each asciiValue > 255
ifTrue: [self at: idx put: (Character leadingChar: leadingChar code: each asUnicode)]]!
Error subclass: #SAXException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
SAXException subclass: #SAXMalformedException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
SAXException subclass: #SAXParseException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
Error subclass: #XMLException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
XMLException subclass: #XMLInvalidException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
XMLException subclass: #XMLMalformedException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
XMLException subclass: #XMLWarningException
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
Object subclass: #DTDEntityDeclaration
instanceVariableNames: 'name value ndata'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
DTDEntityDeclaration class
instanceVariableNames: 'contextBehavior'!
DTDEntityDeclaration class
instanceVariableNames: 'contextBehavior'!
----- Method: DTDEntityDeclaration class>>behaviorForContext: (in category 'accessing') -----
behaviorForContext: aContext
^self contextBehavior at: aContext!
----- Method: DTDEntityDeclaration class>>contextBehavior (in category 'accessing') -----
contextBehavior
^contextBehavior!
----- Method: DTDEntityDeclaration class>>initialize (in category 'class initialization') -----
initialize
"DTDEntityDeclaration initialize"
contextBehavior := Dictionary new.
contextBehavior
at: #content put: #include ;
at: #attributeValueContent put: #includedInLiteral ;
at: #attributeValue put: #forbidden ;
at: #entityValue put: #bypass ;
at: #dtd put: #forbidden !
----- Method: DTDEntityDeclaration class>>leadIn (in category 'accessing') -----
leadIn
^'&'!
----- Method: DTDEntityDeclaration class>>name:value: (in category 'instance creation') -----
name: aString value: aValueString
^self new
name: aString;
value: aValueString!
----- Method: DTDEntityDeclaration>>bypass (in category 'behaviors') -----
bypass
"Return my reference as is."
^self reference!
----- Method: DTDEntityDeclaration>>forbidden (in category 'behaviors') -----
forbidden
self error: 'Forbidden reference usage'!
----- Method: DTDEntityDeclaration>>include (in category 'behaviors') -----
include
"Return my expanded value."
^value ifNil: [SAXWarning signal: 'XML undefined entity ' , name printString]!
----- Method: DTDEntityDeclaration>>includedInLiteral (in category 'behaviors') -----
includedInLiteral
"Return my expanded value."
^self include!
----- Method: DTDEntityDeclaration>>name (in category 'accessing') -----
name
^name!
----- Method: DTDEntityDeclaration>>name: (in category 'accessing') -----
name: aString
name := aString asSymbol!
----- Method: DTDEntityDeclaration>>ndata (in category 'accessing') -----
ndata
^ndata!
----- Method: DTDEntityDeclaration>>ndata: (in category 'accessing') -----
ndata: aString
ndata := aString!
----- Method: DTDEntityDeclaration>>reference (in category 'behaviors') -----
reference
"Return my reference as is."
^self class leadIn , self name , ';'!
----- Method: DTDEntityDeclaration>>registerIn: (in category 'invocation') -----
registerIn: aParser
aParser entity: self name put: self!
----- Method: DTDEntityDeclaration>>value (in category 'accessing') -----
value
^value!
----- Method: DTDEntityDeclaration>>value: (in category 'accessing') -----
value: aString
value := aString!
----- Method: DTDEntityDeclaration>>valueForContext: (in category 'invocation') -----
valueForContext: aContext
^self perform: (self class behaviorForContext: aContext)!
DTDEntityDeclaration subclass: #DTDExternalEntityDeclaration
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: DTDExternalEntityDeclaration class>>initialize (in category 'class initialization') -----
initialize
"DTDExternalEntityDeclaration initialize"
contextBehavior := Dictionary new.
contextBehavior
at: #content put: #include ;
at: #attributeValueContent put: #includedInLiteral ;
at: #attributeValue put: #forbidden ;
at: #entityValue put: #bypass ;
at: #dtd put: #forbidden !
DTDEntityDeclaration subclass: #DTDParameterEntityDeclaration
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: DTDParameterEntityDeclaration class>>initialize (in category 'class initialization') -----
initialize
"DTDParameterEntityDeclaration initialize"
contextBehavior := Dictionary new.
contextBehavior
at: #content put: #notRecognized: ;
at: #attributeValueContent put: #notRecognized: ;
at: #attributeValue put: #notRecognized: ;
at: #entityValue put: #include: ;
at: #dtd put: #includePE:!
----- Method: DTDParameterEntityDeclaration class>>leadIn (in category 'accessing') -----
leadIn
^'%'!
----- Method: DTDParameterEntityDeclaration>>includePE (in category 'behaviors') -----
includePE
"Return my expanded value."
^self include!
----- Method: DTDParameterEntityDeclaration>>notRecognized (in category 'behaviors') -----
notRecognized
SAXMalformedException signal: 'Malformed entity.'!
----- Method: DTDParameterEntityDeclaration>>registerIn: (in category 'invocation') -----
registerIn: aParser
aParser parameterEntity: self name put: self!
Object subclass: #SAXHandler
instanceVariableNames: 'document driver eod'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: SAXHandler class>>on: (in category 'instance creation') -----
on: aStream
| driver parser |
driver := SAXDriver on: aStream.
driver validating: true.
parser := self new driver: driver.
^parser!
----- Method: SAXHandler class>>parseDTDFrom: (in category 'instance creation') -----
parseDTDFrom: aStream
| driver parser |
driver := SAXDriver on: aStream.
driver validating: true.
driver startParsingMarkup.
parser := self new driver: driver.
parser startDocument.
parser parseDocument.
^parser!
----- Method: SAXHandler class>>parseDocumentFrom: (in category 'instance creation') -----
parseDocumentFrom: aStream
^self parseDocumentFrom: aStream useNamespaces: false!
----- Method: SAXHandler class>>parseDocumentFrom:useNamespaces: (in category 'instance creation') -----
parseDocumentFrom: aStream useNamespaces: aBoolean
| parser |
parser := self on: aStream.
parser useNamespaces: aBoolean.
parser startDocument.
parser parseDocument.
^parser!
----- Method: SAXHandler class>>parseDocumentFromFileNamed: (in category 'instance creation') -----
parseDocumentFromFileNamed: fileName
^self parseDocumentFromFileNamed: fileName readIntoMemory: false!
----- Method: SAXHandler class>>parseDocumentFromFileNamed:readIntoMemory: (in category 'instance creation') -----
parseDocumentFromFileNamed: fileName readIntoMemory: readIntoMemory
| stream xmlDoc |
stream := FileDirectory default readOnlyFileNamed: fileName.
readIntoMemory
ifTrue: [stream := stream contentsOfEntireFile readStream].
xmlDoc := [self parseDocumentFrom: stream]
ensure: [stream close].
^xmlDoc!
----- Method: SAXHandler class>>parserOnFileNamed: (in category 'instance creation') -----
parserOnFileNamed: fileName
^self parserOnFileNamed: fileName readIntoMemory: false!
----- Method: SAXHandler class>>parserOnFileNamed:readIntoMemory: (in category 'instance creation') -----
parserOnFileNamed: fileName readIntoMemory: readIntoMemory
| stream |
stream := FileDirectory default readOnlyFileNamed: fileName.
readIntoMemory
ifTrue: [stream := stream contentsOfEntireFile readStream].
^self on: stream!
----- Method: SAXHandler>>characters: (in category 'content') -----
characters: aString
"This call corresponds to the Java SAX call
characters(char[] ch, int start, int length)."!
----- Method: SAXHandler>>checkEOD (in category 'content') -----
checkEOD
"Check if the document shouldn't be ended already"
self eod
ifTrue: [self driver errorExpected: 'No more data expected,']!
----- Method: SAXHandler>>comment: (in category 'lexical') -----
comment: commentString
"This call corresponds to the Java SAX ext call
comment(char[] ch, int start, int length)."!
----- Method: SAXHandler>>document (in category 'accessing') -----
document
^document!
----- Method: SAXHandler>>document: (in category 'accessing') -----
document: aDocument
document := aDocument!
----- Method: SAXHandler>>documentAttributes: (in category 'content') -----
documentAttributes: attributeList!
----- Method: SAXHandler>>driver (in category 'accessing') -----
driver
^driver!
----- Method: SAXHandler>>driver: (in category 'accessing') -----
driver: aDriver
driver := aDriver.
driver saxHandler: self!
----- Method: SAXHandler>>endDocument (in category 'content') -----
endDocument
"This call corresponds to the Java SAX call
endDocument()."
eod := true!
----- Method: SAXHandler>>endElement: (in category 'content') -----
endElement: elementName
!
----- Method: SAXHandler>>endElement:namespace:namespaceURI:qualifiedName: (in category 'content') -----
endElement: elementName namespace: namespace namespaceURI: namespaceURI qualifiedName: qualifiedName
"This call corresponds to the Java SAX call
endElement(java.lang.String namespaceURI, java.lang.String localName, java.lang.String qName).
By default this call is mapped to the following more convenient call:"
self endElement: elementName!
----- Method: SAXHandler>>endEntity: (in category 'lexical') -----
endEntity: entityName
"This call corresponds to the Java SAX ext call
endEntity(java.lang.String name)."!
----- Method: SAXHandler>>endPrefixMapping: (in category 'content') -----
endPrefixMapping: prefix
"This call corresonds to the Java SAX call
endPrefixMapping(java.lang.String prefix)."!
----- Method: SAXHandler>>eod (in category 'accessing') -----
eod
^eod!
----- Method: SAXHandler>>ignorableWhitespace: (in category 'content') -----
ignorableWhitespace: aString
"This call corresonds to the Java SAX call
ignorableWhitespace(char[] ch, int start, int length)."!
----- Method: SAXHandler>>initialize (in category 'initialize') -----
initialize
eod := false!
----- Method: SAXHandler>>parseDocument (in category 'parsing') -----
parseDocument
[self driver nextEntity isNil or: [self eod]] whileFalse!
----- Method: SAXHandler>>processingInstruction:data: (in category 'content') -----
processingInstruction: piName data: dataString
"This call corresonds to the Java SAX call
processingInstruction(java.lang.String target, java.lang.String data)."!
----- Method: SAXHandler>>resolveEntity:systemID: (in category 'entity') -----
resolveEntity: publicID systemID: systemID
"This call corresonds to the Java SAX call
resolveEntity(java.lang.String publicId, java.lang.String systemId)."!
----- Method: SAXHandler>>skippedEntity: (in category 'content') -----
skippedEntity: aString
"This call corresonds to the Java SAX call
skippedEntity(java.lang.String name)."!
----- Method: SAXHandler>>startCData (in category 'lexical') -----
startCData
"This call corresponds to the Java SAX ext call
startCData()."!
----- Method: SAXHandler>>startDTD:publicID:systemID: (in category 'lexical') -----
startDTD: declName publicID: publicID systemID: systemID
"This call corresponds to the Java SAX ext call
startDTD(java.lang.String name, java.lang.String publicId, java.lang.String systemId)."!
----- Method: SAXHandler>>startDocument (in category 'content') -----
startDocument
"This call corresonds to the Java SAX call
startDocument()."!
----- Method: SAXHandler>>startElement:attributeList: (in category 'content') -----
startElement: elementName attributeList: attributeList
!
----- Method: SAXHandler>>startElement:namespaceURI:namespace:attributeList: (in category 'content') -----
startElement: localName namespaceURI: namespaceUri namespace: namespace attributeList: attributeList
"This call corresonds to the Java SAX call
startElement(java.lang.String namespaceURI, java.lang.String localName, java.lang.String qName, Attributes atts).
By default this call is mapped to the following more convenient call:"
self startElement: localName attributeList: attributeList!
----- Method: SAXHandler>>startEntity: (in category 'lexical') -----
startEntity: entityName
"This call corresponds to the Java SAX ext call
startEntity(java.lang.String name)."!
----- Method: SAXHandler>>startPrefixMapping:uri: (in category 'content') -----
startPrefixMapping: prefix uri: uri
"This call corresonds to the Java SAX call
startPrefixMapping(java.lang.String prefix, java.lang.String uri)."!
----- Method: SAXHandler>>useNamespaces: (in category 'accessing') -----
useNamespaces: aBoolean
self driver useNamespaces: aBoolean!
SAXHandler subclass: #XMLDOMParser
instanceVariableNames: 'entity stack incremental'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLDOMParser class>>addressBookXMLWithDTD (in category 'examples') -----
addressBookXMLWithDTD
"XMLDOMParser addressBookXMLWithDTD"
^self parseDocumentFrom: XMLTokenizer addressBookXMLWithDTD readStream useNamespaces: true!
----- Method: XMLDOMParser class>>parseDocumentFrom: (in category 'instance creation') -----
parseDocumentFrom: aStream
^self parseDocumentFrom: aStream useNamespaces: false!
----- Method: XMLDOMParser class>>parseDocumentFrom:useNamespaces: (in category 'instance creation') -----
parseDocumentFrom: aStream useNamespaces: aBoolean
^(super parseDocumentFrom: aStream useNamespaces: aBoolean) document!
----- Method: XMLDOMParser>>characters: (in category 'content') -----
characters: aString
| newElement |
newElement := XMLStringNode string: aString.
self top addContent: newElement.
!
----- Method: XMLDOMParser>>defaultNamespace (in category 'private') -----
defaultNamespace
^self top
ifNotNil: [self top namespace]!
----- Method: XMLDOMParser>>documentAttributes: (in category 'content') -----
documentAttributes: attributeList
self document version: (attributeList at: 'version' ifAbsent: [nil]).
self document encoding: (attributeList at: 'encoding' ifAbsent: [nil]).
self document requiredMarkup: (attributeList at: 'requiredMarkup' ifAbsent: [nil]).
!
----- Method: XMLDOMParser>>domDocument (in category 'parsing') -----
domDocument
[self startDocument; parseDocument]
ensure: [self driver stream close].
^document!
----- Method: XMLDOMParser>>endDocument (in category 'content') -----
endDocument
self pop.
super endDocument!
----- Method: XMLDOMParser>>endElement: (in category 'content') -----
endElement: elementName
| currentElement |
currentElement := self pop.
currentElement name = elementName
ifFalse: [self driver errorExpected: 'End tag "', elementName , '" doesn''t match "' , currentElement name , '".']!
----- Method: XMLDOMParser>>endElement:namespace:namespaceURI:qualifiedName: (in category 'content') -----
endElement: localName namespace: namespace namespaceURI: uri qualifiedName: qualifiedName
| currentElement |
currentElement := self pop.
(currentElement namespace isNil
or: [currentElement namespace = self defaultNamespace])
ifTrue: [
currentElement localName = localName
ifFalse: [self driver errorExpected: 'End tag "', localName , '" doesn''t match "' , currentElement localName , '".']]
ifFalse: [
currentElement qualifiedName = qualifiedName
ifFalse: [self driver errorExpected: 'End tag "', qualifiedName , '" doesn''t match "' , currentElement qualifiedName , '".']]!
----- Method: XMLDOMParser>>incremental (in category 'accessing') -----
incremental
^incremental!
----- Method: XMLDOMParser>>incremental: (in category 'accessing') -----
incremental: aBoolean
incremental := aBoolean!
----- Method: XMLDOMParser>>initialize (in category 'initialize') -----
initialize
super initialize.
stack := OrderedCollection new.
incremental := false!
----- Method: XMLDOMParser>>nextEntity (in category 'parsing') -----
nextEntity
| currentTop |
currentTop := self top.
[self driver nextEntity isNil
or: [self top ~~ currentTop]] whileTrue.
^entity!
----- Method: XMLDOMParser>>nextEntityStart (in category 'parsing') -----
nextEntityStart
[self driver nextEntity.
self stack isEmpty] whileTrue.
^entity!
----- Method: XMLDOMParser>>pop (in category 'private') -----
pop
| oldTop |
oldTop := self stack removeLast.
entity := oldTop.
^oldTop!
----- Method: XMLDOMParser>>processingInstruction:data: (in category 'content') -----
processingInstruction: piName data: dataString
| newElement |
newElement := XMLPI target: piName data: dataString.
self top addElement: newElement!
----- Method: XMLDOMParser>>push: (in category 'private') -----
push: anObject
self stack add: anObject.
entity := anObject
!
----- Method: XMLDOMParser>>stack (in category 'private') -----
stack
^stack!
----- Method: XMLDOMParser>>startDocument (in category 'content') -----
startDocument
self document: XMLDocument new.
self push: self document !
----- Method: XMLDOMParser>>startElement:attributeList: (in category 'content') -----
startElement: elementName attributeList: attributeList
| newElement |
newElement := XMLElement named: elementName attributes: attributeList.
self incremental
ifFalse: [self stack isEmpty
ifFalse: [self top addElement: newElement]].
self push: newElement!
----- Method: XMLDOMParser>>startElement:namespaceURI:namespace:attributeList: (in category 'content') -----
startElement: localName namespaceURI: namespaceUri namespace: namespace attributeList: attributeList
| newElement |
"newElement := namespace = self defaultNamespace
ifTrue: [XMLElement named: localName namespace: nil uri: nil attributes: attributeList]
ifFalse: [XMLElement named: localName namespace: namespace uri: namespaceUri attributes: attributeList]."
newElement := XMLElement named: localName namespace: namespace uri: namespaceUri attributes: attributeList.
self incremental
ifFalse: [self stack isEmpty
ifFalse: [self top addElement: newElement]].
self push: newElement!
----- Method: XMLDOMParser>>top (in category 'private') -----
top
^self stack isEmpty
ifTrue: [nil]
ifFalse: [self stack last]!
Object subclass: #XMLNamespaceScope
instanceVariableNames: 'scope currentBindings useNamespaces validateAttributes'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLNamespaceScope>>currentScope (in category 'private') -----
currentScope
^self scope last!
----- Method: XMLNamespaceScope>>declareNamespace:uri: (in category 'scope') -----
declareNamespace: ns uri: uri
"Declare the given name space prefix with the given URL"
ns = 'xmlns'
ifTrue: [^self defaultNamespace: uri].
self establishLocalBindings.
currentBindings removeKey: ns ifAbsent: [].
currentBindings at: ns put: uri!
----- Method: XMLNamespaceScope>>defaultNamespace (in category 'accessing') -----
defaultNamespace
^self currentScope first!
----- Method: XMLNamespaceScope>>defaultNamespace: (in category 'accessing') -----
defaultNamespace: ns
"Declare the default namespace."
self currentScope at: 1 put: ns!
----- Method: XMLNamespaceScope>>enterScope (in category 'scope') -----
enterScope
self scope addLast: { self defaultNamespace. nil. currentBindings. }!
----- Method: XMLNamespaceScope>>establishLocalBindings (in category 'private') -----
establishLocalBindings
(self currentScope at: 2)
ifNil: [
currentBindings := currentBindings copy.
self currentScope at: 2 put: currentBindings]!
----- Method: XMLNamespaceScope>>initScope (in category 'private') -----
initScope
scope := OrderedCollection new: 20.
currentBindings := Dictionary new.
scope addLast: {'http://www.w3.org/TR/REC-xml-names'. currentBindings. nil. }.
!
----- Method: XMLNamespaceScope>>leaveScope (in category 'scope') -----
leaveScope
| leftScope |
leftScope := self scope removeLast.
currentBindings := (self currentScope at: 2) ifNil: [leftScope at: 3]!
----- Method: XMLNamespaceScope>>namespaceAliases: (in category 'private') -----
namespaceAliases: namespace
"Locate all namespaces that are aliases of the given URI."
| aliases uri |
aliases := Set new.
uri := self namespaceURIOf: namespace ifAbsent: [self parseError: 'Attribute refers to undefined namespace ' , namespace asString ].
currentBindings keysAndValuesDo: [:ns :u |
(u = uri
and: [ns ~= namespace])
ifTrue: [aliases add: ns]].
^ aliases!
----- Method: XMLNamespaceScope>>namespaceURIOf: (in category 'accessing') -----
namespaceURIOf: ns
"Retrieve the URI of the given namespace prefix, if it is defined. A nil namespace
returns the global namespace"
^ self namespaceURIOf: ns ifAbsent: [ nil ]!
----- Method: XMLNamespaceScope>>namespaceURIOf:ifAbsent: (in category 'accessing') -----
namespaceURIOf: ns ifAbsent: aBlock
"Retrieve the URI of the given namespace prefix, if it is defined.
A nil namespace returns the default namespace.
If no namespace can be found the value of the block is returned"
^ns
ifNil: [self defaultNamespace]
ifNotNil: [currentBindings at: ns ifAbsent: aBlock]!
----- Method: XMLNamespaceScope>>namespaces (in category 'accessing') -----
namespaces
^currentBindings!
----- Method: XMLNamespaceScope>>scope (in category 'private') -----
scope
scope ifNil: [self initScope].
^scope!
----- Method: XMLNamespaceScope>>validateAttributes: (in category 'validation') -----
validateAttributes: attributeList
"check all attribute namespaces are defined and not duplicated by aliasing"
attributeList keysDo: [:attrName |
| namespace localName |
self splitName: attrName into: [:ns :ln |
namespace := ns.
localName := ln].
namespace ifNotNil: [
(self namespaceAliases: namespace) do: [:alias |
(attributeList includesKey: alias , ':' , localName)
ifTrue: [self parseError: 'Attributes ' , attrName , ' and ' , alias , ':' , localName , ' are aliased to namespace ' , (self namespaceURIOf: namespace) ]]]]!
Object subclass: #XMLNode
instanceVariableNames: ''
classVariableNames: 'CanonicalTable'
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLNode>>addContent: (in category 'accessing') -----
addContent: contentString
SAXParseException signal: 'Illegal string data.'!
----- Method: XMLNode>>contentsDo: (in category 'enumerating') -----
contentsDo: aBlock!
----- Method: XMLNode>>elementsAndContentsDo: (in category 'enumerating') -----
elementsAndContentsDo: aBlock
self elementsDo: aBlock!
----- Method: XMLNode>>elementsDo: (in category 'enumerating') -----
elementsDo: aBlock!
----- Method: XMLNode>>firstTagNamed: (in category 'searching') -----
firstTagNamed: aSymbol
"Return the first encountered node with the specified tag. Pass the message on"
self elementsDo: [:node |
| answer |
(answer := node firstTagNamed: aSymbol) ifNotNil: [^answer]].
^nil!
----- Method: XMLNode>>firstTagNamed:with: (in category 'searching') -----
firstTagNamed: aSymbol with: aBlock
"Return the first encountered node with the specified tag that
allows the block to evaluate to true. Pass the message on"
self elementsDo: [:node |
| answer |
(answer := node firstTagNamed: aSymbol with: aBlock) ifNotNil: [^answer]].
^nil!
----- Method: XMLNode>>isProcessingInstruction (in category 'testing') -----
isProcessingInstruction
^false!
----- Method: XMLNode>>isTag (in category 'testing') -----
isTag
^false!
----- Method: XMLNode>>isText (in category 'testing') -----
isText
^false!
----- Method: XMLNode>>printOn: (in category 'printing') -----
printOn: stream
self printXMLOn: (XMLWriter on: stream)!
----- Method: XMLNode>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
self subclassResponsibility!
----- Method: XMLNode>>tagsNamed:childrenDo: (in category 'searching') -----
tagsNamed: aSymbol childrenDo: aOneArgumentBlock
"Evaluate aOneArgumentBlock for all children who match"
self elementsDo: [:each |
each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]!
----- Method: XMLNode>>tagsNamed:childrenDoAndRecurse: (in category 'searching') -----
tagsNamed: aSymbol childrenDoAndRecurse: aOneArgumentBlock
"Evaluate aOneArgumentBlock for all children who match and recurse"
self elementsDo: [:each |
each tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock]!
----- Method: XMLNode>>tagsNamed:contentsDo: (in category 'searching') -----
tagsNamed: aSymbol contentsDo: aBlock
"Evaluate aBlock for all of the contents of the receiver.
The receiver has no tag, so pass the message on"
self elementsDo: [:each | each tagsNamed: aSymbol contentsDo: aBlock]!
----- Method: XMLNode>>tagsNamed:do: (in category 'searching') -----
tagsNamed: aSymbol do: aOneArgumentBlock
"Search for nodes with tag aSymbol. When encountered evaluate aOneArgumentBlock"
self elementsDo: [:each | each tagsNamed: aSymbol do: aOneArgumentBlock]!
----- Method: XMLNode>>tagsNamed:ifReceiverDo: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock
"Handled only by XMLElement subclass"
!
----- Method: XMLNode>>tagsNamed:ifReceiverDoAndRecurse: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock
"Recurse all children"
self elementsDo: [:each | each tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock]!
----- Method: XMLNode>>tagsNamed:ifReceiverOrChildDo: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverOrChildDo: aOneArgumentBlock
"Recurse all children"
self elementsDo: [:each | each tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock]!
XMLNode subclass: #XMLNodeWithElements
instanceVariableNames: 'elementsAndContents uri namespace parent'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
XMLNodeWithElements subclass: #XMLDocument
instanceVariableNames: 'dtd version encoding requiredMarkup'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLDocument>>dtd (in category 'accessing') -----
dtd
^dtd!
----- Method: XMLDocument>>dtd: (in category 'accessing') -----
dtd: aDTD
dtd := aDTD!
----- Method: XMLDocument>>encoding (in category 'accessing') -----
encoding
^encoding ifNil: ['UTF-8']!
----- Method: XMLDocument>>encoding: (in category 'accessing') -----
encoding: aString
encoding := aString!
----- Method: XMLDocument>>printCanonicalOn: (in category 'printing') -----
printCanonicalOn: aStream
| writer |
writer := XMLWriter on: aStream.
writer canonical: true.
self printXMLOn: writer!
----- Method: XMLDocument>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
version ifNotNil: [writer xmlDeclaration: self version encoding: self encoding].
super printXMLOn: writer!
----- Method: XMLDocument>>requiredMarkup (in category 'accessing') -----
requiredMarkup
^requiredMarkup!
----- Method: XMLDocument>>requiredMarkup: (in category 'accessing') -----
requiredMarkup: aString
requiredMarkup := aString!
----- Method: XMLDocument>>root (in category 'accessing') -----
root
"return my root element"
^ self topElement !
----- Method: XMLDocument>>version (in category 'accessing') -----
version
^version!
----- Method: XMLDocument>>version: (in category 'accessing') -----
version: aString
version := aString!
XMLNodeWithElements subclass: #XMLElement
instanceVariableNames: 'name attributes'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLElement class>>named: (in category 'instance creation') -----
named: aString
^self new name: aString!
----- Method: XMLElement class>>named:attributes: (in category 'instance creation') -----
named: aString attributes: attributeList
^self new
name: aString;
setAttributes: attributeList!
----- Method: XMLElement class>>named:namespace:uri:attributes: (in category 'instance creation') -----
named: aString namespace: ns uri: uri attributes: attributeList
^self new
name: aString;
namespace: ns uri: uri;
setAttributes: attributeList!
----- Method: XMLElement>>@ (in category 'accessing') -----
@ aSymbol
"shorthand form"
^ self at: aSymbol !
----- Method: XMLElement>>addContent: (in category 'initialize') -----
addContent: contentString
self addElement: contentString!
----- Method: XMLElement>>allAttributes (in category 'accessing') -----
allAttributes
^ self attributes asOrderedCollection!
----- Method: XMLElement>>at: (in category 'accessing') -----
at: aSymbol
^ self attributeAt: aSymbol ifAbsent: ['']
!
----- Method: XMLElement>>attributeAt: (in category 'accessing') -----
attributeAt: attributeName
^self attributeAt: attributeName ifAbsent: [nil]!
----- Method: XMLElement>>attributeAt:ifAbsent: (in category 'accessing') -----
attributeAt: attributeName ifAbsent: aBlock
^self attributes at: attributeName ifAbsent: [^aBlock value]!
----- Method: XMLElement>>attributeAt:put: (in category 'accessing') -----
attributeAt: attributeName put: attributeValue
self attributes at: attributeName asSymbol put: attributeValue!
----- Method: XMLElement>>attributes (in category 'accessing') -----
attributes
^attributes ifNil: [attributes := Dictionary new]!
----- Method: XMLElement>>characterData (in category 'accessing') -----
characterData
^self contentString!
----- Method: XMLElement>>contentString (in category 'accessing') -----
contentString
| contentElements |
contentElements := self elementsAndContents.
^(contentElements size > 0
and: [contentElements first isText])
ifTrue: [contentElements first string]
ifFalse: ['']!
----- Method: XMLElement>>contentStringAt: (in category 'accessing') -----
contentStringAt: entityName
^(self elementAt: entityName ifAbsent: [^'']) contentString!
----- Method: XMLElement>>contents (in category 'accessing') -----
contents
^self elementsAndContents select: [:each | each isText]!
----- Method: XMLElement>>contentsDo: (in category 'enumerating') -----
contentsDo: aBlock
self elementsAndContentsDo: [:each | each isText ifTrue: [aBlock value: each]]!
----- Method: XMLElement>>elements (in category 'accessing') -----
elements
^self elementsAndContents select: [:each | each isText not]!
----- Method: XMLElement>>elementsAndContentsDo: (in category 'enumerating') -----
elementsAndContentsDo: aBlock
self elementsAndContents do: aBlock!
----- Method: XMLElement>>elementsDo: (in category 'enumerating') -----
elementsDo: aBlock
self elementsAndContentsDo: [:each | each isText ifFalse: [aBlock value: each]]!
----- Method: XMLElement>>firstTagNamed: (in category 'searching') -----
firstTagNamed: aSymbol
"Return the first encountered node with the specified tag.
If it is not the receiver, pass the message on"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [^self].
^super firstTagNamed: aSymbol !
----- Method: XMLElement>>firstTagNamed:with: (in category 'searching') -----
firstTagNamed: aSymbol with: aBlock
"Return the first encountered node with the specified tag that allows
the block to evaluate to true. Pass the message on"
((self localName == aSymbol
or: [self tag == aSymbol])
and: [aBlock value: self])
ifTrue: [^self].
^super firstTagNamed: aSymbol with: aBlock.!
----- Method: XMLElement>>isEmpty (in category 'testing') -----
isEmpty
"Answer true if the receiver is empty"
^self elementsAndContents isEmpty!
----- Method: XMLElement>>isTag (in category 'testing') -----
isTag
^true!
----- Method: XMLElement>>localName (in category 'name space') -----
localName
^ name!
----- Method: XMLElement>>name (in category 'accessing') -----
name
^ self qualifiedName!
----- Method: XMLElement>>name: (in category 'initialize') -----
name: aString
name := aString asSymbol!
----- Method: XMLElement>>parent (in category 'accessing') -----
parent
^ parent!
----- Method: XMLElement>>parent: (in category 'accessing') -----
parent: anXMLElement
parent := anXMLElement !
----- Method: XMLElement>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
"Print the receiver in XML form"
writer startElement: self name attributeList: self attributes.
(writer canonical not
and: [self isEmpty])
ifTrue: [writer endEmptyTag: self name]
ifFalse: [
writer endTag.
self elementsAndContentsDo: [:content | content printXMLOn: writer].
writer endTag: self name]!
----- Method: XMLElement>>qualifiedName (in category 'name space') -----
qualifiedName
^self namespace
ifNil: [self localName]
ifNotNil: [self namespace , ':' , self localName]!
----- Method: XMLElement>>setAttributes: (in category 'initialize') -----
setAttributes: newAttributes
attributes := newAttributes!
----- Method: XMLElement>>tag (in category 'accessing') -----
tag
^ self name asSymbol!
----- Method: XMLElement>>tagsNamed:contentsDo: (in category 'searching') -----
tagsNamed: aSymbol contentsDo: aBlock
"Evaluate aBlock for all of the contents of the receiver
if the receiver tag equals aSymbol. Pass the message on"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [self contentsDo: aBlock].
super tagsNamed: aSymbol contentsDo: aBlock!
----- Method: XMLElement>>tagsNamed:do: (in category 'searching') -----
tagsNamed: aSymbol do: aOneArgumentBlock
"If the receiver tag equals aSymbol, evaluate aOneArgumentBlock
with the receiver. Continue the search"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [aOneArgumentBlock value: self].
super tagsNamed: aSymbol do: aOneArgumentBlock!
----- Method: XMLElement>>tagsNamed:ifReceiverDo: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock
"If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [aOneArgumentBlock value: self]
!
----- Method: XMLElement>>tagsNamed:ifReceiverDoAndRecurse: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock
"If the receiver tag equals aSymbol, evaluate aOneArgumentBlock
with the receiver. Then recurse through all the children"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [aOneArgumentBlock value: self].
super tagsNamed: aSymbol ifReceiverDoAndRecurse: aOneArgumentBlock!
----- Method: XMLElement>>tagsNamed:ifReceiverOrChildDo: (in category 'searching') -----
tagsNamed: aSymbol ifReceiverOrChildDo: aOneArgumentBlock
"If the receiver tag equals aSymbol, evaluate aOneArgumentBlock with the receiver.
For each of the receivers children do the same. Do not go beyond direct children"
(self localName == aSymbol
or: [self tag == aSymbol])
ifTrue: [aOneArgumentBlock value: self].
super tagsNamed: aSymbol ifReceiverDo: aOneArgumentBlock!
----- Method: XMLElement>>valueFor: (in category 'accessing') -----
valueFor: aSymbol
^self valueFor: aSymbol ifAbsent: ['']!
----- Method: XMLElement>>valueFor:ifAbsent: (in category 'accessing') -----
valueFor: aSymbol ifAbsent: aBlock
^self attributes at: aSymbol ifAbsent: aBlock!
----- Method: XMLNodeWithElements>>addElement: (in category 'accessing') -----
addElement: element
self elementsAndContents add: element!
----- Method: XMLNodeWithElements>>addEntity:value: (in category 'accessing') -----
addEntity: entityName value: entityValue
self entities add: entityName->entityValue!
----- Method: XMLNodeWithElements>>elementAt: (in category 'accessing') -----
elementAt: entityName
^self elementAt: entityName ifAbsent: [nil]!
----- Method: XMLNodeWithElements>>elementAt:ifAbsent: (in category 'accessing') -----
elementAt: entityName ifAbsent: aBlock
elementsAndContents
ifNil: [^aBlock value].
^self elements detect: [:each | each isProcessingInstruction not and: [each name = entityName or: [each localName = entityName]]] ifNone: [^aBlock value]!
----- Method: XMLNodeWithElements>>elementUnqualifiedAt: (in category 'accessing') -----
elementUnqualifiedAt: entityName
^self elementUnqualifiedAt: entityName ifAbsent: [nil]!
----- Method: XMLNodeWithElements>>elementUnqualifiedAt:ifAbsent: (in category 'accessing') -----
elementUnqualifiedAt: entityName ifAbsent: aBlock
elementsAndContents
ifNil: [^aBlock value].
^self elements detect: [:each | each localName = entityName] ifNone: [^aBlock value]!
----- Method: XMLNodeWithElements>>elements (in category 'accessing') -----
elements
^self elementsAndContents!
----- Method: XMLNodeWithElements>>elementsAndContents (in category 'accessing') -----
elementsAndContents
elementsAndContents ifNil: [elementsAndContents := OrderedCollection new].
^elementsAndContents!
----- Method: XMLNodeWithElements>>elementsDo: (in category 'enumerating') -----
elementsDo: aBlock
self elements do: aBlock!
----- Method: XMLNodeWithElements>>namespace (in category 'name space') -----
namespace
^ namespace!
----- Method: XMLNodeWithElements>>namespace:uri: (in category 'name space') -----
namespace: ns uri: u
namespace := ns.
uri := u!
----- Method: XMLNodeWithElements>>namespaceURI (in category 'name space') -----
namespaceURI
^ uri!
----- Method: XMLNodeWithElements>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
self elementsDo: [:element | element printXMLOn: writer]!
----- Method: XMLNodeWithElements>>removeElement: (in category 'accessing') -----
removeElement: element
"Used to purge certain elements from a document after parsing."
self elementsAndContents remove: element ifAbsent: []!
----- Method: XMLNodeWithElements>>topElement (in category 'accessing') -----
topElement
^self elements first!
XMLNode subclass: #XMLPI
instanceVariableNames: 'target data'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLPI class>>target:data: (in category 'instance creation') -----
target: targetName data: aString
^self new
target: targetName;
data: aString!
----- Method: XMLPI>>data (in category 'accessing') -----
data
^data!
----- Method: XMLPI>>data: (in category 'accessing') -----
data: aString
data := aString!
----- Method: XMLPI>>isProcessingInstruction (in category 'testing') -----
isProcessingInstruction
^true!
----- Method: XMLPI>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
writer pi: self target data: self data!
----- Method: XMLPI>>target (in category 'accessing') -----
target
^target!
----- Method: XMLPI>>target: (in category 'accessing') -----
target: aString
target := aString!
XMLNode subclass: #XMLStringNode
instanceVariableNames: 'string'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLStringNode class>>string: (in category 'instance creation') -----
string: aString
^self new string: aString!
----- Method: XMLStringNode>>characterData (in category 'accessing') -----
characterData
^self string!
----- Method: XMLStringNode>>isText (in category 'testing') -----
isText
^true!
----- Method: XMLStringNode>>printXMLOn: (in category 'printing') -----
printXMLOn: writer
writer pcData: self string!
----- Method: XMLStringNode>>string (in category 'accessing') -----
string
^string ifNil: ['']!
----- Method: XMLStringNode>>string: (in category 'accessing') -----
string: aString
string := aString!
Object subclass: #XMLTokenizer
instanceVariableNames: 'stream nestedStreams entities externalEntities parameterEntities parsingMarkup markedPosition peekChar validating nameBuffer attributeBuffer'
classVariableNames: 'CharEscapes DigitTable LiteralChars NameDelimiters SeparatorTable'
poolDictionaries: ''
category: 'XML-Parser'!
!XMLTokenizer commentStamp: '<historical>' prior: 0!
XMLTokenizer
bolot at cc.gatech.edu
breaks the stream of characters into a stream of XMLnodes (aka token stream)
token stream is used by XMLparser to generate XMLdocument tree!
XMLTokenizer subclass: #SAXDriver
instanceVariableNames: 'saxHandler scope useNamespaces validateAttributes languageEnvironment'
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: SAXDriver>>handleCData: (in category 'handling tokens') -----
handleCData: aString
self saxHandler
checkEOD;
characters: aString!
----- Method: SAXDriver>>handleComment: (in category 'handling tokens') -----
handleComment: aString
self saxHandler
checkEOD;
comment: aString!
----- Method: SAXDriver>>handleEndDocument (in category 'handling tokens') -----
handleEndDocument
self saxHandler endDocument!
----- Method: SAXDriver>>handleEndTag: (in category 'handling tokens') -----
handleEndTag: elementName
| namespace localName namespaceURI qualifiedName |
self usesNamespaces
ifTrue: [
self splitName: elementName into: [:ns :ln |
namespace := ns.
localName := ln].
"ensure our namespace is defined"
namespace
ifNil: [
namespace := self scope defaultNamespace.
qualifiedName := namespace , ':' , elementName]
ifNotNil: [
namespaceURI := self scope namespaceURIOf: namespace.
namespaceURI
ifNil: [self parseError: 'Start tag ' , elementName , ' refers to undefined namespace ' , namespace asString].
qualifiedName := elementName].
"call the handler"
self saxHandler
checkEOD;
endElement: localName namespace: namespace namespaceURI: namespaceURI qualifiedName: qualifiedName.
self scope leaveScope]
ifFalse: [
"call the handler"
self saxHandler
checkEOD;
endElement: elementName namespace: nil namespaceURI: nil qualifiedName: elementName]!
----- Method: SAXDriver>>handlePCData: (in category 'handling tokens') -----
handlePCData: aString
self languageEnvironment
ifNotNil: [aString applyLanguageInfomation: self languageEnvironment].
self saxHandler
checkEOD;
characters: aString!
----- Method: SAXDriver>>handlePI:data: (in category 'handling tokens') -----
handlePI: piTarget data: piData
self saxHandler
checkEOD;
processingInstruction: piTarget data: piData!
----- Method: SAXDriver>>handleStartDocument (in category 'handling tokens') -----
handleStartDocument
self saxHandler startDocument!
----- Method: SAXDriver>>handleStartTag:attributes:namespaces: (in category 'handling tokens') -----
handleStartTag: elementName attributes: attributeList namespaces: namespaces
| localName namespace namespaceURI |
(attributeList includesKey: 'xml:lang')
ifTrue: [languageEnvironment := LanguageEnvironment localeID: (LocaleID isoString: (attributeList at: 'xml:lang'))].
self usesNamespaces
ifTrue: [
self scope enterScope.
"declare any namespaces"
namespaces keysAndValuesDo: [:ns :uri |
self scope declareNamespace: ns uri: uri].
self splitName: elementName into: [:ns :ln |
namespace := ns.
localName := ln].
"ensure our namespace is defined"
namespace
ifNil: [namespace := self scope defaultNamespace]
ifNotNil: [
namespaceURI := self scope namespaceURIOf: namespace.
namespaceURI
ifNil: [self parseError: 'Start tag ' , elementName , ' refers to undefined namespace ' , namespace asString]].
self validatesAttributes
ifTrue: [self scope validateAttributes: attributeList].
"call the handler"
self saxHandler
checkEOD;
startElement: localName namespaceURI: namespaceURI namespace: namespace attributeList: attributeList]
ifFalse: [
"call the handler"
self saxHandler
checkEOD;
startElement: elementName namespaceURI: nil namespace: nil attributeList: attributeList]!
----- Method: SAXDriver>>handleWhitespace: (in category 'handling tokens') -----
handleWhitespace: aString
self saxHandler
checkEOD;
ignorableWhitespace: aString!
----- Method: SAXDriver>>handleXMLDecl:namespaces: (in category 'handling tokens') -----
handleXMLDecl: attributes namespaces: namespaces
self saxHandler
checkEOD;
documentAttributes: attributes.
self usesNamespaces
ifTrue: [
namespaces keysAndValuesDo: [:ns :uri |
self scope declareNamespace: ns uri: uri]]!
----- Method: SAXDriver>>initialize (in category 'initialization') -----
initialize
super initialize.
useNamespaces := false.
validateAttributes := false!
----- Method: SAXDriver>>languageEnvironment (in category 'accessing') -----
languageEnvironment
^languageEnvironment!
----- Method: SAXDriver>>saxHandler (in category 'accessing') -----
saxHandler
^saxHandler!
----- Method: SAXDriver>>saxHandler: (in category 'accessing') -----
saxHandler: aHandler
saxHandler := aHandler!
----- Method: SAXDriver>>scope (in category 'namespaces') -----
scope
scope ifNil: [scope := XMLNamespaceScope new].
^scope!
----- Method: SAXDriver>>splitName:into: (in category 'namespaces') -----
splitName: aName into: twoArgsBlock
"Split the name into namespace and local name (the block arguments).
Handle both qualified and unqualified names using the default name space"
| i ns ln |
i := aName lastIndexOf: $:.
i = 0
ifTrue: [
ns := nil.
ln := aName]
ifFalse: [
ns := aName copyFrom: 1 to: (i - 1).
ln := aName copyFrom: i+1 to: aName size].
twoArgsBlock value: ns value: ln!
----- Method: SAXDriver>>useNamespaces: (in category 'accessing') -----
useNamespaces: aBoolean
useNamespaces := aBoolean!
----- Method: SAXDriver>>usesNamespaces (in category 'testing') -----
usesNamespaces
^useNamespaces!
----- Method: SAXDriver>>validatesAttributes (in category 'testing') -----
validatesAttributes
^validateAttributes!
XMLTokenizer subclass: #XMLParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
!XMLParser commentStamp: 'Alexandre.Bergel 6/1/2009 10:03' prior: 0!
This is a generic parser.
There is two ways to parse XML files, either using SAX, or using DOM. Both ways are supported in the XML-Parser package. SAX is event-based while DOM is tree-based. Ask google for more information!
----- Method: XMLParser>>attribute:value: (in category 'callbacks') -----
attribute: aSymbol value: aString
"This method is called for each attribute/value pair in a start tag"
^self subclassResponsibility!
----- Method: XMLParser>>beginStartTag:asPI: (in category 'callbacks') -----
beginStartTag: aSymbol asPI: aBoolean
"This method is called for at the beginning of a start tag.
The asPI parameter defines whether or not the tag is a 'processing
instruction' rather than a 'normal' tag."
^self subclassResponsibility!
----- Method: XMLParser>>endStartTag: (in category 'callbacks') -----
endStartTag: aSymbol
"This method is called at the end of the start tag after all of the
attributes have been processed"
^self subclassResponsibility!
----- Method: XMLParser>>endTag: (in category 'callbacks') -----
endTag: aSymbol
"This method is called when the parser encounters either an
end tag or the end of a unary tag"
^self subclassResponsibility!
----- Method: XMLParser>>handleCData: (in category 'handling tokens') -----
handleCData: aString
self text: aString!
----- Method: XMLParser>>handleEndTag: (in category 'handling tokens') -----
handleEndTag: aString
self endTag: aString!
----- Method: XMLParser>>handlePCData: (in category 'handling tokens') -----
handlePCData: aString
self text: aString!
----- Method: XMLParser>>handleStartTag:attributes: (in category 'handling tokens') -----
handleStartTag: tagName attributes: attributes
self beginStartTag: tagName asPI: false.
attributes keysAndValuesDo: [:key :value |
self attribute: key value: value].
self endStartTag: tagName!
----- Method: XMLParser>>text: (in category 'callbacks') -----
text: aString
"This method is called for the blocks of text between tags.
It preserves whitespace, but has all of the enclosed entities expanded"
^self subclassResponsibility!
----- Method: XMLTokenizer class>>addressBookXML (in category 'examples') -----
addressBookXML
^'<addressbook>
<person employee-number="A0000" family-name="Gates" first-name="Bob">
<contact-info><!!--Confidential--></contact-info>
<address city="Los Angeles" number="1239" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Manager"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7000" family-name="Brown"
first-name="Robert" middle-initial="L.">
<contact-info>
<email address="robb at iro.ibm.com"/>
<home-phone number="03-3987873"/>
</contact-info>
<address city="New York" number="344" state="NY" street="118 St."/>
<job-info employee-type="Full-Time" is-manager="yes" job-description="Group Leader"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7890" family-name="DePaiva"
first-name="Kassie" middle-initial="W.">
<contact-info><!!-- Kassie''s agent phone: 03-987654 --></contact-info>
<address city="Los Angeles" number="1234" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Actor"/>
<manager employee-number="A0000"/>
<misc-info>One of the most talented actresses on Daytime. Kassie
plays the devious and beautiful Blair Cramer on ABC's
"One Life To Live."</misc-info>
</person>
<person employee-number="A7987" family-name="Smith" first-name="Joe">
<contact-info>
<email address="joes at iro.ibm.com"/>
<mobile-phone number="888-7657765"/>
<home-phone number="03-8767898"/>
<home-phone number="03-8767871"/>
</contact-info>
<address city="New York" number="12789" state="NY" street="W. 15th Ave."/>
<job-info employee-type="Part-Time" is-manager="no" job-description="Hacker"/>
<manager employee-number="A7000"/>
</person>
</addressbook>
'!
----- Method: XMLTokenizer class>>addressBookXMLWithDTD (in category 'examples') -----
addressBookXMLWithDTD
^'<?xml version="1.0" encoding="UTF-8"?>
<!!DOCTYPE addressbook SYSTEM "addressbook.dtd">
<?xml-stylesheet type="text/xsl" href="demo.xsl"?>
<addressbook>
<person employee-number="A0000" family-name="Gates" first-name="Bob">
<contact-info><!!--Confidential--></contact-info>
<address city="Los Angeles" number="1239" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Manager"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7000" family-name="Brown"
first-name="Robert" middle-initial="L.">
<contact-info>
<email address="robb at iro.ibm.com"/>
<home-phone number="03-3987873"/>
</contact-info>
<address city="New York" number="344" state="NY" street="118 St."/>
<job-info employee-type="Full-Time" is-manager="yes" job-description="Group Leader"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7890" family-name="DePaiva"
first-name="Kassie" middle-initial="W.">
<contact-info><!!-- Kassie''s agent phone: 03-987654 --></contact-info>
<address city="Los Angeles" number="1234" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Actor"/>
<manager employee-number="A0000"/>
<misc-info>One of the most talented actresses on Daytime. Kassie
plays the devious and beautiful Blair Cramer on ABC's
"One Life To Live."</misc-info>
</person>
<person employee-number="A7987" family-name="Smith" first-name="Joe">
<contact-info>
<email address="joes at iro.ibm.com"/>
<mobile-phone number="888-7657765"/>
<home-phone number="03-8767898"/>
<home-phone number="03-8767871"/>
</contact-info>
<address city="New York" number="12789" state="NY" street="W. 15th Ave."/>
<job-info employee-type="Part-Time" is-manager="no" job-description="Hacker"/>
<manager employee-number="A7000"/>
</person>
</addressbook>
'!
----- Method: XMLTokenizer class>>exampleAddressBook (in category 'examples') -----
exampleAddressBook
| tokenizer |
"XMLTokenizer exampleAddressBook"
tokenizer := XMLTokenizer on: self addressBookXML readStream.
[tokenizer next notNil]
whileTrue: []!
----- Method: XMLTokenizer class>>exampleAddressBookWithDTD (in category 'examples') -----
exampleAddressBookWithDTD
| tokenizer |
"XMLTokenizer exampleAddressBookWithDTD"
tokenizer := XMLTokenizer on: self addressBookXMLWithDTD readStream.
[tokenizer next notNil]
whileTrue: []!
----- Method: XMLTokenizer class>>initialize (in category 'class initialization') -----
initialize
"XMLTokenizer initialize"
CharEscapes := CharacterSet newFrom: #( $& $" $' $> $< ).
SeparatorTable := CharacterSet new.
#(9 10 12 13 32) do: [:each | SeparatorTable add: each asCharacter].
LiteralChars := CharacterSet newFrom: #( $: $- $_ $= $.).
0 to: 255 do: [:i |
| char |
char := i asCharacter.
(char isDigit or: [char isLetter])
ifTrue: [LiteralChars add: char]].
NameDelimiters := CharacterSet new.
#(9 10 12 13 32 61 "$= asInteger 61" 62 "$> asInteger" 47 "$/ asInteger")
do: [:each | NameDelimiters add: each asCharacter].
DigitTable := Array new: 256.
DigitTable atAllPut: -1.
($0 to: $9) do: [:each | DigitTable at: each asciiValue put: each digitValue].
($a to: $f) do: [:each | DigitTable at: each asciiValue put: each digitValue].
($A to: $F) do: [:each | DigitTable at: each asciiValue put: each digitValue].
!
----- Method: XMLTokenizer class>>isCharEscape: (in category 'accessing') -----
isCharEscape: entityValue
^entityValue size = 1
and: [CharEscapes includes: entityValue first]!
----- Method: XMLTokenizer class>>on: (in category 'instance creation') -----
on: aStream
^self new parseStream: aStream!
----- Method: XMLTokenizer>>atEnd (in category 'streaming') -----
atEnd
nestedStreams == nil
ifTrue: [^peekChar == nil and: [stream atEnd]].
^stream atEnd
ifTrue: [
self popNestingLevel.
self atEnd]
ifFalse: [false]!
----- Method: XMLTokenizer>>checkAndExpandReference: (in category 'tokenizing') -----
checkAndExpandReference: parsingContext
| referenceString nextChar |
nextChar := self peek.
self validating
ifFalse: [^nil].
nextChar == $&
ifTrue: [
self next.
self peek == $#
ifTrue: [^self pushStream: (ReadStream on: self nextCharReference asString)].
referenceString := self nextLiteral.
self next == $;
ifFalse: [self errorExpected: ';'].
self handleEntity: referenceString in: parsingContext ]
ifFalse: [
((nextChar == $%
and: [self parsingMarkup])
and: [parsingContext == #entityValue])
ifTrue: [
self skipSeparators.
referenceString := self nextLiteral.
self handleEntity: referenceString in: parsingContext]].
self atEnd ifTrue: [self errorExpected: 'Character expected.'].
^nextChar!
----- Method: XMLTokenizer>>checkNestedStream (in category 'streaming') -----
checkNestedStream
nestedStreams == nil
ifFalse: [(peekChar == nil and: [self stream atEnd])
ifTrue: [
self popNestingLevel.
self checkNestedStream]]
!
----- Method: XMLTokenizer>>conditionalInclude: (in category 'tokenizing') -----
conditionalInclude: conditionalKeyword
conditionalKeyword = 'INCLUDE'
ifTrue: [^true].
conditionalKeyword = 'IGNORE'
ifTrue: [^false].
^self conditionalInclude: (self parameterEntity: conditionalKeyword) value!
----- Method: XMLTokenizer>>endDocTypeDecl (in category 'tokenizing dtd') -----
endDocTypeDecl
"Skip ]>"
self next; next.
^nil!
----- Method: XMLTokenizer>>endParsingMarkup (in category 'private') -----
endParsingMarkup
parsingMarkup := false!
----- Method: XMLTokenizer>>entities (in category 'entities') -----
entities
entities ifNil: [entities := self initEntities].
^entities!
----- Method: XMLTokenizer>>entity: (in category 'entities') -----
entity: refName
^self validating
ifTrue: [self entities
at: refName
ifAbsentPut: [self parseError: 'XML undefined entity ' , refName printString]]
ifFalse: [DTDEntityDeclaration name: refName value: '']
!
----- Method: XMLTokenizer>>entity:put: (in category 'entities') -----
entity: refName put: aReference
"Only the first declaration of an entity is valid so if there is already one don't register the new value."
self entities at: refName ifAbsentPut: [aReference]!
----- Method: XMLTokenizer>>errorExpected: (in category 'errors') -----
errorExpected: expectedString
| actualString |
actualString := ''.
self atEnd
ifFalse: [
actualString := [self next: 20]
on: Error
do: ['']].
self parseError: 'XML expected ' , expectedString printString , ': ' , actualString!
----- Method: XMLTokenizer>>externalEntities (in category 'entities') -----
externalEntities
externalEntities ifNil: [externalEntities := Dictionary new].
^externalEntities!
----- Method: XMLTokenizer>>externalEntity: (in category 'entities') -----
externalEntity: refName
^self entities
at: refName
ifAbsentPut: ['']!
----- Method: XMLTokenizer>>fastStreamStringContents: (in category 'private') -----
fastStreamStringContents: writeStream
| newSize |
newSize := writeStream position.
^(String new: newSize)
replaceFrom: 1
to: newSize
with: writeStream originalContents
startingAt: 1!
----- Method: XMLTokenizer>>handleCData: (in category 'handling tokens') -----
handleCData: aString
self log: 'CData: ' , aString!
----- Method: XMLTokenizer>>handleComment: (in category 'handling tokens') -----
handleComment: aString
self log: 'Comment: ' , aString!
----- Method: XMLTokenizer>>handleEndDocument (in category 'handling tokens') -----
handleEndDocument
self log: 'End Doc '!
----- Method: XMLTokenizer>>handleEndTag: (in category 'handling tokens') -----
handleEndTag: aString
self log: 'End tag: ' , aString!
----- Method: XMLTokenizer>>handleEntity:in: (in category 'entities') -----
handleEntity: referenceString in: parsingContext
| entity entityValue |
entity := self entity: referenceString.
entityValue := entity valueForContext: parsingContext.
(self class isCharEscape: entityValue)
ifTrue: [entityValue := entity reference].
self pushStream: (ReadStream on: entityValue asString)!
----- Method: XMLTokenizer>>handlePCData: (in category 'handling tokens') -----
handlePCData: aString
self log: 'PCData: ' , aString!
----- Method: XMLTokenizer>>handlePI:data: (in category 'handling tokens') -----
handlePI: piTarget data: piData
self log: 'PI: ' , piTarget , ' data ' , piData!
----- Method: XMLTokenizer>>handleStartDocument (in category 'handling tokens') -----
handleStartDocument
self log: 'Start Doc'!
----- Method: XMLTokenizer>>handleStartTag:attributes: (in category 'handling tokens') -----
handleStartTag: tagName attributes: attributes
self log: 'Start tag: ' , tagName.
attributes keysAndValuesDo: [:key :value |
self log: key , '->' , value]!
----- Method: XMLTokenizer>>handleWhitespace: (in category 'handling tokens') -----
handleWhitespace: aString
self log: 'Whitespace: ' , aString!
----- Method: XMLTokenizer>>handleXMLDecl:namespaces: (in category 'handling tokens') -----
handleXMLDecl: attributes namespaces: namespaces
attributes keysAndValuesDo: [:key :value |
self log: key , '->' , value]!
----- Method: XMLTokenizer>>hasNestedStreams (in category 'streaming') -----
hasNestedStreams
^nestedStreams notNil!
----- Method: XMLTokenizer>>initEntities (in category 'entities') -----
initEntities
| ents |
ents := Dictionary new.
ents
at: 'amp' put: (DTDEntityDeclaration name: 'amp' value: '&');
at: 'quot' put: (DTDEntityDeclaration name: 'quot' value: '"');
at: 'apos' put: (DTDEntityDeclaration name: 'apos' value: '''');
at: 'gt' put: (DTDEntityDeclaration name: 'gt' value: '>');
at: 'lt' put: (DTDEntityDeclaration name: 'lt' value: '<').
^ents!
----- Method: XMLTokenizer>>initialize (in category 'initialize') -----
initialize
parsingMarkup := false.
validating := false.
attributeBuffer := WriteStream on: (String new: 128).
nameBuffer := WriteStream on: (String new: 128)!
----- Method: XMLTokenizer>>log: (in category 'private') -----
log: aString
"Transcript show: aString; cr"!
----- Method: XMLTokenizer>>malformedError: (in category 'errors') -----
malformedError: errorString
SAXMalformedException signal: errorString!
----- Method: XMLTokenizer>>match:into: (in category 'streaming') -----
match: subCollection into: resultStream
"Set the access position of the receiver to be past the next occurrence of the subCollection. Answer whether subCollection is found. No wildcards, and case does matter."
| pattern startMatch |
pattern := ReadStream on: subCollection.
startMatch := nil.
[pattern atEnd] whileFalse:
[self atEnd ifTrue: [^ false].
(self next) = (pattern next)
ifTrue: [pattern position = 1 ifTrue: [startMatch := self position]]
ifFalse: [pattern position: 0.
startMatch ifNotNil: [
self position: startMatch.
startMatch := nil]]].
^ true
!
----- Method: XMLTokenizer>>nestedStreams (in category 'private') -----
nestedStreams
nestedStreams ifNil: [nestedStreams := OrderedCollection new].
^nestedStreams!
----- Method: XMLTokenizer>>next (in category 'streaming') -----
next
"Return the next character from the current input stream. If the current stream is at end pop to next nesting level if there is one.
Due to the potential nesting of original document, included documents and replacment texts the streams are held in a stack representing the nested streams. The current stream is the top one."
| nextChar |
peekChar
ifNil: [
nestedStreams ifNotNil: [self checkNestedStream].
^nextChar := stream next]
ifNotNil: [
nextChar := peekChar.
peekChar := nil.
^nextChar].
!
----- Method: XMLTokenizer>>nextAttributeInto:namespaces: (in category 'tokenizing') -----
nextAttributeInto: attributes namespaces: namespaces
| attrName attrValue |
attrName := self nextName.
self skipSeparators.
self next == $=
ifFalse: [self errorExpected: '='].
self skipSeparators.
attrValue := self nextAttributeValue.
(self usesNamespaces
and: [(attrName findString: 'xmlns') = 1])
ifTrue: [attrName size > 6
ifTrue: [namespaces at: (attrName copyFrom: 7 to: attrName size) put: attrValue]
ifFalse: [namespaces at: attrName put: attrValue]]
ifFalse: [attributes at: attrName put: attrValue]!
----- Method: XMLTokenizer>>nextAttributeValue (in category 'tokenizing') -----
nextAttributeValue
| delimiterChar attributeValueStream nextChar nextPeek referenceString entity entityValue |
delimiterChar := self next.
(delimiterChar == $"
or: [delimiterChar == $'])
ifFalse: [self errorExpected: 'Attribute value delimiter expected.'].
attributeValueStream := attributeBuffer reset.
[
nextPeek := nextChar := self next.
nextChar ifNil: [self errorExpected: 'Character expected.'].
nextChar == $&
ifTrue: [
self peek == $#
ifTrue: [
nextPeek := nil.
nextChar := self nextCharReference]
ifFalse: [
referenceString := self nextLiteral.
self next == $;
ifFalse: [self errorExpected: ';'].
entity := self entity: referenceString.
entityValue := entity valueForContext: #content.
(self class isCharEscape: entityValue)
ifTrue: [
nextPeek := nil.
nextChar := entityValue first]
ifFalse: [
entityValue := entityValue asString.
entityValue isEmpty
ifTrue: [nextPeek := nextChar := nil]
ifFalse: [
self pushStream: (ReadStream on: entityValue asString).
nextPeek := nextChar := self next]]]].
nextPeek == delimiterChar]
whileFalse: [
nextChar ifNotNil: [attributeValueStream nextPut: nextChar]].
^self fastStreamStringContents: attributeValueStream
" ^attributeValueStream contents"!
----- Method: XMLTokenizer>>nextCDataContent (in category 'tokenizing') -----
nextCDataContent
| cdata |
"Skip $[ "
self next.
cdata := self nextUpToAll: ']]>'.
self handleCData: cdata
!
----- Method: XMLTokenizer>>nextCDataOrConditional (in category 'tokenizing') -----
nextCDataOrConditional
| nextChar conditionalKeyword |
"Skip ["
self next.
self skipSeparators.
nextChar := self peek.
nextChar == $%
ifTrue: [
self checkAndExpandReference: (self parsingMarkup ifTrue: [#dtd] ifFalse: [#content]).
conditionalKeyword := self nextLiteral.
self skipSeparators.
^self next == $[
ifTrue: [
self skipSeparators.
self nextIncludeSection: (self conditionalInclude: conditionalKeyword)]
ifFalse: [self errorExpected: '[' ]].
nextChar == $C
ifTrue: [
^self nextLiteral = 'CDATA'
ifTrue: [self peek == $[
ifTrue: [self nextCDataContent]
ifFalse: [self errorExpected: '[' ]]
ifFalse: [self errorExpected: 'CData']].
self errorExpected: 'CData or declaration'
!
----- Method: XMLTokenizer>>nextCharReference (in category 'tokenizing') -----
nextCharReference
| base charValue |
self next == $#
ifFalse: [self errorExpected: 'character reference'].
base := self peek == $x
ifTrue: [
self next.
16]
ifFalse: [10].
charValue := [self readNumberBase: base] on: Error do: [:ex | self errorExpected: 'Number.'].
(self next) == $;
ifFalse: [self errorExpected: '";"'].
^Unicode value: charValue!
----- Method: XMLTokenizer>>nextComment (in category 'tokenizing') -----
nextComment
| string |
"Skip first -"
self next.
self next == $-
ifFalse: [self errorExpected: 'second comment $-'].
string := self nextUpToAll: '-->'.
self handleComment: string!
----- Method: XMLTokenizer>>nextDocType (in category 'tokenizing dtd') -----
nextDocType
| declType |
declType := self nextLiteral.
declType = 'DOCTYPE'
ifTrue: [
self startParsingMarkup.
^self nextDocTypeDecl].
self errorExpected: 'markup declaration, not ' , declType printString!
----- Method: XMLTokenizer>>nextDocTypeDecl (in category 'tokenizing dtd') -----
nextDocTypeDecl
| nextChar |
self skipSeparators.
self nextLiteral.
self skipSeparators.
self peek == $[
ifFalse: [[nextChar := self peek.
nextChar == $> or: [nextChar == $[ ]] whileFalse: [self next]].
self peek == $[
ifTrue: [
self next.
[self skipSeparators.
self peek == $]] whileFalse: [
self checkAndExpandReference: #dtd.
self nextNode].
self next == $]
ifFalse: [self errorExpected: ']' ]].
self skipSeparators.
self next == $>
ifFalse: [self errorExpected: '>' ].
self endParsingMarkup!
----- Method: XMLTokenizer>>nextEndTag (in category 'tokenizing') -----
nextEndTag
| tagName |
"Skip /"
self next.
tagName := self nextName.
self skipSeparators.
(self nextTrimmedBlanksUpTo: $>)
ifNotEmpty: [self parseError: 'XML invalid end tag ' , tagName].
self handleEndTag: tagName!
----- Method: XMLTokenizer>>nextEntity (in category 'tokenizing') -----
nextEntity
"return the next XMLnode, or nil if there are no more.
Fixed to retain leading whitespace when PCDATA is detected."
|whitespace|
"branch, depending on what the first character is"
whitespace := self nextWhitespace.
self atEnd ifTrue: [self handleEndDocument. ^ nil].
self checkAndExpandReference: (self parsingMarkup ifTrue: [#dtd] ifFalse: [#content]).
^self peek = $<
ifTrue: [self nextNode]
ifFalse: [whitespace isEmpty
ifFalse: [self pushBack: whitespace].
self nextPCData]!
----- Method: XMLTokenizer>>nextEntityDeclaration (in category 'tokenizing dtd') -----
nextEntityDeclaration
| entityName entityDef referenceClass reference |
self skipSeparators.
referenceClass := self peek == $%
ifTrue: [
self next.
self skipSeparators.
DTDParameterEntityDeclaration]
ifFalse: [DTDEntityDeclaration].
entityName := self nextLiteral.
self skipSeparators.
entityDef := (self peek == $" or: [self peek == $'])
ifTrue: [self nextEntityValue]
ifFalse: [self nextExternalId].
self skipUpTo: $>.
reference := referenceClass name: entityName value: entityDef.
reference registerIn: self.
^reference!
----- Method: XMLTokenizer>>nextEntityValue (in category 'tokenizing') -----
nextEntityValue
| delimiterChar entityValueStream nextChar nextPeek referenceString entity entityValue |
delimiterChar := self next.
(delimiterChar == $"
or: [delimiterChar == $'])
ifFalse: [self errorExpected: 'Entity value delimiter expected.'].
entityValueStream := WriteStream on: (String new).
[
nextPeek := nextChar := self peek.
nextChar ifNil: [self errorExpected: 'Character expected.'].
nextChar == $&
ifTrue: [
self next.
self peek == $#
ifTrue: [
nextPeek := nil.
nextChar := self nextCharReference]
ifFalse: [
referenceString := self nextLiteral.
self next == $;
ifFalse: [self errorExpected: ';'].
entity := self entity: referenceString.
entityValue := entity valueForContext: #entityValue.
self pushStream: (ReadStream on: entityValue asString).
nextPeek := nextChar := self next]]
ifFalse: [
nextChar == $%
ifTrue: [
self skipSeparators.
referenceString := self nextLiteral.
nextChar := self handleEntity: referenceString in: #entityValue.
nextPeek := nextChar := self next]
ifFalse: [self next]].
nextPeek == delimiterChar]
whileFalse: [
nextChar ifNotNil: [entityValueStream nextPut: nextChar]].
^entityValueStream contents!
----- Method: XMLTokenizer>>nextExternalId (in category 'tokenizing dtd') -----
nextExternalId
| extDefType systemId dir |
extDefType := self nextLiteral.
extDefType = 'PUBLIC'
ifTrue: [
self skipSeparators.
self nextPubidLiteral.
self skipSeparators.
self peek == $>
ifFalse: [
systemId := self nextSystemLiteral]].
extDefType = 'SYSTEM'
ifTrue: [
self skipSeparators.
systemId := self nextSystemLiteral].
systemId
ifNil: [^nil].
"The rest of this method only applies if we're reading aFileStream"
(self topStream isKindOf: FileStream)
ifFalse: [^''].
dir := self topStream directory.
^(dir fileExists: systemId)
ifTrue: [(dir readOnlyFileNamed: systemId) contentsOfEntireFile]
ifFalse: ['']!
----- Method: XMLTokenizer>>nextIncludeSection: (in category 'tokenizing') -----
nextIncludeSection: parseSection
| section |
"Read the file up to the next include section delimiter and parse it if parseSection is true"
section := self nextUpToAll: ']]>'.
parseSection
ifTrue: [
self pushStream: (ReadStream on: section)]!
----- Method: XMLTokenizer>>nextLiteral (in category 'tokenizing') -----
nextLiteral
| resultStream nextChar |
resultStream := (String new: 10) writeStream.
((nextChar := self peek) isLetter
or: [nextChar == $_])
ifFalse: [self errorExpected: 'Name literal.'].
[ | resultString |
nextChar := self peek.
(LiteralChars includes: nextChar)
ifTrue: [
nextChar == $&
ifTrue: [
nextChar := self next.
resultStream nextPut: (self peek == $#
ifTrue: [self nextCharReference]
ifFalse: [^resultStream contents])]
ifFalse: [
resultStream nextPut: self next]]
ifFalse: [resultString := resultStream contents.
resultString isEmpty
ifTrue: [self errorExpected: 'Name literal']
ifFalse: [^resultString]]] repeat!
----- Method: XMLTokenizer>>nextMarkupDeclaration (in category 'tokenizing dtd') -----
nextMarkupDeclaration
| declType |
declType := self nextLiteral.
self validating
ifFalse: [^self skipMarkupDeclaration].
declType = 'ENTITY'
ifTrue: [self nextEntityDeclaration]
ifFalse: [self skipMarkupDeclaration]!
----- Method: XMLTokenizer>>nextName (in category 'tokenizing') -----
nextName
| nextChar |
nameBuffer reset.
self peek == $.
ifTrue: [self malformedError: 'Character expected.'].
[(nextChar := self peek)
ifNil: [self errorExpected: 'Character expected.'].
NameDelimiters includes: nextChar] whileFalse: [
nameBuffer nextPut: self next].
^self fastStreamStringContents: nameBuffer!
----- Method: XMLTokenizer>>nextNode (in category 'tokenizing') -----
nextNode
| nextChar |
"Skip < "
self next.
nextChar := self peek.
nextChar == $!! ifTrue: [
"Skip !!"
self next.
nextChar := self peek.
nextChar == $- ifTrue: [^self nextComment].
nextChar == $[ ifTrue: [^self nextCDataOrConditional].
^self parsingMarkup
ifTrue: [self nextMarkupDeclaration]
ifFalse: [self nextDocType]].
nextChar == $? ifTrue: [^self nextPI].
^self nextTag!
----- Method: XMLTokenizer>>nextPCData (in category 'tokenizing') -----
nextPCData
| resultStream nextChar referenceString entity entityValue nextPeek |
resultStream := (String new: 10) writeStream.
self validating
ifFalse: [
[self peek == $<]
whileFalse: [resultStream nextPut: self next].
^self handlePCData: resultStream contents].
[
nextPeek := nextChar := self peek.
nextChar ifNil: [self errorExpected: 'Character expected.'].
nextChar == $&
ifTrue: [
self next.
self peek == $#
ifTrue: [
nextPeek := nil.
nextChar := self nextCharReference]
ifFalse: [
referenceString := self nextLiteral.
self next == $;
ifFalse: [self errorExpected: ';'].
entity := self entity: referenceString.
entityValue := entity valueForContext: #content.
(self class isCharEscape: entityValue)
ifTrue: [
nextPeek := nil.
nextChar := entityValue first]
ifFalse: [
entityValue := entityValue asString.
entityValue isEmpty
ifTrue: [nextPeek := nextChar := nil]
ifFalse: [
self pushStream: (ReadStream on: entityValue asString).
nextPeek := nextChar := self peek]]]]
ifFalse: [nextPeek == $< ifFalse: [self next]].
nextPeek == $<]
whileFalse: [
nextChar ifNotNil: [resultStream nextPut: nextChar]].
self handlePCData: resultStream contents!
----- Method: XMLTokenizer>>nextPI (in category 'tokenizing') -----
nextPI
| piTarget piData |
"Skip ?"
self next.
piTarget := self nextLiteral.
piTarget asUppercase = 'XML'
ifTrue: [^self nextXMLDecl].
self skipSeparators.
piData := self nextUpToAll: '?>'.
self handlePI: piTarget data: piData!
----- Method: XMLTokenizer>>nextPubidLiteral (in category 'tokenizing') -----
nextPubidLiteral
^self nextAttributeValue!
----- Method: XMLTokenizer>>nextSystemLiteral (in category 'tokenizing') -----
nextSystemLiteral
^self nextAttributeValue!
----- Method: XMLTokenizer>>nextTag (in category 'tokenizing') -----
nextTag
| tagName attributes nextChar namespaces |
(self peek = $/)
ifTrue: [^self nextEndTag].
tagName := self nextName.
self skipSeparators.
attributes := Dictionary new: 33.
namespaces := Dictionary new: 5.
[(nextChar := self peek) == $> or: [nextChar == $/]] whileFalse: [
self checkAndExpandReference: #content.
self nextAttributeInto: attributes namespaces: namespaces.
self skipSeparators.].
self handleStartTag: tagName attributes: attributes namespaces: namespaces.
self next == $/
ifTrue: [
self handleEndTag: tagName.
self next].
!
----- Method: XMLTokenizer>>nextTrimmedBlanksUpTo: (in category 'streaming') -----
nextTrimmedBlanksUpTo: delimiter
| resultStream nextChar |
resultStream := WriteStream on: (String new: 10).
nextChar := nil.
[(nextChar := self next) == delimiter]
whileFalse: [
nextChar == $ ifFalse: [
resultStream nextPut: nextChar]].
nextChar == delimiter
ifFalse: [self parseError: 'XML no delimiting ' , delimiter printString , ' found'].
^resultStream contents
!
----- Method: XMLTokenizer>>nextUpTo: (in category 'streaming') -----
nextUpTo: delimiter
| resultStream nextChar |
resultStream := WriteStream on: (String new: 10).
[self atEnd or: [(nextChar := self next) == delimiter]]
whileFalse: [resultStream nextPut: nextChar].
nextChar == delimiter
ifFalse: [self parseError: 'XML no delimiting ' , delimiter printString , ' found'].
^resultStream contents
!
----- Method: XMLTokenizer>>nextUpToAll: (in category 'streaming') -----
nextUpToAll: delimitingString
| string |
self unpeek.
string := self upToAll: delimitingString.
string
ifNil: [self parseError: 'XML no delimiting ' , delimitingString printString , ' found'].
^string!
----- Method: XMLTokenizer>>nextWhitespace (in category 'tokenizing') -----
nextWhitespace
| nextChar resultStream resultString|
resultStream := (String new: 10) writeStream.
[((nextChar := self peek) ~~ nil)
and: [SeparatorTable includes: nextChar]]
whileTrue: [resultStream nextPut: nextChar. self next].
(nestedStreams == nil or: [self atEnd not])
ifFalse: [self checkNestedStream.
self nextWhitespace].
resultString := resultStream contents.
resultString isEmpty ifFalse: [self handleWhitespace: resultString].
^resultString!
----- Method: XMLTokenizer>>nextXMLDecl (in category 'tokenizing') -----
nextXMLDecl
| attributes nextChar namespaces |
self skipSeparators.
attributes := Dictionary new.
namespaces := Dictionary new.
[(nextChar := self peek) == $?] whileFalse: [
self nextAttributeInto: attributes namespaces: namespaces.
self skipSeparators.].
self next.
self next == $>
ifFalse: [self errorExpected: '> expected.'].
(attributes includesKey: 'encoding') ifTrue: [self streamEncoding: (attributes at: 'encoding')].
self handleXMLDecl: attributes namespaces: namespaces
!
----- Method: XMLTokenizer>>parameterEntities (in category 'entities') -----
parameterEntities
parameterEntities ifNil: [parameterEntities := Dictionary new].
^parameterEntities!
----- Method: XMLTokenizer>>parameterEntity: (in category 'entities') -----
parameterEntity: refName
^self parameterEntities
at: refName
ifAbsent: [self parseError: 'XML undefined parameter entity ' , refName printString]!
----- Method: XMLTokenizer>>parameterEntity:put: (in category 'entities') -----
parameterEntity: refName put: aReference
"Only the first declaration of an entity is valid so if there is already one don't register the new value."
self parameterEntities at: refName ifAbsentPut: [aReference]!
----- Method: XMLTokenizer>>parseError: (in category 'errors') -----
parseError: errorString
SAXParseException signal: errorString!
----- Method: XMLTokenizer>>parseStream: (in category 'accessing') -----
parseStream: aStream
self stream: aStream!
----- Method: XMLTokenizer>>parsingMarkup (in category 'private') -----
parsingMarkup
^parsingMarkup!
----- Method: XMLTokenizer>>peek (in category 'streaming') -----
peek
"Return the next character from the current input stream. If the current stream poop to next nesting level if there is one.
Due to the potential nesting of original document, included documents and replacment texts the streams are held in a stack representing the nested streams. The current stream is the top one."
peekChar
ifNil: [
nestedStreams ifNotNil: [self checkNestedStream].
^peekChar := stream next]
ifNotNil: [^peekChar]!
----- Method: XMLTokenizer>>popNestingLevel (in category 'streaming') -----
popNestingLevel
self hasNestedStreams
ifTrue: [
self stream close.
self stream: self nestedStreams removeLast.
self nestedStreams size > 0
ifFalse: [nestedStreams := nil]]!
----- Method: XMLTokenizer>>pushBack: (in category 'streaming') -----
pushBack: aString
"Fixed to push the string before the peek char (if any)."
| pushBackString |
pushBackString := peekChar
ifNil: [aString]
ifNotNil: [aString, peekChar asString].
peekChar := nil.
self pushStream: (ReadStream on: pushBackString)!
----- Method: XMLTokenizer>>pushStream: (in category 'streaming') -----
pushStream: newStream
"Continue parsing from the new nested stream."
self unpeek.
self nestedStreams addLast: self stream.
self stream: newStream!
----- Method: XMLTokenizer>>readNumberBase: (in category 'private') -----
readNumberBase: base
"Read a hex number from stream until encountering $; "
| value digit |
base = 10 ifFalse: [ | numberString |
numberString := self nextUpTo: $;.
self stream skip: -1.
^Integer readFrom: numberString asUppercase readStream base: base.
].
value := 0.
digit := DigitTable at: self peek asciiValue.
digit < 0
ifTrue: [self error: 'At least one digit expected here'].
self next.
value := digit.
[digit := DigitTable at: self peek asciiValue.
digit < 0
ifTrue: [^value]
ifFalse: [
self next.
value := value * base + digit]
] repeat.
^ value!
----- Method: XMLTokenizer>>skipMarkupDeclaration (in category 'tokenizing dtd') -----
skipMarkupDeclaration
self skipUpTo: $>!
----- Method: XMLTokenizer>>skipSeparators (in category 'streaming') -----
skipSeparators
| nextChar |
[((nextChar := self peek) ~~ nil)
and: [SeparatorTable includes: nextChar]]
whileTrue: [self next].
(nestedStreams == nil or: [self atEnd not])
ifFalse: [
self checkNestedStream.
self skipSeparators]!
----- Method: XMLTokenizer>>skipUpTo: (in category 'streaming') -----
skipUpTo: delimiter
| nextChar |
self unpeek.
[self atEnd or: [(nextChar := self next) == delimiter]]
whileFalse: [].
nextChar == delimiter
ifFalse: [self parseError: 'XML no delimiting ' , delimiter printString , ' found']
!
----- Method: XMLTokenizer>>startParsingMarkup (in category 'private') -----
startParsingMarkup
parsingMarkup := true!
----- Method: XMLTokenizer>>stream (in category 'private') -----
stream
^stream!
----- Method: XMLTokenizer>>stream: (in category 'private') -----
stream: newStream
"Continue parsing from the new nested stream."
stream := newStream!
----- Method: XMLTokenizer>>stream:upToAll: (in category 'streaming') -----
stream: aStream upToAll: aCollection
"Answer a subcollection from the current access position to the occurrence (not inclusive) of aCollection. If aCollection is not in the stream, answer nil."
| startPos endMatch result |
startPos := aStream position.
(aStream match: aCollection)
ifTrue: [endMatch := aStream position.
aStream position: startPos.
result := aStream next: endMatch - startPos - aCollection size.
aStream position: endMatch.
^ result]
ifFalse: [
aStream position: startPos.
^nil]!
----- Method: XMLTokenizer>>streamEncoding: (in category 'streaming') -----
streamEncoding: encodingString
Smalltalk at: #TextConverter ifPresent: [:tc |
(stream respondsTo: #converter:) ifTrue: [
| converterClass |
converterClass := tc defaultConverterClassForEncoding: encodingString asLowercase.
converterClass ifNotNil: [stream converter: converterClass new]]]!
----- Method: XMLTokenizer>>topStream (in category 'streaming') -----
topStream
^self hasNestedStreams
ifTrue: [self nestedStreams first]
ifFalse: [self stream]!
----- Method: XMLTokenizer>>unpeek (in category 'streaming') -----
unpeek
"Fixed to use nested stream since multi-byte streams
do not properly override pushBack: to deal with multi-byte
characters."
peekChar ifNotNil: [self pushBack: '']!
----- Method: XMLTokenizer>>upToAll: (in category 'streaming') -----
upToAll: delimitingString
"Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of delimitingString. If delimitingString is not in the stream, answer the entire rest of the stream."
| result |
self hasNestedStreams
ifFalse: [
result := self stream: self stream upToAll: delimitingString.
result
ifNil: [self parseError: 'XML no delimiting ' , delimitingString printString , ' found'].
^result].
result := self stream: self stream upToAll: delimitingString.
result
ifNotNil: [^result].
result := String streamContents: [:resultStream |
resultStream nextPutAll: self stream upToEnd.
self atEnd
ifTrue: [self parseError: 'XML no delimiting ' , delimitingString printString , ' found'].
self stream position timesRepeat: [
self atEnd
ifFalse: [
resultStream nextPut: self next]]].
self pushBack: result.
^self upToAll: delimitingString!
----- Method: XMLTokenizer>>usesNamespaces (in category 'testing') -----
usesNamespaces
^false!
----- Method: XMLTokenizer>>validating (in category 'testing') -----
validating
^validating!
----- Method: XMLTokenizer>>validating: (in category 'accessing') -----
validating: aBoolean
validating := aBoolean!
Object subclass: #XMLWriter
instanceVariableNames: 'stream stack scope scanner canonical currentIndent indentString'
classVariableNames: 'XMLTranslation XMLTranslationMap'
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLWriter class>>initialize (in category 'class initialization') -----
initialize
"XMLWriter initialize"
XMLTranslation := Dictionary new.
XMLTranslation
at: Character cr put: ' ';
at: Character lf put: ' ';
at: Character tab put: '	';
at: $& put: '&';
at: $< put: '<';
at: $> put: '>';
" at: $' put: '''; "
at: $" put: '"'.
XMLTranslationMap := ByteArray new: 256.
XMLTranslation keysDo:[:ch| XMLTranslationMap at: ch asciiValue+1 put: 1].
!
----- Method: XMLWriter class>>on: (in category 'instance creation') -----
on: aStream
^self basicNew initialize stream: aStream!
----- Method: XMLWriter>>attribute:value: (in category 'writing xml') -----
attribute: attributeName value: attributeValue
self stream
space;
nextPutAll: attributeName.
self
eq;
putAsXMLString: attributeValue!
----- Method: XMLWriter>>canonical (in category 'accessing') -----
canonical
^canonical!
----- Method: XMLWriter>>canonical: (in category 'accessing') -----
canonical: aBoolean
canonical := aBoolean!
----- Method: XMLWriter>>cdata: (in category 'writing xml') -----
cdata: aString
self startCData.
self stream nextPutAll: aString.
self endCData!
----- Method: XMLWriter>>comment: (in category 'writing xml') -----
comment: aString
self startComment.
self stream nextPutAll: aString.
self endComment!
----- Method: XMLWriter>>declareNamespace:uri: (in category 'namespaces') -----
declareNamespace: ns uri: uri
self scope declareNamespace: ns uri: uri!
----- Method: XMLWriter>>defaultNamespace (in category 'namespaces') -----
defaultNamespace
^self scope defaultNamespace!
----- Method: XMLWriter>>defaultNamespace: (in category 'namespaces') -----
defaultNamespace: ns
"Declare the default namespace."
self scope defaultNamespace: ns!
----- Method: XMLWriter>>endCData (in category 'private tags') -----
endCData
self stream nextPutAll: ']]>'!
----- Method: XMLWriter>>endComment (in category 'private tags') -----
endComment
self stream nextPutAll: ' -->'!
----- Method: XMLWriter>>endDecl: (in category 'writing dtd') -----
endDecl: type
self endTag!
----- Method: XMLWriter>>endDeclaration (in category 'writing dtd') -----
endDeclaration
self stream
cr;
nextPut: $].
self endTag!
----- Method: XMLWriter>>endEmptyTag: (in category 'writing xml') -----
endEmptyTag: tagName
self popTag: tagName.
self stream nextPutAll: '/>'.
self canonical
ifFalse: [self stream space]!
----- Method: XMLWriter>>endPI (in category 'private tags') -----
endPI
self stream nextPutAll: ' ?>'!
----- Method: XMLWriter>>endTag (in category 'writing xml') -----
endTag
self stream nextPutAll: '>'.
self indent.
"self canonical
ifFalse: [self stream space]"!
----- Method: XMLWriter>>endTag: (in category 'writing xml') -----
endTag: tagName
self outdent.
self endTag: tagName xmlns: nil!
----- Method: XMLWriter>>endTag:xmlns: (in category 'writing xml') -----
endTag: tagName xmlns: xmlns
self popTag: tagName.
self stream
nextPutAll: '</'.
(xmlns notNil
and: [xmlns ~= self defaultNamespace])
ifTrue: [self stream
nextPutAll: xmlns;
nextPut: $:].
stream nextPutAll: tagName.
self endTag.
!
----- Method: XMLWriter>>enterScope (in category 'namespaces') -----
enterScope
self scope enterScope!
----- Method: XMLWriter>>eq (in category 'private') -----
eq
self stream nextPut: $=!
----- Method: XMLWriter>>flush (in category 'writing xml') -----
flush
self stream flush!
----- Method: XMLWriter>>indent (in category 'private') -----
indent
currentIndent
ifNotNil: [currentIndent := currentIndent +1]!
----- Method: XMLWriter>>indentString: (in category 'accessing') -----
indentString: aString
currentIndent := 0.
indentString := aString!
----- Method: XMLWriter>>indentTab (in category 'accessing') -----
indentTab
self indentString: (String with: Character tab)!
----- Method: XMLWriter>>initialize (in category 'initialize') -----
initialize
stack := OrderedCollection new.
canonical := false.
scope := XMLNamespaceScope new!
----- Method: XMLWriter>>leaveScope (in category 'namespaces') -----
leaveScope
self scope leaveScope!
----- Method: XMLWriter>>outdent (in category 'private') -----
outdent
currentIndent
ifNotNil: [
stream cr.
currentIndent := currentIndent-1.
self writeIndent.
currentIndent := currentIndent-1.]!
----- Method: XMLWriter>>pcData: (in category 'writing xml') -----
pcData: aString
| lastIndex nextIndex |
lastIndex := 1.
"Unroll the first search to avoid copying"
nextIndex := aString class findFirstInString: aString inSet: XMLTranslationMap startingAt: lastIndex.
nextIndex = 0 ifTrue:[^self stream nextPutAll: aString].
[self stream nextPutAll: (aString copyFrom: lastIndex to: nextIndex-1).
self stream nextPutAll: (XMLTranslation at: (aString at: nextIndex)).
lastIndex := nextIndex + 1.
nextIndex := aString class findFirstInString: aString inSet: XMLTranslationMap startingAt: lastIndex.
nextIndex = 0] whileFalse.
self stream nextPutAll: (aString copyFrom: lastIndex to: aString size).!
----- Method: XMLWriter>>pi:data: (in category 'writing xml') -----
pi: piTarget data: piData
self startPI: piTarget.
self stream nextPutAll: piData.
self endPI!
----- Method: XMLWriter>>popTag: (in category 'private') -----
popTag: tagName
| stackTop |
stackTop := self stack isEmpty
ifTrue: ['<empty>']
ifFalse: [self stack last].
^stackTop = tagName
ifTrue: [self stack removeLast]
ifFalse: [self error: 'Closing tag "' , tagName , '" does not match "' , stackTop]!
----- Method: XMLWriter>>pushTag: (in category 'private') -----
pushTag: tagName
self stack add: tagName!
----- Method: XMLWriter>>putAsXMLString: (in category 'private') -----
putAsXMLString: aValue
self stream nextPut: $".
self pcData: aValue.
self stream nextPut: $"!
----- Method: XMLWriter>>scope (in category 'private') -----
scope
^scope!
----- Method: XMLWriter>>stack (in category 'private') -----
stack
^stack!
----- Method: XMLWriter>>startCData (in category 'private tags') -----
startCData
self stream nextPutAll: '<!![CDATA['!
----- Method: XMLWriter>>startComment (in category 'private tags') -----
startComment
self stream nextPutAll: '<-- '!
----- Method: XMLWriter>>startDecl: (in category 'writing dtd') -----
startDecl: type
self stream
nextPutAll: '<!!';
nextPutAll: type asUppercase;
space!
----- Method: XMLWriter>>startDecl:named: (in category 'writing dtd') -----
startDecl: type named: aString
self stream
nextPutAll: '<!!';
nextPutAll: type asUppercase;
space;
nextPutAll: aString;
space!
----- Method: XMLWriter>>startDeclaration: (in category 'writing dtd') -----
startDeclaration: dtdName
self startDecl: 'DOCTYPE' named: dtdName.
self stream
nextPut: $[;
cr!
----- Method: XMLWriter>>startElement:attributeList: (in category 'writing xml') -----
startElement: elementName attributeList: attributeList
self canonical
ifFalse: [self stream cr].
self startTag: elementName.
attributeList keys asArray sort do: [:key |
self attribute: key value: (attributeList at: key)]!
----- Method: XMLWriter>>startPI: (in category 'private tags') -----
startPI: identifier
self stream
nextPutAll: '<?';
nextPutAll: identifier;
space!
----- Method: XMLWriter>>startTag: (in category 'writing xml') -----
startTag: tagName
self writeIndent.
self startTag: tagName xmlns: nil!
----- Method: XMLWriter>>startTag:xmlns: (in category 'writing xml') -----
startTag: tagName xmlns: xmlns
self stream
nextPut: $<.
(xmlns notNil
and: [xmlns ~= self scope defaultNamespace])
ifTrue: [self stream
nextPutAll: xmlns;
nextPut: $:].
self stream
nextPutAll: tagName.
"self canonical
ifFalse: [self stream space]."
self pushTag: tagName!
----- Method: XMLWriter>>stream (in category 'accessing') -----
stream
^stream!
----- Method: XMLWriter>>stream: (in category 'accessing') -----
stream: aStream
stream := aStream!
----- Method: XMLWriter>>writeIndent (in category 'private') -----
writeIndent
currentIndent ifNotNil: [
currentIndent timesRepeat: [self stream nextPutAll: indentString]]!
----- Method: XMLWriter>>xmlDeclaration: (in category 'writing xml') -----
xmlDeclaration: versionString
self canonical
ifFalse: [
self
startPI: 'xml';
attribute: 'version' value: versionString;
endPI]!
----- Method: XMLWriter>>xmlDeclaration:encoding: (in category 'writing xml') -----
xmlDeclaration: versionString encoding: encodingString
self canonical
ifFalse: [
self
startPI: 'xml';
attribute: 'version' value: versionString;
attribute: 'encoding' value: encodingString;
endPI.
self stream flush]!
----- Method: ByteString>>applyLanguageInfomation: (in category '*xml-parser') -----
applyLanguageInfomation: languageEnvironment
!
Warning subclass: #SAXWarning
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
ClassTestCase subclass: #XMLParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'XML-Parser'!
----- Method: XMLParserTest>>addressBookXML (in category 'source') -----
addressBookXML
^'<addressbook>
<person employee-number="A0000" family-name="Gates" first-name="Bob">
<contact-info><!!--Confidential--></contact-info>
<address city="Los Angeles" number="1239" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Manager"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7000" family-name="Brown"
first-name="Robert" middle-initial="L.">
<contact-info>
<email address="robb at iro.ibm.com"/>
<home-phone number="03-3987873"/>
</contact-info>
<address city="New York" number="344" state="NY" street="118 St."/>
<job-info employee-type="Full-Time" is-manager="yes" job-description="Group Leader"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7890" family-name="DePaiva"
first-name="Kassie" middle-initial="W.">
<contact-info><!!-- Kassie''s agent phone: 03-987654 --></contact-info>
<address city="Los Angeles" number="1234" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Actor"/>
<manager employee-number="A0000"/>
<misc-info>One of the most talented actresses on Daytime. Kassie
plays the devious and beautiful Blair Cramer on ABC's
"One Life To Live."</misc-info>
</person>
<person employee-number="A7987" family-name="Smith" first-name="Joe">
<contact-info>
<email address="joes at iro.ibm.com"/>
<mobile-phone number="888-7657765"/>
<home-phone number="03-8767898"/>
<home-phone number="03-8767871"/>
</contact-info>
<address city="New York" number="12789" state="NY" street="W. 15th Ave."/>
<job-info employee-type="Part-Time" is-manager="no" job-description="Hacker"/>
<manager employee-number="A7000"/>
</person>
</addressbook>
'!
----- Method: XMLParserTest>>addressBookXMLWithDTD (in category 'source') -----
addressBookXMLWithDTD
^'<?xml version="1.0" encoding="UTF-8"?>
<!!DOCTYPE addressbook SYSTEM "addressbook.dtd">
<?xml-stylesheet type="text/xsl" href="demo.xsl"?>
<addressbook>
<person employee-number="A0000" family-name="Gates" first-name="Bob">
<contact-info><!!--Confidential--></contact-info>
<address city="Los Angeles" number="1239" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Manager"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7000" family-name="Brown"
first-name="Robert" middle-initial="L.">
<contact-info>
<email address="robb at iro.ibm.com"/>
<home-phone number="03-3987873"/>
</contact-info>
<address city="New York" number="344" state="NY" street="118 St."/>
<job-info employee-type="Full-Time" is-manager="yes" job-description="Group Leader"/>
<manager employee-number="A0000"/>
</person>
<person employee-number="A7890" family-name="DePaiva"
first-name="Kassie" middle-initial="W.">
<contact-info><!!-- Kassie''s agent phone: 03-987654 --></contact-info>
<address city="Los Angeles" number="1234" state="CA" street="Pine Rd."/>
<job-info employee-type="Full-Time" is-manager="no" job-description="Actor"/>
<manager employee-number="A0000"/>
<misc-info>One of the most talented actresses on Daytime. Kassie
plays the devious and beautiful Blair Cramer on ABC's
"One Life To Live."</misc-info>
</person>
<person employee-number="A7987" family-name="Smith" first-name="Joe">
<contact-info>
<email address="joes at iro.ibm.com"/>
<mobile-phone number="888-7657765"/>
<home-phone number="03-8767898"/>
<home-phone number="03-8767871"/>
</contact-info>
<address city="New York" number="12789" state="NY" street="W. 15th Ave."/>
<job-info employee-type="Part-Time" is-manager="no" job-description="Hacker"/>
<manager employee-number="A7000"/>
</person>
</addressbook>
'!
----- Method: XMLParserTest>>testExampleAddressBook (in category 'tests') -----
testExampleAddressBook
| tokenizer |
"self debug: #testExampleAddressBook"
tokenizer := XMLTokenizer on: self addressBookXML readStream.
"We enumerate the first characters of the addressbook example. The file being parsed begins with <addressbook"
self assert: tokenizer next = $<.
self assert: tokenizer next = $a.
self assert: tokenizer next = $d.
self assert: tokenizer next = $d.
self assert: tokenizer next = $r.
"This should not raise an exception."
[tokenizer next notNil] whileTrue: [].!
----- Method: XMLParserTest>>testExampleAddressBookWithDTD (in category 'tests') -----
testExampleAddressBookWithDTD
| tokenizer |
"XMLTokenizer exampleAddressBookWithDTD"
tokenizer := XMLTokenizer on: self addressBookXMLWithDTD readStream.
"This should not raise an exception."
[tokenizer next notNil] whileTrue: [].!
----- Method: XMLParserTest>>testParsing (in category 'tests') -----
testParsing
| xmlDocument root firstPerson numberOfPersons |
"self debug: #testParsing"
xmlDocument := XMLDOMParser parseDocumentFrom: self addressBookXML readStream.
self assert: (xmlDocument isKindOf: XMLDocument).
root := xmlDocument root.
self assert: (root class == XMLElement).
"the tag has to be a symbol!!"
self assert: (root firstTagNamed: 'person') isNil.
self assert: (root firstTagNamed: 'addressbook') isNil.
self assert: (root firstTagNamed: #addressbook) == root.
numberOfPersons := 0.
root tagsNamed: #person do: [:p | numberOfPersons := numberOfPersons + 1].
self assert: numberOfPersons = 4.
firstPerson := root firstTagNamed: #person.
self assert: (firstPerson attributeAt: #'employee-number') = 'A0000'.
self assert: (firstPerson attributeAt: #'family-name') = 'Gates'.
self assert: (firstPerson attributeAt: #'first-name') = 'Bob'.!
----- Method: XMLParserTest>>testParsingCharacters (in category 'tests') -----
testParsingCharacters
| parser |
"This test is actually not that useful. This is not the proper way of using the parser. This test is here just for specification purpose"
"self debug: #testParsingCharacters"
parser := XMLParser on: self addressBookXML readStream.
self assert: parser next = $<.
self assert: parser next = $a.
self assert: parser next = $d.
self assert: parser next = $d.
self assert: parser next = $r.!
----- Method: XMLParserTest>>testPrintElements (in category 'tests') -----
testPrintElements
| node |
node:= (XMLElement new) name: 'foo';
setAttributes: (Dictionary new);
yourself.
self assert: node asString withBlanksTrimmed = '<foo/>'.
node:= (XMLElement new) name: 'foo';
setAttributes: (Dictionary newFromPairs: {'id'. '123'});
yourself.
self assert: node asString withBlanksTrimmed = '<foo id="123"/>'.
node:= (XMLElement new) name: 'foo';
addContent: (XMLStringNode string: 'Hello World');
setAttributes: (Dictionary new);
yourself.
self assert: node asString withBlanksTrimmed = '<foo>Hello World</foo>'.
node:= (XMLElement new) name: 'foo';
addContent: (XMLStringNode string: 'Hello World');
setAttributes: (Dictionary newFromPairs: {'id'. '123'});
yourself.
self assert: node asString withBlanksTrimmed = '<foo id="123">Hello World</foo>'.
!
More information about the Squeak-dev
mailing list
|