Hi, I've extracted the parser and the xml printer from their related classes into a ParserXMLPackage, ParseXMLPackageGroup and PackagePrinter classes. Making the package less dependant from their printer and parser, easier to read, smaller, ...
Gwen
>From 2c7e68e58596234b7e50db8c0073baa34140baed Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio <[email protected]> Date: Wed, 18 Dec 2013 16:33:06 +0100 Subject: [PATCH] Refactor package classes (extract the pretty printer and the parser) --- ChangeLog | 6 + kernel/PkgLoader.st | 721 ++++++++++++++++++++++++++++++---------------------- 2 files changed, 421 insertions(+), 306 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7b6f5e8..cbbcdd2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2013-12-18 Gwenael Casaccio <[email protected]> + + * kernel/PkgLoader.st: Extract the parser from their classes + into a ParseXMLPackage and a ParseXMLPackageGroup. The same + is done for the pretty printer. + 2013-12-08 Holger Hans Peter Freyther <[email protected]> * kernel/Regex.st: Check for isEmpty of the Interval before diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st index 53d9367..0e98733 100644 --- a/kernel/PkgLoader.st +++ b/kernel/PkgLoader.st @@ -330,50 +330,8 @@ XML.'> parse: file [ <category: 'refreshing'> - | open ch cdata tag package allPackages | - open := false. - allPackages := OrderedCollection new. - - [cdata := cdata isNil - ifTrue: [file upTo: $<] - ifFalse: [cdata , (file upTo: $<)]. - file atEnd] - whileFalse: - [cdata trimSeparators isEmpty - ifFalse: [^self error: 'unexpected character data']. - ch := file peek. - ch == $! ifTrue: [file skipTo: $>]. - ch == $/ - ifTrue: - [file next. - (tag := file upTo: $>) = 'packages' ifTrue: [^self]. - ^self error: 'unmatched end tag ' , tag]. - ch isAlphaNumeric - ifTrue: - [open - ifFalse: - [tag := file upTo: $>. - tag = 'package' - ifTrue: [package := Package new parse: file tag: 'package'] - ifFalse: - [tag = 'packages' ifFalse: [^self error: 'expected packages tag']. - open := true]] - ifTrue: - [file skip: -1. - package := Package parse: file]. - package notNil - ifTrue: - [package name isNil - ifTrue: [^self error: 'missing package name in ' , self fileName]. - - [self testPackageValidity: package. - self packages at: package name put: package. - allPackages add: package] - on: PackageSkip - do: [:ex | ex return]. - open ifFalse: [^allPackages]]. - package := nil]]. - ^allPackages + + ^ ParseXMLPackageGroup parse: file into: self ] testPackageValidity: package [ @@ -455,83 +413,30 @@ PackageContainer subclass: PackageDirectory [ Namespace current: Kernel [ -Object subclass: PackageInfo [ - | name | - - <category: 'Language-Packaging'> - <comment: 'I am not part of a standard Smalltalk system. I store internally the -information on a Smalltalk package, and can output my description in -XML.'> - - createNamespace [ - "Create the path of namespaces indicated by our namespace field in - dot notation, and answer the final namespace" - - <category: 'accessing'> - | ns | - ns := Smalltalk. - self namespace isNil ifTrue: [^ns]. - (self namespace subStrings: $.) do: - [:each | - | key | - key := each asSymbol. - (ns includesKey: key) ifFalse: [ns addSubspace: key]. - ns := ns at: key]. - ^ns - ] - - fileIn [ - "File in the given package and its dependencies." - - <category: 'accessing'> - self name isNil - ifTrue: - ["Other packages cannot be dependent on this one." - - PackageLoader fileInPackages: self prerequisites. - self primFileIn] - ifFalse: [PackageLoader fileInPackage: self name] - ] - - fullPathsOf: aCollection [ - "Resolve the names in aCollection according to the base directories - in baseDirectories, and return the collection with the FilePaths. - Raise a PackageNotAvailable exception if no directory was found for one - or more files in aCollection." +Object subclass: PackageInfoPrinter [ - <category: 'accessing'> - ^aCollection collect: - [:fileName | self fullPathOf: fileName] - ] + | package stream | - / fileName [ - "Resolve the file name according to the base directories in - baseDirectories, and return a FilePath for the full filename. - Raise a PackageNotAvailable exception if no directory was found - for fileName." + PackageInfoPrinter class >> package: aPackage stream: aStream [ - <category: 'accessing'> - ^self fullPathOf: fileName + ^ self new + package: aPackage stream: aStream ] - fullPathOf: fileName [ - <category: 'accessing'> - self subclassResponsibility - ] + package: aPackage stream: aStream [ - isDisabled [ - <category: 'accessing'> - ^false + package := aPackage. + stream := aStream. ] - printXmlOn: aStream collection: aCollection tag: aString indent: indent [ + printXml: aCollection tag: aString indent: indent [ "Private - Print aCollection on aStream as a sequence of aString tags." <category: 'accessing'> aCollection do: [:each | - aStream + stream nextPutAll: ' <'; nextPutAll: aString; nextPut: $>; @@ -543,144 +448,220 @@ XML.'> space: indent] ] - printOn: aStream [ - <category: 'accessing'> - self printOn: aStream indent: 0 - ] - - printOn: aStream indent: indent [ - <category: 'accessing'> - self - printOn: aStream - tag: 'package' - indent: indent - ] - - printOn: aStream tag: tag indent: indent [ + print: tag indent: indent [ "Print a representation of the receiver on aStream (it happens to be XML." <category: 'accessing'> - aStream + stream nextPut: $<; nextPutAll: tag; nextPut: $>; nl; space: indent. - self name isNil + package name isNil ifFalse: - [aStream + [stream nextPutAll: ' <name>'; - nextPutAll: self name; + nextPutAll: package name; nextPutAll: '</name>'; nl; space: indent]. - self url isNil + package url isNil ifFalse: - [aStream + [stream nextPutAll: ' <url>'; - nextPutAll: self url; + nextPutAll: package url; nextPutAll: '</url>'; nl; space: indent]. - self namespace isNil + package namespace isNil ifFalse: - [aStream + [stream nextPutAll: ' <namespace>'; - nextPutAll: self namespace; + nextPutAll: package namespace; nextPutAll: '</namespace>'; nl; space: indent]. - self test isNil + package test isNil ifFalse: - [aStream space: 2. - self test - printOn: aStream + [stream space: 2. + package test + printOn: stream tag: 'test' indent: indent + 2. - aStream + stream nl; space: indent]. self - printXmlOn: aStream - collection: self features asSortedCollection + printXml: package features asSortedCollection tag: 'provides' indent: indent. self - printXmlOn: aStream - collection: self prerequisites asSortedCollection + printXml: package prerequisites asSortedCollection tag: 'prereq' indent: indent. self - printXmlOn: aStream - collection: self sunitScripts + printXml: package sunitScripts tag: 'sunit' indent: indent. self - printXmlOn: aStream - collection: self callouts asSortedCollection + printXml: package callouts asSortedCollection tag: 'callout' indent: indent. self - printXmlOn: aStream - collection: self libraries asSortedCollection + printXml: package libraries asSortedCollection tag: 'library' indent: indent. self - printXmlOn: aStream - collection: self modules asSortedCollection + printXml: package modules asSortedCollection tag: 'module' indent: indent. - self relativeDirectory isNil + package relativeDirectory isNil ifFalse: - [aStream + [stream nextPutAll: ' <directory>'; - nextPutAll: self relativeDirectory; + nextPutAll: package relativeDirectory; nextPutAll: '</directory>'; nl; space: indent]. - self files size + self builtFiles size > 1 + package files size + package builtFiles size > 1 ifTrue: - [aStream + [stream nl; space: indent]. self - printXmlOn: aStream - collection: self fileIns + printXml: package fileIns tag: 'filein' indent: indent. self - printXmlOn: aStream - collection: (self files copy removeAll: self fileIns ifAbsent: []; yourself) + printXml: (package files copy removeAll: package fileIns ifAbsent: []; yourself) tag: 'file' indent: indent. self - printXmlOn: aStream - collection: self builtFiles + printXml: package builtFiles tag: 'built-file' indent: indent. - self startScript isNil + package startScript isNil ifFalse: - [aStream + [stream nextPutAll: ' <start>'; - nextPutAll: self startScript; + nextPutAll: package startScript; nextPutAll: '</start>'; nl; space: indent]. - self stopScript isNil + package stopScript isNil ifFalse: - [aStream + [stream nextPutAll: ' <stop>'; - nextPutAll: self stopScript; + nextPutAll: package stopScript; nextPutAll: '</stop>'; nl; space: indent]. - aStream + stream nextPutAll: '</'; nextPutAll: tag; nextPut: $> ] +] + +] + + +Namespace current: Kernel [ + +Object subclass: PackageInfo [ + | name | + + <category: 'Language-Packaging'> + <comment: 'I am not part of a standard Smalltalk system. I store internally the +information on a Smalltalk package, and can output my description in +XML.'> + + createNamespace [ + "Create the path of namespaces indicated by our namespace field in + dot notation, and answer the final namespace" + + <category: 'accessing'> + | ns | + ns := Smalltalk. + self namespace isNil ifTrue: [^ns]. + (self namespace subStrings: $.) do: + [:each | + | key | + key := each asSymbol. + (ns includesKey: key) ifFalse: [ns addSubspace: key]. + ns := ns at: key]. + ^ns + ] + + fileIn [ + "File in the given package and its dependencies." + + <category: 'accessing'> + self name isNil + ifTrue: + ["Other packages cannot be dependent on this one." + + PackageLoader fileInPackages: self prerequisites. + self primFileIn] + ifFalse: [PackageLoader fileInPackage: self name] + ] + + fullPathsOf: aCollection [ + "Resolve the names in aCollection according to the base directories + in baseDirectories, and return the collection with the FilePaths. + Raise a PackageNotAvailable exception if no directory was found for one + or more files in aCollection." + + <category: 'accessing'> + ^aCollection collect: + [:fileName | self fullPathOf: fileName] + ] + + / fileName [ + "Resolve the file name according to the base directories in + baseDirectories, and return a FilePath for the full filename. + Raise a PackageNotAvailable exception if no directory was found + for fileName." + + <category: 'accessing'> + ^self fullPathOf: fileName + ] + + fullPathOf: fileName [ + <category: 'accessing'> + self subclassResponsibility + ] + + isDisabled [ + <category: 'accessing'> + ^false + ] + + printOn: aStream [ + <category: 'accessing'> + self printOn: aStream indent: 0 + ] + + printOn: aStream indent: indent [ + <category: 'accessing'> + self + printOn: aStream + tag: 'package' + indent: indent + ] + + printOn: aStream tag: tag indent: indent [ + "Print a representation of the receiver on aStream (it happens + to be XML." + + <category: 'accessing'> + (PackageInfoPrinter package: self stream: aStream) + print: tag indent: indent + ] + name [ "Answer the name of the package." @@ -1112,9 +1093,275 @@ ExternalPackage subclass: StarPackage [ +Namespace current: Kernel [ + +Object subclass: ParseXMLPackageGroup [ + | stream packages group | + ParseXMLPackageGroup class >> parse: aStream into: aPackageGroup [ + ^ self new + stream: aStream into: aPackageGroup ; + parse; + packages + ] + + packages [ + + ^ packages + ] + + stream: aStream into: aPackageGroup [ + + stream := aStream. + group := aPackageGroup. + ] + + parse [ + | open ch cdata tag package | + open := false. + packages := OrderedCollection new. + + [cdata := cdata isNil + ifTrue: [stream upTo: $<] + ifFalse: [cdata , (stream upTo: $<)]. + stream atEnd] + whileFalse: + [cdata trimSeparators isEmpty + ifFalse: [^self error: 'unexpected character data']. + ch := stream peek. + ch == $! ifTrue: [stream skipTo: $>]. + ch == $/ + ifTrue: + [stream next. + (tag := stream upTo: $>) = 'packages' ifTrue: [^self]. + ^self error: 'unmatched end tag ' , tag]. + ch isAlphaNumeric + ifTrue: + [open + ifFalse: + [tag := stream upTo: $>. + tag = 'package' + ifTrue: [package := ParseXMLPackage parsePackage: stream] + ifFalse: + [tag = 'packages' ifFalse: [^self error: 'expected packages tag']. + open := true]] + ifTrue: + [stream skip: -1. + package := Package parse: stream]. + package notNil + ifTrue: + [package name isNil + ifTrue: [^self error: 'missing package name in ' , self fileName]. + + [group testPackageValidity: package. + group packages at: package name put: package. + packages add: package] + on: PackageSkip + do: [:ex | ex return]. + open ifFalse: [^packages]]. + package := nil]]. + ^packages + ] +] + +Object subclass: ParseXMLPackage [ + + | stream package | + + ParseXMLPackage class [ | Tags | ] + + ParseXMLPackage class >> tags [ + <category: 'accessing'> + + ^ Tags ifNil: [ Tags := Dictionary from: { + 'file' -> #addFile:. + 'filein' -> #addFileIn:. + 'prereq' -> #addPrerequisite:. + 'provides' -> #addFeature:. + 'module' -> #addModule:. + 'directory' -> #relativeDirectory:. + 'name' -> #name:. + 'url' -> #url:. + 'version' -> #parseVersion:. + 'namespace' -> #namespace:. + 'library' -> #addLibrary:. + 'built-file' -> #addBuiltFile:. + 'sunit' -> #addSunitScript:. + 'start' -> #startScript:. + 'stop' -> #stopScript:. + 'callout' -> #addCallout: } ] + ] + + + ParseXMLPackage class >> parseTest: aStream [ + + ^ self new + parseTestPackage: aStream; + package + ] + + ParseXMLPackage class >> parsePackage: aStream [ + + ^ self new + parsePackage: aStream; + package + ] + + ParseXMLPackage class >> parse: aStream [ + + ^ self new + parse: aStream; + package + ] + + parse: aStream [ + + | ch tag | + stream := aStream. + + [(stream upTo: $<) trimSeparators isEmpty + ifFalse: [self error: 'unexpected cdata']. + stream atEnd ifTrue: [self error: 'expected start tag']. + ch := stream peek. + ch == $! ifTrue: [stream skipTo: $>]. + ch == $/ ifTrue: [self error: 'unexpected end tag ']. + ch isAlphaNumeric + ifTrue: + [tag := stream upTo: $>. + tag = 'package' ifTrue: [package := Package new. ^ self parseTag: tag]. + tag = 'disabled-package' + ifTrue: [package := DisabledPackage new. ^ self parseTag: tag]]] + repeat + + ] + + parsePackage: aStream [ + + stream := aStream. + package := Package new. + self parseTag: 'package' + ] + parseTestPackage: aStream [ + + stream := aStream. + package := TestPackage new. + self parseTag: 'test' + ] + + parseTag: openingTag [ + <category: 'private-initializing'> + | stack cdata ch tag testPackage words | + stack := OrderedCollection new. + stack addLast: openingTag. + + [ + [cdata := cdata isNil + ifTrue: [stream upTo: $<] + ifFalse: [cdata , (stream upTo: $<)]. + stream atEnd] + whileFalse: + [ch := stream peek. + ch == $! ifTrue: [stream skipTo: $>]. + ch == $/ + ifTrue: + [tag := stack removeLast. + stream next. + (stream upTo: $>) = tag + ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag ]. + tag = openingTag ifTrue: [ ^ self ]. + package checkTagIfInPath: tag. + package perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata. + cdata := nil ]. + ch isAlphaNumeric + ifTrue: + [tag := stream upTo: $>. + words := tag substrings. + words first = 'dir' ifTrue: [ + self + dir: stream + tag: (self parseAttributes: (tag copyFrom: words first size + 1)) ] + ifFalse: [ + words first = 'test' + ifTrue: [package test: (ParseXMLPackage parseTest: stream)] + ifFalse: [stack addLast: tag] ]. + cdata trimSeparators isEmpty + ifFalse: [^self error: 'unexpected character data']. + cdata := nil]]] + ensure: + [stack isEmpty + ifFalse: + [self error: 'error in packages file: unmatched start tags' + , stack asArray printString]] + ] + + parseAttributes: aString [ + + | attribute args key value terminator ch | + attribute := ReadStream on: aString. + args := LookupTable new. + [ + attribute atEnd ifTrue: [^args]. + attribute peek isSeparator ifFalse: [ + self error: 'expected separator']. + [ + attribute next. + attribute atEnd ifTrue: [^args]. + attribute peek isSeparator ] whileTrue. + attribute peek isAlphaNumeric ifFalse: [ + self error: 'expected attribute']. + + key := String streamContents: [ :s | + [ + attribute atEnd ifTrue: [ + self error: 'expected attribute']. + ch := attribute next. ch = $= ] whileFalse: [ + ch isAlphaNumeric ifFalse: [ + self error: 'invalid attribute name']. + s nextPut: ch ] ]. + + terminator := attribute next. + (terminator = $' or: [terminator = $"]) ifFalse: [ + self error: 'expected single or double quote']. + + value := String streamContents: [ :s | + [ + attribute atEnd ifTrue: [ + self error: 'expected %1' % { terminator }]. + ch := attribute next. ch = terminator ] whileFalse: [ + s nextPut: ch ] ]. + args at: key put: value. + ] repeat + ] + + dir: file tag: aDictionary [ + | oldPath newPath | + newPath := aDictionary + at: 'name' + ifAbsent: [ self error: 'name attribute is not present in a dir tag' ]. + newPath isEmpty + ifTrue: [ self error: 'name attribute is empty' ]. + + oldPath := package path. + newPath := oldPath, newPath. + (newPath notEmpty and: [newPath last isPathSeparator not]) + ifTrue: [ newPath := newPath, Directory pathSeparatorString]. + package path: newPath. + self parseTag: 'dir'. + package path: oldPath. + ] + + package [ + + ^ package + ] +] + +] + + + Namespace current: Kernel [ Object subclass: Version [ @@ -1202,48 +1449,11 @@ Kernel.PackageInfo subclass: Package [ information on a Smalltalk package, and can output my description in XML.'> - Package class [ | Tags | ] - - Package class >> tags [ - <category: 'accessing'> - - ^ Tags ifNil: [ Tags := Dictionary from: { - 'file' -> #addFile:. - 'filein' -> #addFileIn:. - 'prereq' -> #addPrerequisite:. - 'provides' -> #addFeature:. - 'module' -> #addModule:. - 'directory' -> #relativeDirectory:. - 'name' -> #name:. - 'url' -> #url:. - 'version' -> #parseVersion:. - 'namespace' -> #namespace:. - 'library' -> #addLibrary:. - 'built-file' -> #addBuiltFile:. - 'sunit' -> #addSunitScript:. - 'start' -> #startScript:. - 'stop' -> #stopScript:. - 'callout' -> #addCallout: } ] - ] - Package class >> parse: file [ "Answer a package from the XML description in file." <category: 'instance creation'> - | ch tag | - - [(file upTo: $<) trimSeparators isEmpty - ifFalse: [self error: 'unexpected cdata']. - file atEnd ifTrue: [self error: 'expected start tag']. - ch := file peek. - ch == $! ifTrue: [file skipTo: $>]. - ch == $/ ifTrue: [self error: 'unexpected end tag ']. - ch isAlphaNumeric - ifTrue: - [tag := file upTo: $>. - tag = 'package' ifTrue: [^Package new parse: file tag: tag]. - tag = 'disabled-package' - ifTrue: [^DisabledPackage new parse: file tag: tag]]] - repeat + + ^ ParseXMLPackage parse: file ] test [ @@ -1610,107 +1820,6 @@ XML.'> (aString = 'file' or: [ aString = 'filein' or: [ aString = 'built-file' ] ]) ifFalse: [ self error: 'invalid tag in a dir tag ', aString ] ] - dir: file tag: aDictionary [ - | oldPath newPath | - newPath := aDictionary - at: 'name' - ifAbsent: [ self error: 'name attribute is not present in a dir tag' ]. - newPath isEmpty - ifTrue: [ self error: 'name attribute is empty' ]. - - oldPath := self path. - newPath := oldPath, newPath. - (newPath notEmpty and: [newPath last isPathSeparator not]) - ifTrue: [ newPath := newPath, Directory pathSeparatorString]. - self path: newPath. - self parse: file tag: 'dir'. - self path: oldPath. - ] - - parseAttributes: aString [ - - | attribute args key value terminator ch | - attribute := ReadStream on: aString. - args := LookupTable new. - [ - attribute atEnd ifTrue: [^args]. - attribute peek isSeparator ifFalse: [ - self error: 'expected separator']. - [ - attribute next. - attribute atEnd ifTrue: [^args]. - attribute peek isSeparator ] whileTrue. - attribute peek isAlphaNumeric ifFalse: [ - self error: 'expected attribute']. - - key := String streamContents: [ :s | - [ - attribute atEnd ifTrue: [ - self error: 'expected attribute']. - ch := attribute next. ch = $= ] whileFalse: [ - ch isAlphaNumeric ifFalse: [ - self error: 'invalid attribute name']. - s nextPut: ch ] ]. - - terminator := attribute next. - (terminator = $' or: [terminator = $"]) ifFalse: [ - self error: 'expected single or double quote']. - - value := String streamContents: [ :s | - [ - attribute atEnd ifTrue: [ - self error: 'expected %1' % { terminator }]. - ch := attribute next. ch = terminator ] whileFalse: [ - s nextPut: ch ] ]. - args at: key put: value. - ] repeat - ] - - parse: file tag: openingTag [ - <category: 'private-initializing'> - | stack cdata ch tag testPackage words | - stack := OrderedCollection new. - stack addLast: openingTag. - - [ - [cdata := cdata isNil - ifTrue: [file upTo: $<] - ifFalse: [cdata , (file upTo: $<)]. - file atEnd] - whileFalse: - [ch := file peek. - ch == $! ifTrue: [file skipTo: $>]. - ch == $/ - ifTrue: - [tag := stack removeLast. - file next. - (file upTo: $>) = tag - ifFalse: [^self error: 'error in packages file: unmatched end tag ' , tag ]. - tag = openingTag ifTrue: [ ^ self ]. - self checkTagIfInPath: tag. - self perform: (self class tags at: tag ifAbsent: [ self error: 'invalid tag ', tag ]) with: cdata. - cdata := nil ]. - ch isAlphaNumeric - ifTrue: - [tag := file upTo: $>. - words := tag substrings. - words first = 'dir' ifTrue: [ - self - dir: file - tag: (self parseAttributes: (tag copyFrom: words first size + 1)) ] - ifFalse: [ - words first = 'test' - ifTrue: [self test: (TestPackage new parse: file tag: tag)] - ifFalse: [stack addLast: tag] ]. - cdata trimSeparators isEmpty - ifFalse: [^self error: 'unexpected character data']. - cdata := nil]]] - ensure: - [stack isEmpty - ifFalse: - [self error: 'error in packages file: unmatched start tags' - , stack asArray printString]] - ] ] -- 1.8.3.2
_______________________________________________ help-smalltalk mailing list [email protected] https://lists.gnu.org/mailman/listinfo/help-smalltalk
