[Pkg] The Trunk: MonticelloConfigurations-cmm.89.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Mar 15 19:14:32 UTC 2011


Chris Muller uploaded a new version of MonticelloConfigurations to project The Trunk:
http://source.squeak.org/trunk/MonticelloConfigurations-cmm.89.mcz

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

Name: MonticelloConfigurations-cmm.89
Author: cmm
Time: 15 March 2011, 2:04:34.474 pm
UUID: df7e90f2-75c9-4f64-8534-287d0ca5c542
Ancestors: MonticelloConfigurations-cmm.88, MonticelloConfigurations-ul.84

- Merged ul.84 and updated to new MCVersionName api.

=============== Diff against MonticelloConfigurations-ul.84 ===============

Item was changed:
  ----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') -----
+ depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString 
+ 	| count action |
- depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString
- 	| repoMap count action |
- 	repoMap := Dictionary new.
- 	self repositories do: [:repo |
- 		MCRepositoryGroup default addRepository: repo.
- 		repo allVersionNames
- 			ifEmpty: [self logWarning: 'cannot read from ', repo description]
- 			ifNotEmptyDo: [:all | all do: [:ver | repoMap at: ver put: repo]]].
- 
  	count := 0.
+ 	self repositories do: [ : eachRepository | MCRepositoryGroup default addRepository: eachRepository ].
+ 	action := [ : dep | | ver repo |
+ 	ver := dep versionInfo name.
+ 	repo := self repositories
+ 		detect:
+ 			[ : eachRepository | eachRepository includesVersionNamed: ver ]
+ 		ifFound:
+ 			[ : foundRep | foundRep ]
+ 		ifNone:
+ 			[ self logError: 'Version ' , ver , ' not found in any repository'.
- 	action := [:dep |
- 		| ver repo |
- 		ver := dep versionInfo name.
- 		repo := repoMap at: ver ifAbsent: [
- 			self logError: 'Version ', ver, ' not found in any repository'.
  			self logError: 'Aborting'.
+ 			^ count ].
+ 	(selectBlock value: dep) ifTrue:
+ 		[ | new |
+ 		new := self
+ 			versionNamed: ver
+ 			for: dep
+ 			from: repo.
+ 		new
+ 			ifNil:
+ 				[ self logError: 'Could not download version ' , ver , ' from ' , repo description.
+ 				self logError: 'Aborting'.
+ 				^ count ]
+ 			ifNotNil:
+ 				[ self
+ 					logUpdate: dep package
+ 					with: new.
+ 				self class extraProgressInfo ifTrue:
+ 					[ ProgressNotification
+ 						signal: ''
+ 						extra: 'Installing ' , ver ].
+ 				verBlock value: new.
+ 				count := count + 1 ] ].
+ 	dep package workingCopy repositoryGroup addRepository: repo ].
+ 	self class extraProgressInfo
+ 		ifTrue:
+ 			[ self dependencies
+ 				do: action
+ 				displayingProgress: progressString ]
+ 		ifFalse: [ self dependencies do: action ].
+ 	^ count!
- 			^count].
- 		(selectBlock value: dep) ifTrue: [
- 			| new |
- 			new := self versionNamed: ver for: dep from: repo.
- 			new ifNil: [
- 					self logError: 'Could not download version ', ver, ' from ', repo description.
- 					self logError: 'Aborting'.
- 					^count]
- 				ifNotNil: [
- 					self logUpdate: dep package with: new.
- 					self class extraProgressInfo
- 						ifTrue:[ProgressNotification signal: '' extra: 'Installing ', ver].
- 					verBlock value: new.
- 					count := count + 1.
- 				]
- 		].
- 		dep package workingCopy repositoryGroup addRepository: repo.
- 	].
- 	self class extraProgressInfo 
- 		ifTrue:[self dependencies do: action displayingProgress: progressString]
- 		ifFalse:[self dependencies do: action].
- 	^count!

Item was changed:
  ----- 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!
- 	^wc ancestors first name!

Item was changed:
  ----- 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 ].
- 			ifNotNil: [ name copyUpTo: $- ].
  		Utilities authorInitials.
  		name
  			ifNil: [ 1 ]
+ 			ifNotNil: [ name asMCVersionName versionNumber + 1 ] }!
- 			ifNotNil: [ (name copyAfterLast: $.) asInteger + 1 ] }
- 
- 	!

Item was changed:
  ----- Method: MCConfiguration>>updateFromRepositories (in category 'updating') -----
  updateFromRepositories
+ 	| oldNames newNames sortedNames newDeps |
+ 	oldNames := self dependencies collect: [:dep | dep versionInfo versionName].
- 	| oldInfos newNames sortedNames newDeps |
- 	oldInfos := self dependencies collect: [:dep | dep versionInfo].
  	newNames := Dictionary new.
  	self repositories
  		do: [:repo | 
  			ProgressNotification signal: '' extra: 'Checking ', repo description.
+ 			(repo possiblyNewerVersionsOfAnyOf: oldNames)
- 			(repo possiblyNewerVersionsOfAnyOf: oldInfos)
  				do: [:newName | newNames at: newName put: repo]]
  		displayingProgress: 'Searching new versions'.
  
  	sortedNames := newNames keys asArray sort:
+ 		[:a :b | a versionNumber > b versionNumber].
- 		[:a :b | a numericSuffix > b numericSuffix].
  
  	newDeps := OrderedCollection new.
  	self dependencies do: [:dep |
  		| newName |
  		newName := sortedNames
+ 			detect: [:each | each packageName = dep package name]
- 			detect: [:each | (each copyUpToLast: $-) = dep package name]
  			ifNone: [nil].
  		newDeps add: (newName
  			ifNil: [dep]
  			ifNotNil: [
  				| repo info  |
  				repo := newNames at: newName.
  				info := self versionInfoNamed: newName for: dep from: repo.
  				info ifNil: [dep]
  					ifNotNil: [MCVersionDependency package: dep package info: info]
  			])
  	] displayingProgress: 'downloading new versions'.
  
  	self dependencies: newDeps.
  !

Item was changed:
  ----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') -----
+ versionNamed: aMCVersionName for: aDependency from: repo
- versionNamed: verName for: aDependency from: repo
  
  	| baseName fileName ver |
+ 	(repo filterFileNames: repo cachedFileNames forVersionNamed: aMCVersionName) ifNotEmptyDo: [:cachedNames |
- 	(repo filterFileNames: repo cachedFileNames forVersionNamed: verName) ifNotEmptyDo: [:cachedNames |
  		fileName := cachedNames anyOne.
  		self class extraProgressInfo
  			ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName].
+ 		ver := repo versionNamed: fileName].
- 		ver := repo versionFromFileNamed: fileName].
  	ver ifNil: [
  		baseName := self diffBaseFor: aDependency.
+ 		(baseName notNil and: [baseName ~= aMCVersionName and: [repo includesVersionNamed: baseName]]) ifTrue: [
+ 			fileName := (MCDiffyVersion nameForVer: aMCVersionName base: baseName), '.mcd'.
- 		(baseName notNil and: [baseName ~= verName and: [repo includesVersionNamed: baseName]]) ifTrue: [
- 			fileName := (MCDiffyVersion nameForVer: verName base: baseName), '.mcd'.
  			self class extraProgressInfo
  				ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
+ 			ver := repo versionNamed: fileName]].
- 			ver := repo versionFromFileNamed: fileName]].
  	ver ifNil: [
+ 		fileName := aMCVersionName versionName, '.mcz'.
- 		fileName := verName, '.mcz'.
  		self class extraProgressInfo
  			ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName].
+ 		ver := repo versionNamed: fileName].
- 		ver := repo versionFromFileNamed: fileName].
  	^ver!

Item was changed:
  ----- 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?' ]) ]!
- 	missing := (self dependencies collect: [:ea | ea versionInfo name]) asSet.
- 
- 	self repositories
- 		do: [:repo |
- 			repo allVersionNames
- 				do: [:found | missing remove: found ifAbsent: []]]
- 		displayingProgress: 'searching versions'.
- 
- 	^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?'])]
- 	!

Item was changed:
  ----- Method: MCMcmUpdater class>>updateFromRepositories: (in category 'updating') -----
  updateFromRepositories: repositoryUrls
  	"MCMcmUpdater updateFromRepositories: #(
  		'http://squeaksource.com/MCUpdateTest'
  	)"
  
  	| repos config |
  	Preferences enable: #upgradeIsMerge.
  	LastUpdateMap ifNil:[LastUpdateMap := Dictionary new].
  	"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| r cacheAllFileNamesDuring:[
  		| minVersion updateList allNames |
  		updateList := SortedCollection new.
  		minVersion := LastUpdateMap at: r description ifAbsent:[0].
  		"Find all the updates-author.version.mcm files"
  		'Checking ', r description
  			displayProgressAt: Sensor cursorPoint
  			from: 0 to: 1 during:[:bar| 
  				bar value: 0.
+ 				allNames := r allFileNamesOrCache.
- 				allNames := r allFileNames.
  			].
  		allNames do:[:versionedName| | version base parts author type |
  			parts := versionedName findTokens: '.-'.
  			parts size = 4 ifTrue:[
  				base := parts at: 1.
  				author := parts at: 2.
  				version := [(parts at: 3) asNumber] on: Error do:[:ex| ex return: 0].
  				type := parts at: 4.
  			].
  			(base = 'update' and:[version >= minVersion and:[type = 'mcm']]) 
  				ifTrue:[updateList add: version -> versionedName]].
  		
  		"Proceed only if there are updates available at all."
  		updateList ifNotEmpty: [
  			"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 := r versionNamed: assoc value.
- 				config := r versionFromFileNamed: assoc value.
  				"Skip packages that were specifically unloaded"
  				config dependencies: (config dependencies 
  					reject: [:dep| self skipPackages includes: dep package name]).
  				self 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].
  				LastUpdateMap at: r 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."
  			config updateFromRepositories.
  			config upgrade.
  		]].
  	].
  	^config!



More information about the Packages mailing list