--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MetacelloScriptExecutor.st Mon Sep 03 11:13:41 2012 +0000
@@ -0,0 +1,231 @@
+"{ Package: 'stx:goodies/metacello' }"
+
+Object subclass:#MetacelloScriptExecutor
+ instanceVariableNames:'options roots singleRoot projectSpecGenerator actionArg
+ configurationArg baselineArg projectArg classNameArg versionArg
+ repositoryArg'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Metacello-Core-Scripts'
+!
+
+
+!MetacelloScriptExecutor methodsFor:'accessing'!
+
+options
+ options ifNil: [ options := Dictionary new ].
+ ^ options
+!
+
+roots
+ roots ifNil: [ roots := OrderedCollection new ].
+ ^ roots
+!
+
+singleRoot
+ singleRoot ifNil: [ singleRoot := false ].
+ ^ singleRoot
+!
+
+singleRoot: aBool
+ singleRoot := aBool
+! !
+
+!MetacelloScriptExecutor methodsFor:'actions api'!
+
+fetch: required
+ actionArg := #'fetch:' -> {required}
+!
+
+get
+ actionArg := #'get' -> #()
+!
+
+list
+ actionArg := #'list' -> #()
+!
+
+load: required
+ actionArg := #'load:' -> {required}
+!
+
+lock
+ actionArg := #'lock' -> #()
+!
+
+record: required
+ actionArg := #'record:' -> {required}
+!
+
+unlock
+ actionArg := #'unlock' -> #()
+! !
+
+!MetacelloScriptExecutor methodsFor:'args'!
+
+baselineArg
+ ^ baselineArg
+!
+
+baselineArg: anObject
+ baselineArg := anObject
+!
+
+classNameArg
+ ^ classNameArg
+!
+
+classNameArg: anObject
+ classNameArg := anObject
+!
+
+configurationArg
+ ^ configurationArg
+!
+
+configurationArg: anObject
+ configurationArg := anObject
+!
+
+projectArg
+ ^ projectArg
+!
+
+projectArg: anObject
+ projectArg := anObject
+!
+
+repositoryArg
+ ^ repositoryArg
+!
+
+repositoryArg: anObject
+ repositoryArg := anObject
+!
+
+versionArg
+ ^ versionArg
+!
+
+versionArg: anObject
+ versionArg := anObject
+! !
+
+!MetacelloScriptExecutor methodsFor:'execution'!
+
+applyArgsToProjectSpec: aProjectSpec
+ classNameArg ifNotNil: [ aProjectSpec className: classNameArg ].
+ versionArg ifNotNil: [ aProjectSpec versionString: versionArg ].
+ repositoryArg ifNotNil: [ aProjectSpec repository: repositoryArg ].
+ ^ aProjectSpec
+!
+
+execute: statements
+ statements
+ do: [ :assoc | assoc value ifNil: [ self perform: assoc key ] ifNotNil: [ self perform: assoc key withArguments: assoc value ] ].
+ projectSpecGenerator := self projectSpecGenerator.
+ projectSpecGenerator target
+ execute: [ :projectSpec |
+ | engine |
+ engine := MetacelloScriptEngine new
+ options: self options copy;
+ projectSpec: projectSpec;
+ yourself.
+ engine perform: actionArg key withArguments: actionArg value.
+ engine root ifNotNil: [ :root | self roots add: root ] ]
+ against: self.
+ ^ (self singleRoot and: [ self roots size == 1 ])
+ ifTrue: [ self roots first ]
+ ifFalse: [ self roots ]
+!
+
+projectSpecGenerator
+ baselineArg
+ ifNotNil: [
+ configurationArg ifNotNil: [ self error: ' baseline: and configuration: are both be specified' ].
+ projectArg ifNotNil: [ self error: ' baseline: and project are both be specified' ].
+ ^ MetacelloBaselineSpecGenerator new
+ target: baselineArg;
+ yourself ].
+ configurationArg
+ ifNotNil: [
+ baselineArg ifNotNil: [ self error: ' baseline: and configuration: are both be specified' ].
+ projectArg ifNotNil: [ self error: ' configuration and project are both be specified' ].
+ ^ MetacelloConfigurationSpecGenerator new
+ target: configurationArg;
+ yourself ].
+ projectArg
+ ifNotNil: [
+ configurationArg ifNotNil: [ self error: ' project and configuration: are both be specified' ].
+ baselineArg ifNotNil: [ self error: ' baseline: and project are both be specified' ].
+ ^ MetacelloProjectSpecGenerator new
+ target: projectArg;
+ yourself ].
+ self error: 'project, baseline, or configuration not specified'
+! !
+
+!MetacelloScriptExecutor methodsFor:'execution callback'!
+
+executeBlock: selectBlock do: projectSpecBlock
+ ((projectSpecGenerator projectSpecListBlock value select: selectBlock) select: self projectSpecSelectBlock)
+ do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ]
+!
+
+executeCollection: aCollection do: projectSpecBlock
+ aCollection
+ do: [ :projectName |
+ ((projectSpecGenerator projectSpecLookupBlock value: projectName) select: self projectSpecSelectBlock)
+ do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ] ]
+!
+
+executeString: aString do: projectSpecBlock
+ self singleRoot: true.
+ ((projectSpecGenerator projectSpecLookupBlock value: aString) select: self projectSpecSelectBlock)
+ do: [ :projectSpec | projectSpecBlock value: (self applyArgsToProjectSpec: projectSpec copy) ]
+!
+
+projectSpecSelectBlock
+ ^ [ :projectSpec | true ]
+! !
+
+!MetacelloScriptExecutor methodsFor:'options api'!
+
+cacheRepository: aRepositoryDescription
+ self options at: #'cacheRepository' put: aRepositoryDescription
+!
+
+ignoreImage: aBool
+ self options at: #'ignoreImage' put: aBool
+!
+
+onConflict: aBlock
+ self options at: #'onConflict' put: aBlock
+!
+
+onDowngrade: aBlock
+ self options at: #'onDowngrade' put: aBlock
+!
+
+onUpgrade: aBlock
+ self options at: #'onUpgrade' put: aBlock
+!
+
+repositoryOverrides: aRepositoryDescriptionList
+ self options at: #'repositoryOverrides' put: aRepositoryDescriptionList
+!
+
+silently: aBool
+ self options at: #'silently' put: aBool
+!
+
+useCurrentVersion: aBool
+ "private option used to implement the classic mode"
+
+ self options at: #'useCurrentVersion' put: aBool
+! !
+
+!MetacelloScriptExecutor class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id:: $'
+! !