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

Object subclass:#MetacelloProjectRegistry
	instanceVariableNames:'baselineRegistry configurationRegistry'
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-Core-Scripts'
!


!MetacelloProjectRegistry methodsFor:'accessing'!

baselineProjectSpecs
    "MetacelloProjectRegistration baselineProjectSpecs"

    | projectSpecs |
    projectSpecs := OrderedCollection new.
    self baselineRegistry
        keysAndValuesDo: [ :className :registration | projectSpecs add: (self projectSpecForClassNamed: className ifAbsent: [ self error: 'not expected' ]) ].
    ^ projectSpecs asArray
!

baselineRegistry
    baselineRegistry ifNil: [ baselineRegistry := Dictionary new ].
    ^ baselineRegistry
!

configurationProjectSpecs
    "MetacelloProjectRegistration configurationProjectSpecs"

    | projectSpecs |
    projectSpecs := OrderedCollection new.
    self configurationRegistry
        keysAndValuesDo: [ :className :registration | projectSpecs add: (self projectSpecForClassNamed: className ifAbsent: [ self error: 'not expected' ]) ].
    ^ projectSpecs asArray
!

configurationRegistry
    configurationRegistry ifNil: [ configurationRegistry := Dictionary new ].
    ^ configurationRegistry
!

projectSpecs
    "MetacelloProjectRegistration projectSpecs"

    ^ self configurationProjectSpecs , self baselineProjectSpecs
! !

!MetacelloProjectRegistry methodsFor:'copying'!

postCopy
    super postCopy.
    baselineRegistry := self baselineRegistry copy.
    configurationRegistry := self configurationRegistry copy
! !

!MetacelloProjectRegistry methodsFor:'initialization'!

primeRegistryFromImage
    "MetacelloProjectRegistration primeRegistryFromImage"

    MetacelloProjectRegistration configurationClasses
        do: [ :cl | 
            (self configurationRegistry includesKey: cl name asString)
                ifFalse: [ 
                    "not registered"
                    cl project currentVersion
                        ifNotNil: [ :version | 
                            | projectSpec |
                            projectSpec := (version project projectSpec
                                name: (MetacelloScriptEngine baseNameOf: cl name asString);
                                className: cl name asString;
                                versionString: version versionString;
                                repositories: version project projectPackage repositories copy;
                                yourself) asConfigurationProjectSpec.
                            projectSpec asProjectRegistration
                                loadedInImage: true;
                                registerProject ] ] ].
    MetacelloProjectRegistration baselineClasses
        do: [ :cl | 
            (self baselineRegistry includesKey: cl name asString)
                ifFalse: [ 
                    "not registered"
                    cl project currentVersion
                        ifNotNil: [ :version | 
                            | projectSpec |
                            projectSpec := (version project projectSpec
                                name: (MetacelloScriptEngine baseNameOf: cl name asString);
                                repositories: version project projectPackage repositories copy;
                                yourself) asBaselineProjectSpec.
                            projectSpec asProjectRegistration
                                loadedInImage: true;
                                registerProject ] ] ]
! !

!MetacelloProjectRegistry methodsFor:'querying'!

projectSpecForClassNamed: aClassName ifAbsent: absentBlock
    ^ (self configurationRegistry
        at: aClassName
        ifAbsent: [ ^ (self baselineRegistry at: aClassName ifAbsent: [^absentBlock value]) baselineProjectSpec ])
        configurationProjectSpec
!

registrationForClassNamed: aClassName ifAbsent: absentBlock
    | baseName |
    baseName := MetacelloScriptEngine baseNameOf: aClassName.
    self configurationRegistry at: aClassName ifPresent: [ :registration | ^ registration ].
    self baselineRegistry at: aClassName ifPresent: [ :registration | ^ registration ].
    self configurationRegistry at: 'ConfigurationOf' , baseName ifPresent: [ :registration | ^ registration ].
    self baselineRegistry at: 'BaselineOf' , baseName ifPresent: [ :registration | ^ registration ].
    ^ absentBlock value
! !

!MetacelloProjectRegistry methodsFor:'registration'!

registerProjectRegistration: aMetacelloProjectRegistration
    "unconditionally register <newRegistration> ... use with care"

    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | 
            self configurationRegistry
                at: spec className
                ifPresent: [ :existing | 
                    (existing configurationProjectSpec registrationsCompareEqual: spec)
                        ifFalse: [ 
                            Transcript
                                cr;
                                show:
                                        'REGISTRATION OF INCOMPATABLE PROJECTS: ' , existing printString , ' REPLACED BY '
                                                , aMetacelloProjectRegistration printString ] ].
            spec immutable.
            self configurationRegistry at: spec className put: aMetacelloProjectRegistration ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | 
            self baselineRegistry
                at: spec className
                ifPresent: [ :existing | 
                    (existing baselineProjectSpec registrationsCompareEqual: spec)
                        ifFalse: [ 
                            Transcript
                                cr;
                                show:
                                        'REGISTRATION OF INCOMPATABLE PROJECTS: ' , existing printString , ' REPLACED BY '
                                                , aMetacelloProjectRegistration printString ] ].
            spec immutable.
            self baselineRegistry at: spec className put: aMetacelloProjectRegistration ].
    aMetacelloProjectRegistration immutable
!

registrationFor: aMetacelloProjectRegistration ifPresent: presentBlock ifAbsent: absentBlock
    | baseName |
    baseName := aMetacelloProjectRegistration baseName.
    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | self configurationRegistry at: spec className ifPresent: [ :existing | ^ presentBlock value: existing ] ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | self baselineRegistry at: spec className ifPresent: [ :existing | ^ presentBlock value: existing ] ].
    self configurationRegistry
        at: 'ConfigurationOf' , baseName
        ifPresent: [ :existing | ^ presentBlock value: existing ].
    self baselineRegistry at: 'BaselineOf' , baseName ifPresent: [ :existing | ^ presentBlock value: existing ].
    ^ absentBlock value
!

unregisterProjectRegistration: aMetacelloProjectRegistration
    aMetacelloProjectRegistration configurationProjectSpec
        ifNotNil: [ :spec | 
            self configurationRegistry
                removeKey: spec className
                ifAbsent: [ self error: 'unexpectedly missing project registration' ] ].
    aMetacelloProjectRegistration baselineProjectSpec
        ifNotNil: [ :spec | self baselineRegistry removeKey: spec className ifAbsent: [ self error: 'unexpectedly missing project registration' ] ]
! !

!MetacelloProjectRegistry class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !