[Pkg] Installer: Installer-Core-mtf.245.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Thu Oct 23 20:54:15 UTC 2008


A new version of Installer-Core was added to project Installer:
http://www.squeaksource.com/Installer/Installer-Core-mtf.245.mcz

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

Name: Installer-Core-mtf.245
Author: mtf
Time: 23 October 2008, 1:55:24 pm
UUID: 821e6e62-edaf-4b30-8456-cdde56e46937
Ancestors: Installer-Core-mtf.235, Installer-Core-kph.244

reverted the MC instanciation code to the way it was before the refactor

=============== Diff against Installer-Core-mtf.235 ===============

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>>logCR: (in category 'logging') -----
  logCR: text
  
  	self validate.
+ 	^ Transcript show: text; cr!
- 	^ Transcript cr; show: text!

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

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

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 class>>universe (in category 'universe') -----
  universe
  
+ 	^ InstallerUniverse default!
- 	^ InstallerUniverse new universe: (self classUGlobalInstaller universe: self classUUniverse systemUniverse)!

Item was changed:
  ----- 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 := self urlGet: self urlToDownload) 
- 		ifNil: [ self error: 'unable to contact host' ].
  	 
  	^ pageDataStream
  	!

Item was changed:
  ----- Method: InstallerMantis>>bug:fix:date: (in category 'public interface') -----
  bug: aBugNo fix: aFileName date: aDate
   
  	| fixed |
  	self setBug: aBugNo.
  	self ditchOldChangeSetFor: aFileName.
  	self install: aFileName from: (self maThing: aFileName date: aDate).
  
+ 	fixed := self fixesApplied.
- 	fixed := self class fixesApplied.
  	(fixed isEmpty or: [ fixed last ~= aBugNo]) ifTrue: [ fixed add: aBugNo ].
  		
  	^ date!

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

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

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

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: InstallerWeb>>basicInstall (in category 'basic interface') -----
  basicInstall
   
+  	 self thing size > 0 
-  	 self webThing 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:
+ ----- Method: InstallerInternetBased>>wasPbwikiSpeedWarning (in category 'url') -----
+ wasPbwikiSpeedWarning
+ 		
+ 		^ self hasPage and: [pageDataStream contents includesSubString: 'Please slow down a bit' ] 
+  
+ !

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

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 changed:
  ----- 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.
-  	url := self webFindUrlToDownload.
  	
  	self reportFor: line page: pageDataStream on: report !

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

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

Item was removed:
- ----- Method: InstallerWeb>>webThing (in category 'web install') -----
- webThing
-  
-  	url := self webFindUrlToDownload.
- 	url ifNil: [ self logCR: 'page ', self package, ' not found on path' ]
- 		ifNotNil: [ self logCR: 'found ',  url, ' ...'.   ].
- 	^ pageDataStream!

Item was removed:
- ----- Method: InstallerMonticello class>>unloadCleanUp (in category 'unload') -----
- 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 removed:
- ----- Method: InstallerMonticello class>>unload: (in category 'unload') -----
- unload: match 
- 
- 	(MCWorkingCopy allManagers select: [ :wc | match match: (wc package name) ])
- 		 do: [ :wc | 
-  			 	self logCR: 'Unloading ', wc package asString.
-  				wc unload.].
- 	self unloadCleanUp!

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

Item was removed:
- ----- Method: InstallerWeb>>webFindUrlToDownload (in category 'web install') -----
- webFindUrlToDownload
- 
- 	| 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: [ 	
- 								(pageDataStream notNil and: [ pageDataStream size > 0 ]) 
- 									ifTrue: [ (pageDataStream contents includesSubString: 'Please slow down a bit') 
- 													ifTrue: [ retry := true ]
- 													ifFalse: [ pageDataStream reset. 
- 																^ potentialUrl ] ].
- 								(Delay forSeconds: (delay := delay + 5)) wait.
- 								retry ]].
- 	^nil
- !



More information about the Packages mailing list