[squeak-dev] Squeak 4.6: MonticelloConfigurations-dtl.135.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 5 20:28:42 UTC 2015


Chris Muller uploaded a new version of MonticelloConfigurations to project Squeak 4.6:
http://source.squeak.org/squeak46/MonticelloConfigurations-dtl.135.mcz

==================== Summary ====================

Name: MonticelloConfigurations-dtl.135
Author: dtl
Time: 30 May 2015, 8:10:12.525 am
UUID: aabac991-61d2-4a2f-82e9-39e8572e2099
Ancestors: MonticelloConfigurations-eem.134

Restore missing method required by SqueakTrunk CI job

==================== Snapshot ====================

SystemOrganization addCategory: #MonticelloConfigurations!

(PackageInfo named: 'MonticelloConfigurations') postscript: '"below, add code to be run after the loading of this package"
MCConfiguration upgradeIsMerge: Preferences upgradeIsMerge.'!

MCTool subclass: #MCConfigurationBrowser
	instanceVariableNames: 'configuration dependencyIndex repositoryIndex'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCConfigurationBrowser commentStamp: 'dtl 5/10/2010 21:48' prior: 0!
A MCConfigurationBrowser displays an MCConfiguration, and edits the configuration to add or remove package dependencies and repository specifications. It allows a configuration to be stored in a repository or posted to an update stream.!

----- Method: MCConfigurationBrowser class>>initialize (in category 'class initialization') -----
initialize
	TheWorldMenu registerOpenCommand: { 'Monticello Configurations' . { self . #open }. 'Monticello Configuration Browser' }.!

----- Method: MCConfigurationBrowser class>>open (in category 'opening') -----
open
	^self new show!

----- Method: MCConfigurationBrowser>>addDependency (in category 'dependencies') -----
addDependency
	(self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not])
		do: [:wc |
			wc ancestors isEmpty
				ifTrue: [self inform: 'You must save ', wc packageName, ' first!!
Skipping this package']
				ifFalse: [
					self dependencies add: (MCVersionDependency
						package: wc package
						info: wc ancestors first)]].
	self changed: #dependencyList; changed: #description!

----- Method: MCConfigurationBrowser>>addRepository (in category 'repositories') -----
addRepository
	(self pickRepositorySatisfying:
		[ : ea | (self repositories includes: ea) not ]) ifNotNil:
		[ : repo | repo class supportsConfigurations ifFalse: [ ^ self inform: 'Not all of these repositories support MCConfigurations.' ].
		self repositories add: repo.
		self changed: #repositoryList ]!

----- Method: MCConfigurationBrowser>>buttonSpecs (in category 'morphic ui') -----
buttonSpecs
	^ #(('Add' addDependency 'Add a dependency')
		('Update' updateMenu 'Update dependencies')
		('Install' installMenu 'Load/Merge/Upgrade into image')
		('Up' up 'Move item up in list' canMoveUp)
		('Down' down 'Move item down in list' canMoveDown)
		('Remove' remove 'Remove item' canRemove)
		('Store' store 'store configuration')
		('Post' post 'Post this configuration to an update stream')
		)!

----- Method: MCConfigurationBrowser>>canMoveDown (in category 'testing') -----
canMoveDown
	^self index between: 1 and: self maxIndex - 1 !

----- Method: MCConfigurationBrowser>>canMoveUp (in category 'testing') -----
canMoveUp
	^self index > 1!

----- Method: MCConfigurationBrowser>>canRemove (in category 'testing') -----
canRemove
	^self index > 0!

----- Method: MCConfigurationBrowser>>changedButtons (in category 'selection') -----
changedButtons
	self changed: #canMoveDown.
	self changed: #canMoveUp.
	self changed: #canRemove.!

----- Method: MCConfigurationBrowser>>changedList (in category 'selection') -----
changedList
	self dependencyIndex > 0 ifTrue: [^self changed: #dependencyList].
	self repositoryIndex > 0 ifTrue: [^self changed: #repositoryList].
	self error: 'nothing selected'!

----- Method: MCConfigurationBrowser>>checkDependencies (in category 'dependencies') -----
checkDependencies
	^self checkModified and: [self checkMissing]!

----- Method: MCConfigurationBrowser>>checkMissing (in category 'dependencies') -----
checkMissing
	| missing |
	missing := (self dependencies collect:
		[ : ea | ea versionInfo name ]) asSet.
	self repositories do:
		[ : eachRepository | eachRepository cacheAllFileNamesDuring:
			[ missing copy do:
				[ : eachVersionName | (eachRepository includesVersionNamed: eachVersionName) ifTrue: [ missing remove: eachVersionName ] ] ] ].
	^ missing isEmpty or:
		[ self selectDependency: missing anyOne.
		self confirm:
			(String streamContents:
				[ : strm | strm
					 nextPutAll: 'No repository found for' ;
					 cr.
				missing do:
					[ : r | strm
						 nextPutAll: r ;
						 cr ].
				strm nextPutAll: 'Do you still want to store?' ]) ]!

----- Method: MCConfigurationBrowser>>checkModified (in category 'dependencies') -----
checkModified
	| modified |
	modified := self dependencies select: [:dep |
		dep isFulfilled and: [dep package workingCopy modified]].
	
	^modified isEmpty or: [
		self selectDependency: modified anyOne.
		self confirm: (String streamContents: [:strm |
			strm nextPutAll: 'These packages are modified:'; cr.
			modified do: [:dep | strm nextPutAll: dep package name; cr].
			strm nextPutAll: 'Do you still want to store?'])]
	!

----- Method: MCConfigurationBrowser>>checkRepositories (in category 'repositories') -----
checkRepositories
	| bad |
	bad := self repositories reject: [:repo | repo class supportsConfigurations ].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Please remove these repositories:'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: '(only HTTP repositories are supported)']).
		false].
!

----- Method: MCConfigurationBrowser>>checkRepositoryTemplates (in category 'repositories') -----
checkRepositoryTemplates
	"unused for now - we only do HTTP"
	| bad |
	bad := self repositories select: [:repo | repo creationTemplate isNil].
	^bad isEmpty or: [
		self selectRepository: bad first.
		self inform: (String streamContents: [:strm |
			strm nextPutAll: 'Creation template missing for'; cr.
			bad do: [:r | strm nextPutAll: r description; cr].
			strm nextPutAll: 'Please fill in the details first!!']).
		false].
!

----- Method: MCConfigurationBrowser>>configuration (in category 'accessing') -----
configuration
	^configuration ifNil: [configuration := MCConfiguration new]!

----- Method: MCConfigurationBrowser>>configuration: (in category 'accessing') -----
configuration: aConfiguration
	configuration := aConfiguration!

----- Method: MCConfigurationBrowser>>defaultExtent (in category 'morphic ui') -----
defaultExtent
	^ 350 at 500!

----- Method: MCConfigurationBrowser>>dependencies (in category 'accessing') -----
dependencies
	^self configuration dependencies
!

----- Method: MCConfigurationBrowser>>dependencies: (in category 'accessing') -----
dependencies: aCollection
	self configuration dependencies: aCollection.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>dependencyIndex (in category 'selection') -----
dependencyIndex
	^dependencyIndex ifNil: [0]!

----- Method: MCConfigurationBrowser>>dependencyIndex: (in category 'selection') -----
dependencyIndex: anInteger
	dependencyIndex := anInteger.
	dependencyIndex > 0
		ifTrue: [self repositoryIndex: 0].
	self changed: #dependencyIndex; changed: #description.
	self changedButtons.!

----- Method: MCConfigurationBrowser>>dependencyList (in category 'dependencies') -----
dependencyList
	^self dependencies collect: [:dep | 
		Text string: dep versionInfo name
			attributes: (Array streamContents: [:attr |
				dep isFulfilledByAncestors
					ifFalse: [attr nextPut: TextEmphasis bold]
					ifTrue: [dep isCurrent ifFalse: [attr nextPut: TextEmphasis italic]].
			])]
!

----- Method: MCConfigurationBrowser>>dependencyMenu: (in category 'morphic ui') -----
dependencyMenu: aMenu
	self fillMenu: aMenu fromSpecs: #(('add new dependency...' addDependency)).
	self selectedDependency ifNotNil: [
		self fillMenu: aMenu fromSpecs: #(
			addLine
			('remove this dependency' remove)
			('update this dependency from image' updateSelectedDependencyFromImage)
			('update this dependency from repositories' updateSelectedDependencyFromRepositories)
		)].
	^aMenu!

----- Method: MCConfigurationBrowser>>description (in category 'description') -----
description
	self selectedDependency ifNotNil:
		[:dep |
		^ ('Package: ', dep package name, String cr, dep versionInfo summary) asText].
	self selectedRepository ifNotNil:
		[:repo |
		^repo creationTemplate
			ifNotNil: [repo creationTemplate asText]
			ifNil: [repo asCreationTemplate asText addAttribute: TextColor red]].
	^('A configuration is a set of particular versions of packages.  These can be used to manage multiple dependencies amongst packages when an update requires changes to multiple packages.  One stores the current configuration and then modifies the various packages needing modification.  On load, the image will be updated to at least the versions in the current configuration, hence providing the support needed to load the new packages.\\To create a new configuration first load the most up-to-date configuration in your repository (e.g.',  MCHttpRepository trunkUrlString, '), open that repository in the Monticello browser, scroll down to the "update" package, select the first entry in the list on the right hand side and click Browse, which will open the configuration in a new MCConfigurationBrowser.  Then in the new MCConfigurationBrowser click Update, and choose "update all from image" from the pop-up menu.  Click Store to save back to the repository.  If required, one can add repositories to the browser to store the configuration in a different repository.') withCRs!

----- Method: MCConfigurationBrowser>>description: (in category 'description') -----
description: aText

	self selectedRepository ifNotNil: [:repo | 
		| new | 
		new := MCRepository readFrom: aText asString.
		(new class = repo class 
			and: [new description = repo description])
				ifTrue: [
					repo creationTemplate: aText asString.
					self changed: #description]
				ifFalse: [
					self inform: 'This does not match the previous definition!!'
				]
	].

!

----- Method: MCConfigurationBrowser>>down (in category 'actions') -----
down
	self canMoveDown ifTrue: [
		self list swap: self index with: self index + 1.
		self index: self index + 1.
		self changedList.
	].
!

----- Method: MCConfigurationBrowser>>includesPackage: (in category 'testing') -----
includesPackage: aPackage
	^self dependencies anySatisfy: [:each | each package = aPackage]!

----- Method: MCConfigurationBrowser>>index (in category 'selection') -----
index
	^self dependencyIndex max: self repositoryIndex!

----- Method: MCConfigurationBrowser>>index: (in category 'selection') -----
index: anInteger
	self dependencyIndex > 0 ifTrue: [^self dependencyIndex: anInteger].
	self repositoryIndex > 0 ifTrue: [^self repositoryIndex: anInteger].
	anInteger > 0 ifTrue: [self error: 'cannot select']!

----- Method: MCConfigurationBrowser>>installMenu (in category 'actions') -----
installMenu
	| action |
	action := UIManager default
		chooseFrom: #('load packages' 'merge packages' 'upgrade packages')
		values: #(#load #merge #upgrade).
	action ifNotNil: [self perform: action].!

----- Method: MCConfigurationBrowser>>list (in category 'selection') -----
list
	self dependencyIndex > 0 ifTrue: [^self dependencies].
	self repositoryIndex > 0 ifTrue: [^self repositories].
	^#()!

----- Method: MCConfigurationBrowser>>load (in category 'actions') -----
load
	self configuration load.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>maxIndex (in category 'selection') -----
maxIndex
	^ self list size!

----- Method: MCConfigurationBrowser>>merge (in category 'actions') -----
merge
	self configuration merge.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>pickName (in category 'morphic ui') -----
pickName
	| name |
	name := UIManager default
		request: 'Name (.', self configuration writerClass extension, ' will be appended):'
		initialAnswer: self configuration suggestedNameOfNextVersion.
	^ name isEmpty ifFalse: [name]!

----- Method: MCConfigurationBrowser>>pickRepository (in category 'morphic ui') -----
pickRepository
	^self pickRepositorySatisfying: [:ea | true]
!

----- Method: MCConfigurationBrowser>>pickRepositorySatisfying: (in category 'morphic ui') -----
pickRepositorySatisfying: aBlock
	| index list |
	list := MCRepositoryGroup default repositories select: aBlock.
	index := UIManager default chooseFrom: (list collect: [:ea | ea description])
		title: 'Repository:'.
	^ index = 0 ifFalse: [list at: index]!

----- Method: MCConfigurationBrowser>>pickWorkingCopiesSatisfying: (in category 'morphic ui') -----
pickWorkingCopiesSatisfying: aBlock
	| copies item |
	copies := (MCWorkingCopy allManagers select: aBlock)
		asSortedCollection: [:a :b | a packageName <= b packageName].
	item := UIManager default chooseFrom: #('match ...'),(copies collect: [:ea | ea packageName]) lines: #(1) title: 'Package:'.
	item = 1 ifTrue: [
		| pattern |
		pattern := UIManager default request: 'Packages matching:' initialAnswer: '*'.
		^pattern isEmptyOrNil
			ifTrue: [#()]
			ifFalse: [
				(pattern includes: $*) ifFalse: [pattern := '*', pattern, '*'].
				copies select: [:ea | pattern match: ea packageName]]
	].
	^ item = 0
		ifTrue: [#()]
		ifFalse: [{copies at: item - 1}]!

----- Method: MCConfigurationBrowser>>remove (in category 'actions') -----
remove
	self canRemove ifTrue: [
		self list removeAt: self index.
		self changedList.
		self updateIndex.
	].
!

----- Method: MCConfigurationBrowser>>removeRepository (in category 'repositories') -----
removeRepository
	repositoryIndex > 0
		ifTrue: [self repositories removeAt: repositoryIndex.
			repositoryIndex := 0.
			self changed: #repositoryList]!

----- Method: MCConfigurationBrowser>>repositories (in category 'accessing') -----
repositories
	^ self configuration repositories!

----- Method: MCConfigurationBrowser>>repositories: (in category 'accessing') -----
repositories: aCollection
	^self configuration repositories: aCollection
!

----- Method: MCConfigurationBrowser>>repositoryIndex (in category 'selection') -----
repositoryIndex
	^repositoryIndex ifNil: [0]!

----- Method: MCConfigurationBrowser>>repositoryIndex: (in category 'selection') -----
repositoryIndex: anInteger
	repositoryIndex := anInteger.
	repositoryIndex > 0
		ifTrue: [self dependencyIndex: 0].
	self changed: #repositoryIndex; changed: #description.
	self changedButtons.!

----- Method: MCConfigurationBrowser>>repositoryList (in category 'repositories') -----
repositoryList
	^self repositories collect: [:ea | ea description]
!

----- Method: MCConfigurationBrowser>>repositoryMenu: (in category 'morphic ui') -----
repositoryMenu: aMenu
	self fillMenu: aMenu fromSpecs: #(('add repository...' addRepository)).
	self selectedRepository ifNotNil: [
		self fillMenu: aMenu fromSpecs: #(('remove repository' removeRepository))].
	^aMenu
!

----- Method: MCConfigurationBrowser>>selectDependency: (in category 'selection') -----
selectDependency: aDependency
	self dependencyIndex: (self dependencies indexOf: aDependency)!

----- Method: MCConfigurationBrowser>>selectRepository: (in category 'selection') -----
selectRepository: aRepository
	self repositoryIndex: (self repositories indexOf: aRepository)!

----- Method: MCConfigurationBrowser>>selectedDependency (in category 'dependencies') -----
selectedDependency
	^ self dependencies at: self dependencyIndex ifAbsent: []!

----- Method: MCConfigurationBrowser>>selectedPackage (in category 'dependencies') -----
selectedPackage
	^ self selectedDependency ifNotNil: [:dep | dep package]!

----- Method: MCConfigurationBrowser>>selectedRepository (in category 'repositories') -----
selectedRepository
	^ self repositories at: self repositoryIndex ifAbsent: []!

----- Method: MCConfigurationBrowser>>store (in category 'actions') -----
store
	(self checkRepositories and: [self checkDependencies]) ifFalse: [^self].
	self pickName ifNotNil: [:name |
		self configuration name: name.
		self pickRepository ifNotNil: [:repo |
			repo storeVersion: self configuration]].!

----- Method: MCConfigurationBrowser>>up (in category 'actions') -----
up
	self canMoveUp ifTrue: [
		self list swap: self index with: self index - 1.
		self index: self index - 1.
		self changedList.
	].!

----- Method: MCConfigurationBrowser>>updateFromImage (in category 'updating') -----
updateFromImage
	self configuration updateFromImage.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>updateFromRepositories (in category 'updating') -----
updateFromRepositories
	self configuration updateFromRepositories.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>updateIndex (in category 'selection') -----
updateIndex
	self index > 0 ifTrue: [self index: (self index min: self maxIndex)]!

----- Method: MCConfigurationBrowser>>updateMenu (in category 'actions') -----
updateMenu
	| action |
	action := UIManager default
		chooseFrom: #('update all from image' 'update all from repositories')
		values: #(#updateFromImage #updateFromRepositories).
	action ifNotNil: [self perform: action].!

----- Method: MCConfigurationBrowser>>updateSelectedDependencyFromImage (in category 'actions') -----
updateSelectedDependencyFromImage
	self configuration updateFromImage: self dependencyIndex.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>updateSelectedDependencyFromRepositories (in category 'actions') -----
updateSelectedDependencyFromRepositories
	self configuration updateFromRepositories: self dependencyIndex.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>upgrade (in category 'actions') -----
upgrade
	self configuration upgrade.
	self changed: #dependencyList; changed: #description
!

----- Method: MCConfigurationBrowser>>widgetSpecs (in category 'morphic ui') -----
widgetSpecs
	^ #(
		((buttonRow) (0 0 1 0) (0 0 0 defaultButtonPaneHeight))
		((listMorph:selection:menu: dependencyList dependencyIndex dependencyMenu:) (0 0 1 1) (0 defaultButtonPaneHeight 0 -180))
		((listMorph:selection:menu: repositoryList repositoryIndex repositoryMenu:) (0 1 1 1) (0 -180 0 -120))
		((textMorph: description) (0 1 1 1) (0 -120 0 0))
	 	)!

----- Method: MCRepository class>>supportsConfigurations (in category '*monticelloconfigurations') -----
supportsConfigurations
	^ false!

RWBinaryOrTextStream subclass: #MCPseudoFileStream
	instanceVariableNames: 'localName'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCPseudoFileStream commentStamp: '<historical>' prior: 0!
A pseudo file stream which can be used for updates.!

----- Method: MCPseudoFileStream>>localName (in category 'accessing') -----
localName
	^localName!

----- Method: MCPseudoFileStream>>localName: (in category 'accessing') -----
localName: aString
	localName := aString!

MCWriter subclass: #MCMcmWriter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCMcmWriter commentStamp: 'dtl 5/10/2010 22:20' prior: 0!
An MCMcmWriter stores an MCConfiguration on a stream in the form of an array specification.
!

----- Method: MCMcmWriter class>>fileOut:on: (in category 'writing') -----
fileOut: aConfiguration on: aStream
	| inst |
	inst := self on: aStream.
	inst writeConfiguration: aConfiguration.
	inst close.
	
!

----- Method: MCMcmWriter class>>readerClass (in category 'accessing') -----
readerClass
	^ MCMcmReader!

----- Method: MCMcmWriter>>close (in category 'writing') -----
close
	stream close!

----- Method: MCMcmWriter>>writeConfiguration: (in category 'writing') -----
writeConfiguration: aConfiguration

	stream nextPut: $(.

	aConfiguration repositories do: [:ea | 
		stream cr.
		stream nextPutAll: 'repository '.
		(MCConfiguration repositoryToArray: ea) printElementsOn: stream].

	aConfiguration dependencies do: [:ea | 
		stream cr.
		stream nextPutAll: 'dependency '.
		(MCConfiguration dependencyToArray: ea) printElementsOn: stream].

	stream nextPutAll: 'name '; nextPutAll: aConfiguration name printString.

	stream cr.
	stream nextPut: $).
	stream cr.!

Object subclass: #MCConfiguration
	instanceVariableNames: 'name dependencies repositories log'
	classVariableNames: 'DefaultLog ExtraProgressInfo LogToFile UpgradeIsMerge'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCConfiguration commentStamp: 'dtl 5/10/2010 23:03' prior: 0!
An MCConfiguration specifies the configuration of a set of related Monticello packages. It maintains an ordered list of package versions and a list of repositories in which the packages may be found.

An MCConfiguration may be filed out for storage as an array specification, and new instances can be created from a stored array specification.
!

----- Method: MCConfiguration class>>defaultLog (in category 'accessing') -----
defaultLog
	"Answer the default configuration log"
	^DefaultLog!

----- Method: MCConfiguration class>>defaultLog: (in category 'accessing') -----
defaultLog: aStream
	"Set the default configuration log"
	DefaultLog := aStream.!

----- Method: MCConfiguration class>>dependencyFromArray: (in category 'converting') -----
dependencyFromArray: anArray
	^MCVersionDependency
		package: (MCPackage named: anArray first)
		info: (
			MCVersionInfo
			name: anArray second
			id: (UUID fromString: anArray third)
			message: nil
			date: nil
			time: nil
			author: nil
			ancestors: nil)!

----- Method: MCConfiguration class>>dependencyToArray: (in category 'converting') -----
dependencyToArray: aDependency
	^ {
		aDependency package name . 
		aDependency versionInfo name . 
		aDependency versionInfo id asString }!

----- Method: MCConfiguration class>>extraProgressInfo (in category 'preferences') -----
extraProgressInfo
	"Answer true for additional progress info during load. 
	With the newly added MC down/upload operations this seems unnecessary
	but some people might disagree, so let's leave it as a preference right now"
	<preference: 'Extra Progress Info' 
		category: 'Monticello' 
		description: 'If true, additional progress information is displayed when loading MC configurations (i.e., during updates)' 
		type: #Boolean>
	^ExtraProgressInfo ifNil:[false]!

----- Method: MCConfiguration class>>extraProgressInfo: (in category 'preferences') -----
extraProgressInfo: aBool
	"Whether to display for additional progress info during load."
	ExtraProgressInfo := aBool.
!

----- Method: MCConfiguration class>>fromArray: (in category 'instance creation') -----
fromArray: anArray
	| configuration |
	configuration := self new.
	anArray pairsDo: [:key :value |
		key = #repository
			ifTrue: [configuration repositories add: (self repositoryFromArray: value)].
		key = #dependency
			ifTrue: [configuration dependencies add: (self dependencyFromArray: value)].
		key = #name
			ifTrue: [configuration name: value].
	].
	^configuration!

----- Method: MCConfiguration class>>logToFile (in category 'preferences') -----
logToFile
	"Whether to log configuration info to files by default.
	If true, logs to a file named after the configuration (config.nn.log).
	If false, logs to the transcript."
	<preference: 'Log config info to disk' 
		category: 'Monticello' 
		description: 'If true, configuration information (such as change logs) are logged to disk instead of the Transcript. The log file is named after the configuration map (config.nn.log)' 
		type: #Boolean>
	^LogToFile ifNil:[true].!

----- Method: MCConfiguration class>>logToFile: (in category 'preferences') -----
logToFile: aBool
	"Whether to log configuration info to files by default.
		MCConfiguration logToFile: true.
		MCConfiguration logToFile: false.
	"
	LogToFile := aBool!

----- Method: MCConfiguration class>>repositoryFromArray: (in category 'converting') -----
repositoryFromArray: anArray
	^ MCRepositoryGroup default repositories
		detect: [:repo | repo description = anArray first]
		ifNone: [
			MCHttpRepository
				location: anArray first
				user: ''
				password: '']!

----- Method: MCConfiguration class>>repositoryToArray: (in category 'converting') -----
repositoryToArray: aRepository
	^ {aRepository description}!

----- Method: MCConfiguration class>>upgradeIsMerge (in category 'preferences') -----
upgradeIsMerge
	"Answer true if you wish to merge upstream changes whenever you upgrade."
	<preference: 'Upgrade is merge'
		category: 'updates'
		description: 'When upgrading packages, use merge instead of load'
		type: #Boolean>
	^UpgradeIsMerge ifNil: [true]!

----- Method: MCConfiguration class>>upgradeIsMerge: (in category 'preferences') -----
upgradeIsMerge: aBoolean
	UpgradeIsMerge := aBoolean.!

----- Method: MCConfiguration>>browse (in category 'actions') -----
browse
	(MCConfigurationBrowser new configuration: self) show!

----- Method: MCConfiguration>>cacheAllFileNamesDuring: (in category 'private') -----
cacheAllFileNamesDuring: aBlock
	^ (repositories
		inject: aBlock
		into: [ :innerBlock :repository |
			[ repository cacheAllFileNamesDuring: innerBlock ]
		]) value
	
!

----- Method: MCConfiguration>>changes (in category 'faking') -----
changes
	^MCPatch operations: #()!

----- Method: MCConfiguration>>dependencies (in category 'accessing') -----
dependencies
	^dependencies ifNil: [dependencies := OrderedCollection new]!

----- Method: MCConfiguration>>dependencies: (in category 'accessing') -----
dependencies: aCollection
	dependencies := aCollection!

----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') -----
depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString 
	| count selectedVersions cleanWorkingCopies |
	self cacheAllFileNamesDuring: [
		self repositories do: [ :eachRepository |
			MCRepositoryGroup default addRepository: eachRepository ].
		"First, download selected versions"
		count := 0.
		selectedVersions := OrderedCollection new.
		self withProgress: progressString in: self dependencies do: [ :dep | | verName repo |
			verName := dep versionInfo name.
			self class extraProgressInfo ifTrue:
				[ ProgressNotification signal: '' extra: 'Downloading ' , verName ].
			repo := self repositories
				detect: [ :eachRepository | eachRepository includesVersionNamed: verName ]
				ifNone: 	[ self logError: 'Version ' , verName , ' not found in any repository'.
					self logError: 'Aborting'.
					^ count ].
			(selectBlock value: dep) ifTrue: [ | version |
				version := self versionNamed: verName for: dep from: repo.
				version ifNil: [ self logError: 'Could not download version ' , verName , ' from ' , repo description.
					self logError: 'Aborting'.
					^ count ].
				dep package workingCopy newRepositoryGroupIfDefault. "fix old working copies"
				dep package workingCopy repositoryGroup addRepository: repo.
				selectedVersions add: version]].
		"Then, process only those definitions that moved from one package to another, to avoid order dependence"
		cleanWorkingCopies := MCWorkingCopy allManagers reject: [ :wc | wc modified ].
		MCReorganizationPreloader preloadMovesBetween: selectedVersions.
		"Finally, load/merge selected versions"
		self withProgress: progressString in: selectedVersions do: [ :version |
			self logUpdate: version package with: version.
			self class extraProgressInfo ifTrue:
				[ ProgressNotification signal: '' extra: 'Installing ' , version info name ].
			verBlock value: version.
			count := count + 1 ].
		"Clean up packages made dirty by MCReorganizationPreloader"
		cleanWorkingCopies do: [ :wc | wc modified ifTrue: [wc checkModified] ].
	].
	^ count!

----- Method: MCConfiguration>>diffBaseFor: (in category 'private') -----
diffBaseFor: aDependency
	| wc |
	aDependency package hasWorkingCopy ifFalse: [^nil].
	wc := aDependency package workingCopy.
	wc ancestors ifEmpty: [^nil].
	^wc ancestors first versionName!

----- Method: MCConfiguration>>fileName (in category 'accessing') -----
fileName
	^ self name, '.', self writerClass extension
!

----- Method: MCConfiguration>>fileOutOn: (in category 'actions') -----
fileOutOn: aStream
	self writerClass fileOut: self on: aStream!

----- Method: MCConfiguration>>info (in category 'faking') -----
info
	^MCVersionInfo new!

----- Method: MCConfiguration>>initialize (in category 'initialize') -----
initialize
	super initialize.
	log := DefaultLog.!

----- Method: MCConfiguration>>isCacheable (in category 'testing') -----
isCacheable
	^false!

----- Method: MCConfiguration>>load (in category 'actions') -----
load
	^self depsSatisfying: [:dep | dep isCurrent not]
		versionDo: [:ver | ver load]
		displayingProgress: 'loading packages'
!

----- Method: MCConfiguration>>log (in category 'accessing') -----
log
	"Answer the receiver's log. If no log exist use the default log"
	
	^log ifNil: [
		(name notNil and: [ self class logToFile ]) ifFalse: [ 
			Transcript countOpenTranscripts = 0 ifTrue: [Transcript open].
			^Transcript ].
		self log: ((FileStream fileNamed: self logFileName) setToEnd; yourself).
		log ]!

----- Method: MCConfiguration>>log: (in category 'accessing') -----
log: aStream
	log := aStream.!

----- Method: MCConfiguration>>logError: (in category 'private') -----
logError: aString
	self log
		cr; nextPutAll: 'ERROR: ';
		nextPutAll: aString; cr;
		flush.
!

----- Method: MCConfiguration>>logFileName (in category 'accessing') -----
logFileName

	^self name, '-', (FileDirectory localNameFor: Smalltalk imageName), '.log'
	!

----- Method: MCConfiguration>>logUpdate:with: (in category 'private') -----
logUpdate: aPackage with: aVersion
	self log
		cr; nextPutAll: '========== ', aVersion info name, ' =========='; cr;
		cr; nextPutAll: aVersion info message asString; cr;
		flush.

	aPackage hasWorkingCopy ifFalse: [^self].

	aPackage workingCopy ancestors do: [:each |
		(aVersion info hasAncestor: each)
			ifTrue: [(aVersion info allAncestorsOnPathTo: each)
				do: [:ver | self log cr; nextPutAll: '>>> ', ver name, ' <<<'; cr;
							nextPutAll: ver message; cr; flush]]]!

----- Method: MCConfiguration>>logWarning: (in category 'private') -----
logWarning: aString
	self log
		cr; nextPutAll: 'WARNING: ';
		nextPutAll: aString; cr;
		flush.
!

----- Method: MCConfiguration>>merge (in category 'actions') -----
merge
	^self depsSatisfying: [:dep | dep isFulfilledByAncestors not]
		versionDo: [:ver | ver merge]
		displayingProgress: 'merging packages'
!

----- Method: MCConfiguration>>mustMerge: (in category 'private') -----
mustMerge: aVersion
	"answer true if we have to do a full merge and false if we can simply load instead"
	
	| pkg wc current |
	(pkg := aVersion package) hasWorkingCopy ifFalse: [^false "no wc -> load"].
	(wc := pkg workingCopy) modified ifTrue: [^true "modified -> merge"].
	wc ancestors isEmpty ifTrue: [^true "no ancestor info -> merge"].
	current := wc ancestors first.
	(aVersion info hasAncestor: current) ifTrue: [^false "direct descendant of wc -> load"].
	"new branch -> merge"
	^true!

----- Method: MCConfiguration>>name (in category 'accessing') -----
name
	^name!

----- Method: MCConfiguration>>name: (in category 'accessing') -----
name: aString
	name := aString!

----- Method: MCConfiguration>>repositories (in category 'accessing') -----
repositories
	^repositories ifNil: [repositories := OrderedCollection new]!

----- Method: MCConfiguration>>repositories: (in category 'accessing') -----
repositories: aCollection
	repositories := aCollection!

----- Method: MCConfiguration>>setSystemVersion (in category 'updating') -----
setSystemVersion
	"Set the current system version date to the latest date found in my configuration (or the associated working copy). Also set the highest update number to the sum of version numbers in my configuration."

	| versionNumbers versionDates |
	versionNumbers := self dependencies collect: [:d |
		(d versionInfo name copyAfterLast: $.) asInteger].
	versionDates := self dependencies collect: [:d |
		d versionInfo date
			ifNil: [d package workingCopy ancestors first date]].
	SystemVersion current
		date: versionDates max;
		highestUpdate: versionNumbers sum.!

----- Method: MCConfiguration>>suggestedNameOfNextVersion (in category 'private') -----
suggestedNameOfNextVersion
	"Suggest a name for the next version of this configuration. The format is assumed to be name-authorInitials.version. Automatically increments the version, takes author initials from Utilities."
	^'{1}-{2}.{3}' format: {
		name
			ifNil: [ 'newConfiguration' ]
			ifNotNil: [ name asMCVersionName packageName ].
		Utilities authorInitials.
		name
			ifNil: [ 1 ]
			ifNotNil: [ name asMCVersionName versionNumber + 1 ] }!

----- Method: MCConfiguration>>summary (in category 'accessing') -----
summary
	^String streamContents: [:stream |
		self dependencies
			do: [:ea | stream nextPutAll: ea versionInfo name; cr ]]!

----- Method: MCConfiguration>>updateFromImage (in category 'updating') -----
updateFromImage
	self dependencies: (self dependencies collect: [:dep |
		dep package hasWorkingCopy
			ifTrue: [
				dep package workingCopy in: [:wc |
					MCVersionDependency package: wc package info: wc ancestors first]]
			ifFalse: [dep]]).
!

----- Method: MCConfiguration>>updateFromImage: (in category 'updating') -----
updateFromImage: packageIndex
	| dep newDeps |
	dep := self dependencies at: packageIndex.
	newDeps := self dependencies copy.
	newDeps
		at: packageIndex put: (dep package hasWorkingCopy
			ifTrue: [dep package workingCopy in: [:wc |
					MCVersionDependency package: wc package info: wc ancestors first]]
			ifFalse: [dep]).
	self dependencies: newDeps.
!

----- Method: MCConfiguration>>updateFromRepositories (in category 'updating') -----
updateFromRepositories

	self cacheAllFileNamesDuring: [ self updateFromRepositoriesWithoutCaching ]!

----- Method: MCConfiguration>>updateFromRepositories: (in category 'updating') -----
updateFromRepositories: packageIndex

	self cacheAllFileNamesDuring: [ self updateFromRepositoriesWithoutCaching: packageIndex ]!

----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching (in category 'updating') -----
updateFromRepositoriesWithoutCaching

	| oldNames newNames sortedNames newDeps |
	oldNames := self dependencies collect: [:dep | dep versionInfo versionName].
	newNames := Dictionary new.
	self repositories
		do: [:repo | 
			ProgressNotification signal: '' extra: 'Checking ', repo description.
			(repo possiblyNewerVersionsOfAnyOf: oldNames)
				do: [:newName | newNames at: newName put: repo]]
		displayingProgress: 'Searching new versions'.

	sortedNames := newNames keys asArray sort:
		[:a :b | a versionNumber > b versionNumber].

	newDeps := OrderedCollection new: self dependencies size.
	self dependencies
		do: [:dep |
			newDeps add: (sortedNames
				detect: [:each | each packageAndBranchName = dep packageAndBranchName]
				ifFound: [ :newName |
					| repo |
					repo := newNames at: newName.
					(self versionInfoNamed: newName for: dep from: repo)
						ifNil: [ dep ]
						ifNotNil: [ :info |
							MCVersionDependency package: dep package info: info ] ]
				ifNone: [ dep ]) ]
		displayingProgress: 'downloading new versions'.

	self dependencies: newDeps.
!

----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching: (in category 'updating') -----
updateFromRepositoriesWithoutCaching: packageIndex

	| oldNames newNames sortedNames newDeps dep |
	dep := dependencies at: packageIndex.
	oldNames := {dep versionInfo versionName}.
	newNames := Dictionary new.
	self repositories
		do: [:repo | 
			ProgressNotification signal: '' extra: 'Checking ', repo description.
			(repo possiblyNewerVersionsOfAnyOf: oldNames)
				do: [:newName | newNames at: newName put: repo]]
		displayingProgress: 'Searching new versions'.

	sortedNames := newNames keys asArray sort:
		[:a :b | a versionNumber > b versionNumber].

	newDeps := self dependencies copy.
	newDeps at: packageIndex put: (
		sortedNames
				detect: [:each | each packageAndBranchName = dep packageAndBranchName]
				ifFound: [ :newName |
					| repo |
					repo := newNames at: newName.
					(self versionInfoNamed: newName for: dep from: repo)
						ifNil: [ dep ]
						ifNotNil: [ :info |
							MCVersionDependency package: dep package info: info ] ]
				ifNone: [ dep ]).

	self dependencies: newDeps.
!

----- Method: MCConfiguration>>upgrade (in category 'actions') -----
upgrade
	^self depsSatisfying:
			[:dep | dep isFulfilledByAncestors not]
		versionDo:
			[:ver | 
			(self class upgradeIsMerge and: [ver shouldMerge])
				ifFalse: [ver load]
				ifTrue:
					[[ver merge]
						on: MCNoChangesException
						do: [:req| req resume ]
						on: MCMergeResolutionRequest
						do: [:request |
							request merger conflicts isEmpty
								ifTrue: [request resume: true]
								ifFalse: [request pass]]]]
		displayingProgress: 'upgrading packages'!

----- Method: MCConfiguration>>versionInfoNamed:for:from: (in category 'private') -----
versionInfoNamed: newName for: dep from: repo
	"Retrieves the version info instead of the version. Searches in-image first, in case the desired version is part of an already loaded package (usual case when doing a partial update). If not present defaults to versionNamed:for:from: an uses its result."
	MCWorkingCopy registry at: dep package ifPresent:[:workingCopy| | seen |
		"Don't use allAncestorsDo: - apparently this can loop indefinitely.
		Rather keep track of the versions that we've seen and make sure we don't loop."
		seen := Set new.
		workingCopy ancestry ancestorsDoWhileTrue:[:vInfo|
			vInfo name = newName ifTrue:[^vInfo].
			(seen includes: vInfo) ifTrue:[false] ifFalse:[seen add: vInfo. false]
		].
	].
	^(self versionNamed: newName for: dep from: repo) info!

----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') -----
versionNamed: aMCVersionName for: aDependency from: repo

	| baseName fileName ver |
	(repo filterFileNames: repo cachedFileNames forVersionNamed: aMCVersionName) ifNotEmptyDo: [:cachedNames |
		fileName := cachedNames anyOne.
		self class extraProgressInfo
			ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName].
		ver := repo versionNamed: fileName].
	ver ifNil: [
		baseName := self diffBaseFor: aDependency.
		(baseName notNil and: [baseName ~= aMCVersionName and: [repo includesVersionNamed: baseName]]) ifTrue: [
			fileName := (MCDiffyVersion nameForVer: aMCVersionName base: baseName), '.mcd'.
			self class extraProgressInfo
				ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
			ver := [repo versionNamed: fileName] ifError: []]].
	ver ifNil: [
		fileName := aMCVersionName versionName, '.mcz'.
		self class extraProgressInfo
			ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
		ver := repo versionNamed: fileName].
	^ver!

----- Method: MCConfiguration>>withProgress:in:do: (in category 'private') -----
withProgress: progressString in: aCollection do: aBlock
	^self class extraProgressInfo
		ifTrue: [ aCollection do: aBlock displayingProgress: progressString ]
		ifFalse: [ aCollection do: aBlock ]

!

----- Method: MCConfiguration>>writerClass (in category 'accessing') -----
writerClass
	^ MCMcmWriter !

Object subclass: #MCMcmUpdater
	instanceVariableNames: 'updateMapName lastUpdateMap'
	classVariableNames: 'DefaultUpdateURL LastUpdateMap SkipPackages UpdateFromServerAtStartup UpdateMapName UpdateMissingPackages Updaters'
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCMcmUpdater commentStamp: 'dtl 5/4/2015 16:03' prior: 0!
MCMcmUpdater provides utility methods for updating Monticello packages from Monticello configurations.

When Monticello configurations are stored in a repository (or repositories), MCMcmUpdater acts as an update stream. It first ensures that each configuration map has been loaded in sequence, then updates the last configuration map to the most recent version for each specified package, and finally loads these versions to produce a fully updated configuration.

Currently if a set of packages are unloaded from the image, using this class to reload them may cause problems, depending on what dependencies those classes have.  Success is not assured.  Removing packages via SmalltalkImage>>unloadAllKnownPackages will be successful, it flags the packages removed so that they are not loaded by this utility.

If you wish to not have MCMcmUpdater update packages, there are two ways to handle this:

1) To have MCMcmUpdater not update any packages not currently in the image set the UpdateMissingPackages preference to false:
		MCMcmUpdater updateMissingPackages: false
	Note that any new packages added to the repositories will not be picked up when this is turned off.
2) To have MCMcmUpdater not update a specific package, evaluate
		MCMcmUpdater disableUpdatesOfPackage: <packageName>

Class Variables definitions:

DefaultUpdateURL - String: the URL that will be checked by default for updates.  This would be set for a common standard location to check.

Updaters - A dictionary of MCMcmUpdater instances keyed by repository URL.

SkipPackages - Set of Strings: names of packages to not update in MCMcmUpdater (empty by default).

UpdateMissingPackages - Boolean: if true (default), new packages in the update config map will be loaded unless they are in SkipPackages.  If false, packages not currently loaded in the image will not be loaded by MCMcmUpdater.  (This can be dangerous if packages are split - use at your own risk).

Instance Variables:

updateMapName - Base name of the files used for this updater, typically a name such as 'update' or 'update.spur'.

lastUpdateMap - Dictionary of Integer: version number of the last loaded update map per repository.  Keeps track of the last configuration map, so that the utility will not have to run through the full history in the repositories each time you ask to update.
!

----- Method: MCMcmUpdater class>>default (in category 'instance creation') -----
default
	"The default instance for system updates. Uses a default update map
	name that may be set as a preference to enable a specific update stream
	for a repository."

	^ self updaters
		at: self defaultUpdateURL
		ifAbsentPut: [self updateMapName: self updateMapName]!

----- Method: MCMcmUpdater class>>defaultBaseName (in category 'updating') -----
defaultBaseName
	"If not otherwise specified, look for update maps with this base name"

	^ 'update'!

----- Method: MCMcmUpdater class>>defaultUpdateURL (in category 'preferences') -----
defaultUpdateURL
	"The default update repository URL"

	<preference: 'Update URL'
		category: 'updates'
		description: 'The repository URL for loading updates'
		type: #String>

	^DefaultUpdateURL ifNil:['']!

----- Method: MCMcmUpdater class>>defaultUpdateURL: (in category 'preferences') -----
defaultUpdateURL: aString
	"The default update repository URL"

	DefaultUpdateURL := aString!

----- Method: MCMcmUpdater class>>disableUpdatesOfPackage: (in category 'preferences') -----
disableUpdatesOfPackage: packageName
	self skipPackages add: packageName!

----- Method: MCMcmUpdater class>>enableUpdatesForAllPackages (in category 'preferences') -----
enableUpdatesForAllPackages
	SkipPackages := Set new!

----- Method: MCMcmUpdater class>>enableUpdatesOfPackage: (in category 'preferences') -----
enableUpdatesOfPackage: packageName
	self skipPackages remove: packageName ifAbsent: [].!

----- Method: MCMcmUpdater class>>initialize (in category 'class initialization') -----
initialize
	"MCMcmUpdater initialize"
	LastUpdateMap ifNil:[
		LastUpdateMap := Dictionary new.
	].
	DefaultUpdateURL ifNil:[
		DefaultUpdateURL := MCHttpRepository trunkUrlString.
	].
	Updaters := nil.
	self flag: #FIXME.
		"The next line is to faciliate updating from class-side methods to instance based.
		Building a new default update map is very time consuming, so do not do it.
		Delete this after the transition is complete. Also delete class var LastUpdateMap
		and its initialization above. -dtl May 2015"
	LastUpdateMap ifNotNil: [ self default lastUpdateMap: LastUpdateMap ]
!

----- Method: MCMcmUpdater class>>skipPackages (in category 'preferences') -----
skipPackages
	^SkipPackages ifNil: [SkipPackages := Set new]!

----- Method: MCMcmUpdater class>>updateFromDefaultRepository (in category 'updating') -----
updateFromDefaultRepository
	"Update from the default repository only"

	^ self default updateFromDefaultRepository
!

----- Method: MCMcmUpdater class>>updateFromRepositories: (in category 'updating') -----
updateFromRepositories: repositoryUrls
	"MCMcmUpdater updateFromRepositories: #(
		'http://squeaksource.com/MCUpdateTest'
	)"

	^ self default updateFromRepositories: repositoryUrls!

----- Method: MCMcmUpdater class>>updateFromRepositories:using:baseName: (in category 'updating') -----
updateFromRepositories: repositoryUrls using: updaterUrlKey baseName: baseName
	"Update all repositoryUrls using an MCMcmUpdater identified by updaterUrlKey, and
	using update map baseName"

	^ (self updateMapName: baseName repository: updaterUrlKey)
		updateFromRepositories: repositoryUrls!

----- Method: MCMcmUpdater class>>updateFromRepository: (in category 'updating') -----
updateFromRepository: updaterUrlKey
	"Update using an MCMcmUpdater identified by updaterUrlKey using the default
	update map baseName"

	^ self updateFromRepository: updaterUrlKey baseName: self defaultBaseName
!

----- Method: MCMcmUpdater class>>updateFromRepository:baseName: (in category 'updating') -----
updateFromRepository: updaterUrlKey baseName: baseName
	"Update using an MCMcmUpdater identified by updaterUrlKey, and using
	update map baseName"

	^ (self updateMapName: baseName repository: updaterUrlKey)
		updateFrom: updaterUrlKey!

----- Method: MCMcmUpdater class>>updateFromServer (in category 'updating') -----
updateFromServer
	"Update the image by loading all pending updates from the server."

	^self default updateFrom: self defaultUpdateURL
!

----- Method: MCMcmUpdater class>>updateFromServerAtStartup (in category 'preferences') -----
updateFromServerAtStartup
	<preference: 'Update from server at startup'
		category: 'updates'
		description: 'If true, the system will check for and load any available updates.'
		type: #Boolean>
	^ UpdateFromServerAtStartup ifNil: [false].!

----- Method: MCMcmUpdater class>>updateFromServerAtStartup: (in category 'preferences') -----
updateFromServerAtStartup: aBool
	"Whether to update the image on startup."

	UpdateFromServerAtStartup := aBool.!

----- Method: MCMcmUpdater class>>updateMapName (in category 'preferences') -----
updateMapName
	"Name for update map, without version info"

	<preference: 'Update map name'
		category: 'updates'
		description: 'Base name for the update maps'
		type: #String>

	^UpdateMapName ifNil: ['update']!

----- Method: MCMcmUpdater class>>updateMapName: (in category 'instance creation') -----
updateMapName: baseName
	"Answer a new instance with a base update name baseName such as
	'update' or 'update.oscog' "

	^ self new updateMapName: baseName!

----- Method: MCMcmUpdater class>>updateMapName:repository: (in category 'instance creation') -----
updateMapName: baseName repository: url
	"Answer an instance for the given repository URL with a base update name
	baseName. The instance will be updated in the Updaters dictionary if baseName
	has changed."

	| updater |
	updater := self updaters at: url ifAbsentPut: [ self updateMapName: baseName ].
	updater updateMapName = baseName
		ifFalse: [ ^ self updaters at: url put: (self updateMapName: baseName )].
	^ updater
!

----- Method: MCMcmUpdater class>>updateMissingPackages (in category 'preferences') -----
updateMissingPackages
	"Whether to update missing (unloaded) packages"

	<preference: 'Update missing package'
		category: 'updates'
		description: 'If true, missing (unloaded) packages will be loaded during the update process.'
		type: #Boolean>

	^UpdateMissingPackages ifNil:[true]!

----- Method: MCMcmUpdater class>>updateMissingPackages: (in category 'preferences') -----
updateMissingPackages: aBool
	"Whether to update missing (unloaded) packages"

	UpdateMissingPackages := aBool.!

----- Method: MCMcmUpdater class>>updaters (in category 'accessing') -----
updaters
	"A dictionary of updaters, including the system default, indexed by repository URL"

	^ Updaters ifNil: [ Updaters := Dictionary new ]!

----- Method: MCMcmUpdater>>lastUpdateMap (in category 'accessing') -----
lastUpdateMap

	^ lastUpdateMap ifNil: [ lastUpdateMap := Dictionary new ]
!

----- Method: MCMcmUpdater>>lastUpdateMap: (in category 'accessing') -----
lastUpdateMap: aDictionary

	lastUpdateMap := aDictionary
!

----- Method: MCMcmUpdater>>refreshUpdateMapFor:with: (in category 'updating') -----
refreshUpdateMapFor: r with: updateList
	"Update the lastUpdateMap and answer a possibly reduced updateList"

	| config |
	(lastUpdateMap at: r description ifAbsent: [0]) = 0 ifTrue: [
		"No update has ever been loaded from this repo. If no package is
		present in the image either, we can skip right to the latest config"
		config := r versionNamed: updateList last value.
		(config dependencies anySatisfy: [:dep | dep package hasWorkingCopy])
			ifFalse: [(self useLatestPackagesFrom: r)
					ifTrue: [lastUpdateMap at: r description put: updateList last key].
				updateList isEmpty
					ifTrue: [^ #()]
					ifFalse: [^ updateList last: 1]]].
	^ updateList
!

----- Method: MCMcmUpdater>>skipPackages (in category 'private') -----
skipPackages
	^SkipPackages ifNil: [SkipPackages := Set new]!

----- Method: MCMcmUpdater>>updateFrom: (in category 'updating') -----
updateFrom: url
	"Update the image by loading all pending updates from the server."
	| config |
	"Flush all caches. If a previous download failed this is often helpful"
	MCFileBasedRepository flushAllCaches.
	config := self updateFromRepositories: { url }.
	config ifNil: [^self inform: 'Unable to retrieve updates from remote repository.' translated].
	config setSystemVersion.
	self inform: ('Update completed.
Current update number: ' translated, SystemVersion current highestUpdate).!

----- Method: MCMcmUpdater>>updateFromConfig: (in category 'updating') -----
updateFromConfig: config

	"Skip packages that were specifically unloaded"
	config dependencies: (config dependencies 
		reject: [:dep| self class skipPackages includes: dep package name]).
	self class updateMissingPackages ifFalse:[
		"Skip packages that are not in the image"
		config dependencies: (config dependencies 
			select: [:dep| dep package hasWorkingCopy])].
	(config dependencies allSatisfy:[:dep| dep isFulfilled]) 
		ifFalse:[config upgrade].
!

----- Method: MCMcmUpdater>>updateFromDefaultRepository (in category 'updating') -----
updateFromDefaultRepository
	"Update from the default repository only"
	^self updateFromRepositories: {self class defaultUpdateURL}!

----- Method: MCMcmUpdater>>updateFromRepositories: (in category 'updating') -----
updateFromRepositories: repositoryUrls
	"MCMcmUpdater updateFromRepositories: #(
		'http://squeaksource.com/MCUpdateTest'
	)"

	| repos config |
	MCConfiguration upgradeIsMerge: true.
	"The list of repositories to consult in order"
	repos := repositoryUrls collect:[:url| 
		MCRepositoryGroup default repositories 
			detect:[:r| r description = url]
			ifNone:[ | r |
				r := MCHttpRepository location: url user: '' password: ''.
				MCRepositoryGroup default addRepository: r.
				r]].

	"The list of updates-author.version.mcm sorted by version"
	repos do:[ :r | config := self updateFromRepository: r ].
	^config!

----- Method: MCMcmUpdater>>updateFromRepository: (in category 'updating') -----
updateFromRepository: repository

	| config |
	repository cacheAllFileNamesDuring: [ | updateList |
		updateList := self updateListFor: repository.
		"Proceed only if there are updates available at all."
		updateList ifNotEmpty: [
			updateList := self refreshUpdateMapFor: repository with: updateList.
			"Now process each update file. Check if we have all dependencies and if not,
			load the entire configuration (this is mostly to skip older updates quickly)"
			updateList do:[:assoc|
				ProgressNotification signal: '' extra: 'Processing ', assoc value.
				config := repository versionNamed: assoc value.
				self updateFromConfig: config.
				self lastUpdateMap at: repository description put: assoc key.
			] displayingProgress: 'Processing configurations'.
			"We've loaded all the provided update configurations.
			Use the latest configuration to update all the remaining packages."
			(self useLatestPackagesFrom: repository) ifTrue: [
				config updateFromRepositories.
				config upgrade].
		]].
	^ config
!

----- Method: MCMcmUpdater>>updateListFor: (in category 'private') -----
updateListFor: repo

	| updateList allNames minVersion |
	updateList := OrderedCollection new.
	minVersion := self lastUpdateMap at: repo description ifAbsent: [0].
	"Find all the update-*.mcm files"
	allNames := 'Checking ', repo description
		displayProgressFrom: 0 to: 1 during: [:bar| 
			bar value: 0.
			repo allFileNamesOrCache ].
	allNames do: [:fileName | | version |
		((fileName endsWith: '.mcm')
			and: [fileName packageAndBranchName = self updateMapName
				and: [(version := fileName versionNumber) >= minVersion]]) 
					ifTrue: [updateList add: version -> fileName]].
	^updateList sort!

----- Method: MCMcmUpdater>>updateMapName (in category 'accessing') -----
updateMapName
	"Name for update map, without version info"

	^ updateMapName ifNil: [updateMapName := self class updateMapName]!

----- Method: MCMcmUpdater>>updateMapName: (in category 'accessing') -----
updateMapName: aString
	"Name for update map, without version info"
	updateMapName := aString!

----- Method: MCMcmUpdater>>useLatestPackagesFrom: (in category 'private') -----
useLatestPackagesFrom: repo
	"for overriding on a per repository basis"
	^true!

----- Method: MCFileBasedRepository class>>supportsConfigurations (in category '*monticelloconfigurations') -----
supportsConfigurations
	^ true!

MCVersionReader subclass: #MCMcmReader
	instanceVariableNames: 'fileName configuration'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MonticelloConfigurations'!

!MCMcmReader commentStamp: 'dtl 5/10/2010 22:22' prior: 0!
A MCMcmReader creates an MCConfiguration by reading an array specification from a stream.

!

----- Method: MCMcmReader class>>extension (in category 'accessing') -----
extension
	^ 'mcm'!

----- Method: MCMcmReader class>>loadVersionFile: (in category 'instance creation') -----
loadVersionFile: fileName
	| version |
	version := self versionFromFile: fileName.
	version load.
!

----- Method: MCMcmReader class>>on:fileName: (in category 'instance creation') -----
on: aStream fileName: aFileName
	| reader |
	reader := self on: aStream.
	reader fileName: aFileName.
	^reader!

----- Method: MCMcmReader>>configuration (in category 'accessing') -----
configuration
	configuration ifNil: [self loadConfiguration].
	"browser modifies configuration, but the reader might get cached"
	^configuration copy!

----- Method: MCMcmReader>>fileName: (in category 'accessing') -----
fileName: aString
	fileName := aString!

----- Method: MCMcmReader>>loadConfiguration (in category 'accessing') -----
loadConfiguration
	stream reset.
	configuration := MCConfiguration fromArray: (MCScanner scan: stream).
	configuration name ifNil: [ configuration name: self parseNameFromFilename ]!

----- Method: MCMcmReader>>loadVersionInfo (in category 'accessing') -----
loadVersionInfo
	info := self configuration!

----- Method: MCMcmReader>>parseNameFromFilename (in category 'accessing') -----
parseNameFromFilename
	^fileName ifNotNil: [(fileName findTokens: '/\:') last copyUpToLast: $.]!

----- Method: MCMcmReader>>version (in category 'accessing') -----
version
	^self configuration!



More information about the Squeak-dev mailing list