[PATCH] packages.xml parsing refactoring

This extracts parsing of the <package> tag into its own method.  This
will allow both parsing of "test-only" subpackages and parsing of an XML
file inside a ZIPped/TARred package.

Paolo

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-404 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-404
M  kernel/PkgLoader.st

* modified files

--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -30,18 +30,6 @@
 |
  ======================================================================"
 
-Object subclass: #Package
- instanceVariableNames: 'name features prerequisites builtFiles files fileIns directory libraries modules callouts namespace sunitScripts'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Language-Packaging'
-!
-
-Package 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.'!
-
 Namespace current: Kernel!
 
 Object subclass: #PackageGroup
@@ -80,8 +68,32 @@ PackageDirectory comment:
 information on a Smalltalk package, and can output my description in
 XML.'!
 
+Object subclass: #PackageInfo
+ instanceVariableNames: 'name '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Language-Packaging'
+!
+
+PackageInfo 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.'!
+
 Namespace current: Smalltalk!
 
+Kernel.PackageInfo subclass: #Package
+ instanceVariableNames: 'features prerequisites builtFiles files fileIns directory libraries modules callouts namespace sunitScripts'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Language-Packaging'
+!
+
+Package 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.'!
+
 Object subclass: #PackageLoader
  instanceVariableNames: ''
  classVariableNames: ''
@@ -286,78 +298,55 @@ refresh
  ifFalse: [ baseDirectories ].
     allDirs isEmpty ifTrue: [ ^self ].
 
-    packages := LookupTable new.
     file := [ FileStream open: fileName mode: FileStream read ]
  on: Error
  do: [ :ex | ^self ].
 
-    stack := OrderedCollection new.
+    packages := LookupTable new.
+    [ self parse: file baseDirectories: allDirs ]
+        ensure: [ file close ].
+!
+
+parse: file baseDirectories: baseDirs
+    | open ch cdata tag package |
+    open := false.
     [ 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: [
-    tag := stack removeLast.
     file next.
-    (file upTo: $>) = tag ifFalse: [
- file close.
- ^self error: 'error in packages file: unmatched end tag ', tag
-    ].
-
-    "I tried to put these from the most common to the least common"
+    ^(tag := file upTo: $>) = 'packages'
+ ifTrue: [ packages ]
+ ifFalse: [ ^self error: 'unmatched end tag ', tag ] ].
 
-    tag = 'file' ifTrue: [ package files add: cdata ] ifFalse: [
-    tag = 'filein' ifTrue: [ package fileIns add: cdata ] ifFalse: [
-    tag = 'prereq' ifTrue: [ package prerequisites add: cdata ] ifFalse: [
-    tag = 'provides' ifTrue: [ package features add: cdata ] ifFalse: [
-    tag = 'module' ifTrue: [ package modules add: cdata ] ifFalse: [
-    tag = 'directory' ifTrue: [ package directory: cdata ] ifFalse: [
-    tag = 'name' ifTrue: [ package name: cdata ] ifFalse: [
-    tag = 'namespace' ifTrue: [ package namespace: cdata ] ifFalse: [
-    tag = 'library' ifTrue: [ package libraries add: cdata ] ifFalse: [
-    tag = 'package' ifTrue: [
- (package baseDirectories: allDirs)
-    ifTrue: [ packages at: package name put: package ]] ifFalse: [
-    tag = 'built-file' ifTrue: [ package builtFiles add: cdata ] ifFalse: [
-    tag = 'sunit' ifTrue: [ package sunitScripts add: cdata ] ifFalse: [
-    tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]]].
-    cdata := nil.
- ].
  ch isAlphaNumeric ifTrue: [
-    stack addLast: (tag := file upTo: $>).
-    tag = 'package' ifTrue: [ package := Package new ].
-    tag = 'disabled-package' ifTrue: [ package := Package new ].
-    cdata := nil
- ].
-    ].
-    file close.
-    stack isEmpty ifFalse: [
- self error: 'error in packages file: unmatched start tags', stack asArray printString
-    ].
+    open
+ ifFalse: [
+    tag := file upTo: $>.
+    tag = 'packages' ifFalse: [ ^self error: 'expected packages tag' ].
+    open := true ]
+ ifTrue: [
+    file skip: -1.
+    package := Package parse: file.
+    (package notNil and: [ package baseDirectories: baseDirs ])
+ ifTrue: [ packages at: package name put: package ] ] ] ]
 ! !
 
 
 
-!Package methodsFor: 'accessing'!
+!Kernel.PackageInfo methodsFor: 'accessing'!
 
 fileIn
     "File in the given package and its dependencies."
     PackageLoader fileInPackage: self name!
 
-printXmlOn: aStream collection: aCollection tag: aString
-    "Private - Print aCollection on aStream as a sequence of aString
-     tags."
-    aCollection do: [ :each |
- aStream
-    nextPutAll: '  <'; nextPutAll: aString; nextPut: $>;
-    nextPutAll: each;
-    nextPutAll: '</'; nextPutAll: aString; nextPut: $>;
-    nl
-    ]!
-
 printOn: aStream
     "Print a representation of the receiver on aStream (it happens
      to be XML."
@@ -413,8 +402,7 @@ printOn: aStream
  collection: { self directory }
  tag: 'directory'.
 
-    files := self files copy addAll: self builtFiles; yourself.
-    files size > 1 ifTrue: [ aStream nl ].
+    self files size + self builtFiles size > 1 ifTrue: [ aStream nl ].
     self
  printXmlOn: aStream
  collection: self files
@@ -437,6 +425,129 @@ name: aString
 
 namespace
     "Answer the namespace in which the package is loaded."
+    self subclassResponsibility!
+
+features
+    "Answer a (modifiable) Set of features provided by the package."
+    self subclassResponsibility!
+
+prerequisites
+    "Answer a (modifiable) Set of prerequisites."
+    self subclassResponsibility!
+
+builtFiles
+    "Answer a (modifiable) OrderedCollection of files that are part of
+     the package but are not distributed."
+    self subclassResponsibility!
+
+files
+    "Answer a (modifiable) OrderedCollection of files that are part of
+     the package."
+    self subclassResponsibility!
+
+allFiles
+    "Answer an OrderedCollection of all the files, both built and
+     distributed, that are part of the package."
+    ^self files, self builtFiles!
+
+fileIns
+    "Answer a (modifiable) OrderedCollections of files that are to be
+     filed-in to load the package.  This is usually a subset of
+     `files' and `builtFiles'."
+    self subclassResponsibility!
+
+libraries
+    "Answer a (modifiable) Set of shared library names
+     that are required to load the package."
+    self subclassResponsibility!
+
+modules
+    "Answer a (modifiable) Set of modules that are
+     required to load the package."
+    self subclassResponsibility!
+
+sunitScript
+    "Answer a String containing a SUnit script that
+     describes the package's test suite."
+    self sunitScripts isEmpty ifTrue: [ ^'' ].
+    ^self sunitScripts fold: [ :a :b | a, ' ', b ]!
+
+sunitScripts
+    "Answer a (modifiable) OrderedCollection of SUnit scripts that
+     compose the package's test suite."
+    self subclassResponsibility!
+
+callouts
+    "Answer a (modifiable) Set of call-outs that are required to load
+     the package.  Their presence is checked after the libraries and
+     modules are loaded so that you can do a kind of versioning."
+    self subclassResponsibility!
+
+directory
+    "Answer the base directory from which to load the package."
+    self subclassResponsibility!
+! !
+
+
+!Package class methodsFor: 'instance creation'!
+
+parse: file
+    | stack cdata ch tag package |
+    stack := OrderedCollection new.
+    [
+ [ 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
+        ].
+
+        "I tried to put these from the most common to the least common"
+
+        tag = 'file' ifTrue: [ package files add: cdata ] ifFalse: [
+        tag = 'filein' ifTrue: [ package fileIns add: cdata ] ifFalse: [
+        tag = 'prereq' ifTrue: [ package prerequisites add: cdata ] ifFalse: [
+        tag = 'provides' ifTrue: [ package features add: cdata ] ifFalse: [
+        tag = 'module' ifTrue: [ package modules add: cdata ] ifFalse: [
+        tag = 'directory' ifTrue: [ package directory: cdata ] ifFalse: [
+        tag = 'name' ifTrue: [ package name: cdata ] ifFalse: [
+        tag = 'namespace' ifTrue: [ package namespace: cdata ] ifFalse: [
+        tag = 'library' ifTrue: [ package libraries add: cdata ] ifFalse: [
+        tag = 'package' ifTrue: [ ^package ] ifFalse: [
+        tag = 'disabled-package' ifTrue: [ ^nil ] ifFalse: [
+        tag = 'built-file' ifTrue: [ package builtFiles add: cdata ] ifFalse: [
+        tag = 'sunit' ifTrue: [ package sunitScripts add: cdata ] ifFalse: [
+        tag = 'callout' ifTrue: [ package callouts add: cdata ]]]]]]]]]]]]]].
+        cdata := nil.
+    ].
+    ch isAlphaNumeric ifTrue: [
+        tag := file upTo: $>.
+        tag = 'package' ifTrue: [ package := Package new ].
+        tag = 'disabled-package' ifTrue: [ package := Package new ].
+ (stack isEmpty and: [ package isNil ])
+    ifTrue: [ self error: 'expected package tag' ].
+        stack addLast: tag.
+        cdata := nil
+    ].
+        ]
+    ] ensure: [
+        stack isEmpty ifFalse: [
+    self error: 'error in packages file: unmatched start tags',
+ stack asArray printString ]
+    ]
+! !
+
+!Package methodsFor: 'accessing'!
+
+namespace
+    "Answer the namespace in which the package is loaded."
     ^namespace!
 
 namespace: aString
@@ -465,11 +576,6 @@ files
     files isNil ifTrue: [ files := OrderedCollection new ].
     ^files!
 
-allFiles
-    "Answer an OrderedCollection of all the files, both built and
-     distributed, that are part of the package."
-    ^self files, self builtFiles!
-
 fileIns
     "Answer a (modifiable) OrderedCollections of files that are to be
      filed-in to load the package.  This is usually a subset of
@@ -489,12 +595,6 @@ modules
     modules isNil ifTrue: [ modules := Set new ].
     ^modules!
 
-sunitScript
-    "Answer a String containing a SUnit script that
-     describes the package's test suite."
-    self sunitScripts isEmpty ifTrue: [ ^'' ].
-    ^self sunitScripts fold: [ :a :b | a, ' ', b ]!
-
 sunitScripts
     "Answer a (modifiable) OrderedCollection of SUnit scripts that
      compose the package's test suite."
@@ -609,6 +709,7 @@ primFileIn
     self features do: [ :each | Smalltalk addFeature: each ].
 ! !
 
+
 !PackageLoader class methodsFor: 'accessing'!
 
 packageAt: package




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk