[squeak-dev] Squeak 4.5: XML-Parser-fbs.36.mczcommits at source.squeak.org commits at source.squeak.orgFri Jan 24 19:58:54 UTC 2014
Chris Muller uploaded a new version of XML-Parser to project Squeak 4.5: http://source.squeak.org/squeak45/XML-Parser-fbs.36.mcz ==================== Summary ==================== Name: XML-Parser-fbs.36 Author: fbs Time: 6 November 2013, 6:44:04.952 pm UUID: a2d9791a-c341-564b-9b57-a0fe9f42b66f Ancestors: XML-Parser-ael.35 More #shouldnt:raise: Error fixes. ==================== 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 |