"====================================================================== | | PackageLoader Method Definitions | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Steve Byrne. | | This file is part of the GNU Smalltalk class library. | | The GNU Smalltalk class library is free software; you can redistribute it | and/or modify it under the terms of the GNU Lesser General Public License | as published by the Free Software Foundation; either version 2.1, or (at | your option) any later version. | | The GNU Smalltalk class library is distributed in the hope that it will be | useful, but WITHOUT ANY WARRANTY; without even the implied warranty of | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser | General Public License for more details. | | You should have received a copy of the GNU Lesser General Public License | along with the GNU Smalltalk class library; see the file COPYING.LESSER. | If not, write to the Free Software Foundation, 59 Temple Place - Suite | 330, Boston, MA 02111-1307, USA. | ======================================================================" Object subclass: #PackageLoader instanceVariableNames: '' classVariableNames: 'Prerequisites FileIns Directories LoadDate IgnoreCallouts' poolDictionaries: '' category: 'Language-Data types' ! PackageLoader comment: 'I am not part of a standard Smalltalk system. I provide methods for loading packages into a Smalltalk image, correctly handling dependencies.'! !PackageLoader class methodsFor: 'accessing'! directoryFor: package "Answer a complete path to the given package's file-in" | dir | self refreshDependencies. dir := Directories at: package asString. dir size >= 2 ifTrue: [ ((dir at: 1) == $/) | ((dir at: 1) == $\) | (dir includes: $:) ifTrue: [ ^dir ] ]. ^Directory kernel, '/', dir ! fileInsFor: package "Answer a Set of Strings containing the filenames of the given package's file-ins (relative to the directory answered by #directoryFor:)" self refreshDependencies. ^FileIns at: package asString ! prerequisitesFor: package "Answer a Set of Strings containing the prerequisites for the given package" self refreshDependencies. ^Prerequisites at: package asString ! addPackage: package directory: dir fileIn: fileIns needs: prerequisites "Add the given package to the `packages' file, with the given directory (if relative, it is relative to the kernel directory), fileIns and prerequisites. fileIns and prerequisites should be two Collections of Strings. Note that none of this fields are optional. If there are no prere- quisites, just use #('Kernel') as the prerequisites." | file | fileIns isEmpty | prerequisites isEmpty | dir isEmpty ifTrue: [ ^self error: 'parameter not optional' ]. Prerequisites isNil ifFalse: [ Prerequisites at: package asString put: prerequisites asSet. FileIns at: package asString put: fileIns. Directories at: package asString put: dir. ]. file := FileStream open: Directory image, '/packages' mode: FileStream append. file nl; nl; nextPutAll: '# Added on'; print: Date dateAndTimeNow; nl; nextPutAll: package; nl; nextPutAll: ' '. prerequisites do: [ :each | file space; nextPutAll: each ]. file nl; nextPutAll: ' '. fileIns do: [ :each | file space; nextPutAll: each ]. file nl; nextPutAll: ' '; nextPutAll: dir; nl; close. ! ignoreCallouts "Answer whether unavailable C callouts must generate errors or not." ^IgnoreCallouts ! ignoreCallouts: aBoolean "Set whether unavailable C callouts must generate errors or not." IgnoreCallouts := aBoolean ! refreshDependencies "Reload the `packages' file in the image directory" | state | LoadDate isNil ifFalse: [ self stillValid ifTrue: [ ^self ] ]. LoadDate := Date dateAndTimeNow. FileIns := Dictionary new. Directories := Dictionary new. Prerequisites := Dictionary new. state := nil -> 1. self packageFileLinesDo: [ :each | self line: each state: state ]. state value = 1 ifFalse: [ ^self error: 'bad packages file' ]. ! ! !PackageLoader class methodsFor: 'loading'! extractDependenciesFor: packagesList onError: aBlock "Answer an OrderedCollection containing all the packages which you have to load to enable the packages in packagesList, in an appropriate order. For example PackageLoader extractDependenciesFor: #('BloxTestSuite' 'Blox' 'Browser') on a newly built image will evaluate to an OrderedCollection containing 'Kernel', 'C:tclInit', 'Blox', 'BloxTestSuite' and 'Browser'. Note that Blox has been moved before BloxTestSuite. Pass an error message to aBlock if any of the packages needs C call-outs which are not defined." | toBeLoaded oldDep newDep | toBeLoaded := packagesList asOrderedCollection. oldDep := packagesList. [ newDep := Set new. oldDep do: [ :each | (self hasFeature: each) ifFalse: [ (self isCallout: each) ifTrue: [ ^aBlock value: 'C callout not available: ', each ]. (self isLoadable: each) ifFalse: [ ^aBlock value: 'package not available: ', each ]. newDep addAll: (self prerequisitesFor: each) ] ]. "I don't think there will never be lots of packages in newDep (say (more than 5), so I think it is acceptable to remove duplicates this naive way. Note that we remove duplicates from toBeLoaded so that prerequisites are always loaded *before*." toBeLoaded removeAll: newDep ifAbsent: [ :doesNotMatter | ]. newDep isEmpty ] whileFalse: [ toBeLoaded addAllFirst: newDep. "Proceed recursively with the prerequisites for newDep" oldDep := newDep. ]. ^toBeLoaded ! fileInPackage: package "File in the given package into GNU Smalltalk." self fileInPackages: (Array with: package) ! fileInPackages: packagesList "File in all the packages in packagesList into GNU Smalltalk." | toBeLoaded | toBeLoaded := self extractDependenciesFor: packagesList onError: [ :errorMessage | ^self error: errorMessage ]. toBeLoaded do: [ :each | self primFileInPackage: each ] ! ! !PackageLoader class methodsFor: 'testing'! canLoad: package "Answer whether all the needed C call-outs are registered within GNU Smalltalk" self extractDependenciesFor: (Array with: package) onError: [ ^false ]. ^true ! ! !PackageLoader class methodsFor: 'private'! hasFeature: feature "Private - Answer whether the given `feature' (either a C callout in the form C:funcName or a package name) is present in GNU Smalltalk" | descriptor | (self isCallout: feature) ifFalse: [ ^Smalltalk hasFeatures: feature asSymbol ]. ^IgnoreCallouts or: [ CFunctionDescriptor isFunction: (feature copyFrom: 3 to: feature size)] ! isLoadable: feature "Private - Answer whether the packages file includes an entry for `feature'" self refreshDependencies. ^FileIns includesKey: feature asString ! isCallout: feature "Private - Answer whether the given `feature' represents a C callout in the form C:funcName" ^(feature size > 2) and: [ ((feature at: 1) = $C) & ((feature at: 2) = $:) ] ! primFileInPackage: package "Private - File in the given package without paying attention at dependencies and C callout availability" | dir | (self hasFeature: package) ifTrue: [ ^self ]. Transcript nextPutAll: 'Loading package ', package; nl. dir := Directory working. Directory working: (self directoryFor: package). (self fileInsFor: package) do: [ :each | FileStream fileIn: each ]. Directory working: dir. Smalltalk addFeature: package asSymbol ! ! !PackageLoader class methodsFor: 'private - loading packages file'! packageFileName ^Directory image, '/packages' ! packageFileLinesDo: aBlock "Private - Evaluate aBlock once for each non empty line in the packages file, passing it a TokenStream containing the line's contents. Every character in line, after a #, is discarded as a comment. " | file line discard ch tokens | file := FileStream open: self packageFileName mode: FileStream read. line := WriteStream on: (String new: 50). discard := false. [ file atEnd ] whileFalse: [ ch := file next. discard ifFalse: [ (discard := (ch = $#)) ifFalse: [ line nextPut: ch ]. ]. ch = Character cr ifTrue: [ file peekFor: (ch := Character nl) ]. ch = Character nl ifTrue: [ tokens := TokenStream on: line contents. tokens atEnd ifFalse: [ aBlock value: tokens. line emptyStream ]. discard := false ]. ]. tokens := TokenStream on: line contents. tokens atEnd ifFalse: [ aBlock value: tokens. line emptyStream ]. file close ! line: line state: state "Private - Parse the given line (a TokenStream) of the `packages' file, expecting the file as a sequence of: - line with package name - line with package prerequisites (either C callouts in the form C:funcName or package names) - line with file-ins - line with the file-ins' directory, relative to the kernel directory. Blank lines are discarded, like everything coming after a # field." | coll | state value = 1 ifTrue: [ ^state key: line next value: 2 ]. state value = 2 ifTrue: [ coll := Prerequisites at: state key put: Set new. [ line atEnd ] whileFalse: [ coll add: line next ]. ^state value: 3 ]. state value = 3 ifTrue: [ coll := FileIns at: state key put: OrderedCollection new. [ line atEnd ] whileFalse: [ coll add: line next ]. ^state value: 4. ]. state value = 4 ifTrue: [ Directories at: state key put: line next. ^state value: 1. ] ! stillValid | date | date := (File name: self packageFileName) lastModifyTime. (date at: 1) > (LoadDate at: 1) ifTrue: [ ^false ]. (date at: 1) < (LoadDate at: 1) ifTrue: [ ^true ]. ^(date at: 2) < (LoadDate at: 2). ! ! PackageLoader ignoreCallouts: false!