"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

Object subclass:#MCServerRegistry
	instanceVariableNames:'registry'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-RemoteRepositories'
!

MCServerRegistry class instanceVariableNames:'uniqueInstance'

"
 No other class instance variables are inherited by this class.
"
!

MCServerRegistry comment:'Registry for metacello servers'
!


!MCServerRegistry class methodsFor:'instance creation'!

uniqueInstance

	^ uniqueInstance ifNil: [ uniqueInstance := self new ].
! !

!MCServerRegistry methodsFor:'*Tests-Monticello'!

removeCredentialsFor: aString 

	registry removeKey: aString.
! !

!MCServerRegistry methodsFor:'initialization'!

initialize

	super initialize.
	registry := Dictionary new.
! !

!MCServerRegistry methodsFor:'private'!

repositoryAt: urlString credentialsDo: aBlock


	| possibleMatches bestMatch |
	possibleMatches := registry associations select: [ :e | urlString beginsWith: e key ].
	possibleMatches isEmpty ifTrue: [ ^ aBlock value: '' value: '' ].
	bestMatch := possibleMatches inject: possibleMatches anyOne into: [ :last :new | 
		((new key asUrl path size > last key asUrl path size) 
		"this is ugly, but URL always returns a path element, even an empty one..."
		or: [ last key asUrl path size = 1 and: [ last key asUrl path last isEmpty ]]) 
			ifTrue: [ new ]
			ifFalse: [ last ]].
	^ aBlock value: bestMatch value username value: bestMatch value password.
! !

!MCServerRegistry methodsFor:'public'!

on: repositoryUrl beUser: nameString withPassword: passwordString

	| credentials |
	credentials := MCServerCredentials user: nameString password: passwordString.
	registry at: repositoryUrl put: credentials.
! !

!MCServerRegistry class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !