SystemOrganization addCategory: #'Installer-Core'! Object subclass: #Installer instanceVariableNames: 'answers packages messagesToSuppress' classVariableNames: 'IsSetToTrapErrors Remembered SkipLoadingTests InstallerBindings ValidationBlock' poolDictionaries: '' category: 'Installer-Core'! !Installer commentStamp: 'kph 12/19/2007 14:42' prior: 0! Documentation now available at http://installer.pbwiki.com/Installer ! Installer subclass: #InstallerCruft instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerCruft commentStamp: 'mtf 10/1/2008 22:24' prior: 0! I am a copy of Installer as of Installer-Core-kph.232. I am being split up. I am called InstallerCruft because I stand-in for Sake{MC,SM,Mantis,Web,etc}Installer! !InstallerCruft class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classes ^ Smalltalk! ! !InstallerCruft class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classProjectLauncher ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]! ! !InstallerCruft class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classSakePackages ^Smalltalk at: #SakePackages ifAbsent: [ self error: 'Sake Packages code not present' ]! ! !InstallerCruft class methodsFor: 'documentation' stamp: 'kph 7/25/2007 13:25'! history " 7 Jan 2007 !!Installer fixBug: aBugNo can now be a number or a string, beginning with a number. This allows the mantis bug report summary to be used verbatim. It also provides more infomarion for Installer to support self documentation. !!Install fix if not already installed Installer ensureFix: Installer ensureFixes: #(1 2 3 4) Installer now keeps a list of fix that have been installed up to this point. #ensureFix: will only install the fix if it has not already been loaded. note that only the bugNumber not the description is significant in the check. 8 Jan 2007 !!Installer view: Provided that web page based scripts follow some simple rules, installer can collate the scripts from web pages into a single workspace where you can manually 'doit' portions as you wish. The report generation is not very clever, it only matches on: 'Installer install:' , 'Installer installUrl:', and 'Installer mantis fixBug:' note these lines must be properly completed with an ending $. (period). also invoked by commandline option VIEW= 10 Jan 2007 !!Now matches simpler html Check for an html page, now matches ' the allows use of pbwiki's raw=bare option which returns iframe embeddable html without the usual headers. 8 May 2007 Modified bug:fix:date: so that the fixesApplied history does not contain unnecessary duplicate entries. Fixed changeset naming for mantis bugs. 25 July 2007 Added Universes Support "! ! !InstallerCruft class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:38'! label ^ 'cruft'! ! !InstallerCruft class methodsFor: 'documentation' stamp: 'kph 5/24/2007 18:54'! mczInstall: urlOrFile ^ self new mczInstall: urlOrFile ! ! !InstallerCruft class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:20'! smalltalkImage ^ SmalltalkImage current! ! !InstallerCruft class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:20'! sourceFiles ^ SourceFiles! ! !InstallerCruft class methodsFor: 'unload' stamp: 'stephane.ducasse 9/30/2008 18:30'! unload: categoryMatchesString ^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'! ! !InstallerCruft methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classMCMczReader ^Smalltalk at: #MCMczReader ifAbsent: [ nil ] ! ! !InstallerCruft methodsFor: 'mantis' stamp: 'edc 4/4/2007 07:56'! 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 ! ! !InstallerCruft methodsFor: 'mantis' stamp: 'sd 3/6/2008 19:10'! evaluate: stream stream fileIn.! ! !InstallerCruft methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! info self sm ifTrue: [ ^ self smInfo ]. self wsm ifNotNil: [ ^ self wsmInfo ].! ! !InstallerCruft methodsFor: 'monticello' stamp: 'kph 5/24/2007 18:56'! mczInstall: urlOrFile self log: ('Loading ', urlOrFile, ' ...'). (urlOrFile beginsWith: 'http:') ifTrue: [ MczInstaller installStream: (HTTPSocket httpGet: urlOrFile) ] ifFalse: [ MczInstaller installFileNamed: urlOrFile ]. self logCR: ' Loaded'. ! ! !InstallerCruft methodsFor: 'mantis' stamp: 'kph 12/21/2006 01:28'! skipTests ! ! !InstallerCruft methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:06'! user ^ user ifNil: [ '' ]! ! !InstallerCruft methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:06'! user: anObject user := anObject! ! !InstallerCruft methodsFor: 'utils' stamp: 'kph 5/9/2007 21:49'! viewUrl ^Workspace new contents: (self urlGet contents); openLabel: self urlToDownload. ! ! Installer subclass: #InstallerFile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerFile class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:39'! label ^ 'file'! ! !InstallerFile methodsFor: 'basic interface' stamp: 'kph 7/28/2007 23:48'! basicBrowse self browse: self file from: (FileDirectory readOnlyFileNamed: self file). ! ! !InstallerFile methodsFor: 'basic interface' stamp: 'kph 7/28/2007 23:48'! basicInstall self install: self file from: (FileDirectory default readOnlyFileNamed: self file) ! ! !InstallerFile methodsFor: 'basic interface' stamp: 'kph 7/28/2007 23:48'! basicView self view: self file from: (FileDirectory readOnlyFileNamed: self file). ! ! !InstallerFile methodsFor: 'accessing' stamp: 'mtf 10/23/2008 15:51'! file ^ self package! ! !InstallerFile methodsFor: 'accessing' stamp: 'mtf 10/23/2008 15:51'! file: f self package: f! ! Installer subclass: #InstallerInternetBased instanceVariableNames: 'url pageDataStream markers' classVariableNames: 'Entities' poolDictionaries: '' category: 'Installer-Core'! !InstallerInternetBased class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:20'! 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 ] ! ! !InstallerInternetBased methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classHTTPSocket ^Smalltalk at: #HTTPSocket ifAbsent: [ self error: 'Network package not present' ]! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:07'! extractFromHtml: html option: allOrLast | start stop test in | start := self markersBegin. stop := self markersEnd. test := self markersTest. in := ReadWriteStream with: String new. [ html upToAll: start; atEnd ] whileFalse: [ | chunk | (allOrLast == #last) ifTrue: [ in resetToStart ]. chunk := html upToAll: stop. self isSkipLoadingTestsSet ifTrue: [ chunk := chunk readStream upToAll: test ]. in nextPutAll: chunk. ]. ^self removeHtmlMarkupFrom: in reset ! ! !InstallerInternetBased methodsFor: 'url' stamp: 'kph 10/11/2008 17:02'! hasPage ^ pageDataStream notNil and: [ pageDataStream size > 0 ] ! ! !InstallerInternetBased methodsFor: 'utils' stamp: 'sd 3/6/2008 20:15'! httpGet: aUrl | page | page := self classHTTPSocket httpGet: aUrl accept: 'application/octet-stream'. (page respondsTo: #reset) ifFalse: [ self error: 'unable to contact web site' ]. ^ page ! ! !InstallerInternetBased methodsFor: 'url' stamp: 'sd 3/6/2008 20:18'! isHtmlStream: page "matches '' " | first | first := (page next: 14) asUppercase. ^ (first = '') ! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:08'! markersBegin ^ self markers copyUpTo: $.! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:08'! markersEnd "return the third marker or the second if there are only two" | str a | str := self markers readStream. a := str upToAll: '...'; upToAll: '...'. str atEnd ifTrue: [ ^a ] ifFalse: [ ^str upToEnd ] ! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:08'! markersTest ^ self markers readStream upToAll: '...'; upToAll: '...'! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:07'! markers ^ markers ifNil: [ '..."test ...' ]! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:07'! markers: anObject markers := anObject! ! !InstallerInternetBased methodsFor: 'as yet unclassified' stamp: 'kph 12/9/2008 03:08'! removeHtmlMarkupFrom: in | out | out := ReadWriteStream on: (String new: 100). [ in atEnd ] whileFalse: [ out nextPutAll: (in upTo: $<). (((in upTo: $>) asLowercase beginsWith: 'br') and: [ (in peek = Character cr) ]) ifTrue: [ in next ]. ]. ^self replaceEntitiesIn: out reset. ! ! !InstallerInternetBased methodsFor: 'url' stamp: 'sd 3/6/2008 20:19'! replaceEntitiesIn: in | out | out := ReadWriteStream on: (String new: 100). [ in atEnd ] whileFalse: [ out nextPutAll: ((in upTo: $&) replaceAll: Character lf with: Character cr). in atEnd ifFalse: [ out nextPutAll: (self class entities at: (in upTo: $;) ifAbsent: '?') ]. ]. ^out reset! ! !InstallerInternetBased methodsFor: 'url' stamp: 'sd 3/6/2008 20:19'! urlGet ^ self urlGet: self urlToDownload! ! !InstallerInternetBased methodsFor: 'url' stamp: 'kph 12/9/2008 03:17'! urlGet: aUrl | page | page := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'. (page respondsTo: #reset) ifFalse: [ ^ nil ]. (self isHtmlStream: page) ifTrue: [ page := self extractFromHtml: page option: nil ]. ^ page reset ! ! !InstallerInternetBased methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:06'! url ^url! ! !InstallerInternetBased methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:06'! url: aUrl url := aUrl! ! !InstallerInternetBased methodsFor: 'url' stamp: 'kph 10/11/2008 17:02'! wasPbwikiSpeedWarning ^ self hasPage and: [pageDataStream contents includesSubString: 'Please slow down a bit' ] ! ! InstallerInternetBased subclass: #InstallerUrl instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerUrl class methodsFor: 'action report' stamp: 'mtf 10/8/2008 12:00'! canReportLine: line ^ ((line beginsWith: 'Installer installUrl:') and: [ | ext | ext := (line readStream upToAll: '''.') copyAfterLast: $.. (#( 'cs' 'st' 'mcz' 'sar') includes: ext) not ])! ! !InstallerUrl class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:39'! label ^ 'url'! ! !InstallerUrl methodsFor: 'action report' stamp: 'kph 1/8/2007 11:19'! action: line reportOn: report url := line readStream upTo: $' ; upTo: $'. self reportSection: line on: report. (pageDataStream := self urlGet: self urlToDownload) ifNil: [ self error: 'unable to contact host' ]. self reportFor: line page: pageDataStream on: report ! ! !InstallerUrl methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:19'! basicBrowse "(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') browse.". self browse: self urlToDownload from: self urlThing. ! ! !InstallerUrl methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:19'! basicInstall self install: self urlToDownload from: self urlThing. ^ pageDataStream ! ! !InstallerUrl methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:19'! basicView "(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') view.". self view: self urlToDownload from: self urlThing. ! ! !InstallerUrl methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:44'! label ^ 'url:''', url, ''''! ! !InstallerUrl methodsFor: 'url' stamp: 'kph 2/11/2009 20:04'! latest "for protocol compatability"! ! !InstallerUrl methodsFor: 'url' stamp: 'mtf 10/15/2008 08:40'! urlThing | retry delay | self logCR: 'retrieving ', self urlToDownload , ' ...'. delay := 0. [ retry := false. pageDataStream := self urlGet: self urlToDownload ] doWhileTrue: [ self wasPbwikiSpeedWarning ifTrue: [retry := true. delay := delay + 5. self logCR: 'PBWiki speed warning. Retrying in ', delay printString, ' seconds'. (Delay forSeconds: delay) wait ]. retry ]. pageDataStream ifNil: [ self error: 'unable to contact host' ]. ^ pageDataStream ! ! !InstallerUrl methodsFor: 'url' stamp: 'kph 1/4/2007 23:49'! urlToDownload ^ (self url, (self package ifNil: [ '' ])) asUrl asString. ! ! InstallerInternetBased subclass: #InstallerWebBased instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! InstallerWebBased subclass: #InstallerMantis instanceVariableNames: 'ma bug desc date array data status' classVariableNames: 'Fixes Status' poolDictionaries: '' category: 'Installer-Core'! !InstallerMantis commentStamp: 'test 1/14/2009 00:11' prior: 0! Search feature is based upon a custom mantis query ceveloped and maintained by Ken Causey Installer mantis bugsAll select: [ :ea | ea status = 'testing' ].! !InstallerMantis class methodsFor: 'action report' stamp: 'mtf 10/8/2008 12:00'! canReportLine: line ^ line beginsWith: 'Installer mantis fixBug:'! ! !InstallerMantis class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:21'! fixesApplied ^ Fixes ifNil: [ Fixes := OrderedCollection new ].! ! !InstallerMantis class methodsFor: 'instance creation' stamp: 'stephane.ducasse 9/30/2008 18:24'! host: host ^self new ma: host; markers: '"fix begin"..."fix test"..."fix end"'; yourself. ! ! !InstallerMantis class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:40'! label ^ 'mantis'! ! !InstallerMantis methodsFor: 'action report' stamp: 'sd 3/6/2008 18:44'! action: line reportOn: report | param mantis | mantis := Installer mantis. param := line readStream upTo: $: ; upTo: $.. mantis setBug: ((param readStream upTo: $'; atEnd) ifTrue: [ param ] ifFalse: [ param readStream upTo: $'; upTo: $' ]). self reportSection: line on: report. report nextPutAll: (mantis replaceEntitiesIn: mantis markersBegin readStream). self reportFor: line page: mantis maScript on: report. report nextPutAll: (mantis replaceEntitiesIn: mantis markersEnd readStream); cr. ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/13/2009 23:40'! array ^ array! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:25'! browseFile: aFileName ^ self browse: aFileName from: (self maThing: aFileName date: nil)! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:37'! bugFilesView: aBugNo "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " self setBug: aBugNo; viewFiles! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:35'! bugFiles: aBugNo "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " self setBug: aBugNo; files! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:37'! bugScript: aBugNo ^ (self setBug: aBugNo) script ! ! !InstallerMantis methodsFor: 'action report' stamp: 'test 1/13/2009 23:39'! bugsAll ^ array ifNil: [ array := ( self bugsSqueak , (self dataGetFrom: '/installer_export.php') ) asSet asSortedCollection: [ :a :b | a date > b date ] ]. " Installer mantis bugsAll " ! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/13/2009 23:00'! bugsClosed ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]! ! !InstallerMantis methodsFor: 'search' stamp: 'kph 2/15/2009 15:08'! bugsRelease: version ^self bugsAll select: [ :ea | (ea status = 'resolved') and: [ ea fixedIn = version ]]! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/13/2009 22:59'! bugsSqueak ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?project=Squeak' ] " Installer mantis bugsSqueak. Installer mantis bugsAll. Installer mantis bugsClosed. "! ! !InstallerMantis methodsFor: 'search' stamp: 'kph 2/15/2009 15:14'! bugsTesting: version ^self bugsAll select: [ :ea | ea status = 'testing' and: [ ea fixedIn = version ]]! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/13/2009 23:45'! bug ^ bug ifNil: [ date := ((self dataAtName: 'Updated') replaceAll: $ with: $T) asDateAndTime. desc := (self dataAtName: 'Summary'). bug := (self dataAtName: 'Id'). self statusInit. ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:26'! bug: aBugNo browse: aFileName self setBug: aBugNo. ^ self browseFile: aFileName! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/9/2008 22:46'! bug: aBugNo fix: aFileName date: aDate | | self setBug: aBugNo. self ditchOldChangeSetFor: aFileName. self install: aFileName from: (self maThing: aFileName date: aDate). ^ date! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/18/2006 04:11'! bug: aBugNo fix: aFileName ^ self bug: aBugNo fix: aFileName date: nil! ! !InstallerMantis methodsFor: 'public interface' stamp: 'sd 3/6/2008 19:09'! bug: aBugNo retrieve: aFileName self setBug: aBugNo. ^ (self maStreamForFile: aFileName) contents! ! !InstallerMantis methodsFor: 'public interface' stamp: 'sd 3/6/2008 19:09'! bug: aBugNo view: aFileName "Installer mantis bug: 6089 browse: 'TTFSpeedUp-dgd.1.cs'" self setBug: aBugNo. ^ self view: aFileName from: (self maThing: aFileName date: nil)! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/17/2008 10:53'! bug: aBugNo self setBug: aBugNo. ^ self report! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/11/2009 23:15'! category ^ self dataAtName: 'Category' " s bugs collect: [ :ea | ea category ] "! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/13/2009 22:51'! dataAtName: key put: v ^ array at: (self dataNames indexOf: key) put: v! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/11/2009 23:28'! dataAtName: key ^ array at: (self dataNames indexOf: key)! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/12/2009 00:15'! dataClosed ^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 2/22/2009 13:42'! dataGetFrom: aPath | rs line first col row out | rs := HTTPSocket httpGet: ma, aPath. rs isString ifTrue: [ ^ ProtocolClientError signal: 'notFound' ]. first := true. out := OrderedCollection new. [ rs atEnd ] whileFalse: [ line := rs nextLine readStream. col := 1. row := Array new: 9. [ (line atEnd or: [ col > 9 ]) ] whileFalse: [ row at: col put: (line upTo: $|). col := col + 1 ]. rs next. [ out add: (self class new in: self row: row) ] ifError: [] ]. ^ out " self reset. self getBugsList "! ! !InstallerMantis methodsFor: 'public interface' stamp: 'test 1/11/2009 23:29'! dataNames ^ #(Id Project Category Assigned Updated Status Severity FixedIn Summary)! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 12/17/2008 11:58'! date ^ date ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 12/11/2008 14:41'! date: anObject date := anObject ifNotNilDo: [ :d | d asDate ]! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 1/8/2007 07:22'! desc ^ desc! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 1/8/2007 07:22'! desc: anObject desc := anObject! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:45'! ensureFixes: aBugNos aBugNos do: [ :bugNo | self ensureFix: bugNo ].! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:47'! ensureFix | fixesAppliedNumbers | fixesAppliedNumbers := self fixesApplied collect: [ :fixDesc | fixDesc asInteger ]. (fixesAppliedNumbers includes: bug) ifFalse: [ self fixBug ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:47'! ensureFix: aBugNo date: aDate self setBug: aBugNo. self date: aDate.. self ensureFix.! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:48'! ensureFix: aBugNo ^self ensureFix: aBugNo date: nil! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:34'! files "provide a list of files associated with the bug in id order" " Installer mantis bugFiles: 6660. " ^ (self maFiles associations asSortedCollection: [ :a :b | a value asInteger < b value asInteger ]) collect: [ :a | a key ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/14/2008 18:06'! fixBug self install: self maUrl from: self maScript. self maCheckDateAgainst: date. self fixesAppliedNumbers in: [ :fixed | (fixed isEmpty or: [ (fixed includes: bug asInteger) not]) ifTrue: [ self fixesApplied add: (bug asString, desc) ]]. ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:44'! fixBug: aBugNo date: aDate self setBug: aBugNo. self date: aDate. self fixBug. ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 13:48'! fixBug: aBugNo ^ self fixBug: aBugNo date: nil. ! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/14/2009 01:12'! fixedIn ^ self dataAtName: 'FixedIn' ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/9/2008 22:48'! fixesAppliedNumbers ^ self fixesApplied collect: [ :fixDesc | fixDesc asInteger ]. ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 10/16/2008 00:04'! fixesApplied ^ Fixes ifNil: [ Fixes := OrderedCollection new ].! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 12/10/2008 14:21'! getView "Installer mantis viewBug: 5639." | page text | page := self maPage. text := String streamContents: [ :str | #('Bug ID' 'Category' 'Severity' 'Reproducibility' 'Date Submitted' 'Date Updated' 'Reporter' 'View Status' 'Handler' 'Priority' 'Resolution' 'Status' 'Product Version' 'Summary' 'Description' 'Additional Information' ) do: [ :field | | f | f := self maRead: page field: field. str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr. ]. str nextPutAll: 'Notes: '; cr. (self maReadNotes: page) do: [ :note | str nextPutAll: note; cr; cr ]. str nextPutAll: 'Files: '; nextPutAll: self maFiles keys asArray printString. ]. ^ text ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/13/2009 23:41'! hash ^ array hash! ! !InstallerMantis methodsFor: 'public interface' stamp: 'test 1/11/2009 23:56'! in: parent row: dataRow self ma: parent ma. self markers: parent markers. self setArray: dataRow.! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 1/4/2007 06:43'! justFixBug: aBugNo date: d ^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: d ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 1/4/2007 06:43'! justFixBug: aBugNo ^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: nil ]! ! !InstallerMantis methodsFor: 'utils' stamp: 'sd 3/6/2008 20:16'! maCheckDateAgainst: okDate (okDate notNil and: [date < okDate asDate ]) ifTrue: [ self notify: 'bug ', self bug asString, ' updated on ', date printString ]. ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'stephane.ducasse 9/30/2008 18:37'! 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. ^files ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'stephane.ducasse 9/30/2008 18:37'! maPage " self mantis bug: 5251." | 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! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 12/17/2008 13:51'! maReadNotes: page | notes note | notes := OrderedCollection new. [ page upToAll: 'tr class="bugnote"'; upTo: $>. page atEnd ] whileFalse: [ note := (self removeHtmlMarkupFrom: (page upToAll: '') readStream) contents. note := note withBlanksCondensed. note replaceAll: Character lf with: Character cr. notes add: note ]. ^notes! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 12/17/2008 13:55'! maRead: page field: fieldKey | value | value := page upToAll: ('!!-- ', fieldKey, ' -->'); upToAll: '; upToAll: ''. page upTo: $<. page peek = $t ifTrue: [ value := page upToAll: 'td'; upTo: $>; upToAll: '' ]. ^Association key: fieldKey value: (self removeHtmlMarkupFrom: value withBlanksTrimmed readStream) contents! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 1/8/2007 10:01'! maScript ^self extractFromHtml: self maPage option: #last ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 1/8/2007 09:48'! maStreamForFile: aFileName | fileId | fileId := self maFiles at: aFileName ifAbsent: [ self error: aFileName, ' not found' ]. ^ self httpGet: (self ma, 'file_download.php?file_id=' , fileId , '&type=bug'). ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 5/9/2007 22:31'! maThing: aFileName date: aDate self logCR: 'obtaining ', aFileName, '...'. pageDataStream := self maStreamForFile: aFileName. self maCheckDateAgainst: aDate. ^ pageDataStream ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 12/18/2006 04:08'! maUrlFor: maBugNo ^ url := self ma, 'view.php?id=', maBugNo asString ! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 1/8/2007 09:54'! maUrl ^ url := self ma, 'view.php?id=', bug asString ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! ma ^ ma! ! !InstallerMantis methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! ma: aUrl ma := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! ! !InstallerMantis methodsFor: 'accessing' stamp: 'kph 12/9/2008 23:42'! printOn: stream super printOn: stream. (array ifNil: [ ^ self ]) printOn: stream.! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/14/2009 01:06'! project ^ self dataAtName: 'Project' ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/17/2008 14:03'! report "Installer mantis viewBug: 5639." | page text | page := self maPage. text := String streamContents: [ :str | #('Bug ID' 'Category' 'Severity' 'Reproducibility' 'Date Submitted' 'Date Updated' 'Reporter' 'View Status' 'Handler' 'Priority' 'Resolution' 'Status' 'Product Version' 'Summary' 'Description' 'Additional Information' ) do: [ :field | | f | f := self maRead: page field: field. str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr. ]. str nextPutAll: 'Notes: '; cr. (self maReadNotes: page) do: [ :note | str nextPutAll: note; cr; cr ]. str nextPutAll: 'Files: '; nextPutAll: self maFiles keys asArray printString. ]. ^ text ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:27'! script ^ self maScript contents. ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/11/2008 15:30'! selectCategoryCollections ^ self select: [ :ea | ea category = 'Collections' ]! ! !InstallerMantis methodsFor: 'public interface' stamp: 'test 1/11/2009 23:57'! setArray: dataRow (array := dataRow) ifNotNil: [ self bug ].! ! !InstallerMantis methodsFor: 'mantis' stamp: 'kph 12/9/2008 20:25'! setBug: stringOrNumber | newBug | (newBug := stringOrNumber asInteger) = bug ifTrue: [ ^ self ]. self logCR: 'Installer accessing bug: ' , stringOrNumber asString. bug := newBug. stringOrNumber = bug ifTrue: [ desc := ''. ^ self ]. desc := stringOrNumber withoutLeadingDigits ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/13/2009 23:45'! statusInit status ifNil: [ status := Status at: (self dataAtName: 'Status'). self dataAtName:'Status' put: status. ]. ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/11/2009 23:48'! status ^ status! ! !InstallerMantis methodsFor: 'search' stamp: 'test 1/11/2009 23:15'! summary ^ self dataAtName: 'Summary'! ! !InstallerMantis methodsFor: 'action report' stamp: 'kph 2/13/2009 05:50'! validChangeSetName: aFileName | csn prefix | csn := super validChangeSetName: aFileName. prefix := 'M' , self bug asString. ^ (csn beginsWith: prefix) ifTrue: [ csn ] ifFalse: [ prefix, '-', (csn replaceAll: prefix with: '') ]. ! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:22'! viewBug: aBugNo self setBug: aBugNo; view! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:36'! viewFiles ^ self files do: [ :ea | self viewFile: ea ].! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:23'! viewFile: aFileName "Installer mantis bug: 6089 browse: 'TTFSpeedUp-dgd.1.cs'" ^ self view: aFileName from: (self maThing: aFileName date: nil)! ! !InstallerMantis methodsFor: 'public interface' stamp: 'kph 12/10/2008 14:32'! view ^ Workspace new contents: self report; openLabel: ('Mantis ', bug printString). ! ! !InstallerMantis methodsFor: 'accessing' stamp: 'test 1/13/2009 23:42'! = other ^ array = other array! ! !InstallerMantis class methodsFor: 'instance creation' stamp: 'test 1/12/2009 00:00'! initialize Status := Dictionary new at: '10' put: 'new'; at: '20' put: 'feedback'; at: '30' put: 'acknowledged'; at: '40' put: 'confirmed'; at: '50' put: 'assigned'; at: '60' put: 'pending'; at: '70' put: 'testing'; at: '80' put: 'resolved'; at: '90' put: 'closed'; yourself ! ! InstallerWebBased subclass: #InstallerWeb instanceVariableNames: '' classVariableNames: 'WebSearchPath' poolDictionaries: '' category: 'Installer-Core'! !InstallerWeb class methodsFor: 'action report' stamp: 'mtf 10/8/2008 12:00'! canReportLine: line ^ ((line beginsWith: 'Installer install:') | (line beginsWith: 'Installer do:'))! ! !InstallerWeb class methodsFor: 'compatability' stamp: 'stephane.ducasse 9/30/2008 18:22'! install: webPageName "This keeps the syntax Installer web install: working" ^ self new install: webPageName! ! !InstallerWeb class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:40'! label ^ 'web'! ! !InstallerWeb class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:22'! searchPath "a search path item, has the following format. prefix*suffix" ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].! ! !InstallerWeb methodsFor: 'action report' stamp: 'kph 10/11/2008 16:48'! action: line reportOn: report self package: (line readStream upTo: $' ; upTo: $'). self reportSection: line on: report. url := self urlToDownload. self reportFor: line page: pageDataStream on: report ! ! !InstallerWeb methodsFor: 'basic interface' stamp: 'kph 10/11/2008 16:49'! basicBrowse self thing size > 0 ifTrue: [ self browse: url from: pageDataStream ] ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ]. ! ! !InstallerWeb methodsFor: 'basic interface' stamp: 'kph 10/11/2008 16:49'! basicInstall self thing size > 0 ifTrue: [ self install: url from: pageDataStream ] ifFalse: [ url ifNil: [ ^ self logCR: self package, ' not found on webSearchPath' ]. self logCR: '...',url,' was empty' ]. ! ! !InstallerWeb methodsFor: 'basic interface' stamp: 'kph 10/11/2008 16:49'! basicView self thing size > 0 ifTrue: [ self view: url from: pageDataStream ] ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ]. ! ! !InstallerWeb methodsFor: 'web install' stamp: 'mtf 10/15/2008 09:04'! thing self logCR: 'searching for web package ''', self package, ''''. url := self urlToDownload. url ifNil: [ self logCR: 'page ', self package, ' not found on path' ] ifNotNil: [ self logCR: 'found ', url, ' ...'. ]. ^ pageDataStream! ! !InstallerWeb methodsFor: 'web install' stamp: 'mtf 10/15/2008 08:39'! urlToDownload "while we look for a url which returns what we are looking for, we get the data anyway" | delay retry | delay := 0. self class webSearchPath do: [ :pathSpec | | potentialUrl readPathSpec | readPathSpec := pathSpec value readStream. potentialUrl := (readPathSpec upTo: $*), self package, (readPathSpec upToEnd ifNil: [ '' ]). [ retry := false. pageDataStream := self urlGet: potentialUrl ] doWhileTrue: [ self wasPbwikiSpeedWarning ifTrue: [ retry := true. delay := delay + 5. self logCR: 'PBWiki speed warning. Retrying in ', delay printString, ' seconds'. (Delay forSeconds: delay) wait] ifFalse: [ self hasPage ifTrue: [ pageDataStream reset. ^ potentialUrl ] ]. retry ]]. ^nil ! ! !InstallerWeb class methodsFor: 'instanciation' stamp: 'kph 2/23/2009 04:10'! initialize WebSearchPath := nil! ! InstallerWebBased subclass: #InstallerWebSqueakMap instanceVariableNames: 'wsm' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerWebSqueakMap class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:40'! label ^ 'websqueammap'! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'squeak 3/31/2008 22:21'! basicAvailablePackages | html id name pkgs | pkgs := Dictionary new. html := self httpGet: (self wsm, 'packagesbyname'). [ id := html upToAll: '/package/'; upToAll: '">'. name := html upTo: $<. (id notEmpty and: [ name notEmpty ])] whileTrue: [ pkgs at: name put: id ]. ^ pkgs ! ! !InstallerWebSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:41'! basicInstall | it | it := self wsmThing. self install: it from: it asUrl retrieveContents contentStream. ! ! !InstallerWebSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:42'! basicVersions | pkgAndVersion packageId packageName packageVersion versions | pkgAndVersion := self packageAndVersionFrom: self package . packageName := pkgAndVersion first. packageVersion := pkgAndVersion last. packageVersion isEmpty ifTrue: [ packageVersion := #latest ]. packageId := self availablePackages at: packageName. versions := (self wsmReleasesFor: packageId) keys. versions remove: #latest. ^ versions collect: [ :version | self copy package: (packageName,'(', version ,')'); yourself ]. ! ! !InstallerWebSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:42'! basicView | it | it := self wsmThing. self view: it from: (self httpGet: it). ! ! !InstallerWebSqueakMap methodsFor: 'searching' stamp: 'mtf 10/8/2008 12:00'! packagesMatching: aMatch ^ (self availablePackages select: [ :p | ( aMatch) match: p ]) collect: [ :p | self copy package: p ; yourself ]! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'sd 3/6/2008 20:41'! wsmDownloadUrl | pkgAndVersion packageId packageName packageVersion releaseAutoVersion downloadPage | pkgAndVersion := self packageAndVersionFrom: self package. packageName := pkgAndVersion first. packageVersion := pkgAndVersion last. packageVersion isEmpty ifTrue: [ packageVersion := #latest ]. packageId := self availablePackages at: packageName. releaseAutoVersion := (self wsmReleasesFor: packageId) at: packageVersion. downloadPage := self httpGet: (self wsm,'packagebyname/', packageName,'/autoversion/', releaseAutoVersion,'/downloadurl') asUrl asString. ^ downloadPage contents ! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'sd 3/6/2008 20:42'! wsmReleasesFor: packageId | html autoVersion version releases | releases := Dictionary new. html := self httpGet: (self wsm, '/package/', packageId ). [releases at: #latest put: autoVersion. autoVersion := html upToAll: '/autoversion/'; upTo: $". version := html upTo: $-; upTo: $<. (autoVersion notEmpty and: [version notEmpty ])] whileTrue: [ releases at: version put: autoVersion ]. ^ releases ! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'sd 3/6/2008 20:42'! wsmThing | downloadUrl | self logCR: 'finding ', self package, ' from websqueakmap(', self wsm, ') ...'. downloadUrl := self wsmDownloadUrl. self logCR: 'found at ', downloadUrl asString, ' ...'. ^ downloadUrl ! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'sd 3/6/2008 20:40'! wsm ^ wsm! ! !InstallerWebSqueakMap methodsFor: 'websqueakmap' stamp: 'sd 3/6/2008 20:41'! wsm: aUrl wsm := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! ! Installer subclass: #InstallerMonticello instanceVariableNames: 'mc root project' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerMonticello class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:41'! label ^ 'monticello'! ! !InstallerMonticello methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicAvailablePackages ^ self mc allFileNames! ! !InstallerMonticello methodsFor: 'basic interface' stamp: 'kph 12/5/2008 02:46'! basicBrowse "Installer ss project: 'Installer'; browse: 'Installer-Core'." | it | it := self mcThing. (it class includesSelector: #browse) ifTrue: [ ^ it browse ]. (it instVarNamed: 'versions') do: #browse.! ! !InstallerMonticello methodsFor: 'basic interface' stamp: 'kph 10/23/2008 23:09'! basicInstall self withAnswersDo: [ self mcThing load ]. self logCR: 'loaded'. ! ! !InstallerMonticello methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:18'! basicVersions ^ (self availablePackages select: [ :p | ( self package,'-*.mcz' ) match: p ]) collect: [ :p | self copy package: p ; yourself ]. ! ! !InstallerMonticello methodsFor: 'basic interface' stamp: 'kph 12/5/2008 02:56'! basicView "Installer ss project: 'Installer'; view: 'Installer-Core'. " | it | packages isEmptyOrNil ifTrue: [ self mc morphicOpen: nil ]. it := self mcThing. (it respondsTo: #open) ifTrue: [ ^ it open ]. "in case an old mc doesnt have #open" (it instVarNamed: 'versions') do: #open. ! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'mtf 5/20/2008 17:38'! cache mc := self classMCCacheRepository default. root := mc directory localName ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'mtf 5/20/2008 16:43'! classMCCacheRepository ^Smalltalk at: #MCCacheRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 01:01'! classMCDirectoryRepository ^Smalltalk at: #MCDirectoryRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 00:56'! classMCFtpRepository ^Smalltalk at: #MCFtpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 00:59'! classMCGOODSRepository ^Smalltalk at: #MCGOODSRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 00:56'! classMCHttpRepository ^Smalltalk at: #MCHttpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 00:59'! classMCMagmaRepository ^Smalltalk at: #MCMagmaRepository ifAbsent: [ self error: 'Magma not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'mtf 10/25/2008 14:04'! classMCRepositoryGroup ^Smalltalk at: #MCRepositoryGroup ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'kph 5/10/2007 00:56'! classMCSmtpRepository ^Smalltalk at: #MCSmtpRepository ifAbsent: [ self error: 'Monticello not present' ] ! ! !InstallerMonticello methodsFor: 'class references' stamp: 'stephane.ducasse 9/30/2008 18:34'! classMCVersionLoader ^Smalltalk at: #MCVersionLoader ifAbsent: [ self error: 'Monticello not present' ]! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 12/19/2007 00:30'! directory: dir | directory | directory := dir isString ifTrue: [ FileDirectory on: (FileDirectory default fullNameFor: dir) ] ifFalse: [ dir ]. mc := self classMCDirectoryRepository new directory: directory; yourself. root := dir ! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'kph 12/2/2008 07:43'! fromUrl: aUrl | url path | url := aUrl asUrl. self http: url authority. path := url path. path size = 2 ifTrue: [ self project: path first. path removeFirst. ]. path size = 1 ifTrue: [ self package: path first ].! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 12/18/2008 02:06'! ftp: host directory: dir user: name password: secret "Installer mc ftp: 'mc.gjallar.se' directory: '' user: 'gjallar' password: secret." mc := self classMCFtpRepository host: host directory: dir user: name password: secret. root := dir. ! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 5/10/2007 00:58'! goods: host port: aport mc := (self classMCGOODSRepository new) host: host port: aport; yourself ! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 5/10/2007 03:45'! http: aUrl user: name password: secret mc := self classMCHttpRepository location: aUrl user: name password: secret. root := mc locationWithTrailingSlash ! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 12/15/2007 11:37'! http: aUrl self http: aUrl user: 'squeak' password: 'squeak' ! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:42'! label ^ 'repository:''', mc description, ''''! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'kph 12/2/2008 07:40'! latestFromUsers: list | newPackage | newPackage := self package copyUpToLast: $-. self packages removeLast. self package: (list collect: [ :ea | newPackage, '-', ea ])! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'kph 12/2/2008 07:42'! latest | newPackage | newPackage := self package copyUpToLast: $-. self packages removeLast. self package: newPackage " Installer mc fromUrl: 'http://www.squeaksource.com/Installer/Installer-Core-kph.100.mcz'. "! ! !InstallerMonticello methodsFor: 'instance creation' stamp: 'kph 5/10/2007 00:58'! magma: host port: aport mc := (self classMCMagmaRepository new) host: host port: aport; yourself ! ! !InstallerMonticello methodsFor: 'monticello' stamp: 'kph 5/24/2007 19:49'! mcDetectFileBlock self package isString ifTrue: [ ^ [ :aFile | aFile beginsWith: self package ] ]. (self package isKindOf: Array) ifTrue: [ ^ [ :aFile | (self package detect: [ :item | aFile beginsWith: item ] ifNone: [ false ]) ~= false ] ]. self package isBlock ifTrue: [ ^ self package ]. ! ! !InstallerMonticello methodsFor: 'monticello' stamp: 'stephane.ducasse 9/30/2008 18:39'! mcSortFileBlock ^ [:a :b | [(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].! ! !InstallerMonticello methodsFor: 'monticello' stamp: 'kph 12/8/2008 03:36'! mcThing | loader files fileToLoad version count | loader := self classMCVersionLoader new. 1 to: self packages size do: [ :n | self logCR: 'finding ', self package asString, '...'. "several attempts to read files - repository readableFileNames sometimes fails" count := 0. fileToLoad := nil. [count := count + 1. (fileToLoad = nil) and:[ count < 5 ] ] whileTrue: [ files := mc readableFileNames asSortedCollection: self mcSortFileBlock. fileToLoad := files detect: self mcDetectFileBlock ifNone: [ nil ]. ]. fileToLoad ifNil: [ Warning signal: 'Package: ', self package ,' not found in repository: ', mc description. ^ nil ]. version := mc versionFromFileNamed: fileToLoad. (version isKindOf: MCConfiguration) ifTrue: [ ^ version ] ifFalse:[ MCRepositoryGroup default addRepository: self normalizedRepository. version workingCopy repositoryGroup addRepository: self normalizedRepository. loader addVersion: version]. self log: ' found ', version fileName, '...'. packages removeFirst. ]. ^ loader! ! !InstallerMonticello methodsFor: 'monticello' stamp: 'test 1/15/2009 15:10'! mcUrl ^ self mc description ! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! mc ^ mc! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'kph 12/8/2008 03:24'! mc: aRepo mc := aRepo! ! !InstallerMonticello methodsFor: 'monticello' stamp: 'mtf 10/25/2008 14:04'! normalizedRepository "Find an existing instance of the active repository so that we use whatever name and password the user usually uses. If not found, answer a copy" self classMCRepositoryGroup default repositoriesDo: [:ea | mc = ea ifTrue: [^ ea]]. ^ mc copy! ! !InstallerMonticello methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! open self mc morphicOpen: nil! ! !InstallerMonticello methodsFor: 'searching' stamp: 'mtf 10/8/2008 12:00'! packagesMatching: aMatch ^ (self availablePackages select: [:p | ( aMatch , '.mcz' ) match: p]) collect: [:p | self copy package: p ; yourself]! ! !InstallerMonticello methodsFor: 'Installer-Core' stamp: 'kph 2/21/2009 18:41'! printConfigurationOn: stream self project ifNil: [ ^ self ]. stream nextPutAll: ' project:'''; nextPutAll: self project; nextPut: $'! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:04'! project ^ project! ! !InstallerMonticello methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:04'! project: name project := name. packages := nil. (mc respondsTo: #location:) ifTrue:[ mc := mc copy location: root , name ]. (mc respondsTo: #directory:) ifTrue: [ mc := mc copy directory: root ,'/', name ]. ^self copy.! ! !InstallerMonticello methodsFor: 'public interface' stamp: 'kph 10/23/2008 20:57'! unloadCleanUp SystemOrganization removeEmptyCategories. "Until Mantis 5718 is addressed" Smalltalk at: #PackagePaneBrowser ifPresent: [ :ppbClass | ppbClass allInstancesDo: [ :ppb | ppb updatePackages ] ]. Smalltalk at: #Browser ifPresent: [ :bClass | bClass allInstancesDo: [ :b | b updateSystemCategories ] ]. MCFileBasedRepository freeSomeSpace. SmalltalkImage current fixObsoleteReferences.! ! !InstallerMonticello methodsFor: 'public interface' stamp: 'kph 12/8/2008 01:02'! unload (MCWorkingCopy allManagers select: [ :wc | self package match: (wc package name) ]) do: [ :wc | self logCR: 'Unloading ', wc package asString. wc unload.]. self unloadCleanUp! ! !InstallerMonticello methodsFor: 'public interface' stamp: 'kph 12/8/2008 01:02'! unload: match self addPackage: match. self unload.! ! Installer subclass: #InstallerSake instanceVariableNames: 'sake' classVariableNames: 'Sake' poolDictionaries: '' category: 'Installer-Core'! !InstallerSake class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classPackages ^Smalltalk at: #Packages ifAbsent: [ self error: 'Sake Packages code not present' ]! ! !InstallerSake class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:42'! label ^ 'sake'! ! !InstallerSake class methodsFor: 'accessing' stamp: 'kph 6/30/2008 16:49'! sake ^ Sake ifNil: [ self classPackages current ]! ! !InstallerSake class methodsFor: 'accessing' stamp: 'mtf 10/8/2008 12:00'! sake: aClass Sake := aClass! ! !InstallerSake methodsFor: 'basic interface' stamp: 'kph 4/23/2008 22:44'! basicInstall self withAnswersDo: [ (self packages collect: [ :packageName | sake named: packageName ]) asTask run ]. ! ! !InstallerSake methodsFor: 'websqueakmap' stamp: 'kph 1/28/2008 11:27'! sake ^ sake ! ! !InstallerSake methodsFor: 'websqueakmap' stamp: 'kph 1/28/2008 10:41'! sake: aSakePackagesClass sake := aSakePackagesClass! ! Installer subclass: #InstallerScripts instanceVariableNames: 'script isStepping' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerScripts commentStamp: 'kph 2/23/2009 02:27' prior: 0! (self new addPackage: 'Example') options collect: [ :ea | ea value asLegalSelector asSymbol ] #(#scriptExampleSqueak310forKPH #scriptExampleSqueak310 #scriptExampleSqueak310)! !InstallerScripts class methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:21'! basicInstall | selector | self options do: [ :ea | selector := ea value asLegalSelector asSymbol. (self respondsTo: selector) ifTrue: [ ^ self perform: selector ] ]. ^ nil! ! !InstallerScripts class methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:26'! options ^ { ['script', self package, Smalltalk version, 'for' , Utilities authorInitialsPerSe asUppercase]. ['script', self package, Smalltalk version]. ['script', self package, SystemVersion current majorMinorVersion]. }! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:19'! basicInstall | selector | self options do: [ :ea | selector := ea value asLegalSelector asSymbol. (self respondsTo: selector) ifTrue: [ self perform: selector. ^ true ] ]. ^ nil! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:50'! options ^ { ['script', self package, Smalltalk version, 'for' , Utilities authorInitialsPerSe asUppercase]. ['script', self package, Smalltalk version]. ['script', self package, SystemVersion current majorMinorVersion]. ['script', self package, self product ]. ['script', self package ]. }! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:53'! product | vers | vers := Smalltalk version. 1 to: vers size do: [ :n | (vers at: n) isDigit ifTrue: [ ^ Smalltalk version first: n-1 ] ] " self new product "! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:56'! scriptLevelPlayingFieldCroquet Installer mantis fixBug: '7087 Enable MC File in for Croquet'. Installer mantis fixBug: '7088 Parser cannot parse the selector of a method with an underscore assignment'. Installer install:'LevelPlayingField-Monticello15'. Installer ss project: 'mc'; install: 'TweakMC'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:54'! scriptLevelPlayingFieldetoys ^ self scriptLevelPlayingFieldSqueak38! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:01'! scriptLevelPlayingFieldLauncherLaunch Installer mantis fixBug: '6086 Improved Line End Convention Specification'. Installer squeaksource project:'Installer'; install: 'Installer-Launcher'. Installer mantis fixBug: '5851 Refactor SmalltalkImage saveAs'. Transcript cr; cr; show:'You now have a level playing field.'. Transcript cr; cr; show:'Launcher now processing additional commandline parameters...'. (Smalltalk at: #Launcher) new actionSelector: #launchFrom: ; image: SmalltalkImage current; commandLineClass: Launcher; beFirstTime; begin; yourself.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:45'! scriptLevelPlayingFieldMonticello15Pharo Installer installSilentlyUrl: 'http://installer.pbwiki.com/f/PackageInfo-Base-kph.67.st'. Installer installSilentlyUrl: 'http://installer.pbwiki.com/f/Monticello.impl-kph.635.st'. Installer ss project:'mc'; installQuietly: 'Monticello.impl-kph.635'; installQuietly: 'PackageInfo-Base'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'mtf 2/22/2009 23:40'! scriptLevelPlayingFieldMonticello15 Installer installSilentlyUrl: 'http://installer.pbwiki.com/f/PackageInfo-Base-mtf.70.st'. Installer installSilentlyUrl: 'http://installer.pbwiki.com/f/Monticello.impl-kph.635.st'. ((SequenceableCollection organization categoryOfElement: #do:displayingProgress:) beginsWith: '*') ifTrue: [SequenceableCollection organization classify: #do:displayingProgress: under: #enumerating]. Installer ss project:'mc'; installQuietly: 'Monticello.impl-kph.636'; installQuietly: 'PackageInfo-Base'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:56'! scriptLevelPlayingFieldPharo Installer install:'LevelPlayingField-Monticello15'. ! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:00'! scriptLevelPlayingFieldPostscript Installer upgrade. Smalltalk organization removeSystemCategory: 'Monticello-Tests'. (MCPackage named: 'Monticello') workingCopy unregister. (MCPackage named: 'PackageInfo') workingCopy unregister. (MCPackage named: 'MonticelloConfigurations') workingCopy unregister. SystemOrganization removeEmptyCategories. MCMethodDefinition freeSomeSpace. MCFileBasedRepository freeSomeSpace. DataStream initialize. Transcript show: 'Postscript: Squeakmap Update '. [ Installer sm update ] ifError: [ Transcript show: '(Squeakmap not installed)'.]. Installer install:'LevelPlayingField-LauncherLaunch'. ! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:58'! scriptLevelPlayingFieldPreamblePharo Transcript show: 'All fixes are already in Pharo 10236'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:58'! scriptLevelPlayingFieldPreamble Transcript show: 'Preamble found:'. Installer mantis ensureFix: 7131. Installer mantis ensureFix: 7205. Installer mantis ensureFix: 7218. Installer mantis ensureFix: 7166. Installer mantis ensureFix: 7291. Installer mantis ensureFix: 6426. ! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:54'! scriptLevelPlayingFieldSophie ^ self scriptLevelPlayingFieldSqueak38! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:38'! scriptLevelPlayingFieldSqueak3101 Installer install:'LevelPlayingField-Monticello15'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:43'! scriptLevelPlayingFieldSqueak3102 ^ self scriptLevelPlayingFieldSqueak3101! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:37'! scriptLevelPlayingFieldSqueak310 "lets not be beta any more" SystemVersion current version: 'Squeak3.10'. "fix the millisecond clock" Installer mantis ensureFix: 474. Installer mantis ensureFix: 6805. Installer install:'LevelPlayingField-Monticello15'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:32'! scriptLevelPlayingFieldSqueak37 Installer debug mantis fixBug: '6476 Enable MC File in if before 3.9'. "add ifNil:ifNotNil" Installer installUrl: 'http://installer.pbwiki.com/f/For37.cs'. Installer install:'LevelPlayingField-Monticello15'. Installer squeaksource project: 'Glorp37Compat'; install: 'Glorp3.7Compatibility'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:33'! scriptLevelPlayingFieldSqueak38 Installer debug mantis fixBug: '6476 Enable MC File in if before 3.9'. Installer install:'LevelPlayingField-Monticello15'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:36'! scriptLevelPlayingFieldSqueak39 Installer install:'LevelPlayingField-Monticello15'. ! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:41'! scriptLevelPlayingField Transcript cr; show: 'Your image version is not explicitly supported by LPF yet. Contact maintainers for details'. Installer install:'LevelPlayingField-Monticello15'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:06'! scriptLogging Installer mantis ensureFix: '7219 Improve Streams Usage Readability'. Installer ss project: 'Logging'; install: 'ProcessSpecific'; install: 'Logging'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 02:28'! scriptLPFPreamble! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 04:08'! scriptLPF Installer install: 'LevelPlayingField-Preamble'. Installer install: 'LevelPlayingField'. Installer install: 'LevelPlayingField-Postscript'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:08'! scriptMonticello16Beta " Monticello 1.6 will be all about truly atomic loading, thanks to SystemEditor. The atomic loader comes with every copy of Monticello 1.5, but is disabled by default. So this script just loads up MC 1.5, SystemEditor, and enables the atomic loader. Note that this is beta level software, but I think it mostly works There is no support for Traits yet, or for Tweak fields, so you won't be able to load Traits or Nile or parts of Omnibrowser with this enabled. To use the stable loader, disable the preference monticello > useMonticelloAtomicLoader " Installer ss project: 'SystemEditor'; install: 'SystemEditor-Core'; install: 'SystemEditor-Squeak'. Preferences setPreference: #useMonticelloAtomicLoader toValue: true.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:09'! scriptOmniBrowser Installer mantis fixBug: 7132. Installer wiresong project: 'ob'; install: 'OmniBrowser-mtf.413'; install: 'OB-Standard'; install: 'OB-Morphic'; install: 'OB-SUnitIntegration'; install: 'OB-Enhancements'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:03'! scriptPackagesPharo Installer mantis ensureFix: '7272 BlockContext equality testing missing'. Installer squeaksource project: 'Sake'; install: 'Sake-Core'. Installer squeaksource project: 'Packages'; install: 'Sake-Packages'; install: 'Packages-Library'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:02'! scriptPackages Installer mantis ensureFix: '7219 Streams Readability'. Installer mantis ensureFix: '7166 Speedup allSelectors add allSelectorsBelow'. Installer mantis ensureFix: '7272 BlockContext equality testing missing'. Installer squeaksource project: 'Sake'; install: 'Sake-Core'. Installer squeaksource project: 'Packages'; install: 'Sake-Packages'; install: 'Packages-Library'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:06'! scriptUniverses Installer ss project: 'XMLSupport'; install: 'XML-Parser'. Installer ss project: 'universes'; install: 'Universes'.! ! !InstallerScripts methodsFor: 'as yet unclassified' stamp: 'kph 2/23/2009 03:13'! scriptUnloadTraits "Phase 1: Disable traits activity and stub out the instance variables that will be removed in Phase 2" SystemChangeNotifier uniqueInstance noMoreNotificationsFor: ProvidedSelectors current; noMoreNotificationsFor: RequiredSelectors current; noMoreNotificationsFor: LocalSends current. Installer installUrl: 'http://installer.pbwiki.org/f/UnloadTraits-StubOutAcessors.cs'. "Phase 2: Recompile the image with classes in the old format, ie, without the traitsComposition and localSends instance variables" [ ClassDescription subclass: #Metaclass instanceVariableNames: 'thisClass' classVariableNames: ' ' poolDictionaries: ' ' category: 'Kernel-Classes'. ClassDescription subclass: #Class instanceVariableNames: 'subclasses name classPool sharedPools environment category' classVariableNames: ' ' poolDictionaries: ' ' category: 'Kernel-Classes'. ] on: Warning do: [:warning | warning resume]. "Phase 3: Remove all traits and all references to the Traits classes from the image, including methods that refer to traits functionality" "Kill all traits" "variables are nil-ed out to prevent obsolete refs later" Smalltalk allTraits do: [:trait | trait removeFromSystem. trait := nil]. "Recompile all methods that were part of a trait" SystemNavigation default allBehaviorsDo: [:class | class selectorsAndMethodsDo: [:sel :method | class ~~ method methodClass ifTrue: [class recompile: sel]. method := nil]. class := nil]. "Remove references to traits from various places in the code" Installer installUrl: 'http://installer.pbwiki.org/f/UnloadTraits-ClearRefs.cs'. "Phase 4: Unload the Traits package and install the Traits compatability stubs for Monticello" Installer unload: 'Traits'. Installer installUrl: 'http://installer.pbwiki.org/f/TraitsStubs.cs'. ! ! Installer subclass: #InstallerSqueakMap instanceVariableNames: 'sm' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerSqueakMap class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:42'! label ^ 'squeakmap'! ! !InstallerSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:43'! basicAvailablePackages ^self classSMSqueakMap default packagesByName! ! !InstallerSqueakMap methodsFor: 'basic interface' stamp: 'kph 5/10/2007 00:29'! basicBrowse self smThing explore! ! !InstallerSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:42'! basicInstall self log: ' installing '. self withAnswersDo: [ self smThing install ]. self log: ' done'. ! ! !InstallerSqueakMap methodsFor: 'basic interface' stamp: 'sd 3/6/2008 20:43'! basicVersions ^ (self smReleasesForPackage: self package) collect: [ :v | self copy package: (v package name,'(',v version,')'); yourself. ] ! ! !InstallerSqueakMap methodsFor: 'basic interface' stamp: 'kph 5/10/2007 00:25'! basicView self smThing explore! ! !InstallerSqueakMap methodsFor: 'class references' stamp: 'sd 3/6/2008 20:17'! classSMLoader ^Smalltalk at: #SMLoader ifAbsent: [ self error: 'SqueakMap Loader not present' ]! ! !InstallerSqueakMap methodsFor: 'class references' stamp: 'sd 3/6/2008 20:17'! classSMSqueakMap ^Smalltalk at: #SMSqueakMap ifAbsent: [ self error: 'SqueakMap not present' ]! ! !InstallerSqueakMap methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! open self classSMLoader open! ! !InstallerSqueakMap methodsFor: 'searching' stamp: 'mtf 10/8/2008 12:00'! packagesMatching: aMatch ^ (self availablePackages select: [ :p | aMatch match: p name ]) collect: [ :p | self copy package: p name; yourself ]! ! !InstallerSqueakMap methodsFor: 'searching' stamp: 'damiencassou 2/20/2009 19:30'! search: aMatch | results | results := Set new. self availablePackages do: [ :pkg | ({ 'name:',pkg name. 'summary:', pkg summary. 'description:', pkg description. 'author:', pkg author. } anySatisfy: [ :field | aMatch match: field ]) ifTrue: [ results add: (self copy package: pkg name) ]. ]. ^results ! ! !InstallerSqueakMap methodsFor: 'squeakmap' stamp: 'kph 4/24/2008 23:03'! smPackageAndVersion | p | p := ReadStream on: self package . ^Array with: (p upTo: $() with: (p upTo: $)).! ! !InstallerSqueakMap methodsFor: 'squeakmap' stamp: 'sd 3/6/2008 20:43'! smReleasesForPackage: name ^(self classSMSqueakMap default packageWithName: name) releases! ! !InstallerSqueakMap methodsFor: 'squeakmap' stamp: 'sd 3/6/2008 20:43'! smThing | pkgAndVersion releases release | pkgAndVersion := self packageAndVersionFrom: self package. self logCR: 'retrieving ', self package, ' from SqueakMap...'. releases := self smReleasesForPackage: pkgAndVersion first. release := pkgAndVersion last isEmpty ifTrue: [ releases last ] ifFalse:[ releases detect: [ :rel | rel version = pkgAndVersion last ] ]. ^ release ! ! !InstallerSqueakMap methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:05'! sm ^ sm ifNil: [ false ]! ! !InstallerSqueakMap methodsFor: 'accessing' stamp: 'sd 3/6/2008 19:05'! sm: anObject sm := anObject! ! !InstallerSqueakMap methodsFor: 'squeakmap' stamp: 'stephane.ducasse 9/30/2008 18:41'! update "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/SqueakMap8.st 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. doneSema wait! ! Installer subclass: #InstallerUniverse instanceVariableNames: 'universe' classVariableNames: 'LastUniUpdate' poolDictionaries: '' category: 'Installer-Core'! !InstallerUniverse class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classUGlobalInstaller ^Smalltalk at: #UGlobalInstaller ifAbsent: [ self error: 'Universes code not present' ]! ! !InstallerUniverse class methodsFor: 'accessing system' stamp: 'stephane.ducasse 9/30/2008 18:16'! classUUniverse ^Smalltalk at: #UUniverse ifAbsent: [ self error: 'Universes code not present' ]! ! !InstallerUniverse class methodsFor: 'instance creation' stamp: 'mtf 10/14/2008 10:09'! default ^ self universe: (self classUGlobalInstaller universe: self classUUniverse systemUniverse)! ! !InstallerUniverse class methodsFor: 'as yet unclassified' stamp: 'damiencassou 2/20/2009 19:42'! label ^ 'universe'! ! !InstallerUniverse class methodsFor: 'instance creation' stamp: 'mtf 10/14/2008 10:10'! universe: u ^ self new universe: u! ! !InstallerUniverse methodsFor: 'basic interface' stamp: 'sd 3/6/2008 19:05'! basicInstall | pkgAndVersion pkg version potentials | self packages do: [ :packageName | pkgAndVersion := self packageAndVersionFrom: packageName. pkg := pkgAndVersion first. version := pkgAndVersion last. potentials := universe packageVersionsForPackage: pkg. pkg := version isEmpty ifTrue: [ potentials last ] ifFalse: [ version := self classUVersion readFrom: version readStream. potentials detect:[ :p | p version = version] ifNone: [ ^ self error: 'version not found'] ]. universe planToInstallPackage: pkg. ]. self uniDoInstall! ! !InstallerUniverse methodsFor: 'class references' stamp: 'sd 3/6/2008 20:17'! classUVersion ^Smalltalk at: #UVersion ifAbsent: [ self error: 'Universes code not present' ]! ! !InstallerUniverse methodsFor: 'universes' stamp: 'kph 7/25/2007 13:46'! uniDoInstall self withAnswersDo: [ self universe doInstall ] ! ! !InstallerUniverse methodsFor: 'universes' stamp: 'kph 7/25/2007 12:52'! universe ^ universe! ! !InstallerUniverse methodsFor: 'universes' stamp: 'squeak 7/26/2007 18:12'! universe: u universe := u. self update.! ! !InstallerUniverse methodsFor: 'public interface' stamp: 'stephane.ducasse 9/30/2008 18:41'! update (LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds ]) ifTrue: [universe requestPackageList. LastUniUpdate := DateAndTime now]! ! Installer subclass: #InstallerUpdateStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Installer-Core'! !InstallerUpdateStream class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:43'! label ^ 'updatestream'! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/6/2008 20:40'! changesetNamesFromUpdates: startNumber through: stopNumber "Answer the concatenation of summary strings for updates numbered in the given range" "self new changesetNamesFromUpdates: 7059 through: 7061" ^ String streamContents: [:aStream | ((ChangeSet changeSetsNamedSuchThat: [:aName | aName first isDigit and: [aName initialIntegerOrNil >= startNumber] and: [aName initialIntegerOrNil <= stopNumber]]) asSortedCollection: [:a :b | a name < b name]) do: [:aChangeSet | aStream cr; nextPutAll: aChangeSet summaryString]] ! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/9/2008 11:30'! loadUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag "To use this mechanism, be sure all updates you want to have considered are in a folder named 'updates' which resides in the same directory as your image. Having done that, simply evaluate: Installer new loadUpdatesFromDiskToUpdateNumber: 100020 stopIfGap: false and all numbered updates <= lastUpdateNumber not yet in the image will be loaded in numerical order." "apparently does not use the updatelist too bad!! and to rewrite - sd 7 March 2008" | previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded | updateDirectory := self updateDirectoryOrNil. updateDirectory ifNil: [^ self]. previousHighest := SystemVersion current highestUpdate. currentUpdateNumber := previousHighest. done := false. loaded := 0. [done] whileFalse: [currentUpdateNumber := currentUpdateNumber + 1. currentUpdateNumber > lastUpdateNumber ifTrue: [done := true] ifFalse: [fileNames := updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'. fileNames size > 1 ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , ' (at this point it is probably best to remedy the situation on disk, then try again.)']. fileNames size == 0 ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'. done := stopIfGapFlag] ifFalse: [ChangeSet newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first) named: fileNames first. SystemVersion current registerUpdate: currentUpdateNumber. loaded := loaded + 1]]]. aMessage := loaded = 0 ifTrue: ['No new updates found.'] ifFalse: [loaded printString , ' update(s) loaded.']. self inform: aMessage , ' Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/8/2008 21:15'! loadUpdatesFromDisk | updateDirectory updateNumbers | updateDirectory := self updateDirectoryOrNil. updateDirectory ifNil: [^ self]. updateNumbers := updateDirectory fileNames collect: [:fn | fn initialIntegerOrNil] thenSelect: [:fn | fn notNil]. self loadUpdatesFromDiskToUpdateNumber: updateNumbers max stopIfGap: false ! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/3/2008 10:37'! parseUpdateListContents: listContentString "Parse the contents of an updates.list into {{releaseTag. {fileNames*}}*}, and return it." | sections releaseTag strm line fileNames | sections := OrderedCollection new. fileNames := OrderedCollection new: 1000. releaseTag := nil. strm := ReadStream on: listContentString. [strm atEnd] whileFalse: [line := strm upTo: Character cr. line size > 0 ifTrue: [line first = $# ifTrue: [releaseTag ifNotNil: [sections addLast: {releaseTag. fileNames asArray}]. releaseTag := line allButFirst. fileNames resetTo: 1] ifFalse: [line first = $* ifFalse: [fileNames addLast: line]]]]. releaseTag ifNotNil: [sections addLast: {releaseTag. fileNames asArray}]. ^ sections asArray ! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/8/2008 21:13'! updateDirectoryOrNil ^ (FileDirectory default directoryNames includes: 'updates') ifTrue: [FileDirectory default directoryNamed: 'updates'] ifFalse: [self inform: 'Error: cannot find "updates" folder'. nil]! ! !InstallerUpdateStream methodsFor: 'updates' stamp: 'sd 3/3/2008 10:52'! writeList: listContents toStream: strm "Write a parsed updates.list out as text. This is the inverse of parseUpdateListContents:" | fileNames releaseTag | strm reset. listContents do: [:pair | releaseTag := pair first. fileNames := pair last. strm nextPut: $#; nextPutAll: releaseTag; cr. fileNames do: [:fileName | strm nextPutAll: fileName; cr]]. strm close! ! !Installer class methodsFor: 'action report' stamp: 'mtf 10/8/2008 12:00'! actionMatch: theLine reportOn: report ifNoMatch: aBlock | line | line := theLine withBlanksCondensed. self allSubclassesDo: [:class | (class canReportLine: line) ifTrue: [ ^ class new action: theLine reportOn: report ]]. ^ aBlock value! ! !Installer class methodsFor: 'mantis' stamp: 'kph 2/15/2009 05:21'! bug: n fix: filename Transcript cr; show: 'Code script in Mantis:', n asString, ' should read Installer mantis bug: ',n asString, ' fix: ', filename printString,'.'. ^ self mantis bug: n fix: filename! ! !Installer class methodsFor: 'monticello' stamp: 'mtf 5/20/2008 22:10'! cache ^ self monticello cache! ! !Installer class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:20'! cancelSkipLoadingTests "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages" SkipLoadingTests := false. ! ! !Installer class methodsFor: 'action report' stamp: 'mtf 10/8/2008 12:00'! canReportLine: line ^ false! ! !Installer class methodsFor: 'debug' stamp: 'kph 5/9/2007 23:05'! debug IsSetToTrapErrors := false! ! !Installer class methodsFor: 'custom names' stamp: 'kph 5/28/2007 05:11'! doesNotUnderstand: aMessage ^ self remembered at: aMessage selector ifAbsent: [ super doesNotUnderstand: aMessage ]! ! !Installer class methodsFor: 'launcher support' stamp: 'kph 2/23/2009 01:55'! do: webPageName | rs | rs := webPageName readStream. [ rs atEnd ] whileFalse: [ self install: (rs upTo: $;) ]. ! ! !Installer class methodsFor: 'file' stamp: 'mtf 10/23/2008 15:49'! file ^ InstallerFile new! ! !Installer class methodsFor: 'file' stamp: 'mtf 10/23/2008 16:08'! file: fileName ^ InstallerFile new file: fileName; yourself ! ! !Installer class methodsFor: 'url' stamp: 'kph 2/11/2009 20:12'! fromUrl: aUrl "try and pick an Installer appropriate for the Url" | mci | mci := Installer mc fromUrl: aUrl. mci packages ifEmpty: [ ^ Installer url: aUrl ]. ^ mci! ! !Installer class methodsFor: 'repositories' stamp: 'kph 6/2/2008 20:21'! goran ^ self monticello http: 'squeak.krampe.se'; project: ''! ! !Installer class methodsFor: 'repositories' stamp: 'kph 5/10/2007 01:29'! impara ^ self monticello http: 'source.impara.de'! ! !Installer class methodsFor: 'file' stamp: 'mtf 10/23/2008 16:08'! installFile: fileName ^ (self file: fileName) install. ! ! !Installer class methodsFor: 'url' stamp: 'stephane.ducasse 9/30/2008 18:24'! installSilentlyUrl: urlString ^ SystemChangeNotifier uniqueInstance doSilently: [ self url url: urlString; install ]. ! ! !Installer class methodsFor: 'url' stamp: 'stephane.ducasse 9/30/2008 18:24'! installUrl: urlString ^ self url url: urlString; install. ! ! !Installer class methodsFor: 'action report' stamp: 'kph 2/23/2009 02:05'! install: scriptName ^ (self scripts install: scriptName) ifNil:[ self web install: scriptName ] ! ! !Installer class methodsFor: 'repositories' stamp: 'kph 12/18/2008 02:06'! keith ^ self monticello ftp: 'squeak.warwick.st' directory: 'mc' user: 'squeak' password: 'viewpoints'! ! !Installer class methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 20:29'! label ^ ''! ! !Installer class methodsFor: 'launcher support' stamp: 'kph 2/27/2007 18:57'! launchFrom: launcher ^self launchWith: launcher getParameters! ! !Installer class methodsFor: 'launcher support' stamp: 'kph 5/24/2007 19:59'! launchHelp ^'path=/dir/*.txt Specify a search path for the item to install p=/dir1/*.txt;/ Multiple items delimited by ; The page name is typically appended to the path string, or if a "*" is present, it will be replaced by the page name. in,i,install= Page appended to the path to begin the install process url,u= Install using an explicit url from which to obtain a script or file file= Install using a local file +debug Do not trap errors view= Print the script that would have been installed. For more options use Script eval="Installer ... " ' ! ! !Installer class methodsFor: 'launcher support' stamp: 'kph 1/11/2008 07:58'! launchWith: params params at: 'P' ifPresent: [ :v | params at: 'PATH' put: v ]. params at: 'I' ifPresent: [ :v | params at: 'INSTALL' put: v ]. params at: 'IN' ifPresent: [ :v | params at: 'INSTALL' put: v ]. params at: 'U' ifPresent: [ :v | params at: 'URL' put: v ]. params at: 'PATH' ifPresent: [ :v | self webSearchPathFrom: v. ]. params at: 'USER' ifPresent: [ :v | Utilities setAuthorInitials: v ]. params at: 'VERSION' ifPresent: [ :v | SystemVersion current version: v ]. params at: 'VIEW' ifPresent: [ :v | self view: v ]. IsSetToTrapErrors := true. params at: 'DEBUG' ifPresent: [ :v | IsSetToTrapErrors := (v == true) not ]. params at: 'URL' ifPresent: [ :v | self installUrl: v ]. params at: 'FILE' ifPresent: [ :v | self installFile: v ]. params at: 'INSTALL' ifPresent: [ :v | self do: v ]. params at: 'DO' ifPresent: [ :v | self do: v ]. ^true ! ! !Installer class methodsFor: 'repositories' stamp: 'kph 4/24/2008 16:56'! lukas ^ self monticello http: 'source.lukas-renggli.ch'! ! !Installer class methodsFor: 'mantis' stamp: 'kph 3/14/2007 21:07'! mantis ^ self mantis: 'http://bugs.squeak.org/'! ! !Installer class methodsFor: 'mantis' stamp: 'mtf 10/8/2008 12:00'! mantis: host ^ InstallerMantis host: host! ! !Installer class methodsFor: 'monticello' stamp: 'kph 5/10/2007 00:49'! mc ^ self monticello! ! !Installer class methodsFor: 'monticello' stamp: 'kph 5/10/2007 00:49'! monticello ^ InstallerMonticello new! ! !Installer class methodsFor: 'debug' stamp: 'kph 5/9/2007 23:05'! noDebug IsSetToTrapErrors := true! ! !Installer class methodsFor: 'during' stamp: 'kph 5/21/2008 09:05'! noProgressDuring: block [ block value: self ] on: ProgressInitiationException do: [ :note | note resume ] ! ! !Installer class methodsFor: 'web' stamp: 'stephane.ducasse 9/30/2008 18:24'! path: aString "convenience abbreviation" self webSearchPathFrom: aString! ! !Installer class methodsFor: 'custom names' stamp: 'kph 5/28/2007 00:54'! remembered ^ Remembered ifNil: [ Remembered := IdentityDictionary new ]! ! !Installer class methodsFor: 'instanciation' stamp: 'kph 12/1/2008 20:12'! repositories ^ self class organization listAtCategoryNamed: 'repositories'. ! ! !Installer class methodsFor: 'monticello' stamp: 'stephane.ducasse 9/30/2008 18:24'! repository: host ^self monticello http: host ! ! !Installer class methodsFor: 'sake' stamp: 'mtf 10/8/2008 12:00'! sake ^ self sake: InstallerSake sake! ! !Installer class methodsFor: 'sake' stamp: 'kph 1/28/2008 10:42'! sake: aSakePackagesClass ^ InstallerSake new sake: aSakePackagesClass! ! !Installer class methodsFor: 'repositories' stamp: 'kph 8/18/2008 03:15'! saltypickle ^ self monticello http: 'squeak.saltypickle.com'! ! !Installer class methodsFor: 'internal scripts' stamp: 'kph 2/23/2009 02:03'! scripts ^ InstallerScripts new! ! !Installer class methodsFor: 'sake' stamp: 'mtf 10/8/2008 12:00'! setSakeToUse: aClass InstallerSake sake: aClass! ! !Installer class methodsFor: 'documentation' stamp: 'kph 5/10/2007 01:21'! sf ^ self squeakfoundation ! ! !Installer class methodsFor: 'during' stamp: 'kph 5/21/2008 08:53'! skipLoadingTestsDuring: block | oldValue | oldValue := SkipLoadingTests. SkipLoadingTests := true. [ block value: self ] ensure:[ SkipLoadingTests := oldValue ].! ! !Installer class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:21'! skipLoadingTests "sets a flag to ignore loading of the testing portion of scripts embedded in pages" SkipLoadingTests := true. ! ! !Installer class methodsFor: 'squeakmap' stamp: 'kph 5/10/2007 01:19'! sm ^ self squeakmap! ! !Installer class methodsFor: 'repositories' stamp: 'kph 12/15/2007 11:08'! sophie ^ self monticello http: 'source.sophieproject.org' ! ! !Installer class methodsFor: 'repositories' stamp: 'kph 5/10/2007 01:21'! squeakfoundation ^ self monticello http: 'source.squeakfoundation.org'! ! !Installer class methodsFor: 'squeakmap' stamp: 'stephane.ducasse 9/30/2008 18:26'! squeakmap ^ InstallerSqueakMap new sm: true; yourself! ! !Installer class methodsFor: 'repositories' stamp: 'kph 5/10/2007 01:19'! squeaksource ^ self monticello http: 'www.squeaksource.com'! ! !Installer class methodsFor: 'repositories' stamp: 'kph 5/10/2007 01:19'! ss ^ self squeaksource ! ! !Installer class methodsFor: 'universe' stamp: 'mtf 10/14/2008 10:10'! universe ^ InstallerUniverse default! ! !Installer class methodsFor: 'instanciation' stamp: 'kph 12/18/2007 11:47'! upgrade Installer ss project: 'Installer'; installQuietly: 'Installer-Core'. ^ self! ! !Installer class methodsFor: 'url' stamp: 'kph 12/9/2008 03:10'! url ^ InstallerUrl new url: ''! ! !Installer class methodsFor: 'url' stamp: 'stephane.ducasse 9/30/2008 18:26'! url: urlString ^self url url: urlString; yourself! ! !Installer class methodsFor: 'accessing' stamp: 'stephane.ducasse 9/30/2008 18:28'! validationBlock ^ ValidationBlock! ! !Installer class methodsFor: 'accessing' stamp: 'kph 5/25/2007 01:34'! validationBlock: aBlock ValidationBlock := aBlock! ! !Installer class methodsFor: 'instanciation' stamp: 'stephane.ducasse 9/30/2008 18:26'! view: webPageNameOrUrl | theReport | theReport := String streamContents: [ :report | (webPageNameOrUrl beginsWith: 'http://') ifTrue: [ self actionMatch: ('Installer installUrl: ', (webPageNameOrUrl printString),'.') reportOn: report ifNoMatch: [] ] ifFalse: [ self actionMatch: ('Installer install: ', (webPageNameOrUrl printString),'.') reportOn: report ifNoMatch: [] ]]. Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl. ^theReport contents ! ! !Installer class methodsFor: 'web' stamp: 'kph 2/23/2009 01:56'! webInstall: webPageName ^ self web install: webPageName ! ! !Installer class methodsFor: 'web' stamp: 'stephane.ducasse 9/30/2008 18:22'! webSearchPathFrom: string | reader wsp path | reader := string readStream. wsp := self webSearchPath. [ reader atEnd ] whileFalse: [ path := reader upTo: $;. (wsp includes: wsp) ifFalse: [ wsp addFirst: path ]]. ! ! !Installer class methodsFor: 'web' stamp: 'stephane.ducasse 9/30/2008 18:22'! webSearchPath "a search path item, has the following format. prefix*suffix" ^ self web searchPath! ! !Installer class methodsFor: 'websqueakmap' stamp: 'stephane.ducasse 9/30/2008 18:28'! websqueakmap ^ InstallerWebSqueakMap new wsm: 'http://map.squeak.org'; yourself! ! !Installer class methodsFor: 'websqueakmap' stamp: 'stephane.ducasse 9/30/2008 18:28'! websqueakmap: host ^ InstallerWebSqueakMap new wsm: host; yourself! ! !Installer class methodsFor: 'web' stamp: 'stephane.ducasse 9/30/2008 18:26'! web ^ InstallerWeb! ! !Installer class methodsFor: 'repositories' stamp: 'kph 5/10/2007 01:30'! wiresong ^ self monticello http: 'source.wiresong.ca'! ! !Installer class methodsFor: 'websqueakmap' stamp: 'kph 5/10/2007 01:19'! wsm ^ self websqueakmap! ! !Installer methodsFor: 'public interface' stamp: 'sd 3/6/2008 18:45'! addPackage: anObject self packages add: anObject! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:46'! answers ^ answers ifNil: [ answers := OrderedCollection new ]! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:46'! answers: anObject answers := anObject! ! !Installer methodsFor: 'auto answering' stamp: 'sd 3/6/2008 18:46'! answer: aString with: anAnswer ^self answers add: ( Array with: aString with: anAnswer )! ! !Installer methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! availablePackages ^ self basicAvailablePackages! ! !Installer methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicAvailablePackages! ! !Installer methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicBrowse! ! !Installer methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicInstall! ! !Installer methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicVersions! ! !Installer methodsFor: 'basic interface' stamp: 'mtf 10/8/2008 12:00'! basicView! ! !Installer methodsFor: 'script bindings' stamp: 'kph 5/8/2007 19:52'! bindingOf: aString InstallerBindings isNil ifTrue: [ InstallerBindings := Dictionary new]. (InstallerBindings includesKey: aString) ifFalse: [InstallerBindings at: aString put: nil]. ^ InstallerBindings associationAt: aString.! ! !Installer methodsFor: 'mantis' stamp: 'kph 12/19/2007 13:49'! browseCS: aFileName from: stream | list | list := self classChangeList new scanFile: stream from: 1 to: stream size. self classChangeList open: list name: aFileName multiSelect: true. ! ! !Installer methodsFor: 'mantis' stamp: 'kph 12/19/2007 12:05'! browseDefault: aFileName from: stream self view: aFileName from: stream! ! !Installer methodsFor: 'mantis' stamp: 'sd 3/6/2008 19:08'! browseGZ: aFileName from: stream "FileIn the contents of a gzipped stream" | zipped unzipped | zipped := self classGZipReadStream on: stream. unzipped := MultiByteBinaryOrTextStream with: zipped contents asString. unzipped reset. ChangeList browseStream: unzipped ! ! !Installer methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! browse self logErrorDuring: [self basicBrowse]! ! !Installer methodsFor: 'mantis' stamp: 'kph 12/19/2007 12:03'! browse: aFileName from: stream | mcThing ext browseSelector | self log: ' browsing...'. mcThing := self classMCReader ifNotNil: [ self mcThing: aFileName from: stream ]. mcThing ifNotNil: [ (mcThing respondsTo: #snapshot) ifTrue: [ mcThing browse ] ifFalse: [ (MCSnapshotBrowser forSnapshot: mcThing) showLabelled: 'Browsing ', aFileName ] ] ifNil: [ ext := aFileName copyAfterLast: $.. browseSelector := ('browse', ext asUppercase, ':from:') asSymbol. (self respondsTo: browseSelector) ifTrue: [ self perform: browseSelector with: aFileName with: stream ] ifFalse: [ self browseDefault: aFileName from: stream ]. ]! ! !Installer methodsFor: 'public interface' stamp: 'sd 3/6/2008 18:45'! browse: packageNameCollectionOrDetectBlock self package: packageNameCollectionOrDetectBlock. self browse! ! !Installer methodsFor: 'utils' stamp: 'kph 5/24/2007 19:16'! changeSetNamed: aName (ChangeSet respondsTo: #named:) ifTrue: [ ^ChangeSet named: aName ]. ^ ChangeSorter changeSetNamed: aName.! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classChangeList ^Smalltalk at: #ChangeList ifAbsent: [ self error: 'ChangeList not present' ]! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classChangeSet ^Smalltalk at: #ChangeSet ifAbsent: [ self error: 'ChangeSet not present' ]! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classChangeSorter ^Smalltalk at: #ChangeSorter ifAbsent: [ self error: 'ChangeSorter not present' ]! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classGZipReadStream ^Smalltalk at: #GZipReadStream ifAbsent: [ self error: 'Compression not present' ]! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classMCReader ^Smalltalk at: #MCReader ifAbsent: [ nil ] ! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:16'! classMczInstaller ^Smalltalk at: #MczInstaller ifAbsent: [ nil ] ! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:17'! classMultiByteBinaryOrTextStream ^Smalltalk at: #MultiByteBinaryOrTextStream ifAbsent: [ self error: 'MultiByteBinaryOrTextStream not present' ]! ! !Installer methodsFor: 'class references' stamp: 'sd 3/6/2008 20:17'! classSARInstaller ^Smalltalk at: #SARInstaller ifAbsent: [ self error: 'SARInstaller not present' ]! ! !Installer methodsFor: 'utils' stamp: 'mtf 7/23/2008 12:00'! ditchOldChangeSetFor: aFileName | changeSetName | changeSetName := (self validChangeSetName: aFileName) sansPeriodSuffix. (self changeSetNamed: changeSetName) ifNotNilDo: [:changeSet | (self logCR:'Removing old change set ', changeSetName) cr. self removeChangeSet: changeSet ].! ! !Installer methodsFor: 'mantis' stamp: 'kph 5/9/2007 18:14'! installCS: aFileName from: stream self ditchOldChangeSetFor: aFileName. self newChangeSetFromStream: stream named: (self validChangeSetName: aFileName). ! ! !Installer methodsFor: 'mantis' stamp: 'ar 2/14/2009 22:56'! installDefault: aFileName from: stream "Check for UTF-8 input before filing it in" | pos bom | pos := stream position. bom := stream next: 3. (bom size = 3 and:[(bom at: 1) asInteger = 16rEF] and:[(bom at: 2) asInteger = 16rBB] and:[(bom at: 3) asInteger = 16rBF]) ifTrue:[(RWBinaryOrTextStream on: stream upToEnd utf8ToSqueak) fileIn] ifFalse:[stream position: pos; fileIn] ! ! !Installer methodsFor: 'mantis' stamp: 'kph 1/8/2007 06:42'! installGZ: aFileName from: stream "FileIn the contents of a gzipped stream" | zipped unzipped | zipped := self classGZipReadStream on: stream. unzipped := MultiByteBinaryOrTextStream with: zipped contents asString. unzipped reset. self newChangeSetFromStream: unzipped named:aFileName. ! ! !Installer methodsFor: 'mantis' stamp: 'kph 5/9/2007 18:07'! installMCcs: aFileName from: stream | reader | reader := MCCsReader on: stream.! ! !Installer methodsFor: 'mantis' stamp: 'kph 5/9/2007 18:17'! installMCZ: aFileName from: stream self classMczInstaller ifNotNilDo: [ :reader | ^reader installStream: stream]. self error: 'no monticello readers available'. ! ! !Installer methodsFor: 'public interface' stamp: 'kph 5/16/2008 00:44'! installQuietly [ self install ] on: Warning do: [ :ex | ex resume: true ].! ! !Installer methodsFor: 'public interface' stamp: 'kph 5/16/2008 00:45'! installQuietly: packageNameCollectionOrDetectBlock self package: packageNameCollectionOrDetectBlock. self installQuietly.! ! !Installer methodsFor: 'mantis' stamp: 'kph 5/25/2007 01:09'! installSAR: aFileName from: stream | newCS | self classSARInstaller withCurrentChangeSetNamed: aFileName do: [:cs | newCS := cs. self classSARInstaller new fileInFrom: stream]. newCS isEmpty ifTrue: [ self removeChangeSet: newCS ]! ! !Installer methodsFor: 'public interface' stamp: 'kph 6/2/2008 12:17'! installSilently SystemChangeNotifier uniqueInstance doSilently: [ self install ] ! ! !Installer methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! install self logErrorDuring: [self basicInstall]! ! !Installer methodsFor: 'mantis' stamp: 'kph 12/9/2008 17:51'! install: aFileName from: stream | ext installSelector mcThing | self log: ' installing...'. self withAnswersDo: [ mcThing := self classMCReader ifNotNil: [ self mcThing: aFileName from: stream ]. mcThing ifNotNil: [ (mcThing respondsTo: #install) ifTrue: [ mcThing install ] ifFalse: [ (mcThing respondsTo: #load) ifTrue: [ mcThing load ] ] ] ifNil: [ ext := (aFileName copyAfterLast: $/) in: [ :path | path isEmpty ifTrue: [ aFileName ] ifFalse: [ path ] ]. ext := ext copyAfterLast: $.. ext = '' ifTrue: [ ext := 'st' ]. installSelector := ('install', ext asUppercase, ':from:') asSymbol. (self respondsTo: installSelector) ifTrue: [ self perform: installSelector with: aFileName with: stream ] ifFalse: [ self installDefault: aFileName from: stream ]. ] ]. self log: ' done.' ! ! !Installer methodsFor: 'public interface' stamp: 'sd 3/6/2008 18:45'! install: packageNameCollectionOrDetectBlock self addPackage: packageNameCollectionOrDetectBlock. self install! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! isSkipLoadingTestsSet ^SkipLoadingTests ifNil: [ false ]! ! !Installer methodsFor: 'accessing' stamp: 'damiencassou 2/20/2009 19:37'! label ^ self class label! ! !Installer methodsFor: 'logging' stamp: 'mtf 10/15/2008 08:08'! logCR: text self validate. ^ Transcript show: text; cr! ! !Installer methodsFor: 'logging' stamp: 'kph 9/1/2008 21:39'! logErrorDuring: block (IsSetToTrapErrors = true) ifFalse: [ ^ block value ]. block on: Error do: [ :e | self halt. self logCR: '****', e class name, ': ', (e messageText ifNil: [ '']). (e isKindOf: MessageNotUnderstood) ifTrue: [ e pass ] ifFalse: [ e isResumable ifTrue:[ e resume: true ]]]! ! !Installer methodsFor: 'logging' stamp: 'sd 3/6/2008 20:23'! log: text ^Transcript show: text.! ! !Installer methodsFor: 'searching' stamp: 'kph 1/4/2007 23:59'! match: aMatch ^self packagesMatching: aMatch! ! !Installer methodsFor: 'mantis' stamp: 'stephane.ducasse 9/30/2008 18:38'! 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. ^ reader version ] ifFalse: [ reader := reader on: stream. ^ reader snapshot ].! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:47'! messagesToSuppress ^ messagesToSuppress ifNil: [ messagesToSuppress := OrderedCollection new ]! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:48'! messagesToSuppress: anObject messagesToSuppress := anObject! ! !Installer methodsFor: 'mantis' stamp: 'kb 12/18/2006 13:01'! newChangeSetFromStream: aStream named: aName "This code is based upon ChangeSet-c-#newChangesFromStream:named: which is in 3.9, implemented here for previous versions. The second branch is for 3.8, where ChangeSets are loaded by ChangeSorter. " | oldChanges newName newSet newStream | (self classChangeSet respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSet newChangesFromStream: aStream named:aName ]. (self classChangeSorter respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSorter newChangesFromStream: aStream named: aName ]. oldChanges := ChangeSet current. "so a Bumper update can find it" newName := aName sansPeriodSuffix. newSet := self classChangeSet basicNewNamed: newName. [newSet ifNotNil: [(aStream respondsTo: #converter:) ifTrue: [newStream := aStream] ifFalse: [newStream := self classMultiByteBinaryOrTextStream with: aStream contentsOfEntireFile. newStream reset]. self classChangeSet newChanges: newSet. newStream setConverterForCode. newStream fileInAnnouncing: 'Loading ' , newName , '...'. Transcript cr; show: 'File ' , aName , ' successfully filed in to change set ' , newName]. aStream close] ensure: [self classChangeSet newChanges: oldChanges]. ^ newSet! ! !Installer methodsFor: 'public interface' stamp: 'sd 3/6/2008 18:48'! open! ! !Installer methodsFor: 'squeakmap' stamp: 'mtf 10/15/2008 10:14'! packageAndVersionFrom: pkg | p | p := ReadStream on: pkg . ^Array with: (p upTo: $() with: (p upTo: $)).! ! !Installer methodsFor: 'searching' stamp: 'mtf 10/8/2008 12:00'! packagesMatching: aMatch ^'search type not supported'! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:48'! packages ^ packages ifNil: [ packages := OrderedCollection new ]! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:48'! packages: aCollection packages := aCollection! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:48'! package ^ self packages isEmpty ifTrue: [ nil ] ifFalse: [ self packages last ]! ! !Installer methodsFor: 'accessing' stamp: 'sd 3/6/2008 18:48'! package: anObject self addPackage: anObject.! ! !Installer methodsFor: 'printing' stamp: 'damiencassou 2/20/2009 20:30'! printConfigurationOn: stream ! ! !Installer methodsFor: 'printing' stamp: 'damiencassou 2/20/2009 20:30'! printOn: s s nextPutAll: '(Installer '; nextPutAll: self label; nextPut: $). "lf project ifNotNil: [ s nextPutAll: ' project:'; nextPutAll: '''', self project, ''''. self package ifNotNil: [ s nextPutAll: '; '] ]." self package ifNotNil: [ s nextPutAll: ' package:'; nextPutAll: '''', self package asString, '''' ]. self printConfigurationOn: s. s nextPut: $..! ! !Installer methodsFor: 'custom names' stamp: 'kph 5/28/2007 03:42'! rememberAs: symbol self class remembered at: symbol asSymbol put: self! ! !Installer methodsFor: 'utils' stamp: 'kph 5/25/2007 01:15'! removeChangeSet: cs (self classChangeSet respondsTo: #removeChangeSet:) ifTrue: [ ^ChangeSet removeChangeSet: cs ]. ^ self classChangeSorter removeChangeSet: cs .! ! !Installer methodsFor: 'action report' stamp: 'sd 3/6/2008 18:45'! reportFor: theLine page: thePage on: report [ thePage atEnd ] whileFalse: [ | line | line := thePage nextLine. Installer actionMatch: line reportOn: report ifNoMatch: [ report nextPutAll: line; cr. ]].! ! !Installer methodsFor: 'action report' stamp: 'sd 3/6/2008 18:45'! reportSection: line on: report report isEmpty ifFalse: [ report cr ]. report nextPutAll: '">>>> ' ; nextPutAll: (line copyWithout: $"); nextPut: $"; cr. ! ! !Installer methodsFor: 'searching' stamp: 'damiencassou 2/20/2009 19:29'! search: aMatch ^'search type not supported'! ! !Installer methodsFor: 'auto answering' stamp: 'kph 2/5/2008 15:48'! suppress: aMessage messagesToSuppress add: aMessage! ! !Installer methodsFor: 'logging' stamp: 'kph 5/25/2007 01:36'! validate ValidationBlock value = false ifTrue: [ self error: 'Validation failed' ].! ! !Installer methodsFor: 'url' stamp: 'sd 3/6/2008 20:20'! validChangeSetName: aFileName " dots in the url confuses the changeset loader. I replace them with dashes" (aFileName beginsWith:'http:') ifTrue: [ | asUrl | asUrl := Url absoluteFromText: aFileName. ^String streamContents: [:stream | stream nextPutAll: (asUrl authority copyReplaceAll: '.' with: '-'). asUrl path allButLastDo: [:each | stream nextPutAll: '/'; nextPutAll: (each copyReplaceAll: '.' with: '-') ]. stream nextPutAll: '/'; nextPutAll: asUrl path last ] ]. ^aFileName! ! !Installer methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! versions ^ self basicVersions! ! !Installer methodsFor: 'public interface' stamp: 'mtf 10/8/2008 12:00'! view self logErrorDuring: [self basicView]! ! !Installer methodsFor: 'mantis' stamp: 'kph 5/10/2007 00:21'! view: aFileName from: stream self log: ' viewing...'. Workspace new contents: (stream contents); openLabel: aFileName. ! ! !Installer methodsFor: 'public interface' stamp: 'sd 3/6/2008 19:06'! view: packageNameCollectionOrDetectBlock self package: packageNameCollectionOrDetectBlock. self view! ! !Installer methodsFor: 'auto answering' stamp: 'kph 10/21/2006 06:52'! withAnswersDo: aBlock (aBlock respondsTo: #valueSuppressingMessages:supplyingAnswers: ) ifTrue: [aBlock valueSuppressingMessages: self messagesToSuppress supplyingAnswers: self answers.] ifFalse: [ aBlock value ] ! ! InstallerMantis initialize! InstallerWeb initialize!