SystemOrganization addCategory: #Gofer! Object subclass: #Gofer instanceVariableNames: 'actions repository' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !Gofer methodsFor: 'actions' stamp: 'lr 7/4/2009 18:44'! execute "Perform the selected actions." | loader | loader := MCMultiPackageLoader new. actions do: [ :action | action preExecute ]. actions do: [ :action | action execute: loader ]. loader load. actions do: [ :action | action postExecute ]. MCFileBasedRepository flushAllCaches. MCWorkingCopy changed: #allManagers! ! !Gofer methodsFor: 'initialization' stamp: 'lr 7/4/2009 16:59'! initialize actions := OrderedCollection new! ! !Gofer methodsFor: 'actions' stamp: 'lr 7/4/2009 17:01'! load: aString "Install the package named aString in the image." ^ actions addLast: (GoferLoad on: self name: aString)! ! !Gofer methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:06'! repository ^ repository! ! !Gofer methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:10'! repository: aRepository MCRepositoryGroup default addRepository: aRepository. repository := MCRepositoryGroup default repositories detect: [ :each | aRepository = each ] ifNone: [ nil ]! ! !Gofer methodsFor: 'actions' stamp: 'lr 7/4/2009 17:01'! unload: aString "Remove the package named aString from the image." ^ actions addLast: (GoferUnload on: self name: aString)! ! !Gofer methodsFor: 'repository' stamp: 'lr 7/4/2009 18:00'! url: aString self url: aString username: String new password: String new! ! !Gofer methodsFor: 'repository' stamp: 'lr 7/4/2009 18:01'! url: aString username: aUsernameString password: aPasswordString self repository: (MCHttpRepository location: aString user: aUsernameString password: aPasswordString)! ! Object subclass: #GoferAction instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferAction class methodsFor: 'instance creation' stamp: 'lr 7/4/2009 17:02'! on: aGopher name: aString ^ self basicNew initializeOn: aGopher name: aString! ! !GoferAction methodsFor: 'actions' stamp: 'lr 7/4/2009 17:09'! execute: aLoader self subclassResponsibility! ! !GoferAction methodsFor: 'initialization' stamp: 'lr 7/4/2009 17:29'! initializeOn: aGopher name: aString name := aString! ! !GoferAction methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:13'! name ^ name! ! !GoferAction methodsFor: 'actions' stamp: 'lr 7/4/2009 17:18'! postExecute! ! !GoferAction methodsFor: 'actions' stamp: 'lr 7/4/2009 17:29'! preExecute! ! GoferAction subclass: #GoferLoad instanceVariableNames: 'repository version' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferLoad methodsFor: 'actions' stamp: 'lr 7/4/2009 18:59'! execute: aLoader aLoader installSnapshot: self version snapshot. self version workingCopy repositoryGroup addRepository: self repository! ! !GoferLoad methodsFor: 'private' stamp: 'lr 7/4/2009 18:33'! findLatestVersion | versions | versions := self repository 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' ]. ^ self repository loadVersionFromFileNamed: versions last , '.mcz'! ! !GoferLoad methodsFor: 'initialization' stamp: 'lr 7/4/2009 18:32'! initializeOn: aGopher name: aString super initializeOn: aGopher name: aString. repository := aGopher repository. version := self findLatestVersion! ! !GoferLoad methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:32'! repository ^ repository! ! !GoferLoad methodsFor: 'accessing' stamp: 'lr 7/4/2009 18:24'! version ^ version! ! GoferAction subclass: #GoferUnload instanceVariableNames: 'workingCopy' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferUnload 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 ] ]! ! !GoferUnload 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 ] ] ]! ! !GoferUnload methodsFor: 'actions' stamp: 'lr 7/4/2009 17:14'! execute: aLoader aLoader unloadPackage: self package! ! !GoferUnload methodsFor: 'initialization' stamp: 'lr 7/4/2009 17:41'! initializeOn: aGopher name: aString super initializeOn: aGopher name: aString. workingCopy := MCWorkingCopy registry detect: [ :each | each packageName = aString ] ifNone: [ self error: 'Working copy ' , aString printString , ' not found' ]! ! !GoferUnload methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! package ^ self workingCopy package! ! !GoferUnload methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! packageInfo ^ self workingCopy packageInfo! ! !GoferUnload methodsFor: 'actions' stamp: 'lr 7/4/2009 18:04'! postExecute self cleanupCategories. self cleanupProtocols. self unregisterWorkingCopy. self unregisterPackageInfo. self unregisterRepositories! ! !GoferUnload methodsFor: 'actions' stamp: 'lr 7/4/2009 17:27'! preExecute self packageInfo classes do: [ :class | (class selectors includes: #unload) ifTrue: [ class unload ] ]! ! !GoferUnload methodsFor: 'private' stamp: 'lr 7/4/2009 17:38'! unregisterPackageInfo "Unregister the package information from the system." PackageOrganizer default unregisterPackage: self packageInfo! ! !GoferUnload 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 ]! ! !GoferUnload methodsFor: 'private' stamp: 'lr 7/4/2009 17:52'! unregisterWorkingCopy "Unregister the working copy." MCWorkingCopy registry removeKey: self package ifAbsent: [ ] ! ! !GoferUnload methodsFor: 'accessing' stamp: 'lr 7/4/2009 17:36'! workingCopy ^ workingCopy! ! TestCase subclass: #GoferTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferTest methodsFor: 'as yet unclassified' stamp: 'lr 7/4/2009 17:59'! testLoad Gofer new url: 'http://source.lukas-renggli.ch/flair'; load: 'Flair'! ! !GoferTest methodsFor: 'as yet unclassified' stamp: 'lr 7/4/2009 17:42'! testUnload Gofer new unload: 'Flair'; execute! !