smalltalk
/
osmo-st-all
Archived
1
0
Fork 0
This repository has been archived on 2022-02-17. You can view files and clone it, but cannot push or open issues or pull requests.
osmo-st-all/soapopera/SoXML.st

1419 lines
34 KiB
Smalltalk
Raw Normal View History

PackageLoader fileInPackage: 'XML-XMLParser'.
PackageLoader fileInPackage: 'Iconv'.
Object subclass: SoConstants [
<category: 'SoXML-Base'>
<comment: 'Abstract Constants provider. --- mu 5/3/2001 19:22'>
SoConstants class [
| constDict |
]
SoConstants class >> at: aKey ifAbsentPutValue: aValue [
<category: 'private'>
^self constDict at: aKey ifAbsent: [self constDict at: aKey put: aValue]
]
SoConstants class >> constDict [
<category: 'accessing'>
constDict isNil
ifTrue:
[constDict := (super canUnderstand: #constDict)
ifTrue: [super constDict copy]
ifFalse: [IdentityDictionary new]].
^constDict
]
SoConstants class >> initialize [
"SoConstants initialize"
<category: 'class initialization'>
constDict := nil
]
SoConstants class >> removeKey: aKey [
<category: 'private'>
^self constDict removeKey: aKey
]
]
SoConstants subclass: SoXmlConstants [
<category: 'SoXML-Base'>
<comment: 'XML Constants provider. (I hate to use Pool) --- mu 5/3/2001 19:22'>
SoXmlConstants class >> anyType [
<category: 'xsd types'>
^self at: #anyType ifAbsentPutValue: 'anyType'
]
SoXmlConstants class >> base64 [
<category: 'xsd types'>
^self at: #base64 ifAbsentPutValue: 'base64'
]
SoXmlConstants class >> base64Binary [
<category: 'xsd types'>
^self at: #base64Binary ifAbsentPutValue: 'base64Binary'
]
SoXmlConstants class >> boolean [
<category: 'xsd types'>
^self at: #boolean ifAbsentPutValue: 'boolean'
]
SoXmlConstants class >> float [
<category: 'xsd types'>
^self at: #float ifAbsentPutValue: 'float'
]
SoXmlConstants class >> integer [
<category: 'xsd types'>
^self at: #integer ifAbsentPutValue: 'integer'
]
SoXmlConstants class >> string [
<category: 'xsd types'>
^self at: #string ifAbsentPutValue: 'string'
]
SoXmlConstants class >> time [
<category: 'xsd types'>
^self at: #time ifAbsentPutValue: 'time'
]
SoXmlConstants class >> withColon: aString [
<category: 'utility'>
| wStr |
wStr := WriteStream on: (String new: aString size).
wStr nextPutAll: aString.
wStr nextPut: $:.
^wStr contents
]
SoXmlConstants class >> xmlnsPrefix [
<category: 'prefixes'>
^self at: #xmlnsPrefix ifAbsentPutValue: 'xmlns'
]
SoXmlConstants class >> xmlnsPrefixColon [
<category: 'prefixes'>
^self withColon: self xmlnsPrefix
]
SoXmlConstants class >> xmlnsURI [
<category: 'URIs'>
^self at: #xmlnsURI ifAbsentPutValue: 'http://www.w3.org/2000/xmlns/'
]
SoXmlConstants class >> xmlnsURI: aString [
<category: 'URIs'>
^self constDict at: #xmlnsURI put: aString
]
SoXmlConstants class >> xsdAnyType [
<category: 'xsd types'>
^self at: #xsdAnyType ifAbsentPutValue: self xsdPrefixColon , 'anyType'
]
SoXmlConstants class >> xsdBase64BinaryType [
<category: 'xsd types'>
^self at: #xsdBase64Binary
ifAbsentPutValue: self xsdPrefixColon , 'base64Binary'
]
SoXmlConstants class >> xsdFloatType [
<category: 'xsd types'>
^self at: #xsdFloatType ifAbsentPutValue: self xsdPrefixColon , 'float'
]
SoXmlConstants class >> xsdIntegerType [
<category: 'xsd types'>
^self at: #xsdIntegerType ifAbsentPutValue: self xsdPrefixColon , 'integer'
]
SoXmlConstants class >> xsdPrefix [
<category: 'prefixes'>
^self at: #xsdPrefix ifAbsentPutValue: 'xsd'
]
SoXmlConstants class >> xsdPrefixColon [
<category: 'prefixes'>
^self withColon: self xsdPrefix
]
SoXmlConstants class >> xsdStringType [
<category: 'xsd types'>
^self at: #xsdStringType ifAbsentPutValue: self xsdPrefixColon , 'string'
]
SoXmlConstants class >> xsdTimeType [
<category: 'xsd types'>
^self at: #xsdTime ifAbsentPutValue: self xsdPrefixColon , 'time'
]
SoXmlConstants class >> xsdURI [
<category: 'URIs'>
^self at: #xsdURI ifAbsentPutValue: 'http://www.w3.org/2001/XMLSchema'
]
SoXmlConstants class >> xsdURI: aString [
<category: 'URIs'>
^self constDict at: #xsdURI put: aString
]
SoXmlConstants class >> xsiPrefix [
<category: 'prefixes'>
^self at: #xsiPrefix ifAbsentPutValue: 'xsi'
]
SoXmlConstants class >> xsiPrefixColon [
<category: 'prefixes'>
^self withColon: self xsiPrefix
]
SoXmlConstants class >> xsiType [
"shortcut for performance"
<category: 'attributes'>
^self at: #xsiType ifAbsentPutValue: self xsiPrefixColon , 'type'
]
SoXmlConstants class >> xsiURI [
<category: 'URIs'>
^self at: #xsiURI
ifAbsentPutValue: 'http://www.w3.org/2001/XMLSchema-instance'
]
SoXmlConstants class >> xsiURI: aString [
<category: 'URIs'>
^self constDict at: #xsiURI put: aString
]
]
Object subclass: SoExoboxXMLParserAdapter [
<category: 'SoXML-ParserAdapter'>
<comment: nil>
SoExoboxXMLParserAdapter class >> attribDictFrom: aParsedXMLElement [
<category: 'actions'>
aParsedXMLElement isText ifTrue: [^Dictionary new].
^aParsedXMLElement attributes
]
SoExoboxXMLParserAdapter class >> elementNameFrom: aParsedXMLElement [
"assuming Exobox"
<category: 'actions'>
^aParsedXMLElement tag
]
SoExoboxXMLParserAdapter class >> elementShortNameFrom: aParsedXMLElement [
<category: 'actions'>
^(SoXmlUtil prefixAndLocalNameFrom: aParsedXMLElement tag) last
]
SoExoboxXMLParserAdapter class >> elementValueFrom: aParsedXMLElement [
<category: 'actions'>
| cData |
cData := aParsedXMLElement charactersData.
^cData isEmpty ifTrue: [nil] ifFalse: [cData]
]
SoExoboxXMLParserAdapter class >> elementsFrom: aParsedXMLElement [
<category: 'actions'>
^aParsedXMLElement contents
]
SoExoboxXMLParserAdapter class >> elementsWithoutBlankTextsFrom: aParsedXMLElement [
<category: 'actions'>
aParsedXMLElement isText ifTrue: [^#()].
^aParsedXMLElement contents
reject: [:e | e isText and: [SoPortableUtil isBlank: e text]]
]
SoExoboxXMLParserAdapter class >> elementsWithoutTextsFrom: aParsedXMLElement [
<category: 'actions'>
^aParsedXMLElement contents select: [:e | e isText not]
]
SoExoboxXMLParserAdapter class >> isTextElement: aParsedXMLElement [
<category: 'actions'>
^aParsedXMLElement isText
]
SoExoboxXMLParserAdapter class >> parseXml: xmlString [
"assuming Exobox"
<category: 'actions'>
^(XMLReader fromString: xmlString) root
]
]
Object subclass: SoPortableUtil [
<category: 'SoXML-Base'>
<comment: 'An utility for providing adapter interfaces for various Smalltalk implementations. Currently I support Squeak only. If you would like to use other Smalltalks, you should subclass me. --- mu 5/3/2001 19:23'>
SoPortableUtil class >> convertString: aString from: encoderName [
<category: 'actions'>
"No reason to decode a unicode string"
aString isUnicode ifTrue: [^aString].
^aString asUnicodeString: encoderName
]
SoPortableUtil class >> convertString: aString to: encoderName [
<category: 'actions'>
^I18N.EncodedString fromString: aString encoding: encoderName
]
SoPortableUtil class >> isBlank: aString [
"##ANSI ST specific##"
<category: 'actions'>
^aString allSatisfy: [:i | i isSeparator]
]
SoPortableUtil class >> relativeURIFrom: aString [
"SoPortableUtil relativeURIFrom: 'urn:target:1'"
"SoPortableUtil relativeURIFrom: 'http://localhost:80/target/1'"
"SoPortableUtil relativeURIFrom: '/target1/'"
"SoPortableUtil relativeURIFrom: 'target1'"
"SoPortableUtil relativeURIFrom: '/'"
"##Squeak specific##"
<category: 'actions'>
| uriStr colonIdx schemeName slashIdx |
aString isEmpty ifTrue: [^aString].
uriStr := aString last = $/
ifTrue: [aString copyFrom: 1 to: aString size - 1]
ifFalse: [aString].
colonIdx := uriStr indexOf: $:
ifAbsent: [^(uriStr beginsWith: '/') ifTrue: [uriStr] ifFalse: ['/' , uriStr]].
schemeName := aString copyFrom: 1 to: colonIdx - 1.
(schemeName allSatisfy: [:each | each isLetter])
ifTrue: [uriStr := uriStr copyFrom: colonIdx + 1 to: uriStr size].
((uriStr at: 1) = $/ and: [(uriStr at: 2) = $/])
ifTrue: [uriStr := uriStr copyFrom: 2 to: uriStr size].
slashIdx := uriStr findString: '/' startingAt: 2.
slashIdx = 0
ifFalse: [uriStr := uriStr copyFrom: slashIdx to: uriStr size].
^uriStr
]
SoPortableUtil class >> stackTraceFrom: anError [
<category: 'actions'>
| ctx |
ctx := [anError signalerContext shortStack] on: Error
do: [:ex | ex return: ''].
^ctx
]
SoPortableUtil class >> substringsFrom: aString [
"ToDo: Support other Smalltalks"
"##Squeak specific##"
<category: 'actions'>
aString isNil ifTrue: [^#()].
^aString substrings
]
]
XML.XMLParser subclass: SoXMLParser [
| namespaces |
findNamespace: ns [
[^ super findNamespace: ns]
on: XML.InvalidSignal
do: [^ self customNamespaces at: ns ifAbsentPut: ['unknown'] ]
]
customNamespaces [
^ namespaces ifNil: [namespaces := Dictionary new]
]
]
Object subclass: SoVWXMLParserAdapter [
<category: 'SoXML-ParserAdapter'>
<comment: nil>
SoVWXMLParserAdapter class >> attribDictFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
| dict |
dict := Dictionary new.
aParsedXMLElement isText ifTrue: [^dict].
aParsedXMLElement attributes
do: [:each | dict add: (Association key: each tag asString value: each value)].
^dict
]
SoVWXMLParserAdapter class >> elementNameFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement tag asString
]
SoVWXMLParserAdapter class >> elementShortNameFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement tag type
]
SoVWXMLParserAdapter class >> elementValueFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement isText
ifTrue: [aParsedXMLElement characterData]
ifFalse: [nil]
]
SoVWXMLParserAdapter class >> elementsFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement elements
]
SoVWXMLParserAdapter class >> elementsWithoutBlankTextsFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
aParsedXMLElement isText ifTrue: [^#()].
^aParsedXMLElement elements
reject: [:e | e isText and: [SoPortableUtil isBlank: e characterData]]
]
SoVWXMLParserAdapter class >> elementsWithoutTextsFrom: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement elements select: [:e | e isText not]
]
SoVWXMLParserAdapter class >> isTextElement: aParsedXMLElement [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^aParsedXMLElement isText
]
SoVWXMLParserAdapter class >> parseXml: xmlString [
"TODO: support multi parser"
"assuming VWXML"
<category: 'actions'>
^(SoXMLParser processDocumentString: xmlString
beforeScanDo: [:p | p validate: false]) root
]
]
Object subclass: SoXmlAttributesHolder [
| namespaceDict otherDict |
<category: 'SoXML-Base'>
<comment: 'An utitily class for XML attribute handling. --- mu 5/3/2001 19:22'>
SoXmlAttributesHolder class >> new [
<category: 'instance creation'>
^super new initialize
]
asDictionary [
<category: 'actions'>
| dict |
dict := Dictionary new.
self namespaceDict keysAndValuesDo: [:k :v | dict at: k put: v].
self otherDict keysAndValuesDo: [:k :v | dict at: k put: v].
^dict
]
chopPrefix: attribName [
<category: 'private'>
^(SoXmlUtil prefixAndLocalNameFrom: attribName) last
]
declareNamespace: prefix uri: uri [
<category: 'actions'>
prefix isEmpty
ifTrue: [self namespaceDict at: SoXmlConstants xmlnsPrefix , prefix put: uri]
ifFalse:
[self namespaceDict at: SoXmlConstants xmlnsPrefixColon , prefix put: uri]
]
declaredNamespacePrefixes [
<category: 'actions'>
^self namespaceDict keys collect:
[:each |
each = SoXmlConstants xmlnsPrefix
ifTrue: ['']
ifFalse:
[each copyFrom: SoXmlConstants xmlnsPrefixColon size + 1 to: each size]]
]
declaredNamespaceURIFor: prefix [
<category: 'actions'>
^self declaredNamespaceURIFor: prefix ifAbsent: []
]
declaredNamespaceURIFor: prefix ifAbsent: aBlock [
<category: 'actions'>
^self namespaceDict at: SoXmlConstants xmlnsPrefixColon , prefix
ifAbsent: [self namespaceDict at: SoXmlConstants xmlnsPrefix ifAbsent: aBlock]
]
getAttributeLike: aNameString [
<category: 'actions'>
| key |
key := self otherDict keys detect: [:each | aNameString match: each]
ifNone: [].
key isNil
ifTrue:
[key := self namespaceDict keys detect: [:each | aNameString match: each]
ifNone: []].
^self getAttributeNamed: key
]
getAttributeNamed: aNameString [
<category: 'actions'>
^self otherDict at: aNameString
ifAbsent: [self namespaceDict at: aNameString ifAbsent: []]
]
hasAttributeLike: aNameString [
<category: 'actions'>
^(self otherDict keys detect: [:each | aNameString match: each]
ifNone: [nil]) notNil
or:
[(self namespaceDict keys detect: [:each | aNameString match: each]
ifNone: [nil]) notNil]
]
hasAttributeNamed: aNameString [
<category: 'actions'>
^(self otherDict includesKey: aNameString)
or: [self namespaceDict includesKey: aNameString]
]
initialize [
<category: 'initialize-release'>
namespaceDict := Dictionary new.
otherDict := Dictionary new
]
namespaceDict [
<category: 'accessing'>
^namespaceDict
]
otherDict [
<category: 'accessing'>
^otherDict
]
printOn: aStream [
"super printOn: aStream."
"for Debug"
<category: 'printing'>
self printXmlOn: aStream
]
printXmlOn: aStream [
<category: 'printing'>
self namespaceDict keysAndValuesDo:
[:k :v |
aStream nextPut: Character space.
self writeName: k on: aStream.
aStream nextPutAll: '="'.
self writeValue: v asString on: aStream.
aStream nextPut: $"].
self otherDict keysAndValuesDo:
[:k :v |
aStream nextPut: Character space.
self writeName: k on: aStream.
aStream nextPutAll: '="'.
self writeValue: v asString on: aStream.
aStream nextPut: $"]
]
putAttribute: aNameValueArray [
<category: 'actions'>
self putAttributeNamed: aNameValueArray first asString
value: aNameValueArray last asString
]
putAttributeNamed: attribName value: attribValue [
<category: 'actions'>
((attribName beginsWith: SoXmlConstants xmlnsPrefixColon)
or: [attribName = SoXmlConstants xmlnsPrefix])
ifTrue: [self namespaceDict at: attribName put: attribValue]
ifFalse: [self otherDict at: attribName put: attribValue]
]
removeAttributeNamed: aNameString [
<category: 'actions'>
^self otherDict removeKey: aNameString
]
trimAttributePrefixNamed: attribName [
<category: 'actions'>
| value newKey |
value := self otherDict at: attribName ifAbsent: [].
value isNil ifTrue: [^nil].
newKey := self chopPrefix: attribName.
self removeAttributeNamed: attribName.
^self putAttributeNamed: newKey value: value
]
undeclareNamespaces [
<category: 'actions'>
namespaceDict := Dictionary new
]
writeName: aCharacterArray on: aStream [
"TODO: check illegal characters"
<category: 'private'>
^aStream nextPutAll: aCharacterArray
]
writeValue: aCharacterArray on: aStream [
<category: 'private'>
^SoXmlUtil writeXmlText: aCharacterArray on: aStream
]
]
Object subclass: SoXmlUtil [
<category: 'SoXML-Base'>
<comment: 'An utility for XML processing. It includes: -Parsing XML -Writing XML text I assume you have VWXMLParser. If you would like to use other XML parsers, you should subclass me. --- mu 5/3/2001 19:23'>
SoXmlUtil class [
| convertCharDict parserAdapter useNcr stringEncoding |
]
SoXmlUtil class >> asXmlText: aString [
<category: 'actions'>
| wStr |
wStr := WriteStream on: (String new: aString size).
^(self writeXmlText: aString on: wStr) contents
]
SoXmlUtil class >> attribDictFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter attribDictFrom: aParsedXMLElement
]
SoXmlUtil class >> contentsWithXmlDeclaration: aString [
<category: 'actions'>
| wStr |
wStr := WriteStream on: (String new: 1024).
wStr
nextPutAll: '<?xml version="1.0" encoding="' , self stringEncoding , '"?>'.
2 timesRepeat:
[wStr nextPut: Character cr.
wStr nextPut: Character lf].
wStr nextPutAll: aString.
^SoPortableUtil convertString: wStr contents to: self stringEncoding
]
SoXmlUtil class >> convertCharDict [
<category: 'accessing'>
^convertCharDict
]
SoXmlUtil class >> elementNameFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementNameFrom: aParsedXMLElement
]
SoXmlUtil class >> elementShortNameFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementShortNameFrom: aParsedXMLElement
]
SoXmlUtil class >> elementValueFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementValueFrom: aParsedXMLElement
]
SoXmlUtil class >> elementsFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementsFrom: aParsedXMLElement
]
SoXmlUtil class >> elementsWithoutBlankTextsFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementsWithoutBlankTextsFrom: aParsedXMLElement
]
SoXmlUtil class >> elementsWithoutTextsFrom: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter elementsWithoutTextsFrom: aParsedXMLElement
]
SoXmlUtil class >> initConvertCharDict [
<category: 'private-initialize'>
convertCharDict := Dictionary new.
0 to: 47
do: [:each | convertCharDict at: each put: '&#' , each asString , ';'].
convertCharDict
at: $& asciiValue put: '&amp;';
at: $< asciiValue put: '&lt;';
at: $> asciiValue put: '&gt;';
at: $' asciiValue put: '&apos;';
at: $" asciiValue put: '&quot;'.
convertCharDict
removeKey: Character space asciiValue;
removeKey: Character tab asciiValue;
removeKey: Character cr asciiValue;
removeKey: Character lf asciiValue.
convertCharDict
removeKey: $/ asciiValue;
removeKey: $- asciiValue;
removeKey: $# asciiValue;
removeKey: $. asciiValue
]
SoXmlUtil class >> initParserAdapter [
"Currently YAXO and VWXML conscious"
<category: 'private-initialize'>
parserAdapter := self environment at: #SoVWXMLParserAdapter
ifAbsent:
[self environment at: #SoYaxXMLParserAdapter
ifAbsent:
[Transcript
cr;
show: '##failed to initParserAdapter##']]
]
SoXmlUtil class >> initialize [
"SoXmlUtil initialize"
<category: 'class initialization'>
self initConvertCharDict.
parserAdapter := nil
]
SoXmlUtil class >> isPrefixedName: aString [
"self isPrefixedName: 'aaa:bbb'"
<category: 'actions'>
aString ifNil: [^false].
^aString includes: $:
]
SoXmlUtil class >> isTextElement: aParsedXMLElement [
<category: 'actions-parse'>
^self parserAdapter isTextElement: aParsedXMLElement
]
SoXmlUtil class >> localNameFrom: aString [
<category: 'actions'>
aString ifNil: [^''].
^(self prefixAndLocalNameFrom: aString) last
]
SoXmlUtil class >> parseXml: xmlString [
<category: 'actions-parse'>
^self parserAdapter parseXml: xmlString
]
SoXmlUtil class >> parserAdapter [
<category: 'accessing'>
parserAdapter ifNil: [self initParserAdapter].
^parserAdapter
]
SoXmlUtil class >> parserAdapter: xmlParserAdapter [
<category: 'accessing'>
parserAdapter := xmlParserAdapter
]
SoXmlUtil class >> prefixAndLocalNameFrom: aString [
<category: 'actions'>
| index readStream prefixName localName |
index := aString indexOf: $:.
index = 0
ifTrue:
[prefixName := ''.
localName := aString]
ifFalse:
[readStream := aString readStream.
prefixName := readStream next: index - 1.
readStream skip: 1.
localName := readStream next: aString size - index].
^Array with: prefixName with: localName
]
SoXmlUtil class >> prefixFrom: aString [
<category: 'actions'>
aString ifNil: [^nil].
^(self prefixAndLocalNameFrom: aString) first
]
SoXmlUtil class >> randomPrefix [
<category: 'actions'>
^'ns' , (Random new nextInt: 100000000) printString
]
SoXmlUtil class >> stringEncoding [
<category: 'accessing'>
stringEncoding ifNil: [stringEncoding := 'utf-8'].
^stringEncoding
]
SoXmlUtil class >> stringEncoding: aString [
<category: 'accessing'>
stringEncoding := aString
]
SoXmlUtil class >> useNcr [
<category: 'accessing'>
useNcr ifNil: [useNcr := false].
^useNcr
]
SoXmlUtil class >> useNcr: aBoolean [
<category: 'accessing'>
useNcr := aBoolean == true
]
SoXmlUtil class >> writeUnicodeChar: aCharacter code: charCode on: aWriteStream [
<category: 'private'>
self useNcr
ifTrue:
[aWriteStream
nextPutAll: '&#';
nextPutAll: charCode asString;
nextPut: $;]
ifFalse: [aWriteStream nextPut: aCharacter]
]
SoXmlUtil class >> writeXmlText: aString on: aWriteStream [
<category: 'actions'>
| cDict wStr contentStr |
cDict := self convertCharDict.
wStr := aWriteStream.
contentStr := aString asString.
contentStr do:
[:eachChar |
| val |
val := eachChar charCode.
val >= 127
ifTrue:
[self
writeUnicodeChar: eachChar
code: val
on: wStr]
ifFalse:
[| conv |
conv := cDict at: val ifAbsent: [].
conv isNil
ifTrue: [wStr nextPut: eachChar]
ifFalse: [wStr nextPutAll: conv]]].
^wStr
]
]
Object subclass: SoXmlWrapElement [
| prefixName localName name value attributesHolder children parent isEmptyBody isPrintCDATA |
<category: 'SoXML-Base'>
<comment: 'Representing an XML element. Using XmlUtil, I am independent of XML parser implementations. -- mu 5/3/2001 19:28'>
IsPrintCDATA := nil.
SoXmlWrapElement class >> emptyNamed: anElemName [
<category: 'instance creation'>
^(self named: anElemName) beEmpty
]
SoXmlWrapElement class >> fromXml: xmlString [
<category: 'from xml'>
^self fromXmlElement: (SoXmlUtil parseXml: xmlString)
]
SoXmlWrapElement class >> fromXmlElement: aParsedXmlElement [
<category: 'from xml'>
^self new initByDom: aParsedXmlElement
]
SoXmlWrapElement class >> isPrintCDATA [
<category: 'accessing'>
IsPrintCDATA isNil ifTrue: [IsPrintCDATA := false].
^IsPrintCDATA
]
SoXmlWrapElement class >> isPrintCDATA: aBoolean [
<category: 'accessing'>
IsPrintCDATA := aBoolean
]
SoXmlWrapElement class >> named: anElemName [
<category: 'instance creation'>
^self new name: anElemName
]
SoXmlWrapElement class >> named: anElemName withPrefix: prefix [
<category: 'instance creation'>
prefix ifEmpty: [^self named: anElemName].
^self named: prefix , ':' , anElemName
]
SoXmlWrapElement class >> new [
<category: 'instance creation'>
^super new initialize
]
addChild: anXMLEleemnt [
<category: 'actions'>
anXMLEleemnt isNil ifTrue: [^nil].
anXMLEleemnt parent: self.
^self children add: anXMLEleemnt
]
allDeclaredNamespacePrefixes [
<category: 'actions'>
^self attributesHolder declaredNamespacePrefixes
ifNotEmptyDo: [:prefixes | prefixes]
ifEmpty: [self parent ifNotNilDo: [:par | par declaredNamespacePrefixes]]
]
allDeclaredNamespaceURIFor: prefix [
<category: 'actions'>
^self attributesHolder declaredNamespaceURIFor: prefix
ifAbsent:
[self parent notNil ifTrue: [self parent declaredNamespaceURIFor: prefix]]
]
attributesDictionary [
<category: 'actions'>
^self attributesHolder asDictionary
]
attributesHolder [
<category: 'accessing'>
attributesHolder isNil
ifTrue: [attributesHolder := SoXmlAttributesHolder new].
^attributesHolder
]
attributesHolder: aValue [
<category: 'accessing'>
attributesHolder := aValue
]
basicValue: aValue [
"Exceptional Use: For debugging or performance tuning"
<category: 'accessing'>
value := aValue
]
beEmpty [
<category: 'actions'>
self isEmptyBody: true
]
beShortName [
<category: 'actions'>
self name: self shortName
]
children [
<category: 'accessing'>
children isNil ifTrue: [children := OrderedCollection new].
^children
]
children: aValue [
<category: 'accessing'>
children := aValue
]
createChildNamed: anElemName [
<category: 'actions'>
| child |
child := self class named: anElemName.
self addChild: child.
^child
]
createParentNamed: anElemName [
<category: 'actions'>
| pa |
pa := self class named: anElemName.
pa addChild: self.
^pa
]
declareNamespace: prefix uri: uri [
<category: 'actions'>
self attributesHolder declareNamespace: prefix uri: uri
]
declaredNamespacePrefixes [
<category: 'actions'>
^self attributesHolder declaredNamespacePrefixes
]
declaredNamespaceURIFor: prefix [
<category: 'actions'>
^self attributesHolder declaredNamespaceURIFor: prefix
]
findChild: aBlock [
<category: 'actions'>
^self children detect: aBlock ifNone: []
]
findChildLocalNamed: anElemName [
<category: 'actions'>
^self children detect: [:each | each localName = anElemName] ifNone: []
]
findChildNamed: anElemName [
<category: 'actions'>
^self children detect: [:each | each name = anElemName] ifNone: []
]
findChildren: aBlock [
<category: 'actions'>
^self children select: aBlock
]
findChildrenLocalNamed: anElemName [
<category: 'actions'>
^self children select: [:each | each localName = anElemName]
]
findChildrenNamed: anElemName [
<category: 'actions'>
^self children select: [:each | each name = anElemName]
]
firstChild [
<category: 'actions'>
^self children first
]
getAttributeLike: aNameString [
<category: 'actions'>
^self attributesHolder getAttributeLike: aNameString
]
getAttributeNamed: aNameString [
<category: 'actions'>
^self attributesHolder getAttributeNamed: aNameString
]
hasAttributeLike: aNameString [
<category: 'actions'>
^self attributesHolder hasAttributeLike: aNameString
]
hasAttributeNamed: aNameString [
<category: 'actions'>
^self attributesHolder hasAttributeNamed: aNameString
]
initAttributesBy: aDictionary [
<category: 'private-init'>
aDictionary keysAndValuesDo: [:k :v | self putAttributeNamed: k value: v]
]
initByDom: aParsedXmlElement [
<category: 'private-init'>
| prefixAndLocalName |
self name: (SoXmlUtil elementNameFrom: aParsedXmlElement).
prefixAndLocalName := SoXmlUtil prefixAndLocalNameFrom: self name.
self prefixName: prefixAndLocalName first.
self localName: prefixAndLocalName last.
self initAttributesBy: (SoXmlUtil attribDictFrom: aParsedXmlElement).
self value: (SoXmlUtil elementValueFrom: aParsedXmlElement).
(SoXmlUtil elementsWithoutBlankTextsFrom: aParsedXmlElement)
do: [:each | self initChildElementByDom: each]
]
initChildElementByDom: aParsedXmlElement [
<category: 'private-init'>
| parentElem childElmClass child |
(SoXmlUtil isTextElement: aParsedXmlElement)
ifTrue: [^self value: (SoXmlUtil elementValueFrom: aParsedXmlElement)].
parentElem := SoXmlUtil elementNameFrom: aParsedXmlElement.
childElmClass := self privElementClassFrom: parentElem.
child := childElmClass fromXmlElement: aParsedXmlElement.
self addChild: child
]
initialize [
<category: 'initialize-release'>
isEmptyBody := false
]
isEmptyBody [
<category: 'accessing'>
^isEmptyBody
]
isEmptyBody: aValue [
<category: 'accessing'>
isEmptyBody := aValue
]
isPrintCDATA [
<category: 'accessing'>
isPrintCDATA isNil ifTrue: [isPrintCDATA := self class isPrintCDATA].
^isPrintCDATA
]
isPrintCDATA: aValue [
<category: 'accessing'>
isPrintCDATA := aValue
]
isXmlPrintable [
<category: 'private'>
^self name notNil
]
localName [
<category: 'accessing'>
^localName
]
localName: aValue [
<category: 'accessing'>
localName := aValue
]
name [
<category: 'accessing'>
^name
]
name: aValue [
<category: 'accessing'>
name := aValue
]
parent [
<category: 'accessing'>
^parent
]
parent: aValue [
<category: 'accessing'>
parent := aValue
]
prefixName [
<category: 'accessing'>
^prefixName
]
prefixName: aValue [
<category: 'accessing'>
prefixName := aValue
]
printOn: aStream [
"super printOn: aStream"
"for Debug"
<category: 'printing'>
self printXmlOn: aStream
]
printXmlContentsOn: aStream indent: level [
<category: 'printing'>
self isEmptyBody
ifFalse:
[self value isNil ifFalse: [self privPrintXmlContentOn: aStream].
children isNil
ifFalse:
["ugly - but for performance"
aStream nl.
self privPrintChildrenOn: aStream indent: level + 1.
level timesRepeat: [aStream space]]]
]
printXmlFooterOn: aStream [
<category: 'printing'>
self isXmlPrintable ifFalse: [^self].
self isEmptyBody
ifFalse:
[aStream nextPut: $<.
aStream nextPut: $/.
self writeName: self name on: aStream.
aStream nextPut: $>]
]
printXmlHeaderOn: aStream [
<category: 'printing'>
self isXmlPrintable ifFalse: [^self].
self isEmptyBody
ifTrue:
[aStream nextPut: $<.
self writeName: self name on: aStream.
self privPrintAttribsOn: aStream.
aStream nextPut: $/.
aStream nextPut: $>]
ifFalse:
[aStream nextPut: $<.
self writeName: self name on: aStream.
self privPrintAttribsOn: aStream.
aStream nextPut: $>]
]
printXmlOn: aStream [
<category: 'printing'>
self printXmlOn: aStream indent: 0
]
printXmlOn: aStream indent: level [
<category: 'printing'>
self isXmlPrintable ifFalse: [^self].
level timesRepeat: [aStream space].
self printXmlHeaderOn: aStream.
self printXmlContentsOn: aStream indent: level.
self printXmlFooterOn: aStream.
aStream nl
]
privElementClassFrom: parentXmlElement [
"override to return apporopriate XmlWrapElement"
<category: 'private'>
^self class
]
privPrintAttribsOn: aStream [
<category: 'private'>
attributesHolder isNil ifTrue: [^self]. "ugly - but for performance"
self attributesHolder printXmlOn: aStream
]
privPrintChildrenOn: aStream indent: level [
<category: 'private'>
(self privSortChildren: children)
do: [:each | each printXmlOn: aStream indent: level]
]
privPrintXmlContentOn: aStream [
<category: 'private'>
self isPrintCDATA
ifTrue:
[aStream nextPutAll: '<![CDATA['.
aStream nextPutAll: self value.
aStream nextPutAll: ']]>']
ifFalse: [self writeValue: self value on: aStream]
]
privSortChildren: aCollectionOfXmlElement [
"default do nothing"
<category: 'sorting'>
^aCollectionOfXmlElement
]
putAttribute: aNameValueArray [
<category: 'actions'>
self putAttributeNamed: aNameValueArray first asString
value: aNameValueArray last asString
]
putAttributeNamed: aNameString value: aValueString [
<category: 'actions'>
^self attributesHolder putAttributeNamed: aNameString value: aValueString
]
removeAttributeNamed: aNameString [
<category: 'actions'>
^self attributesHolder removeAttributeNamed: aNameString
]
removeChild: anXMLEleemnt [
<category: 'actions'>
^self children remove: anXMLEleemnt ifAbsent: [nil]
]
shortName [
<category: 'actions'>
| nm idx sz |
nm := self name.
idx := nm indexOf: $: ifAbsent: [^nm].
sz := nm size.
idx > sz ifTrue: [^nm].
^nm copyFrom: idx + 1 to: sz
]
undeclareNamespaces [
<category: 'actions'>
self attributesHolder undeclareNamespaces
]
value [
<category: 'accessing'>
^value
]
value: aValue [
<category: 'accessing'>
aValue isNil ifTrue: [^self].
value := aValue asString
]
writeName: aCharacterArray on: aStream [
"TODO: check illegal characters"
<category: 'private'>
^aStream nextPutAll: aCharacterArray
]
writeValue: aCharacterArray on: aStream [
<category: 'private'>
^SoXmlUtil writeXmlText: aCharacterArray on: aStream
]
xmlString [
<category: 'printing'>
| wStr |
wStr := WriteStream on: (String new: 64).
self printXmlOn: wStr.
^wStr contents
]
]
Object subclass: SoYaxXMLParserAdapter [
<category: 'SoXML-ParserAdapter'>
<comment: nil>
SoYaxXMLParserAdapter class >> attribDictFrom: aParsedXMLElement [
<category: 'actions'>
aParsedXMLElement isText ifTrue: [^Dictionary new].
^aParsedXMLElement attributes
]
SoYaxXMLParserAdapter class >> elementNameFrom: aParsedXMLElement [
"assuming Yax"
<category: 'actions'>
^aParsedXMLElement tag
]
SoYaxXMLParserAdapter class >> elementShortNameFrom: aParsedXMLElement [
"assuming Yax"
<category: 'actions'>
^(SoXmlUtil prefixAndLocalNameFrom: aParsedXMLElement tag) last
]
SoYaxXMLParserAdapter class >> elementValueFrom: aParsedXMLElement [
"assuming Yax"
<category: 'actions'>
| cData |
cData := aParsedXMLElement characterData.
^cData isEmpty ifTrue: [nil] ifFalse: [cData]
]
SoYaxXMLParserAdapter class >> elementsFrom: aParsedXMLElement [
"assuming YAXO"
<category: 'actions'>
^aParsedXMLElement elements , aParsedXMLElement contents
]
SoYaxXMLParserAdapter class >> elementsWithoutBlankTextsFrom: aParsedXMLElement [
"assuming YAXO"
<category: 'actions'>
^aParsedXMLElement elements , (aParsedXMLElement contents
reject: [:each | SoPortableUtil isBlank: each characterData])
]
SoYaxXMLParserAdapter class >> elementsWithoutTextsFrom: aParsedXMLElement [
"assuming YAXO"
<category: 'actions'>
^aParsedXMLElement elements
]
SoYaxXMLParserAdapter class >> isTextElement: aParsedXMLElement [
"assuming Yax"
<category: 'actions'>
^aParsedXMLElement isText
]
SoYaxXMLParserAdapter class >> parseXml: xmlString [
"assuming Yax"
<category: 'actions'>
^(XMLDOMParser parseDocumentFrom: (ReadStream on: xmlString)) topElement
]
]
Eval [
SoConstants initialize.
SoXmlUtil initialize
]