[Pkg] The Trunk: XML-Parser-ul.44.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Apr 9 12:30:48 UTC 2017


Levente Uzonyi uploaded a new version of XML-Parser to project The Trunk:
http://source.squeak.org/trunk/XML-Parser-ul.44.mcz

==================== Summary ====================

Name: XML-Parser-ul.44
Author: ul
Time: 9 April 2017, 2:24:08.800111 pm
UUID: d80a95c6-c790-4f15-9525-238ae42fafb6
Ancestors: XML-Parser-ul.43

As Monty pointed out on the mailing list, some out-of-image SAXHandlers assume that the attriubteList passed to its methods is always initialized to a Dictionary. Therefore, I introduced LazyAttributeListSAXDriver, which has the new, lazy behavior, and made SAXDriver a subclass of it with the old behavior.
Introduced SAXHandler class >> #driverClass which returns the SAXDriver to be used.
SAXHandler uses SAXDriver, while XMLDOMParser uses LazyAttributeListSAXDriver.

=============== Diff against XML-Parser-ul.43 ===============

Item was added:
+ XMLTokenizer subclass: #LazyAttributeListSAXDriver
+ 	instanceVariableNames: 'saxHandler scope useNamespaces validateAttributes languageEnvironment'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'XML-Parser'!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleCData: (in category 'handling tokens') -----
+ handleCData: aString
+ 	self saxHandler
+ 		checkEOD; 
+ 		characters: aString!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleComment: (in category 'handling tokens') -----
+ handleComment: aString
+ 	self saxHandler
+ 		checkEOD; 
+ 		comment: aString!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleEndDocument (in category 'handling tokens') -----
+ handleEndDocument
+ 	self saxHandler endDocument!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>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]!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handlePCData: (in category 'handling tokens') -----
+ handlePCData: aString
+ 	self languageEnvironment
+ 		ifNotNil: [aString applyLanguageInformation: self languageEnvironment].
+ 	self saxHandler
+ 		checkEOD; 
+ 		characters: aString!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handlePI:data: (in category 'handling tokens') -----
+ handlePI: piTarget data: piData
+ 	self saxHandler
+ 		checkEOD; 
+ 		processingInstruction: piTarget data: piData!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleStartDocument (in category 'handling tokens') -----
+ handleStartDocument
+ 	self saxHandler startDocument!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleStartTag:attributes:namespaces: (in category 'handling tokens') -----
+ handleStartTag: elementName attributes: attributeList namespaces: namespaces
+ 
+ 	| localName namespace namespaceURI |
+ 	attributeList ifNotNil: [
+ 		(attributeList includesKey: 'xml:lang') ifTrue: [
+ 			languageEnvironment := LanguageEnvironment localeID: (LocaleID isoString: (attributeList at: 'xml:lang')) ] ].
+ 
+ 	self usesNamespaces ifFalse: [
+ 		"call the handler"
+ 		self saxHandler
+ 			checkEOD; 
+ 			startElement: elementName namespaceURI: nil namespace: nil attributeList: attributeList.
+ 		^self ].
+ 	
+ 	self scope enterScope.
+ 	"declare any namespaces"
+ 	namespaces ifNotNil: [
+ 		namespaces keysAndValuesDo: [:ns :uri |
+ 			self scope declareNamespace: ns uri: uri] ].
+ 
+ 	self splitName: elementName into: [:ns :ln |
+ 		namespace := ns.
+ 		localName := ln].
+ 
+ 	namespaceURI := self scope 
+ 		namespaceURIOf: namespace
+ 		ifAbsent: [self parseError: 'Start tag ' , elementName , ' refers to undefined namespace ' , namespace asString].
+ 
+ 	attributeList ifNotNil: [
+ 		self validatesAttributes ifTrue: [
+ 			self scope validateAttributes: attributeList ] ].
+ 	"call the handler"
+ 	self saxHandler
+ 		checkEOD; 
+ 		startElement: localName namespaceURI: namespaceURI namespace: namespace attributeList: attributeList!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>handleWhitespace: (in category 'handling tokens') -----
+ handleWhitespace: aString
+ 	self saxHandler
+ 		checkEOD; 
+ 		ignorableWhitespace: aString!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>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]]!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	useNamespaces := false.
+ 	validateAttributes := false!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>languageEnvironment (in category 'accessing') -----
+ languageEnvironment
+ 	^languageEnvironment!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>saxHandler (in category 'accessing') -----
+ saxHandler
+ 	^saxHandler!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>saxHandler: (in category 'accessing') -----
+ saxHandler: aHandler
+ 	saxHandler := aHandler!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>scope (in category 'namespaces') -----
+ scope
+ 	scope ifNil: [scope := XMLNamespaceScope new].
+ 	^scope!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>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!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>useNamespaces: (in category 'accessing') -----
+ useNamespaces: aBoolean
+ 	useNamespaces := aBoolean!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>usesNamespaces (in category 'testing') -----
+ usesNamespaces
+ 	^useNamespaces!

Item was added:
+ ----- Method: LazyAttributeListSAXDriver>>validatesAttributes (in category 'testing') -----
+ validatesAttributes
+ 	^validateAttributes!

Item was changed:
+ LazyAttributeListSAXDriver subclass: #SAXDriver
+ 	instanceVariableNames: ''
- XMLTokenizer subclass: #SAXDriver
- 	instanceVariableNames: 'saxHandler scope useNamespaces validateAttributes languageEnvironment'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'XML-Parser'!

Item was removed:
- ----- Method: SAXDriver>>handleCData: (in category 'handling tokens') -----
- handleCData: aString
- 	self saxHandler
- 		checkEOD; 
- 		characters: aString!

Item was removed:
- ----- Method: SAXDriver>>handleComment: (in category 'handling tokens') -----
- handleComment: aString
- 	self saxHandler
- 		checkEOD; 
- 		comment: aString!

Item was removed:
- ----- Method: SAXDriver>>handleEndDocument (in category 'handling tokens') -----
- handleEndDocument
- 	self saxHandler endDocument!

Item was removed:
- ----- 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]!

Item was removed:
- ----- Method: SAXDriver>>handlePCData: (in category 'handling tokens') -----
- handlePCData: aString
- 	self languageEnvironment
- 		ifNotNil: [aString applyLanguageInformation: self languageEnvironment].
- 	self saxHandler
- 		checkEOD; 
- 		characters: aString!

Item was removed:
- ----- Method: SAXDriver>>handlePI:data: (in category 'handling tokens') -----
- handlePI: piTarget data: piData
- 	self saxHandler
- 		checkEOD; 
- 		processingInstruction: piTarget data: piData!

Item was removed:
- ----- Method: SAXDriver>>handleStartDocument (in category 'handling tokens') -----
- handleStartDocument
- 	self saxHandler startDocument!

Item was changed:
  ----- Method: SAXDriver>>handleStartTag:attributes:namespaces: (in category 'handling tokens') -----
  handleStartTag: elementName attributes: attributeList namespaces: namespaces
+ 	"Same as super, but will create and pass and empty Dictionary as attributeList if it is empty."
  
  	| localName namespace namespaceURI |
  	attributeList ifNotNil: [
  		(attributeList includesKey: 'xml:lang') ifTrue: [
  			languageEnvironment := LanguageEnvironment localeID: (LocaleID isoString: (attributeList at: 'xml:lang')) ] ].
  
  	self usesNamespaces ifFalse: [
  		"call the handler"
  		self saxHandler
  			checkEOD; 
+ 			startElement: elementName namespaceURI: nil namespace: nil attributeList: (attributeList ifNil: [ Dictionary new ]).
- 			startElement: elementName namespaceURI: nil namespace: nil attributeList: attributeList.
  		^self ].
  	
  	self scope enterScope.
  	"declare any namespaces"
  	namespaces ifNotNil: [
  		namespaces keysAndValuesDo: [:ns :uri |
  			self scope declareNamespace: ns uri: uri] ].
  
  	self splitName: elementName into: [:ns :ln |
  		namespace := ns.
  		localName := ln].
  
  	namespaceURI := self scope 
  		namespaceURIOf: namespace
  		ifAbsent: [self parseError: 'Start tag ' , elementName , ' refers to undefined namespace ' , namespace asString].
  
  	attributeList ifNotNil: [
  		self validatesAttributes ifTrue: [
  			self scope validateAttributes: attributeList ] ].
  	"call the handler"
  	self saxHandler
  		checkEOD; 
+ 		startElement: localName namespaceURI: namespaceURI namespace: namespace attributeList: (attributeList ifNil: [ Dictionary new ])!
- 		startElement: localName namespaceURI: namespaceURI namespace: namespace attributeList: attributeList!

Item was removed:
- ----- Method: SAXDriver>>handleWhitespace: (in category 'handling tokens') -----
- handleWhitespace: aString
- 	self saxHandler
- 		checkEOD; 
- 		ignorableWhitespace: aString!

Item was removed:
- ----- 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]]!

Item was removed:
- ----- Method: SAXDriver>>initialize (in category 'initialization') -----
- initialize
- 	super initialize.
- 	useNamespaces := false.
- 	validateAttributes := false!

Item was removed:
- ----- Method: SAXDriver>>languageEnvironment (in category 'accessing') -----
- languageEnvironment
- 	^languageEnvironment!

Item was removed:
- ----- Method: SAXDriver>>saxHandler (in category 'accessing') -----
- saxHandler
- 	^saxHandler!

Item was removed:
- ----- Method: SAXDriver>>saxHandler: (in category 'accessing') -----
- saxHandler: aHandler
- 	saxHandler := aHandler!

Item was removed:
- ----- Method: SAXDriver>>scope (in category 'namespaces') -----
- scope
- 	scope ifNil: [scope := XMLNamespaceScope new].
- 	^scope!

Item was removed:
- ----- 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!

Item was removed:
- ----- Method: SAXDriver>>useNamespaces: (in category 'accessing') -----
- useNamespaces: aBoolean
- 	useNamespaces := aBoolean!

Item was removed:
- ----- Method: SAXDriver>>usesNamespaces (in category 'testing') -----
- usesNamespaces
- 	^useNamespaces!

Item was removed:
- ----- Method: SAXDriver>>validatesAttributes (in category 'testing') -----
- validatesAttributes
- 	^validateAttributes!

Item was added:
+ ----- Method: SAXHandler class>>driverClass (in category 'accessing') -----
+ driverClass
+ 
+ 	^SAXDriver!

Item was changed:
  ----- Method: SAXHandler class>>on: (in category 'instance creation') -----
  on: aStream
  	| driver parser |
+ 	driver := self driverClass on: aStream.
- 	driver := SAXDriver on: aStream.
  	driver validating: true.
  	parser := self new driver: driver.
  	^parser!

Item was changed:
  ----- Method: SAXHandler class>>parseDTDFrom: (in category 'instance creation') -----
  parseDTDFrom: aStream
  	| driver parser |
+ 	driver := self driverClass on: aStream.
- 	driver := SAXDriver on: aStream.
  	driver validating: true.
  	driver startParsingMarkup.
  	parser := self new driver: driver.
  	parser startDocument.
  	parser parseDocument.
  	^parser!

Item was added:
+ ----- Method: XMLDOMParser class>>driverClass (in category 'accessing') -----
+ driverClass
+ 
+ 	^LazyAttributeListSAXDriver!



More information about the Packages mailing list