[squeak-dev] The Trunk: System-nice.636.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 6 22:30:09 UTC 2013


Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.636.mcz

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

Name: System-nice.636
Author: nice
Time: 6 December 2013, 11:28:52.246 pm
UUID: e1f5ee68-5a4c-4c7b-82d4-d093f2b6b571
Ancestors: System-fbs.635

Deprecate updateStream utilities

=============== Diff against System-fbs.635 ===============

Item was removed:
- ----- Method: Utilities class>>applyUpdatesFromDisk (in category 'fetching updates') -----
- applyUpdatesFromDisk
- 	"Utilities applyUpdatesFromDisk"
- 	"compute highest update number"
- 	| updateDirectory updateNumbers |
- 	updateDirectory := self getUpdateDirectoryOrNil.
- 	updateDirectory
- 		ifNil: [^ self].
- 	updateNumbers := updateDirectory fileNames
- 				collect: [:fn | fn initialIntegerOrNil]
- 				thenSelect: [:fn | fn notNil].
- 	self
- 		applyUpdatesFromDiskToUpdateNumber: (updateNumbers
- 				inject: 0
- 				into: [:max :num | max max: num])
- 		stopIfGap: false!

Item was removed:
- ----- Method: Utilities class>>applyUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'fetching updates') -----
- applyUpdatesFromDiskToUpdateNumber: 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:  
- 	 
- 	Utilities applyUpdatesFromDiskToUpdateNumber: 1234 stopIfGap: false  
- 	 
- 	and all numbered updates <= lastUpdateNumber not yet in the image will 
- 	be loaded in numerical order."
- 	| previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded |
- 	updateDirectory := self getUpdateDirectoryOrNil.
- 	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 removed:
- ----- Method: Utilities class>>assureAbsenceOfUnstableUpdateStream (in category 'fetching updates') -----
- assureAbsenceOfUnstableUpdateStream
- 	"Check to see if the unstable Updates stream is in the list; if it is, *remove* it.  This is the *opposite* of #assureAvailabilityOfUnstableUpdateStream"
- 
- 	UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new].
- 	UpdateUrlLists := UpdateUrlLists select:
- 		[:pair | pair first ~= 'Unstable Updates*']
- 
- 
- "Utilities assureAbsenceOfUnstableUpdateStream"!

Item was removed:
- ----- Method: Utilities class>>assureAvailabilityOfUnstableUpdateStream (in category 'fetching updates') -----
- assureAvailabilityOfUnstableUpdateStream
- 	"Check to see if the unstable Updates stream is in the list; if not, add it"
- 
- 	UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new].
- 	UpdateUrlLists do:
- 		[:pair | (pair first =  'Unstable Updates*') ifTrue: [^ self]].
- 
- 	UpdateUrlLists addFirst: #('Unstable Updates*' #('squeak.cs.uiuc.edu/Squeak2.0/' 'update.squeakfoundation.org/external/'))
- 
- "Utilities assureAvailabilityOfUnstableUpdateStream"!

Item was removed:
- ----- Method: Utilities class>>broadcastUpdatesFrom:to:except: (in category 'fetching updates') -----
- broadcastUpdatesFrom: n1 to: n2 except: skipList
- "
- 	Note:  This method takes its list of files from the directory named 'updates',
- 	which will have been created and filled by, eg,
- 		Utilities readServerUpdatesSaveLocally: true updateImage: true.
- 	These can then be rebroadcast to any server using, eg,
- 		Utilities broadcastUpdatesFrom: 1 to: 9999 except: #(223 224).
- 	If the files are already on the server, and it is only a matter
- 	of copying them to the index for a different version, then use...
- 		(ServerDirectory serverInGroupNamed: 'SqC Internal Updates*')
- 			exportUpdatesExcept: #().
- "
- 	| fileNames fileNamesInOrder names choice file updateDirectory |
- 	updateDirectory := FileDirectory default directoryNamed: 'updates'.
- 	fileNames := updateDirectory fileNames select:
- 		[:n | n first isDigit
- 			and: [(n initialIntegerOrNil between: n1 and: n2)
- 			and: [(skipList includes: n initialIntegerOrNil) not]]].
- 	(file := fileNames select: [:n | (n occurrencesOf: $.) > 1]) size > 0
- 		ifTrue: [self halt: file first , ' has multiple periods'].
- 	fileNamesInOrder := fileNames asSortedCollection:
- 		[:a :b | a initialIntegerOrNil < b initialIntegerOrNil].
- 
- 	names := ServerDirectory groupNames asSortedArray.
- 	choice := UIManager default chooseFrom: names values: names.
- 	choice == nil ifTrue: [^ self].
- 	(ServerDirectory serverInGroupNamed: choice)
- 		putUpdateMulti: fileNamesInOrder fromDirectory: updateDirectory
- !

Item was removed:
- ----- Method: Utilities class>>chooseUpdateList (in category 'fetching updates') -----
- chooseUpdateList
- 	"When there is more than one set of update servers, let the user choose which we will update from.  Put it at the front of the list. Return false if the user aborted.  If the preference #promptForUpdateServer is false, then suppress that prompt, in effect using the same server choice that was used the previous time (a convenience for those of us who always answer the same thing to the prompt.)"
- 
- 	| index him |
- 	((UpdateUrlLists size > 1) and: [Preferences promptForUpdateServer])
- 		ifTrue:
- 			[index := UIManager default 
- 				chooseFrom: (UpdateUrlLists collect: [:each | each first]) 
- 				lines: #()
- 				title: 'Choose a group of servers\from which to fetch updates.' translated withCRs.
- 			index > 0 ifTrue:
- 				[him := UpdateUrlLists at: index.
- 				UpdateUrlLists removeAt: index.
- 				UpdateUrlLists addFirst: him].
- 			^ index > 0].
- 	^ true!

Item was removed:
- ----- Method: Utilities class>>extractThisVersion: (in category 'fetching updates') -----
- extractThisVersion: list
- 	"Pull out the part of the list that applies to this version."
- 
- 	| listContents version versIndex |
- 	listContents := self parseListContents: list.
- 	version := SystemVersion current version.
- 	
- 	versIndex := (listContents collect: [:pair | pair first]) indexOf: version.
- 	versIndex = 0 ifTrue: [^ Array new].		"abort"
- 	^ (listContents at: versIndex) last!

Item was removed:
- ----- Method: Utilities class>>fileInFromUpdatesFolder: (in category 'fetching updates') -----
- fileInFromUpdatesFolder: numberList
- 	"File in a series of updates with the given updates numbers, from the updates folder in the default directory.  The file-ins are done in numeric order, even if numberList was not sorted upon entry.
- 	This is useful for test-driving the retrofitting of a possibly discontinguous list of updates from an alpha version back to a stable release.
- 
- 	Utilities fileInFromUpdatesFolder: #(4745 4746 4747 4748 4749 4750 4751 4752 4754 4755 4761 4762 4767 4769).
- "
- 	| fileNames fileNamesInOrder file updateDirectory |
- 	updateDirectory := FileDirectory default directoryNamed: 'updates'.
- 	fileNames := updateDirectory fileNames select:
- 		[:n | n first isDigit
- 			and: [numberList includes: n initialIntegerOrNil]].
- 	(file := fileNames select: [:n | (n occurrencesOf: $.) > 1]) size > 0
- 		ifTrue: [self error: file first , ' has multiple periods'].
- 	fileNamesInOrder := fileNames asSortedCollection:
- 		[:a :b | a initialIntegerOrNil < b initialIntegerOrNil].
- 
- 	fileNamesInOrder do:
- 		[:aFileName | (updateDirectory readOnlyFileNamed: aFileName) fileIntoNewChangeSet]!

Item was removed:
- ----- Method: Utilities class>>getUpdateDirectoryOrNil (in category 'fetching updates') -----
- getUpdateDirectoryOrNil
- 	^ (FileDirectory default directoryNames includes: 'updates')
- 		ifTrue: [FileDirectory default directoryNamed: 'updates']
- 		ifFalse: [self inform: 'Error: cannot find "updates" folder'.
- 			nil]!

Item was removed:
- ----- Method: Utilities class>>lastUpdateNum: (in category 'fetching updates') -----
- lastUpdateNum: updatesFileStrm
- 	"Look in the Updates file and see what the last sequence number is.  Warn the user if the version it is under is not this image's version."
- 
- 	| verIndex seqIndex char ver seqNum |
- 	verIndex := seqIndex := 0.	 "last # starting a line and last digit starting a line"
- 	seqNum := 0.
- 	updatesFileStrm reset; ascii.
- 	[char := updatesFileStrm next.
- 	 updatesFileStrm atEnd] whileFalse: [
- 		char == Character cr ifTrue: [
- 			updatesFileStrm peek == $# ifTrue: [verIndex := updatesFileStrm position +1.
- 				seqIndex = 0 ifFalse: ["See if last num of old version if biggest so far"
- 					updatesFileStrm position: seqIndex.
- 					ver := SmallInteger readFrom: updatesFileStrm.
- 					seqNum := seqNum max: ver.
- 					updatesFileStrm position: verIndex-1]].
- 			updatesFileStrm peek isDigit ifTrue: [seqIndex := updatesFileStrm position]]].
- 
- 	seqIndex = 0 ifFalse: ["See if last num of old version if biggest so far"
- 		updatesFileStrm position: seqIndex.
- 		ver := SmallInteger readFrom: updatesFileStrm.
- 		seqNum := seqNum max: ver.
- 		updatesFileStrm setToEnd].
- 	^ seqNum!

Item was removed:
- ----- Method: Utilities class>>newUpdatesOn:special:throughNumber: (in category 'fetching updates') -----
- newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber
- 	"Return a list of fully formed URLs of update files we do not yet have.  Go to the listed servers and look at the file 'updates.list' for the names of the last N update files.  We look backwards for the first one we have, and make the list from there.  tk 9/10/97
- 	No updates numbered higher than aNumber (if it is not nil) are returned " 
- 
- 	| existing out maxNumber |
- 	maxNumber := aNumber ifNil: [99999].
- 	out := OrderedCollection new.
- 	existing := SystemVersion current updates.
- 	serverList do: [:server | | raw doc list char |
- 		doc := HTTPClient httpGet: 'http://' , server,indexPrefix,'updates.list'.
- 		
- 		"test here for server being up"
- 		doc class == RWBinaryOrTextStream ifTrue:
- 			[raw := doc reset; contents.	"one file name per line"
- 			list := self extractThisVersion: raw.
- 			list reverseDo: [:fileName | | ff itsNumber |
- 				ff := (fileName findTokens: '/') last.	"allow subdirectories"
- 				itsNumber := ff initialIntegerOrNil. 
- 				(existing includes: itsNumber)
- 					ifFalse:
- 						[
- 						(itsNumber == nil or: [itsNumber <= maxNumber])
- 							ifTrue:
- 								[out addFirst: 'http://' , server, fileName]]
- 					ifTrue: [^ out]].
- 			((out size > 0) or: [char := doc reset; skipSeparators; next.
- 				(char == $*) | (char == $#)]) ifTrue:
- 					[^ out "we have our list"]].	"else got error msg instead of file"
- 		"Server was down, try next one"].
- 	self inform: 'All code update servers seem to be unavailable'.
- 	^ out!

Item was removed:
- ----- Method: Utilities class>>objectStrmFromUpdates: (in category 'fetching updates') -----
- objectStrmFromUpdates: fileName
- 	"Go to the known servers and look for this file in the updates folder.  It is an auxillery file, like .morph or a .gif.  Return a RWBinaryOrTextStream on it.    Meant to be called from during the getting of updates from the server.  That assures that (Utilities serverUrls) returns the right group of servers."
- 	Cursor wait showWhile:
- 		[ | urls |
- 		urls := Utilities serverUrls collect: [:url | url, 'updates/', fileName].
- 		urls do: [:aUrl | | doc |
- 			doc := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'.
- 			"test here for server being up"
- 			doc class == RWBinaryOrTextStream ifTrue: [^ doc reset]]].
- 
- 	self inform: 'All update servers are unavailable, or bad file name'.
- 	^ nil!

Item was removed:
- ----- Method: Utilities class>>parseListContents: (in category 'fetching updates') -----
- parseListContents: listContents
- 	| sections vers strm line fileNames |
- 	"Parse the contents of updates.list into {{vers. {fileNames*}}*}, and return it."
- 
- 	sections := OrderedCollection new.
- 	fileNames := OrderedCollection new: 1000.
- 	vers := nil.
- 	strm := ReadStream on: listContents.
- 	[strm atEnd] whileFalse:
- 		[line := strm nextLine.
- 		line size > 0 ifTrue:
- 			[line first = $#
- 				ifTrue: [vers ifNotNil: [sections addLast: {vers. fileNames asArray}].
- 						"Start a new section"
- 						vers := line allButFirst.
- 						fileNames resetTo: 1]
- 				ifFalse: [line first = $* ifFalse: [fileNames addLast: line]]]].
- 	vers ifNotNil: [sections addLast: {vers. fileNames asArray}].
- 	^ sections asArray
- " TEST:
-  | list |
- list := Utilities parseListContents: (FileStream oldFileNamed: 'updates.list') contentsOfEntireFile.
- list = (Utilities parseListContents: (String streamContents: [:s | Utilities writeList: list toStream: s]))
- 	ifFalse: [self error: 'test failed']
- 	ifTrue: [self inform: 'test OK']
- "!

Item was removed:
- ----- Method: Utilities class>>position:atVersion: (in category 'fetching updates') -----
- position: updateStrm atVersion: version
- 	"Set the stream to the end of the last line of updates names for this version.  Usually the end of the file.  We will add a new update name.   Return the contents of the rest of the file."
- 
- 	| char foundIt where data |
- 	updateStrm reset; ascii.
- 	foundIt := false.
- 	[char := updateStrm next.
- 	 updateStrm atEnd] whileFalse: [
- 		(char == Character cr or: [char == Character lf]) ifTrue: [
- 			updateStrm peek == $# ifTrue: [
- 				foundIt ifTrue: ["Next section"
- 					where := updateStrm position.
- 					data := updateStrm upTo: (255 asCharacter).
- 					updateStrm position: where.
- 					^ data].	"won't be found -- copy all the way to the end"
- 				updateStrm next.
- 				(updateStrm nextMatchAll: version) ifTrue: [
- 					(updateStrm atEnd or: [(updateStrm peek = Character cr) | 
- 						(updateStrm peek = Character lf)]) ifTrue: [
- 							foundIt := true
- 					]]]]].
- 	foundIt ifTrue: [
- 		updateStrm setToEnd.
- 		^ ''].
- 	self error: 'The current version does not have a section in the Updates file'.
- !

Item was removed:
- ----- Method: Utilities class>>readNextUpdateFromServer (in category 'fetching updates') -----
- readNextUpdateFromServer
- 	"Utilities readNextUpdateFromServer"
- 	self updateFromServerThroughUpdateNumber: (ChangeSet highestNumberedChangeSet + 1)!

Item was removed:
- ----- Method: Utilities class>>readNextUpdatesFromDisk: (in category 'fetching updates') -----
- readNextUpdatesFromDisk: n
- 	"Read the updates up through the current highest-update-number plus n.  Thus, 
- 	Utilities readNextUpdatesFromDisk: 7
- will read the next seven updates from disk"
- 
- 	self applyUpdatesFromDiskToUpdateNumber: ChangeSet highestNumberedChangeSet + n
- 		stopIfGap: false!

Item was removed:
- ----- Method: Utilities class>>readServer:special:updatesThrough:saveLocally:updateImage: (in category 'fetching updates') -----
- readServer: serverList special: indexPrefix updatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage
- 	"Scan the update server(s) for unassimilated updates. If maxNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point.   If saveLocally is true, then save local copies of the update files on disc.  If updateImage is true, then absorb the updates into the current image."
- 
- "Utilities readServer: Utilities serverUrls updatesThrough: 828 saveLocally: true updateImage: true"
- 
- 	| str urls failed loaded |
- 	Cursor wait showWhile: [ | docQueue docQueueSema |
- 
- 	urls := self newUpdatesOn: (serverList collect: [:url | url, 'updates/']) 
- 				special: indexPrefix
- 				throughNumber: maxNumber.
- 	loaded := 0.
- 	failed := nil.
- 
- 	"send downloaded documents throuh this queue"
- 	docQueue := SharedQueue new.
- 
- 	"this semaphore keeps too many documents from beeing queueed up at a time"
- 	docQueueSema := Semaphore new.
- 	5 timesRepeat: [ docQueueSema signal ].
- 
- 	"fork a process to download the updates"
- 	self retrieveUrls: urls ontoQueue: docQueue withWaitSema: docQueueSema.
- 
- 	"process downloaded updates in the foreground"
- 	'Processing updates' displayProgressFrom: 0 to: urls size during: [:bar | | nextDoc this updateName |
- 	[ this := docQueue next.
- 	  nextDoc := docQueue next.  
- 	  nextDoc = #failed ifTrue: [ failed := this ].
- 	  (failed isNil and: [ nextDoc ~= #finished ])
- 	] whileTrue: [
- 		failed ifNil: [
- 			nextDoc reset; text.
- 			nextDoc size = 0 ifTrue: [ failed := this ]. ].
- 		failed ifNil: [
- 			nextDoc peek asciiValue = 4	"pure object file"
- 				ifTrue: [failed := this]].	"Must be fileIn, not pure object file"
- 		failed ifNil: [
- 			"(this endsWith: '.html') ifTrue: [doc := doc asHtml]."
- 				"HTML source code not supported here yet"
- 			updateImage
- 				ifTrue: [
- 					updateName := (this findTokens: '/') last.
- 					ChangeSet newChangesFromStream: nextDoc named: updateName.
- 					SystemVersion current registerUpdate: updateName initialIntegerOrNil].
- 			saveLocally ifTrue:
- 				[self saveUpdate: nextDoc onFile: (this findTokens: '/') last].	"if wanted"
- 			loaded := loaded + 1.
- 			bar value: loaded].
- 
- 		docQueueSema signal].
- 	]].
- 
- 	failed ~~ nil & (urls size - loaded > 0) ifTrue: [
- 		str := loaded printString ,' new update file(s) processed.'.
- 		str := str, '\Could not load ' withCRs, 
- 			(urls size - loaded) printString ,' update file(s).',
- 			'\Starting with "' withCRs, failed, '".'.
- 		self inform: str].
- 	^ Array with: failed with: loaded
- !

Item was removed:
- ----- Method: Utilities class>>readServerUpdatesSaveLocally:updateImage: (in category 'fetching updates') -----
- readServerUpdatesSaveLocally: saveLocally updateImage: updateImage
- 	^ self readServerUpdatesThrough: nil saveLocally: saveLocally updateImage: updateImage!

Item was removed:
- ----- Method: Utilities class>>readServerUpdatesThrough:saveLocally:updateImage: (in category 'fetching updates') -----
- readServerUpdatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage
- 	"Scan the update server(s) for unassimilated updates. If maxNumber is not nil, it represents the highest-numbered update to load.  This makes it possible to update only up to a particular point.   If saveLocally is true, then save local copies of the update files on disc.  If updateImage is true, then absorb the updates into the current image.
- 
- A file on the server called updates.list has the names of the last N update files.  We look backwards for the first one we do not have, and start there"
- "* To add a new update:  Name it starting with a new two-digit code.  
- * Do not use %, /, *, space, or more than one period in the name of an update file.
- * The update name does not need to have any relation to the version name.
- * Figure out which versions of the system the update makes sense for.
- * Add the name of the file to each version's category below.
- * Put this file and the update file on all of the servers.
- *
- * To make a new version of the system:  Pick a name for it (no restrictions)
- * Put # and exactly that name on a new line at the end of this file.
- * During the release process, fill in exactly that name in the dialog box.
- * Put this file on the server."
- "When two sets of updates need to use the same directory, one of them has a * in its 
- serverUrls description.  When that is true, the first word of the description is put on
- the front of 'updates.list', and that is the index file used."
- 
- "Utilities readServerUpdatesThrough: 3922 saveLocally: true updateImage: true"
- 
- 	| failed loaded str res servers triple tryAgain indexPrefix |
- 	Utilities chooseUpdateList ifFalse: [^ self].	"ask the user which kind of updates"
- 
- 	servers := Utilities serverUrls copy.
- 	indexPrefix := (Utilities updateUrlLists first first includes: $*) 
- 		ifTrue: [(Utilities updateUrlLists first first findTokens: ' ') first]
- 						"special for internal updates"
- 		ifFalse: ['']. 	"normal"
- 	[servers isEmpty] whileFalse: [
- 		triple := self readServer: servers special: indexPrefix 
- 					updatesThrough: maxNumber 
- 					saveLocally: saveLocally updateImage: updateImage.
- 
- 		"report to user"
- 		failed := triple first.
- 		loaded := triple second.
- 		tryAgain := false.
- 		failed ifNil: ["is OK"
- 			loaded = 0 ifTrue: ["found no updates"
- 				servers size > 1 ifTrue: ["not the last server"
- 					res := UIManager default 
- 							chooseFrom: #('Stop looking' 'Try next server')
- 							title: 
- 'No new updates on the server
- ', servers first, '
- Would you like to try the next server?
- (Normally, all servers are identical, but sometimes a
- server won''t let us store new files, and gets out of date.)' 
- 						.
- 					res = 2 ifFalse: [^ self]
- 						 ifTrue: [servers := servers allButFirst.	"try the next server"
- 							tryAgain := true]]]].
- 		tryAgain ifFalse: [
- 			str := loaded printString ,' new update file(s) processed.'.
- 			^ self inform: str].
- 	].!

Item was removed:
- ----- Method: Utilities class>>retrieveUrls:ontoQueue:withWaitSema: (in category 'fetching updates') -----
- retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema 
- 	"download the given list of URLs. The queue will be loaded alternately  
- 	with url's and with the retrieved contents. If a download fails, the  
- 	contents will be #failed. If all goes well, a special pair with an empty  
- 	URL and the contents #finished will be put on the queue. waitSema is  
- 	waited on every time before a new document is downloaded; this keeps 
- 	the downloader from getting too far  ahead of the main process"
- 	"kill the existing downloader if there is one"
- 	| updateCounter |
- 	UpdateDownloader
- 		ifNotNil: [UpdateDownloader terminate].
- 	updateCounter := 0.
- 	"fork a new downloading process"
- 	UpdateDownloader := [
- 		'Downloading updates' displayProgressFrom: 0 to: urls size during: [:bar |
- 			urls
- 				do: [:url | | front canPeek doc | 
- 					waitSema wait.
- 					queue nextPut: url.
- 					doc := HTTPClient httpGet: url.
- 					doc isString
- 						ifTrue: [queue nextPut: #failed.
- 							UpdateDownloader := nil.
- 							Processor activeProcess terminate]
- 						ifFalse: [canPeek := 120 min: doc size.
- 							front := doc next: canPeek.  doc skip: -1 * canPeek.
- 							(front beginsWith: '<!!DOCTYPE') ifTrue: [
- 								(front includesSubString: 'Not Found') ifTrue: [
- 									queue nextPut: #failed.
- 									UpdateDownloader := nil.
- 									Processor activeProcess terminate]]].
- 						UpdateDownloader ifNotNil: [queue nextPut: doc. updateCounter := updateCounter + 1. bar value: updateCounter]]].
- 			queue nextPut: ''.
- 			queue nextPut: #finished.
- 			UpdateDownloader := nil] newProcess.
- 	UpdateDownloader priority: Processor userInterruptPriority.
- 	"start the process running"
- 	UpdateDownloader resume!

Item was removed:
- ----- Method: Utilities class>>saveUpdate:onFile: (in category 'fetching updates') -----
- saveUpdate: doc onFile: fileName
- 	"Save the update on a local file.  With or without the update number on the front, depending on the preference #updateRemoveSequenceNum"
- 
- 	| file fName pos updateDirectory |
- 
- 	(FileDirectory default directoryNames includes: 'updates') ifFalse:
- 		[FileDirectory default createDirectory: 'updates'].
- 	updateDirectory := FileDirectory default directoryNamed: 'updates'.
- 
- 	fName := fileName.
- 	(Preferences valueOfFlag: #updateRemoveSequenceNum) ifTrue:
- 		[pos := fName findFirst: [:c | c isDigit not].
- 		fName := fName copyFrom: pos to: fName size].
- 	doc reset; ascii.
- 	(updateDirectory fileExists: fName) ifFalse:
- 		[file := updateDirectory newFileNamed: fName.
- 		file nextPutAll: doc contents.
- 		file close].
- !

Item was removed:
- ----- Method: Utilities class>>serverUrls (in category 'fetching updates') -----
- serverUrls 
- 	"Return the current list of server URLs.  For code updates.  Format of UpdateUrlLists is 
- #( ('squeak updates' ('url1' 'url2'))
-     ('some other updates' ('url3' 'url4')))"
- 
- 	| list |
- 	list := UpdateUrlLists first last.
- 
- 	"If there is a dead server, return a copy with that server last" 
- 	Socket deadServer ifNotNil: [
- 		list clone withIndexDo: [:aName :ind |
- 		(aName beginsWith: Socket deadServer) ifTrue: [
- 			list := list asOrderedCollection.	"and it's a copy"
- 			list removeAt: ind.
- 			list addLast: aName]]
- 	].
- 
- 	^ list asArray!

Item was removed:
- ----- Method: Utilities class>>setUpdateServer: (in category 'fetching updates') -----
- setUpdateServer: groupName
- 	"Utilities setUpdateServer: 'Squeakland' "
- 	| entry index |
- 
- 
- 	entry := UpdateUrlLists detect: [:each | each first = groupName] ifNone: [^self].
- 	index := UpdateUrlLists indexOf: entry.
- 	UpdateUrlLists removeAt: index.
- 	UpdateUrlLists addFirst: entry!

Item was removed:
- ----- Method: Utilities class>>summariesForUpdates:through: (in category 'fetching updates') -----
- summariesForUpdates: startNumber through: stopNumber
- 	"Answer the concatenation of summary strings for updates numbered in the given range"
- 
- 	^ 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]]
- 
- "Utilities summariesForUpdates: 4899 through: 4903"
- 
- !

Item was removed:
- ----- Method: Utilities class>>updateComment (in category 'fetching updates') -----
- updateComment
- "The following used to be at the beginning of the update file.
- 	Now it is here to simplify parsing the file...
- 
- * To add a new update:  Name it starting with a new four-digit code.  
- * Do not use %, /, *, space, or more than one period in the name of an update file.
- * The update name does not need to have any relation to the version name.
- * Figure out which versions of the system the update makes sense for.
- * Add the name of the file to each version's category below.
- * Put this file and the update file on all of the servers.
- *
- * To make a new version of the system:  Pick a name for it (no restrictions)
- * Put # and exactly that name on a new line at the end of this file.
- * During the release process, fill in exactly that name in the dialog box.
- * Put a copy of updates.list on the server.
- *
- * Special file with a different name for Disney Internal Updates.  
- * No need to move or rename files to release them to external updates.
- "!

Item was removed:
- ----- Method: Utilities class>>updateFromServerThroughUpdateNumber: (in category 'fetching updates') -----
- updateFromServerThroughUpdateNumber: aNumber
- 	"Update the image by loading all pending updates from the server.  Also save local copies of the update files if the #updateSavesFile preference is set to true"
- 
- 	self readServerUpdatesThrough: aNumber saveLocally: Preferences updateSavesFile updateImage: true!

Item was removed:
- ----- Method: Utilities class>>updateUrlLists (in category 'fetching updates') -----
- updateUrlLists
- 
- 	UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new].
- 	^ UpdateUrlLists!

Item was removed:
- ----- Method: Utilities class>>writeList:toStream: (in category 'fetching updates') -----
- writeList: listContents toStream: strm
- 	"Write a parsed updates.list out as text.
- 	This is the inverse of parseListContents:"
- 
- 	
- 	strm reset.
- 	listContents do:
- 		[:pair | | version fileNames |
- 		version := pair first.  fileNames := pair last.
- 		strm nextPut: $#; nextPutAll: version; cr.
- 		fileNames do: [:fileName | strm nextPutAll: fileName; cr]].
- 	strm close!

Item was removed:
- ----- Method: Utilities class>>zapUpdateDownloader (in category 'fetching updates') -----
- zapUpdateDownloader
- 
- 	UpdateDownloader ifNotNil: [UpdateDownloader terminate].
- 	UpdateDownloader := nil.!



More information about the Squeak-dev mailing list