core/MetacelloScriptExecutor.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 19 Sep 2012 01:38:26 +0000
changeset 20 8caf2f257260
parent 19 28c344380944
permissions -rw-r--r--
- fixes for package support

"{ Package: 'stx:goodies/metacello/core' }"

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 root |

            engine := MetacelloScriptEngine new
                options: self options copy;
                projectSpec: projectSpec;
                yourself.
            engine perform: actionArg key withArguments: actionArg value.
            (root := engine root) ifNotNil: [ 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::                                                                                                                        $'
! !