[BUG][ENH] SqueakMap 2 beta breaks for unreleased packages

Brian T Rice water at tunes.org
Thu Nov 20 09:25:44 UTC 2003


While testing SM2 Beta, the Win32VM test package had no releases and
revealed a huge absence of checking in SM2 domain code. This includes
fixes for every issue I could determine through call-accessibility. See
the preamble of the attached changeset for details.

-- 
Brian T. Rice
LOGOS Research and Development
http://tunes.org/~water/
-------------- next part --------------
'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5548] on 20 November 2003 at 1:18:26 am'!
"Change Set:		NoReleaseFixes
Date:			20 November 2003
Author:			Brian T. Rice

This alters several methods which existed in Package for backwards compatibility in using the lastRelease of an SMPackage, but didn't check to see if the package was released.

This includes the checks, and returns or errors appropriately. Also, the package fullDescription method was altered not to mention the URL of the latest release."!


!SMLoader methodsFor: 'model' stamp: 'btr 11/20/2003 00:19'!
downloadPackageRelease
	"Download package release."

	| item release |
	item _ self selectedPackageOrRelease.
	release _ item isPackage ifTrue: [item lastRelease] ifFalse: [item].
	release ifNil: [self error: 'A release was not found for the package.'].
	[Cursor wait showWhile: [
		(SMInstaller forPackageRelease: release) download]
	] on: Error do: [:ex |
		self inform: ('Error occurred during download:\', ex messageText) withCRs]! !

!SMLoader methodsFor: 'model' stamp: 'btr 11/20/2003 00:21'!
installPackageRelease
	"Install a package release."

	| item release |
	item _ self selectedPackageOrRelease.
	release _ item isPackage ifTrue: [item lastRelease] ifFalse: [item].
	release ifNil: [self error: 'A release was not found for the package.'].
	[Cursor wait showWhile: [
		(SMInstaller forPackageRelease: release) install.
		self noteChanged]
	] on: Error do: [:ex |
		self inform: ('Error occurred during install:\', ex messageText) withCRs].
	! !


!SMPackage methodsFor: 'accessing' stamp: 'btr 11/20/2003 00:27'!
currentVersion
	^self isReleased ifTrue: [self lastRelease version]! !

!SMPackage methodsFor: 'accessing' stamp: 'btr 11/20/2003 00:30'!
downloadUrl
	self isReleased ifFalse: [self error: 'There is no release for this package to download.'].
	^self lastRelease downloadUrl! !

!SMPackage methodsFor: 'accessing' stamp: 'btr 11/20/2003 01:05'!
fullDescription
	"Return a full textual description of the package. 
	Most of the description is taken from the last release."
	| s tab |
	s := TextStream
				on: (Text new: 400).
	tab := String with: Character tab.
	self
		describe: name
		withBoldLabel: 'Name:' , tab , tab
		on: s.
	summary isEmptyOrNil
		ifFalse: [self
				describe: summary
				withBoldLabel: 'Summary:' , tab
				on: s].
	author isEmptyOrNil
		ifFalse: [s
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Author:'];
				 tab;
				 tab.
			s
				withAttribute: (PluggableTextAttribute
						evalBlock: [self userInterface sendMailTo: author regardingPackageRelease: self lastRelease])
				do: [s nextPutAll: author];
				 cr].
	self maintainer
		ifNotNil: [s
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Maintainer:'];
				 tab.
			s
				withAttribute: (PluggableTextAttribute
						evalBlock: [self userInterface sendMailTo: self maintainer email regardingPackageRelease: self lastRelease])
				do: [s nextPutAll: self maintainer email];
				 cr].
	categories isEmptyOrNil
		ifFalse: [s cr;
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Categories: ']; cr.
			self
				categoriesDo: [:c | s tab;
						withAttribute: TextEmphasis italic
						do: [c
								parentsDo: [:p | s nextPutAll: p name;
										 nextPutAll: '/'].
							s nextPutAll: c name]; nextPutAll: ' - ' , c summary; cr].
			s cr].
	self currentVersion isEmptyOrNil
		ifTrue: [self
				describe: self smartVersion
				withBoldLabel: 'Calculated version: '
				on: s]
		ifFalse: [self
				describe: self currentVersion
				withBoldLabel: 'Current version: '
				on: s].
	self versionComment isEmptyOrNil
		ifFalse: [s cr;
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Version Comment:'].
			s cr.
			s
				withAttribute: (TextIndent tabs: 1)
				do: [s nextPutAll: self versionComment].
			s cr; cr].
	url isEmptyOrNil
		ifFalse: [s
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Homepage:'];
				 tab;
				
				withAttribute: (TextURL new url: url)
				do: [s nextPutAll: url];
				 cr].
	description isEmptyOrNil
		ifFalse: [s cr.
			s
				withAttribute: TextEmphasis bold
				do: [s nextPutAll: 'Description:'].
			s cr.
			s
				withAttribute: (TextIndent tabs: 1)
				do: [s nextPutAll: description].
			s cr; cr].
	^ s contents isoToSqueak! !

!SMPackage methodsFor: 'accessing' stamp: 'btr 11/20/2003 00:39'!
versionComment
	^self isReleased ifTrue: [self lastRelease note]! !

!SMPackage methodsFor: 'services' stamp: 'btr 11/20/2003 00:30'!
downloadFileName
	"Cut out the filename from the url."
	self isReleased ifFalse: [self error: 'There is no release for this package to download.'].
	^self lastRelease downloadFileName! !

!SMPackage methodsFor: 'services' stamp: 'btr 11/20/2003 00:53'!
smartVersion
	"Delegate to last release."

	^self isReleased ifTrue: [self lastRelease smartVersion] ifFalse: ['']! !

!SMPackage methodsFor: 'deprecated' stamp: 'btr 11/20/2003 00:23'!
created: c updated: u name: n currentVersion: v summary: s description: d url: ur downloadUrl: du author: a maintainer: m registrator: r password: p categories: cats 
	"Deprecated. Only kept for migration from SM 1.0x.
	Method used when recreating from storeOn: format.
	A few attributes are moved over from the card and the release
	is given the same categories as the card to begin with."

	self isReleased ifFalse:[self newRelease].
	self lastRelease
		oldCreated: c updated: u downloadUrl: du maintainer: m registrant: r password: p version: v;
		categories: cats.
	self categories: cats.
	created _ c.
	updated _ u.
	name _ n.
	summary _ s.
	description _ d.
	url _ ur.
	author _ a	! !

!SMPackage methodsFor: 'deprecated' stamp: 'btr 11/20/2003 00:38'!
modulePath: p moduleVersion: v moduleTag: t versionComment: vc
	"Deprecated. Only kept for migration from SM 1.0x.
	Method used when recreating from storeOn: format."

	self isReleased ifTrue: [self lastRelease note: vc]! !

!SMPackage methodsFor: 'testing-delegated' stamp: 'btr 11/20/2003 00:34'!
isCached
	"Is the file corresponding to me in the local file cache?"

	^self isReleased and: [self lastRelease isCached]! !

!SMPackage methodsFor: 'testing-delegated' stamp: 'btr 11/20/2003 00:35'!
isDownloadable
	"Answer if I can be downloaded."

	^self isReleased and: [self lastRelease isDownloadable]! !

!SMPackage methodsFor: 'testing-delegated' stamp: 'btr 11/20/2003 00:35'!
isInstallable
	"Answer if there is any installer for me. 
	This depends typically on the filename of 
	the download url, but can in the future 
	depend on other things too. 
	It does *not* say if the package is installed or not."
	^ self isReleased and: [self lastRelease isInstallable]! !

!SMPackage methodsFor: 'testing-delegated' stamp: 'btr 11/20/2003 00:05'!
isReleased
	^ releases isEmpty not! !

!SMPackage methodsFor: 'testing-delegated' stamp: 'btr 11/20/2003 00:37'!
isUpgradeable
	"Answer if there is any installer that can upgrade me."

	^self isReleased and: [self lastRelease isUpgradeable]! !

!SMPackage methodsFor: 'cache' stamp: 'btr 11/20/2003 00:29'!
download
	"Force download into cache."
	self isReleased ifFalse: [self error: 'There is no release for this package to download.'].
	^self lastRelease download! !

!SMPackage methodsFor: 'cache' stamp: 'btr 11/20/2003 00:30'!
ensureInCache
	"Makes sure the file is in the cache."
	self isReleased ifFalse: [self error: 'There is no release for this package to download.'].
	^self lastRelease ensureInCache ! !


!SMPackageRelease methodsFor: 'initialize-release' stamp: 'btr 11/20/2003 00:41'!
initializeInPackage: aPackage
	"Initialize package release.
	Currently we do not support branching so we simply
	pick the next available version number."

	| previous |
	self map: aPackage map id: UUID new.
	package _ aPackage.
	previous _ package lastRelease.
	automaticVersion _ 	previous ifNil: [VersionNumber first]
							ifNotNil: [previous automaticVersion next].
	version _ note _ downloadUrl _ ''! !



More information about the Squeak-dev mailing list