[squeak-dev] The Inbox: SMBase-ct.146.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:55 UTC 2022
A new version of SMBase was added to project The Inbox: http://source.squeak.org/inbox/SMBase-ct.146.mcz ==================== Summary ==================== Name: SMBase-ct.146 Author: ct Time: 18 May 2022, 7:29:27.534874 pm UUID: e0aa203f-bb34-d942-8f8b-f8f3ebd212be Ancestors: SMBase-tpr.145 Improves multilingual support and moves from UIManager default to Project uiManager. =============== Diff against SMBase-tpr.145 =============== Item was removed: - SystemOrganization addCategory: #'SMBase-UI'! - SystemOrganization addCategory: #'SMBase-domain'! - SystemOrganization addCategory: #'SMBase-installer'! - SystemOrganization addCategory: #'SMBase-utilities'! Item was removed: - Object subclass: #RcsDiff - instanceVariableNames: 'commandLines' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-utilities'! Item was removed: - ----- Method: RcsDiff class>>lines: (in category 'instance creation') ----- - lines: aString - "Create a new RcsDiff file." - ^(self new) commandLines: aString; yourself! Item was removed: - ----- Method: RcsDiff>>applyTo: (in category 'applying') ----- - applyTo: aString - "Apply me to given String and return the patched String." - - | space commandStream originalStream currentLine | - space := Character space. - commandStream := ReadStream on: commandLines. - originalStream := ReadStream on: aString. - currentLine := 1. - ^String streamContents: [:stream | - | nextCommand | - [nextCommand := commandStream next. - nextCommand isNil] whileFalse: [ - | nextLine lineCount | - nextLine := (commandStream upTo: space) asNumber. - lineCount := commandStream nextLine asNumber. - [currentLine = nextLine] - whileFalse: [stream nextPutAll: originalStream nextLine; cr. currentLine := currentLine + 1]. - nextCommand = $d - ifTrue:[ lineCount timesRepeat: [originalStream nextLine. currentLine := currentLine + 1]] - ifFalse:[ nextCommand = $a - ifTrue:[ stream nextPutAll: originalStream nextLine; cr. - currentLine := currentLine + 1. - lineCount timesRepeat: [ - stream nextPutAll: commandStream nextLine; cr]]]]. - stream nextPutAll: originalStream upToEnd]! Item was removed: - ----- Method: RcsDiff>>commandLines: (in category 'accessing') ----- - commandLines: aString - commandLines := aString! Item was removed: - SMRootedObject subclass: #SMAccount - instanceVariableNames: 'initials email signature password newPassword advogatoId objects coObjects isAdmin' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMAccount commentStamp: '<historical>' prior: 0! - SMAccount is the object representing a user account in SqueakMap - a Squeaker that owns information in SqueakMap. - - It keeps track of the email address, developer initials and two passwords used to access the account. There is also an advogatoId (people.squeakfoundation.org username) and a signature field (not used yet). The flag isAdmin is a crude way of marking a user as a superuser, this will possibly be changed in the future and instead expressed using a category. - - Passwords are stored as secure hashes. The extra password (newPassword) is used when the regular password is forgotten - it is then randomly set and an email is sent out containing it to the registered email. This enables the original password to still work. When logging in, the user gets a chance to enter a new regular password overwriting the old one and clearing the random new password in the process. - - The instvar objects holds all SMPersonalObjects (instances of subclasses) that this account "owns" - these are typically instances of SMPackages and SMResources, but are not limited to be. - - The instvar coObjects holds all SMPersonalObjects that this account is co-maintaining - these are typically instances of SMPackages and SMResources. - - Finally the account also maintains a directory with uploaded files on the server. This directory has the UUID of the account as its name and it is located under sm/accounts! Item was removed: - ----- Method: SMAccount>>addCoObject: (in category 'objects') ----- - addCoObject: anObject - "Add <anObject> to this account. - Only called from #addMaintainer:." - - (coObjects includes: anObject) - ifFalse:[coObjects add: anObject]! Item was removed: - ----- Method: SMAccount>>addObject: (in category 'objects') ----- - addObject: anObject - "Add <anObject> to this account. Also makes sure the - reverse reference is correct." - - (objects includes: anObject) ifFalse:[ - objects add: anObject. - anObject owner: self. - map addObject: anObject]! Item was removed: - ----- Method: SMAccount>>advogatoId (in category 'accessing') ----- - advogatoId - ^advogatoId! Item was removed: - ----- Method: SMAccount>>advogatoId: (in category 'accessing') ----- - advogatoId: aString - advogatoId := aString! Item was removed: - ----- Method: SMAccount>>coPackageWithId: (in category 'objects') ----- - coPackageWithId: anIdString - "Return the correct package or nil." - - ^self withId: anIdString in: self coPackages! Item was removed: - ----- Method: SMAccount>>coPackages (in category 'objects') ----- - coPackages - "Return all co-maintained packages." - - ^coObjects select: [:o | o isPackage]! Item was removed: - ----- Method: SMAccount>>correctPassword: (in category 'passwords') ----- - correctPassword: aPassword - "We store the password as a SHA hash so that we can let the slave maps - have them too. Also check the optional new random password." - - | try | - aPassword isEmptyOrNil ifTrue:[^false]. - try := SecureHashAlgorithm new hashMessage: aPassword. - ^password = try or: [newPassword = try]! Item was removed: - ----- Method: SMAccount>>createRandomPassword (in category 'passwords') ----- - createRandomPassword - "Create a random password and set it - in parallell to the regular one." - - | randomPass | - randomPass := String streamContents: [:stream | 10 timesRepeat: [ stream nextPut: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' atRandom]]. - self setNewPassword: randomPass. - ^randomPass! Item was removed: - ----- Method: SMAccount>>delete (in category 'files') ----- - delete - "Delete this account. First delete all SM objects we own - and disconnect this account from those we co-maintain." - - objects do: [:o | o delete]. - coObjects do: [:co | co removeMaintainer: self]. - super delete - ! Item was removed: - ----- Method: SMAccount>>deleteFiles: (in category 'files') ----- - deleteFiles: fileNames - "Delete all fileNames from the uploads directory." - - | dir | - dir := self uploadsDirectory. - fileNames do: [:fn | dir deleteFileNamed: fn] - ! Item was removed: - ----- Method: SMAccount>>directory (in category 'files') ----- - directory - "Get the directory for the account." - - | dir | - dir := (map directory directoryNamed: 'accounts') assureExistence; yourself. - ^(dir directoryNamed: id asString) assureExistence; yourself - ! Item was removed: - ----- Method: SMAccount>>email (in category 'accessing') ----- - email - ^email! Item was removed: - ----- Method: SMAccount>>email: (in category 'accessing') ----- - email: address - email := address! Item was removed: - ----- Method: SMAccount>>entries (in category 'files') ----- - entries - "Return all file entries in the upload directory." - - ^self uploadsDirectory entries! Item was removed: - ----- Method: SMAccount>>files (in category 'files') ----- - files - "Return filenames for uploaded files." - - ^self uploadsDirectory fileNames - ! Item was removed: - ----- Method: SMAccount>>getLink: (in category 'view') ----- - getLink: aBuilder - "Return a link for using on the web. - Always from the top." - - ^aBuilder getLinkTop: 'accountbyid/', id asString text: self nameWithInitials! Item was removed: - ----- Method: SMAccount>>initialize (in category 'initialize-release') ----- - initialize - "Initialize account." - - super initialize. - initials := signature := advogatoId := ''. - isAdmin := false. - objects := OrderedCollection new. - coObjects := OrderedCollection new! Item was removed: - ----- Method: SMAccount>>initials (in category 'accessing') ----- - initials - ^initials! Item was removed: - ----- Method: SMAccount>>initials: (in category 'accessing') ----- - initials: aString - "If these are changed we need to update the dictionary in the map." - - initials ~= aString ifTrue: [ - initials := aString. - map clearUsernames]! Item was removed: - ----- Method: SMAccount>>isAccount (in category 'testing') ----- - isAccount - ^true! Item was removed: - ----- Method: SMAccount>>isAdmin (in category 'accessing') ----- - isAdmin - ^isAdmin ifNil: [false] ifNotNil: [isAdmin]! Item was removed: - ----- Method: SMAccount>>isAdmin: (in category 'accessing') ----- - isAdmin: aBoolean - isAdmin := aBoolean! Item was removed: - ----- Method: SMAccount>>logout (in category 'view') ----- - logout - "Automatically called upon logout. Do nothing."! Item was removed: - ----- Method: SMAccount>>moveObject:toAccount: (in category 'objects') ----- - moveObject: aPersonalObject toAccount: anAccount - "Transfer the ownership of the given personal object to <anAccount>." - - self removeObject: aPersonalObject. - anAccount addObject: aPersonalObject! Item was removed: - ----- Method: SMAccount>>nameAndEmail (in category 'accessing') ----- - nameAndEmail - "This is not really correct, the name needs to be - mime encoded." - - ^name , ' <', email, '>'! Item was removed: - ----- Method: SMAccount>>nameWithInitials (in category 'view') ----- - nameWithInitials - "Return name and developer initials within parentheses." - - ^name, ' (', (initials isEmptyOrNil ifTrue: ['not entered'] ifFalse: [initials]) , ')'! Item was removed: - ----- Method: SMAccount>>newFile:block: (in category 'files') ----- - newFile: fileName block: aBlock - "Create a new file. Let <aBlock> fill the file with content by calling it with a stream." - - | dir stream | - dir := self uploadsDirectory. - [(dir fileExists: fileName) ifTrue:[dir deleteFileNamed: fileName]. - stream := dir newFileNamed: fileName. - stream binary. - aBlock value: stream] ensure: [stream close]! Item was removed: - ----- Method: SMAccount>>newPassword (in category 'accessing') ----- - newPassword - "Get the parallell password hash." - - ^newPassword! Item was removed: - ----- Method: SMAccount>>newPassword: (in category 'accessing') ----- - newPassword: aHashNumber - "Set the parallell password hash." - - newPassword := aHashNumber! Item was removed: - ----- Method: SMAccount>>owns: (in category 'testing') ----- - owns: anObject - ^objects includes: anObject! Item was removed: - ----- Method: SMAccount>>packageWithId: (in category 'objects') ----- - packageWithId: anIdString - "Return the correct package or nil." - - ^self withId: anIdString in: self packages! Item was removed: - ----- Method: SMAccount>>packages (in category 'objects') ----- - packages - "Return all owned packages." - - ^objects select: [:o | o isPackage]! Item was removed: - ----- Method: SMAccount>>password (in category 'accessing') ----- - password - "Get the password hash." - - ^password! Item was removed: - ----- Method: SMAccount>>password: (in category 'accessing') ----- - password: aHashNumber - "Set the password hash." - - password := aHashNumber! Item was removed: - ----- Method: SMAccount>>publicViewFor: (in category 'view') ----- - publicViewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis." - - ^uiObject publicAccountViewOn: self! Item was removed: - ----- Method: SMAccount>>removeCoObject: (in category 'objects') ----- - removeCoObject: anObject - "Remove <anObject> from this account. - Only called from #removeMaintainer:." - - (coObjects includes: anObject) ifTrue: [ - coObjects remove: anObject]! Item was removed: - ----- Method: SMAccount>>removeObject: (in category 'objects') ----- - removeObject: anObject - "Remove <anObject> from this account. Also makes sure the - reverse reference is cleared." - - (objects includes: anObject) ifTrue: [ - anObject owner: nil. - objects remove: anObject]! Item was removed: - ----- Method: SMAccount>>setNewPassword: (in category 'passwords') ----- - setNewPassword: aString - "Set a new parallell password the user can use to get in - if the old password is forgotten. We don't delete the old - password since the request for this new password is made - anonymously. Note that the password is stored as a secured - hash large integer." - - newPassword := SecureHashAlgorithm new hashMessage: aString! Item was removed: - ----- Method: SMAccount>>setPassword: (in category 'passwords') ----- - setPassword: aString - "We also clear the random extra password." - - password := SecureHashAlgorithm new hashMessage: aString. - newPassword := nil! Item was removed: - ----- Method: SMAccount>>signature (in category 'accessing') ----- - signature - "Get the signature." - - ^signature! Item was removed: - ----- Method: SMAccount>>signature: (in category 'accessing') ----- - signature: aSignature - "Set the signature." - - signature := aSignature! Item was removed: - ----- Method: SMAccount>>streamForFile: (in category 'files') ----- - streamForFile: fileName - "Return a readonly stream for file <fileName>. - If the file does not exist return nil." - - ^[StandardFileStream oldFileNamed: (self uploadsDirectory fullNameFor: fileName)] - on: FileDoesNotExistException do: [nil]! Item was removed: - ----- Method: SMAccount>>type (in category 'printing') ----- - type - "Used in various views." - - ^'Account'! Item was removed: - ----- Method: SMAccount>>uploadsDirectory (in category 'files') ----- - uploadsDirectory - "Get the directory for uploaded files, create it if missing." - - ^(self directory directoryNamed: 'uploads') assureExistence; yourself - ! Item was removed: - ----- Method: SMAccount>>viewFor: (in category 'view') ----- - viewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis." - - ^uiObject accountViewOn: self! Item was removed: - SMObject subclass: #SMCategorizableObject - instanceVariableNames: 'categories resources' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMCategorizableObject commentStamp: '<historical>' prior: 0! - A categorizable object can be associated with one or more SMCategories. - The relation between the categories and the SMCategorizableObject is bidirectional. - A categorizable object can also have attached resources, see SMResource. - - The categories are used to classify the categorizable object for different purposes. - Package and package releases are classified in different ways, but so can resources and accounts be. - ! Item was removed: - ----- Method: SMCategorizableObject>>addCategory: (in category 'private') ----- - addCategory: aCategory - "Add <aCategory> to me. If I already have it do nothing." - - categories ifNil: [categories := OrderedCollection new]. - (categories includes: aCategory) ifFalse:[ - aCategory addObject: self. - categories add: aCategory]. - ^aCategory! Item was removed: - ----- Method: SMCategorizableObject>>addResource: (in category 'resources') ----- - addResource: aResource - "Lazily initialize the resources collection." - - resources ifNil: [resources := OrderedCollection new]. - aResource object: self. - ^resources add: aResource! Item was removed: - ----- Method: SMCategorizableObject>>beCommunitySupported (in category 'testing') ----- - beCommunitySupported - self addCategory: (self map categoryWithNameBeginning: 'Community Supported')! Item was removed: - ----- Method: SMCategorizableObject>>categories (in category 'accessing') ----- - categories - "Lazily initialized." - - ^categories ifNil: [OrderedCollection new]! Item was removed: - ----- Method: SMCategorizableObject>>categoriesDo: (in category 'categories') ----- - categoriesDo: aBlock - "Evaluate aBlock for each of the categories." - - categories ifNil: [^self]. - categories do: aBlock! Item was removed: - ----- Method: SMCategorizableObject>>categoryForParent: (in category 'categories') ----- - categoryForParent: aCategory - "Answer one of my categories with parent <aCategory>, if I have it." - - categories ifNil: [^nil]. - ^categories detect: [:cat | cat parent = aCategory ] ifNone: [nil]! Item was removed: - ----- Method: SMCategorizableObject>>communitySupportedCategory (in category 'accessing') ----- - communitySupportedCategory - ^ self categories - detect: [:each | each name = 'Community Supported'] - ifNone: []! Item was removed: - ----- Method: SMCategorizableObject>>delete (in category 'private') ----- - delete - "Delete me. Disconnect me from my categories." - - super delete. - self removeFromCategories! Item was removed: - ----- Method: SMCategorizableObject>>describeCategoriesOn:indent: (in category 'printing') ----- - describeCategoriesOn: aStream indent: tabs - "Show a full listing of categories and their dscription on aStream, indented by the given number of tabs." - - categories isEmptyOrNil - ifFalse: [aStream cr; - withAttribute: TextEmphasis bold - do: [aStream nextPutAll: 'Categories: ']; cr. - (self categories sorted: [:a :b | a path < b path]) - do: [:c | - aStream tab: tabs. - c - parentsDo: [:p | aStream nextPutAll: p name; - nextPut: $/]. - aStream nextPutAll: c name; - nextPutAll: ' - '; - - withAttributes: {TextEmphasis italic. TextIndent tabs: tabs + 1 } - do: [aStream nextPutAll: c summary]; - cr]]! Item was removed: - ----- Method: SMCategorizableObject>>embeddedResources (in category 'resources') ----- - embeddedResources - "Return all embedded resources." - - ^resources ifNil: [#()] - ifNotNil: [resources select: [:r | r isEmbedded ]] - ! Item was removed: - ----- Method: SMCategorizableObject>>hasCategory: (in category 'categories') ----- - hasCategory: aCategory - "Answer true if I am in it." - - ^categories notNil and: [categories includes: aCategory]! Item was removed: - ----- Method: SMCategorizableObject>>hasCategoryOrSubCategoryOf: (in category 'categories') ----- - hasCategoryOrSubCategoryOf: aCategory - "Answer true if I am in aCategory or if I am in any - of its sub categories recursively." - - aCategory allCategoriesDo: [:cat | - (self hasCategory: cat) ifTrue: [^ true]]. - ^false! Item was removed: - ----- Method: SMCategorizableObject>>isCommunitySupported (in category 'testing') ----- - isCommunitySupported - ^ self communitySupportedCategory notNil! Item was removed: - ----- Method: SMCategorizableObject>>removeCategory: (in category 'private') ----- - removeCategory: aCategory - "Remove category from me if I am in it." - - (categories notNil and: [categories includes: aCategory]) ifTrue:[ - aCategory removeObject: self. - categories remove: aCategory]. - ^aCategory! Item was removed: - ----- Method: SMCategorizableObject>>removeFromCategories (in category 'private') ----- - removeFromCategories - "Remove me from all my categories." - - categories ifNotNil:[ - categories copy do: [:cat | self removeCategory: cat ]]! Item was removed: - ----- Method: SMCategorizableObject>>removeResource: (in category 'resources') ----- - removeResource: aResource - "Disconnect and remove the resource." - - aResource object: nil. - ^resources remove: aResource! Item was removed: - ----- Method: SMCategorizableObject>>resources (in category 'accessing') ----- - resources - "Lazily initialized." - - ^resources ifNil: [OrderedCollection new]! Item was removed: - SMObject subclass: #SMCategory - instanceVariableNames: 'mandatory subCategories parent objects' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMCategory commentStamp: 'gk 3/8/2004 19:44' prior: 0! - An SMCategory is a "tag" that can be attached to SMCategorizableObjects in order to classify them. - - The SMCategories are arranged in a strict hierarchy and each SMCategory both knows it's parent and it's subcategories. - The instvar objects holds all SMObjects belonging to this category. - Instvars name and summary are already inherited from SMObject and describe the category. - The instvar url can be used to refer to a web page that can explain the category in more detail, typically a page at the Squeak Swiki. - SMCategory adds an instance variable called mandatory holding a Set with the classes (SMPackage, SMPackageRelease, SMAccount, SMResource etc) that must belong to at least one subcategory of this SMCategory. Obviously not many categories will be mandatory for each class. - - The category tree is maintained by a few trusted people so that chaos will not reign. :-) - ! Item was removed: - ----- Method: SMCategory>>addCategory: (in category 'private') ----- - addCategory: cat - "Add a category as a subcategory to self. - The collection of subcategories is lazily instantiated." - - subCategories ifNil: [subCategories := OrderedCollection new]. - cat parent ifNotNil: [cat parent removeCategory: cat ]. - subCategories add: cat. - cat parent: self. - ^cat! Item was removed: - ----- Method: SMCategory>>addObject: (in category 'private') ----- - addObject: anObject - "Add <anObject> to this category. This should only be called - from SMCategorizableObject>>addCategory: to ensure consistency." - - (objects includes: anObject) ifFalse:[objects add: anObject]! Item was removed: - ----- Method: SMCategory>>allCategoriesDo: (in category 'services') ----- - allCategoriesDo: aBlock - "Evaluate <aBlock> for all categories below me including me, - bottom up breadth-first." - - self allSubCategoriesDo: aBlock. - aBlock value: self! Item was removed: - ----- Method: SMCategory>>allSubCategoriesDo: (in category 'services') ----- - allSubCategoriesDo: aBlock - "Evaluate <aBlock> for all categories below me NOT including me, - bottom up breadth-first." - - subCategories ifNil: [^self]. - subCategories do: [:sub | - sub allSubCategoriesDo: aBlock. - aBlock value: sub]! Item was removed: - ----- Method: SMCategory>>categoryBefore (in category 'services') ----- - categoryBefore - "Return the category listed before me in my parent. - If I am first or I have no parent, return nil." - - parent isNil ifTrue:[^nil]. - parent subCategories first = self ifTrue:[^nil]. - ^parent subCategories before: self - ! Item was removed: - ----- Method: SMCategory>>delete (in category 'private') ----- - delete - "Delete me. Disconnect me from my objects and my parent. - Then delete my subcategories." - - super delete. - self removeFromObjects; removeFromParent. - self subCategories do: [:c | c delete ]! Item was removed: - ----- Method: SMCategory>>getLink: (in category 'view') ----- - getLink: aBuilder - "Return a link for using on the web. - Always from the top." - - ^aBuilder getLinkTop: 'category/', id asString text: name! Item was removed: - ----- Method: SMCategory>>hasSubCategories (in category 'testing') ----- - hasSubCategories - ^subCategories isEmptyOrNil not! Item was removed: - ----- Method: SMCategory>>includes: (in category 'testing') ----- - includes: anObject - "Answer if <anObject> is in this category." - - ^objects includes: anObject! Item was removed: - ----- Method: SMCategory>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - name := summary := url := ''. - objects := OrderedCollection new! Item was removed: - ----- Method: SMCategory>>isCategory (in category 'testing') ----- - isCategory - ^true! Item was removed: - ----- Method: SMCategory>>isTopCategory (in category 'testing') ----- - isTopCategory - ^parent isNil! Item was removed: - ----- Method: SMCategory>>mandatory (in category 'accessing') ----- - mandatory - ^mandatory! Item was removed: - ----- Method: SMCategory>>mandatory: (in category 'accessing') ----- - mandatory: aSet - mandatory := aSet! Item was removed: - ----- Method: SMCategory>>mandatoryFor: (in category 'accessing') ----- - mandatoryFor: aClass - "Is this category mandatory for instances of <aClass>?" - - ^mandatory ifNil: [false] ifNotNil: [mandatory includes: aClass]! Item was removed: - ----- Method: SMCategory>>move:toAfter: (in category 'services') ----- - move: cat toAfter: before - "Move a category to be after the category <before>." - - subCategories remove: cat. - before ifNil: [subCategories addFirst: cat] ifNotNil: [subCategories add: cat after: before]! Item was removed: - ----- Method: SMCategory>>objects (in category 'accessing') ----- - objects - "Return all objects in this category." - - ^objects! Item was removed: - ----- Method: SMCategory>>packages (in category 'accessing') ----- - packages - "Return all packages in this category." - - ^objects select: [:p | p isPackage]! Item was removed: - ----- Method: SMCategory>>parent (in category 'accessing') ----- - parent - ^parent! Item was removed: - ----- Method: SMCategory>>parent: (in category 'private') ----- - parent: aCategory - "Change the parent category. - This method relies on that somebody else - updates the parent's subCategories collection." - - parent := aCategory! Item was removed: - ----- Method: SMCategory>>parentsDo: (in category 'services') ----- - parentsDo: aBlock - "Run a block for all my parents starting from the top." - - parent ifNotNil: [ - parent parentsDo: aBlock. - aBlock value: parent]! Item was removed: - ----- Method: SMCategory>>path (in category 'printing') ----- - path - "Return my name with a full path of my - parent names separated with slashes like: - 'Squeak versions/Squeak3.5' " - - ^String streamContents: [:s | - self parentsDo: [:cat | - s nextPutAll: cat name; nextPutAll: '/']. - s nextPutAll: self name]! Item was removed: - ----- Method: SMCategory>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPutAll: self class name, ': ', name! Item was removed: - ----- Method: SMCategory>>removeDeepFromObjects (in category 'private') ----- - removeDeepFromObjects - "Remove myself from my objects and then ask - my subCategories to do the same." - - self removeFromObjects. - subCategories do: [:cat | cat removeDeepFromObjects]! Item was removed: - ----- Method: SMCategory>>removeFromObjects (in category 'private') ----- - removeFromObjects - "Remove myself from my objects." - - objects copy do: [:obj | obj removeCategory: self]! Item was removed: - ----- Method: SMCategory>>removeFromParent (in category 'private') ----- - removeFromParent - "Remove me from my parent." - - parent ifNotNil: [parent removeCategory: self]! Item was removed: - ----- Method: SMCategory>>removeObject: (in category 'private') ----- - removeObject: anObject - "Remove <anObject> from this category. This should only be called - from SMCategorizableObject>>removeCategory: to ensure consistency." - - ^objects remove: anObject! Item was removed: - ----- Method: SMCategory>>subCategories (in category 'accessing') ----- - subCategories - subCategories ifNil: [^#()]. - ^subCategories! Item was removed: - ----- Method: SMCategory>>type (in category 'printing') ----- - type - - ^'Category'! Item was removed: - ----- Method: SMCategory>>viewFor: (in category 'view') ----- - viewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis." - - ^uiObject categoryViewOn: self! Item was removed: - SMDefaultInstaller subclass: #SMDVSInstaller - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMDVSInstaller commentStamp: '<historical>' prior: 0! - This is an installer class for DVS packages. It handles packages categorized with package - format as DVS and with a download filename with extensions .st or .st.gz. - - This class can function without DVS installed, needed classes are looked up dynamically.! Item was removed: - ----- Method: SMDVSInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Can I install this? First we check if class StreamPackageLoader - is available, otherwise DVS isn't installed. - Then we check if the package is categorized with package - format DVS - currently we have hardcoded the id of that category." - - - Smalltalk at: #StreamPackageLoader ifPresent: [ :loader | | fileName | - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - fileName := fileName asLowercase. - ^((fileName endsWith: '.st') or: [fileName endsWith: '.st.gz']) - and: [aPackage categories includes: "The DVS format category" - (SMSqueakMap default - categoryWithId: 'b02f51f4-25b4-4117-9b65-f346215a8e41')]]. - ^false! Item was removed: - ----- Method: SMDVSInstaller class>>loadDVS (in category 'loading') ----- - loadDVS - "Load the DVS package from SqueakMap." - - SMSqueakMap default installPackageWithId: '100d59d0-bf81-4e74-a4fe-5a2fd0c6b4ec'! Item was removed: - ----- Method: SMDVSInstaller>>install (in category 'services') ----- - install - "Install using DVS." - - | imagePackageLoader streamPackageLoader packageInfo packageManager baseName current new manager | - self cache; unpack. - imagePackageLoader := Smalltalk at: #ImagePackageLoader ifAbsent: []. - streamPackageLoader := Smalltalk at: #StreamPackageLoader ifAbsent: []. - packageInfo := Smalltalk at: #PackageInfo ifAbsent: []. - packageManager := Smalltalk at: #FilePackageManager ifAbsent: []. - - ({ imagePackageLoader. streamPackageLoader. packageInfo. packageManager } includes: nil) - ifTrue: [ (self confirm: ('DVS support is not loaded, but would be helpful in loading ', unpackedFileName, '. - It isn''t necessary, but if you intend to use DVS later it would be a good idea to load it now. - Load it from SqueakMap?')) - ifTrue: [ self class loadDVS. ^self install ] - ifFalse: [ ^self fileIn ]]. - - baseName := packageRelease name. - dir rename: unpackedFileName toBe: (baseName, '.st'). - unpackedFileName := baseName, '.st'. - - (manager := packageManager allManagers detect: [ :pm | pm packageName = baseName ] ifNone: []) - ifNotNil: [ - current := imagePackageLoader new package: (packageInfo named: baseName). - new := streamPackageLoader new stream: (dir readOnlyFileNamed: unpackedFileName). - (new changesFromBase: current) fileIn ] - ifNil: [ - self fileIn. - manager := packageManager named: baseName. ]. - - manager directory: dir. - packageManager changed: #allManagers. - packageRelease noteInstalled! Item was removed: - SMSimpleInstaller subclass: #SMDefaultInstaller - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMDefaultInstaller commentStamp: '<historical>' prior: 0! - An installer takes care of installing SqueakMap packages represented by SMCards. - This installer handles packages that consist of classical fileins (single changesets and .st-files) and optional gzip-decompression of those. Deciding if a package is installable and instantiating the correct installer class is done on the class side in SMInstaller, to see how this installer gets chosen - see SMDefaultInstaller class>>canInstall:. - - ! Item was removed: - ----- Method: SMDefaultInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Answer if this class can install/upgrade the package. - This installer handles .st, .cs, .mst, .mcs (Squeak 3.9+) - with or without .gz suffix." - - | fileName | - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - fileName := fileName asLowercase. - ^self sourceFileSuffixes anySatisfy: [:each | - (fileName endsWith: (FileDirectory dot, each)) or: [ - fileName endsWith: (FileDirectory dot, each, '.gz')]]! Item was removed: - ----- Method: SMDefaultInstaller class>>multiSuffixes (in category 'private') ----- - multiSuffixes - "Unfortunately we can not tell which suffixes use multibyte encoding. - So we guess that they begin with $m." - - ^self sourceFileSuffixes select: [:suff | suff first = $m]! Item was removed: - ----- Method: SMDefaultInstaller class>>nonMultiSuffixes (in category 'private') ----- - nonMultiSuffixes - "Unfortunately we can not tell which suffixes use multibyte encoding. - So we guess that they begin with $m." - - ^self sourceFileSuffixes reject: [:suff | suff first = $m]! Item was removed: - ----- Method: SMDefaultInstaller class>>sourceFileSuffixes (in category 'private') ----- - sourceFileSuffixes - "Trying to play nice with all Squeak versions." - - ^(FileStream respondsTo: #sourceFileSuffixes) - ifTrue: [FileStream sourceFileSuffixes] - ifFalse: [#(cs st)].! Item was removed: - ----- Method: SMDefaultInstaller>>fileIn (in category 'private') ----- - fileIn - "Installing in the standard installer is simply filing in. - Both .st and .cs files will file into a ChangeSet of their own. - We let the user confirm filing into an existing ChangeSet - or specify another ChangeSet name if - the name derived from the filename already exists." - - | fileStream | - (self class nonMultiSuffixes anySatisfy: [:each | unpackedFileName endsWith: (FileDirectory dot, each)]) - ifTrue:[ - fileStream := dir readOnlyFileNamed: unpackedFileName. - (fileStream respondsTo: #setConverterForCode) ifTrue: [fileStream setConverterForCode]. - self fileIntoChangeSetNamed: (fileStream localName sansPeriodSuffix) fromStream: fileStream. - ^self]. - (self class multiSuffixes anySatisfy: [:each | unpackedFileName endsWith: (FileDirectory dot, each)]) - ifTrue:[ - fileStream := dir readOnlyFileNamed: unpackedFileName. - "Only images with converters should have multi suffixes" - fileStream converter: (Smalltalk at: #UTF8TextConverter) new. - self fileIntoChangeSetNamed: (fileStream localName sansPeriodSuffix) fromStream: fileStream. - ^self]. - self error: 'Filename should end with a proper extension'. - ! Item was removed: - ----- Method: SMDefaultInstaller>>install (in category 'services') ----- - install - "This service should bring the package to the client, - unpack it if necessary and install it into the image. - The package is notified of the installation." - - self cache; unpack; fileIn. - packageRelease noteInstalled - ! Item was removed: - Object subclass: #SMDependencyAnalysis - instanceVariableNames: 'task map wantedReleases alreadyInstalled trivialToInstall alreadyInstallable combinations suggestedInstallSetsSet workingConfigurations workingConfigurationsSize conflictingInstallSetsSet trickyReleases subAnalysises success' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMDependencyAnalysis commentStamp: '<historical>' prior: 0! - A dependency analysis is instantiated by an SMInstallationTask as a step in calculating how the task can be performed. - - The analysis is done using a map and some input - for example a list of package releases that the task wants to get installed. It can then be queried for the results. The analysis is performed in a series of steps and middle results are collected in instvars. It also uses sub instances so the analysis actually forms a tree of several instances of SMDependencyAnalysis where each node describes one level of dependencies. - - Instvars: - - task - the task that instantiated this analysis. - map - the SMSqueakMap to use, we get it by asking the task. - wantedReleases - the releases that we want to install. - alreadyInstalled - the subset of wantedReleases that are already installed. - trivialToInstall - the subset of wantedReleases that do not have dependencies and can be installed directly. - alreadyInstallable - the subset of wantedReleases that do have dependencies but for which at least one configuration is fulfilled and thus the release can already be installed. - trickyReleases - the subset of wantedReleases that do have configurations but none of them are fulfilled, so some dependencies first needs to be installed before these releases can be installed. - - workingConfigurations - an OrderedCollection of OrderedCollections holding all working configurations for the trickyReleases. - workingConfigurationsSize - size of workingConfigurations. - combinations - all possible (unordered) combinations of picking one working configuration for each tricky release. - suggestedInstallSetsSet - computed from combinations above. A Set of Sets of required releases. Each Set is a unique combination of the required releases to install in order to fulfill one configuration for each of the tricky releases. - conflictingInstallSetsSet - the subset of suggestedInstallSetsSet that are invalid since it includes multiple releases from the same package. - ! Item was removed: - ----- Method: SMDependencyAnalysis class>>task: (in category 'instance creation') ----- - task: ownerTask - - ^self new task: ownerTask! Item was removed: - ----- Method: SMDependencyAnalysis>>allInstallPaths (in category 'queries') ----- - allInstallPaths - "For all paths, collect in reverse all releases to install. - At each level, first we add trivially installable releases - (those that have no dependencies), then installable releases - (those that have one configuration fulfilled) and finally - the tricky releases (those left). - Note that we also return paths with conflicting releases - of the same package and paths with releases that conflict with - already installed releases - those paths can be tweaked - and - paths that are supersets of other paths." - - | installPaths | - installPaths := OrderedCollection new. - self allPathsDo: [:path | - | releases | - releases := OrderedCollection new. - path reverseDo: [:ana | - releases addAll: (ana trivialToInstall difference: releases). - releases addAll: (ana alreadyInstallable difference: releases). - releases addAll: (ana trickyReleases difference: releases) - "Below for debugging - r := OrderedCollection new. - r add: ana trivialToInstall; add: ana alreadyInstallable; add: ana trickyReleases. - releases add: r"]. - installPaths add: releases]. - ^ installPaths! Item was removed: - ----- Method: SMDependencyAnalysis>>allNormalizedInstallPaths (in category 'queries') ----- - allNormalizedInstallPaths - "Same as allInstallPaths, but with paths removed that - are clear supersets of others." - - | installPaths | - installPaths := self allInstallPaths. - installPaths := installPaths reject: [:p1 | - installPaths anySatisfy: [:p2 | - (p1 ~~ p2) and: [p1 includesAllOf: p2]]]. - ^installPaths! Item was removed: - ----- Method: SMDependencyAnalysis>>allPathsDo: (in category 'private') ----- - allPathsDo: aBlock - "For all paths down the tree, evaluate aBlock." - - ^ self allPathsDo: aBlock trail: OrderedCollection new! Item was removed: - ----- Method: SMDependencyAnalysis>>allPathsDo:trail: (in category 'private') ----- - allPathsDo: aBlock trail: trail - "For all paths down the tree, evaluate aBlock." - - trail add: self. - subAnalysises - ifNil: [ - aBlock value: trail.] - ifNotNil: [ - subAnalysises do: [:sub | - sub allPathsDo: aBlock trail: trail]]. - trail removeLast! Item was removed: - ----- Method: SMDependencyAnalysis>>allRoutesDo:currentRoute:level: (in category 'private') ----- - allRoutesDo: aBlock currentRoute: currentRoute level: level - "Recursively iterate over all routes down the tree." - - | newLevel | - workingConfigurationsSize = level ifTrue: ["we reached the leaves" - workingConfigurations last do: [:conf | - currentRoute addLast: conf. - aBlock value: currentRoute. - currentRoute removeLast]. - ^self]. - newLevel := level + 1. - (workingConfigurations at: level) do: [:conf | - currentRoute addLast: conf. - self allRoutesDo: aBlock currentRoute: currentRoute level: newLevel. - currentRoute removeLast]! Item was removed: - ----- Method: SMDependencyAnalysis>>alreadyInstallable (in category 'accessing') ----- - alreadyInstallable - ^alreadyInstallable - ! Item was removed: - ----- Method: SMDependencyAnalysis>>alreadyInstalled (in category 'accessing') ----- - alreadyInstalled - ^alreadyInstalled - ! Item was removed: - ----- Method: SMDependencyAnalysis>>bestInstallPath (in category 'queries') ----- - bestInstallPath - "Using some heuristics we suggest the best path: - - No conflicts - - Fewest releases - - If same packages, the newest releases" - - | paths min points | - paths := self installPathsWithoutConflicts. - paths size = 1 ifTrue: [^paths first]. - min := paths inject: 999 into: [:mi :p | p size < mi ifTrue: [p size] ifFalse: [mi]]. - paths := paths select: [:p | p size = min]. - paths size = 1 ifTrue: [^paths first]. - "Try to pick the one with newest releases" - points := Dictionary new. - paths do: [:p | | point | - point := 0. - p do: [:r | | package | - package := r package. - paths do: [:p2 | - p2 == p ifFalse: [ - (p2 anySatisfy: [:r2 | - (r2 package == package) and: [r newerThan: r2]]) - ifTrue:[point := point + 1]]]]. - points at: p put: point]. - points isEmpty ifTrue: [^nil]. - ^(points associations detectMax: [ :each | each value ]) key! Item was removed: - ----- Method: SMDependencyAnalysis>>collectCombinationsOfConfigurations (in category 'private') ----- - collectCombinationsOfConfigurations - "Given the wanted releases, find and return all possible combinations - of working configurations for all those. Perhaps not possible to do - given lots of releases and configurations, then we need smarter algorithms." - - "Pick out all working configurations first." - workingConfigurations := (trickyReleases collect: [:r | r workingConfigurations]) asOrderedCollection. - workingConfigurationsSize := workingConfigurations size. - - "We iterate over all possible combinations of configurations - and collect the unique set of unordered configurations." - combinations := Set new. - self allRoutesDo: [:route | - combinations add: route asSet copy] currentRoute: OrderedCollection new level: 1! Item was removed: - ----- Method: SMDependencyAnalysis>>computeInstallSets (in category 'private') ----- - computeInstallSets - "Given all combinations of configurations, compute all valid combinations - of depdendency releases - all possible different Sets of required releases - to install before the trickyReleases can be installed." - - "For each unique combination of configurations, collect all required releases - and produce a Set of unique required release combinations." - suggestedInstallSetsSet := (combinations collect: [:comb | - comb inject: Set new into: [:set :conf | - set addAll: conf requiredReleases. - set ]]) asSet. - - "Filter out those Sets that have multiple releases of the same package, they are conflicting - and thus not valid - we can't have two different releases of the same package - installed at the same time." - - "conflictingInstallSetsSet := suggestedInstallSetsSet select: - [:set | self detectConflictingReleasesIn: set]. - suggestedInstallSetsSet removeAll: conflictingInstallSetsSet"! Item was removed: - ----- Method: SMDependencyAnalysis>>detectConflictingReleasesIn: (in category 'private') ----- - detectConflictingReleasesIn: collectionOfReleases - "Detect if the Set has multiple releases of the same package." - - | detectedPackages | - detectedPackages := Set new. - collectionOfReleases do: [:r | - (detectedPackages includes: r package) - ifTrue: [^ true] - ifFalse: [detectedPackages add: r package]]. - ^false! Item was removed: - ----- Method: SMDependencyAnalysis>>indent: (in category 'printing') ----- - indent: level - ^' ' - last: level * 6! Item was removed: - ----- Method: SMDependencyAnalysis>>installPackageReleases: (in category 'calculation') ----- - installPackageReleases: packageReleases - "Given a Set of wanted SMPackageReleases, calculate all possible - installation scenarios. If the analysis succeeds, return true, otherwise false." - - - wantedReleases := packageReleases copy. - "First classify the releases in different groups." - self partitionReleases. - - "If there are no tricky releases, we are already done. - No extra required releases needs to be installed or upgraded." - trickyReleases isEmpty ifTrue: [^success := true]. - - "Ok, that was the easy part. The releases left now needs to be processed - so that we can find out the different scenarios of required releases that we need - to install first. First we calculate all combinations of available working configurations - for the tricky releases." - self collectCombinationsOfConfigurations. - - "Based on all configuration combinations, - compute possible combinations of dependency releases." - self computeInstallSets. - - "Check if we have failed - meaning that there are no valid scenarios without conflicts." - suggestedInstallSetsSet isEmpty ifTrue: [^success := false]. - - "Ok, this means we have at least one solution *on this level*!! But we need to do the - analysis recursively for all these sets of required releases..." - subAnalysises := OrderedCollection new. - success := false. - suggestedInstallSetsSet do: [:set | | result subAnalysis | - subAnalysis := SMDependencyAnalysis task: task. - result := subAnalysis installPackageReleases: set. - result ifTrue: [success := true]. - subAnalysises add: subAnalysis]. - - "Did at least one succeed? If so, then we have at least one possible scenario!! - If not, then we need to do tweaking." - ^success! Item was removed: - ----- Method: SMDependencyAnalysis>>installPathsWithConflicts (in category 'queries') ----- - installPathsWithConflicts - "Same as allInstallPaths, but we only return paths - with multiple releases of the same package." - - ^ self allInstallPaths select: [:path | self detectConflictingReleasesIn: path] ! Item was removed: - ----- Method: SMDependencyAnalysis>>installPathsWithoutConflicts (in category 'queries') ----- - installPathsWithoutConflicts - "Same as allInstallPaths, but we filter out paths - with multiple releases of the same package." - - ^ self allInstallPaths reject: [:path | self detectConflictingReleasesIn: path] ! Item was removed: - ----- Method: SMDependencyAnalysis>>partitionReleases (in category 'private') ----- - partitionReleases - "Move releases from wantedReleases to suitable other collections - if they are either installed, trivial to install, or installable as is." - - trickyReleases := wantedReleases copy. - alreadyInstalled := wantedReleases select: [:r | r isInstalled ]. - trickyReleases removeAll: alreadyInstalled. - trivialToInstall := trickyReleases select: [:r | r hasNoConfigurations ]. - trickyReleases removeAll: trivialToInstall. - alreadyInstallable := trickyReleases select: [:r | r hasFulfilledConfiguration ]. - trickyReleases removeAll: alreadyInstallable! Item was removed: - ----- Method: SMDependencyAnalysis>>printAllInstallPaths (in category 'printing') ----- - printAllInstallPaths - "Follow all install paths in the tree." - - ^String streamContents: [:s | - self allInstallPaths do: [:path | - path do: [:rel | - s nextPutAll: rel packageNameWithVersion, ', ']. - s cr]] ! Item was removed: - ----- Method: SMDependencyAnalysis>>removeOlderReleasesIn: (in category 'private') ----- - removeOlderReleasesIn: collectionOfReleases - "Remove older multiple releases of the same package. - 2 scans to retain order." - - | newestReleases rel | - newestReleases := Dictionary new. - collectionOfReleases do: [:r | - rel := newestReleases at: r package ifAbsentPut: [r]. - (r newerThan: rel) ifTrue: [newestReleases at: r package put: r]]. - ^collectionOfReleases select: [:r | - (newestReleases at: r package) == r]! Item was removed: - ----- Method: SMDependencyAnalysis>>success (in category 'accessing') ----- - success - ^success - ! Item was removed: - ----- Method: SMDependencyAnalysis>>task: (in category 'accessing') ----- - task: ownerTask - task := ownerTask. - map := task map! Item was removed: - ----- Method: SMDependencyAnalysis>>treeString (in category 'printing') ----- - treeString - "Return a indented String showing the tree - structure of all possible scenarios." - - ^String streamContents: [:s | - self treeStringOn: s indent: 0]! Item was removed: - ----- Method: SMDependencyAnalysis>>treeStringOn:indent: (in category 'printing') ----- - treeStringOn: stream indent: level - "Print the tree - structure of all possible scenarios." - - | i | - i := self indent: level. - stream nextPutAll: i, 'Wanted:'; cr. - wantedReleases do: [:r | - stream nextPutAll: i ,' ' , r packageNameWithVersion;cr]. - stream nextPutAll: i, 'Tricky:'; cr. - trickyReleases do: [:r | - stream nextPutAll: i ,' ' , r packageNameWithVersion;cr]. - stream cr. - subAnalysises ifNotNil: [ - subAnalysises do: [:sub | sub treeStringOn: stream indent: level + 1]]! Item was removed: - ----- Method: SMDependencyAnalysis>>trickyReleases (in category 'accessing') ----- - trickyReleases - ^trickyReleases - ! Item was removed: - ----- Method: SMDependencyAnalysis>>trivialToInstall (in category 'accessing') ----- - trivialToInstall - ^trivialToInstall - ! Item was removed: - ----- Method: SMDependencyAnalysis>>untestedInstallPaths (in category 'queries') ----- - untestedInstallPaths - "We take the paths with conflicts and remove the older releases." - - ^self installPathsWithConflicts collect: [:p | - self removeOlderReleasesIn: p] ! Item was removed: - ----- Method: SMDependencyAnalysis>>wantedReleases (in category 'accessing') ----- - wantedReleases - ^wantedReleases - ! Item was removed: - Object subclass: #SMDependencyEngine - instanceVariableNames: 'map' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMDependencyEngine commentStamp: '<historical>' prior: 0! - A dependency engine is used to perform one or more installation, upgrade or uninstallation tasks. - After creation it is typically configured according to different strategies, policies etc based on the preferences of the user. - Then it is used to calculate what installations, uninstallations or upgrades are needed and in which order to reach certain stated goals, like installing a set of wanted packages or upgrading the installed packages. - - The engine instantiates different SMInstallationTask subclasses depending on what it should calculate. - - Todo: both the installation information for the image and the engine should probably be kept outside of the SMSqueakMap instance. - ! Item was removed: - ----- Method: SMDependencyEngine class>>map: (in category 'instance creation') ----- - map: aMap - - ^ self new map: aMap! Item was removed: - ----- Method: SMDependencyEngine>>installPackages: (in category 'tasks') ----- - installPackages: wantedPackages - "Given a Set of wanted SMPackages, create an installation task to compute - possible installation scenarios. - Returns an SMInstallationTask which can be further configured - and then be sent #calculate after which it can be queried for results." - - ^SMPackageInstallationTask engine: self wantedPackages: wantedPackages! Item was removed: - ----- Method: SMDependencyEngine>>map (in category 'accessing') ----- - map - ^map! Item was removed: - ----- Method: SMDependencyEngine>>map: (in category 'accessing') ----- - map: aMap - map := aMap! Item was removed: - TestCase subclass: #SMDependencyTest - instanceVariableNames: 'engine map goranAccount' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMDependencyTest commentStamp: '<historical>' prior: 0! - Tests for the dependency engine.! Item was removed: - ----- Method: SMDependencyTest>>setUp (in category 'running') ----- - setUp - | trivial1rel installed1rel installed2rel tricky2rel conf1 conf2 tricky3rel1 tricky3rel2 tricky1rel seaside httpview kom1 kom2 | - map := SMSqueakMap new. - map isCheckpointAvailable - ifTrue: [ map reload ] - ifFalse: [ map loadUpdates ]. - goranAccount := map newAccount: 'Goran' username: 'Goran' email: 'g at g.com'. - - "Add a few packages to test with: - - Tricky1 1 - Installed1 1 - Tricky2 1 - Tricky2 1 - Installed1 1 - TrivialToInstall1 1 - Tricky3 1 - - Installed1 1 - TrivialToInstall1 1 - Tricky3 2 - Tricky3 2 - TrivialToInstall1 1 - - Installed2 1 - - Seaside - KomHttpServer 1 - - HttpView - KomHttpServer 2 - " - { - {'A'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 3}. - {'B'. {'Squeak3.6'. 'Stable'}. 2}. - {'TrivialToInstall1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Installed1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Installed2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'AlreadyInstallable1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Tricky1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Tricky2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Tricky3'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 2}. - {'Circular1'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Circular2'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Circular3'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'Seaside'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - {'KomHttpServer'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 2}. - {'HttpView'. {'Squeak3.6'. 'Squeak3.7'. 'Stable'}. 1}. - } do: [:arr | | package | - package := SMPackage newIn: map. - package name: arr first. - arr second do: [:cn | package addCategory: (map categoryWithNameBeginning: cn)]. - arr third timesRepeat: [package newRelease ]. - goranAccount addObject: package]. - - trivial1rel := (map packageWithName: 'TrivialToInstall1') lastRelease. - trivial1rel publisher: goranAccount. - - installed1rel := (map packageWithName: 'Installed1') lastRelease. - installed1rel publisher: goranAccount; noteInstalled. - installed2rel := (map packageWithName: 'Installed2') lastRelease. - installed2rel publisher: goranAccount; noteInstalled. - - ((map packageWithName: 'AlreadyInstallable1') lastRelease - publisher: goranAccount; - addConfiguration) - addRequiredRelease: installed1rel. - "Tricky1 has just a single configuration with one installed and one not installed." - tricky1rel := (map packageWithName: 'Tricky1') lastRelease. - tricky2rel := (map packageWithName: 'Tricky2') lastRelease. - (tricky1rel publisher: goranAccount; addConfiguration) - addRequiredRelease: installed1rel; "already installed" - addRequiredRelease: tricky2rel. "not installed" - - "Tricky2 has two configurations: - 1: an installed, a trivial one and Tricky3 r1. - 2: an installed, a trivial one and Tricky3 r2." - conf1 := tricky2rel publisher: goranAccount; addConfiguration. - conf2 := tricky2rel addConfiguration. - - tricky3rel1 := (map packageWithName: 'Tricky3') releases first. - tricky3rel2 := (map packageWithName: 'Tricky3') lastRelease. - tricky3rel1 publisher: goranAccount. - tricky3rel2 publisher: goranAccount. - - conf1 addRequiredRelease: installed1rel; addRequiredRelease: trivial1rel; addRequiredRelease: tricky3rel1. - conf2 addRequiredRelease: installed1rel; addRequiredRelease: trivial1rel; addRequiredRelease: tricky3rel2. - - "Tricky3rel2 has two configurations: - 1: trivial1 - 2: installed2rel" - conf1 := tricky3rel2 publisher: goranAccount; addConfiguration. - conf2 := tricky3rel2 addConfiguration. - conf1 addRequiredRelease: trivial1rel. - conf2 addRequiredRelease: installed2rel. - - - seaside := (map packageWithName: 'Seaside') lastRelease. - seaside publisher: goranAccount. - httpview := (map packageWithName: 'HttpView') lastRelease. - httpview publisher: goranAccount. - kom1 := (map packageWithName: 'KomHttpServer') firstRelease. - kom1 publisher: goranAccount. - kom2 := (map packageWithName: 'KomHttpServer') lastRelease. - kom2 publisher: goranAccount. - - conf1 := seaside addConfiguration. - conf2 := httpview addConfiguration. - conf1 addRequiredRelease: kom1. - conf2 addRequiredRelease: kom2! Item was removed: - SMMaintainableObject subclass: #SMDocument - instanceVariableNames: 'description author' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMDocument commentStamp: '<historical>' prior: 0! - An SMDocument refers typically to a piece of digital information accessible through a URL. :-) - This means it can be downloaded and cached. - - The instvar description describes the document and instvar author references the name and/or email of the original author. - - SMDocument has one subclasses - SMPackage. Since SqueakMap is primarily meant for - keeping track of installable source packages of Squeak software, a specific subclass handles those.! Item was removed: - ----- Method: SMDocument>>author (in category 'accessing') ----- - author - ^author! Item was removed: - ----- Method: SMDocument>>author: (in category 'accessing') ----- - author: aString - author := aString! Item was removed: - ----- Method: SMDocument>>description (in category 'accessing') ----- - description - ^description! Item was removed: - ----- Method: SMDocument>>description: (in category 'accessing') ----- - description: aString - description := aString! Item was removed: - ----- Method: SMDocument>>ensureInCache (in category 'cache') ----- - ensureInCache - "Makes sure the file is in the cache." - - self subclassResponsibility ! Item was removed: - ----- Method: SMDocument>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - description := author := ''! Item was removed: - ----- Method: SMDocument>>isCached (in category 'cache') ----- - isCached - "Is the file corresponding to me in the local file cache?" - - self subclassResponsibility ! Item was removed: - ----- Method: SMDocument>>isDownloadable (in category 'testing') ----- - isDownloadable - "Answer if I can be downloaded. - Default is false." - - ^ false - - - ! Item was removed: - SMResource subclass: #SMEmbeddedResource - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMEmbeddedResource commentStamp: '<historical>' prior: 0! - An embedded resource is a resource that is stored inside the map. No download is needed. - This means that embedded resources should be "small" and typically only be used for information that - is needed to be available at all times without downloading. A typical example is meta data for other SMObjects. - - ! Item was removed: - ----- Method: SMEmbeddedResource>>download (in category 'services') ----- - download - "A dummy method to respond as other resources would." - - ^true! Item was removed: - ----- Method: SMEmbeddedResource>>ensureInCache (in category 'services') ----- - ensureInCache - "Makes sure the file is in the cache. - An embedded resource doesn't have a file." - - ^true! Item was removed: - ----- Method: SMEmbeddedResource>>isCached (in category 'testing') ----- - isCached - "Is the file corresponding to me in the local file cache? - Well consider it as true since I am embedded in the map." - - ^true! Item was removed: - ----- Method: SMEmbeddedResource>>isEmbedded (in category 'testing') ----- - isEmbedded - ^ true! Item was removed: - SMResource subclass: #SMExternalResource - instanceVariableNames: 'downloadUrl' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMExternalResource commentStamp: 'gk 3/8/2004 20:09' prior: 0! - An external resource is a downloadable resource. - The instance variable downloadUrl holds the URL to the resource and the resource is cacheable in the FileCache for the SqueakMap. - An external resource can be used for any kind of document that is to be attached to another SMObject.! Item was removed: - ----- Method: SMExternalResource>>cacheDirectory (in category 'accessing') ----- - cacheDirectory - ^ map cache directoryForResource: self! Item was removed: - ----- Method: SMExternalResource>>contents (in category 'accessing') ----- - contents - "Return the contents of a stream from the downloaded resource. - Not yet tested, this resource returns the stream and not its contents." - - map cache add: self. - ^(self cacheDirectory readOnlyFileNamed: self downloadFileName) binary; yourself! Item was removed: - ----- Method: SMExternalResource>>download (in category 'services') ----- - download - "Force a download into the cache regardless if it is already there." - - ^map cache download: self! Item was removed: - ----- Method: SMExternalResource>>downloadFileName (in category 'accessing') ----- - downloadFileName - "Cut out the filename from the url." - - downloadUrl isEmpty ifTrue: [^nil]. - ^downloadUrl asUrl path last! Item was removed: - ----- Method: SMExternalResource>>downloadUrl (in category 'accessing') ----- - downloadUrl - ^ downloadUrl! Item was removed: - ----- Method: SMExternalResource>>downloadUrl: (in category 'accessing') ----- - downloadUrl: anUrl - downloadUrl := anUrl! Item was removed: - ----- Method: SMExternalResource>>ensureInCache (in category 'services') ----- - ensureInCache - "Makes sure the file is in the cache." - - ^map cache add: self! Item was removed: - ----- Method: SMExternalResource>>isCached (in category 'testing') ----- - isCached - "Is the file corresponding to me in the local file cache?" - - ^map cache includes: self! Item was removed: - ----- Method: SMExternalResource>>isDownloadable (in category 'accessing') ----- - isDownloadable - "Answer if I can be downloaded. - We simply verify that the download url - ends with a filename." - - ^self downloadFileName isEmptyOrNil not! Item was removed: - Object subclass: #SMFileCache - instanceVariableNames: 'map' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMFileCache commentStamp: 'gk 3/8/2004 20:10' prior: 0! - A repository for SMSqueakMap downloads. This behaves like a Set, responding to add: and include:, but also package contents may be forcibly refreshed with download:. - - The SqueakMap determines what path the cache resides at. Within the cache, there is a 'packages' directory containing UUID-based directories for each package containing further directories for each release. A 'resources' directory stores UUID-based directories for each Resource, with the file stored within that by its original name. Because the cache follows a Set protocol, it can be automatically traversed within Smalltalk's collection protocol, avoiding manual hassles.! Item was removed: - ----- Method: SMFileCache class>>newFor: (in category 'instance creation') ----- - newFor: aMap - "This is the default creation method, responsible for ensuring the - paths and such exist, and filling in defaults." - - ^self new forMap: aMap - ! Item was removed: - ----- Method: SMFileCache>>add: (in category 'services') ----- - add: aDownloadable - "Conditionally download the downloadable object into the cache. - Return true on success, otherwise false." - aDownloadable downloadFileName isEmptyOrNil ifTrue: [ ^ false ]. - ^(self includes: aDownloadable) - ifTrue: [true] - ifFalse: [self download: aDownloadable]! Item was removed: - ----- Method: SMFileCache>>cacheUrlFor: (in category 'private') ----- - cacheUrlFor: aDownloadable - "Find a cache URL for this downloadable. - Returns nil if no server is available. - Could use #relativeUrl also." - - | server | - server := aDownloadable map class findServer. - server ifNil: [^ nil]. - ^'http://', server, '/object/', aDownloadable id asString, '/cache'! Item was removed: - ----- Method: SMFileCache>>contents: (in category 'services') ----- - contents: anSMObject - "Return contents of the file for the object - or nil if not in cache." - - anSMObject isCached - ifTrue: [^(anSMObject cacheDirectory readOnlyFileNamed: anSMObject downloadFileName) binary; contentsOfEntireFile] - ifFalse: [^nil] - ! Item was removed: - ----- Method: SMFileCache>>directory (in category 'accessing') ----- - directory - ^map packageCacheDirectory! Item was removed: - ----- Method: SMFileCache>>directoryForPackage: (in category 'accessing') ----- - directoryForPackage: aPackage - "Returns the local path for storing the package cache's package file area. - This also ensures that the path exists." - - | slash path dir | - slash := FileDirectory slash. - path := 'packages' , slash , aPackage id asString36 , slash. - dir := FileDirectory default on: self directory fullName, slash, path. - dir assureExistence. - ^dir! Item was removed: - ----- Method: SMFileCache>>directoryForPackageRelease: (in category 'accessing') ----- - directoryForPackageRelease: aPackageRelease - "Returns the local path for storing the package cache's version of a - package file. This also ensures that the path exists." - - | slash path dir | - slash := FileDirectory slash. - path := 'packages' , slash , aPackageRelease package id asString36 , slash , aPackageRelease automaticVersionString. - dir := FileDirectory default on: self directory fullName, slash, path. - dir assureExistence. - ^dir! Item was removed: - ----- Method: SMFileCache>>directoryForResource: (in category 'accessing') ----- - directoryForResource: aResource - "Returns the local path for storing the package cache's version of a - resource file. This also ensures that the path exists." - - | slash path dir | - slash := FileDirectory slash. - path := 'resources' , slash , aResource id asString36. - dir := FileDirectory default on: self directory fullName, slash, path. - dir assureExistence. - ^dir! Item was removed: - ----- Method: SMFileCache>>download: (in category 'services') ----- - download: aDownloadable - "Download the file for this SMObject into the local file cache. - If the file already exists, delete it. - No unpacking or installation into the running image." - - | stream file fileName dir | - [fileName := aDownloadable downloadFileName. - fileName - ifNil: [self inform: 'No download url, can not download.'. - ^ false]. - fileName isEmpty - ifTrue: [self inform: 'Download url lacks filename, can not download.'. - ^ false]. - dir := aDownloadable cacheDirectory. - [stream := self getStream: aDownloadable. - stream ifNil: [^ false]. - (dir fileExists: fileName) - ifTrue: [dir deleteFileNamed: fileName]. - file := dir newFileNamed: fileName. - file binary; nextPutAll: stream contents] - ensure: [file ifNotNil: [file close]]] - on: Error - do: [^ false]. - ^ true! Item was removed: - ----- Method: SMFileCache>>forMap: (in category 'initialize') ----- - forMap: aMap - "Initialize the ache, make sure the cache dir exists." - - map := aMap! Item was removed: - ----- Method: SMFileCache>>getStream: (in category 'private') ----- - getStream: aDownloadable - "Get the stream, either from the original url - or if that fails, from the server cache - unless - this is the actual server of course. :) - We also verify that the sha1sum is correct." - - | stream | - [stream := aDownloadable downloadUrl asUrl retrieveContents contentStream binary. - (aDownloadable correctSha1sum: stream contents) - ifFalse: [self error: 'Incorrect SHA checksum of file from original URL']] - on: Error do: [:ex | - Transcript show: 'Download from original url (', aDownloadable downloadUrl, ') failed with this exception: ', ex messageText;cr. - SMUtilities isServer - ifTrue: [^nil] - ifFalse: [ - Transcript show: 'Trying server cache instead.'; cr. - [stream := (self cacheUrlFor: aDownloadable) asUrl retrieveContents contentStream binary. - (stream contents size = 21 and: [stream contents asString = 'SMFILEMISSINGONSERVER']) - ifTrue: [self error: 'File missing in server cache']. - (stream contents size = 24 and: [stream contents asString = 'SMRELEASENOTDOWNLOADABLE']) - ifTrue: [self error: 'Release not downloadable']. - (aDownloadable correctSha1sum: stream contents) - ifFalse: [self error: 'Incorrect SHA checksum of file from server']] - on: Error do: [:ex2 | | msg | - msg := 'Download from server cache of ', aDownloadable printName, ' failed with this exception: ', ex2 messageText. - Transcript show: msg; cr. - self error: msg]]]. - ^ stream! Item was removed: - ----- Method: SMFileCache>>includes: (in category 'services') ----- - includes: anSMObject - "Check if the cache holds the file for the object." - ^ anSMObject downloadFileName notNil and: [ anSMObject cacheDirectory fileExists: anSMObject downloadFileName ]! Item was removed: - ----- Method: SMFileCache>>map (in category 'accessing') ----- - map - ^ map! Item was removed: - ----- Method: SMFileCache>>remove: (in category 'services') ----- - remove: aDownloadable - "Remove aDownloadable from the cache, if it exists." - (self includes: aDownloadable) ifTrue: - [ aDownloadable cacheDirectory deleteFileNamed: aDownloadable downloadFileName ]! Item was removed: - SMEmbeddedResource subclass: #SMGenericEmbeddedResource - instanceVariableNames: 'contents' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMGenericEmbeddedResource commentStamp: 'gk 10/12/2005 23:01' prior: 0! - A generic embedded resource is simply some kind of object, held in instvar #contents, that is stored inside the map. No download is needed. - Embedded resources should be "small" and typically only be used for resources that - are needed to be available at all times without downloading. A typical example is meta data for other SMObjects. - - ! Item was removed: - ----- Method: SMGenericEmbeddedResource>>contents (in category 'as yet unclassified') ----- - contents - "Answers the contents object." - - ^contents! Item was removed: - ----- Method: SMGenericEmbeddedResource>>contents: (in category 'as yet unclassified') ----- - contents: obj - "Sets the actual contents of this resource. - SM does not know what it is." - - contents := obj! Item was removed: - Object subclass: #SMInstallationDeviation - instanceVariableNames: 'brokenConfigurations selectedRelease' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMInstallationDeviation commentStamp: '<historical>' prior: 0! - An installation deviation is when the user decides to install or upgrade to a release that is newer than one or more used configurations specify. - This means that the other installed releases which configurations will be broken may not work correctly. - Instvar selectedRelease refers to the release selected to install, brokenConfigurations is a collection of all configurations that need another release of this package.! Item was removed: - ----- Method: SMInstallationDeviation class>>selectedRelease:releases: (in category 'instance creation') ----- - selectedRelease: release releases: releases - ^self new selectedRelease: release releases: releases! Item was removed: - ----- Method: SMInstallationDeviation>>otherReleases (in category 'accessing') ----- - otherReleases - | package | - package := selectedRelease package. - ^ brokenConfigurations collect: [:conf | - conf releases detect: [:r | r package == package]]! Item was removed: - ----- Method: SMInstallationDeviation>>selectedRelease (in category 'accessing') ----- - selectedRelease - ^ selectedRelease! Item was removed: - ----- Method: SMInstallationDeviation>>selectedRelease:releases: (in category 'initialize-release') ----- - selectedRelease: aRelease releases: releases - - | p others | - selectedRelease := aRelease. - p := selectedRelease package. - brokenConfigurations := OrderedCollection new. - others := releases copyWithout: aRelease. - others := others select: [:r | r package ~= p]. - others do: [:rel | - rel workingConfigurations do: [:conf | | otherRequired | - otherRequired := conf requiredReleases select: [:r | r package ~= p]. - ((others includesAllOf: otherRequired) and: - [(conf requiredReleases includes: selectedRelease) not]) - ifTrue: [brokenConfigurations add: conf]]]! Item was removed: - Object subclass: #SMInstallationProposal - instanceVariableNames: 'installList comment deviations task' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMInstallationProposal commentStamp: '<historical>' prior: 0! - This is primarily an ordered list of package release installations or upgrades to achieve a given installation task. - ! Item was removed: - ----- Method: SMInstallationProposal class>>installList: (in category 'instance creation') ----- - installList: anOrderedCollection - ^ self new installList: anOrderedCollection! Item was removed: - ----- Method: SMInstallationProposal>>calculateComment (in category 'initialize-release') ----- - calculateComment - - comment := ''! Item was removed: - ----- Method: SMInstallationProposal>>calculateDeviations (in category 'initialize-release') ----- - calculateDeviations - "Calculate deviations. Currently we just pick the newest release." - - | conflicts | - deviations := OrderedCollection new. - conflicts := self collectConflictsIn: installList. - conflicts keysAndValuesDo: [:package :releases | | newest | - newest := releases first. - releases do: [:r | (r newerThan: newest) ifTrue: [newest := r]]. - deviations add: (SMInstallationDeviation selectedRelease: newest releases: installList)]! Item was removed: - ----- Method: SMInstallationProposal>>collectConflictsIn: (in category 'initialize-release') ----- - collectConflictsIn: collectionOfReleases - "Collect all conflicts where there are either - - multiple releases of the same package and/or - - another release of the same package already installed - Return the conflicts as an IdentityDictionary with - the package as key and the value being a Set of releases." - - | conflicts set | - conflicts := IdentityDictionary new. - collectionOfReleases do: [:r | - set := conflicts at: r package ifAbsentPut: [OrderedCollection new]. - set add: r]. - "Add the installed releases too" - conflicts keysAndValuesDo: [:key :value | - key isInstalled ifTrue: [value add: key installedRelease]]. - "Prune release sets with only one member" - ^conflicts select: [:releaseSet | releaseSet size > 1]! Item was removed: - ----- Method: SMInstallationProposal>>hasDeviations (in category 'initialize-release') ----- - hasDeviations - ^ deviations notEmpty! Item was removed: - ----- Method: SMInstallationProposal>>installList: (in category 'initialize-release') ----- - installList: anOrderedCollection - - installList := anOrderedCollection. - self calculateDeviations. - self calculateComment! Item was removed: - Object subclass: #SMInstallationRegistry - instanceVariableNames: 'installedPackages installCounter map' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMInstallationRegistry commentStamp: '<historical>' prior: 0! - A registry instance keeps track of installations into an image. Typically used by the SMSqueakMap instance when installing package releases.! Item was removed: - ----- Method: SMInstallationRegistry class>>map: (in category 'instance creation') ----- - map: aMap - "Create a new registry and make it use the given map." - - ^self new map: aMap! Item was removed: - ----- Method: SMInstallationRegistry>>clearInstalledPackageWithId: (in category 'queries') ----- - clearInstalledPackageWithId: aPackageId - "Clear the fact that any release of this package is installed. - Can be used even when the map isn't loaded." - - ^installedPackages ifNotNil: [ - installedPackages removeKey: (UUID fromString: aPackageId) ifAbsent: [nil]]! Item was removed: - ----- Method: SMInstallationRegistry>>clearInstalledPackages (in category 'services') ----- - clearInstalledPackages - "Simply clear the dictionary with information on installed packages. - Might be good if things get corrupted etc. Also see - SMSqueakMap class>>recreateInstalledPackagesFromChangeLog" - - installedPackages := nil. - installCounter := 0! Item was removed: - ----- Method: SMInstallationRegistry>>countInstall (in category 'private') ----- - countInstall - "Increase the install counter." - - installCounter ifNil: [installCounter := 0]. - ^installCounter := installCounter + 1 - ! Item was removed: - ----- Method: SMInstallationRegistry>>installCounter: (in category 'accessing') ----- - installCounter: anInteger - "Set counter directly." - - installCounter := anInteger! Item was removed: - ----- Method: SMInstallationRegistry>>installedPackages (in category 'queries') ----- - installedPackages - "Answer all packages that we know are installed. - Lazily initialize. The Dictionary contains the installed packages - using their UUIDs as keys and the version string as the value." - - | result | - result := OrderedCollection new. - installedPackages ifNil: [^#()] - ifNotNil: [installedPackages keys - do: [:k | | p | - p := map object: k. - p ifNotNil: [result add: p]]]. - ^result! Item was removed: - ----- Method: SMInstallationRegistry>>installedPackagesDictionary (in category 'accessing') ----- - installedPackagesDictionary - "Access the dictionary directly. The UUID of the installed package is the key. - The value is an OrderedCollection of Arrays. - The arrays have the smartVersion of the package, the time of the - installation in seconds and the sequence number (installCounter)." - - ^installedPackages ifNil: [Dictionary new]! Item was removed: - ----- Method: SMInstallationRegistry>>installedPackagesDictionary: (in category 'accessing') ----- - installedPackagesDictionary: aDict - "Set dictionary directly." - - installedPackages := aDict! Item was removed: - ----- Method: SMInstallationRegistry>>installedReleaseOf: (in category 'queries') ----- - installedReleaseOf: aPackage - "If the package is installed, return the release. - Otherwise return nil. SM2 stores the version as - an Association to be able to distinguish it." - - | autoVersionOrOld | - installedPackages ifNil: [^nil]. - autoVersionOrOld := (installedPackages at: aPackage id ifAbsent: [^nil]) last first. - (autoVersionOrOld isKindOf: Association) - ifTrue: [ - ^aPackage releaseWithAutomaticVersion: autoVersionOrOld value] - ifFalse: [ - ^aPackage releaseWithVersion: autoVersionOrOld]! Item was removed: - ----- Method: SMInstallationRegistry>>installedVersionOf: (in category 'queries') ----- - installedVersionOf: aPackage - "If the package is installed, return the version as a String. - If it is a package installed during SM1 it will return the manual version String, - for SM2 it returns the automatic version as a String. - If package is not installed - return nil. If you want it to work without the map loaded you - should instead use #installedVersionOfPackageWithId:." - - | versionOrString | - versionOrString := self installedVersionOfPackageWithId: aPackage id. - versionOrString ifNil: [^nil]. - ^versionOrString isString - ifTrue: [versionOrString] - ifFalse: [versionOrString versionString]! Item was removed: - ----- Method: SMInstallationRegistry>>installedVersionOfPackageWithId: (in category 'queries') ----- - installedVersionOfPackageWithId: anId - "If the package is installed, return the automatic version or version String. - Otherwise return nil. This can be used without the map loaded." - - | autoVersionOrOld | - installedPackages ifNil: [^nil]. - autoVersionOrOld := (installedPackages at: anId ifAbsent: [^nil]) last first. - (autoVersionOrOld isKindOf: Association) - ifTrue: [ - ^autoVersionOrOld value] - ifFalse: [ - ^autoVersionOrOld]! Item was removed: - ----- Method: SMInstallationRegistry>>map: (in category 'accessing') ----- - map: aMap - - map := aMap! Item was removed: - ----- Method: SMInstallationRegistry>>markInstalled:version:time:counter: (in category 'private') ----- - markInstalled: uuid version: version time: time counter: num - "Private. Mark the installation. SM2 uses an Association - to distinguish the automatic version from old versions." - - - | installs | - installedPackages ifNil: [installedPackages := Dictionary new]. - installs := installedPackages at: uuid ifAbsentPut: [OrderedCollection new]. - installs add: - (Array with: 2->version - with: time - with: num)! Item was removed: - ----- Method: SMInstallationRegistry>>noteInstalledPackage:version: (in category 'installation-changelog') ----- - noteInstalledPackage: uuidString version: version - "Mark a specific version of a package as installed. - This method is called when replaying a logged installation - from before SqueakMap 1.07. Such logged installations lacked - a timestamp and a count. We take the current time and a - count starting from -10000 and upwards. This should keep - the sorting order correct." - - "Find the lowest installed count." - | lowest | - lowest := 0. - installedPackages ifNotNil: [ - installedPackages valuesDo: [:oc | - oc do: [:array | - array last < lowest ifTrue: [lowest := array last]]]] - ifNil: [lowest := -10000]. - lowest negative ifFalse: [lowest := -10000]. - ^self noteInstalledPackage: uuidString version: version - atSeconds: Time totalSeconds number: lowest + 1! Item was removed: - ----- Method: SMInstallationRegistry>>noteInstalledPackage:version:atSeconds:number: (in category 'installation-changelog') ----- - noteInstalledPackage: uuidString version: version atSeconds: time number: num - "Mark a package as installed in the Dictionary. - This method is called when replaying a logged installation. - <time> is the point in time as totalSeconds of the installation. - <num> is the installCount of the installation. - This method is typically called from a doIt in the changelog - in order to try to keep track of packages installed." - - num negative ifFalse: ["Not an emulated count from prior SM1.07" - installCounter := num max: installCounter]. - self markInstalled: (UUID fromString: uuidString) version: version time: time counter: num! Item was removed: - ----- Method: SMInstallationRegistry>>noteInstalledPackageWithId:autoVersion:atSeconds:number: (in category 'installation-changelog') ----- - noteInstalledPackageWithId: uuidString autoVersion: version atSeconds: time number: num - "Mark a package as installed in the Dictionary. - This method is called when replaying a logged installation. - <time> is the point in time as totalSeconds of the installation. - <num> is the installCount of the installation. - This method is typically called from a doIt in the changelog - in order to try to keep track of packages installed." - - num negative ifFalse: ["Not an emulated count from prior SM1.07" - installCounter := num max: installCounter]. - self markInstalled: (UUID fromString: uuidString) version: version time: time counter: num! Item was removed: - ----- Method: SMInstallationRegistry>>noteInstalledPackageWithId:autoVersion:name: (in category 'installation') ----- - noteInstalledPackageWithId: aPackageId autoVersion: aVersion name: aName - "The package release was just successfully installed. - Can be used to inform SM of an installation not been - done using SM, even when the map isn't loaded. - - We record the fact in our Dictionary of installed packages - and log a 'do it' to mark this in the changelog. - The doit helps keeping track of the packages when - recovering changes etc - not a perfect solution but should help. - The map used is the default map. - The id of the package is the key and the value is an OrderedCollection - of Arrays with the release auto version, the point in time and the current installCounter." - - | time name id v | - v := aVersion isString ifTrue: [aVersion asVersion] ifFalse: [aVersion]. - aName ifNil: [name := '<unknown package name>'] ifNotNil: [name := aName]. - id := UUID fromString: aPackageId. - time := Time totalSeconds. - self countInstall. - self markInstalled: id version: v time: time counter: installCounter. - (((Smalltalk classNamed: 'SmalltalkImage') ifNotNil: [:si | si current]) ifNil: [Smalltalk]) - logChange: '"Installed ', name, ' auto version ', v versionString, '". - (Smalltalk at: #SMSqueakMap ifAbsent: []) ifNotNil:[ - SMSqueakMap noteInstalledPackageWithId: ', id asString storeString, ' autoVersion: ', v storeString, ' atSeconds: ', time asString, ' number: ', installCounter asString, ']'! Item was removed: - ----- Method: SMInstallationRegistry>>noteUninstalledPackageWithId:autoVersion:name: (in category 'installation') ----- - noteUninstalledPackageWithId: aPackageId autoVersion: aVersion name: aName - "The package release was just successfully uninstalled. - Can be used to inform SM of an uninstallation not been - done using SM, even when the map isn't loaded. - - We record the fact in our Dictionary of installed packages - and log a 'do it' to mark this in the changelog. - The doit helps keeping track of the packages when - recovering changes etc - not a perfect solution but should help. - The map used is the default map. - The id of the package is the key and the value is an OrderedCollection - of Arrays with the release auto version, the point in time and the current installCounter." - - | time name id v | - v := aVersion isString ifTrue: [aVersion asVersion] ifFalse: [aVersion]. - aName ifNil: [name := '<unknown package name>'] ifNotNil: [name := aName]. - id := UUID fromString: aPackageId. - time := Time totalSeconds. - self countInstall. "Used for both installs and uninstalls" - self clearInstalled: id version: v time: time counter: installCounter. - (((Smalltalk classNamed: 'SmalltalkImage') ifNotNil: [:si | si current]) ifNil: [Smalltalk]) - logChange: '"Uninstalled ', name, ' auto version ', v versionString, '". - (Smalltalk at: #SMSqueakMap ifAbsent: []) ifNotNil:[ - SMSqueakMap noteUninstalledPackageWithId: ', id asString storeString, ' autoVersion: ', v storeString, ' atSeconds: ', time asString, ' number: ', installCounter asString, ']'! Item was removed: - Object subclass: #SMInstallationTask - instanceVariableNames: 'map engine' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMInstallationTask commentStamp: '<historical>' prior: 0! - An SMInstallationProposal is effectively a list of releases to install or upgrade to in a specific order to achieve an SMInstallationTask. - The task can be either an upgrade or a new installation - the proposal still involved an ordered list of installations or upgrades. - ! Item was removed: - ----- Method: SMInstallationTask>>calculate (in category 'calculation') ----- - calculate - "Calculate how the task should be performed. - After calculation the task can be inspected and presented - to the user for confirmation. Actually performing the task - is done by #execute." - - self subclassResponsibility ! Item was removed: - ----- Method: SMInstallationTask>>engine: (in category 'accessing') ----- - engine: anEngine - engine := anEngine. - map := engine map! Item was removed: - ----- Method: SMInstallationTask>>execute (in category 'calculation') ----- - execute - "Actually perform the task." - - self subclassResponsibility ! Item was removed: - ----- Method: SMInstallationTask>>map (in category 'accessing') ----- - map - ^map! Item was removed: - Object subclass: #SMInstaller - instanceVariableNames: 'packageRelease' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMInstaller commentStamp: '<historical>' prior: 0! - An installer takes care of installing SqueakMap packages represented by SMCards. - Deciding if a package is installable and instantiating the correct installer class is done on the class side, see implementors of #canInstall:. Two methods need to be implemented by subclasses - download and install. Upgrade can also be specialized by implementing #upgrade, otherwise it will default to #install.! Item was removed: - ----- Method: SMInstaller class>>basicNewChangeSet: (in category 'changeset utilities') ----- - basicNewChangeSet: newName - "This method copied here to ensure SqueakMap is independent of - ChangesOrganizer. " - Smalltalk - at: #ChangesOrganizer - ifPresentAndInMemory: [:cs | ^ cs basicNewChangeSet: newName]. - (self changeSetNamed: newName) - ifNotNil: [self error: 'The name ' , newName , ' is already used']. - ^ ChangeSet basicNewNamed: newName! Item was removed: - ----- Method: SMInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackageRelease - "Nope, I am an abstract class and can not install anything. - But my subclasses should reimplement this." - - ^ false! Item was removed: - ----- Method: SMInstaller class>>changeSetNamed: (in category 'changeset utilities') ----- - changeSetNamed: newName - "This method copied here to ensure SqueakMap is independent of ChangesOrganizer." - - Smalltalk at: #ChangesOrganizer ifPresentAndInMemory: [ :cs | ^cs changeSetNamed: newName ]. - ^ChangeSet allInstances detect: [ :cs | cs name = newName ] ifNone: [ nil ].! Item was removed: - ----- Method: SMInstaller class>>classForPackageRelease: (in category 'instance creation') ----- - classForPackageRelease: aPackageRelease - "Decide which subclass to instantiate. - We detect and return the first subclass - that wants to handle the release going - recursively leaf first so that subclasses gets - first chance if several classes compete over - the same packages, like for example SMDVSInstaller - that also uses the .st file extension." - - self subclasses do: [:ea | - (ea classForPackageRelease: aPackageRelease) - ifNotNil: [:class | ^ class]]. - ^(self canInstall: aPackageRelease) - ifTrue: [self]! Item was removed: - ----- Method: SMInstaller class>>forPackageRelease: (in category 'deprecated') ----- - forPackageRelease: aPackageRelease - "Instantiate the first class suitable to install the package release. - If no installer class is found we raise an Error." - - | class | - aPackageRelease ifNil: [self error: 'No package release specified to find installer for.']. - class := self classForPackageRelease: aPackageRelease. - ^class - ifNil: [self error: 'No installer found for package ', aPackageRelease name, '.'] - ifNotNil: [class new packageRelease: aPackageRelease]! Item was removed: - ----- Method: SMInstaller class>>isInstallable: (in category 'testing') ----- - isInstallable: aPackageRelease - "Detect if any subclass can handle the package release." - - aPackageRelease ifNil: [^false]. - ^(self classForPackageRelease: aPackageRelease) notNil! Item was removed: - ----- Method: SMInstaller class>>isUpgradeable: (in category 'testing') ----- - isUpgradeable: aPackageRelease - "Detect if any subclass can handle the release. - Currently we assume that upgrade is the same as install." - - ^self isInstallable: aPackageRelease! Item was removed: - ----- Method: SMInstaller>>download (in category 'services') ----- - download - "This service should bring the package release to - the client and also unpack it on disk if needed. - It will not install it into the running image though. - Raises errors if operation does not succeed." - - self subclassResponsibility ! Item was removed: - ----- Method: SMInstaller>>install (in category 'services') ----- - install - "This service should bring the package release to the client, - unpack it if necessary and install it into the image. - The package release should be notified of the installation using - 'packageRelease noteInstalled'." - - self subclassResponsibility ! Item was removed: - ----- Method: SMInstaller>>isCached (in category 'testing') ----- - isCached - "Check if it is in the cache." - - ^packageRelease isCached! Item was removed: - ----- Method: SMInstaller>>packageRelease: (in category 'accessing') ----- - packageRelease: aPackageRelease - packageRelease := aPackageRelease! Item was removed: - ----- Method: SMInstaller>>silent (in category 'private') ----- - silent - "Can we ask questions?" - - ^packageRelease ifNotNil: [packageRelease map silent] ifNil: [false]! Item was removed: - ----- Method: SMInstaller>>upgrade (in category 'services') ----- - upgrade - "This service performs an upgrade to the selected release. - Currently it just defaults to the same operation as an install - - which is handled fine by Monticello, but not necessarily for - other formats." - - ^self install! Item was removed: - SMGenericEmbeddedResource subclass: #SMKabunguHint - instanceVariableNames: 'type' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! Item was removed: - ----- Method: SMKabunguHint>>account (in category 'as yet unclassified') ----- - account - - ^ self owner! Item was removed: - ----- Method: SMKabunguHint>>type (in category 'as yet unclassified') ----- - type - - ^ type! Item was removed: - ----- Method: SMKabunguHint>>type: (in category 'as yet unclassified') ----- - type: t - - type := t! Item was removed: - SMSimpleInstaller subclass: #SMLanguageInstaller - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! Item was removed: - ----- Method: SMLanguageInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Answer if this class can install the package. - We handle .translation files optionally compressed." - - | fileName | - ((Smalltalk includesKey: #Language) - or: [Smalltalk includesKey: #NaturalLanguageTranslator]) ifFalse: [^false]. - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - fileName := fileName asLowercase. - ^(fileName endsWith: '.translation') or: [ - (fileName endsWith: '.tra') or: [ - (fileName endsWith: '.tra.gz') or: [ - fileName endsWith: '.translation.gz']]]! Item was removed: - ----- Method: SMLanguageInstaller>>install (in category 'services') ----- - install - "This service should bring the package to the client, - unpack it if necessary and install it into the image. - The package is notified of the installation." - - | translator | - self cache; unpack. - translator := Smalltalk at: #Language ifAbsent: [Smalltalk at: #NaturalLanguageTranslator]. - [translator mergeTranslationFileNamed: unpackedFileName] - ensure: [packageRelease noteInstalled]! Item was removed: - SMPersonalObject subclass: #SMMaintainableObject - instanceVariableNames: 'maintainers rss feedbackEmail' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMMaintainableObject commentStamp: '<historical>' prior: 0! - A mainainable object is a personal object that is of such a complexity that it seems beneficial to optionally co-maintain with other people. - It thus has a potential list of maintainers - other accounts that also can modify the object. It also has a field to be able to refer to an RSS feed regarding the object.! Item was removed: - ----- Method: SMMaintainableObject>>addMaintainer: (in category 'maintainers') ----- - addMaintainer: anAccount - "Add anAccount as a maintainer." - - maintainers ifNil: [maintainers := OrderedCollection new]. - maintainers add: anAccount. - anAccount addCoObject: self! Item was removed: - ----- Method: SMMaintainableObject>>delete (in category 'deletion') ----- - delete - "Disconnect from maintainers." - - super delete. - maintainers ifNotNil: [ - maintainers copy do: [:m | self removeMaintainer: m]]! Item was removed: - ----- Method: SMMaintainableObject>>feedbackEmail (in category 'maintainers') ----- - feedbackEmail - ^feedbackEmail! Item was removed: - ----- Method: SMMaintainableObject>>feedbackEmail: (in category 'maintainers') ----- - feedbackEmail: anEmail - feedbackEmail := anEmail! Item was removed: - ----- Method: SMMaintainableObject>>isOwnerOrMaintainer: (in category 'testing') ----- - isOwnerOrMaintainer: anAccount - ^ owner = anAccount or: [self maintainers includes: anAccount]! Item was removed: - ----- Method: SMMaintainableObject>>maintainers (in category 'maintainers') ----- - maintainers - "Return all maintainers." - - ^maintainers ifNil: [#()]! Item was removed: - ----- Method: SMMaintainableObject>>removeMaintainer: (in category 'maintainers') ----- - removeMaintainer: anAccount - "Remove anAccount as a maintainer." - - maintainers ifNil: [^self]. - maintainers remove: anAccount. - anAccount removeCoObject: self! Item was removed: - ----- Method: SMMaintainableObject>>rss (in category 'maintainers') ----- - rss - ^rss! Item was removed: - ----- Method: SMMaintainableObject>>rss: (in category 'maintainers') ----- - rss: anUrl - anUrl = 'nil' - ifTrue: [rss := nil] - ifFalse: [rss := anUrl]! Item was removed: - SMSimpleInstaller subclass: #SMMcInstaller - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMMcInstaller commentStamp: 'gk 10/8/2003 14:28' prior: 0! - I am a SMInstaller that knows how to install .mcz (Monticello) files. If Monticello is installed I use that (MCMczReader), otherwise I file in the code more simply using the package MCInstaller (MczInstaller).! Item was removed: - ----- Method: SMMcInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Is this a Monticello package and do I have MCInstaller - or Monticello available?" - - | fileName | - ((Smalltalk includesKey: #MCMczReader) or: [ - Smalltalk includesKey: #MczInstaller]) - ifTrue: [ - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - ^ 'mcz' = (FileDirectory extensionFor: fileName) asLowercase]. - ^false! Item was removed: - ----- Method: SMMcInstaller>>fileIn (in category 'private') ----- - fileIn - | extension | - extension := (FileDirectory extensionFor: fileName) asLowercase. - extension = 'mcz' - ifTrue: [self installMcz] - ifFalse: [self error: 'Cannot install file of type .', extension]! Item was removed: - ----- Method: SMMcInstaller>>fullFileName (in category 'private') ----- - fullFileName - ^ dir fullNameFor: fileName! Item was removed: - ----- Method: SMMcInstaller>>install (in category 'services') ----- - install - "This service should bring the package to the client, - unpack it if necessary and install it into the image. - The package is notified of the installation." - - self cache; fileIn. - packageRelease noteInstalled! Item was removed: - ----- Method: SMMcInstaller>>installMcz (in category 'private') ----- - installMcz - "Install the package, we already know that either MCInstaller or Monticello is available." - - | installer monticello | - installer := MczInstaller. - (Smalltalk hasClassNamed: #MCMczReader) ifFalse: [ - packageRelease package isInstalled ifTrue: [ - (self silent ifFalse: [ - (self confirm: - 'A release of package ''', packageRelease package name, ''' is already installed. - You only have MCInstaller and not Monticello - installed and MCInstaller can not properly upgrade packages. - Do you wish to install Monticello first and then proceed? - If you answer no MCInstaller will be used - but at your own risk. - Cancel cancels the installation.' orCancel: [self error: 'Installation cancelled.'])] - ifTrue: [false]) - ifTrue: [ - monticello := packageRelease map packageWithName: 'Monticello'. - monticello lastPublishedRelease - ifNotNil: [monticello lastPublishedRelease install] - ifNil: [monticello lastRelease install]. - installer := (Smalltalk at: #MCMczReader)]] - ] ifTrue: [installer := (Smalltalk at: #MCMczReader)]. - installer loadVersionFile: self fullFileName! Item was removed: - Object subclass: #SMObject - instanceVariableNames: 'id map created updated name summary url' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMObject commentStamp: 'gk 9/23/2003 20:26' prior: 0! - SMObject is the abstract superclass for all objects living in an SMSqueakMap. - - It has a unique UUID and a reference to the owning SMSqueakMap. - It has timestamps to record the birthtime and the last modification. - It has basic attributes like name, oneline summary and url. - - - - - - ! Item was removed: - ----- Method: SMObject class>>newIn: (in category 'instance creation') ----- - newIn: aMap - "Create a new object in a given map with an UUID to ensure unique identity." - - ^(self basicNew) map: aMap id: UUID new! Item was removed: - ----- Method: SMObject>><= (in category 'comparing') ----- - <= anSMObject - - ^name <= anSMObject name! Item was removed: - ----- Method: SMObject>>asString (in category 'accessing') ----- - asString - ^ self name! Item was removed: - ----- Method: SMObject>>created (in category 'accessing') ----- - created - ^TimeStamp fromSeconds: created! Item was removed: - ----- Method: SMObject>>createdAsSeconds (in category 'accessing') ----- - createdAsSeconds - ^created! Item was removed: - ----- Method: SMObject>>delete (in category 'deletion') ----- - delete - "Delete from map." - - map deleteObject: self! Item was removed: - ----- Method: SMObject>>describe:withBoldLabel:on: (in category 'printing') ----- - describe: string withBoldLabel: label on: stream - "Helper method for doing styled text." - - stream withAttribute: (TextEmphasis bold) do: [ stream nextPutAll: label ]. - stream nextPutAll: string; cr! Item was removed: - ----- Method: SMObject>>id (in category 'accessing') ----- - id - ^id! Item was removed: - ----- Method: SMObject>>id: (in category 'accessing') ----- - id: anId - id := anId! Item was removed: - ----- Method: SMObject>>initialize (in category 'initialize-release') ----- - initialize - "Initialize the receiver." - - updated := created := TimeStamp current asSeconds. - name := summary := url := ''.! Item was removed: - ----- Method: SMObject>>isAccount (in category 'testing') ----- - isAccount - ^false! Item was removed: - ----- Method: SMObject>>isCategory (in category 'testing') ----- - isCategory - ^false! Item was removed: - ----- Method: SMObject>>isPackage (in category 'testing') ----- - isPackage - ^false! Item was removed: - ----- Method: SMObject>>isPackageRelease (in category 'testing') ----- - isPackageRelease - ^false! Item was removed: - ----- Method: SMObject>>isResource (in category 'testing') ----- - isResource - ^false! Item was removed: - ----- Method: SMObject>>map (in category 'accessing') ----- - map - ^map! Item was removed: - ----- Method: SMObject>>map: (in category 'accessing') ----- - map: aMap - map := aMap! Item was removed: - ----- Method: SMObject>>map:id: (in category 'initialize-release') ----- - map: aMap id: anId - "Initialize the receiver." - - self initialize. - map := aMap. - id := anId! Item was removed: - ----- Method: SMObject>>name (in category 'accessing') ----- - name - ^name! Item was removed: - ----- Method: SMObject>>name: (in category 'accessing') ----- - name: aName - name := aName! Item was removed: - ----- Method: SMObject>>printName (in category 'printing') ----- - printName - "Return a String identifying receiver without a context. - Default is name." - - ^self name! Item was removed: - ----- Method: SMObject>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPutAll: self class name, '[', name, ']'! Item was removed: - ----- Method: SMObject>>stampAsUpdated (in category 'updating') ----- - stampAsUpdated - "This method should be called whenever the object is modified." - - updated := TimeStamp current asSeconds! Item was removed: - ----- Method: SMObject>>summary (in category 'accessing') ----- - summary - ^summary! Item was removed: - ----- Method: SMObject>>summary: (in category 'accessing') ----- - summary: aString - summary := aString! Item was removed: - ----- Method: SMObject>>type (in category 'printing') ----- - type - - ^'Object'! Item was removed: - ----- Method: SMObject>>updated (in category 'accessing') ----- - updated - ^TimeStamp fromSeconds: updated! Item was removed: - ----- Method: SMObject>>updatedAsSeconds (in category 'accessing') ----- - updatedAsSeconds - ^updated! Item was removed: - ----- Method: SMObject>>url (in category 'accessing') ----- - url - ^url! Item was removed: - ----- Method: SMObject>>url: (in category 'accessing') ----- - url: aString - url := aString! Item was removed: - ----- Method: SMObject>>userInterface (in category 'accessing') ----- - userInterface - "Return the object that we use for interacting with the user." - - ^SMUtilities! Item was removed: - ----- Method: SMObject>>withId:in: (in category 'private') ----- - withId: aUUIDString in: aCollection - "Return the object with the corresponding id - and nil if not found." - - | uuid | - uuid := UUID fromString: aUUIDString. - ^aCollection detect: [:o | o id = uuid ] ifNone: [nil]! Item was removed: - SMDocument subclass: #SMPackage - instanceVariableNames: 'releases packageInfoName repository' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPackage commentStamp: '<historical>' prior: 0! - An SMPackage represents a named piece of an installable "thing" in the image. Typically it is a code package, but it can be other things too. - It owns a collection of SMPackageReleases. Each release represents a version of the package, and each release has a URL that refers to the actual content that can be installed. - - An SMPackage also knows its packageInfoName which can tie it into the image.! Item was removed: - ----- Method: SMPackage>>addRelease: (in category 'private') ----- - addRelease: aSMPackageRelease - "Add the release. Make sure package is set." - (releases includes: aSMPackageRelease) ifFalse: [ releases add: aSMPackageRelease ]. - aSMPackageRelease package: self. - ^ aSMPackageRelease! Item was removed: - ----- Method: SMPackage>>cacheDirectory (in category 'cache') ----- - cacheDirectory - ^ self lastRelease cacheDirectory! Item was removed: - ----- Method: SMPackage>>currentVersion (in category 'accessing') ----- - currentVersion - ^self isPublished ifTrue: [self lastPublishedRelease version]! Item was removed: - ----- Method: SMPackage>>delete (in category 'private') ----- - delete - "Delete me. Delete my releases." - - super delete. - self deleteReleases! Item was removed: - ----- Method: SMPackage>>deleteReleases (in category 'private') ----- - deleteReleases - "Delete my releases." - - releases copy do: [:release | release delete]! Item was removed: - ----- Method: SMPackage>>download (in category 'cache') ----- - download - "Force download into cache." - - self isReleased ifFalse: [self error: 'There is no release for this package to download.']. - ^self lastRelease download! Item was removed: - ----- Method: SMPackage>>ensureInCache (in category 'cache') ----- - ensureInCache - "Makes sure all release files are in the cache." - - self releases do: [:rel | rel ensureInCache ]! Item was removed: - ----- Method: SMPackage>>firstRelease (in category 'services') ----- - firstRelease - "Return the first release." - - ^releases isEmpty ifTrue: [nil] ifFalse: [releases first]! Item was removed: - ----- Method: SMPackage>>fullDescription (in category 'accessing') ----- - fullDescription - "Return a full textual description of the package. - Most of the description is taken from the last release." - | s publishedRelease sqDescription | - s := TextStream on: (Text new: 400). - - self - describe: name - withBoldLabel: 'Name: ' - on: s. - - summary isEmptyOrNil - ifFalse: [self - describe: summary - withBoldLabel: 'Summary: ' - on: s ]. - - author isEmptyOrNil - ifFalse: [s - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Author:']; - tab; - tab. - s - withAttribute: (PluggableTextAttribute - evalBlock: [self userInterface - sendMailTo: (SMUtilities stripEmailFrom: author) - regardingPackageRelease: self lastRelease]) - do: [s nextPutAll: author]; - cr]. - self owner - ifNotNil: [s - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Owner:']; - tab; tab. - s - withAttribute: (PluggableTextAttribute - evalBlock: [self userInterface - sendMailTo: self owner email - regardingPackageRelease: self lastRelease]) - do: [s nextPutAll: self owner nameAndEmail]; - cr]. - - self maintainers isEmpty ifFalse: [ - s withAttribute: TextEmphasis bold do: [s nextPutAll: 'Co-Maintainers:']; tab. - self maintainers do: [:com | - com = self maintainers first ifFalse: [s nextPutAll: ', ']. - s - withAttribute: - (PluggableTextAttribute - evalBlock: [self userInterface - sendMailTo: com email - regardingPackageRelease: self lastRelease]) - do: [s nextPutAll: com nameAndEmail]]. - s cr]. - - description isEmptyOrNil - ifFalse: [sqDescription := description withSqueakLineEndings. - s cr. - s - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Description:']. - s cr. - s - withAttribute: (TextIndent tabs: 1) - do: [s next: (sqDescription findLast: [ :c | c isSeparator not ]) putAll: sqDescription]. - s cr ]. - - self describeCategoriesOn: s indent: 1. - - s cr. - publishedRelease := self lastPublishedRelease. - self - describe: (self publishedVersion ifNil: ['<not published>']) - withBoldLabel: 'Published Version: ' - on: s. - self isPublished ifTrue: [ - s - withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Created: ' ]; - print: publishedRelease created; - cr. - self note isEmptyOrNil - ifFalse: [s - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Release Note:']. - s cr. - s - withAttribute: (TextIndent tabs: 1) - do: [s nextPutAll: publishedRelease note withSqueakLineEndings]. - s cr ]]. - - url isEmptyOrNil - ifFalse: [s cr; - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Homepage: ']; - withAttribute: (TextURL new url: url) - do: [s nextPutAll: url]; - cr]. - packageInfoName isEmptyOrNil - ifFalse: [self - describe: packageInfoName - withBoldLabel: 'Package Info: ' - on: s ]. - - ^ s contents! Item was removed: - ----- Method: SMPackage>>getCoEditLink: (in category 'view') ----- - getCoEditLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getCoEditLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getCoEditLink:view: (in category 'view') ----- - getCoEditLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'copackage/', id asString, '/edit' text: 'edit' view: aView! Item was removed: - ----- Method: SMPackage>>getCoEditReleasesLink: (in category 'view') ----- - getCoEditReleasesLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getCoEditReleasesLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getCoEditReleasesLink:view: (in category 'view') ----- - getCoEditReleasesLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'copackage/', id asString, '/editreleases' text: 'edit releases' view: aView! Item was removed: - ----- Method: SMPackage>>getCoLink: (in category 'view') ----- - getCoLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getCoLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getCoLink:view: (in category 'view') ----- - getCoLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'copackage/', id asString text: name view: aView! Item was removed: - ----- Method: SMPackage>>getEditLink: (in category 'view') ----- - getEditLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getEditLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getEditLink:view: (in category 'view') ----- - getEditLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'package/', id asString, '/edit' text: 'edit' view: aView! Item was removed: - ----- Method: SMPackage>>getEditReleasesLink: (in category 'view') ----- - getEditReleasesLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getEditReleasesLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getEditReleasesLink:view: (in category 'view') ----- - getEditReleasesLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'package/', id asString, '/editreleases' text: 'edit releases' view: aView! Item was removed: - ----- Method: SMPackage>>getLink: (in category 'view') ----- - getLink: aBuilder - "Return a link for using on the web. - Relative to the current view." - - ^self getLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackage>>getLink:view: (in category 'view') ----- - getLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLink: 'package/', id asString text: name view: aView! Item was removed: - ----- Method: SMPackage>>initialize (in category 'initialize-release') ----- - initialize - "Initialize package." - - super initialize. - packageInfoName := ''. - releases := OrderedCollection new! Item was removed: - ----- Method: SMPackage>>install (in category 'installation') ----- - install - "Install the latest newer published version for this version of Squeak." - - ^map installPackage: self! Item was removed: - ----- Method: SMPackage>>installedRelease (in category 'installation') ----- - installedRelease - "Return the installed release. - We ask the map. Return nil if this package is not installed." - - ^map installedReleaseOf: self! Item was removed: - ----- Method: SMPackage>>installedVersion (in category 'printing') ----- - installedVersion - "Return the version String for the installed version. - We ask the map. Return nil if this package is not installed." - - ^self installedRelease ifNotNil: [:r | r smartVersion]! Item was removed: - ----- Method: SMPackage>>isAvailable (in category 'testing') ----- - isAvailable - "Answer if I am old or not installed regardless of - if there is installer support for me. It also does - not care if the newer release is not published - or no for this Squeak version." - - ^self isOld or: [self isInstalled not]! Item was removed: - ----- Method: SMPackage>>isCached (in category 'testing') ----- - isCached - "Is the last release corresponding to me in the local file cache? - NOTE: This doesn't honour #published nor if the release is - intended for the current Squeak version." - - ^self isReleased and: [self lastRelease isCached]! Item was removed: - ----- Method: SMPackage>>isInstallable (in category 'testing') ----- - isInstallable - "Answer if any of my releases can be installed." - - ^ releases anySatisfy: [:rel | rel isInstallable]! Item was removed: - ----- Method: SMPackage>>isInstallableAndNotInstalled (in category 'testing') ----- - isInstallableAndNotInstalled - "Answer if there is any installer that - can install me and I am not yet installed." - - ^self isInstallable and: [self isInstalled not]! Item was removed: - ----- Method: SMPackage>>isInstalled (in category 'testing') ----- - isInstalled - "Answer if any version of me is installed." - - ^(map installedReleaseOf: self) notNil! Item was removed: - ----- Method: SMPackage>>isOld (in category 'testing') ----- - isOld - "Answer if I am installed and there also is a - newer version available *regardless* if it is - not published or not for this Squeak version. - This is for people who want to experiment!!" - - | installed | - installed := map installedReleaseOf: self. - ^installed - ifNil: [false] - ifNotNil: [ - self releases anySatisfy: [:r | - r newerThan: installed ]]! Item was removed: - ----- Method: SMPackage>>isPackage (in category 'testing') ----- - isPackage - ^true! Item was removed: - ----- Method: SMPackage>>isPublished (in category 'testing') ----- - isPublished - "Answer if I have public releases." - - ^releases anySatisfy: [:rel | rel isPublished]! Item was removed: - ----- Method: SMPackage>>isReleased (in category 'testing') ----- - isReleased - ^ releases isEmpty not! Item was removed: - ----- Method: SMPackage>>isSafeToInstall (in category 'testing') ----- - isSafeToInstall - "Answer if I am NOT installed and there also is a - published version for this version of Squeak available." - ^ self isInstalled not - and: [self lastReleaseForCurrentSystemVersion notNil]! Item was removed: - ----- Method: SMPackage>>isSafelyAvailable (in category 'testing') ----- - isSafelyAvailable - "Answer if I am old or not installed regardless of - if there is installer support for me. The - newer release should be published - and meant for this Squeak version." - - ^self isSafeToInstall or: [self isSafelyOld]! Item was removed: - ----- Method: SMPackage>>isSafelyOld (in category 'testing') ----- - isSafelyOld - "Answer if I am installed and there also is a - newer published version for this version of Squeak available." - - | installed | - installed := self installedRelease. - ^installed ifNil: [false] ifNotNil: [ - ^(self lastPublishedReleaseForCurrentSystemVersionNewerThan: installed) notNil]! Item was removed: - ----- Method: SMPackage>>isSafelyOldAndUpgradeable (in category 'testing') ----- - isSafelyOldAndUpgradeable - "Answer if I am installed and there also is a - newer published version for this version of Squeak available - that can be upgraded to (installer support)." - - | installed newRelease | - installed := self installedRelease. - ^installed ifNil: [false] ifNotNil: [ - newRelease := self lastPublishedReleaseForCurrentSystemVersionNewerThan: installed. - ^newRelease ifNil: [false] ifNotNil: [newRelease isUpgradeable]]! Item was removed: - ----- Method: SMPackage>>lastPublishedRelease (in category 'services') ----- - lastPublishedRelease - "Return the latest published release." - - ^releases isEmpty ifTrue: [nil] ifFalse: [ - releases reversed detect: [:r | r isPublished] ifNone:[nil]]! Item was removed: - ----- Method: SMPackage>>lastPublishedReleaseForCurrentSystemVersion (in category 'services') ----- - lastPublishedReleaseForCurrentSystemVersion - "Return the latest published release marked - as compatible with the current SystemVersion." - - ^releases isEmpty ifTrue: [nil] ifFalse: [ - releases reversed detect: [:r | - r isPublished and: [r isCompatibleWithCurrentSystemVersion]] - ifNone:[nil]]! Item was removed: - ----- Method: SMPackage>>lastPublishedReleaseForCurrentSystemVersionNewerThan: (in category 'services') ----- - lastPublishedReleaseForCurrentSystemVersionNewerThan: aRelease - "Return the latest published release marked - as compatible with the current SystemVersion - that is newer than the given release." - - ^releases isEmpty ifTrue: [nil] ifFalse: [ - releases reversed detect: [:r | - (r isPublished and: [r newerThan: aRelease]) - and: [r isCompatibleWithCurrentSystemVersion]] - ifNone:[nil]]! Item was removed: - ----- Method: SMPackage>>lastRelease (in category 'services') ----- - lastRelease - "Return the latest release." - - ^releases isEmpty ifTrue: [nil] ifFalse: [releases last]! Item was removed: - ----- Method: SMPackage>>lastReleaseForCurrentSystemVersion (in category 'services') ----- - lastReleaseForCurrentSystemVersion - "Return the latest published release marked - as compatible with the current SystemVersion." - ^ releases isEmpty - ifFalse: [releases reversed - detect: [:r | r isCompatibleWithCurrentSystemVersion] - ifNone: []]! Item was removed: - ----- Method: SMPackage>>nameWithVersionLabel (in category 'installation') ----- - nameWithVersionLabel - ^name, ' (', self versionLabel, ')'! Item was removed: - ----- Method: SMPackage>>newChildReleaseFrom: (in category 'private') ----- - newChildReleaseFrom: aRelease - "Create a new release." - - ^self addRelease: (map newObject: (SMPackageRelease newFromRelease: aRelease package: self))! Item was removed: - ----- Method: SMPackage>>newRelease (in category 'private') ----- - newRelease - "Create a new release. Just use the last - chronological release as parent, if this is the first release - that is nil." - - ^self newChildReleaseFrom: self lastRelease! Item was removed: - ----- Method: SMPackage>>note (in category 'accessing') ----- - note - ^self isPublished ifTrue: [self lastPublishedRelease note]! Item was removed: - ----- Method: SMPackage>>packageInfoName (in category 'accessing') ----- - packageInfoName - ^packageInfoName! Item was removed: - ----- Method: SMPackage>>packageInfoName: (in category 'accessing') ----- - packageInfoName: aString - packageInfoName := aString! Item was removed: - ----- Method: SMPackage>>parentReleaseFor: (in category 'services') ----- - parentReleaseFor: aPackageRelease - "If there is none (the given release is automaticVersion '1'), return nil." - - | previousVersion | - previousVersion := aPackageRelease automaticVersion previous. - ^releases detect: [:r | r automaticVersion = previousVersion] ifNone: [nil]! Item was removed: - ----- Method: SMPackage>>previousReleaseFor: (in category 'services') ----- - previousReleaseFor: aPackageRelease - "If there is none, return nil." - - ^releases before: aPackageRelease ifAbsent: [nil]! Item was removed: - ----- Method: SMPackage>>publishedVersion (in category 'accessing') ----- - publishedVersion - ^self isPublished ifTrue: [self lastPublishedRelease version]! Item was removed: - ----- Method: SMPackage>>releaseWithAutomaticVersion: (in category 'services') ----- - releaseWithAutomaticVersion: aVersion - "Look up a specific package release of mine. Return nil if missing. - They are few so we just do a #select:." - - ^releases detect: [:rel | rel automaticVersion = aVersion ] ifNone: [nil]! Item was removed: - ----- Method: SMPackage>>releaseWithAutomaticVersionString: (in category 'services') ----- - releaseWithAutomaticVersionString: aVersionString - "Look up a specific package release of mine. Return nil if missing. - They are few so we just do a #select:." - - ^self releaseWithAutomaticVersion: aVersionString asVersion! Item was removed: - ----- Method: SMPackage>>releaseWithId: (in category 'services') ----- - releaseWithId: anIdString - | anId | - anId := UUID fromString: anIdString. - ^ releases - detect: [ : each | each id = anId ] - ifNone: [ nil ]! Item was removed: - ----- Method: SMPackage>>releaseWithVersion: (in category 'services') ----- - releaseWithVersion: aVersionString - "Look up a specific package release of mine. Return nil if missing. - They are few so we just do a #select:." - - ^releases detect: [:rel | rel version = aVersionString ] ifNone: [nil]! Item was removed: - ----- Method: SMPackage>>releases (in category 'accessing') ----- - releases - ^releases! Item was removed: - ----- Method: SMPackage>>removeRelease: (in category 'private') ----- - removeRelease: aRelease - "Remove the release." - - releases remove: aRelease! Item was removed: - ----- Method: SMPackage>>repository (in category 'accessing') ----- - repository - ^repository! Item was removed: - ----- Method: SMPackage>>repository: (in category 'accessing') ----- - repository: aString - repository := aString! Item was removed: - ----- Method: SMPackage>>smartVersion (in category 'services') ----- - smartVersion - "Delegate to last release for this SystemVersion." - | r | - r := self lastReleaseForCurrentSystemVersion. - ^r ifNotNil: [r smartVersion] ifNil: ['']! Item was removed: - ----- Method: SMPackage>>type (in category 'printing') ----- - type - - ^'Package'! Item was removed: - ----- Method: SMPackage>>upgrade (in category 'installation') ----- - upgrade - "Upgrade to the latest newer published version for this version of Squeak." - - | installed | - installed := self installedRelease. - installed - ifNil: [self error: 'No release installed, can not upgrade.'] - ifNotNil: [^installed upgrade]! Item was removed: - ----- Method: SMPackage>>upgradeOrInstall (in category 'installation') ----- - upgradeOrInstall - "Upgrade to or install the latest newer published version for this version of Squeak." - - | installed | - installed := self installedRelease. - installed - ifNil: [^self install] - ifNotNil: [^installed upgrade]! Item was removed: - ----- Method: SMPackage>>versionLabel (in category 'installation') ----- - versionLabel - "Return a label indicating installed and available version as: - '1.0' = 1.0 is installed and no new published version for this version of Squeak is available - '1.0->1.1' = 1.0 is installed and 1.1 is published for this version of Squeak - '->1.1' = No version is installed and 1.1 is published for this version of Squeak - '->(1.1) = No version is installed and there is only a non published version available for this version of Squeak - - The version showed is the one that #smartVersion returns. - If a version name is in parenthesis it is not published." - - | installedVersion r r2 | - r := self installedRelease. - r ifNotNil: [ - installedVersion := r smartVersion. - r2 := self lastPublishedReleaseForCurrentSystemVersionNewerThan: r] - ifNil: [ - installedVersion := ''. - r2 := self lastPublishedReleaseForCurrentSystemVersion ]. - ^r2 ifNil: [installedVersion ] ifNotNil: [installedVersion, '->', r2 smartVersion].! Item was removed: - ----- Method: SMPackage>>viewFor: (in category 'view') ----- - viewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis." - - ^uiObject packageViewOn: self! Item was removed: - SMInstallationTask subclass: #SMPackageInstallationTask - instanceVariableNames: 'wantedPackages wantedReleases analysis' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPackageInstallationTask commentStamp: '<historical>' prior: 0! - A package installation task is to install one or more given SMPackages (not specified releases) into the image. - - First it tries to calculate the ideal releases of the given packages that it will try to install given the policy and preferences set by the user. Then it runs an analysis to find how to install those wanted releases. This typically results in zero, one or more possible scenarios. - ! Item was removed: - ----- Method: SMPackageInstallationTask class>>engine:wantedPackages: (in category 'instance creation') ----- - engine: engine wantedPackages: wantedPackages - ^self new engine: engine; wantedPackages: wantedPackages! Item was removed: - ----- Method: SMPackageInstallationTask>>allInstallPaths (in category 'queries') ----- - allInstallPaths - "Return all different ways to install - the ones requested plus all dependencies. - This includes ways where different releases of the same package are combined." - - ^analysis allInstallPaths! Item was removed: - ----- Method: SMPackageInstallationTask>>analysis (in category 'accessing') ----- - analysis - "Return the analysis of the task." - - ^analysis! Item was removed: - ----- Method: SMPackageInstallationTask>>calculate (in category 'calculation') ----- - calculate - "First calculate the wanted releases. Then perform a dependency analysis. - We return the most basic result of the analysis - does there exist at least one - working installation scenario without tweaks?" - - self calculateWantedReleases. - analysis := SMDependencyAnalysis task: self. - analysis installPackageReleases: wantedReleases. - ^analysis success! Item was removed: - ----- Method: SMPackageInstallationTask>>calculateWantedReleases (in category 'private') ----- - calculateWantedReleases - "The user gave us wanted packages. - We need to figure out which actual releases of those - we should try to install." - - wantedReleases := Set new. - wantedPackages do: [:p | | rel | - rel := self idealReleaseFor: p. - rel ifNotNil: [wantedReleases add: rel]]! Item was removed: - ----- Method: SMPackageInstallationTask>>idealReleaseFor: (in category 'private') ----- - idealReleaseFor: aPackage - "Return the most suitable release to install for <aPackage>." - - ^ aPackage lastPublishedReleaseForCurrentSystemVersion! Item was removed: - ----- Method: SMPackageInstallationTask>>proposals (in category 'queries') ----- - proposals - "Return all different possible proposals to install - sorted with the best proposal first." - - ^analysis allNormalizedInstallPaths collect: [:path | SMInstallationProposal installList: path]! Item was removed: - ----- Method: SMPackageInstallationTask>>wantedPackages: (in category 'accessing') ----- - wantedPackages: packages - - wantedPackages := packages! Item was removed: - SMCategorizableObject subclass: #SMPackageRelease - instanceVariableNames: 'publisher automaticVersion version note downloadUrl package repository sha1sum' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPackageRelease commentStamp: '<historical>' prior: 0! - A package release refers to a specific version of the package. - Releases are auto numbered (with a VersionNumber) and also has a designated version name which can be whatever the maintainer wants. - There is also a release note and the URL for download. The inherited url is for any homepage for the release. - The instvar publisher refers to the SMAccount that owned the package at the time of the release and the instvar package refers to the owning package. - The instvar repository holds a String that is used to connect to the live repository for the package release, for example a Monticello repository.! Item was removed: - ----- Method: SMPackageRelease class>>newFromRelease:package: (in category 'instance creation') ----- - newFromRelease: aPackageRelease package: aPackage - "Create a new release from a given release." - - ^super new initializeFromRelease: aPackageRelease package: aPackage! Item was removed: - ----- Method: SMPackageRelease>>addConfiguration (in category 'configurations') ----- - addConfiguration - "Create and add a new SMPackageReleaseConfiguration and return it." - - ^ self addResource: (SMPackageReleaseConfiguration newIn: map)! Item was removed: - ----- Method: SMPackageRelease>>addToLocalCache (in category 'private') ----- - addToLocalCache - self downloadUrl ifNotNil: [map cache add: self]! Item was removed: - ----- Method: SMPackageRelease>>automaticVersion (in category 'accessing') ----- - automaticVersion - "Return the VersionNumber for me." - - ^automaticVersion! Item was removed: - ----- Method: SMPackageRelease>>automaticVersionString (in category 'accessing') ----- - automaticVersionString - "Return my VersionNumber as a String." - - ^automaticVersion versionString! Item was removed: - ----- Method: SMPackageRelease>>cacheDirectory (in category 'accessing') ----- - cacheDirectory - ^ map cache directoryForPackageRelease: self! Item was removed: - ----- Method: SMPackageRelease>>calculateSha1sum (in category 'accessing') ----- - calculateSha1sum - "Return the checksum of the currently cached file contents." - - ^SecureHashAlgorithm new hashMessage: self contents - - - ! Item was removed: - ----- Method: SMPackageRelease>>configurations (in category 'configurations') ----- - configurations - "Return all SMPackageReleaseConfigurations attached to this release." - - - ^ self embeddedResources select: [:er | er isConfiguration]! Item was removed: - ----- Method: SMPackageRelease>>contents (in category 'accessing') ----- - contents - "Return the contents of the cached file. - If it is not downloadable, or if the file - is not cached, return nil." - - ^map cache contents: self! Item was removed: - ----- Method: SMPackageRelease>>correctSha1sum: (in category 'accessing') ----- - correctSha1sum: content - "Return if the checksum of the content is correct. - If we have none, then we consider that to be correct." - - ^sha1sum isNil or: [sha1sum = (SecureHashAlgorithm new hashMessage: content)] - - - ! Item was removed: - ----- Method: SMPackageRelease>>delete (in category 'deletion') ----- - delete - super delete. - package removeRelease: self! Item was removed: - ----- Method: SMPackageRelease>>download (in category 'services') ----- - download - "Force a download into the cache regardless if it is already there." - - ^map cache download: self! Item was removed: - ----- Method: SMPackageRelease>>downloadFileName (in category 'accessing') ----- - downloadFileName - "Cut out the filename from the url." - - downloadUrl isEmpty ifTrue: [^nil]. - ^downloadUrl asUrl path last! Item was removed: - ----- Method: SMPackageRelease>>downloadUrl (in category 'accessing') ----- - downloadUrl - ^downloadUrl! Item was removed: - ----- Method: SMPackageRelease>>downloadUrl: (in category 'accessing') ----- - downloadUrl: urlString - downloadUrl := urlString! Item was removed: - ----- Method: SMPackageRelease>>eitherVersion (in category 'services') ----- - eitherVersion - "Return either version: - 1. If the maintainer entered a version then we use that. - 2. Otherwise we use the automatic version with an 'r' prepended." - - ^version notEmpty - ifTrue:[version] - ifFalse:['r', automaticVersion versionString]! Item was removed: - ----- Method: SMPackageRelease>>ensureInCache (in category 'services') ----- - ensureInCache - "Makes sure the file is in the cache. - Return true on success, otherwise false." - - ^map cache add: self! Item was removed: - ----- Method: SMPackageRelease>>fullDescription (in category 'printing') ----- - fullDescription - "Return a full textual description of the package release." - - | s | - s := TextStream on: (Text new: 400). - self describe: self package name withBoldLabel: 'Package Name: ' on: s. - name isEmptyOrNil ifFalse: - [self describe: self name withBoldLabel: 'Release Name: ' on: s]. - summary isEmptyOrNil ifFalse: - [self describe: self summary withBoldLabel: 'Release Summary: ' on: s]. - - self - describe: self version - withBoldLabel: 'Version: ' - on: s. - - self note isEmptyOrNil - ifFalse: - [ s withAttribute: (TextIndent tabs: 1) do: [s nextPutAll: self note withSqueakLineEndings]. - s cr]. - - categories isEmptyOrNil - ifFalse: - [s - cr; - withAttribute: TextEmphasis bold do: [s nextPutAll: 'Categories: ']; - cr. - (self categories sorted: [:a :b | a path < b path]) - do: [: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]. - - created ifNotNil: [ - s - withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Created: ' ]; - print: self created; - cr]. - updated ifNotNil: [ - s - withAttribute: TextEmphasis bold do: [ s nextPutAll: 'Modified: ' ]; - print: self updated; - cr]. - publisher ifNotNil: [ - s - withAttribute: TextEmphasis bold - do: [s nextPutAll: 'Publisher: ']. - s - withAttribute: (PluggableTextAttribute - evalBlock: [self userInterface - sendMailTo: self publisher email - regardingPackageRelease: self]) - do: [s nextPutAll: self publisher nameAndEmail]; - cr]. - - url isEmptyOrNil - ifFalse: - [s - withAttribute: TextEmphasis bold do: [s nextPutAll: 'Homepage:']; - tab; - withAttribute: (TextURL new url: url) do: [s nextPutAll: url]; - cr]. - self downloadUrl isEmptyOrNil - ifFalse: - [s - withAttribute: TextEmphasis bold do: [s nextPutAll: 'Download:']; - tab; - withAttribute: (TextURL new url: self downloadUrl) - do: [s nextPutAll: self downloadUrl]; - cr]. - ^s contents. - - ! Item was removed: - ----- Method: SMPackageRelease>>fullVersion (in category 'services') ----- - fullVersion - "Return version followed by the automatic version - with r prepended in parenthesis." - - ^version, ' (r', automaticVersion versionString, ')'! Item was removed: - ----- Method: SMPackageRelease>>getLink: (in category 'view') ----- - getLink: aBuilder - "Return a link for using on the web." - - ^self getLink: aBuilder view: aBuilder view! Item was removed: - ----- Method: SMPackageRelease>>getLink:view: (in category 'view') ----- - getLink: aBuilder view: aView - "Return a link for using on the web." - - ^aBuilder getLinkTop: self relativeUrl text: self packageNameWithVersion! Item was removed: - ----- Method: SMPackageRelease>>getShortLink: (in category 'view') ----- - getShortLink: aBuilder - - ^aBuilder getLinkTop: self relativeUrl text: self listName! Item was removed: - ----- Method: SMPackageRelease>>hasFulfilledConfiguration (in category 'configurations') ----- - hasFulfilledConfiguration - "Is any of the configurations already fulfilled? - A fulfilled configuration has all required releases - already installed, this means the release can be - trivially installed." - - ^self workingConfigurations anySatisfy: [:c | c isFulfilled]! Item was removed: - ----- Method: SMPackageRelease>>hasNoConfigurations (in category 'configurations') ----- - hasNoConfigurations - "Does this release lack configurations, - both working or failed ones? This is interpreted - as if the release has no dependencies." - - ^self configurations isEmpty! Item was removed: - ----- Method: SMPackageRelease>>initializeFromRelease:package: (in category 'initialize-release') ----- - initializeFromRelease: parentRelease package: aPackage - "Initialize package release from a given parent. Branch if needed." - self - map: aPackage map - id: UUID new. - package := aPackage. - aPackage isCommunitySupported ifTrue: [ self beCommunitySupported ]. - automaticVersion := parentRelease - ifNil: [ VersionNumber first ] - ifNotNil: - [ self downloadUrl: parentRelease downloadUrl. - parentRelease nextOrBranch ]. - version := note := String empty! Item was removed: - ----- Method: SMPackageRelease>>install (in category 'services') ----- - install - "Install this package release." - - ^map installPackageRelease: self! Item was removed: - ----- Method: SMPackageRelease>>isCached (in category 'testing') ----- - isCached - "Delegate to last release." - - ^map cache includes: self! Item was removed: - ----- Method: SMPackageRelease>>isCompatibleWithCurrentSystemVersion (in category 'testing') ----- - isCompatibleWithCurrentSystemVersion - "Return true if this release is listed as being compatible with the SystemVersion of the current image. Only checks major/minor version number; does not differentiate between alpha/beta/gamma releases. Checks version categories of both the SMPackageRelease and the parent SMPackage." - - | current | - current := (self majorMinorVersionFrom: SystemVersion current version) - copyWithout: Character space. - self categories, self package categories do: [:c | - ((c parent name = 'Squeak versions') and: [ - ((self majorMinorVersionFrom: c name) - copyWithout: Character space) = current]) - ifTrue: [^true]]. - ^ false - ! Item was removed: - ----- Method: SMPackageRelease>>isDownloadable (in category 'testing') ----- - isDownloadable - "Answer if I can be downloaded. - We simply verify that the download url - ends with a filename." - - ^self downloadFileName isEmptyOrNil not! Item was removed: - ----- Method: SMPackageRelease>>isInstallable (in category 'testing') ----- - 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 release is installed or not." - - ^SMInstaller isInstallable: self! Item was removed: - ----- Method: SMPackageRelease>>isInstalled (in category 'testing') ----- - isInstalled - "Answer if this release is installed." - - ^(map installedReleaseOf: package) == self! Item was removed: - ----- Method: SMPackageRelease>>isPackageRelease (in category 'testing') ----- - isPackageRelease - ^true! Item was removed: - ----- Method: SMPackageRelease>>isPublished (in category 'testing') ----- - isPublished - "It is published when the publisher is set." - - ^publisher notNil! Item was removed: - ----- Method: SMPackageRelease>>isUpgradeable (in category 'testing') ----- - isUpgradeable - "Answer if there is any installer that can upgrade 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 - or if there is a newer version available or not." - - ^SMInstaller isUpgradeable: self! Item was removed: - ----- Method: SMPackageRelease>>listName (in category 'printing') ----- - listName - "Return something suitable for showing in lists. - We list the manual version after a dash if it is available. - We don't list the release name." - - ^version isEmpty - ifFalse: [self automaticVersion versionString , '-', version] - ifTrue: [self automaticVersion versionString] ! Item was removed: - ----- Method: SMPackageRelease>>majorMinorVersionFrom: (in category 'private') ----- - majorMinorVersionFrom: aVersionName - - | start | - start := aVersionName indexOf: $.. - start = 0 ifTrue: [^ aVersionName]. - aVersionName size = start ifTrue: [^ aVersionName]. - start + 1 to: aVersionName size do: [:i | - (aVersionName at: i) isDigit ifFalse: [^aVersionName copyFrom: 1 to: i - 1]]. - ^aVersionName! Item was removed: - ----- Method: SMPackageRelease>>newerThan: (in category 'testing') ----- - newerThan: aRelease - "Answer if this release was made after <aRelease>." - ^ (aRelease automaticVersion inSameBranchAs: automaticVersion) - ifTrue: [ aRelease automaticVersion < automaticVersion ] - ifFalse: [ aRelease automaticVersion numbers first > automaticVersion numbers first ]! Item was removed: - ----- Method: SMPackageRelease>>nextOrBranch (in category 'services') ----- - nextOrBranch - "Return a new automaticVersion that is either - the next following my version, or if that is taken - a branch, or if that is taken too - a branch from it and so on. - Yes, it sucks, but I don't have time hacking VersionNumber right now." - - | nextVersion nextBranch | - nextVersion := automaticVersion next. - (package releaseWithAutomaticVersion: nextVersion) ifNil: [^nextVersion]. - nextBranch := automaticVersion branchNext. - [(package releaseWithAutomaticVersion: nextBranch) notNil] - whileTrue: [nextBranch := nextBranch branchNext]. - ^nextBranch - ! Item was removed: - ----- Method: SMPackageRelease>>note (in category 'accessing') ----- - note - ^note! Item was removed: - ----- Method: SMPackageRelease>>note: (in category 'accessing') ----- - note: aString - note := aString! Item was removed: - ----- Method: SMPackageRelease>>noteInstalled (in category 'services') ----- - noteInstalled - "This package release was just successfully installed. - We tell the map so that it can keep track of what - package releases are installed." - - map noteInstalled: self! Item was removed: - ----- Method: SMPackageRelease>>noteUninstalled (in category 'services') ----- - noteUninstalled - "This package release was just successfully uninstalled. - We tell the map so that it can keep track of what - package releases are installed." - - self error: 'Uninstall is not working yet!!'. - map noteUninstalled: self! Item was removed: - ----- Method: SMPackageRelease>>olderThan: (in category 'testing') ----- - olderThan: aRelease - "Answer if this release was made before <aRelease>." - - ^automaticVersion < aRelease automaticVersion! Item was removed: - ----- Method: SMPackageRelease>>package (in category 'accessing') ----- - package - "Get the package that I belong to." - - ^package! Item was removed: - ----- Method: SMPackageRelease>>package: (in category 'private') ----- - package: aPackage - "Set when I am created." - - package := aPackage! Item was removed: - ----- Method: SMPackageRelease>>packageNameWithVersion (in category 'printing') ----- - packageNameWithVersion - "Return '<packageName> <autoVersion>-<version>' like: - 'SqueakMap 5-0.92' " - - ^package name, ' ', self listName! Item was removed: - ----- Method: SMPackageRelease>>parentRelease (in category 'services') ----- - parentRelease - "Return my parent release based on the automatic - version number." - - ^package parentReleaseFor: self! Item was removed: - ----- Method: SMPackageRelease>>previousRelease (in category 'services') ----- - previousRelease - "Return the release before me. - Returns nil if there is none. - This is chronological order and not how they relate." - - ^package previousReleaseFor: self! Item was removed: - ----- Method: SMPackageRelease>>printName (in category 'printing') ----- - printName - "Return a String identifying object without context." - - ^self packageNameWithVersion! Item was removed: - ----- Method: SMPackageRelease>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPutAll: self class name, '[', self packageNameWithVersion, ']'! Item was removed: - ----- Method: SMPackageRelease>>publisher (in category 'accessing') ----- - publisher - ^publisher! Item was removed: - ----- Method: SMPackageRelease>>publisher: (in category 'accessing') ----- - publisher: anObject - publisher := anObject! Item was removed: - ----- Method: SMPackageRelease>>refreshInCache (in category 'services') ----- - refreshInCache - "Delete and re-download the file back into the cache. - Return true on success, otherwise false." - map cache remove: self. - ^ self - sha1sum: nil; - ensureInCache! Item was removed: - ----- Method: SMPackageRelease>>relativeUrl (in category 'services') ----- - relativeUrl - "Return the relative url for this release on an SM server." - - ^'package/', package id asString, '/autoversion/', automaticVersion versionString! Item was removed: - ----- Method: SMPackageRelease>>removeFromLocalCache (in category 'private') ----- - removeFromLocalCache - self downloadUrl ifNotNil: [map cache remove: self]! Item was removed: - ----- Method: SMPackageRelease>>repository (in category 'accessing') ----- - repository - ^repository! Item was removed: - ----- Method: SMPackageRelease>>repository: (in category 'accessing') ----- - repository: aString - repository := aString! Item was removed: - ----- Method: SMPackageRelease>>sha1sum (in category 'accessing') ----- - sha1sum - ^sha1sum! Item was removed: - ----- Method: SMPackageRelease>>sha1sum: (in category 'accessing') ----- - sha1sum: aString - sha1sum := aString! Item was removed: - ----- Method: SMPackageRelease>>smartVersion (in category 'services') ----- - smartVersion - "This method is used to ensure that we always have a - version name for the package release even if the maintainer didn't - bother to enter one. Is is calculated like this: - 1. If the maintainer entered a version then we use that. - 2. Otherwise we use the automatic version with an 'r' prepended. - 3. If the release is not published we enclose it in parenthesis." - - ^ self isPublished ifTrue: [self eitherVersion] ifFalse: ['(', self eitherVersion, ')']! Item was removed: - ----- Method: SMPackageRelease>>type (in category 'printing') ----- - type - - ^'Package release'! Item was removed: - ----- Method: SMPackageRelease>>upgrade (in category 'services') ----- - upgrade - "Upgrade this package release if there is a new release available." - - | newRelease | - newRelease := package lastPublishedReleaseForCurrentSystemVersionNewerThan: self. - newRelease ifNotNil: [(SMInstaller forPackageRelease: newRelease) upgrade]! Item was removed: - ----- Method: SMPackageRelease>>version (in category 'accessing') ----- - version - ^version! Item was removed: - ----- Method: SMPackageRelease>>version: (in category 'accessing') ----- - version: aString - version := aString! Item was removed: - ----- Method: SMPackageRelease>>viewFor: (in category 'view') ----- - viewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis." - - ^uiObject packageReleaseViewOn: self! Item was removed: - ----- Method: SMPackageRelease>>workingConfigurations (in category 'configurations') ----- - workingConfigurations - "Return all working configurations." - - ^ self configurations select: [:c | c isWorking ]! Item was removed: - SMEmbeddedResource subclass: #SMPackageReleaseConfiguration - instanceVariableNames: 'requiredReleases status' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPackageReleaseConfiguration commentStamp: '<historical>' prior: 0! - A package release configuration describes the result of testing the specific release with a set of other releases that it depends on. - The status instvar holds a symbol which reflects the result. Currently there are two valid values: - #working - #failing - - The intention is that users and maintainers post these configurations to the map as "known working combinations of required releases". - Each SMPackageRelease can then have multiple of these configurations.! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>addRequiredRelease: (in category 'dependencies') ----- - addRequiredRelease: aRelease - "Add <aRelease> as a required release. The release added - can not indirectly refer back to this release." - - (self isCircular: aRelease) ifTrue: [self error: 'Circular dependencies not allowed.']. - requiredReleases := requiredReleases copyWith: aRelease. - ^aRelease! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - requiredReleases := #(). - status := #working! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>isCircular: (in category 'private') ----- - isCircular: aRelease - "Answer if there is a reference that goes back - to the release of this configuration." - - "This is the base case" - aRelease == object ifTrue: [^ true]. - - aRelease configurations do: [:conf | - conf requiredReleases do: [:rel | - (self isCircular: rel) ifTrue: [^ true]]]. - ^false! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>isConfiguration (in category 'testing') ----- - isConfiguration - ^true! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>isFailing (in category 'testing') ----- - isFailing - ^status == #failing! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>isFulfilled (in category 'testing') ----- - isFulfilled - "Are all my required releases already installed?" - - ^requiredReleases allSatisfy: [:r | r isInstalled ]! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>isWorking (in category 'testing') ----- - isWorking - ^status == #working! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>printOn: (in category 'printing') ----- - printOn: aStream - - aStream nextPutAll: 'Cfg['. - requiredReleases do: [:r | - aStream nextPutAll: r printString; space]. - aStream nextPutAll: ']'! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>removeRequiredRelease: (in category 'dependencies') ----- - removeRequiredRelease: aRelease - "Remove <aRelease> as a required release." - - requiredReleases := requiredReleases copyWithout: aRelease. - ^ aRelease! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>requiredReleases (in category 'accessing') ----- - requiredReleases - ^ requiredReleases! Item was removed: - ----- Method: SMPackageReleaseConfiguration>>status (in category 'accessing') ----- - status - ^ status! Item was removed: - SMPackageInstallationTask subclass: #SMPackageUpgradeTask - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPackageUpgradeTask commentStamp: '<historical>' prior: 0! - A package upgrade task is to upgrade one or more given SMPackages (not specified releases) in the image to newer releases. - - First it tries to calculate the newest available releases of the given packages that it will try to upgrade given the policy and preferences set by the user. Then it runs an analysis to find how to upgrade to those wanted releases. This typically results in zero, one or more possible scenarios. - ! Item was removed: - SMRootedObject subclass: #SMPersonalObject - instanceVariableNames: 'owner' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMPersonalObject commentStamp: 'gk 7/27/2004 13:28' prior: 0! - SMPersonalObject is the abstract base class for things that belong/are owned by a user account in SqueakMap. Most things are personal objects - but the SMCategories aren't for example. - - A personal object has a reference to the SMAccount owning it.! Item was removed: - ----- Method: SMPersonalObject>>delete (in category 'deletion') ----- - delete - "Disconnect from owner." - - super delete. - owner removeObject: self! Item was removed: - ----- Method: SMPersonalObject>>owner (in category 'accessing') ----- - owner - ^owner! Item was removed: - ----- Method: SMPersonalObject>>owner: (in category 'accessing') ----- - owner: anAccount - owner := anAccount! Item was removed: - SMSimpleInstaller subclass: #SMProjectInstaller - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMProjectInstaller commentStamp: '<historical>' prior: 0! - I am a SMInstaller that knows how to install .pr (Project) files.! Item was removed: - ----- Method: SMProjectInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Answer if this class can install the package. - We handle .pr files (upper and lowercase)" - - | fileName | - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - ^'pr' = (FileDirectory extensionFor: fileName) asLowercase! Item was removed: - ----- Method: SMProjectInstaller>>install (in category 'services') ----- - install - "This service should bring the package to the client, - unpack it if necessary and install it into the image. - The package is notified of the installation." - - Project canWeLoadAProjectNow ifFalse: [self error: 'Can not load Project now, probably because not in Morphic.']. - self cache. - [[ ProjectLoading openFromDirectory: dir andFileName: fileName ] - on: ProgressTargetRequestNotification do: [ :ex | ex resume ]] - ensure: [packageRelease noteInstalled]! Item was removed: - SMPersonalObject subclass: #SMResource - instanceVariableNames: 'object version' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMResource commentStamp: '<historical>' prior: 0! - A resource is a document that is NOT a package. Thus, it is used for all the things interesting to register on SM that aren't packages. The are three major differences with resources: - - - A resource keeps no track of version history like packages do with package releases. It only has a field for the current version. - - A resource can be embedded inside the map instead of being a document reached by a URL. - - A resource can be associated with another SMObject, the instvar object. - - However, resources respond to some of the same actions as PackageReleases.! Item was removed: - ----- Method: SMResource class>>forString: (in category 'instance creation') ----- - forString: aString - ^ SMEmbeddedResource new content: aString! Item was removed: - ----- Method: SMResource class>>forUrl: (in category 'instance creation') ----- - forUrl: anUrl - ^ SMExternalResource new downloadUrl: anUrl; yourself! Item was removed: - ----- Method: SMResource>>isConfiguration (in category 'testing') ----- - isConfiguration - ^ false! Item was removed: - ----- Method: SMResource>>isEmbedded (in category 'testing') ----- - isEmbedded - ^false! Item was removed: - ----- Method: SMResource>>isResource (in category 'testing') ----- - isResource - ^ true! Item was removed: - ----- Method: SMResource>>object (in category 'accessing') ----- - object - ^object! Item was removed: - ----- Method: SMResource>>object: (in category 'accessing') ----- - object: anSMCategorizableObject - object := anSMCategorizableObject! Item was removed: - ----- Method: SMResource>>version (in category 'accessing') ----- - version - ^ version! Item was removed: - ----- Method: SMResource>>version: (in category 'accessing') ----- - version: aVersion - version := aVersion! Item was removed: - SMCategorizableObject subclass: #SMRootedObject - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMRootedObject commentStamp: '<historical>' prior: 0! - An SMRootedObject is an SMObject that can be "rooted" in a given homeMap. This concept is for the upcoming new architecture with a tree of SM servers. Not used yet.! Item was removed: - SMSimpleInstaller subclass: #SMSARInstaller - instanceVariableNames: 'zip' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMSARInstaller commentStamp: '<historical>' prior: 0! - I am a SqueakMap installer that knows how to deal with Zip format change-set archives. - I recognize them by the file extension ".sar" (Squeak Archive). - - These have a couple of members with special names: - - install/preamble - install/postscript - - These are loaded in order. Either or both can further load other members using fileInMemberNamed:. - - Inside a postscript or preamble, the pseudo-variable "self" is set to an instance of SARInstaller; you can then get to its ZipArchive using the method "zip". Or you can call its methods for filing in change sets, extracting files, etc. - - You can test this loading with: - (SMSARInstaller new) directory: FileDirectory default; fileName: 'test.sar'; fileIn. - - See ChangeSet>>fileOutAsZipNamed: for one way to make these files. Here is another way of creating a multi change set archive installable by SqueakMap: - - "The following doit will create a .sar file with HVs preamble and postscript as - separate entries and the included changesets included as normal. - Given a preamble as described below this will autoinstall in SqueakMap." - (ChangeSorter changeSetNamed: 'HV') - fileOutAsZipNamed: 'httpview-021023.sar' - including: { - ChangeSorter changeSetNamed: 'HVFixes'. - ChangeSorter changeSetNamed: 'kom412'} - - Preamble in changeset HV that will install the changesets: - - "Change Set: HV - Date: 23 October 2002 - Author: Göran Hultgren - - This is my latest developer code drop of HttpView packaged as a Squeak selfextracting archive (courtesy Ned Konz)." - - "Standard SqueakMap installing code follows:" - (self isKindOf: SARInstaller) ifTrue:[ - self fileInMemberNamed: 'HVFixes'. - self fileInMemberNamed: 'kom412'. - self fileInMemberNamed: 'HV' - ] - - ! Item was removed: - ----- Method: SMSARInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Answer if this class can install the package. - We handle it if the filename has the extension - .sar (upper and lowercase) and SARInstaller is - present in the image to handle the install." - - | fileName | - fileName := aPackage downloadFileName. - fileName ifNil: [^false]. - Smalltalk at: #SARInstaller ifPresent: [ :installer | - ^'sar' = (FileDirectory extensionFor: fileName) asLowercase]. - ^false! Item was removed: - ----- Method: SMSARInstaller>>fileIn (in category 'private') ----- - fileIn - - Smalltalk at: #SARInstaller ifPresent: [:installer | - (installer directory: dir fileName: fileName) fileIn. ^self]. - self error: 'SAR support not installed in image, can not install.'! Item was removed: - ----- Method: SMSARInstaller>>install (in category 'services') ----- - install - "This service should bring the package to the client, - unpack it if necessary and install it into the image. - The package is notified of the installation." - - self cache; fileIn. - packageRelease noteInstalled! Item was removed: - SMInstaller subclass: #SMSimpleInstaller - instanceVariableNames: 'fileName dir unpackedFileName' - classVariableNames: '' - poolDictionaries: '' - category: 'SMBase-installer'! - - !SMSimpleInstaller commentStamp: '<historical>' prior: 0! - This is a base class that you can subclass if your package format can be downloaded using - a single file url and possibly also be decompressed using gzip.! Item was removed: - ----- Method: SMSimpleInstaller class>>canInstall: (in category 'testing') ----- - canInstall: aPackage - "Answer if this class can install the package. - This class is abstract so we return false." - - ^false! Item was removed: - ----- Method: SMSimpleInstaller>>cache (in category 'services') ----- - cache - "Download object into cache if needed. - Set the directory and fileName for subsequent unpacking and install." - - packageRelease ensureInCache ifTrue: [ - fileName := packageRelease downloadFileName. - dir := packageRelease cacheDirectory]! Item was removed: - ----- Method: SMSimpleInstaller>>directory (in category 'accessing') ----- - directory - ^dir! Item was removed: - ----- Method: SMSimpleInstaller>>download (in category 'services') ----- - download - "This service downloads the last release of the package - even if it is in the cache already." - - packageRelease download ifTrue: [ - fileName := packageRelease downloadFileName. - dir := packageRelease cacheDirectory]! Item was removed: - ----- Method: SMSimpleInstaller>>fileIntoChangeSetNamed:fromStream: (in category 'services') ----- - fileIntoChangeSetNamed: aString fromStream: stream - "We let the user confirm filing into an existing ChangeSet - or specify another ChangeSet name if - the name derived from the filename already exists." - - | changeSet newName oldChanges global | - newName := aString. - changeSet := SMInstaller changeSetNamed: newName. - changeSet ifNotNil: [ - newName := self silent ifNil: [UIManager default - request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' - initialAnswer: newName] - ifNotNil: [newName]. - newName isEmpty ifTrue:[self error: 'Cancelled by user']. - changeSet := SMInstaller changeSetNamed: newName]. - changeSet ifNil:[changeSet := SMInstaller basicNewChangeSet: newName]. - changeSet ifNil:[self error: 'User did not specify a valid ChangeSet name']. - oldChanges := (SystemVersion current highestUpdate < 5302) - ifFalse: [global := ChangeSet. ChangeSet current] - ifTrue: [global := Smalltalk. Smalltalk changes]. - [global newChanges: changeSet. - stream fileInAnnouncing: 'Loading ', newName, ' into change set ''', newName, ''''. - stream close] ensure: [global newChanges: oldChanges]! Item was removed: - ----- Method: SMSimpleInstaller>>fileName (in category 'accessing') ----- - fileName - ^fileName! Item was removed: - ----- Method: SMSimpleInstaller>>fileName: (in category 'accessing') ----- - fileName: aFileName - fileName := aFileName! Item was removed: - ----- Method: SMSimpleInstaller>>fullFileName (in category 'accessing') ----- - fullFileName - ^ self directory fullNameFor: self fileName! Item was removed: - ----- Method: SMSimpleInstaller>>unpack (in category 'services') ----- - unpack - "This basic installer simply checks the file extension of - the downloaded file to choose suitable method for unpacking. - Currently it only supports .gz decompression. - If a file exists with the same name it is first deleted. - The unpacked filename is set on succesfull decompression or - if the file was not recognized as a compressed file." - - | unzipped zipped buffer | - (fileName endsWith: '.gz') - ifTrue:[ - unpackedFileName := fileName copyUpToLast: FileDirectory extensionDelimiter. - (dir fileExists: unpackedFileName) ifTrue:[ dir deleteFileNamed: unpackedFileName ]. - unzipped := dir newFileNamed: unpackedFileName. - unzipped binary. - zipped := GZipReadStream on: ((dir readOnlyFileNamed: fileName) binary; yourself). - buffer := ByteArray new: 50000. - 'Extracting ' , fileName - displayProgressFrom: 0 - to: zipped sourceStream size - during: [:bar | - [zipped atEnd] - whileFalse: - [bar value: zipped sourceStream position. - unzipped nextPutAll: (zipped nextInto: buffer)]. - zipped close. - unzipped close]] - ifFalse:[unpackedFileName := fileName]! Item was removed: - ----- Method: SMSimpleInstaller>>unpackedFileName (in category 'accessing') ----- - unpackedFileName - ^unpackedFileName! Item was removed: - Object subclass: #SMSqueakMap - instanceVariableNames: 'packages accounts objects categories dir adminPassword fileCache users mutex isDirty checkpointNumber silent registry' - classVariableNames: 'DefaultMap ServerList' - poolDictionaries: '' - category: 'SMBase-domain'! - - !SMSqueakMap commentStamp: '<historical>' prior: 0! - SqueakMap is a Squeak meta catalog, primarily a catalog of all available Squeak packages. - SMSqueakMap is the class for the domain model. - - One master instance lives on a server on the Internet at map1.squeakfoundation.org (but there are fallback servers too). Then each Squeak connected to the Internet has one instance that is synchronized against the master. This way every user can have an updated catalog of all available Squeak software on the planet locally on their machine. :-) - - Typically you only need one instance of SMSqueakMap per image and it is held by a singleton class variable reached with "SMSqueakMap default". If it is not there it will then be created together with it's own directory on disk by default the "sm" directory created in your default directory. - - Synching with the master is the only action that affects the map so you can actually use the same map from multiple images (they will by default use the same snapshot files if the images have the same default directory) and multiple tools (SMLoader, SMBrowser or others). - - An instance of SMSqueakMap contains instances of SMPackage which which represent Squeak packages and SMCategories which are centrally registered values that can be included as attributes in an SMPackage. An example of such a category would be different kinds of licenses, topic etc. etc. - - It also contains instances of SMAccount which are registered Squeak developers, the maintainers of the packages. - - Finally SMSqueakMap also refers to a registry object (SMInstallationRegistry) which records what packages and releases of them have been installed in the image - -------------------- - "Simplest use of SMSqueakMap - this will create a map if you don't have one and open a simple UI"" - SMLoader open - - Use these doits to play "hands on" with a SqueakMap. - - "Creating another SqueakMap in directory 'slavemap' instead of default 'sm'" - Smalltalk at: #AnotherSqueakMap put: (SMSqueakMap newIn: 'slavemap') - - "Update the default map by synching it with the master - check Transcript for some numbers." - SMSqueakMap default loadUpdates - - "If the map is broken in some way, reload it from disk" - SMSqueakMap default reload - - "Clear out the contents of the map to save image space, this does not remove the registry." - SMSqueakMap default purge - ! Item was removed: - ----- Method: SMSqueakMap class>>askUser (in category 'changelog replay') ----- - askUser - "Ask user about how to handle a replayed installation note - when there is no current SqueakMap in the image." - - | choice | - [choice := Project uiManager - chooseOptionFrom: #('Yes' 'No' 'More info') - title: - 'There is no SqueakMap in this image, - do you wish to create/recreate it? (typical answer is Yes)' . - choice = 3] whileTrue: - [self inform: - 'When packages are installed using SqueakMap a little mark is made - in the change log. When an image is reconstructed from the changelog - these marks are intended to keep your map informed about what packages - are installed. You probably already have a map on disk which will automatically be - reloaded if you choose ''Yes'', otherwise an new empty map will be created. - If you choose ''No'', it will only result in that SqueakMap will not know that this package - is installed in your image. - If you are still unsure - answer ''Yes'' since that is probably the best.']. - ^choice = 1! Item was removed: - ----- Method: SMSqueakMap class>>bootStrap (in category 'bootstrap upgrade') ----- - bootStrap - "Bootstrap upgrade. Only used when SqueakMap itself is too old to - communicate with the server. This relies on the existence of a package - called SqueakMap that is a .st loadscript. The loadscript needs to do its - own changeset management." - - | server url | - server := self findServer. - server ifNotNil: ["Ok, found a SqueakMap server" - url := (('http://', server, '/packagebyname/squeakmap/downloadurl') - asUrl retrieveContents content) asUrl. - (url retrieveContents content unzipped readStream) - fileInAnnouncing: 'Upgrading SqueakMap...']! Item was removed: - ----- Method: SMSqueakMap class>>cleanUp: (in category 'class initialization') ----- - cleanUp: aggressive - "Nuke the default map when performing aggressive cleanup" - - aggressive ifTrue:[self clear]. - ! Item was removed: - ----- Method: SMSqueakMap class>>clear (in category 'instance creation') ----- - clear - "Clear out the model in the image. This will forget - about what packages are installed and what versions. - The map is itself on disk though and will be reloaded. - - If you only want to reload the map and not forget about - installed packages then use 'SMSqueakMap default reload'. - - If you want to throw out the map perhaps when shrinking - an image, then use 'SMSqueakMap default purge'." - - "SMSqueakMap clear" - - DefaultMap := nil! Item was removed: - ----- Method: SMSqueakMap class>>default (in category 'instance creation') ----- - default - "Return the default map, create one if missing." - - "SMSqueakMap default" - - ^DefaultMap ifNil: [DefaultMap := self new]! Item was removed: - ----- Method: SMSqueakMap class>>defaultNoCreate (in category 'instance creation') ----- - defaultNoCreate - "Return the default map or nil if there is none." - - "SMSqueakMap defaultNoCreate" - - ^DefaultMap! Item was removed: - ----- Method: SMSqueakMap class>>discardSM (in category 'discarding') ----- - discardSM - "Discard SqueakMapBase. All the map state is kept in - the class var DefaultMap in SMSqueakMap and is thus also removed." - - "SMSqueakMap discardSM" - - SystemOrganization removeCategoriesMatching: 'SM-domain'.! Item was removed: - ----- Method: SMSqueakMap class>>findServer (in category 'server detection') ----- - findServer - "Go through the list of known master servers, ping - each one using simple http get on a known 'ping'-url - until one responds return the server name. - If some servers are bypassed we write that to Transcript. - If all servers are down we inform the user and return nil." - - | notAnswering deafServers | - Socket initializeNetwork. - notAnswering := OrderedCollection new. - Cursor wait - showWhile: [ServerList - do: [:server | (self pingServer: server) - ifTrue: [notAnswering isEmpty - ifFalse: [deafServers := String - streamContents: [:str | notAnswering - do: [:srvr | str nextPutAll: srvr printString; - nextPut: Character cr]]. - Transcript show: ('These SqueakMap master servers did not respond:\' , deafServers , 'Falling back on ' , server printString , '.') withCRs]. - ^ server] - ifFalse: [notAnswering add: server]]]. - deafServers := String - streamContents: [:str | notAnswering - do: [:srvr | str nextPutAll: srvr printString; - nextPut: Character cr]]. - self error: ('All SqueakMap master servers are down:\' , deafServers , '\ \Can not update SqueakMap...') withCRs. - ^ nil! Item was removed: - ----- Method: SMSqueakMap class>>initialize (in category 'class initialization') ----- - initialize - "Initialize the list of master servers. - The last one is for debugging/development." - - "self initialize" - - ServerList := #('map.squeak.org' 'map1.squeakfoundation.org' 'map2.squeakfoundation.org' '127.0.0.1:8080')! Item was removed: - ----- Method: SMSqueakMap class>>new (in category 'instance creation') ----- - new - "Create a new server in a new directory - under the default directory called 'sm'." - - ^super new initializeOn: 'sm'! Item was removed: - ----- Method: SMSqueakMap class>>newIn: (in category 'instance creation') ----- - newIn: directoryName - "Create a new server in a new directory - under the default directory called <directoryName>." - - ^super new initializeOn: directoryName! Item was removed: - ----- Method: SMSqueakMap class>>noteInstalledPackage:version: (in category 'changelog replay') ----- - noteInstalledPackage: uuidString version: version - "We are replaying a change that indicates that a package - was just installed. If there is a map we let it record this, - otherwise we ask the user if we should create/recreate the map." - - | choice | - DefaultMap - ifNotNil: [DefaultMap noteInstalledPackage: uuidString version: version] - ifNil: - [[choice := Project uiManager - chooseOptionFrom: #('Yes' 'No' 'More info') - title: - 'There is no SqueakMap in this image, - do you wish to create/recreate it? (typical answer is Yes)' . - choice = 3] whileTrue: - [self inform: - 'When packages are installed using SqueakMap a little mark is made - in the change log. When an image is reconstructed from the changelog - these marks are intended to keep your map informed about what packages - are installed. You probably already have a map on disk which will automatically be - reloaded if you choose ''Yes'', otherwise an new empty map will be created. - If you choose ''No'', it will only result in that SqueakMap will not know that this package - is installed in your image. - If you are still unsure - answer ''Yes'' since that is probably the best.']. - choice = 1 ifTrue: - [self default noteInstalledPackage: uuidString version: version]]! Item was removed: - ----- Method: SMSqueakMap class>>noteInstalledPackage:version:atSeconds:number: (in category 'changelog replay') ----- - noteInstalledPackage: uuidString version: version atSeconds: sec number: num - "We are replaying a change that indicates that a package - was just installed. If there is a map we let it record this, - otherwise we ask the user if we should create/recreate the map." - - DefaultMap - ifNotNil: [DefaultMap noteInstalledPackage: uuidString version: version - atSeconds: sec number: num] - ifNil: [ - self askUser - ifTrue:[self default noteInstalledPackage: uuidString version: version - atSeconds: sec number: num]]! Item was removed: - ----- Method: SMSqueakMap class>>noteInstalledPackageWithId:autoVersion:atSeconds:number: (in category 'changelog replay') ----- - noteInstalledPackageWithId: uuidString autoVersion: version atSeconds: sec number: num - "We are replaying a change that indicates that a package release - was just installed using SM2. If there is a map we let it record this, - otherwise we ask the user if we should create/recreate the map." - - DefaultMap - ifNotNil: [DefaultMap noteInstalledPackageWithId: uuidString autoVersion: version - atSeconds: sec number: num] - ifNil: [ - self askUser - ifTrue:[self default noteInstalledPackageWithId: uuidString autoVersion: version - atSeconds: sec number: num]]! Item was removed: - ----- Method: SMSqueakMap class>>noteInstalledPackageWithId:version:atSeconds:number: (in category 'changelog replay') ----- - noteInstalledPackageWithId: uuidString version: version atSeconds: sec number: num - "We are replaying a change that indicates that a package release - was just installed using SM2. If there is a map we let it record this, - otherwise we ask the user if we should create/recreate the map." - - DefaultMap - ifNotNil: [DefaultMap noteInstalledPackageWithId: uuidString version: version - atSeconds: sec number: num] - ifNil: [ - self askUser - ifTrue:[self default noteInstalledPackageWithId: uuidString version: version - atSeconds: sec number: num]]! Item was removed: - ----- Method: SMSqueakMap class>>pingServer: (in category 'server detection') ----- - pingServer: aServerName - "Check if the SqueakMap server is responding. - For an old image we first make sure the name resolves - - the #httpGet: had such a long timeout (and hanging?) - for resolving the name." - - "Only test name lookup first if image is before the network rewrite, - after the rewrite it works." - ^[ | answer url | - (SystemVersion current highestUpdate < 5252) - ifTrue: [NetNameResolver addressForName: (aServerName upTo: $:) timeout: 5]. - url := 'http://', aServerName, '/ping'. - answer := HTTPSocket httpGet: url. - answer isString not and: [answer contents = 'pong']] - on: Error do: [ false ]. - ! Item was removed: - ----- Method: SMSqueakMap class>>recreateInstalledPackagesFromChangeLog (in category 'migration') ----- - recreateInstalledPackagesFromChangeLog - "Clear and recreate the Dictionary with information on installed packages. - - NOTE: This takes some time to run and will only find packages installed using SM - and since the last changelog condense. - - For packages installed prior to SqueakMap 1.07 there is no timestamp nor counter - logged. These packages will be given the time of the replay and a separate count - (from -10000 upwards) maintaining correct order of installation." - - "SMSqueakMap recreateInstalledPackagesFromChangeLog" - - | changesFile chunk | - SMSqueakMap default clearInstalledPackages. - changesFile := (SourceFiles at: 2) readOnlyCopy. - [changesFile atEnd] - whileFalse: [ - chunk := changesFile nextChunk. - ((chunk beginsWith: '"Installed') and: [ - (chunk indexOfSubCollection: 'SMSqueakMap noteInstalledPackage:' - startingAt: 10) > 0]) - ifTrue: [Compiler evaluate: chunk]]. - changesFile close! Item was removed: - ----- Method: SMSqueakMap class>>version (in category 'constants') ----- - version - "This is the protocol version number used for clients to decide if - they need to update SMSqueakMap before synching with - the master. In short - only increase this if changes have made - the clients incompatible so that they need to be updated. - - 2.0: Removed Module stuff and added Package releases. - 2.1: Various changes/additions and class shape changes. - 2.2: Various 3.9 related fixes and bug fix in segment compression etc. - 2.3: Moving to SmartRefStream when preparing to release Squeak 4.1." - - ^'2.3'! Item was removed: - ----- Method: SMSqueakMap>>accountForEmail: (in category 'queries') ----- - accountForEmail: email - "Find account given email." - - ^self accounts detect: [:a | a email = email] ifNone: [nil]! Item was removed: - ----- Method: SMSqueakMap>>accountForName: (in category 'queries') ----- - accountForName: name - "Find account given full name. Disregarding case - and allows up to 2 different characters. - Size must match though, someone else can be smarter - - this is just for migrating accounts properly." - - | lowerName size | - lowerName := name asLowercase. - size := lowerName size. - ^self accounts - detect: [:a | - | aName | - aName := a name asLowercase. - (aName size = size) and: [| errors | - errors := 0. - aName with: lowerName do: [:c1 :c2 | - c1 ~= c2 ifTrue: [errors := errors + 1]]. - errors < 3 - ]] - ifNone: [nil] - ! Item was removed: - ----- Method: SMSqueakMap>>accountForUsername: (in category 'queries') ----- - accountForUsername: username - "Find account given username. The username used - is the developer initials of the account." - - ^self users at: username ifAbsent: [nil]! Item was removed: - ----- Method: SMSqueakMap>>accountWithId: (in category 'queries') ----- - accountWithId: anIdString - "Look up an account. Return nil if missing. - Raise error if it is not an account." - - | account | - account := self objectWithId: anIdString. - account ifNil: [^nil]. - account isAccount ifTrue:[^account]. - self error: 'UUID did not map to a account.'! Item was removed: - ----- Method: SMSqueakMap>>accountWithName: (in category 'queries') ----- - accountWithName: aName - "Look up an account by name. Return nil if missing." - - ^self accounts detect: [:a | a name = aName ] ifNone: [nil]! Item was removed: - ----- Method: SMSqueakMap>>accounts (in category 'accessing') ----- - accounts - "Lazily maintain a cache of all known account objects." - - accounts ifNotNil: [^accounts]. - accounts := objects select: [:o | o isAccount]. - ^accounts! Item was removed: - ----- Method: SMSqueakMap>>accountsByInitials (in category 'queries') ----- - accountsByInitials - "Return the accounts sorted by the developer initials." - - ^self accounts sorted: [:x :y | x initials caseInsensitiveLessOrEqual: y initials]! Item was removed: - ----- Method: SMSqueakMap>>accountsByName (in category 'queries') ----- - accountsByName - "Return the accounts sorted by their name." - - ^self accounts sorted: [:x :y | x name caseInsensitiveLessOrEqual: y name].! Item was removed: - ----- Method: SMSqueakMap>>addCategory:inObject: (in category 'public-master') ----- - addCategory: category inObject: object - "Add a category in an object." - - ^object addCategory: category - ! Item was removed: - ----- Method: SMSqueakMap>>addDirty: (in category 'transactions') ----- - addDirty: anSMObject - "Add the SMObject to the dirty list making - sure it gets committed when transaction ends." - - "In first SM2 version we do nothing" - - " dirtyList add: anSMObject"! Item was removed: - ----- Method: SMSqueakMap>>addObject: (in category 'public-master') ----- - addObject: anSMObject - "Add a new object, only if not already added." - - (self object: anSMObject id) ifNil: [ - self transaction: [self newObject: anSMObject]]! Item was removed: - ----- Method: SMSqueakMap>>adminPassword: (in category 'accessing') ----- - adminPassword: aString - "We store the password as a SHA hash so that we can let the slave maps - have it too." - - adminPassword := SecureHashAlgorithm new hashMessage: aString! Item was removed: - ----- Method: SMSqueakMap>>allPackages (in category 'public-packages') ----- - allPackages - "Answer all packages." - - ^self packages! Item was removed: - ----- Method: SMSqueakMap>>availablePackages (in category 'public-packages') ----- - availablePackages - "Answer all packages that are old or not installed." - - ^self packages select: [:package | package isAvailable]! Item was removed: - ----- Method: SMSqueakMap>>cache (in category 'accessing') ----- - cache - ^ fileCache! Item was removed: - ----- Method: SMSqueakMap>>categories (in category 'accessing') ----- - categories - "Lazily maintain a cache of all known category objects." - - categories ifNotNil: [^categories]. - objects isNil ifTrue: [ ^ #() ]. - categories := objects select: [:o | o isCategory]. - ^categories! Item was removed: - ----- Method: SMSqueakMap>>categoryWithId: (in category 'queries') ----- - categoryWithId: anIdString - "Look up a category. Return nil if missing. - Raise error if it is not a category." - - | cat | - cat := self objectWithId: anIdString. - cat ifNil: [^nil]. - cat isCategory ifTrue:[^cat]. - self error: 'UUID did not map to a category.'! Item was removed: - ----- Method: SMSqueakMap>>categoryWithNameBeginning: (in category 'queries') ----- - categoryWithNameBeginning: aString - "Look up a category beginning with <aString>. Return nil if missing. - We return the shortest matching one. We also strip out spaces and - ignore case in both <aString> and the names." - - | candidates shortest answer searchString | - searchString := (aString asLowercase) copyWithout: Character space. - candidates := self categories select: [:cat | - ((cat name asLowercase) copyWithout: Character space) - beginsWith: searchString ]. - shortest := 1000. - candidates do: [:ca | - ca name size < shortest ifTrue:[answer := ca. shortest := ca name size]]. - ^answer ! Item was removed: - ----- Method: SMSqueakMap>>changeCategoriesTo:inObject: (in category 'public-master') ----- - changeCategoriesTo: newCategories inObject: object - "Remove or add categories in an object such that - it belongs to the categories in <newCategories>. - Logs the changes." - - newCategories do: [:cat | - (object hasCategory: cat) - ifFalse:[self addCategory: cat inObject: object]]. - object categories do: [:cat | - (newCategories includes: cat) - ifFalse: [self removeCategory: cat inObject: object]] - ! Item was removed: - ----- Method: SMSqueakMap>>check (in category 'queries') ----- - check - "Sanity checks." - - "SMSqueakMap default check" - - (((self packages inject: 0 into: [:sum :p | sum + p releases size]) + - self accounts size + - self packages size + - self categories size) = SMSqueakMap default objects size) - ifFalse: [self error: 'Count inconsistency in map']. - - objects do: [:o | - o map == self - ifFalse: [self error: 'Object with wrong map']]. - self packages do: [:p | - (p releases allSatisfy: [:r | r map == self]) - ifFalse: [self error: 'Package with release pointing to wrong map']]. - - self packageReleases do: [:r | - r package map == self ifFalse: [self error: 'Release pointing to package in wrong map']]! Item was removed: - ----- Method: SMSqueakMap>>checkVersion: (in category 'private') ----- - checkVersion: string - "Check the content for a SqueakMap version conflict notification. - Return true if no conflict is reported, otherwise ask user if we - should upgrade SqueakMap using the bootstrap method." - - (string beginsWith: 'Server version:') - ifTrue:[(self confirm: ('The SqueakMap master server is running another version (', (string last: (string size - 15)), ') than the client (', SMSqueakMap version, '). - You need to upgrade the SqueakMap package, would you like to do that now?')) - ifTrue: [self class bootStrap. ^false] - ifFalse: [^false] - ]. - ^true! Item was removed: - ----- Method: SMSqueakMap>>checkpointNumber (in category 'accessing') ----- - checkpointNumber - - ^checkpointNumber! Item was removed: - ----- Method: SMSqueakMap>>clearCaches (in category 'private') ----- - clearCaches - "Clear the caches." - - packages := accounts := users := categories := nil - ! Item was removed: - ----- Method: SMSqueakMap>>clearCachesFor: (in category 'private') ----- - clearCachesFor: anObject - "Clear the valid caches." - - anObject isPackage ifTrue:[packages := nil]. - anObject isAccount ifTrue:[accounts := users := nil]. - anObject isCategory ifTrue:[categories := nil] - ! Item was removed: - ----- Method: SMSqueakMap>>clearInstalledPackageWithId: (in category 'public-installation') ----- - clearInstalledPackageWithId: aPackageId - "Clear the fact that any release of this package is installed. - Can be used even when the map isn't loaded." - - ^self registry clearInstalledPackageWithId: aPackageId! Item was removed: - ----- Method: SMSqueakMap>>clearInstalledPackages (in category 'public-installation') ----- - clearInstalledPackages - "Simply clear the dictionary with information on installed packages. - Might be good if things get corrupted etc. Also see - SMSqueakMap class>>recreateInstalledPackagesFromChangeLog" - - ^self registry clearInstalledPackages! Item was removed: - ----- Method: SMSqueakMap>>clearUsernames (in category 'private') ----- - clearUsernames - "Clear the username cache." - - users := nil! Item was removed: - ----- Method: SMSqueakMap>>compressFile: (in category 'checkpoints') ----- - compressFile: aFileStream - "Shamelessly copied and modified from StandardFileStream>>compressFile." - - | zipped buffer | - aFileStream binary. - zipped := StandardFileStream newFileNamed: (self directory fullNameFor: (aFileStream name, 'gz')). - zipped binary; setFileTypeToObject. - "Type and Creator not to be text, so can be enclosed in an email" - zipped := GZipWriteStream on: zipped. - buffer := ByteArray new: 50000. - [[aFileStream atEnd] whileFalse: [ - zipped nextPutAll: (aFileStream nextInto: buffer)]] - ensure: [zipped close. aFileStream close]. - self directory deleteFileNamed: aFileStream name! Item was removed: - ----- Method: SMSqueakMap>>copyFrom: (in category 'private') ----- - copyFrom: aMap - "Copy all relevant info from the other map." - - objects := aMap objects. - objects do: [:o | o map: self]. - objects rehash. - accounts := users := packages := categories := nil. - checkpointNumber := aMap checkpointNumber! Item was removed: - ----- Method: SMSqueakMap>>createCheckpoint (in category 'checkpoints') ----- - createCheckpoint - "Export a new checkpoint of me using an ImageSegment." - - ^self createCheckpointNumber: - (self nextFileNameForCheckPoint findTokens: '.') second asNumber. - ! Item was removed: - ----- Method: SMSqueakMap>>createCheckpointNumber: (in category 'checkpoints') ----- - createCheckpointNumber: number - "Export me using an ImageSegment or SmartRefStream. - This is used for checkpointing the map on disk - in a form that can be brought into an independent image. - We do not overwrite older versions." - - | fname stream oldMutex | - fname := self filename, '.', number asString, '.r'. - (self directory fileExists: fname, 'gz') ifTrue: [self error: 'Checkpoint already exists!!']. - stream := StandardFileStream newFileNamed: (self directory fullNameFor: fname). - checkpointNumber := number. - oldMutex := mutex. - mutex := nil. self clearCaches. - [| smartStream | - [smartStream := SmartRefStream on: stream. - smartStream nextPut: self] ensure: [smartStream close]. - self compressFile: (StandardFileStream oldFileNamed: (self directory fullNameFor: fname)). - isDirty := false] - ensure: [mutex := oldMutex]! Item was removed: - ----- Method: SMSqueakMap>>deleteObject: (in category 'private') ----- - deleteObject: anObject - "Delete an object, remove it from objects. - This method is called from the #delete method of - anObject so it will take care of the rest of the - cleaning up. Clear the valid caches." - - objects removeKey: anObject id. - self clearCachesFor: anObject - ! Item was removed: - ----- Method: SMSqueakMap>>directory (in category 'accessing') ----- - directory - "Return the subdirectory that SqueakMap uses." - - (FileDirectory default directoryExists: dir) - ifFalse:[FileDirectory default createDirectory: dir]. - ^FileDirectory default directoryNamed: dir! Item was removed: - ----- Method: SMSqueakMap>>emailOccupied: (in category 'private') ----- - emailOccupied: aUsername - "Return true if email already taken." - - ^(self accountForEmail: aUsername) notNil! Item was removed: - ----- Method: SMSqueakMap>>extension (in category 'checkpoints') ----- - extension - ^'rgz'! Item was removed: - ----- Method: SMSqueakMap>>filename (in category 'checkpoints') ----- - filename - ^'map'! Item was removed: - ----- Method: SMSqueakMap>>getLastCheckpointWithFilename (in category 'checkpoints') ----- - getLastCheckpointWithFilename - "Return a readstream on a fresh checkpoint gzipped imagesegment. - First we check if we are dirty and must create a new checkpoint. - The filename is tacked on at the end so that the checkpoint number - can be used on the client side too." - - | directory fname | - isDirty ifTrue: [self createCheckpoint]. - directory := self directory. - fname := self lastCheckpointFilename. - fname ifNil: [self error: 'No checkpoint available']. - ^((StandardFileStream oldFileNamed: (directory fullNameFor: fname)) - contentsOfEntireFile), ':', fname! Item was removed: - ----- Method: SMSqueakMap>>initializeOn: (in category 'initialize-release') ----- - initializeOn: directoryName - "Create the local directory for SqueakMap." - - dir := directoryName. - (FileDirectory default directoryExists: dir) - ifFalse:[FileDirectory default createDirectory: dir]. - fileCache := SMFileCache newFor: self. - checkpointNumber := 1! Item was removed: - ----- Method: SMSqueakMap>>installPackage: (in category 'public-installation') ----- - installPackage: aPackage - "Install the package. - - Note: This method should not be used anymore, better - to specify a specific release." - - | rel | - rel := aPackage lastPublishedReleaseForCurrentSystemVersion - ifNil: [self error: 'No published release for this system version found to install.']. - ^self installPackageRelease: rel! Item was removed: - ----- Method: SMSqueakMap>>installPackage:autoVersion: (in category 'public-installation') ----- - installPackage: aPackage autoVersion: version - "Install the release <version> of <aPackage. - <version> is the automatic version name." - - | r | - r := aPackage releaseWithAutomaticVersionString: version. - r ifNil: [self error: 'No package release found with automatic version ', version]. - ^self installPackageRelease: r! Item was removed: - ----- Method: SMSqueakMap>>installPackageNamed: (in category 'public-installation') ----- - installPackageNamed: aString - "Install the last published release - for this Squeak version of the package with a name - beginning with aString (see method comment - of #packageWithNameBeginning:). - - Note: This method should not be used anymore. - Better to specify a specific release." - - | p | - p := self packageWithNameBeginning: aString. - p ifNil: [self error: 'No package found with name beginning with ', aString]. - ^self installPackage: p! Item was removed: - ----- Method: SMSqueakMap>>installPackageNamed:autoVersion: (in category 'public-installation') ----- - installPackageNamed: aString autoVersion: version - "Install the release <version> of the package with a name - beginning with aString (see method comment - of #packageWithNameBeginning:). <version> is the - automatic version name." - - | p r | - p := self packageWithNameBeginning: aString. - p ifNil: [self error: 'No package found with name beginning with ', aString]. - r := p releaseWithAutomaticVersionString: version. - r ifNil: [self error: 'No package release found with automatic version ', version]. - ^self installPackageRelease: r! Item was removed: - ----- Method: SMSqueakMap>>installPackageNamed:version: (in category 'public-installation') ----- - installPackageNamed: aString version: version - "Install the release <version> of the package with a name - beginning with aString (see method comment - of #packageWithNameBeginning:). <version> is the - user-specified version name." - | package release | - package := self packageWithNameBeginning: aString. - package ifNil: [self error: 'No package found with name beginning with ', aString]. - release := package releaseWithVersion: version. - release ifNil: [self error: 'No package release found with version ', version]. - ^self installPackageRelease: release! Item was removed: - ----- Method: SMSqueakMap>>installPackageRelease: (in category 'public-installation') ----- - installPackageRelease: aPackageRelease - "Install the given package release, no checks made." - - (SMInstaller forPackageRelease: aPackageRelease) install! Item was removed: - ----- Method: SMSqueakMap>>installPackageReleaseWithId: (in category 'public-installation') ----- - installPackageReleaseWithId: anUUIDString - "Look up and install the given release." - - | r | - r := self packageReleaseWithId: anUUIDString. - r ifNil: [self error: 'No package release available with id: ''', anUUIDString, '''']. - ^self installPackageRelease: r! Item was removed: - ----- Method: SMSqueakMap>>installPackageWithId: (in category 'public-installation') ----- - installPackageWithId: anUUIDString - "Look up and install the latest release of the given package. - - Note: This method should not be used anymore. - Better to specify a specific release." - - | package | - package := self packageWithId: anUUIDString. - package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. - ^self installPackage: package! Item was removed: - ----- Method: SMSqueakMap>>installPackageWithId:autoVersion: (in category 'public-installation') ----- - installPackageWithId: anUUIDString autoVersion: version - "Install the release <version> of the package with id <anUUIDString>. - <version> is the automatic version name." - - | p | - p := self packageWithId: anUUIDString. - p ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. - ^self installPackage: p autoVersion: version! Item was removed: - ----- Method: SMSqueakMap>>installableAndNotInstalledPackages (in category 'public-packages') ----- - installableAndNotInstalledPackages - "Answer all installable but not installed packages." - - ^self packages select: [:package | package isInstallableAndNotInstalled]! Item was removed: - ----- Method: SMSqueakMap>>installablePackages (in category 'public-packages') ----- - installablePackages - "Answer all packages that can be (auto)installed - - we have installers that can install them." - - ^self packages select: [:package | package isInstallable]! Item was removed: - ----- Method: SMSqueakMap>>installedPackageReleases (in category 'public-installation') ----- - installedPackageReleases - "Answer all package releases that we know are installed. - Lazily initialize. The Dictionary contains the installed packages - using their UUIDs as keys and the version string as the value." - - ^self installedPackages collect: [:p | self installedReleaseOf: p]! Item was removed: - ----- Method: SMSqueakMap>>installedPackages (in category 'public-installation') ----- - installedPackages - "Answer all packages that we know are installed." - - ^self registry installedPackages! Item was removed: - ----- Method: SMSqueakMap>>installedPackagesDictionary (in category 'public-installation') ----- - installedPackagesDictionary - "Access the dictionary directly. The UUID of the installed package is the key. - The value is an OrderedCollection of Arrays. - The arrays have the smartVersion of the package, the time of the - installation in seconds and the sequence number (installCounter)." - - ^self registry installedPackagesDictionary! Item was removed: - ----- Method: SMSqueakMap>>installedPackagesDictionary: (in category 'public-installation') ----- - installedPackagesDictionary: aDict - "Set dictionary directly." - - ^self registry installedPackagesDictionary: aDict! Item was removed: - ----- Method: SMSqueakMap>>installedReleaseOf: (in category 'public-installation') ----- - installedReleaseOf: aPackage - "If the package is installed, return the release. - Otherwise return nil. SM2 stores the version as - an Association to be able to distinguish it." - - ^self registry installedReleaseOf: aPackage! Item was removed: - ----- Method: SMSqueakMap>>installedVersionOf: (in category 'public-installation') ----- - installedVersionOf: aPackage - "If the package is installed, return the version as a String. - If it is a package installed during SM1 it will return the manual version String, - for SM2 it returns the automatic version as a String. - If package is not installed - return nil. If you want it to work without the map loaded you - should instead use #installedVersionOfPackageWithId:." - - ^self registry installedVersionOf: aPackage! Item was removed: - ----- Method: SMSqueakMap>>installedVersionOfPackageWithId: (in category 'public-installation') ----- - installedVersionOfPackageWithId: anId - "If the package is installed, return the automatic version or version String. - Otherwise return nil. This can be used without the map loaded." - - ^self registry installedVersionOfPackageWithId: anId! Item was removed: - ----- Method: SMSqueakMap>>isCheckpointAvailable (in category 'checkpoints') ----- - isCheckpointAvailable - "Check that there is an 'sm' directory - and that it contains at least one checkpoint." - - [^self lastCheckpointFilename notNil] on: Error do: [:ex | ^false]! Item was removed: - ----- Method: SMSqueakMap>>isDirty (in category 'transactions') ----- - isDirty - "Is the map modified but not yet checkpointed to disk?" - - ^isDirty! Item was removed: - ----- Method: SMSqueakMap>>isPurged (in category 'public') ----- - isPurged - "Is this instance purged (empty)? - - ar 4/13/2010: Added the test for object isNil as a workaround for 4.1. - Without the test 'SMSqueakMap new syncWithDisk' creates an invalid - checkpoint file and fails forever after." - - ^checkpointNumber isZero or:[objects isNil]! Item was removed: - ----- Method: SMSqueakMap>>lastCheckpointFilename (in category 'checkpoints') ----- - lastCheckpointFilename - "Return the filename for the newest checkpoint." - - ^self directory lastNameFor: self filename extension: self extension! Item was removed: - ----- Method: SMSqueakMap>>lastCheckpointNumberOnDisk (in category 'checkpoints') ----- - lastCheckpointNumberOnDisk - "Return the last checkpoint number on disk." - - ^(self nextFileNameForCheckPoint findTokens: '.') second asNumber - 1! Item was removed: - ----- Method: SMSqueakMap>>loadFull (in category 'public') ----- - loadFull - "Go through the list of known master servers, ping - each one using simple http get on a known 'ping'-url - until one responds and then load the full map from it." - - self loadUpdatesFull: true! Item was removed: - ----- Method: SMSqueakMap>>loadFullFrom: (in category 'private') ----- - loadFullFrom: aServerName - "Contact the SqueakMap at aServerName, building the the url for this version and load a full map from scratch. - Allow several retries in case of net slowness etc." - | url zipped attempts mapContents | - url := 'http://' , aServerName , '/loadgz?mapversion=' , SMSqueakMap version , '&checkpoint=' , checkpointNumber asString. - attempts := 0. - - [attempts := attempts + 1. - zipped := HTTPSocket httpGet: url. - zipped isString - ifTrue: ["awful legacy way to detect net error - use a proper technique - when the httpsocket can be replaced with a webclient. For now, raise a generic exception" - NetworkError signal]] - on: NetworkError - do: [:ex | - attempts >= 3 - ifTrue: [self halt: 'Unable to load SqueakMap map update after ' , attempts asString , ' attempts']. - ex retry]. - - mapContents := zipped contents. - ((self checkVersion: mapContents) - and: [mapContents ~= 'UPTODATE']) - ifTrue: [self saveCheckpoint: mapContents. - self reload]! Item was removed: - ----- Method: SMSqueakMap>>loadUpdates (in category 'public') ----- - loadUpdates - "Go through the list of known master servers, ping - each one using simple http get on a known 'ping'-url - until one responds and then load updates from it." - - "SM2 starts with using full always" - - self loadFull! Item was removed: - ----- Method: SMSqueakMap>>loadUpdatesFull: (in category 'private') ----- - loadUpdatesFull: full - "Find a server and load updates from it." - - | server | - server := self class findServer. - server ifNotNil: [ - self synchWithDisk. - full ifTrue: [self loadFullFrom: server] - ifFalse:[self error: 'Not supported yet!!'."self loadUpdatesFrom: server"]]! Item was removed: - ----- Method: SMSqueakMap>>mandatoryCategoriesFor: (in category 'private') ----- - mandatoryCategoriesFor: aClass - "Return the categories that are mandatory for instances of <aClass>." - - ^self categories select: [:c | c mandatoryFor: aClass]! Item was removed: - ----- Method: SMSqueakMap>>markInstalled:version:time:counter: (in category 'private-installation') ----- - markInstalled: uuid version: version time: time counter: num - "Private. Mark the installation. SM2 uses an Association - to distinguish the automatic version from old versions." - - ^self registry markInstalled: uuid version: version time: time counter: num! Item was removed: - ----- Method: SMSqueakMap>>moveCategory:toAfter:inParent: (in category 'public-master') ----- - moveCategory: category toAfter: categoryBefore inParent: parent - "Move a category to be listed after <categoryBefore> in <parent>." - - parent move: category toAfter: categoryBefore. - ^category - - ! Item was removed: - ----- Method: SMSqueakMap>>moveCategory:toParent: (in category 'public-master') ----- - moveCategory: category toParent: parentCategory - "Move a category into another parent category." - - parentCategory - ifNil: [category parent: nil] - ifNotNil: [parentCategory addCategory: category]. - ^category - - ! Item was removed: - ----- Method: SMSqueakMap>>mutex (in category 'transactions') ----- - mutex - "Lazily initialize the Semaphore." - - ^mutex ifNil: [mutex := Semaphore forMutualExclusion]! Item was removed: - ----- Method: SMSqueakMap>>newAccount (in category 'private') ----- - newAccount - "Create a new account." - - ^SMAccount newIn: self! Item was removed: - ----- Method: SMSqueakMap>>newAccount:username:email: (in category 'public-master') ----- - newAccount: name username: username email: email - "Create an account. Checking for previous account should already have been done. - To add the account to the map, use SMSqueakMap>>addObject:" - - | account | - account := self newAccount - name: name; - initials: username; - email: email. - ^account - - ! Item was removed: - ----- Method: SMSqueakMap>>newObject: (in category 'private') ----- - newObject: anSMObject - "Add an SMObject to me. Clear the valid caches." - - self addDirty: anSMObject. - self clearCachesFor: anSMObject. - ^objects at: anSMObject id put: anSMObject! Item was removed: - ----- Method: SMSqueakMap>>nextFileNameForCheckPoint (in category 'checkpoints') ----- - nextFileNameForCheckPoint - "Return the next available filename for a checkpoint." - - ^self directory nextNameFor: self filename extension: self extension! Item was removed: - ----- Method: SMSqueakMap>>notInstalledPackages (in category 'public-packages') ----- - notInstalledPackages - "Answer all packages that are not installed." - - ^self packages reject: [:package | package isInstalled]! Item was removed: - ----- Method: SMSqueakMap>>noteInstalled: (in category 'public-installation') ----- - noteInstalled: aPackageRelease - "The package release was just successfully installed using SM. - This is the method being called by SM upon a successful installation. - - We record this in our Dictionary of installed package releases - and log a 'do it' to mark this in the changelog. - The map used is the default map." - - ^self noteInstalledPackageWithId: aPackageRelease package id asString - autoVersion: aPackageRelease automaticVersion - name: aPackageRelease package name! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackage:autoVersion: (in category 'public-installation') ----- - noteInstalledPackage: aPackage autoVersion: aVersion - "Mark that the package release was just successfully installed. - Can be used to inform SM of an installation not been done using SM." - - - ^self noteInstalledPackageWithId: aPackage id asString - autoVersion: aVersion - name: aPackage name! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackage:version: (in category 'private-installation') ----- - noteInstalledPackage: uuidString version: version - "Mark a specific version of a package as installed. - This method is called when replaying a logged installation - from before SqueakMap 1.07. Such logged installations lacked - a timestamp and a count. We take the current time and a - count starting from -10000 and upwards. This should keep - the sorting order correct." - - ^self registry noteInstalledPackage: uuidString version: version! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackage:version:atSeconds:number: (in category 'private-installation') ----- - noteInstalledPackage: uuidString version: version atSeconds: time number: num - "Mark a package as installed in the Dictionary. - This method is called when replaying a logged installation. - <time> is the point in time as totalSeconds of the installation. - <num> is the installCount of the installation. - This method is typically called from a doIt in the changelog - in order to try to keep track of packages installed." - - ^self registry noteInstalledPackage: uuidString version: version atSeconds: time number: num! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackageNamed:autoVersion: (in category 'public-installation') ----- - noteInstalledPackageNamed: aString autoVersion: aVersion - "Mark that the package release was just successfully installed. - <aVersion> is the automatic version as a String. - Can be used to inform SM of an installation not been done using SM." - - | p | - p := self packageWithNameBeginning: aString. - p ifNil: [self error: 'No package found with name beginning with ', aString]. - - ^self noteInstalledPackage: p autoVersion: aVersion asVersion! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackageWithId:autoVersion: (in category 'public-installation') ----- - noteInstalledPackageWithId: aPackageId autoVersion: aVersion - "The package release was just successfully installed. - Can be used to inform SM of an installation not been - done using SM, even when the map isn't loaded." - - - ^self noteInstalledPackageWithId: aPackageId - autoVersion: aVersion - name: '<unknown name>'! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackageWithId:autoVersion:atSeconds:number: (in category 'private-installation') ----- - noteInstalledPackageWithId: uuidString autoVersion: version atSeconds: time number: num - "Mark a package as installed in the Dictionary. - This method is called when replaying a logged installation. - <time> is the point in time as totalSeconds of the installation. - <num> is the installCount of the installation. - This method is typically called from a doIt in the changelog - in order to try to keep track of packages installed." - - ^self registry noteInstalledPackageWithId: uuidString autoVersion: version atSeconds: time number: num! Item was removed: - ----- Method: SMSqueakMap>>noteInstalledPackageWithId:autoVersion:name: (in category 'public-installation') ----- - noteInstalledPackageWithId: aPackageId autoVersion: aVersion name: aName - "The package release was just successfully installed. - Can be used to inform SM of an installation not been - done using SM, even when the map isn't loaded. - - We record the fact in our Dictionary of installed packages - and log a 'do it' to mark this in the changelog. - The doit helps keeping track of the packages when - recovering changes etc - not a perfect solution but should help. - The map used is the default map. - The id of the package is the key and the value is an OrderedCollection - of Arrays with the release auto version, the point in time and the current installCounter." - - ^self registry noteInstalledPackageWithId: aPackageId autoVersion: aVersion name: aName! Item was removed: - ----- Method: SMSqueakMap>>noteUninstalled: (in category 'private-installation') ----- - noteUninstalled: aPackageRelease - "The package release was just successfully uninstalled using SM. - This is the method being called by SM upon a successful uninstallation. - - We record this in our Dictionary of installed package releases - and log a 'do it' to mark this in the changelog. - The map used is the default map." - - ^self noteUninstalledPackageWithId: aPackageRelease package id asString - autoVersion: aPackageRelease automaticVersion - name: aPackageRelease package name! Item was removed: - ----- Method: SMSqueakMap>>noteUninstalledPackageWithId:autoVersion:name: (in category 'private-installation') ----- - noteUninstalledPackageWithId: aPackageId autoVersion: aVersion name: aName - "The package release was just successfully uninstalled. - Can be used to inform SM of an uninstallation not been - done using SM, even when the map isn't loaded. - - We record the fact in our Dictionary of installed packages - and log a 'do it' to mark this in the changelog. - The doit helps keeping track of the packages when - recovering changes etc - not a perfect solution but should help. - The map used is the default map. - The id of the package is the key and the value is an OrderedCollection - of Arrays with the release auto version, the point in time and the current installCounter." - - ^self registry noteUninstalledPackageWithId: aPackageId autoVersion: aVersion name: aName! Item was removed: - ----- Method: SMSqueakMap>>object: (in category 'queries') ----- - object: aUUID - "Look up a categorizable object. Return nil if missing." - - ^objects at: aUUID ifAbsent: [nil]! Item was removed: - ----- Method: SMSqueakMap>>objectWithId: (in category 'queries') ----- - objectWithId: anIdString - "Look up a categorizable object. Return nil if missing." - - ^objects at: (UUID fromString: anIdString) ifAbsent: [nil]! Item was removed: - ----- Method: SMSqueakMap>>objects (in category 'accessing') ----- - objects - ^objects! Item was removed: - ----- Method: SMSqueakMap>>oldPackages (in category 'public-packages') ----- - oldPackages - "Answer all packages that are installed with a - newer published version for this Squeak version available." - - ^self installedPackages select: [:package | package isSafelyOld]! Item was removed: - ----- Method: SMSqueakMap>>oldReload (in category 'private') ----- - oldReload - "Reload the map from the latest checkpoint on disk. - The opposite of #purge." - - | fname stream map | - fname := self directory lastNameFor: self filename extension: 'sgz'. - fname ifNil: [self error: 'No ImageSegment checkpoint available!!']. - stream := (StandardFileStream oldFileNamed: (self directory fullNameFor: fname)) asUnZippedStream. - stream ifNil: [self error: 'Couldn''t open stream on checkpoint file!!']. - [map := (stream fileInObjectAndCode) install arrayOfRoots first] ensure: [stream close]. - self copyFrom: map! Item was removed: - ----- Method: SMSqueakMap>>packageCacheDirectory (in category 'accessing') ----- - packageCacheDirectory - "Return a FileDirectory for the package cache of the map. - Creates it if it is missing." - - | dirName baseDir | - dirName := self packageCacheDirectoryName. - baseDir := self directory. - (baseDir fileOrDirectoryExists: dirName) - ifFalse:[baseDir createDirectory: dirName]. - ^baseDir directoryNamed: dirName! Item was removed: - ----- Method: SMSqueakMap>>packageCacheDirectoryName (in category 'private') ----- - packageCacheDirectoryName - "What is the name of the cache directory?" - - ^'cache'! Item was removed: - ----- Method: SMSqueakMap>>packageReleaseWithId: (in category 'queries') ----- - packageReleaseWithId: anIdString - "Look up a package release. Return nil if missing. - Raise error if it is not a package release." - - | r | - r := self objectWithId: anIdString. - r ifNil: [^nil]. - r isPackageRelease ifTrue:[^r]. - self error: 'UUID did not map to a package release.'! Item was removed: - ----- Method: SMSqueakMap>>packageReleases (in category 'accessing') ----- - packageReleases - "Return subset of objects." - - objects ifNil: [^#()]. - ^objects select: [:o | o isPackageRelease]! Item was removed: - ----- Method: SMSqueakMap>>packageWithId: (in category 'queries') ----- - packageWithId: anIdString - "Look up a package. Return nil if missing. - Raise error if it is not a package." - - | package | - package := self objectWithId: anIdString. - package ifNil: [^nil]. - package isPackage ifTrue:[^package]. - self error: 'UUID did not map to a package.'! Item was removed: - ----- Method: SMSqueakMap>>packageWithName: (in category 'queries') ----- - packageWithName: aName - "Look up a package by exact match on name. Signal an exception if missing." - ^ self - packageWithName: aName - ifAbsent: [ self error: aName , ' is not in the cached catalog.' ]! Item was removed: - ----- Method: SMSqueakMap>>packageWithName:ifAbsent: (in category 'queries') ----- - packageWithName: aName ifAbsent: aBlock - "Look up a package by exact match on name. Answer the value of aBlock if missing." - ^ self packages - detect: [ : package | package name = aName ] - ifNone: aBlock! Item was removed: - ----- Method: SMSqueakMap>>packageWithNameBeginning: (in category 'queries') ----- - packageWithNameBeginning: aString - "Look up a package beginning with <aString>. Return nil if missing. - We return the shortest matching one. We also strip out spaces and - ignore case in both <aString> and the names." - - | candidates shortest answer searchString | - searchString := (aString asLowercase) copyWithout: Character space. - candidates := self packages select: [:package | - ((package name asLowercase) copyWithout: Character space) - beginsWith: searchString ]. - shortest := 1000. - candidates do: [:package | - package name size < shortest ifTrue:[answer := package. shortest := package name size]]. - ^answer ! Item was removed: - ----- Method: SMSqueakMap>>packageWithPI: (in category 'queries') ----- - packageWithPI: aPIName - "Look up a package by exact match on PackageInfo name. Return nil if missing." - - aPIName isEmptyOrNil ifTrue: [^nil]. - ^self packages detect: [:package | package packageInfoName = aPIName ] ifNone: [nil]! Item was removed: - ----- Method: SMSqueakMap>>packages (in category 'accessing') ----- - packages - "Lazily maintain a cache of all known package objects." - - packages ifNotNil: [^packages]. - objects ifNil: [^#()]. - packages := objects select: [:o | o isPackage]. - ^packages! Item was removed: - ----- Method: SMSqueakMap>>packagesByName (in category 'queries') ----- - packagesByName - "Return the packages sorted by their name." - - ^self packages sorted: [:x :y | x name caseInsensitiveLessOrEqual: y name]! Item was removed: - ----- Method: SMSqueakMap>>pingServer: (in category 'private') ----- - pingServer: aServerName - - ^self class pingServer: aServerName! Item was removed: - ----- Method: SMSqueakMap>>purge (in category 'public') ----- - purge - "Clear out the map from memory. Use this to reclaim space, - no information is lost because it does not remove information - about what packages are installed, and the map itself is checkpointed - to disk. Use #reload to get it back from the latest checkpoint on disk." - - objects := accounts := users := packages := categories := nil. - checkpointNumber := 0.! Item was removed: - ----- Method: SMSqueakMap>>registry (in category 'accessing') ----- - registry - ^registry ifNil: [registry := SMInstallationRegistry map: self]! Item was removed: - ----- Method: SMSqueakMap>>reload (in category 'public') ----- - reload - "Reload the map from the latest checkpoint on disk. - The opposite of #purge." - - | fname stream map | - fname := self lastCheckpointFilename. - fname ifNil: [self error: 'No checkpoint available!!']. - "Code below uses good ole StandardFileStream to avoid m17n issues (this is binary data) and - also uses #unzipped since it works in older Squeaks" - stream := (StandardFileStream oldFileNamed: (self directory fullNameFor: fname)) asUnZippedStream. - stream ifNil: [self error: 'Couldn''t open stream on checkpoint file!!']. - [map := stream fileInObjectAndCode] ensure: [stream close]. - self copyFrom: map! Item was removed: - ----- Method: SMSqueakMap>>removeCategory:inObject: (in category 'public-master') ----- - removeCategory: category inObject: object - "Remove a category from an object." - - ^object removeCategory: category - ! Item was removed: - ----- Method: SMSqueakMap>>repair (in category 'public-master') ----- - repair - "Integrity repairs. This should not be neeed, but - for some reason the map can obviously get messed up, - not sure how." - - "SMSqueakMap default repair" - - "all objects should point back to me and not at another map" - objects do: [:o | o map: self]. - - "all releases should point back at the package they are in" - self packages do: [:p | p releases do: [:r | r package: p]]. - - "all releases in this map should point at a package in this map" - self packageReleases do: [:r | | p | - p := self object: r package id. - p ifNil: [self error: 'Unknown package']. - r package: p]! Item was removed: - ----- Method: SMSqueakMap>>saveCheckpoint: (in category 'checkpoints') ----- - saveCheckpoint: contentWithFilename - "Save the map checkpoint to disk if it is not there already." - - | file directory sz fname content | - directory := self directory. - sz := contentWithFilename size. - fname := contentWithFilename last: sz - (contentWithFilename lastIndexOf: $:). - content := contentWithFilename first: sz - fname size - 1. - (directory fileExists: fname) ifFalse: [ - "Please do not upgrade the following to use Squeak 4.0 or later API's (e.g., #newFileNamed:do:) until we can convert the SMServer code to latest Squeaks." - [file := StandardFileStream newFileNamed: (directory fullNameFor: fname). - file nextPutAll: content] - ensure: [file close]]! Item was removed: - ----- Method: SMSqueakMap>>setDirty (in category 'transactions') ----- - setDirty - "Set the map modified so that it will get written to disk." - - isDirty := true! Item was removed: - ----- Method: SMSqueakMap>>silent (in category 'accessing') ----- - silent - "Can installations ask questions or should they be silent - and us good defaults?" - - ^ silent ifNil: [false] ifNotNil: [true]! Item was removed: - ----- Method: SMSqueakMap>>silentlyDo: (in category 'public-installation') ----- - silentlyDo: aBlock - "Execute <aBlock> with the Silent flag set. - This is a crude way of avoiding user interaction - during batch operations, like loading updates." - - [silent := true. - aBlock value] - ensure: [silent := nil]! Item was removed: - ----- Method: SMSqueakMap>>sortedCategories (in category 'accessing') ----- - sortedCategories - "Lazily maintain a cache of all known category objects." - ^ self categories - sorted: [:a :b | (a name compare: b name caseSensitive: true) - = 1]! Item was removed: - ----- Method: SMSqueakMap>>synchWithDisk (in category 'private') ----- - synchWithDisk - "Synchronize myself with the checkpoints on disk. - If there is a newer checkpoint than I know of, load it. - If there is no checkpoint or if I have a higher checkpoint number, - create a new checkpoint from me. - - The end result is that I am in synch with the disk and we are both as - updated as possible." - - | checkpointNumberOnDisk | - "If there is no checkpoint, save one from me." - (self isCheckpointAvailable) ifFalse: [ - "If I am purged - don't checkpoint, no point" - self isPurged ifTrue: [^self]. - ^self createCheckpointNumber: checkpointNumber]. - "If the one on disk is newer, load it" - checkpointNumberOnDisk := self lastCheckpointNumberOnDisk. - (checkpointNumber < checkpointNumberOnDisk) - ifTrue: [^self reload]. - "If I am newer, recreate me on disk" - (checkpointNumberOnDisk < checkpointNumber) - ifTrue: [^self createCheckpointNumber: checkpointNumber]! Item was removed: - ----- Method: SMSqueakMap>>topCategories (in category 'queries') ----- - topCategories - ^self categories select: [:cat | cat isTopCategory]! Item was removed: - ----- Method: SMSqueakMap>>transaction: (in category 'transactions') ----- - transaction: aBlock - "Execute aBlock and then make sure any modified SMObjects - are committed to disk. We do this inside a mutex in order to - serialize transactions. Transactions must be initiated from - service methods in this class and not from inside the domain - objects - otherwise they could get nested and a deadlock occurs." - - "In first version of SM2 we simply set the isDirty flag, - when next client asks for updates, or 30 minutes has passed, - we checkpoint." - - " self mutex critical: [" - aBlock value. - isDirty := true - " ]" - - " self mutex critical: [ - dirtyList := OrderedCollection new. - aBlock value. - dirtyList do: [:obj | obj commit]. - dirtyList := nil - ]"! Item was removed: - ----- Method: SMSqueakMap>>upgradeOldPackages (in category 'public-installation') ----- - upgradeOldPackages - "Upgrade all upgradeable old packages without confirmation on each." - - ^self upgradeOldPackagesConfirmBlock: [:package | true ]! Item was removed: - ----- Method: SMSqueakMap>>upgradeOldPackagesConfirmBlock: (in category 'public-installation') ----- - upgradeOldPackagesConfirmBlock: aBlock - "First we find out which of the installed packages are upgradeable and old. - Then we upgrade them if confirmation block yields true. - The block will be called with each SMPackage to upgrade. - We return a Dictionary with the packages we tried to upgrade as keys - and the value being the result of the upgrade, true or false." - - | result | - result := Dictionary new. - self upgradeableAndOldPackages - do: [:package | - (aBlock value: package) - ifTrue:[ result at: package put: package upgrade]]. - ^result - ! Item was removed: - ----- Method: SMSqueakMap>>upgradeOrInstallPackage: (in category 'public-installation') ----- - upgradeOrInstallPackage: aPackage - "Upgrade package (or install) to the latest published release for this Squeak version." - - ^aPackage upgradeOrInstall! Item was removed: - ----- Method: SMSqueakMap>>upgradeOrInstallPackageWithId: (in category 'public-installation') ----- - upgradeOrInstallPackageWithId: anUUIDString - "Upgrade package (or install) to the latest published release for this Squeak version." - - | package | - package := self packageWithId: anUUIDString. - package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. - ^package upgradeOrInstall! Item was removed: - ----- Method: SMSqueakMap>>upgradeOrInstallPackageWithId:asOf: (in category 'public-installation') ----- - upgradeOrInstallPackageWithId: anUUIDString asOf: aTimeStamp - "Upgrade package (or install) to the latest published release as it was - on <aTimeStamp> for this Squeak version. This ensures that the same - release will be installed (for all Squeak versions) as when it was tested." - - | package | - package := self packageWithId: anUUIDString. - package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. - ^package upgradeOrInstall! Item was removed: - ----- Method: SMSqueakMap>>upgradePackage: (in category 'public-installation') ----- - upgradePackage: aPackage - "Upgrade package to the latest published release for this Squeak version." - - ^aPackage upgrade! Item was removed: - ----- Method: SMSqueakMap>>upgradePackageWithId: (in category 'public-installation') ----- - upgradePackageWithId: anUUIDString - "Upgrade package to the latest published release for this Squeak version. - Will raise error if there is no release installed, otherwise use - #upgradeOrInstallPackageWithId: " - - | package | - package := self packageWithId: anUUIDString. - package ifNil: [self error: 'No package available with id: ''', anUUIDString, '''']. - ^package upgrade! Item was removed: - ----- Method: SMSqueakMap>>upgradeableAndOldOrInstallableAndNotInstalledPackages (in category 'public-packages') ----- - upgradeableAndOldOrInstallableAndNotInstalledPackages - "This would give you all packages that are available now - for automatic install or automatic upgrade." - - ^self upgradeableAndOldPackages union: self installableAndNotInstalledPackages! Item was removed: - ----- Method: SMSqueakMap>>upgradeableAndOldPackages (in category 'public-packages') ----- - upgradeableAndOldPackages - "Answer all packages that are installed and which have a - newer published release for this Squeak version that also - can be to by an installer." - - ^self installedPackages select: [:package | package isSafelyOldAndUpgradeable]! Item was removed: - ----- Method: SMSqueakMap>>usernameOccupied: (in category 'private') ----- - usernameOccupied: aUsername - "Return true if name already taken." - - ^(self accountForUsername: aUsername) notNil! Item was removed: - ----- Method: SMSqueakMap>>users (in category 'accessing') ----- - users - "Lazily maintain a cache of all known account objects - keyed by their developer initials." - - users ifNotNil: [^users]. - users := Dictionary new. - self accounts do: [:a | users at: a initials put: a]. - ^users! Item was removed: - ----- Method: SMSqueakMap>>verifyAdminPassword: (in category 'private') ----- - verifyAdminPassword: aString - "Answer true if it is the correct password." - - ^adminPassword = (SecureHashAlgorithm new hashMessage: aString)! Item was removed: - ----- Method: SMSqueakMap>>viewFor: (in category 'views') ----- - viewFor: uiObject - "This is a double dispatch mechanism for multiple views - for multiple uis. Used primarily by the web frontend." - - ^uiObject squeakMapViewOn: self! Item was removed: - Object subclass: #SMUtilities - instanceVariableNames: '' - classVariableNames: 'MailServer MasterServer' - poolDictionaries: '' - category: 'SMBase-UI'! - - !SMUtilities commentStamp: 'gk 11/13/2003 23:39' prior: 0! - Various loose functions in SM.! Item was removed: - ----- Method: SMUtilities class>>initialize (in category 'class initialization') ----- - initialize - "Initialize server settings." - - "self initialize" - - MasterServer := nil. - MailServer := nil! Item was removed: - ----- Method: SMUtilities class>>isServer (in category 'server') ----- - isServer - "Is this a running server?" - - ^MasterServer notNil! Item was removed: - ----- Method: SMUtilities class>>mail:subject:message: (in category 'private') ----- - mail: anAccount subject: sub message: msg - "Send a mail to the holder of <anAccount>." - - SMTPClient - deliverMailFrom: 'squeakmap at squeak.org' - to: {anAccount email} - text: - ('From: SqueakMap <squeakmap at squeak.org> - To: ', anAccount email, ' - Subject: ', sub, - ' - ', msg, (self randomPhrase), ', SqueakMap') usingServer: MailServer! Item was removed: - ----- Method: SMUtilities class>>mailPassword:for: (in category 'server') ----- - mailPassword: randomPass for: anAccount - "Change the password to a random generated one - and mail it to the holder of the account." - - self mail: anAccount subject: 'New password at SqueakMap!!' message: - 'Hi!! - An extra random password has been added for the account held by "', anAccount name, '": - "', randomPass, '" - - You can login to SqueakMap at: - - ', MasterServer, '/login - - The regular password still works, so if it was not you who requested this extra - random password you can safely just delete this email. - - This extra password will stop working when you change your regular password. - - '! Item was removed: - ----- Method: SMUtilities class>>mailPassword:forNew: (in category 'server') ----- - mailPassword: aPassword forNew: anAccount - "Mail the password to the person who just registered the account." - - self mail: anAccount subject: 'Your new account at SqueakMap!!' message: - 'Hi!! - You or someone else has registered an account on SqueakMap. You can login to it using this link: - - ', - MasterServer, '/autologin?u=', anAccount initials, '&p=', aPassword, - ' - - If it was not you who performed this registration you can safely just delete this email. - - '! Item was removed: - ----- Method: SMUtilities class>>mailServer:masterServer: (in category 'class initialization') ----- - mailServer: ipName masterServer: httpUrl - "Initialize server settings." - - MailServer := ipName. - MasterServer := httpUrl! Item was removed: - ----- Method: SMUtilities class>>mailUserName (in category 'private') ----- - mailUserName - "Answer the mail user's name, but deal with some historical mail senders." - - | mailSender | - mailSender := (Smalltalk at: #MailSender ifAbsent: [ Smalltalk at: #Celeste ifAbsent: []]). - ^mailSender - ifNil: [ UIManager default request: 'What is your email address?' ] - ifNotNil: [ mailSender userName ]! Item was removed: - ----- Method: SMUtilities class>>masterServer (in category 'server') ----- - masterServer - "Return the master server url." - - ^MasterServer! Item was removed: - ----- Method: SMUtilities class>>randomPhrase (in category 'private') ----- - randomPhrase - "Pick a nice phrase." - - ^#('Debug safely' 'Happy Squeaking' 'Just do it' 'Yours truly' 'Stay a Squeaker' 'Squeak rocks') atRandom! Item was removed: - ----- Method: SMUtilities class>>sendMail: (in category 'utilities') ----- - sendMail: aString - "Send the given mail message, but check for modern mail senders." - - - - Smalltalk at: #MailSender ifPresent: [ :mailSender | - ^mailSender sendMessage: ((Smalltalk at: #MailMessage) from: aString). - ]. - - Smalltalk at: #MailComposition ifPresent: [ :mailComposition | - ^mailComposition new - messageText: aString; - open - ]. - - Smalltalk at: #Celeste ifPresent: [ :celeste | - celeste isSmtpServerSet ifTrue: [ - Smalltalk at: #CelesteComposition ifPresent: [ :celesteComposition | - ^celesteComposition - openForCeleste: celeste current - initialText: aString - ] - ] - ]. - - Smalltalk at: #AdHocComposition ifPresent: [ :adHocComposition | | server | - server := UIManager default request: 'What is your mail server for outgoing mail?'. - ^adHocComposition - openForCeleste: server - initialText: aString - ]. - - ^self inform: 'Sorry, no known way to send the message'. - ! Item was removed: - ----- Method: SMUtilities class>>sendMailTo:regardingPackageRelease: (in category 'utilities') ----- - sendMailTo: recipient regardingPackageRelease: pr - "Send mail to the given recipient. Try to use the first of: - - MailSender (with its registered composition class) - - Celeste - - AdHocComposition - for compatibility with 3.5 and 3.6 images" - - self sendMail: (String streamContents: [:stream | - stream - nextPutAll: 'From: '; nextPutAll: self mailUserName; cr; - nextPutAll: 'To: '; nextPutAll: recipient; cr; - nextPutAll: 'Subject: Regarding '; nextPutAll: pr printName; cr])! Item was removed: - ----- Method: SMUtilities class>>stripEmailFrom: (in category 'utilities') ----- - stripEmailFrom: aString - "Picks out the email from: - 'Robert Robertson <rob at here.com>' => 'rob at here.com' - Spamblockers 'no_spam', 'no_canned_ham' and 'spam_block' - (case insensitive) will be filtered out." - - | lessThan moreThan email | - lessThan := aString indexOf: $<. - moreThan := aString indexOf: $>. - (lessThan * moreThan = 0) ifTrue: [^ aString]. - email := (aString copyFrom: lessThan + 1 to: moreThan - 1) asLowercase. - #('no_spam' 'no_canned_ham' 'spam_block') do: [:block | | pos | - pos := email findString: block. - pos = 0 ifFalse:[email := (email copyFrom: 1 to: pos - 1), (email copyFrom: pos + block size to: email size)]]. - ^email! Item was removed: - ----- Method: SMUtilities class>>stripNameFrom: (in category 'utilities') ----- - stripNameFrom: aString - "Picks out the name from: - 'Robert Robertson <rob at here.com>' => 'Robert Robertson' - " - - | lessThan | - lessThan := aString indexOf: $<. - ^(aString copyFrom: 1 to: lessThan - 1) withBlanksTrimmed ! Item was removed: - ----- Method: UUID class>>fromString36: (in category '*smbase-macsafe') ----- - fromString36: aString - "Decode the UUID from a base 36 string using 0-9 and lowercase a-z. - This is the shortest representation still being able to work as - filenames etc since it does not depend on case nor characters - that might cause problems." - - | object num | - object := self nilUUID. - num := Integer readFrom: aString asUppercase readStream base: 36. - 1 to: 16 do: [:i | object at: i put: (num digitAt: i)]. - ^object! Item was removed: - ----- Method: UUID>>asString36 (in category '*smbase-macsafe') ----- - asString36 - "Encode the UUID as a base 36 string using 0-9 and lowercase a-z. - This is the shortest representation still being able to work as - filenames etc since it does not depend on case nor characters - that might cause problems, and it fits into short filenames like on - the old MacOS HFS filesystem. The check for 36r is to make this code - work in versions before Squeak 3.8." - - | num candidate | - num := 0. - 1 to: self size do: [:i | num := num + ((256 raisedTo: i - 1) * (self at: i))]. - candidate := num printStringBase: 36. - ^((candidate beginsWith: '36r') - ifTrue: [candidate copyFrom: 4 to: candidate size] - ifFalse: [candidate]) asLowercase!
More information about the Squeak-dev mailing list |