help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] beginnings of STAR packages


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] beginnings of STAR packages
Date: Thu, 21 Jun 2007 13:56:48 +0200
User-agent: Thunderbird 2.0.0.4 (Macintosh/20070604)

Yes, SmallTalk ARchives :-) They work, but they need support in the build system so that packages are installed as STARs.

A .star file must have the same name as the package it contains except for the extension. It must include a package.xml file (singular, not plural). It cannot contain .so modules as these have to be installed separately. To load it, we use the VFS functionality.

Tested by building a MD5.star package:

$ zip -9 ../+build/MD5.star md5.st md5tests.st package.xml

where package.xml is this:

<package>
  <name>MD5</name>
  <sunit>MD5Test</sunit>
  <prereq>SUnit</prereq>

  <filein>md5.st</filein>
  <filein>md5tests.st</filein>
  <module>md5</module>

  <file>md5.st</file>
  <file>md5tests.st</file>
</package>

and doing this:

((((PackageLoader refresh; instVarAt: 14) instVarAt: 1) at: 3) at: #MD5) primFileIn

Don't you all love encapsulation? :-)

Paolo
--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -80,6 +80,18 @@ PackageInfo comment:
 information on a Smalltalk package, and can output my description in
 XML.'!
 
+PackageInfo subclass: #StarPackage
+       instanceVariableNames: 'fileName loadedPackage '
+       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
@@ -272,7 +284,7 @@ at: aString ifAbsent: aBlock
 !
 
 keys
-    ^packages keys
+    ^packages isNil ifTrue: [ #() ] ifFalse: [ packages keys ]
 !
 
 includesKey: aString
@@ -305,6 +317,13 @@ refresh
     packages := LookupTable new.
     [ self parse: file baseDirectories: allDirs ]
         ensure: [ file close ].
+
+    (Directory name: (File pathFor: fileName))
+       namesMatching: '*.star'
+       do: [ :starName |
+           | package |
+           package := Kernel.StarPackage fileName: starName.
+           packages at: package name put: package ]
 !
 
 parse: file baseDirectories: baseDirs
@@ -347,6 +366,17 @@ 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."
@@ -397,10 +427,12 @@ printOn: aStream
        collection: self modules asSortedCollection
        tag: 'module'.
 
-    self
-       printXmlOn: aStream
-       collection: { self directory }
-       tag: 'directory'.
+    self directory isNil
+       ifFalse: [
+           self
+               printXmlOn: aStream
+               collection: { self directory }
+               tag: 'directory' ].
 
     self files size + self builtFiles size > 1 ifTrue: [ aStream nl ].
     self
@@ -489,6 +521,100 @@ directory
 ! !
 
 
+!Kernel.StarPackage class methodsFor: 'accessing'!
+
+fileName: fileName
+    ^self new
+       fileName: fileName;
+       name: (File stripPathFrom: (File stripExtensionFrom: fileName));
+       yourself
+! !
+
+!Kernel.StarPackage methodsFor: 'accessing'!
+
+namespace
+    "Answer the namespace in which the package is loaded."
+    ^self loadedPackage namespace!
+
+features
+    "Answer a (modifiable) Set of features provided by the package."
+    ^self loadedPackage features!
+
+prerequisites
+    "Answer a (modifiable) Set of prerequisites."
+    ^self loadedPackage prerequisites!
+
+builtFiles
+    "Answer a (modifiable) OrderedCollection of files that are part of
+     the package but are not distributed."
+    ^self loadedPackage builtFiles!
+
+files
+    "Answer a (modifiable) OrderedCollection of files that are part of
+     the package."
+    ^self loadedPackage files!
+
+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 loadedPackage fileIns!
+
+libraries
+    "Answer a (modifiable) Set of shared library names
+     that are required to load the package."
+    ^self loadedPackage libraries!
+
+modules
+    "Answer a (modifiable) Set of modules that are
+     required to load the package."
+    ^self loadedPackage modules!
+
+sunitScripts
+    "Answer a (modifiable) OrderedCollection of SUnit scripts that
+     compose the package's test suite."
+    ^self loadedPackage sunitScripts!
+
+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 loadedPackage callouts!
+
+directory
+    ^fileName, '#uzip'!
+
+fileName
+    ^fileName!
+
+fileName: aString
+    fileName := aString!
+
+primFileIn
+    self loadedPackage primFileIn!
+
+loadedPackage
+    | file package |
+    loadedPackage isNil ifFalse: [ ^loadedPackage ].
+
+    file := FileStream open: fileName, '#uzip/package.xml' mode: FileStream 
read.
+    [ package := Package parse: file ]
+       ensure: [ file close ].
+    package isNil ifTrue: [
+       ^self error: 'invalid disabled-package tag inside a star file' ].
+
+    package baseDirectories: { self directory }.
+    package name isNil
+       ifTrue: [ package name: self name ]
+       ifFalse: [
+           package name = self name
+               ifFalse: [ self error: 'invalid package name in package.xml' ] 
].
+
+    loadedPackage := package.
+    ^loadedPackage
+! !
+
+
 !Package class methodsFor: 'instance creation'!
 
 parse: file
@@ -627,10 +753,12 @@ baseDirectories: baseDirectories
 
     files isNil | fileIns isNil | builtFiles isNil ifTrue: [ ^false ].
 
-    baseDirectories
-       do: [ :dir || name |
-            name := Directory append: self directory to: dir.
-            (Directory exists: name) ifTrue: [ directory := name. ^true ] ].
+    self directory printNl isNil ifFalse: [
+        baseDirectories
+           do: [ :dir || name |
+                name := Directory append: self directory to: dir.
+                name := Directory append: self directory to: dir.
+                (Directory exists: name) ifTrue: [ directory := name. ^true ] 
] ].
 
     ^false
 !
@@ -650,9 +778,11 @@ findBaseDirs: baseDirectories forFile: f
      exists.  Return nil if no directory is found that contains the file."
     | name |
     baseDirectories do: [ :dir |
-       name := Directory append: self directory to: dir.
-       name := Directory append: fileName to: name.
-       (File exists: name) ifTrue: [ ^name ] ].
+       name := dir.
+       self directory isNil ifFalse: [
+            name := Directory append: self directory to: dir ].
+        name := Directory append: fileName to: name.
+        (File exists: name) ifTrue: [ ^name ] ].
     ^nil
 !
 
@@ -690,23 +820,26 @@ primFileIn
            nl
     ].
 
-    dir := Directory working.
-    namespace := Namespace current.
-    Namespace current: self createNamespace.
-    Directory working: self directory.
-    self libraries do: [ :each | DLD addLibrary: each ].
-    self modules do: [ :each | DLD addModule: each ].
-
-    PackageLoader ignoreCallouts ifFalse: [
-        self callouts do: [ :func |
-            (CFunctionDescriptor isFunction: func)
-                ifFalse: [ ^self error: 'C callout not available: ', func ]]].
-
-    self fileIns do: [ :each | FileStream fileIn: each ].
-    Directory working: dir.
-    Namespace current: namespace.
-    Smalltalk addFeature: self name.
-    self features do: [ :each | Smalltalk addFeature: each ].
+    [
+        dir := Directory working.
+        namespace := Namespace current.
+        Namespace current: self createNamespace.
+        self directory isNil ifFalse: [ Directory working: self directory ].
+        self libraries do: [ :each | DLD addLibrary: each ].
+        self modules do: [ :each | DLD addModule: each ].
+
+        PackageLoader ignoreCallouts ifFalse: [
+            self callouts do: [ :func |
+                (CFunctionDescriptor isFunction: func)
+                    ifFalse: [ ^self error: 'C callout not available: ', func 
]]].
+
+        self fileIns do: [ :each | FileStream fileIn: each ].
+        Smalltalk addFeature: self name.
+        self features do: [ :each | Smalltalk addFeature: each ].
+    ] ensure: [
+        Directory working: dir.
+        Namespace current: namespace.
+    ]
 ! !
 
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]