SystemOrganization addCategory: #Gofer! Object subclass: #Gofer instanceVariableNames: 'packages repository' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !Gofer commentStamp: 'lr 8/19/2009 15:04' prior: 0! Gofer loads, updates, merges, diffs, reverts and unloads Monticello packages. When loading/updating/merging a package with Gofer, it ... - cleanly loads the code 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 belong to the packages, - unregisters repositories that are no longer in use. " Example: Working with Seaside 2.8 " " 1. Specify the packages (and repositories) to work with " gofer := Gofer new. gofer squeaksource: 'KomHttpServer'; addAll: #( 'DynamicBindings' 'KomServices' 'KomHttpServer' ); squeaksource: 'Seaside'; addAll: #( 'Seaside2.8a' 'Scriptaculous' ). " 2. Perform some operations on the packages " gofer load. gofer merge. gofer diff. gofer commit: '' gofer revert. gofer unload.! !Gofer methodsFor: 'adding' stamp: 'lr 8/19/2009 14:43'! add: aString self packages addLast: (GoferPackage name: aString repository: self repository)! ! !Gofer methodsFor: 'adding' stamp: 'lr 8/19/2009 14:43'! addAll: aCollection aCollection do: [ :each | self add: each ]! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/19/2009 14:42'! commit "Commit the specified packages." ^ self commit: nil! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/19/2009 14:42'! commit: aString "Commit the specified packages with the commit message aString." ^ (GoferCommit on: self packages) message: aString; execute! ! !Gofer methodsFor: 'options-repositories' stamp: 'lr 7/10/2009 16:27'! croquet: aString self url: 'http://hedgehog.software.umn.edu:8888/' , aString! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/19/2009 13:58'! diff "Display the differences between the working copy and the base of the specified packages." ^ (GoferDiff on: self packages) execute! ! !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: '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 8/19/2009 14:51'! repository: aRepository "Set the repository 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: 'actions' stamp: 'lr 8/19/2009 13:19'! revert "Revert the specified packages to the currently loaded version." ^ (GoferRevert on: self packages) execute! ! !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:50'! unload "Unload the specified packages." ^ (GoferUnload on: self packages) execute! ! !Gofer methodsFor: 'actions' stamp: 'lr 8/19/2009 14:47'! update "Update the specified packages, this is the same as loading." ^ self load! ! !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: #GoferOperation instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! GoferOperation subclass: #GoferAbsent instanceVariableNames: 'repositories' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferAbsent methodsFor: 'private' stamp: 'lr 8/19/2009 13:59'! addPackage: aPackage | version | version := aPackage findLatestVersion. version withAllDependenciesDo: [ :dependency | (repositories at: dependency ifAbsentPut: [ Set new ]) add: aPackage repository ]. self model addVersion: version! ! !GoferAbsent methodsFor: 'initialization' stamp: 'lr 8/19/2009 13:54'! initialize super initialize. repositories := Dictionary new! ! !GoferAbsent methodsFor: 'initialization' stamp: 'lr 8/19/2009 13:54'! initializeOn: aCollection super initializeOn: aCollection. aCollection do: [ :package | self addPackage: package ]! ! !GoferAbsent methodsFor: 'private' stamp: 'lr 8/19/2009 14:50'! updateRepositories repositories keysAndValuesDo: [ :version :collection | collection do: [ :repository | version workingCopy repositoryGroup addRepository: repository ] ]! ! GoferAbsent subclass: #GoferLoad instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferLoad methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'! defaultModel ^ MCVersionLoader new! ! !GoferLoad methodsFor: 'running' stamp: 'lr 8/19/2009 13:59'! execute self model load. self updateRepositories! ! GoferAbsent subclass: #GoferMerge instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferMerge methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'! defaultModel ^ MCVersionMerger new! ! !GoferMerge methodsFor: 'running' stamp: 'lr 8/19/2009 14:00'! execute [ self model merge ] on: MCMergeResolutionRequest do: [ :request | request merger conflicts isEmpty ifTrue: [ request resume: true ] ifFalse: [ request pass ] ]. self updateRepositories! ! !GoferOperation class methodsFor: 'instance creation' stamp: 'lr 8/19/2009 11:50'! on: aCollection ^ self basicNew initializeOn: 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: 'private' stamp: 'lr 8/19/2009 14:01'! defaultModel ^ nil! ! !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 14:01'! initialize model := self defaultModel! ! !GoferOperation methodsFor: 'initialization' stamp: 'lr 8/19/2009 11:50'! initializeOn: aCollection self initialize! ! !GoferOperation methodsFor: 'accessing' stamp: 'lr 8/19/2009 14:51'! model "Answer the Monticello model, if available." ^ model! ! GoferOperation subclass: #GoferPresent instanceVariableNames: 'workingCopies' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! GoferPresent subclass: #GoferCommit instanceVariableNames: 'message repositories' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferCommit methodsFor: 'private' stamp: 'lr 8/19/2009 14:32'! addRequiredCopy: aWorkingCopy repository: aRepository super addRequiredCopy: aWorkingCopy repository: aRepository. repositories at: aWorkingCopy put: (aRepository ifNil: [ aWorkingCopy repositoryGroup repositories detect: [ :each | each isKindOf: MCHttpRepository ] ifNone: [ self error: 'No repository found for ' , aWorkingCopy packageName ] ])! ! !GoferCommit methodsFor: 'running' stamp: 'lr 8/19/2009 14:50'! commit: aWorkingCopy | version | version := [ aWorkingCopy newVersion ] on: MCVersionNameAndMessageRequest do: [ :notifcation | self message isNil ifTrue: [ self message: notifcation outer last ]. notifcation resume: (Array with: notifcation suggestedName with: self message) ]. (repositories at: aWorkingCopy) storeVersion: version! ! !GoferCommit methodsFor: 'running' stamp: 'lr 8/19/2009 14:37'! execute self workingCopies do: [ :each | each needsSaving ifTrue: [ self commit: each ] ]! ! !GoferCommit methodsFor: 'initialization' stamp: 'lr 8/19/2009 14:32'! initialize super initialize. repositories := Dictionary new! ! !GoferCommit methodsFor: 'accessing' stamp: 'lr 8/19/2009 14:32'! message ^ message! ! !GoferCommit methodsFor: 'accessing' stamp: 'lr 8/19/2009 14:32'! message: anObject message := anObject! ! GoferPresent subclass: #GoferDiff instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferDiff methodsFor: 'private' stamp: 'lr 8/19/2009 14:21'! addRequiredCopy: aWorkingCopy repository: aRepository | reposiory patch | reposiory := aRepository ifNil: [ aWorkingCopy repositoryGroup ]. patch := aWorkingCopy package snapshot patchRelativeToBase: (reposiory versionWithInfo: aWorkingCopy ancestors first) snapshot. aWorkingCopy modified: patch isEmpty not. self model operations addAll: patch operations! ! !GoferDiff methodsFor: 'private' stamp: 'lr 8/19/2009 14:02'! defaultModel ^ MCPatch operations: OrderedCollection new! ! !GoferDiff methodsFor: 'running' stamp: 'lr 8/19/2009 14:06'! execute self model isEmpty ifFalse: [ self model browse ]! ! !GoferPresent methodsFor: 'private' stamp: 'lr 8/19/2009 14:19'! addRequiredCopy: aWorkingCopy repository: aRepository (workingCopies includes: aWorkingCopy) ifTrue: [ ^ self ]. workingCopies addLast: aWorkingCopy. aWorkingCopy requiredPackages reverseDo: [ :each | self addRequiredCopy: each workingCopy repository: aRepository ]! ! !GoferPresent methodsFor: 'private' stamp: 'lr 8/19/2009 14:18'! addWorkingCopy: aWorkingCopy repository: aRepository self addRequiredCopy: aWorkingCopy repository: aRepository! ! !GoferPresent methodsFor: 'cleaning' stamp: 'lr 8/19/2009 13:50'! cleanup: aWorkingCopy self cleanupCategories: aWorkingCopy. self cleanupProtocols: aWorkingCopy! ! !GoferPresent methodsFor: 'cleaning' stamp: 'lr 8/19/2009 14:50'! cleanupCategories: aWorkingCopy aWorkingCopy packageInfo systemCategories do: [ :category | (SystemOrganization classesInCategory: category) isEmpty ifTrue: [ SystemOrganization removeSystemCategory: category ] ]! ! !GoferPresent methodsFor: 'cleaning' stamp: 'lr 8/19/2009 14:50'! cleanupProtocols: aWorkingCopy aWorkingCopy packageInfo foreignClasses do: [ :class | (aWorkingCopy packageInfo foreignExtensionCategoriesForClass: class) do: [ :category | (class organization listAtCategoryNamed: category) isEmpty ifTrue: [ class organization removeCategory: category ] ] ]! ! !GoferPresent methodsFor: 'initialization' stamp: 'lr 8/19/2009 13:14'! initialize super initialize. workingCopies := OrderedCollection new! ! !GoferPresent methodsFor: 'initialization' stamp: 'lr 8/19/2009 14:18'! initializeOn: aCollection super initializeOn: aCollection. aCollection do: [ :package | self addWorkingCopy: package findWorkingCopy repository: package repository ]! ! !GoferPresent methodsFor: 'accessing' stamp: 'lr 8/19/2009 13:43'! workingCopies "Answer the working copies to be operated on." ^ workingCopies! ! GoferPresent subclass: #GoferRevert instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferRevert methodsFor: 'private' stamp: 'lr 8/19/2009 14:19'! addWorkingCopy: aWorkingCopy repository: aRepository | version | super addWorkingCopy: aWorkingCopy repository: aRepository. version := (aRepository ifNil: [ aWorkingCopy repositoryGroup ]) versionWithInfo: aWorkingCopy ancestors first. self model addVersion: version! ! !GoferRevert methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'! defaultModel ^ MCVersionLoader new! ! !GoferRevert methodsFor: 'running' stamp: 'lr 8/19/2009 14:00'! execute self workingCopies do: [ :each | each modified: false ]. self model load. self workingCopies do: [ :each | self cleanup: each ]! ! GoferPresent subclass: #GoferUnload instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Gofer'! !GoferUnload methodsFor: 'private' stamp: 'lr 8/19/2009 14:01'! defaultModel ^ MCMultiPackageLoader new! ! !GoferUnload methodsFor: 'running' stamp: 'lr 8/19/2009 14:00'! execute self workingCopies do: [ :copy | self unloadClasses: copy; unloadPackage: copy ]. self model load. self workingCopies do: [ :copy | self cleanup: copy; unregister: copy ]. self cleanup! ! !GoferUnload methodsFor: 'unloading' stamp: 'lr 8/19/2009 13:50'! unloadClasses: aWorkingCopy aWorkingCopy packageInfo classes do: [ :class | (class selectors includes: #unload) ifTrue: [ class unload ] ]! ! !GoferUnload methodsFor: 'unloading' stamp: 'lr 8/19/2009 14:00'! unloadPackage: aWorkingCopy self model unloadPackage: aWorkingCopy package! ! !GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/19/2009 13:49'! unregister: aWorkingCopy self unregisterWorkingCopy: aWorkingCopy. self unregisterRepositories: aWorkingCopy. self unregisterPackageInfo: aWorkingCopy! ! !GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/19/2009 13:50'! unregisterPackageInfo: aWorkingCopy PackageOrganizer default unregisterPackage: aWorkingCopy packageInfo! ! !GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/19/2009 13:50'! unregisterRepositories: aWorkingCopy aWorkingCopy repositoryGroup repositories allButFirst do: [ :repository | MCWorkingCopy allManagers do: [ :copy | (copy repositoryGroup includes: repository) ifTrue: [ ^ self ] ]. MCRepositoryGroup default removeRepository: repository ]! ! !GoferUnload methodsFor: 'unregistering' stamp: 'lr 8/19/2009 13:51'! unregisterWorkingCopy: aWorkingCopy MCWorkingCopy registry removeKey: aWorkingCopy package ifAbsent: [ ] ! ! Object subclass: #GoferPackage instanceVariableNames: 'name repository' 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: 'querying' stamp: 'lr 8/19/2009 11: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'! ! !GoferPackage methodsFor: 'querying' stamp: 'lr 8/19/2009 11:32'! findWorkingCopy ^ MCWorkingCopy registry detect: [ :each | self name beginsWith: each packageName ] ifNone: [ self error: 'Working copy ' , self name printString , ' not found' ]! ! !GoferPackage methodsFor: 'initialization' stamp: 'lr 8/19/2009 14:49'! initializeName: aString repository: aRepository name := aString. repository := aRepository! ! !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! ! 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' stamp: 'lr 8/19/2009 14:54'! testAdd gofer add: 'Foo'. self assert: gofer packages size = 1. self assert: gofer packages first name = 'Foo'. self assert: gofer packages first repository isNil. gofer url: 'http://foo.com'; add: 'Bar'. self assert: gofer packages size = 2. self assert: gofer packages last name = 'Bar'. self assert: gofer packages last repository locationWithTrailingSlash = 'http://foo.com/'! ! !GoferTest methodsFor: 'testing' stamp: 'lr 8/19/2009 14:54'! testAddAll gofer addAll: #('Foo' 'Bar'). self assert: gofer packages size = 2. self assert: gofer packages first name = 'Foo'. self assert: gofer packages first repository isNil. self assert: gofer packages last name = 'Bar'. self assert: gofer packages last repository isNil! ! !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 14:54'! testInitialized self assert: gofer repository isNil. self assert: gofer packages isEmpty! ! !GoferTest methodsFor: 'testing' stamp: 'lr 8/19/2009 14:55'! testLoadUnload gofer renggli: 'pieraddons'; add: 'Pier-Setup'. self assert: gofer packages size = 1. self assert: gofer packages first repository = gofer repository. self assert: gofer packages first name = 'Pier-Setup'. self shouldnt: [ gofer load ] raise: Error. self shouldnt: [ gofer unload ] raise: Error! ! !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/'! !