Squeak 4.6: MonticelloConfigurations-dtl.1
Locked
 
|
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@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! |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |