[Pkg] The Trunk: Installer-Core-mtf.335.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 4 16:43:32 UTC 2010


Andreas Raab uploaded a new version of Installer-Core to project The Trunk:
http://source.squeak.org/trunk/Installer-Core-mtf.335.mcz

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

Name: Installer-Core-mtf.335
Author: mtf
Time: 4 February 2010, 10:20:36 am
UUID: 2093361a-e14b-40b4-9f45-2c1b070e1535
Ancestors: Installer-Core-mtf.334, Installer-Core-nice.93

merged Installer-Core-nice.93 from trunk. This completes the merge of trunk Installer and mainstream Installer. Please put this version into squeak trunk rather than the ancient version you have now. Merging is rather difficult as there has been a severe refactoring since this 2-year-old version was current. See http://www.squeaksource.com/Installer for a complete history

Name: Installer-Core-nice.93
Author: nice
Time: 18 January 2010, 3:27:55 am
UUID: 099486b1-f102-c748-bba5-cb794f54a1fe
Ancestors: Installer-Core-nice.92

remove an outer temp assignment: #withCurrentChangeSetNamed:do: does return the change set, so it is not necessary to assign temp inside the block

=============== Diff against Installer-Core-nice.93 ===============

Item was changed:
  ----- Method: Installer>>logCR: (in category 'logging') -----
  logCR: text
  
+ 	self validate.
+ 	^ Transcript show: text; cr!
- ^ Transcript cr; show: text!

Item was added:
+ ----- Method: InstallerMonticello>>mcSortFileBlock (in category 'monticello') -----
+ mcSortFileBlock
+ 
+ 	^ [:a :b | 
+         	[(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] 
+ 				on: Error do: [:ex | false]].!

Item was added:
+ ----- Method: Installer classSide>>goran (in category 'repositories') -----
+ goran
+ 
+ 	^ self monticello http: 'squeak.krampe.se'; project: ''!

Item was added:
+ Installer subclass: #InstallerUpdateStream
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerMonticello>>http:user:password: (in category 'instance creation') -----
+ http: aUrl user: name password: secret
+ 	
+ 	mc := self classMCHttpRepository location: aUrl user: name password: secret.
+ 	root := mc locationWithTrailingSlash	
+  !

Item was added:
+ ----- Method: Installer classSide>>sf (in category 'documentation') -----
+ sf
+ 
+ 	^ self squeakfoundation
+  !

Item was added:
+ Installer subclass: #InstallerMonticello
+ 	instanceVariableNames: 'mc root project'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: Installer classSide>>bootstrapTheRestOfInstaller (in category 'action report') -----
+ bootstrapTheRestOfInstaller
+ 
+ 	(Installer url: 'www.squeaksource.com/Installer/Installer-Scripts')  
+ 			fileInSource;
+ 			logCR: 'installer bootstrap - loaded'.!

Item was added:
+ ----- Method: Installer>>bootstrap (in category 'public interface') -----
+ bootstrap
+ 	"keep for compatability"
+ 	
+ 	self deprecatedApi.
+ 
+ 	useFileIn := true.
+ 	self install.!

Item was added:
+ ----- Method: InstallerWeb>>basicInstall (in category 'basic interface') -----
+ 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' ].
+ 	 !

Item was added:
+ Installer subclass: #InstallerSqueakMap
+ 	instanceVariableNames: 'sm'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was changed:
  ----- Method: Installer>>answers (in category 'accessing') -----
  answers
  
+ 	^ answers ifNil: [ answers := OrderedCollection new ]!
- ^ answers ifNil: [ answers := OrderedCollection new ]!

Item was added:
+ ----- Method: InstallerMantis>>ensureFix:date: (in category 'public interface') -----
+ ensureFix: aBugNo date: aDate
+ 
+ 	self setBug: aBugNo.
+ 	self date: aDate.
+ 	
+ 	self ensureFix.!

Item was added:
+ ----- Method: Installer>>install:from:using: (in category 'mantis') -----
+ install: aFileName from: stream using: installSelector
+ 
+ 		(self respondsTo: installSelector)
+ 			ifTrue: [ self perform: installSelector with: aFileName with: stream ]
+ 			ifFalse: [ self installDefault: aFileName from: stream ].
+ !

Item was added:
+ ----- Method: InstallerMantis>>fixBug: (in category 'public interface') -----
+ fixBug: aBugNo 
+ 
+ 	^ self fixBug: aBugNo date: nil.
+ 	
+ !

Item was added:
+ ----- Method: InstallerSake classSide>>sake (in category 'accessing') -----
+ sake
+ 
+ 	^ Sake ifNil: [ self classPackages current ]!

Item was added:
+ ----- Method: InstallerSake>>sake (in category 'websqueakmap') -----
+ sake 
+ 
+ 	^ sake  !

Item was added:
+ ----- Method: InstallerMantis>>printOn: (in category 'accessing') -----
+ printOn: stream
+ 
+ 	super printOn: stream.
+ 	
+ 	(array ifNil: [ ^ self ]) printOn: stream.!

Item was added:
+ ----- Method: InstallerMantis>>setArray: (in category 'public interface') -----
+ setArray: dataRow
+ 
+ 	(array := dataRow) ifNotNil: [ self bug ].!

Item was added:
+ ----- Method: InstallerMantis>>justFixBug: (in category 'public interface') -----
+ justFixBug: aBugNo
+ 
+ 	^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: nil ]!

Item was added:
+ ----- Method: InstallerMantis>>browseFile: (in category 'public interface') -----
+ browseFile: aFileName
+ 
+ 	^ self browse: aFileName from: (self maThing: aFileName date: nil)!

Item was added:
+ ----- Method: InstallerCruft classSide>>unload: (in category 'unload') -----
+ unload: categoryMatchesString 
+ 
+ 	^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'!

Item was added:
+ ----- Method: InstallerMantis>>array (in category 'accessing') -----
+ array
+ 
+ 	^ array!

Item was added:
+ ----- Method: InstallerSake classSide>>sake: (in category 'accessing') -----
+ sake: aClass
+ 
+ 	Sake := aClass!

Item was added:
+ ----- Method: InstallerMonticello>>normalizedRepository (in category 'monticello') -----
+ 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!

Item was added:
+ ----- Method: InstallerMantis>>dataAtName:put: (in category 'search') -----
+ dataAtName: key put: v
+ 	
+ 	^ array at: (self dataNames indexOf: key) put: v!

Item was added:
+ ----- Method: InstallerMantis>>hash (in category 'accessing') -----
+ hash
+ 
+ 	^ array hash!

Item was changed:
+ ----- Method: Installer classSide>>view: (in category 'instanciation') -----
- ----- Method: Installer classSide>>view: (in category 'as yet unclassified') -----
  view: webPageNameOrUrl
  
+ 	| theReport |
- | theReport |
  
+ 	theReport := String streamContents: [ :report | 
- theReport := String streamContents: [ :report | 
  	(webPageNameOrUrl beginsWith: 'http://') ifTrue: [ 
+ 		self actionMatch: ('Installer installUrl: ', (webPageNameOrUrl printString),'.')  	
+ 			reportOn: report ifNoMatch: []
- 		self new urlAction: ('Installer installUrl: ', (webPageNameOrUrl printString),'.')  	
- 						 reportOn: report.
  	]
  	ifFalse: [
+ 		self actionMatch: ('Installer install: ', (webPageNameOrUrl printString),'.')  	
+ 			reportOn: report ifNoMatch: []
+ 	]].
- 		self new webAction: ('Installer install: ', (webPageNameOrUrl printString),'.')  	
- 						 reportOn: report.
- 	].
- ].
  
+ 	Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl.
- Workspace new contents: (theReport contents); openLabel: webPageNameOrUrl.
  
+ 	^theReport contents
- ^theReport contents
  !

Item was added:
+ ----- Method: Installer>>view: (in category 'public interface') -----
+ view: packageNameCollectionOrDetectBlock
+ 
+ 	self package: packageNameCollectionOrDetectBlock.
+ 	self view!

Item was changed:
+ ----- Method: Installer>>install (in category 'public interface') -----
- ----- Method: Installer>>install (in category 'accessing') -----
  install
+ 	
+ 	noiseLevel = #quiet ifTrue: [ ^ self installQuietly ].
+ 	noiseLevel = #silent ifTrue: [ ^ self installSilently ].
+ 	
+ 	^ self installLogging!
- 
- self logErrorDuring: [
- 	self mc ifNotNil: [ ^self mcInstall ].
- 	self wsm ifNotNil: [ ^self wsmInstall ].
- 	self sm ifTrue: [ ^self smInstall ].
- 	self url ifNotNil: [ ^self urlInstall ].
- 	self package ifNotNil: [ ^self webInstall ].
- ] !

Item was changed:
  ----- Method: Installer>>packages: (in category 'accessing') -----
+ packages: aCollection 
- packages: anObject
- 	"Set the value of packages"
  
+ 	packages := aCollection!
- 	packages := anObject!

Item was added:
+ ----- Method: InstallerMantis>>dataNames (in category 'public interface') -----
+ dataNames
+ 
+ 	^ #(Id Project Category Assigned Updated Status Severity FixedIn Summary)!

Item was added:
+ ----- Method: InstallerMantis>>ensureFixes: (in category 'public interface') -----
+ ensureFixes: aBugNos
+ 
+ 	aBugNos do: [ :bugNo | self ensureFix: bugNo ].!

Item was added:
+ ----- Method: InstallerWeb>>basicBrowse (in category 'basic interface') -----
+ basicBrowse
+  
+  	 self thing size > 0 
+ 		ifTrue: [ self browse: url from: pageDataStream ]
+ 		ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ].
+ 	 !

Item was added:
+ ----- Method: InstallerUniverse classSide>>classUGlobalInstaller (in category 'accessing system') -----
+ classUGlobalInstaller
+ 
+ 	^Smalltalk at: #UGlobalInstaller  ifAbsent: [ self error: 'Universes code not present' ]!

Item was added:
+ ----- Method: InstallerInternetBased>>markers: (in category 'as yet unclassified') -----
+ markers: anObject
+ 
+ 	markers := anObject!

Item was added:
+ ----- Method: InstallerMantis>>files (in category 'public interface') -----
+ 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 ]!

Item was added:
+ ----- Method: InstallerMonticello>>magma:port: (in category 'instance creation') -----
+ magma: host port: aport
+ 	
+ 	mc := (self classMCMagmaRepository new) host: host port: aport; yourself
+  !

Item was added:
+ ----- Method: InstallerUpdateStream classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'updatestream'!

Item was added:
+ ----- Method: Installer classSide>>validationBlock: (in category 'accessing') -----
+ validationBlock: aBlock
+ 
+ 	ValidationBlock := aBlock!

Item was added:
+ ----- Method: Installer classSide>>saltypickle (in category 'repositories') -----
+ saltypickle
+ 
+ 	^ self monticello http: 'squeak.saltypickle.com'!

Item was changed:
+ ----- Method: Installer>>open (in category 'public interface') -----
+ open!
- ----- Method: Installer>>open (in category 'accessing') -----
- open
- 	
- self sm ifTrue: [ self classSMLoader open ].
- self mc ifNotNil: [self mcRepository morphicOpen: nil ].!

Item was added:
+ ----- Method: Installer classSide>>web (in category 'web') -----
+ web 
+ 	^ InstallerWeb!

Item was added:
+ ----- Method: Installer classSide>>fromUrl: (in category 'url') -----
+ fromUrl: aUrl
+ 
+ 	"try and pick an Installer appropriate for the Url"
+ 	| inst | 
+ 	((aUrl endsWith: '.mcz') or: [ aUrl endsWith: '.mcm' ])
+ 	ifTrue: [ inst := Installer mc fromUrl: aUrl.
+ 		inst packages isEmpty ifFalse: [ ^ inst ]
+ 	] .
+ 	
+ 	^ Installer url: aUrl 
+ 	!

Item was changed:
  ----- Method: Installer>>search: (in category 'searching') -----
  search: aMatch
+ 	^'search type not supported'!
- 
- self sm ifTrue: [ ^ self smSearch: ('*',aMatch,'*') ].
- self mc ifTrue: [ ^ self mcSearch: ('*',aMatch,'*')  ].
- self wsm ifNotNil: [ ^ self wsmSearch: ('*',aMatch,'*')  ].
- 
- ^'search type not supported'!

Item was added:
+ ----- Method: InstallerMantis>>category (in category 'search') -----
+ category
+ 
+ 	^ self dataAtName: 'Category'
+ 	
+  "
+ s bugs collect: [ :ea | ea category ]
+ "!

Item was added:
+ ----- Method: InstallerInternetBased>>url (in category 'accessing') -----
+ url
+ 
+ 	^url!

Item was added:
+ ----- Method: Installer>>basicBrowse (in category 'basic interface') -----
+ basicBrowse!

Item was changed:
  ----- Method: Installer>>classChangeList (in category 'class references') -----
  classChangeList
  
+ 	^Smalltalk at: #ChangeList  ifAbsent: [ self error: 'ChangeList not present' ]!
- ^Smalltalk at: #ChangeList  ifAbsent: [ self error: 'ChangeList not present' ]!

Item was added:
+ ----- Method: InstallerMonticello>>classMCHttpRepository (in category 'class references') -----
+ classMCHttpRepository
+ 
+ 	^Smalltalk at: #MCHttpRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerUpdateStream>>loadUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'updates') -----
+ 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 , '.'!

Item was added:
+ ----- Method: InstallerUpdateStream>>changesetNamesFromUpdates:through: (in category 'updates') -----
+ 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]]
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: InstallerSqueakMap>>classSMSqueakMap (in category 'class references') -----
+ classSMSqueakMap
+ 
+ 	^Smalltalk at: #SMSqueakMap  ifAbsent: [ self error: 'SqueakMap not present' ]!

Item was added:
+ ----- Method: Installer>>installLogging (in category 'public interface') -----
+ installLogging
+ 
+ 	self logErrorDuring: [self basicInstall]!

Item was added:
+ ----- Method: InstallerMantis classSide>>host: (in category 'instance creation') -----
+ host: host
+ 
+ 	^self new	ma: host; 
+ 			markers: '&quot;fix begin&quot;...&quot;fix test&quot;...&quot;fix end&quot;'; 
+ 			yourself.
+ !

Item was added:
+ ----- Method: InstallerMantis>>ma (in category 'accessing') -----
+ ma
+ 
+ 	^ ma!

Item was added:
+ ----- Method: InstallerWeb>>thing (in category 'web install') -----
+ 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!

Item was added:
+ ----- Method: InstallerUniverse>>update (in category 'public interface') -----
+ update
+ 
+ 	(LastUniUpdate isNil or:[ (DateAndTime now - LastUniUpdate) > 600 seconds  ])
+ 		ifTrue: [universe requestPackageList.
+ 				LastUniUpdate := DateAndTime now]!

Item was added:
+ ----- Method: InstallerWeb classSide>>canReportLine: (in category 'action report') -----
+ canReportLine: line
+ 	^ ((line beginsWith: 'Installer install:') | (line beginsWith: 'Installer do:'))!

Item was added:
+ ----- Method: InstallerMonticello>>classMCFtpRepository (in category 'class references') -----
+ classMCFtpRepository
+ 
+ 	^Smalltalk at: #MCFtpRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: Installer>>browse:from: (in category 'mantis') -----
+ 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 ].
+ 			]!

Item was added:
+ ----- Method: InstallerMantis>>summary (in category 'search') -----
+ summary
+ 
+ 	^ self dataAtName: 'Summary'!

Item was added:
+ ----- Method: InstallerMonticello>>classMCVersionLoader (in category 'class references') -----
+ classMCVersionLoader
+ 
+ 	^Smalltalk at: #MCVersionLoader  ifAbsent: [ self error: 'Monticello not present' ]!

Item was added:
+ ----- Method: Installer>>basicInstall (in category 'basic interface') -----
+ basicInstall!

Item was added:
+ 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!

Item was added:
+ ----- Method: InstallerMantis>>getView (in category 'accessing') -----
+ 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	
+ !

Item was added:
+ ----- Method: InstallerMantis>>maStreamForFile: (in category 'mantis') -----
+ 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').
+ 	 !

Item was added:
+ ----- Method: Installer classSide>>file (in category 'file') -----
+ file
+ 
+ 	^ InstallerFile new!

Item was added:
+ ----- Method: InstallerMonticello>>classMCDirectoryRepository (in category 'class references') -----
+ classMCDirectoryRepository
+ 
+ 	^Smalltalk at: #MCDirectoryRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was changed:
+ ----- Method: Installer classSide>>mantis (in category 'mantis') -----
- ----- Method: Installer classSide>>mantis (in category 'instanciation') -----
  mantis
  
  	^ self mantis: 'http://bugs.squeak.org/'!

Item was added:
+ ----- Method: InstallerInternetBased>>markersTest (in category 'as yet unclassified') -----
+ markersTest
+ 		 	 
+ 	^ self markers readStream upToAll: '...'; upToAll: '...'!

Item was added:
+ ----- Method: Installer classSide>>canReportLine: (in category 'action report') -----
+ canReportLine: line
+ 	^ false!

Item was added:
+ ----- Method: InstallerMantis>>fixesAppliedNumbers (in category 'public interface') -----
+ fixesAppliedNumbers
+ 	^ self fixesApplied collect: [ :fixDesc | fixDesc asInteger ]. !

Item was added:
+ ----- Method: Installer classSide>>skipLoadingTestsDuring: (in category 'during') -----
+ skipLoadingTestsDuring: block
+ 
+ 	| oldValue |
+ 
+ 	oldValue := SkipLoadingTests.
+ 	SkipLoadingTests := true.
+ 	
+ 	[ block value: self ] ensure:[ SkipLoadingTests := oldValue ].!

Item was added:
+ ----- Method: InstallerMantis>>desc: (in category 'accessing') -----
+ desc: anObject
+ 
+ 	desc := anObject!

Item was added:
+ ----- Method: InstallerSake>>basicInstall (in category 'basic interface') -----
+ basicInstall
+  
+ 	self withAnswersDo: [ (self packages collect: [ :packageName | sake named: packageName ]) asTask run ].
+ 	!

Item was added:
+ ----- Method: InstallerMantis>>bug:browse: (in category 'public interface') -----
+ bug: aBugNo browse: aFileName
+ 
+ 	 self setBug: aBugNo.
+ 	^ self browseFile: aFileName!

Item was changed:
  ----- Method: Installer>>reportSection:on: (in category 'action report') -----
  reportSection: line on: report
  	
  	report isEmpty ifFalse: [ report cr ].
- 	
  	report nextPutAll: '">>>> ' ; nextPutAll: (line copyWithout: $"); nextPut: $"; cr.
  
  	!

Item was added:
+ ----- Method: Installer>>fileInSource (in category 'public interface') -----
+ fileInSource
+ 
+ 	useFileIn := true.
+ 	self install.!

Item was added:
+ ----- Method: Installer classSide>>webInstall: (in category 'web') -----
+ webInstall: webPageName
+ 
+ 	^ self web install: webPageName
+ !

Item was changed:
  ----- Method: Installer>>package: (in category 'accessing') -----
  package: anObject
- 	"Set the value of package"
  
+ 	self addPackage: anObject.!
- 	package := anObject!

Item was changed:
  ----- Method: Installer>>classMczInstaller (in category 'class references') -----
  classMczInstaller
  
+ 	^Smalltalk at: #MczInstaller ifAbsent: [ nil ]
- ^Smalltalk at: #MczInstaller ifAbsent: [ nil ]
  	!

Item was added:
+ ----- Method: InstallerMonticello>>ftp:directory:user:password: (in category 'instance creation') -----
+ 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.	
+  !

Item was added:
+ ----- Method: Installer classSide>>installSilentlyUrl: (in category 'url') -----
+ installSilentlyUrl: urlString
+ 
+ 	^ SystemChangeNotifier uniqueInstance doSilently: [ self url url: urlString; install ].
+ !

Item was added:
+ ----- Method: Installer classSide>>impara (in category 'repositories') -----
+ impara
+ 
+ 	^ self monticello http: 'source.impara.de'!

Item was added:
+ ----- Method: InstallerMantis classSide>>canReportLine: (in category 'action report') -----
+ canReportLine: line
+ 	^ line beginsWith: 'Installer mantis fixBug:'!

Item was added:
+ ----- Method: Installer classSide>>lukas (in category 'repositories') -----
+ lukas
+ 
+ 	^ self monticello http: 'http://source.lukas-renggli.ch'!

Item was changed:
  Object subclass: #Installer
+ 	instanceVariableNames: 'answers packages messagesToSuppress useFileIn noiseLevel'
+ 	classVariableNames: 'InstallerBindings IsSetToTrapErrors Remembered SkipLoadingTests ValidationBlock'
- 	instanceVariableNames: 'sm wsm mc ma url user command markers password project package bug desc answers packages messagesToSuppress pageDataStream date'
- 	classVariableNames: 'Bindings Entities Fixes IsSetToTrapErrors SkipLoadingTests WebSearchPath'
  	poolDictionaries: ''
  	category: 'Installer-Core'!
  
+ !Installer commentStamp: 'kph 3/30/2009 01:29' prior: 0!
+ Documentation now available at http://installer.pbwiki.com/Installer
+  
+ useFileIn - flag to load source.st rather than using Monticello!
- !Installer commentStamp: 'kph 1/7/2007 22:53' prior: 0!
- Installer provides a simple Domain Specific Language for installing packages from monticello and squeakmap of various version.
- 
- One design decision is to be able to paste scripts a workspace and run and tested from there without any special editing.
- 
- Installer can also be used as a squeak startup document with various commandline parameters.
- 
- example 1 (non working example)
- 
- unix$ squeak Squeak3.8-7067 http://installer.pbwiki.com/f/Installer.st Url="http://..." saveas="MyImage" postinstall=Tester done=quit
- 
- This will load installer as the startup document, installer will install a file/script from the given url, then the image will be saved in the given filename, and processing is then passed on to the class Tester, once complete the image will quit.
- 
- supported parameters:
- P|PATH=prefix1*suffix1;...;prefixN*suffixN
- I|IN|INSTALL=aPage (needs PATH)
- U|URL=aUrl
- O|OUT|SAVEAS=aFileName
- +S|SAVE
- P|TEST|POSTINSTALL=aClassName | aPage(given PATH) | aUrl
- DONE= save | quit | save&quit | aClassName
- +SKIPTESTS
- 
- example 2: (working example)
- 
- unix$ squeak Squeak3.8-7067 http://installer.pbwiki.com/f/Installer.st path=wiki.squeak.org/squeak/;installer.pbwiki.com/*-alt in=CommandLineExample2 done=quit.
- 
- ===
- Examples - Using SqueakMap
- 
- 1)
- squeakmap := Installer squeakmap.
- squeakmap install: 'DynamicBindings'.
- squeakmap open. "opens the squeak map loader gui"
- 2)
- Installer squeakmap install: 'DynamicBindings'.
- 
- 3) Alternatively using websqueakmap which uses http (similar usage api to squeakmap)
- squeakmap := Installer websqueakmap.
- squeakmap package: 'DynamicBindings'; install.
- 
- 4) Abbreviated instanciation
- squeakmap := Installer sm. "squeakmap"
- squeakmap := Installer wsm. "web-squeakmap"
- 
- 5) Finding Packages by Name
- (Installer sm match: 'Labby*') explore.
- 
- 6) Obtaining List of Package Versions
- (Installer sm package: 'Labby & Walker'; versions)  explore.  
- 
- 6) Searching Packages
- Installer sm search: 'seaside'.
- Installer sm search: 'author:*Smith'. 
- "fields available for searching: author: name:, summary:,description:"
- 
- 7) Specify specific version of a package for installation
- Installer sm install: 'Labby(17)'.
- 
- Examples - Using Monticello
- 1)
- squeaksource := Installer repository: 'http://www.squeaksource.com'.
- seaside := squeaksource project: 'Seaside'.
- seaside install: 'Comet-lr.8';
- 		install: 'Scriptaculous'.
- 2) 
- squeaksource := Installer repository: 'http://www.squeaksource.com'		
- squeaksource project: 'Seaside';
- 			  install: 'Comet-lr.8;
- 			  install: 'Scriptaculous'.
- 3) Supplying user/password.
- squeaksource := Installer repository: 'http://www.squeaksource.com'.
- squeaksource user: 'me'; password: 'asecret'.
- 
- 4) Abbreviated instanciation for convenience.
- squeaksource := Installer squeakSource.
- or
- squeaksource := Installer ss.
- 
- Examples - install straight from a url		
- 1a)
- (Installer url: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/MakeTestsGreen39.cs') install.
- 1b)
- Installer installUrl: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/MakeTestsGreen39.cs'.
- 
- 2)
- | page |
- page := Installer url: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/'.
- page package: 'MakeTestsGreen39.cs'.
- page install.
- 
- 3)
- In html page scripts are delimited by <code st>...</code st>
- | page |
- page := Installer url: 'http://wiki.squeak.org/squeak/742'.
- page install.
- 4)
- specify your own delimeters
- | page |
- page := Installer url: 'http://wiki.squeak.org/742'.
- page markers: 'beginning of script...end of script'.
- page install.
- 
- Note: Scripts embedded in html or a swiki page may need to escape some entities.
- Supported entities are &amp; &gt; &lt; &star; &quot; (see Installer-c-entities)
- 
- Examples - Using Mantis
- 1 . Viewing a file uploaded to a mantis bug report
- 
- Installer mantis bug: 4874 view: 'Join.4.cs'.
- 
- 1. Installing a file uploaded to a mantis bug report
- Installer mantis bug: 4874 fix: 'Join.4.cs'.
- 
- 2. as above, inform user if bug report has been updated since a given date 
- Installer mantix	bug: 4874 fix: 'JoinTest.1.cs' date: '12-18-06'. 
- 	
- 3. Install or view a fix for a given bug.
- 
- Installer mantis viewBug: 4874.
- Installer mantis fixBug: 4874.
- 
- The fix script is published in a note added to the bug report page with the following syntax
- 
- "fix begin"
-  Installer mantis bug: 474 fix: 'Join.4.cs'.
- "fix test"
-  Installer mantis bug: 474 fix: 'JoinTest.1.cs' date: '12-18-06'. 
- "fix end"
- 
- 4. Install a fix for a given bug, ignoring all test code
- (test code being delimeted by: "fix test" ... "fix end" )
- 
- Installer mantis justFixBug: 474.
- or
- Installer mantis justFixBug: 474 date: '12-19-06'.
- 
- 
- 
- !

Item was added:
+ Installer subclass: #InstallerUniverse
+ 	instanceVariableNames: 'universe'
+ 	classVariableNames: 'LastUniUpdate'
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: Installer>>mcThing:from: (in category 'mantis') -----
+ mcThing: aFileName from: stream
+ 		
+ 	"dont use monticello for .cs or for .st use monticello for .mcs"
+ 
+ 	| reader |
+ 	
+ 	useFileIn ifTrue: [ ^ nil ].
+ 	
+ 	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  ].!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>packagesMatching: (in category 'searching') -----
+ packagesMatching: aMatch
+ 	^ (self availablePackages
+ 		select: [ :p | ( aMatch) match: p ]) 
+ 		collect: [ :p | self copy package: p ; yourself ]!

Item was added:
+ Installer subclass: #InstallerFile
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ Installer subclass: #InstallerSake
+ 	instanceVariableNames: 'sake'
+ 	classVariableNames: 'Sake'
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerMantis>>ensureFix (in category 'public interface') -----
+ ensureFix
+ 
+ 	| fixesAppliedNumbers |
+ 	
+ 	fixesAppliedNumbers := self fixesApplied collect: [ :fixDesc | fixDesc asInteger ].
+ 	(fixesAppliedNumbers includes: bug) ifFalse: [ self fixBug ]!

Item was added:
+ ----- Method: InstallerMonticello>>goods:port: (in category 'instance creation') -----
+ goods: host port: aport
+ 	
+ 	mc := (self classMCGOODSRepository new) host: host port: aport; yourself
+  !

Item was changed:
+ ----- Method: Installer classSide>>squeaksource (in category 'repositories') -----
- ----- Method: Installer classSide>>squeaksource (in category 'instanciation-abbreviated') -----
  squeaksource
  
+ 	^ self monticello http: 'http://www.squeaksource.com'!
- ^self repository: 'http://www.squeaksource.com'!

Item was added:
+ ----- Method: InstallerWebSqueakMap classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'websqueammap'!

Item was added:
+ ----- Method: Installer>>browseCS:from: (in category 'mantis') -----
+ browseCS: aFileName from: stream
+  	
+ 	| list |
+ 	
+ 	list := self classChangeList new
+ 			scanFile: stream from: 1 to: stream size.
+ 		 
+ 	self classChangeList open: list name: aFileName
+ 		multiSelect: true.
+ !

Item was added:
+ ----- Method: InstallerInternetBased>>replaceEntitiesIn: (in category 'url') -----
+ 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!

Item was added:
+ ----- Method: InstallerMonticello classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'monticello'!

Item was added:
+ ----- Method: InstallerMantis>>fixedIn (in category 'search') -----
+ fixedIn
+ 
+ 	^ self dataAtName: 'FixedIn'
+ !

Item was changed:
+ ----- Method: Installer classSide>>cancelSkipLoadingTests (in category 'accessing') -----
- ----- Method: Installer classSide>>cancelSkipLoadingTests (in category 'as yet unclassified') -----
  cancelSkipLoadingTests
+ 	"sets a flag to un-ignore loading of the testing portion of scripts embedded in pages"
+ 	
+ 	SkipLoadingTests := false.
- 
- "sets a flag to un-ignore loading of the testing portion of scripts embedded in pages"
- SkipLoadingTests := false.
   !

Item was added:
+ ----- Method: InstallerMonticello>>label (in category 'accessing') -----
+ label
+ 	^ 'repository:''', mc description, ''''!

Item was added:
+ ----- Method: Installer>>rememberAs: (in category 'custom names') -----
+ rememberAs: symbol
+ 
+ 	self class remembered at: symbol asSymbol put: self!

Item was added:
+ ----- Method: InstallerCruft>>evaluate: (in category 'mantis') -----
+ evaluate: stream
+ 
+ 	stream fileIn.!

Item was added:
+ ----- Method: InstallerUpdateStream>>writeList:toStream: (in category 'updates') -----
+ 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!

Item was added:
+ ----- Method: InstallerUniverse>>basicInstall (in category 'basic interface') -----
+ 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!

Item was added:
+ ----- Method: InstallerWeb classSide>>initialize (in category 'instanciation') -----
+ initialize
+ 	
+ 	WebSearchPath := nil!

Item was added:
+ ----- Method: InstallerMonticello>>unload (in category 'public interface') -----
+ unload 
+ 
+ 	(MCWorkingCopy allManagers select: [ :wc | self package match: (wc package name) ])
+ 		 do: [ :wc | 
+  			 	self logCR: 'Unloading ', wc package asString.
+  				wc unload.].
+ 	self unloadCleanUp!

Item was changed:
+ ----- Method: Installer classSide>>sm (in category 'squeakmap') -----
- ----- Method: Installer classSide>>sm (in category 'instanciation-abbreviated') -----
  sm
  
+ 	^ self squeakmap!
- ^self squeakmap!

Item was changed:
+ ----- Method: Installer classSide>>url: (in category 'url') -----
- ----- Method: Installer classSide>>url: (in category 'accessing') -----
  url: urlString
  
+ 	^self url url: urlString; yourself!
- ^self new url: urlString; yourself!

Item was added:
+ ----- Method: InstallerMantis>>justFixBug:date: (in category 'public interface') -----
+ justFixBug: aBugNo date: d
+ 
+ 	^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: d ]!

Item was added:
+ ----- Method: InstallerMonticello>>classMCSmtpRepository (in category 'class references') -----
+ classMCSmtpRepository
+ 
+ 	^Smalltalk at: #MCSmtpRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerMantis>>fixBug:date: (in category 'public interface') -----
+ fixBug: aBugNo date: aDate
+ 
+ 	self setBug: aBugNo.
+  	self date: aDate.
+ 	self fixBug.
+ 	
+ !

Item was added:
+ ----- Method: InstallerMantis>>desc (in category 'accessing') -----
+ desc
+ 	 
+ 	^ desc!

Item was added:
+ ----- Method: InstallerMantis>>viewFile: (in category 'public interface') -----
+ viewFile: aFileName
+ 	"Installer mantis bug: 6089 browse: 'TTFSpeedUp-dgd.1.cs'"
+ 	
+ 	^ self view: aFileName from: (self maThing: aFileName date: nil)!

Item was changed:
  ----- Method: Installer>>suppress: (in category 'auto answering') -----
  suppress: aMessage
  
+ 	messagesToSuppress add: aMessage!
- messagesToSuppress add: aMessage!

Item was changed:
+ ----- Method: Installer classSide>>installUrl: (in category 'url') -----
- ----- Method: Installer classSide>>installUrl: (in category 'as yet unclassified') -----
  installUrl: urlString
  
+ 	^ self url url: urlString; install.
- ^ (self url: urlString) install.
  !

Item was changed:
+ ----- Method: Installer classSide>>mantis: (in category 'mantis') -----
- ----- Method: Installer classSide>>mantis: (in category 'instanciation') -----
  mantis: host
  
+ 	^ InstallerMantis host: host!
- ^self new	ma: host; 
- 			markers: '&quot;fix begin&quot;...&quot;fix test&quot;...&quot;fix end&quot;'; 
- 			yourself.
- !

Item was added:
+ ----- Method: InstallerInternetBased>>url: (in category 'accessing') -----
+ url: aUrl
+  
+ 	url := aUrl!

Item was added:
+ ----- Method: InstallerMantis>>viewBug: (in category 'public interface') -----
+ viewBug: aBugNo
+ 
+ 	self setBug: aBugNo; view!

Item was added:
+ ----- Method: Installer>>addPackage: (in category 'public interface') -----
+ addPackage: anObject
+ 
+ 	self packages add: anObject!

Item was added:
+ ----- Method: InstallerInternetBased>>urlGet: (in category 'url') -----
+ 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
+ 	!

Item was changed:
  ----- Method: Installer>>answers: (in category 'accessing') -----
  answers: anObject
- 	"Set the value of answers"
  
  	answers := anObject!

Item was added:
+ ----- Method: Installer>>initialize (in category 'public interface') -----
+ initialize
+ 
+ 	useFileIn := false..!

Item was added:
+ ----- Method: InstallerInternetBased>>httpGet: (in category 'utils') -----
+ httpGet: aUrl
+ 
+ 	| page |
+ 	page := self classHTTPSocket httpGet: aUrl accept: 'application/octet-stream'.  
+  
+ 	(page respondsTo: #reset)  ifFalse: [ self error: 'unable to contact web site' ].
+ 	^ page
+ 	!

Item was added:
+ ----- Method: Installer>>view:from: (in category 'mantis') -----
+ view: aFileName from: stream
+ 	
+ 	self log: ' viewing...'.
+  	
+ 	Workspace new contents: (stream contents); openLabel: aFileName.
+  
+ 	 
+ 
+ 				 !

Item was added:
+ ----- Method: Installer>>browseGZ:from: (in category 'mantis') -----
+ 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
+ 	!

Item was added:
+ ----- Method: Installer classSide>>remembered (in category 'custom names') -----
+ remembered
+ 
+ 	^	Remembered ifNil: [ Remembered := IdentityDictionary new ]!

Item was added:
+ ----- Method: Installer classSide>>launchFrom: (in category 'launcher support') -----
+ launchFrom: launcher
+ 
+ 	^self launchWith: launcher getParameters!

Item was added:
+ ----- Method: InstallerMantis>>project (in category 'search') -----
+ project
+ 
+ 	^ self dataAtName: 'Project'
+ !

Item was added:
+ ----- Method: InstallerWebSqueakMap>>basicView (in category 'basic interface') -----
+ basicView
+ 	
+ 	| it |
+ 	it := self wsmThing.
+ 	self view: it from: (self httpGet: it).
+ 
+ 	!

Item was added:
+ ----- Method: InstallerMonticello>>packagesMatching: (in category 'searching') -----
+ packagesMatching: aMatch
+ 	^ (self availablePackages
+ 		select: [:p | ( aMatch , '.mcz' ) match: p])
+ 		collect: [:p | self copy package: p ; yourself]!

Item was added:
+ ----- Method: InstallerSake classSide>>classPackages (in category 'accessing system') -----
+ classPackages
+ 
+ 	^Smalltalk at: #Packages  ifAbsent: [ self error: 'Sake Packages code not present' ]!

Item was added:
+ ----- Method: InstallerCruft>>createRBforBug: (in category 'mantis') -----
+ createRBforBug: aBugNo 
+ 	| aStream  fileList selFile aFileName suffix |
+ 
+ 	self setBug: aBugNo.
+ fileList := self maFiles keys asOrderedCollection.
+ fileList  addLast: 'none'.
+ (Smalltalk classNamed: #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 .suffix := (FileDirectory extensionFor: aFileName) asLowercase.
+ 	
+ 	suffix caseOf:
+ 	{
+ ['gz'] -> [self installGZ: aFileName from: aStream ].
+ ['cs' ] -> [self installCS: aFileName from: aStream].
+ ['st' ] -> [self installCS: aFileName from: aStream].
+ ['mcz' ] -> [self installMCZ: aFileName from: aStream ].
+ ['sar'] -> [self installSAR: aFileName from: aStream ].
+ }otherwise: [Error].
+ ].selFile = fileList size]whileFalse.
+ 	
+ 	
+ 	
+ 	(Smalltalk classNamed: #ReleaseBuilderFor3dot10) current newUpdateFor: aBugNo
+ 	
+ 	
+ 	!

Item was added:
+ ----- Method: InstallerMonticello>>mc (in category 'accessing') -----
+ mc
+ 
+ 	^ mc!

Item was added:
+ ----- Method: InstallerUrl>>action:reportOn: (in category 'action report') -----
+ 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 !

Item was added:
+ ----- Method: InstallerWebSqueakMap>>basicVersions (in category 'basic interface') -----
+ 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 asSet.
+ 	versions remove: #latest.
+ 	^ versions collect: [ :version | self copy package: (packageName,'(', version ,')'); yourself ]. !

Item was added:
+ ----- Method: InstallerMonticello>>basicVersions (in category 'basic interface') -----
+ basicVersions
+ 
+ 	^ (self availablePackages select: [ :p | ( self package,'-*.mcz' ) match: p ]) collect: [ :p | self copy package: p  ; yourself ].
+  !

Item was added:
+ ----- Method: InstallerWebSqueakMap>>basicAvailablePackages (in category 'websqueakmap') -----
+ 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	
+ 	!

Item was added:
+ ----- Method: Installer classSide>>monticello (in category 'monticello') -----
+ monticello
+ 
+ 	^ InstallerMonticello new!

Item was added:
+ ----- Method: InstallerMantis>>in:row: (in category 'public interface') -----
+ in: parent row: dataRow
+ 
+ 	self ma: parent ma.
+ 	self markers: parent markers.
+ 	self setArray: dataRow.!

Item was added:
+ ----- Method: Installer>>silently (in category 'public interface') -----
+ silently
+ 
+ 	noiseLevel := #silent!

Item was added:
+ ----- Method: InstallerSqueakMap classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'squeakmap'!

Item was added:
+ ----- Method: Installer>>removeChangeSet: (in category 'utils') -----
+ removeChangeSet: cs
+ 
+ 	(self classChangeSet respondsTo: #removeChangeSet:)
+ 		ifTrue: [ ^ChangeSet removeChangeSet: cs ].
+ 		
+ 	^ self classChangeSorter removeChangeSet: cs .!

Item was changed:
  ----- Method: Installer>>classSARInstaller (in category 'class references') -----
  classSARInstaller
  
+ 	^Smalltalk at: #SARInstaller  ifAbsent: [ self error: 'SARInstaller not present' ]!
- ^Smalltalk at: #SARInstaller  ifAbsent: [ self error: 'SARInstaller not present' ]!

Item was added:
+ ----- Method: InstallerMantis>>bug:fix: (in category 'public interface') -----
+ bug: aBugNo fix: aFileName
+ 
+ 	^ self bug: aBugNo fix: aFileName date: nil!

Item was added:
+ ----- Method: InstallerMonticello>>classMCGOODSRepository (in category 'class references') -----
+ classMCGOODSRepository
+ 
+ 	^Smalltalk at: #MCGOODSRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerMantis>>maUrlFor: (in category 'mantis') -----
+ maUrlFor: maBugNo
+  
+ 	^ url := self ma, 'view.php?id=', maBugNo asString 
+  !

Item was added:
+ ----- Method: InstallerUpdateStream>>updateDirectoryOrNil (in category 'updates') -----
+ updateDirectoryOrNil
+ 
+ 	^ (FileDirectory default directoryNames includes: 'updates')
+ 		ifTrue: [FileDirectory default directoryNamed: 'updates']
+ 		ifFalse: [self inform: 'Error: cannot find "updates" folder'.
+ 				nil]!

Item was changed:
  ----- Method: Installer>>classChangeSorter (in category 'class references') -----
  classChangeSorter
  
+ 	^Smalltalk at: #ChangeSorter ifAbsent: [ self error: 'ChangeSorter not present' ]!
- ^Smalltalk at: #ChangeSorter ifAbsent: [ self error: 'ChangeSorter not present' ]!

Item was added:
+ ----- Method: InstallerUrl>>urlToDownload (in category 'url') -----
+ urlToDownload
+ 
+ 	^ (self url, (self package ifNil: [ '' ])) asUrl asString.
+ 	
+  !

Item was changed:
+ ----- Method: Installer classSide>>webSearchPath (in category 'web') -----
- ----- Method: Installer classSide>>webSearchPath (in category 'accessing') -----
  webSearchPath
+ 	"a search path item, has the following format. prefix*suffix"
  
+ 	^ self web searchPath!
- "a search path item, has the following format. prefix*suffix"
- 
- ^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].!

Item was added:
+ ----- Method: InstallerMantis>>bugFilesView: (in category 'public interface') -----
+ bugFilesView: aBugNo
+  	"provide a list of files associated with the bug in id order"
+ 	"
+ 	Installer mantis bugFiles: 6660.
+ 	"
+ 	self setBug: aBugNo; viewFiles!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>wsmThing (in category 'websqueakmap') -----
+ wsmThing
+ 
+ 	| downloadUrl |
+ 	self logCR: 'finding ', self package, ' from websqueakmap(', self wsm, ') ...'.
+ 	downloadUrl := self wsmDownloadUrl.
+ 	self logCR: 'found at ', downloadUrl asString, ' ...'.
+ 	^ downloadUrl
+ 	!

Item was changed:
  ----- Method: Installer>>installDefault:from: (in category 'mantis') -----
  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]
+ !
- 
- stream fileIn.!

Item was added:
+ ----- Method: InstallerMonticello>>basicView (in category 'basic interface') -----
+ 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.
+ !

Item was added:
+ ----- Method: InstallerCruft classSide>>classProjectLauncher (in category 'accessing system') -----
+ classProjectLauncher
+ 
+ 	^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!

Item was added:
+ ----- Method: InstallerCruft>>info (in category 'accessing') -----
+ info
+ 
+ 	self sm ifTrue: [ ^ self smInfo  ].
+ 	self wsm ifNotNil: [ ^ self wsmInfo  ].!

Item was added:
+ ----- Method: InstallerCruft>>preambleCsForRB: (in category 'mantis') -----
+ preambleCsForRB: aBugNo
+ "
+ Installer mantis preambleCsForRB: 5936.
+ "
+ 	| page text   | 
+ 
+ 	self setBug: aBugNo.
+ 	
+ 	page := self maPage.
+  
+ 	text := String streamContents: [ :str |	
+ 			
+ 		#('Reporter'  'Summary' 'Description' 'Additional Information' ) 
+ 				do: [ :field |
+ 						| f |
+ 						f := self maRead: page field: field.
+ 			str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr.
+ 		]
+ 	].
+  	
+ ^ text	!

Item was added:
+ ----- Method: Installer classSide>>sophie (in category 'repositories') -----
+ sophie
+ 
+ 	^ self monticello http: 'source.sophieproject.org'
+ 	
+ !

Item was added:
+ ----- Method: InstallerMonticello>>unloadCleanUp (in category 'public interface') -----
+ 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.!

Item was changed:
  ----- Method: Installer>>validChangeSetName: (in category 'url') -----
  validChangeSetName: aFileName
  	" dots in the url confuses the changeset loader. I replace them with dashes"
+ 	
+  	(aFileName beginsWith:'http:') ifTrue: [ | asUrl |
-  	self url ifNotNil: [ | 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!

Item was added:
+ ----- Method: InstallerFile classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'file'!

Item was added:
+ ----- Method: InstallerMantis classSide>>initialize (in category 'instance creation') -----
+ 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 !

Item was added:
+ ----- Method: Installer classSide>>bug:fix: (in category 'mantis') -----
+ 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!

Item was added:
+ ----- Method: Installer classSide>>file: (in category 'file') -----
+ file: fileName
+  
+ 	^ InstallerFile new file: fileName; yourself
+ !

Item was added:
+ ----- Method: InstallerCruft classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'cruft'!

Item was added:
+ ----- Method: InstallerMantis>>bugsClosed (in category 'search') -----
+ bugsClosed
+ 
+ 	^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]!

Item was added:
+ ----- Method: InstallerSqueakMap>>packagesMatching: (in category 'searching') -----
+ packagesMatching: aMatch
+ 	^ (self availablePackages
+ 		select: [ :p | aMatch match: p name ]) 
+ 		collect: [ :p | self copy package: p name; yourself ]!

Item was added:
+ ----- Method: InstallerMonticello>>open (in category 'public interface') -----
+ open
+ 	self mc morphicOpen: nil!

Item was added:
+ 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 <ken at kencausey.com>
+ 
+ Installer mantis bugsAll select: [ :ea | ea status = 'testing' ].!

Item was added:
+ ----- Method: InstallerMonticello>>basicAvailablePackages (in category 'basic interface') -----
+ basicAvailablePackages
+ 	^ self mc allFileNames!

Item was changed:
  ----- Method: Installer>>isSkipLoadingTestsSet (in category 'accessing') -----
  isSkipLoadingTestsSet
  
+ 	^SkipLoadingTests ifNil: [ false ]!
- ^SkipLoadingTests ifNil: [ false ]!

Item was changed:
  ----- Method: Installer>>install:from: (in category 'mantis') -----
  install: aFileName from: stream
  
+ | ext installSelector mcThing |
- | ext installSelector |
  	 
+ 	self log: ' installing...'.
- 	self log: 'installing...'.
   
- 	ext := aFileName copyAfterLast: $..
- 	installSelector := ('install', ext asUppercase, ':from:') asSymbol.
- 	
  	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.
+ 	
+ 				useFileIn ifTrue: [ 
+ 				[
+ 					SystemChangeNotifier uniqueInstance doSilently: [self install: aFileName from: stream using: installSelector ]] 
+ 						on: Warning do: [ :ex | ex resume: true ].
+ 				] ifFalse: [
+ 					self install: aFileName from: stream using: installSelector. 
+ 				]
+ 			]
- 		(self respondsTo: installSelector)
- 			ifTrue: [ self perform: installSelector with: aFileName with: stream ]
- 			ifFalse: [ self installDefault: aFileName from: stream ].
  	]. 
  
+ 	self log: ' done.'
+ !
- 	self log: '.done'
-  !

Item was added:
+ ----- Method: InstallerMonticello>>fromUrl: (in category 'accessing') -----
+ 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 ].!

Item was added:
+ ----- Method: InstallerMonticello>>mcThing (in category 'monticello') -----
+ mcThing
+ 
+ 	| loader files fileToLoad  version  count |
+ 
+ 	loader := self classMCVersionLoader new.
+ 	
+ 	count := 0. files := nil.
+ 	self logCR: 'reading ', mc description, '...'.
+ 		"several attempts to read files - repository readableFileNames sometimes fails"
+ 	[ count := count + 1.
+ 	 (files = nil) and:[ count < 5 ] ] 
+ 		whileTrue: [files := mc readableFileNames asSortedCollection: self mcSortFileBlock ].
+ 	files ifNil: [  Warning signal: 'Repository not readable: ', mc description. ^ nil  ].
+ 		
+ 	self packages do: [ :pkg |
+ 
+ 		self log: 'finding ', pkg asString, '...'.
+ 		
+ 		fileToLoad := files detect: (self mcDetectFileBlock: pkg) ifNone: [ 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 logCR: ' found ', version fileName, '...'.
+ 	].
+ 
+ 	^ loader!

Item was added:
+ ----- Method: InstallerMantis>>validChangeSetName: (in category 'action report') -----
+ validChangeSetName: aFileName
+ 
+ 	| csn prefix |
+ 
+ 	csn := super validChangeSetName: aFileName.
+ 	prefix := 'M' , self bug asInteger asString.
+ 
+ 	csn := csn replaceAll: ('-', prefix) with: ''.
+ 	csn := csn replaceAll: (prefix,'-') with: ''.
+ 	csn := csn replaceAll: prefix with: ''.
+ 	
+ 	^ prefix, '-', csn 	
+ 	!

Item was added:
+ ----- Method: Installer classSide>>validationBlock (in category 'accessing') -----
+ validationBlock
+ 
+ 	^ ValidationBlock!

Item was added:
+ ----- Method: InstallerMantis>>report (in category 'public interface') -----
+ 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	
+ !

Item was added:
+ ----- Method: InstallerSqueakMap>>basicVersions (in category 'basic interface') -----
+ basicVersions
+  
+ 	^ (self smReleasesForPackage: self package) 
+ 			collect: [ :v | self copy package: (v package name,'(',v version,')'); yourself. ] 
+ 
+  !

Item was added:
+ ----- Method: InstallerMantis>>status (in category 'accessing') -----
+ status 
+ 
+ 	^ status!

Item was added:
+ Installer subclass: #InstallerInternetBased
+ 	instanceVariableNames: 'url pageDataStream markers'
+ 	classVariableNames: 'Entities'
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerMantis>>dataClosed (in category 'search') -----
+ dataClosed
+ 
+ 	^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?closed' ]!

Item was changed:
  ----- Method: Installer>>messagesToSuppress: (in category 'accessing') -----
  messagesToSuppress: anObject
- 	"Set the value of messagesToSuppress"
  
  	messagesToSuppress := anObject!

Item was added:
+ ----- Method: InstallerMonticello>>directory: (in category 'instance creation') -----
+ directory: dir
+ 
+ 	| directory |
+ 	directory := dir isString 
+ 		ifTrue: [  FileDirectory on: (FileDirectory default fullNameFor: dir) ]
+ 		ifFalse: [ dir ].
+ 		
+ 	mc := self classMCDirectoryRepository new directory: directory; yourself.
+  	root := dir
+ 	
+  !

Item was added:
+ ----- Method: InstallerMantis>>bugsSqueak (in category 'search') -----
+ bugsSqueak
+ 
+ 	^ array ifNil: [ array := self dataGetFrom: '/installer_export.php?project=Squeak' ]
+ 	
+ "
+ Installer mantis bugsSqueak.
+ Installer mantis bugsAll.
+ Installer mantis bugsClosed.
+ 
+ "!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>basicInstall (in category 'basic interface') -----
+ basicInstall
+ 	
+ 	| it |
+ 	it := self wsmThing.
+ 	self install: it from: it asUrl retrieveContents contentStream.
+ 
+ 	!

Item was changed:
  ----- Method: Installer>>logErrorDuring: (in category 'logging') -----
  logErrorDuring: block
  
+ 	(IsSetToTrapErrors = true) ifFalse: [ ^ block value ].
- (IsSetToTrapErrors == false) ifTrue: [ ^ 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 ]]]!
- block on: Error do: [ :e | self logCR: e messageText. ]!

Item was added:
+ ----- Method: InstallerMonticello>>basicInstall (in category 'basic interface') -----
+ basicInstall
+ 	 
+ 	self withAnswersDo: [ self mcThing load ].
+ 	self logCR: 'loaded'.
+ !

Item was changed:
  ----- Method: Installer>>package (in category 'accessing') -----
  package
- 	"Answer the value of package"
  
+ 	^ self packages isEmpty ifTrue: [ nil ] ifFalse: [ self packages last ]!
- 	^ package!

Item was added:
+ ----- Method: InstallerMantis>>fixesApplied (in category 'public interface') -----
+ fixesApplied
+ 
+ 	^ Fixes ifNil: [ Fixes := OrderedCollection new ].!

Item was added:
+ ----- Method: InstallerMonticello>>classMCMagmaRepository (in category 'class references') -----
+ classMCMagmaRepository
+ 
+ 	^Smalltalk at: #MCMagmaRepository ifAbsent: [ self error: 'Magma not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerInternetBased>>markersEnd (in category 'as yet unclassified') -----
+ 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 ]
+ 	!

Item was changed:
+ ----- Method: Installer classSide>>ss (in category 'repositories') -----
- ----- Method: Installer classSide>>ss (in category 'instanciation-abbreviated') -----
  ss
  
+ 	^ self squeaksource
- ^self squeaksource
   !

Item was added:
+ ----- Method: InstallerSqueakMap>>update (in category 'squeakmap') -----
+ 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!

Item was added:
+ ----- Method: InstallerUrl>>label (in category 'accessing') -----
+ label
+ 	^ 'url:''', url, ''''!

Item was added:
+ ----- Method: Installer classSide>>actionMatch:reportOn:ifNoMatch: (in category 'action report') -----
+ 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!

Item was added:
+ ----- Method: Installer>>browse (in category 'public interface') -----
+ browse
+ 	self logErrorDuring: [self basicBrowse]!

Item was added:
+ ----- Method: InstallerUrl classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'url'!

Item was added:
+ ----- Method: Installer classSide>>wiresong (in category 'repositories') -----
+ wiresong
+ 
+ 	^ self monticello http: 'http://source.wiresong.ca'!

Item was changed:
+ ----- Method: Installer classSide>>wsm (in category 'websqueakmap') -----
- ----- Method: Installer classSide>>wsm (in category 'instanciation-abbreviated') -----
  wsm
  
+ 	^ self websqueakmap!
- ^self websqueakmap!

Item was added:
+ ----- Method: Installer>>browseDefault:from: (in category 'mantis') -----
+ browseDefault: aFileName from: stream
+ 
+ 	self view: aFileName from: stream!

Item was added:
+ ----- Method: InstallerMantis>>= (in category 'accessing') -----
+ = other
+ 
+ 	^ array = other array!

Item was changed:
+ ----- Method: Installer classSide>>websqueakmap: (in category 'websqueakmap') -----
- ----- Method: Installer classSide>>websqueakmap: (in category 'as yet unclassified') -----
  websqueakmap: host
  
+ 	^ InstallerWebSqueakMap new wsm: host; yourself!
- ^self new wsm: host; yourself!

Item was added:
+ ----- Method: InstallerSqueakMap>>basicView (in category 'basic interface') -----
+ basicView
+ 
+ 	self smThing explore!

Item was added:
+ ----- Method: InstallerInternetBased>>extractFromHtml:option: (in category 'as yet unclassified') -----
+ 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
+ 	 
+ !

Item was added:
+ InstallerWebBased subclass: #InstallerWebSqueakMap
+ 	instanceVariableNames: 'wsm'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ InstallerInternetBased subclass: #InstallerUrl
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>wsmReleasesFor: (in category 'websqueakmap') -----
+ 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
+ 	!

Item was added:
+ ----- Method: InstallerWeb>>action:reportOn: (in category 'action report') -----
+ 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 !

Item was added:
+ ----- Method: InstallerCruft>>classMCMczReader (in category 'class references') -----
+ classMCMczReader
+ 
+ 	^Smalltalk at: #MCMczReader ifAbsent: [ nil ]
+ 	!

Item was added:
+ ----- Method: InstallerCruft classSide>>classes (in category 'accessing system') -----
+ classes
+ 
+ 	^ Smalltalk!

Item was added:
+ ----- Method: InstallerMonticello>>basicBrowse (in category 'basic interface') -----
+ basicBrowse
+ 	 "Installer ss project: 'Installer'; browse: 'Installer-Core'."
+ 
+ 	| it |
+ 	it := self mcThing.
+ 	
+ 	(it class includesSelector: #browse) ifTrue: [ ^ it browse ].
+ 	
+ 	(it instVarNamed: 'versions') do: #browse.!

Item was changed:
  ----- Method: Installer>>ditchOldChangeSetFor: (in category 'utils') -----
  ditchOldChangeSetFor: aFileName 
  
+ 	| changeSetName changeSet |
+  	changeSetName := (self validChangeSetName: aFileName) sansPeriodSuffix.
+ 	changeSet := self changeSetNamed: changeSetName.
+ 	
+ 	changeSet ifNotNil: [
+ 		
+ 		(self logCR:'Removing old change set ', changeSetName) cr.
+ 		self  removeChangeSet: changeSet 
+ 	].!
- 	| changeSetName |
-  
- 	changeSetName := (self validChangeSetName: aFileName) sansPeriodSuffix.
- 
- 
- 	(self classChangeSet named: changeSetName)
- 		ifNotNil: [  	
- 				(self logCR:'Removing old change set ', changeSetName) cr.
- 				self classChangeSet removeChangeSet: (self classChangeSet named: changeSetName) ].!

Item was added:
+ ----- Method: Installer>>changeSetNamed: (in category 'utils') -----
+ changeSetNamed: aName
+ 
+ 	(ChangeSet respondsTo: #named:)
+ 		ifTrue: [ ^ ChangeSet named: aName ].
+ 		
+ 	^ ChangeSorter changeSetNamed: aName.!

Item was added:
+ ----- Method: InstallerMantis>>maScript (in category 'mantis') -----
+ maScript 
+ 
+ 	^self extractFromHtml: self maPage option: #last
+ !

Item was added:
+ ----- Method: Installer classSide>>privateUpgradeTheRest (in category 'instanciation') -----
+ privateUpgradeTheRest
+ 
+ 	Installer ss project: 'Installer'; 
+ 		installQuietly: 'Installer-Scripts';
+ 		installQuietly: 'Installer-Formats'..
+ 		
+ 	^ self!

Item was added:
+ ----- Method: InstallerMantis>>dataGetFrom: (in category 'public interface') -----
+ 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 
+ "!

Item was added:
+ ----- Method: InstallerCruft classSide>>mczInstall: (in category 'documentation') -----
+ mczInstall: urlOrFile
+ 
+ 	^ self new mczInstall: urlOrFile
+ !

Item was added:
+ ----- Method: InstallerCruft>>mczInstall: (in category 'monticello') -----
+ mczInstall: urlOrFile
+ 
+ 	self log: ('Loading ', urlOrFile, ' ...').
+ 
+ 	(urlOrFile beginsWith: 'http:')
+ 		ifTrue: [  MczInstaller installStream: (HTTPSocket httpGet: urlOrFile) ]
+ 		ifFalse: [ MczInstaller installFileNamed: urlOrFile ].
+ 		
+ 	self logCR: ' Loaded'.
+ 
+ 	
+ 
+ !

Item was added:
+ ----- Method: InstallerCruft classSide>>classSakePackages (in category 'accessing system') -----
+ classSakePackages
+ 
+ 	^Smalltalk at: #SakePackages  ifAbsent: [ self error: 'Sake Packages code not present' ]!

Item was added:
+ ----- Method: InstallerSqueakMap>>open (in category 'public interface') -----
+ open
+ 	self classSMLoader open!

Item was added:
+ ----- Method: Installer>>printConfigurationOn: (in category 'printing') -----
+ printConfigurationOn: stream
+ 	!

Item was added:
+ ----- Method: InstallerSqueakMap>>basicAvailablePackages (in category 'basic interface') -----
+ basicAvailablePackages
+ 	
+ 	^self classSMSqueakMap default packagesByName!

Item was added:
+ ----- Method: InstallerSqueakMap>>search: (in category 'searching') -----
+ 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
+ 
+ !

Item was added:
+ ----- Method: Installer>>availablePackages (in category 'public interface') -----
+ availablePackages
+ 	
+ 	^ self basicAvailablePackages!

Item was added:
+ ----- Method: InstallerWeb classSide>>install: (in category 'compatability') -----
+ install: webPageName
+ "This keeps the syntax Installer web install: working"
+ 	^ self new install: webPageName!

Item was added:
+ ----- Method: Installer>>classMCReader (in category 'class references') -----
+ classMCReader
+ 
+ 	^Smalltalk at: #MCReader ifAbsent: [ nil ]
+ 	!

Item was added:
+ ----- Method: InstallerFile>>basicView (in category 'basic interface') -----
+ basicView
+ 	
+ 	self view: self file from:  (FileDirectory readOnlyFileNamed: self file).
+ 
+ 	!

Item was added:
+ ----- Method: Installer classSide>>installFile: (in category 'file') -----
+ installFile: fileName
+  
+ 	^ (self file: fileName) install.
+ !

Item was added:
+ ----- Method: Installer>>view (in category 'public interface') -----
+ view
+ 	self logErrorDuring: [self basicView]!

Item was added:
+ ----- Method: InstallerMantis classSide>>fixesApplied (in category 'accessing') -----
+ fixesApplied
+ 
+ 	^ Fixes ifNil: [ Fixes := OrderedCollection new ].!

Item was added:
+ ----- Method: InstallerMantis>>bug:retrieve: (in category 'public interface') -----
+ bug: aBugNo retrieve: aFileName
+ 
+ 	 self setBug: aBugNo.
+ 	^ (self maStreamForFile: aFileName) contents!

Item was added:
+ ----- Method: InstallerMantis>>maRead:field: (in category 'mantis') -----
+ maRead: page field: fieldKey
+ 
+ 	 | value |
+  
+ 	value := page upToAll: ('!!-- ', fieldKey, ' -->'); upToAll: '<td'; upTo: $>; upToAll: '</td>'.
+ 	
+ 	page upTo: $<.
+ 	
+ 	page peek = $t ifTrue: [ value := page upToAll: 'td'; upTo: $>; upToAll: '</td>' ].
+ 	  
+ 	^Association key: fieldKey value: (self removeHtmlMarkupFrom: value withBlanksTrimmed readStream) contents!

Item was added:
+ ----- Method: InstallerUpdateStream>>parseUpdateListContents: (in category 'updates') -----
+ 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
+ !

Item was added:
+ ----- Method: InstallerMantis>>bugsTesting: (in category 'search') -----
+ bugsTesting: version
+ 
+ 	^self bugsAll select: [ :ea | ea status = 'testing' and: [ ea fixedIn = version ]]!

Item was added:
+ ----- Method: InstallerWeb>>urlToDownload (in category 'web install') -----
+ 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
+ !

Item was changed:
+ ----- Method: Installer classSide>>install: (in category 'action report') -----
+ install: scriptName
- ----- Method: Installer classSide>>install: (in category 'as yet unclassified') -----
- install: webPageName
  
+ 	^ (self scripts install: scriptName) ifNil:[ self web install: scriptName ]
- self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
- 
- ^(self new package: webPageName) install.
  !

Item was added:
+ ----- Method: Installer classSide>>keith (in category 'repositories') -----
+ keith
+  
+ 	^ self monticello ftp: 'squeak.warwick.st' directory: 'mc' user: 'squeak' password: 'viewpoints'!

Item was changed:
+ ----- Method: Installer>>install: (in category 'public interface') -----
- ----- Method: Installer>>install: (in category 'accessing') -----
  install: packageNameCollectionOrDetectBlock
  
+ 	self addPackage: packageNameCollectionOrDetectBlock.
+ 	self install!
- self package: packageNameCollectionOrDetectBlock.
- 
- self install!

Item was added:
+ ----- Method: InstallerMantis>>ensureFix: (in category 'public interface') -----
+ ensureFix: aBugNo
+ 
+ 	^self ensureFix: aBugNo date: nil!

Item was added:
+ ----- Method: InstallerMantis>>bug: (in category 'public interface') -----
+ bug: aBugNo
+ 
+ 	| page |
+ 	self setBug: aBugNo.
+ 	
+ 	page := self maPage.
+ 	date := ((self maRead: page field: 'Date Updated') value replaceAll: $  with: $T) asDateAndTime.
+ 	status := (self maRead: page field: 'Status') value.
+ "	
+ Installer mantis bug: 7235 
+ "!

Item was added:
+ ----- Method: InstallerMantis>>bugsRelease: (in category 'search') -----
+ bugsRelease: version
+ 
+ 	^self bugsAll select: [ :ea | (ea status = 'resolved') and: [ ea fixedIn = version ]]!

Item was added:
+ ----- Method: InstallerMantis>>action:reportOn: (in category 'action report') -----
+ 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.
+ 	!

Item was added:
+ InstallerInternetBased subclass: #InstallerWebBased
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerUniverse>>uniDoInstall (in category 'universes') -----
+ uniDoInstall
+ 
+ 	self withAnswersDo: [ self universe doInstall ] !

Item was added:
+ ----- Method: InstallerCruft classSide>>smalltalkImage (in category 'accessing system') -----
+ smalltalkImage
+ 
+ 	^ SmalltalkImage current!

Item was added:
+ ----- Method: InstallerSqueakMap>>basicInstall (in category 'basic interface') -----
+ basicInstall 
+ 
+ 	self log: ' installing '. 
+ 	self withAnswersDo: [ self smThing install ].
+ 	self log: ' done'.
+ !

Item was added:
+ ----- Method: Installer classSide>>noProgressDuring: (in category 'during') -----
+ noProgressDuring: block
+  
+ 	[ block value: self ] on: ProgressInitiationException do: [ :note | note resume ]
+ 
+ !

Item was added:
+ ----- Method: InstallerMantis>>view (in category 'public interface') -----
+ view
+ 	
+ 	^ Workspace new contents: self report; openLabel: ('Mantis ', bug printString).
+ !

Item was added:
+ ----- Method: Installer>>validate (in category 'logging') -----
+ validate
+ 
+ 	ValidationBlock value = false ifTrue: [ self error: 'Validation failed' ].!

Item was added:
+ ----- Method: InstallerMantis>>bugScript: (in category 'public interface') -----
+ bugScript: aBugNo
+ 
+ 	^ (self setBug: aBugNo) script
+ 	
+ 	
+ !

Item was added:
+ ----- Method: InstallerMantis>>bugFiles: (in category 'public interface') -----
+ bugFiles: aBugNo
+  	"provide a list of files associated with the bug in id order"
+ 	"
+ 	Installer mantis bugFiles: 6660.
+ 	"
+ 	self setBug: aBugNo; files!

Item was added:
+ ----- Method: InstallerMantis>>fixBug (in category 'public interface') -----
+ 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) ]].
+ 
+ 	
+ 	
+ !

Item was added:
+ ----- Method: InstallerMantis>>setBug: (in category 'mantis') -----
+ 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  !

Item was added:
+ ----- Method: Installer classSide>>cache (in category 'monticello') -----
+ cache
+ 	^ self monticello cache!

Item was changed:
+ ----- Method: Installer classSide>>repository: (in category 'monticello') -----
- ----- Method: Installer classSide>>repository: (in category 'accessing') -----
  repository: host  
  
+ 	^self monticello http: host !
- ^self new mc: host !

Item was added:
+ ----- Method: InstallerMantis>>ma: (in category 'accessing') -----
+ ma: aUrl
+ 
+ 	ma := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]!

Item was changed:
+ ----- Method: Installer classSide>>websqueakmap (in category 'websqueakmap') -----
- ----- Method: Installer classSide>>websqueakmap (in category 'as yet unclassified') -----
  websqueakmap
  
+ 	^ InstallerWebSqueakMap new wsm: 'http://map.squeak.org'; yourself!
- ^self new wsm: 'http://map.squeak.org'; yourself!

Item was added:
+ ----- Method: Installer classSide>>repositories (in category 'instanciation') -----
+ repositories
+ 
+ 	^ self class organization listAtCategoryNamed: 'repositories'.
+ !

Item was added:
+ ----- Method: InstallerMonticello>>classMCCacheRepository (in category 'class references') -----
+ classMCCacheRepository
+ 
+ 	^Smalltalk at: #MCCacheRepository ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerInternetBased>>markers (in category 'as yet unclassified') -----
+ markers
+ 
+ 	^ markers ifNil: [ '<code st>..."test ...</code st>' ]!

Item was changed:
+ ----- Method: Installer classSide>>squeakmap (in category 'squeakmap') -----
- ----- Method: Installer classSide>>squeakmap (in category 'instanciation') -----
  squeakmap
  
+ 	^ InstallerSqueakMap new sm: true; yourself!
- ^self new sm: true; yourself!

Item was added:
+ ----- Method: Installer classSide>>launchHelp (in category 'launcher support') -----
+ launchHelp
+ 
+ ^'path=/dir/*.txt          Specify a search path for the item to install
+ p=/dir1/*.txt;<url2>/    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>      Page appended to the path to begin the install process
+ url,u=<url>              Install using an explicit url from which to obtain a script or file
+ file=<url>                Install using a local file
+ +debug                   Do not trap errors
+ view=<page>              Print the script that would have been installed.
+ 
+ For more options use Script eval="Installer ... " 
+ '
+ !

Item was added:
+ ----- Method: InstallerUrl>>basicView (in category 'basic interface') -----
+ basicView
+  	 "(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') view.".
+ 	
+ 	self view: self urlToDownload from: self urlThing.
+ 	
+ 	
+ !

Item was added:
+ ----- Method: InstallerSqueakMap>>basicBrowse (in category 'basic interface') -----
+ basicBrowse
+ 
+ 	self smThing explore!

Item was added:
+ ----- Method: InstallerFile>>basicInstall (in category 'basic interface') -----
+ basicInstall
+ 	
+ 	self install: self file from: (FileDirectory default readOnlyFileNamed: self file)
+ 
+ 	!

Item was added:
+ ----- Method: Installer classSide>>noDebug (in category 'debug') -----
+ noDebug
+ 
+ 	IsSetToTrapErrors := true!

Item was added:
+ ----- Method: InstallerSqueakMap>>classSMLoader (in category 'class references') -----
+ classSMLoader
+ 
+ 	^Smalltalk at: #SMLoader  ifAbsent: [ self error: 'SqueakMap Loader not present' ]!

Item was added:
+ ----- Method: InstallerFile>>file (in category 'accessing') -----
+ file
+ 
+ 	^ self package!

Item was added:
+ ----- Method: Installer>>installMCcs:from: (in category 'mantis') -----
+ installMCcs: aFileName from: stream 
+ 
+ 	| reader |
+ 	
+ 	reader := Smalltalk at: #MCCsReader ifPresent: [:class | class on: stream].!

Item was added:
+ ----- Method: InstallerMonticello>>project: (in category 'accessing') -----
+ 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.!

Item was changed:
+ ----- Method: Installer classSide>>do: (in category 'launcher support') -----
- ----- Method: Installer classSide>>do: (in category 'as yet unclassified') -----
  do: webPageName
  
+ 	| rs |
+ 	rs := webPageName readStream.
+ 	[ rs atEnd ] whileFalse: [ self install: (rs upTo: $;) ].
- self webSearchPath isEmpty ifTrue: [ ^self error: 'search path not set' ].
- 
- ^(self new package: webPageName) install.
  !

Item was added:
+ ----- Method: InstallerWebSqueakMap>>wsmDownloadUrl (in category 'websqueakmap') -----
+ 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
+ 	
+ !

Item was added:
+ ----- Method: InstallerMonticello>>project (in category 'accessing') -----
+ project
+ 
+ 	^ project!

Item was changed:
  ----- Method: Installer>>installMCZ:from: (in category 'mantis') -----
  installMCZ: aFileName from: stream 
  
+ 	| source pkg wc |
+ 	
+ 	pkg := aFileName copyUpToLast: $-.
+ 	
+ 	wc := Smalltalk at: #MCWorkingCopy ifAbsent: [ nil ].
+ wc ifNotNil: [ 
+ 	(wc allManagers select:  [:each | each packageName = pkg ]) do: [ :ea | ea unregister ] 
+ ].
+ 	
+ 	self classMczInstaller ifNotNil: [^ self classMczInstaller install: aFileName stream: stream].  
- 	self classMczInstaller ifNotNil: [ :reader | ^reader installStream: stream].  
- 	self classMCMczReader ifNotNil: [ :reader | ^(reader versionFromStream: stream) load]. 
  
+ 	source :=  ((ZipArchive new readFrom:stream) memberNamed: 'snapshot/source.st') contents.
+ 
+ 	[
+ 		SystemChangeNotifier uniqueInstance doSilently: [ 
+ 			source  readStream fileInAnnouncing: 'Booting ' , aFileName.
+  		]
+ 	] on: Warning do: [ :ex | ex resume: true ].!
- 	self error: 'no monticello readers available'. 
-  !

Item was added:
+ ----- Method: InstallerMantis>>dataAtName: (in category 'search') -----
+ dataAtName: key
+ 	
+ 	^ array at: (self dataNames indexOf: key)!

Item was changed:
  ----- Method: Installer>>answer:with: (in category 'auto answering') -----
  answer: aString with: anAnswer
  
+ 	^self answers add: ( Array with: aString with: anAnswer )!
- ^self answers add: ( Array with: aString with: anAnswer )!

Item was added:
+ ----- Method: InstallerSqueakMap>>smPackageAndVersion (in category 'squeakmap') -----
+ smPackageAndVersion
+ 
+ 	| p |
+ 	p := ReadStream on: self package .
+ 	^Array with: (p upTo: $() with: (p upTo: $)).!

Item was changed:
  ----- Method: Installer>>reportFor:page:on: (in category 'action report') -----
  reportFor: theLine page: thePage on: report 
   	
  	[ thePage atEnd ] whileFalse: [ 
  		| line |
  		line := thePage nextLine.
+ 		Installer actionMatch: line reportOn: report ifNoMatch: [ report nextPutAll: line; cr. ]].!
- 		self actionMatch: line reportOn: report ifNoMatch: [ report nextPutAll: line; cr. ] 	
- 	].!

Item was added:
+ ----- Method: InstallerFile>>basicBrowse (in category 'basic interface') -----
+ basicBrowse
+ 	
+ 	self browse: self file from:  (FileDirectory readOnlyFileNamed: self file).
+ 
+ 	!

Item was added:
+ ----- Method: InstallerSqueakMap>>smReleasesForPackage: (in category 'squeakmap') -----
+ smReleasesForPackage: name 
+ 
+ 	^(self classSMSqueakMap default packageWithName: name) releases!

Item was added:
+ ----- Method: InstallerSqueakMap>>sm (in category 'accessing') -----
+ sm
+ 
+ 	^ sm ifNil: [ false ]!

Item was added:
+ ----- Method: InstallerUpdateStream>>loadUpdatesFromDisk (in category 'updates') -----
+ 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
+ 		
+ 	!

Item was added:
+ ----- Method: InstallerMonticello>>classMCRepositoryGroup (in category 'class references') -----
+ classMCRepositoryGroup
+ 
+ 	^Smalltalk at: #MCRepositoryGroup ifAbsent: [ self error: 'Monticello not present' ]
+ 	!

Item was added:
+ ----- Method: InstallerCruft classSide>>sourceFiles (in category 'accessing system') -----
+ sourceFiles
+ 
+ 	^ SourceFiles!

Item was added:
+ ----- Method: Installer>>packageAndVersionFrom: (in category 'squeakmap') -----
+ packageAndVersionFrom: pkg
+ 
+ 	| p |
+ 	p := ReadStream on: pkg .
+ 	^Array with: (p upTo: $() with: (p upTo: $)).!

Item was changed:
  ----- Method: Installer>>classMultiByteBinaryOrTextStream (in category 'class references') -----
  classMultiByteBinaryOrTextStream
+ 
+ 	^Smalltalk at: #MultiByteBinaryOrTextStream  ifAbsent: [ self error: 'MultiByteBinaryOrTextStream not present' ]!
- ^Smalltalk at: #MultiByteBinaryOrTextStream  ifAbsent: [ self error: 'MultiByteBinaryOrTextStream not present' ]!

Item was added:
+ ----- Method: Installer classSide>>launchWith: (in category 'launcher support') -----
+ 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
+ 
+ 	!

Item was added:
+ ----- Method: InstallerMantis>>date: (in category 'accessing') -----
+ date: anObject
+ 
+ 	date := anObject ifNotNil: [anObject asDate ]!

Item was added:
+ ----- Method: Installer classSide>>universe (in category 'universe') -----
+ universe
+ 
+ 	^ InstallerUniverse default!

Item was added:
+ ----- Method: InstallerInternetBased>>isHtmlStream: (in category 'url') -----
+ isHtmlStream: page
+ 	"matches  '<!!DOCTYPE HTML', and <html>' "
+ 	
+ 	| first |	
+ 	first := (page next: 14) asUppercase.
+ 	^ (first = '<!!DOCTYPE HTML') | (first beginsWith: '<HTML>')
+ 	
+ !

Item was added:
+ ----- Method: Installer>>label (in category 'accessing') -----
+ label
+ 	^ self class label!

Item was added:
+ ----- Method: InstallerMonticello>>mcUrl (in category 'monticello') -----
+ mcUrl
+ 
+ 	^ self mc description 
+ 	!

Item was added:
+ ----- Method: InstallerUniverse>>universe (in category 'universes') -----
+ universe
+ 
+ 	^ universe!

Item was changed:
  ----- Method: Installer>>classGZipReadStream (in category 'class references') -----
  classGZipReadStream
  
+ 	^Smalltalk at: #GZipReadStream  ifAbsent: [ self error: 'Compression not present' ]!
- ^Smalltalk at: #GZipReadStream  ifAbsent: [ self error: 'Compression not present' ]!

Item was added:
+ ----- Method: InstallerUrl>>basicInstall (in category 'basic interface') -----
+ basicInstall 
+  	 
+ 	self install: self urlToDownload from: self urlThing.
+ 	^ pageDataStream 
+ !

Item was changed:
  ----- Method: Installer>>installSAR:from: (in category 'mantis') -----
  installSAR: aFileName from: stream 
  
  	| newCS |
  	newCS := self classSARInstaller withCurrentChangeSetNamed: aFileName
  		do: [:cs | self classSARInstaller new fileInFrom: stream].
+ 	newCS isEmpty ifTrue: [ self removeChangeSet: newCS ]!
- 	newCS isEmpty ifTrue: [ self classChangeSet removeChangeSet: newCS ]!

Item was changed:
+ ----- Method: Installer classSide>>path: (in category 'web') -----
- ----- Method: Installer classSide>>path: (in category 'accessing') -----
  path: aString
  	"convenience abbreviation"
+ 	
  	self webSearchPathFrom: aString!

Item was changed:
  ----- Method: Installer>>installCS:from: (in category 'mantis') -----
  installCS: aFileName from: stream
  
+  	self ditchOldChangeSetFor: aFileName.
- 	self ditchOldChangeSetFor: aFileName.
  	self newChangeSetFromStream: stream named: (self validChangeSetName: aFileName).
  !

Item was added:
+ ----- Method: Installer>>installMCZBasic:from: (in category 'mantis') -----
+ installMCZBasic: aFileName from: stream 
+ 
+ 	| source |
+ 	
+  
+ 	self classMczInstaller ifNotNil: [^ self classMczInstaller install: aFileName stream: stream].  
+ 
+ 	source :=  ((ZipArchive new readFrom:stream) memberNamed: 'snapshot/source.st') contents.
+ 
+ 	[
+ 		SystemChangeNotifier uniqueInstance doSilently: [ 
+ 			source  readStream fileInAnnouncing: 'Booting ' , aFileName.
+  		]
+ 	] on: Warning do: [ :ex | ex resume: true ].!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>wsm (in category 'websqueakmap') -----
+ wsm
+ 	
+ 	^ wsm!

Item was added:
+ ----- Method: InstallerMantis>>bug:fix:date: (in category 'public interface') -----
+ bug: aBugNo fix: aFileName date: aDate
+  
+ 	| |
+ 	self setBug: aBugNo.
+ 	self ditchOldChangeSetFor: aFileName.
+ 	self install: aFileName from: (self maThing: aFileName date: aDate).
+ 		
+ 	^ date!

Item was added:
+ ----- Method: InstallerUrl>>urlThing (in category 'url') -----
+ 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
+ 	!

Item was added:
+ ----- Method: InstallerSqueakMap>>sm: (in category 'accessing') -----
+ sm: anObject
+ 
+ 	sm := anObject!

Item was added:
+ ----- Method: Installer>>quietly (in category 'public interface') -----
+ quietly
+ 
+ 	noiseLevel := #quiet!

Item was added:
+ ----- Method: InstallerInternetBased>>classHTTPSocket (in category 'class references') -----
+ classHTTPSocket
+ 
+ 	^Smalltalk at: #HTTPSocket ifAbsent: [ self error: 'Network package not present' ]!

Item was added:
+ ----- Method: InstallerMantis>>selectCategoryCollections (in category 'public interface') -----
+ selectCategoryCollections
+ 
+ 	^ self select: [ :ea | ea category = 'Collections' ]!

Item was added:
+ ----- Method: InstallerUrl classSide>>canReportLine: (in category 'action report') -----
+ canReportLine: line
+ 	^ ((line beginsWith: 'Installer installUrl:') and: 
+ 		[ | ext |
+ 		 ext :=  (line readStream upToAll: '''.') copyAfterLast: $..
+ 		 (#( 'cs' 'st' 'mcz' 'sar') includes: ext) not ])!

Item was added:
+ ----- Method: InstallerCruft classSide>>history (in category 'documentation') -----
+ history
+ 
+ "
+ 7 Jan 2007  
+ !!Installer fixBug: <aBugNo>
+ 
+ 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: <aBugNoOrString>
+  Installer ensureFixes: #(1 2 3 4)
+ 
+ Installer now keeps a list of fix <aBugNoOrString> 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: <webPageNameOrUrl>
+ 
+ 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=<webPageNameOrUrl>
+ 
+ 10 Jan 2007
+ !!Now matches simpler html
+ 
+ Check for an html page, now matches
+ '<!!DOCTYPE HTML' and <html> 
+ 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
+ "!

Item was added:
+ ----- Method: InstallerSqueakMap>>smThing (in category 'squeakmap') -----
+ 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
+ 		
+ 	
+ !

Item was added:
+ ----- Method: InstallerMonticello>>latestFromUsers: (in category 'accessing') -----
+ latestFromUsers: list
+ 
+ 	| newPackage |
+ 	newPackage := self package copyUpToLast: $-.
+ 	self packages removeLast.
+ 	self package: (list collect: [ :ea | newPackage, '-', ea ])!

Item was added:
+ ----- Method: InstallerUniverse classSide>>classUUniverse (in category 'accessing system') -----
+ classUUniverse
+ 
+ 	^Smalltalk at: #UUniverse  ifAbsent: [ self error: 'Universes code not present' ]!

Item was added:
+ ----- Method: InstallerMantis>>script (in category 'public interface') -----
+ script
+ 
+  	^ self maScript contents.
+ 	 
+ 	
+ 	
+ !

Item was added:
+ ----- Method: Installer classSide>>debug (in category 'debug') -----
+ debug
+ 
+ 	IsSetToTrapErrors := false!

Item was added:
+ ----- Method: InstallerMonticello>>latest (in category 'accessing') -----
+ 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'.
+ "!

Item was added:
+ ----- Method: InstallerUrl>>fileInSource (in category 'accessing') -----
+ fileInSource
+ 
+ "
+ (Installer url: 'http://www.squeaksource.com/Sake/Sake-Core-kph.47.mcz') bootstrap.
+ "
+ 
+ 
+ | pkg splitPos repo getFileName fileName |
+ 
+ useFileIn := true.
+ 
+ splitPos := url lastIndexOf: $/. 
+ 
+ pkg := url copyFrom: splitPos + 1 to: url size.
+ repo := url copyFrom: 1 to: splitPos.
+ 
+ getFileName := [ :pkgName | pkgName , ((HTTPSocket httpGet: repo) upToAll: pkgName; upTo: $") ].
+  
+ fileName := getFileName value: pkg.
+ 
+ url := repo,fileName.
+ 
+ self install!

Item was added:
+ ----- Method: InstallerMonticello>>unload: (in category 'public interface') -----
+ unload: match 
+ 
+ 	self addPackage: match.
+ 	self unload.!

Item was changed:
  ----- Method: Installer>>messagesToSuppress (in category 'accessing') -----
  messagesToSuppress
  
+ 	^ messagesToSuppress ifNil: [ messagesToSuppress := OrderedCollection new ]!
- ^ messagesToSuppress ifNil: [ messagesToSuppress := OrderedCollection new ]!

Item was added:
+ ----- Method: InstallerInternetBased>>urlGet (in category 'url') -----
+ urlGet
+ 
+ 	^ self urlGet: self urlToDownload!

Item was added:
+ ----- Method: InstallerMantis>>maThing:date: (in category 'mantis') -----
+ maThing: aFileName date: aDate
+  
+ 	self logCR: 'obtaining ', aFileName, '...'.
+ 
+ 	pageDataStream := self maStreamForFile: aFileName.
+ 
+ 	self maCheckDateAgainst: aDate.
+ 
+ 	^ pageDataStream
+ 	!

Item was added:
+ ----- Method: InstallerWeb classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'web'!

Item was added:
+ ----- Method: InstallerWeb classSide>>searchPath (in category 'accessing') -----
+ searchPath
+ 	"a search path item, has the following format. prefix*suffix"
+ 
+ 	^ WebSearchPath ifNil: [ WebSearchPath := OrderedCollection new ].!

Item was added:
+ ----- Method: InstallerUrl>>basicBrowse (in category 'basic interface') -----
+ basicBrowse
+  	"(Installer debug url: 'http://installer.pbwiki.com/f/Installer.st') browse.".
+ 	
+ 	self browse: self urlToDownload from: self urlThing.
+ 	
+ 	
+ !

Item was added:
+ ----- Method: InstallerMantis>>bugsAll (in category 'action report') -----
+ bugsAll
+ 
+ 	^ array ifNil: [
+ 		
+ 		array := ( self bugsSqueak ,  (self dataGetFrom: '/installer_export.php') ) asSet asSortedCollection: [ :a :b | a date > b date ]
+ 		
+ 	].
+ 
+ "
+ 
+ Installer mantis bugsAll
+ 
+ "
+ 	
+ !

Item was changed:
  ----- Method: Installer>>packagesMatching: (in category 'searching') -----
  packagesMatching: aMatch
+ 	^'search type not supported'!
- 
- self sm ifTrue: [ ^ (self packages select: [ :p | aMatch match: p name ]) collect: [ :p | self copy package: p name; yourself ] ].
- self mc ifNotNil: [ ^ (self packages select: [ :p | ( aMatch , '.mcz' ) match: p ]) collect: [ :p | self copy package: p ; yourself ] ].
- self wsm ifNotNil: [ ^ (self packages select: [ :p | ( aMatch) match: p ]) collect: [ :p | self copy package: p ; yourself ] ].
- 
- ^'search type not supported'!

Item was added:
+ ----- Method: InstallerMantis>>maPage (in category 'mantis') -----
+ 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 asString, ' not found' ].
+ 	date := date asDate.
+  	^page reset!

Item was added:
+ ----- Method: InstallerMonticello>>mcDetectFileBlock: (in category 'monticello') -----
+ mcDetectFileBlock: pkg
+ 
+ 	pkg isString ifTrue: [  ^ [ :aFile | aFile beginsWith: pkg ] ].
+ 
+ 	(pkg isKindOf: Array) 
+ 			ifTrue: [  ^  [ :aFile | (pkg detect: [ :item | aFile beginsWith: item ] ifNone: [ false ]) ~= false ] ].
+ 
+ 	pkg isBlock ifTrue: [ ^ pkg ].
+   
+  !

Item was changed:
  ----- Method: Installer>>log: (in category 'logging') -----
  log: text
  
+ 	^Transcript show: text.!
- ^Transcript show: text.!

Item was added:
+ ----- Method: InstallerUniverse classSide>>default (in category 'instance creation') -----
+ default
+ 
+ 	^ self universe: (self classUGlobalInstaller universe: self classUUniverse systemUniverse)!

Item was added:
+ ----- Method: Installer classSide>>setSakeToUse: (in category 'sake') -----
+ setSakeToUse: aClass
+ 
+ 	InstallerSake sake: aClass!

Item was changed:
+ ----- Method: Installer classSide>>skipLoadingTests (in category 'accessing') -----
- ----- Method: Installer classSide>>skipLoadingTests (in category 'as yet unclassified') -----
  skipLoadingTests
+ 	"sets a flag to ignore loading of the testing portion of scripts embedded in pages"
+ 	
+ 	SkipLoadingTests := true.
- 
- "sets a flag to ignore loading of the testing portion of scripts embedded in pages"
- SkipLoadingTests := true.
   !

Item was added:
+ InstallerWebBased subclass: #InstallerWeb
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'WebSearchPath'
+ 	poolDictionaries: ''
+ 	category: 'Installer-Core'!

Item was added:
+ ----- Method: InstallerMonticello>>mc: (in category 'accessing') -----
+ mc: aRepo
+ 
+ 	mc := aRepo!

Item was added:
+ ----- Method: InstallerMantis>>maReadNotes: (in category 'mantis') -----
+ maReadNotes: page 
+ 
+ 	 |  notes note  |
+  
+ 	notes := OrderedCollection new.
+ 
+ 	[ page upToAll: 'tr class="bugnote"'; upTo: $>.
+ 	  page atEnd ]
+ 		
+ 	whileFalse: [ 
+ 		note := (self removeHtmlMarkupFrom: (page upToAll: '</tr>') readStream) contents.
+ 		note := note withBlanksCondensed.
+ 		note replaceAll: Character lf with: Character cr.
+ 		notes add: note  
+ 	].
+ 	
+ 	^notes!

Item was added:
+ ----- Method: Installer classSide>>label (in category 'accessing') -----
+ label
+ 	^ ''!

Item was changed:
  ----- Method: Installer>>packages (in category 'accessing') -----
  packages
  	
+  	^ packages ifNil: [ packages := OrderedCollection new ]!
- self sm ifTrue: [ ^self smPackages ].
- self mc ifNotNil: [ ^self mcRepository allFileNames ].
- self wsm ifNotNil: [ ^self wsmPackagesByName keys ].!

Item was added:
+ ----- Method: Installer classSide>>squeakfoundation (in category 'repositories') -----
+ squeakfoundation
+ 
+ 	^ self monticello http: 'source.squeakfoundation.org'!

Item was changed:
+ ----- Method: Installer classSide>>webSearchPathFrom: (in category 'web') -----
- ----- Method: Installer classSide>>webSearchPathFrom: (in category 'accessing') -----
  webSearchPathFrom: string
  
+ 	| reader wsp path |
- 	| reader result |
- 	
  	reader := string readStream.
+ 	wsp := self webSearchPath.
+ 	[ reader atEnd ] whileFalse: [ 
+ 		path := reader upTo: $;.
+ 		(wsp includes: wsp) ifFalse: [ wsp addFirst: path ]].
- 	result := OrderedCollection new.
- 	
- 	[ reader atEnd ] whileFalse: [ result add: (reader upTo: $;) ].
  
+ 	 !
- 	WebSearchPath := result.!

Item was added:
+ ----- Method: InstallerUniverse classSide>>universe: (in category 'instance creation') -----
+ universe: u
+ 
+ 	^ self new universe: u!

Item was changed:
+ ----- Method: Installer>>withAnswersDo: (in category 'auto answering') -----
- ----- Method: Installer>>withAnswersDo: (in category 'monticello') -----
  withAnswersDo: aBlock
  
  	(aBlock respondsTo: #valueSuppressingMessages:supplyingAnswers: )
  		ifTrue: [aBlock valueSuppressingMessages: self messagesToSuppress supplyingAnswers: self answers.]
  		ifFalse: [ aBlock value ]
  !

Item was added:
+ ----- Method: InstallerUniverse>>universe: (in category 'universes') -----
+ universe: u
+ 
+ 	universe := u.
+ 	self update.!

Item was added:
+ ----- Method: Installer classSide>>upgrade (in category 'instanciation') -----
+ upgrade
+ 
+ 	Installer ss project: 'Installer'; 
+ 		installQuietly: 'Installer-Core'.
+ 			 
+ 	self privateUpgradeTheRest.
+ 	
+ 	^ self!

Item was added:
+ ----- Method: InstallerInternetBased>>hasPage (in category 'url') -----
+ hasPage
+ 
+ 	^ pageDataStream notNil and: [ pageDataStream size > 0 ]
+ 			!

Item was added:
+ ----- Method: InstallerCruft>>viewUrl (in category 'utils') -----
+ viewUrl
+ 
+ 	^Workspace new contents: (self urlGet contents); openLabel: self urlToDownload.
+ !

Item was added:
+ ----- Method: InstallerMantis>>bug (in category 'accessing') -----
+ bug
+ 	
+ 	^ bug ifNil: [ 
+ 		
+ 		date := ((self dataAtName: 'Updated') replaceAll: $  with: $T) asDateAndTime. 
+ 		desc := (self dataAtName: 'Summary').
+ 		bug := (self dataAtName: 'Id'). 
+ 		self statusInit.
+  	]!

Item was added:
+ ----- Method: InstallerMantis>>maCheckDateAgainst: (in category 'utils') -----
+ maCheckDateAgainst: okDate
+ 
+ 	(okDate notNil and: [date < okDate asDate ]) 
+ 		ifTrue: [ self notify: 'bug ', self bug asString, ' updated on ', date printString ].
+  !

Item was added:
+ ----- Method: InstallerSake classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'sake'!

Item was added:
+ ----- Method: InstallerMantis>>statusInit (in category 'accessing') -----
+ statusInit
+ 
+ 	status ifNil: [ status := Status at: (self dataAtName: 'Status').
+ 		self dataAtName:'Status' put: status.
+ 	].
+ 
+ 	!

Item was added:
+ ----- Method: Installer classSide>>doesNotUnderstand: (in category 'custom names') -----
+ doesNotUnderstand: aMessage
+ 
+ 	^ self remembered at: aMessage selector ifAbsent: [ super doesNotUnderstand: aMessage ]!

Item was added:
+ ----- Method: Installer classSide>>sake: (in category 'sake') -----
+ sake: aSakePackagesClass
+ 
+ 	^ InstallerSake new sake: aSakePackagesClass!

Item was added:
+ ----- Method: InstallerWeb>>basicView (in category 'basic interface') -----
+ basicView
+  
+  	 self thing size > 0 
+ 		ifTrue: [ self view: url from: pageDataStream ]
+ 		ifFalse: [ self logCR: 'NO DATA ',url,' was empty' ].
+ 	 !

Item was added:
+ ----- Method: InstallerMantis classSide>>label (in category 'accessing') -----
+ label
+ 	^ 'mantis'!

Item was added:
+ ----- Method: InstallerUniverse>>classUVersion (in category 'class references') -----
+ classUVersion
+ 
+ 	^Smalltalk at: #UVersion  ifAbsent: [ self error: 'Universes code not present' ]!

Item was changed:
+ ----- Method: Installer>>versions (in category 'public interface') -----
- ----- Method: Installer>>versions (in category 'accessing') -----
  versions
  	
+ 	^ self basicVersions!
- self sm ifTrue: [ ^self smVersions ].
- self mc ifNotNil: [ ^self mcVersions ].
- self wsm ifNotNil: [ ^self wsmVersions ].!

Item was added:
+ ----- Method: InstallerMantis>>bug:view: (in category 'public interface') -----
+ 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)!

Item was changed:
  ----- Method: Installer>>bindingOf: (in category 'script bindings') -----
  bindingOf: aString 
  	
+ 	InstallerBindings isNil ifTrue: [ InstallerBindings := Dictionary new].
- 	Bindings isNil ifTrue: [ Bindings := Dictionary new].
  
+ 	(InstallerBindings includesKey: aString)
+ 		ifFalse: [InstallerBindings at: aString put: nil].
- 	(Bindings includesKey: aString)
- 		ifFalse: [Bindings at: aString put: nil].
  
+ 	^ InstallerBindings associationAt: aString.!
- 	^ Bindings associationAt: aString.!

Item was added:
+ ----- Method: InstallerMonticello>>cache (in category 'instance creation') -----
+ cache
+ 	
+ 	mc := self classMCCacheRepository default.
+ 	root := mc directory localName
+  !

Item was added:
+ ----- Method: Installer>>installSilently (in category 'public interface') -----
+ installSilently
+ 
+ 	SystemChangeNotifier uniqueInstance doSilently: [ self installLogging ]
+ 
+ 	!

Item was added:
+ ----- Method: InstallerMantis>>maUrl (in category 'mantis') -----
+ maUrl
+  
+ 	^ url := self ma, 'view.php?id=', bug asString
+  !

Item was changed:
  ----- Method: Installer>>classChangeSet (in category 'class references') -----
  classChangeSet
  
+ 	^Smalltalk at: #ChangeSet  ifAbsent: [ self error: 'ChangeSet not present' ]!
- ^Smalltalk at: #ChangeSet  ifAbsent: [ self error: 'ChangeSet not present' ]!

Item was added:
+ ----- Method: InstallerWebSqueakMap>>wsm: (in category 'websqueakmap') -----
+ wsm: aUrl
+  
+ 	wsm := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]!

Item was added:
+ ----- Method: Installer>>installQuietly (in category 'public interface') -----
+ installQuietly 
+ 
+   	[ self installLogging ] on: Warning do: [ :ex | ex resume: true ].!

Item was added:
+ ----- Method: Installer>>basicView (in category 'basic interface') -----
+ basicView!

Item was added:
+ ----- Method: InstallerSake>>sake: (in category 'websqueakmap') -----
+ sake: aSakePackagesClass
+ 
+ 	sake := aSakePackagesClass!

Item was added:
+ ----- Method: Installer>>browse: (in category 'public interface') -----
+ browse: packageNameCollectionOrDetectBlock
+ 
+ 	self package: packageNameCollectionOrDetectBlock.
+ 	self browse!

Item was added:
+ ----- Method: InstallerMonticello>>printConfigurationOn: (in category 'Installer-Core') -----
+ printConfigurationOn: stream
+ 	self project ifNil: [ ^ self ].
+ 	
+ 	stream 
+ 		nextPutAll: ' project:''';
+ 		nextPutAll: self project;
+ 		nextPut: $'!

Item was added:
+ ----- Method: InstallerMantis>>maFiles (in category 'mantis') -----
+ maFiles
+  	| file files bugPage id  | 
+  	files := Dictionary new.
+  	bugPage := self maPage.
+ 	 [ 
+ 		id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. 
+  		file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<.
+  		((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ].
+  		id notEmpty ] whileTrue.
+ 
+ 	^files !

Item was added:
+ ----- Method: Installer classSide>>log: (in category 'logging') -----
+ log: aString
+ 
+ 	Transcript show: aString; cr.!

Item was added:
+ ----- Method: InstallerInternetBased>>wasPbwikiSpeedWarning (in category 'url') -----
+ wasPbwikiSpeedWarning
+ 		
+ 		^ self hasPage and: [pageDataStream contents includesSubString: 'Please slow down a bit' ] 
+  
+ !

Item was added:
+ ----- Method: Installer classSide>>mc (in category 'monticello') -----
+ mc
+ 
+ 	^ self monticello!

Item was added:
+ ----- Method: InstallerMantis>>viewFiles (in category 'public interface') -----
+ viewFiles
+ 	
+ 	^ self files do: [ :ea | self viewFile: ea ].!

Item was added:
+ ----- Method: InstallerInternetBased>>markersBegin (in category 'as yet unclassified') -----
+ markersBegin
+ 		 	 
+ 	 ^ self markers copyUpTo: $.!

Item was added:
+ ----- Method: InstallerInternetBased>>removeHtmlMarkupFrom: (in category 'as yet unclassified') -----
+ 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.
+ !

Item was added:
+ ----- Method: InstallerMantis>>date (in category 'accessing') -----
+ date 
+ 
+ 	^ date !

Item was added:
+ ----- Method: Installer>>installQuietly: (in category 'public interface') -----
+ installQuietly: packageNameCollectionOrDetectBlock
+ 
+ 	self quietly install: packageNameCollectionOrDetectBlock.
+  !

Item was changed:
+ ----- Method: Installer>>printOn: (in category 'printing') -----
- ----- Method: Installer>>printOn: (in category 'accessing') -----
  printOn: s
+ 	s
+ 		nextPutAll: '(Installer ';
+ 		nextPutAll: self label;
+ 		nextPut: $).
-  
- s nextPutAll: '(Installer'.
  
+ 	"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: $..!
- self sm ifTrue: [ s nextPutAll: ' squeakmap' ].
- self ma ifNotNil: [ s nextPutAll: ' mantis' ].
- self wsm ifNotNil: [ s nextPutAll: ' websqueakmap' ].
- self url ifNotNil: [ s nextPutAll: ' url:''', self url,'''' ].
- self mc ifNotNil: [ s nextPutAll: ' repository:''', self mc,'''' ].
- 
- s nextPut: $).
- 
- self project ifNotNil: [ s nextPutAll: ' project:';
-   						nextPutAll: '''', self project, ''''.
- 					   self package ifNotNil: [ s nextPutAll: '; '] ].
- 					
- self package ifNotNil: [ s nextPutAll: ' package:';
-   						 nextPutAll: '''', self package asString, '''' ].
- 					
- s nextPut: $..!

Item was added:
+ ----- Method: InstallerMonticello>>http: (in category 'instance creation') -----
+ http: aUrl  
+ 	
+ 	self http: aUrl user: '' password: ''
+ 		
+  !

Item was added:
+ ----- Method: InstallerCruft>>skipTests (in category 'mantis') -----
+ skipTests
+ 
+ !

Item was added:
+ ----- Method: Installer classSide>>url (in category 'url') -----
+ url
+ 
+ 	^ InstallerUrl new url: ''!

Item was added:
+ ----- Method: Installer>>basicVersions (in category 'basic interface') -----
+ basicVersions!

Item was added:
+ ----- Method: InstallerUniverse classSide>>label (in category 'as yet unclassified') -----
+ label
+ 	^ 'universe'!

Item was added:
+ ----- Method: Installer>>basicAvailablePackages (in category 'basic interface') -----
+ basicAvailablePackages!

Item was added:
+ ----- Method: Installer classSide>>sake (in category 'sake') -----
+ sake
+ 
+ 	^ self sake: InstallerSake sake!

Item was added:
+ ----- Method: InstallerFile>>file: (in category 'accessing') -----
+ file: f
+ 	self package: f!

Item was added:
+ ----- Method: InstallerInternetBased classSide>>entities (in category 'accessing') -----
+ entities
+ 
+ 	^ Entities ifNil: [ Entities := 
+ 				"enough entities to be going on with"
+   				Dictionary new.
+ 				Entities at: 'lt' put: '<';
+ 				at: 'gt' put: '>';
+ 				at: 'amp' put: '&';
+ 				at: 'star' put: '*';
+ 				at: 'quot' put: '"';
+ 				at: 'nbsp' put: ' ';
+  			yourself
+ ]
+ 
+  !

Item was removed:
- ----- Method: Installer>>ma (in category 'accessing') -----
- ma
- 	"Answer the value of ma"
- 
- 	^ ma!

Item was removed:
- ----- Method: Installer>>project (in category 'accessing') -----
- project
- 	"Answer the value of project"
- 
- 	^ project!

Item was removed:
- ----- Method: Installer>>smPackageAndVersion (in category 'squeakmap') -----
- smPackageAndVersion
- 
- | p |
- 
- p := ReadStream on: self package .
- 
- ^Array with: (p upTo: $() with: (p upTo: $)).!

Item was removed:
- ----- Method: Installer>>viewBug: (in category 'mantis') -----
- viewBug: aBugNo
- 
- 	^Workspace new contents: (self bug: aBugNo); openLabel: ('Mantis ', aBugNo printString).
- !

Item was removed:
- ----- Method: Installer>>ma: (in category 'accessing') -----
- ma: aUrl
-  
- 	"Set the value of host"
- 
- 	ma := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]!

Item was removed:
- ----- Method: Installer>>wsmDownloadUrl (in category 'websqueakmap') -----
- wsmDownloadUrl 
- 
- | pkgAndVersion packageId packageName packageVersion releaseAutoVersion
-  downloadPage |
- 
- 	pkgAndVersion := self smPackageAndVersion.
- 	packageName := pkgAndVersion first.
- 	packageVersion := pkgAndVersion last.
- 	packageVersion isEmpty ifTrue: [ packageVersion := #latest ].
- 
- 	packageId := self wsmPackagesByName at: packageName.
- 	releaseAutoVersion := (self wsmReleasesFor: packageId) at: packageVersion.
- 					 
- 	downloadPage := self httpGet: (self wsm,'packagebyname/', packageName,'/autoversion/', releaseAutoVersion,'/downloadurl') asUrl asString.
- 				 		 
- 	^ downloadPage contents
- 	
- !

Item was removed:
- ----- Method: Installer>>mcInstall (in category 'monticello') -----
- mcInstall
- 
- 	| repository sortMczs files fileToLoad  version detectFileBlock  count |
- 
- 	self logCR: 'installing ', self package asString, '...'.
- 
- 	self package isString ifTrue: [ detectFileBlock := [ :file | file beginsWith: self package ] ].
- 	(self package isKindOf: Array) 
- 			ifTrue: [ detectFileBlock :=  [ :file | (self package detect: [ :item | file beginsWith: item ] ifNone: [ false ]) ~= false ] ].
- 	self package isBlock ifTrue: [ detectFileBlock := self package ].
-   
- 
- 	repository := self mcRepository.
- 
- 	sortMczs := [:a :b | 
-         	[(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].
- 
- 	"several attempts to read files - repository readableFileNames sometimes fails"
- 
- 	count := 0. fileToLoad := nil.
- 	
- 	[count := count + 1.
- 	 (fileToLoad = nil) and:[ count < 5 ] ] 
- 		whileTrue: [
- 						files := repository readableFileNames asSortedCollection: sortMczs.
- 						fileToLoad := files detect: detectFileBlock ifNone: [ nil ].
- 																						].
- 
- 	version := repository versionFromFileNamed: fileToLoad.
- 	version workingCopy repositoryGroup addRepository: repository.
- 	repository creationTemplate: 'MCHttpRepository
-         	location: ''', self mcUrl, '''
-         	user: ''', self user, '''
-         	password: ''', self password, ''''.
- 	self log: ' ', version fileName, '...'.
- 
- 	self withAnswersDo: [ version load ].
- 
- 	self log: 'done'.
- !

Item was removed:
- ----- Method: Installer>>justFixBug:date: (in category 'mantis') -----
- justFixBug: aBugNo date: d
- 
- 	^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: d ]!

Item was removed:
- ----- Method: Installer>>webFindUrlToDownload (in category 'web install') -----
- webFindUrlToDownload
- 
- 	self class webSearchPath do: [ :pathSpec | 
- 		| potentialUrl readPathSpec  |
- 	
- 		readPathSpec := pathSpec readStream.
- 		potentialUrl := (readPathSpec upTo: $*), package, (readPathSpec upToEnd ifNil: [ '' ]).
- 	
- 		pageDataStream := self urlGet: potentialUrl.
- 		
- 		pageDataStream notNil ifTrue: [ ^potentialUrl ]
- 	].
- 
- 	^nil
- !

Item was removed:
- ----- Method: Installer>>replaceEntitiesIn: (in category 'url') -----
- 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!

Item was removed:
- ----- Method: Installer>>urlView (in category 'url') -----
- urlView
- 
- ^ self urlGet: self urlToDownload!

Item was removed:
- ----- Method: Installer>>actionMatch:reportOn:ifNoMatch: (in category 'action report') -----
- actionMatch: theLine reportOn: report ifNoMatch: aBlock
- 
- 	| line |
- 	
- 	line := theLine withBlanksCondensed.
- 	
- 	((line beginsWith: 'Installer install:') | (line beginsWith: 'Installer do:')) 
- 		ifTrue: [ ^self webAction: theLine reportOn: report ].
- 	
- 	
- 	((line beginsWith: 'Installer installUrl:') and: 
- 		[ | ext |
- 		 ext :=  (line readStream upToAll: '''.') copyAfterLast: $..
- 		 (#( 'cs' 'st' 'mcz' 'sar') includes: ext) not ]) ifTrue: [ ^self urlAction: theLine reportOn: report ].
- 
- 	(line beginsWith: 'Installer mantis fixBug:') ifTrue: [ ^self mantisAction: theLine reportOn: report ].
- 	
- 	
- 	aBlock value.
- !

Item was removed:
- ----- Method: Installer>>maFiles (in category 'mantis') -----
- maFiles
-  
-  | file files bugPage id  | 
-  
-  files := Dictionary new.
-  
-  bugPage := self maPage.
- 
-  [
-   id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. 
-  file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<.
-  
-  ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ].
-  
-  id notEmpty ] whileTrue.
- 
- ^files !

Item was removed:
- ----- Method: Installer>>maPage (in category 'mantis') -----
- maPage
-   "
-   self mantis bug: 5251.
-  "
-  | page |
- 
- page :=  self httpGet: self maUrl.
-  
- date := ((self maRead: page field: 'Date Updated') value upTo: $ ) asDate.
-  
- ^page reset!

Item was removed:
- ----- Method: Installer>>maUrl (in category 'mantis') -----
- maUrl
-  
- 	^ url := self ma, 'view.php?id=', bug asString
-  !

Item was removed:
- ----- Method: Installer>>mc (in category 'accessing') -----
- mc
- 	"Answer the value of mc"
- 
- 	^ mc!

Item was removed:
- ----- Method: Installer>>smInstall (in category 'squeakmap') -----
- smInstall 
- 
- 	| pkgAndVersion releases release |
- 
- 	pkgAndVersion := self smPackageAndVersion.
- 
- 	self logCR: 'installing ', self package, ' from SqueakMap...'.
- 
- 
- 	releases := self smReleasesForPackage: pkgAndVersion first.
-  	
- 	release := pkgAndVersion last isEmpty ifTrue: [ releases last ]
- 					ifFalse:[ releases detect: [ :rel | rel version = pkgAndVersion last ] ]. 
- 	
- 	self withAnswersDo: [ release install ].
- 
- 	self log: ' done'.
- !

Item was removed:
- ----- Method: Installer>>mc: (in category 'accessing') -----
- mc: aUrl
-  
- 	"Set the value of host"
- 
- 	mc := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]!

Item was removed:
- ----- Method: Installer>>urlToDownload (in category 'url') -----
- urlToDownload
- 
- 	^ (self url, (self package ifNil: [ '' ])) asUrl asString.
- 	
-  !

Item was removed:
- ----- Method: Installer classSide>>classes (in category 'accessing system') -----
- classes
- 
- ^ Smalltalk!

Item was removed:
- ----- Method: Installer>>viewUrl (in category 'utils') -----
- viewUrl
- 
- 	^Workspace new contents: (self urlGet contents); openLabel: self urlToDownload.
- !

Item was removed:
- ----- Method: Installer>>urlGet (in category 'url') -----
- urlGet
- 
- ^ self urlGet: self urlToDownload!

Item was removed:
- ----- Method: Installer>>mcVersions (in category 'monticello') -----
- mcVersions
- 
- ^ (self packages select: [ :p | ( self package,'-*.mcz' ) match: p ]) collect: [ :p | self copy package: p  ; yourself ].
-  !

Item was removed:
- ----- Method: Installer>>markers (in category 'accessing') -----
- markers
- 	"Answer the value of markers"
- 
- 	^ markers ifNil: [ '<code st>..."test ...</code st>' ]!

Item was removed:
- ----- Method: Installer>>bug:fix: (in category 'mantis') -----
- bug: aBugNo fix: aFileName
- 
- 	^ self bug: aBugNo fix: aFileName date: nil!

Item was removed:
- ----- Method: Installer>>fixBug: (in category 'mantis') -----
- fixBug: aBugNo
- 
- 	^ self fixBug: aBugNo date: nil!

Item was removed:
- ----- Method: Installer>>ensureFixes: (in category 'mantis') -----
- ensureFixes: aBugNos
- 
- 	aBugNos do: [ :bugNo | self ensureFixes: bugNo ].!

Item was removed:
- ----- Method: Installer>>sm: (in category 'accessing') -----
- sm: anObject
- 	"Set the value of sm"
- 
- 	sm := anObject!

Item was removed:
- ----- Method: Installer>>markersBegin (in category 'url') -----
- markersBegin
- 		 	 
- 	 ^ self markers upTo: $.!

Item was removed:
- ----- Method: Installer>>bug (in category 'accessing') -----
- bug
- 	"Answer the value of bug"
- 
- 	^ bug!

Item was removed:
- ----- Method: Installer>>extractFromHtml:option: (in category 'action report') -----
- 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
- 	 
- !

Item was removed:
- ----- Method: Installer>>classSMLoader (in category 'class references') -----
- classSMLoader
- 
- ^Smalltalk at: #SMLoader  ifAbsent: [ self error: 'SqueakMap Loader not present' ]!

Item was removed:
- ----- Method: Installer>>bug:fix:date: (in category 'mantis') -----
- bug: aBugNo fix: aFileName date: aDate
-  
- 	| stream |
- 
- 	self setBug: aBugNo.
- 
- 	self logCR: 'obtaining ', aFileName, '...'.
- 
- 	stream := self maStreamForFile: aFileName.
- 
- 	self ditchOldChangeSetFor: aFileName.
- 
- 	self maCheckDateAgainst: aDate.
- 
- 	self install: aFileName from: stream.
- 
- 	self class fixesApplied add: aBugNo.
- 		
- 	^ date!

Item was removed:
- ----- Method: Installer>>classMCMczReader (in category 'class references') -----
- classMCMczReader
- 
- ^Smalltalk at: #MCMczReader ifAbsent: [ nil ]
- 	!

Item was removed:
- ----- Method: Installer>>maRead:field: (in category 'mantis') -----
- maRead: page field: fieldKey
- 
- 	 | value |
-  
- 	value := page upToAll: ('!!-- ', fieldKey, ' -->'); upToAll: '<td'; upTo: $>; upToAll: '</td>'.
- 	
- 	page upTo: $<.
- 	
- 	page peek = $t ifTrue: [ value := page upToAll: 'td'; upTo: $>; upToAll: '</td>' ].
- 	  
- 	^Association key: fieldKey value: value withBlanksTrimmed!

Item was removed:
- ----- Method: Installer>>maScript (in category 'mantis') -----
- maScript 
- 
- 	^self extractFromHtml: self maPage option: #last
- !

Item was removed:
- ----- Method: Installer classSide>>history (in category 'documentation') -----
- history
- 
- "
- 7 Jan 2007  
- !!Installer fixBug: <aBugNo>
- 
- 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: <aBugNoOrString>
-  Installer ensureFixes: #(1 2 3 4)
- 
- Installer now keeps a list of fix <aBugNoOrString> 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: <webPageNameOrUrl>
- 
- 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=<webPageNameOrUrl>
- 
- 10 Jan 2007
- !!Now matches simpler html
- 
- Check for an html page, now matches
- '<!!DOCTYPE HTML' and <html> 
- the allows use of pbwiki's raw=bare option which returns iframe 
- embeddable html without the usual headers.
- "!

Item was removed:
- ----- Method: Installer>>bug: (in category 'mantis') -----
- bug: aBugNo
- 
- "
- Installer mantis viewBug: 5639.
- "
- 	| page text | 
- 
- 	self setBug: aBugNo.
- 	
- 	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	
- !

Item was removed:
- ----- Method: Installer>>urlGet: (in category 'url') -----
- 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
- 	!

Item was removed:
- ----- Method: Installer>>smReleasesForPackage: (in category 'squeakmap') -----
- smReleasesForPackage: name 
- 
- ^(self classSMSqueakMap default packageWithName: name) releases!

Item was removed:
- ----- Method: Installer>>setBug: (in category 'mantis') -----
- setBug: stringOrNumber
-  
-   | str |
-  
-  stringOrNumber isInteger ifTrue: [ bug := stringOrNumber. desc := ''. ^self ].
-  
-  bug := stringOrNumber asInteger.
-  str := str printString. 
-  desc := stringOrNumber copyFrom: (str size + 1) to: (stringOrNumber size) !

Item was removed:
- ----- Method: Installer>>info (in category 'accessing') -----
- info
- 
- self sm ifTrue: [ ^ self smInfo  ].
- self wsm ifNotNil: [ ^ self wsmInfo  ].!

Item was removed:
- ----- Method: Installer>>date: (in category 'accessing') -----
- date: anObject
- 	"Set the value of markers"
- 
- 	date := anObject asDate!

Item was removed:
- ----- Method: Installer>>ensureFix: (in category 'mantis') -----
- ensureFix: aBugNo
- 
- 	| fixesAppliedNumbers |
- 	
- 	self setBug: aBugNo.
- 	
- 	fixesAppliedNumbers := self class fixesApplied collect: [ :fixDesc | fixDesc asInteger ].
- 	
- 	(fixesAppliedNumbers includes: bug) ifFalse: [ self fixBug: aBugNo ]!

Item was removed:
- ----- Method: Installer>>httpGet: (in category 'utils') -----
- httpGet: aUrl
- 
- 	| page |
- 
- 	page := self classHTTPSocket httpGet: aUrl accept: 'application/octet-stream'.  
-  
- 	(page respondsTo: #reset)  ifFalse: [ self error: 'unable to contact web site' ].
-  
- 	^ page
- 	!

Item was removed:
- ----- Method: Installer>>maCheckDateAgainst: (in category 'utils') -----
- maCheckDateAgainst: okDate
- 
- 	(okDate notNil and: [date < okDate asDate ]) ifTrue: [ self notify: 'bug ', self bug asString, ' updated on ', date printString ].
-  !

Item was removed:
- ----- Method: Installer>>isHtmlStream: (in category 'url') -----
- isHtmlStream: page
- 
- 	"matches  '<!!DOCTYPE HTML', and <html>' "
- 	
- 	| first |	
- 	
- 	first := (page next: 14) asUppercase.
- 	
- 	^ (first = '<!!DOCTYPE HTML') | (first beginsWith: '<HTML>')
- 	
- !

Item was removed:
- ----- Method: Installer>>classMCHttpRepository (in category 'class references') -----
- classMCHttpRepository
- 
- ^Smalltalk at: #MCHttpRepository ifAbsent: [ self error: 'Monticello not present' ]
- 	!

Item was removed:
- ----- Method: Installer>>wsm: (in category 'websqueakmap') -----
- wsm: aUrl
-  
- 	"Set the value of host"
- 
- 	wsm := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]!

Item was removed:
- ----- Method: Installer>>project: (in category 'accessing') -----
- project: anObject
- 	"Set the value of project"
- 
- 	project := anObject.
- 
- 	^self copy.!

Item was removed:
- ----- Method: Installer>>fixBug:date: (in category 'mantis') -----
- fixBug: aBugNo date: aDate
- 
- 	self setBug: aBugNo.
- 	
-  	self install: self maUrl from: self maScript.
- 	
- 	self maCheckDateAgainst: aDate.
- 	
- 	
- 	
- !

Item was removed:
- ----- Method: Installer>>markersTest (in category 'url') -----
- markersTest
- 		 	 
- 	 ^ self markers readStream upToAll: '...'; upToAll: '...'!

Item was removed:
- ----- Method: Installer>>mcRepository (in category 'monticello') -----
- mcRepository
- 
- ^self classMCHttpRepository location: (self mcUrl) user: self user password: self password.!

Item was removed:
- ----- Method: Installer>>smSearch: (in category 'searching') -----
- smSearch: aMatch  
- 
- 	| results |
- 	
- 	results := Set new.
- 
- 	self packages 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
- 
- !

Item was removed:
- ----- Method: Installer>>removeHtmlMarkupFrom: (in category 'url') -----
- 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.
- !

Item was removed:
- ----- Method: Installer>>desc: (in category 'accessing') -----
- desc: anObject
- 
- 	desc := anObject!

Item was removed:
- ----- Method: Installer>>sm (in category 'accessing') -----
- sm
- 	"Answer the value of sm"
- 
- 	^ sm ifNil: [ false ]!

Item was removed:
- ----- Method: Installer>>webAction:reportOn: (in category 'action report') -----
- webAction: line reportOn: report
- 	
- 	package :=  line readStream upTo: $' ; upTo: $'.
- 
- 	self reportSection: line on: report.
- 	
-  	url := self webFindUrlToDownload.
- 	
- 	self reportFor: line page: pageDataStream on: report !

Item was removed:
- ----- Method: Installer>>password: (in category 'accessing') -----
- password: anObject
- 	"Set the value of password"
- 
- 	password := anObject!

Item was removed:
- ----- Method: Installer>>url (in category 'accessing') -----
- url
- 
- ^url!

Item was removed:
- ----- Method: Installer>>urlAction:reportOn: (in category 'action report') -----
- urlAction: 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 !

Item was removed:
- ----- Method: Installer>>webInstall (in category 'web install') -----
- webInstall 
- "
- Installer install: 'MyPage'.
- "
-  	url := self webFindUrlToDownload ifNil: [ self logCR: 'url not found'. self error: 'url not found' ].
- 	
- 	self logCR: 'found ',  url, ' ...'.
- 	
- 	pageDataStream size > 0 
- 		ifTrue: [ self install: url from: pageDataStream ]
- 		ifFalse: [ self logCR: '...',url,' was empty' ].
- 	
- 	^ pageDataStream.
- 
- 	!

Item was removed:
- ----- Method: Installer>>wsmReleasesFor: (in category 'websqueakmap') -----
- 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
- 	!

Item was removed:
- ----- Method: Installer>>password (in category 'accessing') -----
- password
- 	"Answer the value of password"
- 
- 	^ password  ifNil: [ '' ]!

Item was removed:
- ----- Method: Installer>>mcUrl (in category 'monticello') -----
- mcUrl
- 
- ^ self mc, (self project ifNil: [''])!

Item was removed:
- ----- Method: Installer>>user: (in category 'accessing') -----
- user: anObject
- 	"Set the value of user"
- 
- 	user := anObject!

Item was removed:
- ----- Method: Installer>>markersEnd (in category 'url') -----
- 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 ]
- 	!

Item was removed:
- ----- Method: Installer>>url: (in category 'accessing') -----
- url: aUrl
-  
-  url := aUrl!

Item was removed:
- ----- Method: Installer classSide>>sourceFiles (in category 'accessing system') -----
- sourceFiles
- 
- ^ SourceFiles!

Item was removed:
- ----- Method: Installer>>bug:retrieve: (in category 'mantis') -----
- bug: aBugNo retrieve: aFileName
- 
- 	 self setBug: aBugNo.
- 
- 	^ (self maStreamForFile: aFileName) contents!

Item was removed:
- ----- Method: Installer>>wsm (in category 'websqueakmap') -----
- wsm
- 	"Answer the value of wsm"
- 	
- 	^ wsm!

Item was removed:
- ----- Method: Installer classSide>>unload: (in category 'utility') -----
- unload: categoryMatchesString 
- 
- ^ self new unload: categoryMatchesString!

Item was removed:
- ----- Method: Installer>>maStreamForFile: (in category 'mantis') -----
- 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').
- 	 !

Item was removed:
- ----- Method: Installer classSide>>classProjectLauncher (in category 'accessing system') -----
- classProjectLauncher
- 
- ^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!

Item was removed:
- ----- Method: Installer>>user (in category 'accessing') -----
- user
- 	"Answer the value of user"
- 
- 	^ user ifNil: [ '' ]!

Item was removed:
- ----- Method: Installer>>maUrlFor: (in category 'mantis') -----
- maUrlFor: maBugNo
-  
- 	^ url := self ma, 'view.php?id=', maBugNo asString 
-  !

Item was removed:
- ----- Method: Installer classSide>>fixesApplied (in category 'as yet unclassified') -----
- fixesApplied
- 
- ^ Fixes ifNil: [ Fixes := OrderedCollection new ].!

Item was removed:
- ----- Method: Installer>>smVersions (in category 'squeakmap') -----
- smVersions
-  
- ^ (self smReleasesForPackage: self package) collect: [ :v | self copy package: (v package name,'(',v version,')'); yourself. ] 
- 
-  !

Item was removed:
- ----- Method: Installer>>classSMSqueakMap (in category 'class references') -----
- classSMSqueakMap
- 
- ^Smalltalk at: #SMSqueakMap  ifAbsent: [ self error: 'SqueakMap not present' ]!

Item was removed:
- ----- Method: Installer>>desc (in category 'accessing') -----
- desc
- 	 
- 	^ desc!

Item was removed:
- ----- Method: Installer>>wsmVersions (in category 'websqueakmap') -----
- wsmVersions
- 
- | pkgAndVersion packageId packageName packageVersion versions |
- 
- 	pkgAndVersion := self smPackageAndVersion.
- 	packageName := pkgAndVersion first.
- 	packageVersion := pkgAndVersion last.
- 	packageVersion isEmpty ifTrue: [ packageVersion := #latest ].
- 
- 	packageId := self wsmPackagesByName at: packageName.
- 	
- 	versions := (self wsmReleasesFor: packageId) keys asSet.
- 	versions remove: #latest.
- 	
- 	^ versions collect: [ :version | self copy package: (packageName,'(', version ,')'); yourself ]. !

Item was removed:
- ----- Method: Installer>>preambleCsForRB: (in category 'mantis') -----
- preambleCsForRB: aBugNo
- "
- Installer mantis preambleCsForRB: 5936.
- "
- 	| page text   | 
- 
- 	self setBug: aBugNo.
- 	
- 	page := self maPage.
-  
- 	text := String streamContents: [ :str |	
- 			
- 		#('Reporter'  'Summary' 'Description' 'Additional Information' ) 
- 				do: [ :field |
- 						| f |
- 						f := self maRead: page field: field.
- 			str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr.
- 		]
- 	].
-  	
- ^ text	!

Item was removed:
- ----- Method: Installer>>bug:view: (in category 'mantis') -----
- bug: aBugNo view: aFileName
- 
- 	| file list |
- 	
- 	self setBug: aBugNo.
- 	
- 	file :=  self maStreamForFile: aFileName.
- 
- 	list := self classChangeList new
- 			scanFile:  file from: 1 to: file size.
- 		 
- 	self classChangeList open: list name: (aFileName, ' mantis: ', aBugNo printString) 
- 		multiSelect: true.!

Item was removed:
- ----- Method: Installer>>justFixBug: (in category 'mantis') -----
- justFixBug: aBugNo
- 
- 	^self class skipLoadingTests: true during: [ self fixBug: aBugNo date: nil ]!

Item was removed:
- ----- Method: Installer>>skipTests (in category 'mantis') -----
- skipTests
- 
- !

Item was removed:
- ----- Method: Installer>>wsmPackagesByName (in category 'websqueakmap') -----
- wsmPackagesByName
- 
- 	| html id name | 
- 	
- 	packages ifNotNil: [ ^packages ].
- 	
- 	packages := Dictionary new.
- 	
- 	html := self httpGet: (self wsm, 'packagesbyname').
- 	
- 	[
- 		id := html upToAll: '/package/'; upToAll: '">'.
- 		name := html upTo: $<.
- 		
- 		(id notEmpty and: [ name notEmpty ]) 
- 
- 	] whileTrue: [ packages at: name put: id ].
- 
- 	^ packages	
- 	!

Item was removed:
- ----- Method: Installer classSide>>entities (in category 'as yet unclassified') -----
- 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
- ]
- 
-  !

Item was removed:
- ----- Method: Installer>>wsmInstall (in category 'websqueakmap') -----
- wsmInstall 
- 
- 	| downloadUrl |
- 
- 	self logCR: 'finding ', self package, ' from websqueakmap(', self wsm, ') ...'.
- 
- 	downloadUrl := self wsmDownloadUrl.
- 	
- 	self logCR: 'found at ', downloadUrl asString, ' ...'.
- 	 
- 	self install: downloadUrl from: (self httpGet: downloadUrl).
- 
- 	!

Item was removed:
- ----- Method: Installer>>urlInstall (in category 'url') -----
- urlInstall 
- "
- Installer installUrl: 'wiki.squeak.org/742'.
- "
-  
- 	self logCR: 'retrieving ', self urlToDownload , ' ...'.
- 	
- 	(pageDataStream := self urlGet: self urlToDownload) 
- 		ifNil: [ self error: 'unable to contact host' ].
- 	 
- 	self install: self urlToDownload from: pageDataStream.
- 	
- 	^ pageDataStream 
- !

Item was removed:
- ----- Method: Installer>>classHTTPSocket (in category 'class references') -----
- classHTTPSocket
- 
- ^Smalltalk at: #HTTPSocket ifAbsent: [ self error: 'Network package not present' ]!

Item was removed:
- ----- Method: Installer>>markers: (in category 'accessing') -----
- markers: anObject
- 	"Set the value of markers"
- 
- 	markers := anObject!

Item was removed:
- ----- Method: Installer classSide>>skipLoadingTests:during: (in category 'as yet unclassified') -----
- skipLoadingTests: yesNo during: block
- 
- 	| oldValue |
- 
- 	oldValue := SkipLoadingTests.
- 	SkipLoadingTests := yesNo.
- 	
- 	block ensure:[ SkipLoadingTests := oldValue ].!

Item was removed:
- ----- Method: Installer classSide>>smalltalkImage (in category 'accessing system') -----
- smalltalkImage
- 
- ^ SmalltalkImage current!

Item was removed:
- ----- Method: Installer>>unload: (in category 'script bindings') -----
- unload: categoryMatchesString 
- 
-  (SystemOrganization categoriesMatching: categoryMatchesString) do: [ :cat | 
-      self logCR: 'Unloading ', cat.
-  	(MCPackage named: cat)  workingCopy unload.
- 	SystemOrganization removeCategory: cat.
-  ].
- 
- "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 ] ].!

Item was removed:
- ----- Method: Installer>>mantisAction:reportOn: (in category 'action report') -----
- mantisAction: 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.
- 	!

Item was removed:
- ----- Method: Installer>>smPackages (in category 'squeakmap') -----
- smPackages
- 	
- ^self classSMSqueakMap default packagesByName!

Item was removed:
- ----- Method: Installer>>maReadNotes: (in category 'mantis') -----
- maReadNotes: page 
- 
- 	 |  notes note  |
-  
- 	notes := OrderedCollection new.
- 
- 	[ page upToAll: 'tr class="bugnote"'; upTo: $>.
- 	  page atEnd ]
- 		
- 	whileFalse: [ 
- 		note := (self removeHtmlMarkupFrom: (page upToAll: '</tr>') readStream) contents.
- 		note := note withBlanksCondensed.
- 		"note replaceAll: Character cr with: $ ."
- 		note replaceAll: Character lf with: Character cr.
- 		notes add: note  
- 	].
- 	
- 	^notes!

Item was removed:
- ----- Method: Installer>>evaluate: (in category 'mantis') -----
- evaluate: stream
- 
- stream fileIn.!



More information about the Packages mailing list