Stéphane Ducasse uploaded a new version of Installer-Core to project Installer: http://www.squeaksource.com/Installer/Installer-Core-stephane.ducasse.230.mc...
==================== Summary ====================
Name: Installer-Core-stephane.ducasse.230 Author: stephane.ducasse Time: 30 September 2008, 6:45:25 pm UUID: 92281bc6-c1be-4563-b7ea-259c5c4cc875 Ancestors: Installer-Core-kph.229
stef fixing indentation and providing some comments
I read the code of Installer I reformatted the code and publish it.
Now here is a list of questions/suggestions
============================== Installer class>>classes ^ Smalltalk
not invoked seems bogus
============================== Entities seems a bad name for html elements mapping.
============================== history seems obsolete
Installer class>>mczInstall is misclassified
============================== Installer class>>sake
^ self sake: (Sake ifNil: [ self classPackages current ])
Does not make sense to me if Sake is not loaded.
setSakeToUse: aClass
Sake := aClass is missing a comment to indicate what is the purpose of Sake?
On the instance side ============================== user
^ user ifNil: [ '' ] user: anObject
user := anObject
user is undefined, thanks shout!
==============================
classMCMczReader
^Smalltalk at: #MCMczReader ifAbsent: [ nil ] classMCReader
^Smalltalk at: #MCReader ifAbsent: [ nil ]
classMczInstaller
^Smalltalk at: #MczInstaller ifAbsent: [ nil ] why nil and not error as all the others?
==============================
createRBforBug: aBugNo | aStream fileList selFile aFileName |
self setBug: aBugNo. fileList := self maFiles keys asOrderedCollection. fileList addLast: 'none'. ReleaseBuilderFor3dot10 clear. [selFile := UIManager default chooseFrom: fileList title: 'Choose what files load '. selFile = fileList size ifFalse:[ aFileName := fileList at: selFile. self logCR: 'obtaining ', aFileName, '...'.
aStream := self maStreamForFile: aFileName . ReleaseBuilderFor3dot10 current packagesInfluenced: aStream named: aFileName. self installCS: aFileName from: aStream].selFile = fileList size]whileFalse. ReleaseBuilderFor3dot10 current newUpdateFor: aBugNo ReleaseBuilderFor3dot10 does not exist.
==============================
installMCcs: aFileName from: stream
| reader | reader := MCCsReader on: stream.
should use self MCCsReader because MCCsReader may not exist
============================== skipTests is empty
=============== Diff against Installer-Core-kph.229 ===============
Item was changed: ----- Method: Installer class>>unload: (in category 'unload') ----- unload: categoryMatchesString
+ ^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'! - ^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'!
Item was changed: ----- Method: Installer>>uniUpdate (in category 'universes') ----- uniUpdate + (LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ]) ifTrue: [universe requestPackageList. LastUniUpdate := DateAndTime now]!
Item was changed: ----- Method: Installer class>>sourceFiles (in category 'accessing system') ----- sourceFiles
+ ^ SourceFiles! - ^ SourceFiles!
Item was changed: ----- Method: Installer class>>squeakmap (in category 'instanciation') ----- squeakmap
+ ^self new sm: true; yourself! - ^self new sm: true; yourself!
Item was changed: ----- Method: Installer class>>file: (in category 'instanciation') ----- file: fileName
+ ^ self new file: fileName; yourself - ^ self new file: fileName; yourself !
Item was changed: ----- Method: Installer class>>classSakePackages (in category 'accessing system') ----- classSakePackages
+ ^Smalltalk at: #SakePackages ifAbsent: [ self error: 'Sake Packages code not present' ]! - ^Smalltalk at: #SakePackages ifAbsent: [ self error: 'Sake Packages code not present' ]!
Item was changed: ----- Method: Installer class>>url: (in category 'instanciation') ----- url: urlString
+ ^self web url: urlString; yourself! - ^self web url: urlString; yourself!
Item was changed: ----- Method: Installer>>smUpdate (in category 'squeakmap') ----- smUpdate "Updates the local map for SqueakMap, upgrading SqueakMap to the latest version if necessary.
When SqueakMap is old and needs to be upgraded, it does four things that mostly make sense in the interactive world SM was built for, but are totally evil here in the world of automatic scripting: 1. It asks the user if she wants to upgrade, in the form of a pop-up (see SMSqueakMap >> #checkVersion:). 2. It terminates its own process. 3. It creates a new UI process. (see the last line of the SqueakMap upgrade file-in: ''Project spawnNewProcessAndTerminateOld: true'', from http://map.squeak.org/accountbyid/9bdedc18-1525-44a6-9b79-db5d4a87f6f8/files... 4. It opens a SqueakMap window
We work around these three problems seperately: 1. We use #answer:with: and #withAnswersDo: to automatically answer ''Yes'' when asked if we want to upgrade 2. We don't want this process to be terminated, so we run the update in a forked process and wait for it to finish, using #fork, #ensure:, and a Semaphore 3. We keep track of the UI process before updating, and if it changes, we terminate the new UI process and reinstall the old one using Project >> #resumeProcess: 4. We don't bother with the newly opened window. The other three problems are much worse.
We do all this in a new process, since it is not unlikely that this method is executing in the UI process"
| oldUIProcess newUIProcess doneSema | self answer: 'You need to upgrade the SqueakMap package' with: true. oldUIProcess := Project uiProcess. doneSema := Semaphore new. + [[self withAnswersDo: [self classSMSqueakMap default loadUpdates]] + ensure: [newUIProcess := Project uiProcess. + (oldUIProcess ~~ newUIProcess + and: [oldUIProcess notNil] + and: [oldUIProcess isTerminated not]) + ifTrue: [ + newUIProcess ifNotNil: [newUIProcess terminate]. + oldUIProcess suspend. + Project resumeProcess: oldUIProcess.]. + doneSema signal]] fork. - - [[ - self withAnswersDo: [self classSMSqueakMap default loadUpdates] - ] ensure: [ - newUIProcess := Project uiProcess. - - ( - oldUIProcess ~~ newUIProcess - and: [oldUIProcess notNil] - and: [oldUIProcess isTerminated not] - ) ifTrue: [ - newUIProcess ifNotNil: [newUIProcess terminate]. - oldUIProcess suspend. - Project resumeProcess: oldUIProcess. - ]. - - doneSema signal - ]] fork. doneSema wait!
Item was changed: ----- Method: Installer class>>websqueakmap (in category 'instanciation') ----- websqueakmap
+ ^self new wsm: 'http://map.squeak.org'; yourself! - ^self new wsm: 'http://map.squeak.org'; yourself!
Item was changed: ----- Method: Installer class>>mantis: (in category 'instanciation') ----- mantis: host
+ ^self new ma: host; - ^self new ma: host; markers: '"fix begin"..."fix test"..."fix end"'; yourself. !
Item was changed: ----- Method: Installer>>classMCVersionLoader (in category 'class references') ----- classMCVersionLoader
+ ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]! - ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]!
Item was changed: ----- Method: Installer class>>cancelSkipLoadingTests (in category 'accessing') ----- cancelSkipLoadingTests + "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages" + + SkipLoadingTests := false. - - "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages" - SkipLoadingTests := false. !
Item was changed: ----- Method: Installer class>>webSearchPath (in category 'accessing') ----- webSearchPath + "a search path item, has the following format. prefix*suffix"
+ ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].! - "a search path item, has the following format. prefix*suffix" - - ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].!
Item was changed: ----- Method: Installer class>>fixesApplied (in category 'accessing') ----- fixesApplied
+ ^ Fixes ifNil: [ Fixes := OrderedCollection new ].! - ^ Fixes ifNil: [ Fixes := OrderedCollection new ].!
Item was changed: ----- Method: Installer class>>classes (in category 'accessing system') ----- classes
+ ^ Smalltalk! - ^ Smalltalk!
Item was changed: ----- Method: Installer class>>classProjectLauncher (in category 'accessing system') ----- classProjectLauncher
+ ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]! - ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!
Item was changed: ----- Method: Installer>>webFindUrlToDownload (in category 'web install') ----- webFindUrlToDownload
+ self class webSearchPath + do: [ :pathSpec | + | potentialUrl readPathSpec | + readPathSpec := pathSpec value readStream. + potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]). + [ pageDataStream := self urlGet: potentialUrl ] + doWhileTrue: [ + (pageDataStream notNil and: [ pageDataStream size > 0 ]) + ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') + ifFalse: [ pageDataStream reset. + ^ potentialUrl ] ]. + (Delay forSeconds: 2) wait. + true]]. - self class webSearchPath do: [ :pathSpec | - | potentialUrl readPathSpec | - readPathSpec := pathSpec value readStream. - potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]). - [ pageDataStream := self urlGet: potentialUrl ] - - doWhileTrue: [ - - (pageDataStream notNil and: [ pageDataStream size > 0 ]) - ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') ifFalse: [ pageDataStream reset. ^ potentialUrl ] ]. - - (Delay forSeconds: 2) wait. - true. - ]. - - ]. ^nil !
Item was changed: ----- Method: Installer class>>web (in category 'instanciation') ----- web + ^self new ! - ^self new !
Item was changed: ----- Method: Installer class>>do: (in category 'launcher support') ----- do: webPageName
| rs | - self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ]. - rs := webPageName readStream. - [ rs atEnd ] whileFalse: [ self install: (rs upTo: $;) ]. !
Item was changed: ----- Method: Installer class>>validationBlock (in category 'instanciation-abbreviated') ----- validationBlock
- ^ ValidationBlock!
Item was changed: ----- Method: Installer class>>view: (in category 'instanciation') ----- view: webPageNameOrUrl
+ | theReport | - | theReport |
+ theReport := String streamContents: [ :report | - theReport := String streamContents: [ :report | (webPageNameOrUrl beginsWith: 'http://') ifTrue: [ self new urlAction: ('Installer installUrl: ', (webPageNameOrUrl printString),'.') reportOn: report. ] ifFalse: [ self new webAction: ('Installer install: ', (webPageNameOrUrl printString),'.') reportOn: report. + ]]. - ]. - ]. - - Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl.
+ Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl. + + ^theReport contents - ^theReport contents !
Item was changed: ----- Method: Installer class>>classPackages (in category 'accessing system') ----- classPackages
+ ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]! - ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]!
Item was changed: ----- Method: Installer>>maFiles (in category 'mantis') ----- maFiles + | file files bugPage id | + files := Dictionary new. + bugPage := self maPage. + [ + id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. + file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<. + ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ]. + id notEmpty ] whileTrue. - - | file files bugPage id | - - files := Dictionary new. - - bugPage := self maPage.
+ ^files ! - [ - id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. - file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<. - - ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ]. - - id notEmpty ] whileTrue. - - ^files !
Item was changed: ----- Method: Installer class>>classUGlobalInstaller (in category 'accessing system') ----- classUGlobalInstaller
+ ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]! - ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]!
Item was changed: ----- Method: Installer class>>classUUniverse (in category 'accessing system') ----- classUUniverse
+ ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]! - ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]!
Item was changed: ----- Method: Installer class>>installUrl: (in category 'instanciation') ----- installUrl: urlString
+ ^ self web url: urlString; install. - ^ self web url: urlString; install. !
Item was changed: ----- Method: Installer class>>skipLoadingTests (in category 'accessing') ----- skipLoadingTests + "sets a flag to ignore loading of the testing portion of scripts embedded in pages" + + SkipLoadingTests := true. - - "sets a flag to ignore loading of the testing portion of scripts embedded in pages" - SkipLoadingTests := true. !
Item was changed: ----- Method: Installer class>>installSilentlyUrl: (in category 'instanciation') ----- installSilentlyUrl: urlString
+ ^ SystemChangeNotifier uniqueInstance doSilently: [ self web url: urlString; install ]. - ^ SystemChangeNotifier uniqueInstance doSilently: [ self web url: urlString; install ]. !
Item was changed: ----- Method: Installer class>>webInstall: (in category 'instanciation') ----- webInstall: webPageName
+ self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ]. + ^ self web install: webPageName - self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ]. - - ^ self web install: webPageName !
Item was changed: ----- Method: Installer class>>installFile: (in category 'instanciation') ----- installFile: fileName
+ ^ (self file: fileName) install. - ^ (self file: fileName) install. !
Item was changed: ----- Method: Installer class>>path: (in category 'instanciation') ----- path: aString "convenience abbreviation" + self webSearchPathFrom: aString!
Item was changed: ----- Method: Installer class>>websqueakmap: (in category 'instanciation') ----- websqueakmap: host
+ ^self new wsm: host; yourself! - ^self new wsm: host; yourself!
Item was changed: ----- Method: Installer>>maPage (in category 'mantis') ----- maPage + " self mantis bug: 5251." - " - self mantis bug: 5251. - " - | page |
+ | page | + page := self httpGet: self maUrl. + date := ((self maRead: page field: 'Date Updated') value copyUpTo: $ ). + date isEmpty ifTrue: [ ^self error: bug, ' not found' ]. + date := date asDate. + ^page reset! - page := self httpGet: self maUrl. - - date := ((self maRead: page field: 'Date Updated') value copyUpTo: $ ). - - date isEmpty ifTrue: [ ^self error: bug, ' not found' ]. - - date := date asDate. - - ^page reset!
Item was changed: ----- Method: Installer class>>webSearchPathFrom: (in category 'accessing') ----- webSearchPathFrom: string
| reader wsp path | - reader := string readStream. wsp := self webSearchPath. - [ reader atEnd ] whileFalse: [ path := reader upTo: $;. + (wsp includes: wsp) ifFalse: [ wsp addFirst: path ]]. - (wsp includes: wsp) ifFalse: [ wsp addFirst: path ] - ].
!
Item was changed: ----- Method: Installer>>mcThing:from: (in category 'mantis') ----- mcThing: aFileName from: stream "dont use monticello for .cs or for .st use monticello for .mcs"
| reader | - reader := self classMCReader readerClassForFileNamed: aFileName. - reader name = 'MCStReader' ifTrue: [ ^ nil ]. - reader ifNil: [ ^ nil ]. - (reader respondsTo: #on:fileName:) + ifTrue: [ reader := reader on: stream fileName: aFileName. - ifTrue: [ reader := reader on: stream fileName: aFileName. ^ reader version ] + ifFalse: [ reader := reader on: stream. - ifFalse: [ reader := reader on: stream. ^ reader snapshot ].!
Item was changed: ----- Method: Installer>>unload: (in category 'actions') ----- unload: match
(MCWorkingCopy allManagers select: [ :wc | match match: (wc package name) ]) do: [ :wc | self logCR: 'Unloading ', wc package asString. + wc unload.]. - wc unload. - - ]. - self unloadCleanUp!
Item was changed: + ----- Method: Installer class>>noProgressDuring: (in category 'during') ----- - ----- Method: Installer class>>noProgressDuring: (in category 'as yet unclassified') ----- noProgressDuring: block
[ block value: self ] on: ProgressInitiationException do: [ :note | note resume ]
!
Item was changed: ----- Method: Installer>>setBug: (in category 'mantis') ----- setBug: stringOrNumber - - | str | - - self logCR: stringOrNumber. - - stringOrNumber isInteger ifTrue: [ bug := stringOrNumber. desc := ''. ^self ]. - - bug := stringOrNumber asInteger. - str := str printString. - desc := stringOrNumber copyFrom: (str size + 1) to: (stringOrNumber size)
+ | str | + self logCR: stringOrNumber. + stringOrNumber isInteger ifTrue: [ bug := stringOrNumber. desc := ''. ^self ]. + bug := stringOrNumber asInteger. + str := str printString. + desc := stringOrNumber copyFrom: (str size + 1) to: (stringOrNumber size) + !
Item was changed: ----- Method: Installer>>mcSortFileBlock (in category 'monticello') ----- mcSortFileBlock
^ [:a :b | + [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] + on: Error do: [:ex | false]].! - [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].!
Item was changed: ----- Method: Installer class>>install: (in category 'instanciation') ----- install: webPageName
+ self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ]. - self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
+ ^ self web install: webPageName - ^ self web install: webPageName !
Item was changed: ----- Method: Installer class>>entities (in category 'accessing') ----- entities
+ ^ Entities ifNil: [ Entities := + "enough entities to be going on with" + Dictionary new. + Entities at: 'lt' put: '<'; + at: 'gt' put: '>'; + at: 'amp' put: '&'; + at: 'star' put: '*'; + at: 'quot' put: '"'; + at: 'nbsp' put: ' '; + yourself - ^ Entities ifNil: [ Entities := - "enough entities to be going on with" - Dictionary new. - Entities at: 'lt' put: '<'; - at: 'gt' put: '>'; - at: 'amp' put: '&'; - at: 'star' put: '*'; - at: 'quot' put: '"'; - at: 'nbsp' put: ' '; - yourself ]
!
Item was changed: ----- Method: Installer class>>smalltalkImage (in category 'accessing system') ----- smalltalkImage
+ ^ SmalltalkImage current! - ^ SmalltalkImage current!
Item was changed: ----- Method: Installer class>>repository: (in category 'instanciation') ----- repository: host
+ ^self monticello http: host ! - ^self monticello http: host !
Item was changed: + ----- Method: Installer class>>skipLoadingTestsDuring: (in category 'during') ----- - ----- Method: Installer class>>skipLoadingTestsDuring: (in category 'as yet unclassified') ----- skipLoadingTestsDuring: block
| oldValue |
oldValue := SkipLoadingTests. SkipLoadingTests := true. [ block value: self ] ensure:[ SkipLoadingTests := oldValue ].!