SystemOrganization addCategory: #Gofer! Object subclass: #Gofer instanceVariableNames: 'packages repository' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !Gofer commentStamp: 'lr 8/17/2009 13:36' prior: 0! Gofer loads, merges and unloads Monticello packages. When loading a package with Gofer, it ... - cleanly loads one or more packages from one or more repositories, - finds the "latest" version of a package matching the given name prefix, - makes sure that dependencies are correctly loaded as well, - makes sure that the repository is assigned to the working copy, and - makes sure that the repository is shared among all packages of the same repository. When unloading a package with Gofer, it ... - cleanly unloads one or more packages from the image, - detects dependencies and automatically unloads these as well, - removes class categories and method protocols that belonged to the packages, - unregisters repositories that are no longer in use. " Example: Load Seaside 2.8 " Gofer new url: 'http://www.squeaksource.com/KomHttpServer'; package: 'DynamicBindings'; package: 'KomServices'; package: 'KomHttpServer'; url: 'http://www.squeaksource.com/Seaside'; package: 'Seaside2.8a'; package: 'Scriptaculous'; load. " Example: Unload Seaside 2.8 " Gofer new package: 'DynamicBindings'; package: 'KomServices'; package: 'KomHttpServer'; package: 'Seaside2'; package: 'Scriptaculous'; unload.! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:27'! croquet: aString self url: 'http://hedgehog.software.umn.edu:8888/' , aString! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:27'! impara: aString self url: 'http://source.impara.de/' , aString! ! !Gofer methodsFor: 'initialization' stamp: 'lr 8/17/2009 13:46'! initialize packages := OrderedCollection new! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/17/2009 14:39'! load "Load the specified packages." ^ (GoferLoad on: self packages) execute! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/17/2009 14:39'! merge "Merge the specified packages." ^ (GoferMerge on: self packages) execute! ! !Gofer methodsFor: 'adding' stamp: 'lr 8/19/2009 10:27'! package: aString self packages addLast: (GoferPackage name: aString repository: self repository)! ! !Gofer methodsFor: 'accessing' stamp: 'lr 8/17/2009 13:46'! packages ^ packages! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:25'! renggli: aString self url: 'http://source.lukas-renggli.ch/' , aString! ! !Gofer methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:06'! repository ^ repository! ! !Gofer methodsFor: 'options' stamp: 'lr 7/5/2009 10:20'! repository: aRepository "Set the reposiory aRepository to load from during the following load actions." MCRepositoryGroup default addRepository: aRepository. repository := MCRepositoryGroup default repositories detect: [ :each | each = aRepository ] ifNone: [ nil ]! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:29'! saltypickle: aString self url: 'http://squeak.saltypickle.com/' , aString! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:28'! squeakfoundation: aString self url: 'http://source.squeakfoundation.org/' , aString! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:28'! squeaksource: aString self url: 'http://www.squeaksource.com/' , aString! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/19/2009 11:15'! unload "Unload the specified packages." ^ (GoferUnload packages: self packages) execute! ! !Gofer methodsFor: 'options' stamp: 'lr 7/5/2009 09:58'! url: anUrlString "Convenience method to set a repository URL using anUrlString." self repository: (MCHttpRepository location: anUrlString user: String new password: String new)! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:26'! wiresong: aString self url: 'http://source.wiresong.ca/' , aString! ! Object subclass: #GoferActionA instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferActionA class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 17:02'! on: aGopher name: aString ^ self basicNew initializeOn: aGopher name: aString! ! !GoferActionA methodsFor: 'actions' stamp: 'lr 7/4/2009 17:09'! execute: aLoader self subclassResponsibility! ! !GoferActionA methodsFor: 'initialization' stamp: 'lr 7/4/2009 17:29'! initializeOn: aGopher name: aString name := aString! ! !GoferActionA methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:13'! name ^ name! ! !GoferActionA methodsFor: 'actions' stamp: 'lr 7/4/2009 17:18'! postExecute! ! !GoferActionA methodsFor: 'actions' stamp: 'lr 7/4/2009 17:29'! preExecute! ! GoferActionA subclass: #GoferLoadA instanceVariableNames: 'repository version' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferLoadA class methodsFor: 'instance creation' stamp: 'lr 7/5/2009 10:14'! on: aGopher version: aVersion ^ self new initializeOn: aGopher version: aVersion! ! !GoferLoadA methodsFor: 'private' stamp: 'lr 7/5/2009 10:15'! addDependenciesTo: aGofer self version allDependenciesDo: [ :each | aGofer actions addLast: (self class on: aGofer version: each) ]! ! !GoferLoadA methodsFor: 'actions' stamp: 'lr 7/5/2009 10:25'! execute: aLoader aLoader updatePackage: self package withSnapshot: self snapshot! ! !GoferLoadA methodsFor: 'private' stamp: 'lr 7/5/2009 10:21'! findLatestVersionIn: aRepository | versions | versions := aRepository allVersionNames select: [ :each | each beginsWith: self name ]. versions := versions asSortedCollection: [ :a :b | (a copyAfterLast: $.) asNumber <= (b copyAfterLast: $.) asNumber ]. versions isEmpty ifTrue: [ self error: 'No version named ' , self name printString , ' found' ]. ^ aRepository loadVersionFromFileNamed: versions last , '.mcz'! ! !GoferLoadA methodsFor: 'initialization' stamp: 'lr 7/5/2009 10:22'! initializeOn: aGopher name: aString super initializeOn: aGopher name: aString. self initializeOn: aGopher version: (self findLatestVersionIn: aGopher repository). self addDependenciesTo: aGopher! ! !GoferLoadA methodsFor: 'initialization' stamp: 'lr 7/5/2009 10:13'! initializeOn: aGopher version: aVersion repository := aGopher repository. version := aVersion! ! !GoferLoadA methodsFor: 'accessing' stamp: 'lr 7/5/2009 10:25'! package ^ self workingCopy package! ! !GoferLoadA methodsFor: 'actions' stamp: 'lr 7/4/2009 20:52'! postExecute self workingCopy repositoryGroup addRepository: self repository. self workingCopy loaded: self version! ! !GoferLoadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:32'! repository ^ repository! ! !GoferLoadA methodsFor: 'accessing' stamp: 'lr 7/5/2009 10:25'! snapshot ^ self version snapshot! ! !GoferLoadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:24'! version ^ version! ! !GoferLoadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 20:49'! workingCopy ^ self version workingCopy! ! GoferActionA subclass: #GoferUnloadA instanceVariableNames: 'workingCopy' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferUnloadA class methodsFor: 'instance creation' stamp: 'lr 7/5/2009 10:40'! on: aGopher workingCopy: aWorkingCopy ^ self new initializeOn: aGopher workingCopy: aWorkingCopy! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/5/2009 10:39'! addDependenciesTo: aGofer | index dependencies | index := 1. dependencies := OrderedCollection new. dependencies addAll: (self workingCopy requiredPackages collect: [ :each | each workingCopy ]). [ index between: 1 and: dependencies size ] whileTrue: [ (dependencies at: index) requiredPackages do: [ :each | (dependencies includes: each workingCopy) ifFalse: [ dependencies addLast: each workingCopy ] ]. index := index + 1 ]. dependencies do: [ :each | aGofer actions addLast: (self class on: aGofer workingCopy: each) ]! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/4/2009 17:44'! cleanupCategories "Cleanup class categories, leftover from the unloading process." self packageInfo systemCategories do: [ :category | (SystemOrganization classesInCategory: category) isEmpty ifTrue: [ SystemOrganization removeSystemCategory: category ] ]! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/4/2009 17:44'! cleanupProtocols "Cleanup the method protocols, left over from method extensions." self packageInfo foreignClasses do: [ :class | (self packageInfo foreignExtensionCategoriesForClass: class) do: [ :category | (class organization listAtCategoryNamed: category) isEmpty ifTrue: [ class organization removeCategory: category ] ] ]! ! !GoferUnloadA methodsFor: 'actions' stamp: 'lr 7/4/2009 17:14'! execute: aLoader aLoader unloadPackage: self package! ! !GoferUnloadA methodsFor: 'initialization' stamp: 'lr 7/5/2009 10:29'! initializeOn: aGopher name: aString super initializeOn: aGopher name: aString. self initializeOn: aGopher workingCopy: (MCWorkingCopy registry detect: [ :each | each packageName = aString ] ifNone: [ self error: 'Working copy ' , aString printString , ' not found' ]). self addDependenciesTo: aGopher! ! !GoferUnloadA methodsFor: 'initialization' stamp: 'lr 7/5/2009 10:29'! initializeOn: aGopher workingCopy: aWorkingCopy workingCopy := aWorkingCopy! ! !GoferUnloadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! package ^ self workingCopy package! ! !GoferUnloadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! packageInfo ^ self workingCopy packageInfo! ! !GoferUnloadA methodsFor: 'actions' stamp: 'lr 7/4/2009 18:04'! postExecute self cleanupCategories. self cleanupProtocols. self unregisterWorkingCopy. self unregisterPackageInfo. self unregisterRepositories! ! !GoferUnloadA methodsFor: 'actions' stamp: 'lr 7/4/2009 17:27'! preExecute self packageInfo classes do: [ :class | (class selectors includes: #unload) ifTrue: [ class unload ] ]! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/4/2009 17:38'! unregisterPackageInfo "Unregister the package information from the system." PackageOrganizer default unregisterPackage: self packageInfo! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/4/2009 19:02'! unregisterRepositories "Remove the repositories if no longer in use by any of the packages." self workingCopy repositoryGroup repositories allButFirst do: [ :repository | MCWorkingCopy allManagers do: [ :copy | (copy repositoryGroup includes: repository) ifTrue: [ ^ self ] ]. MCRepositoryGroup default removeRepository: repository ]! ! !GoferUnloadA methodsFor: 'private' stamp: 'lr 7/4/2009 17:52'! unregisterWorkingCopy "Unregister the working copy." MCWorkingCopy registry removeKey: self package ifAbsent: [ ] ! ! !GoferUnloadA methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! workingCopy ^ workingCopy! ! Object subclass: #GoferOperation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! GoferOperation subclass: #GoferLoad instanceVariableNames: 'loader' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferLoad methodsFor: 'as yet unclassified' stamp: 'lr 8/17/2009 14:42'! execute loader := MCMultiPackageLoader new.! ! GoferOperation subclass: #GoferMerge instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferOperation class methodsFor: 'instance creation' stamp: 'lr 8/19/2009 10:34'! packages: aCollection ^ self basicNew initializePackages: aCollection! ! !GoferOperation methodsFor: 'private' stamp: 'lr 8/19/2009 11:23'! cleanup "Some generic cleanup code." MCDefinition clearInstances. MCFileBasedRepository flushAllCaches. MCWorkingCopy changed: #allManagers! ! !GoferOperation methodsFor: 'running' stamp: 'lr 8/17/2009 14:40'! execute "Execute the receiving action." self subclassResponsibility! ! !GoferOperation methodsFor: 'initialization' stamp: 'lr 8/19/2009 11:02'! initialize! ! !GoferOperation methodsFor: 'initialization' stamp: 'lr 8/19/2009 11:02'! initializePackages: aCollection self initialize! ! GoferOperation subclass: #GoferUnload instanceVariableNames: 'unloader workingCopies' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 11:04'! addWorkingCopy: aWorkingCopy self addWorkingCopy: aWorkingCopy seen: Set new! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 11:05'! addWorkingCopy: aWorkingCopy seen: aSet (aSet includes: aWorkingCopy) ifTrue: [ ^ self ]. aSet add: aWorkingCopy. aWorkingCopy requiredPackages reverseDo: [ :each | self addWorkingCopy: each workingCopy seen: aSet ]. workingCopies addLast: aWorkingCopy! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 11:21'! cleanupCategories: aWorkginCopy "Cleanup class categories, leftover from the unloading process." aWorkginCopy packageInfo systemCategories do: [ :category | (SystemOrganization classesInCategory: category) isEmpty ifTrue: [ SystemOrganization removeSystemCategory: category ] ]! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 10:58'! cleanupProtocols: aWorkginCopy "Cleanup the method protocols, left over from method extensions." aWorkginCopy packageInfo foreignClasses do: [ :class | (aWorkginCopy packageInfo foreignExtensionCategoriesForClass: class) do: [ :category | (class organization listAtCategoryNamed: category) isEmpty ifTrue: [ class organization removeCategory: category ] ] ]! ! !GoferUnload methodsFor: 'running' stamp: 'lr 8/19/2009 11:25'! execute self workingCopies do: [ :copy | self unloadPackage: copy. self finalizeClasses: copy ]. self unloader load. self workingCopies do: [ :copy | self cleanupCategories: copy. self cleanupProtocols: copy. self unregisterWorkingCopy: copy. self unregisterPackageInfo: copy. self unregisterRepositories: copy ]. self cleanup! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 11:05'! finalizeClasses: aWorkingCopy "Call the unload metod of classes if present." aWorkingCopy packageInfo classes do: [ :class | (class selectors includes: #unload) ifTrue: [ class unload ] ]! ! !GoferUnload methodsFor: 'initialization' stamp: 'lr 8/19/2009 11:18'! initialize super initialize. unloader := MCMultiPackageLoader new. workingCopies := OrderedCollection new! ! !GoferUnload methodsFor: 'initialization' stamp: 'lr 8/19/2009 11:16'! initializePackages: aCollection super initializePackages: aCollection. aCollection do: [ :package | | copy | copy := MCWorkingCopy registry detect: [ :each | package name beginsWith: each packageName ] ifNone: [ self error: 'Working copy ' , package name printString , ' not found' ]. self addWorkingCopy: copy ]! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 11:18'! unloadPackage: aWorkingCopy self unloader unloadPackage: aWorkingCopy package! ! !GoferUnload methodsFor: 'accessing' stamp: 'lr 8/19/2009 11:18'! unloader "Answer the monticello loader object." ^ unloader! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 10:57'! unregisterPackageInfo: aWorkingCopy "Unregister the package information from the system." PackageOrganizer default unregisterPackage: aWorkingCopy packageInfo! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 10:57'! unregisterRepositories: aWorkingCopy "Remove the repositories if no longer in use by any of the packages." aWorkingCopy repositoryGroup repositories allButFirst do: [ :repository | MCWorkingCopy allManagers do: [ :copy | (copy repositoryGroup includes: repository) ifTrue: [ ^ self ] ]. MCRepositoryGroup default removeRepository: repository ]! ! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 10:58'! unregisterWorkingCopy: aWorkingCopy "Unregister the working copy." MCWorkingCopy registry removeKey: aWorkingCopy package ifAbsent: [ ] ! ! !GoferUnload methodsFor: 'accessing' stamp: 'lr 8/19/2009 11:01'! workingCopies "Answer the working copies to be unloaded." ^ workingCopies! ! Object subclass: #GoferPackage instanceVariableNames: 'name repository cache' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferPackage class methodsFor: 'instance creation' stamp: 'lr 8/19/2009 10:27'! name: aString repository: aRepository ^ self basicNew initializeName: aString repository: aRepository! ! !GoferPackage methodsFor: 'initialization' stamp: 'lr 8/19/2009 10:26'! initializeName: aString repository: aRepository name := aString. repository := aRepository. cache := Dictionary new! ! !GoferPackage methodsFor: 'accessing-loading' stamp: 'lr 8/19/2009 10:14'! loadablePackage ^ cache at: #loadablePackage ifAbsentPut: [ self loadableVersion package ]! ! !GoferPackage methodsFor: 'accessing-loading' stamp: 'lr 8/19/2009 10:13'! loadableSnapshot ^ cache at: #loadableSnapshot ifAbsentPut: [ self loadableVersion snapshot ]! ! !GoferPackage methodsFor: 'accessing-loading' stamp: 'lr 8/19/2009 10:13'! loadableVersion ^ cache at: #loadableVersion ifAbsentPut: [ | versions | versions := self repository allVersionNames select: [ :each | each beginsWith: self package ]. versions := versions asSortedCollection: [ :a :b | (a copyAfterLast: $.) asNumber <= (b copyAfterLast: $.) asNumber ]. versions isEmpty ifTrue: [ self error: 'No version named ' , self package printString , ' found' ]. self repository loadVersionFromFileNamed: versions last , '.mcz' ]! ! !GoferPackage methodsFor: 'accessing-loading' stamp: 'lr 8/19/2009 10:15'! loadableWorkingCopy ^ cache at: #loadableWorkingCopy ifAbsentPut: [ self loadableVersion workingCopy ]! ! !GoferPackage methodsFor: 'accessing' stamp: 'lr 8/19/2009 10:30'! name "Answer the package name or prefix." ^ name! ! !GoferPackage methodsFor: 'printing' stamp: 'lr 8/19/2009 10:30'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' name: '; print: self name! ! !GoferPackage methodsFor: 'accessing' stamp: 'lr 8/17/2009 13:55'! repository "Answer the repository instance of this package, or nil." ^ repository! ! !GoferPackage methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2009 10:32'! workingCopy ^ cache at: #workingCopy ifAbsentPut: [ MCWorkingCopy registry detect: [ :each | self name beginsWith: each packageName ] ifNone: [ self error: 'Working copy ' , self name printString , ' not found' ] ]! ! TestCase subclass: #GoferTest instanceVariableNames: 'gofer' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferTest methodsFor: 'running' stamp: 'lr 7/10/2009 16:32'! setUp super setUp. gofer := Gofer new! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:51'! testCroquet gofer croquet: 'Hermes'. self assert: gofer repository locationWithTrailingSlash = 'http://hedgehog.software.umn.edu:8888/Hermes/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:56'! testImpara gofer impara: 'Tweak'. self assert: gofer repository locationWithTrailingSlash = 'http://source.impara.de/Tweak/'! ! !GoferTest methodsFor: 'testing' stamp: 'lr 8/19/2009 10:05'! testLoadUnload gofer renggli: 'pieraddons'; package: 'Pier-Setup'. self assert: gofer packages size = 1. self assert: gofer packages first repository = gofer repository. self assert: gofer packages first package = 'Pier-Setup'. self shouldnt: [ gofer load ] raise: Error. self shouldnt: [ gofer unload ] raise: Error! ! !GoferTest methodsFor: 'testing' stamp: 'lr 8/19/2009 10:08'! testPackages self assert: gofer packages isEmpty. gofer package: 'Foo'. self assert: gofer packages size = 1. self assert: gofer packages first package = 'Foo'. self assert: gofer packages first repository isNil. gofer url: 'http://foo.com'; package: 'Bar'. self assert: gofer packages size = 2. self assert: gofer packages last package = 'Bar'. self assert: gofer packages last repository locationWithTrailingSlash = 'http://foo.com/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:56'! testRenggli gofer renggli: 'pier'. self assert: gofer repository locationWithTrailingSlash = 'http://source.lukas-renggli.ch/pier/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:47'! testRepository gofer repository: MCDirectoryRepository new. self assert: (gofer repository isKindOf: MCDirectoryRepository)! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:53'! testSaltypickle gofer saltypickle: 'GraphViz'. self assert: gofer repository locationWithTrailingSlash = 'http://squeak.saltypickle.com/GraphViz/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:57'! testSqueakfoundation gofer squeakfoundation: '39a'. self assert: gofer repository locationWithTrailingSlash = 'http://source.squeakfoundation.org/39a/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:54'! testSqueaksource gofer squeaksource: 'Seaside29'. self assert: gofer repository locationWithTrailingSlash = 'http://www.squeaksource.com/Seaside29/'! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:47'! testUrl gofer url: 'http://source.lukas-renggli.ch/pier'. self assert: (gofer repository isKindOf: MCHttpRepository). self assert: (gofer repository locationWithTrailingSlash = 'http://source.lukas-renggli.ch/pier/')! ! !GoferTest methodsFor: 'testing-options' stamp: 'lr 7/10/2009 16:55'! testWiresong gofer wiresong: 'ob'. self assert: gofer repository locationWithTrailingSlash = 'http://source.wiresong.ca/ob/'! !