SystemOrganization addCategory: #'Flair-Core'! SystemOrganization addCategory: #'Flair-Loader'! SystemOrganization addCategory: #'Flair-Tests'! Object subclass: #FLAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLAction class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 22:39'! new ^ self basicNew initialize! ! !FLAction methodsFor: 'initialization' stamp: 'lr 4/15/2009 22:39'! initialize scripts := OrderedCollection new. relations := OrderedCollection new! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:17'! install: aContext "This method is called to install the receiver."! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:16'! postInstall: aContext "This method is called after installation."! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:16'! postRemove: aContext "This method is called after removal."! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:16'! preInstall: aContext "This method is called prior to installation."! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:17'! preRemove: aContext "This method is called prior to removal."! ! !FLAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:17'! remove: aContext "This method is called to remove the receiver."! ! FLAction subclass: #FLMonticelloAction instanceVariableNames: 'url name' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:42'! cleanupCategories: aPackageInfo aPackageInfo categories do: [ :category | (SystemOrganization classesInCategory: category) isEmpty ifTrue: [ SystemOrganization removeSystemCategory: category ] ]! ! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:42'! cleanupProtocols: aPackageInfo aPackageInfo foreignClasses do: [ :class | (aPackageInfo foreignExtensionCategoriesForClass: class) do: [ :category | (class organization listAtCategoryNamed: category) isEmpty ifTrue: [ class organization removeCategory: category ] ] ]! ! !FLMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 4/15/2009 23:22'! fileName ^ self name , '.mcz'! ! !FLMonticelloAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:46'! install: aContext | repository | repository := self registerRepository: self url. [ (repository loadVersionFromFileNamed: self fileName) load ] on: Warning do: [ :err | err resume: true ]! ! !FLMonticelloAction methodsFor: 'accessing' stamp: 'lr 4/15/2009 23:22'! name ^ name! ! !FLMonticelloAction methodsFor: 'accessing' stamp: 'lr 4/15/2009 23:22'! name: aString name := aString! ! !FLMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 4/15/2009 23:23'! packageInfo ^ PackageInfo new packageName: self packageName; yourself! ! !FLMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 4/15/2009 23:22'! packageName ^ self name copyUpToLast: $-! ! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:43'! performUnload: aPackageInfo aPackageInfo classes do: [ :class | (class selectors includes: #unload) ifTrue: [ class unload ] ]! ! !FLMonticelloAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:42'! postRemove: aContext self cleanupCategories: self packageInfo. self cleanupProtocols: self packageInfo. self unregisterPackageInfo: self packageInfo. self unregisterRepository: self repository! ! !FLMonticelloAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:43'! preRemove: aContext self performUnload: self packageInfo! ! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:46'! registerRepository: aString | repository | repository := MCHttpRepository location: aString user: String new password: String new. MCRepositoryGroup default addRepository: repository. ^ MCRepositoryGroup default repositories detect: [ :each | repository = each ] ifNone: [ nil ]! ! !FLMonticelloAction methodsFor: 'actions' stamp: 'lr 4/15/2009 23:45'! remove: aContext self workingCopy unload! ! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:41'! unregisterPackageInfo: aPackageInfo "Unregister the pacakge information from the system." PackageOrganizer default unregisterPackage: aPackageInfo! ! !FLMonticelloAction methodsFor: 'utilities' stamp: 'lr 4/15/2009 23:41'! unregisterRepository: aRepository "Remove a repository if it is no longer in use by any of the packages." MCWorkingCopy allManagers do: [ :copy | (copy repositoryGroup includes: aRepository) ifTrue: [ ^ self ] ]. MCRepositoryGroup default removeRepository: aRepository! ! !FLMonticelloAction methodsFor: 'accessing' stamp: 'lr 4/15/2009 23:19'! url ^ url! ! !FLMonticelloAction methodsFor: 'accessing' stamp: 'lr 4/15/2009 23:21'! url: aString url := aString. (url beginsWith: 'http://') ifFalse: [ url := 'http://' , url ]. (url endsWith: '/') ifFalse: [ url := url , '/' ]! ! !FLMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 4/15/2009 23:25'! workingCopy ^ MCWorkingCopy allManagers detect: [ :each | self packageInfo = each packageInfo ] ifNone: [ nil ]! ! FLAction subclass: #FLScriptAction instanceVariableNames: 'script' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! FLScriptAction subclass: #FLPostInstallAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLPostInstallAction methodsFor: 'actions' stamp: 'lr 4/15/2009 22:47'! postInstall: aContext self execute: aContext! ! FLScriptAction subclass: #FLPostRemoveAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLPostRemoveAction methodsFor: 'actions' stamp: 'lr 4/15/2009 22:47'! postRemove: aContext self execute: aContext! ! FLScriptAction subclass: #FLPreInstallAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLPreInstallAction methodsFor: 'actions' stamp: 'lr 4/15/2009 22:47'! preInstall: aContext self execute: aContext! ! FLScriptAction subclass: #FLPreRemoveAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Loader'! !FLPreRemoveAction methodsFor: 'actions' stamp: 'lr 4/15/2009 22:47'! preRemove: aContext self execute: aContext! ! !FLScriptAction methodsFor: 'actions' stamp: 'lr 4/15/2009 22:49'! execute: aContext Compiler evaluate: self script for: aContext notifying: nil logged: true! ! Object subclass: #FLPackage instanceVariableNames: 'version description maintainer scripts relations' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLPackage class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 22:39'! new ^ self basicNew initialize! ! !FLPackage methodsFor: 'initialization' stamp: 'lr 4/15/2009 22:07'! initialize scripts := OrderedCollection new. relations := OrderedCollection new! ! !FLPackage methodsFor: 'accessing' stamp: 'lr 4/15/2009 20:36'! version ^ version! ! !FLPackage methodsFor: 'accessing' stamp: 'lr 4/15/2009 20:36'! version: aVersion version := aVersion! ! Object subclass: #FLRegistry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLRegistry class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 22:08'! new ^ self basicNew initialize! ! !FLRegistry methodsFor: 'initialization' stamp: 'lr 4/15/2009 22:08'! initialize scripts := OrderedCollection new. relations := OrderedCollection new! ! Object subclass: #FLRelation instanceVariableNames: 'requirements' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! FLRelation subclass: #FLDependsRelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLDependsRelation commentStamp: 'lr 4/15/2009 20:27' prior: 0! Package A depends on Package B if B absolutely must be installed in order to run A.! FLRelation subclass: #FLProvidesRelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLProvidesRelation commentStamp: 'lr 4/15/2009 20:29' prior: 0! Package A provides Package B when all of the files and functionality of B are incorporated into A.! !FLRelation class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 20:43'! new ^ self basicNew initialize! ! !FLRelation methodsFor: 'initialization' stamp: 'lr 4/15/2009 22:09'! initialize requirements := OrderedCollection new! ! FLRelation subclass: #FLReplacesRelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLReplacesRelation commentStamp: 'lr 4/15/2009 20:28' prior: 0! Package A replaces Package B when files installed by B are removed over-written by files in A.! Object subclass: #FLScript instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLScript class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 20:43'! new ^ self basicNew initialize! ! !FLScript methodsFor: 'initialization' stamp: 'lr 4/15/2009 20:43'! initialize ! ! Object subclass: #FLVersion instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLVersion class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 21:49'! new ^ self basicNew initialize! ! !FLVersion methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:56'! name ^ name! ! !FLVersion methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:56'! name: aString name := aString! ! !FLVersion methodsFor: 'printing' stamp: 'lr 4/15/2009 21:57'! printOn: aStream aStream nextPutAll: self name! ! FLVersion subclass: #FLVersionRequirement instanceVariableNames: 'operator number' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLVersionRequirement methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:57'! number ^ number! ! !FLVersionRequirement methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:58'! number: aVersionNumber number := aVersionNumber! ! !FLVersionRequirement methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:55'! operator ^ operator! ! !FLVersionRequirement methodsFor: 'accessing' stamp: 'lr 4/15/2009 21:56'! operator: aSymbol operator := aSymbol! ! !FLVersionRequirement methodsFor: 'printing' stamp: 'lr 4/15/2009 21:59'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' ('. self operator = #= ifFalse: [ aStream nextPutAll: self operator; nextPut: Character space ]. aStream print: self number. aStream nextPut: $)! ! Magnitude variableSubclass: #FLVersionNumber instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Flair-Core'! !FLVersionNumber class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 21:26'! new ^ self error: 'Use ' , self class name , '>>#on: to instantiate the receiver'! ! !FLVersionNumber class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 21:25'! new: anInteger ^ self new! ! !FLVersionNumber class methodsFor: 'instance creation' stamp: 'lr 4/15/2009 21:24'! on: anArray | result | result := self basicNew: anArray size. 1 to: anArray size do: [ :index | result at: index put: (anArray at: index) ]. ^ result! ! !FLVersionNumber methodsFor: 'comparing' stamp: 'lr 4/15/2009 21:31'! < aVersionNumber 1 to: (self size min: aVersionNumber size) do: [ :index | (self at: index) = (aVersionNumber at: index) ifFalse: [ ^ (self at: index) < (aVersionNumber at: index) ] ]. ^ self size < aVersionNumber size! ! !FLVersionNumber methodsFor: 'comparing' stamp: 'lr 4/15/2009 21:31'! = aVersionNumber (self class = aVersionNumber class and: [ self size = aVersionNumber size ]) ifFalse: [ ^ false ]. 1 to: self size do: [ :index | (self at: index) = (aVersionNumber at: index) ifFalse: [ ^ false ] ]. ^ true! ! !FLVersionNumber methodsFor: 'comparing' stamp: 'lr 4/15/2009 21:37'! hash | hash | hash := self species hash. 1 to: self size do: [ :index | hash := ((hash bitShift: 6) bitXor: ((self at: index))) bitAnd: 16r0FFFFFFF ]. ^ hash! ! !FLVersionNumber methodsFor: 'printing' stamp: 'lr 4/15/2009 21:39'! printOn: aStream 1 to: self size do: [ :index | index = 1 ifFalse: [ aStream nextPut: $. ]. aStream print: (self at: index) ]! ! TestCase subclass: #FLVersionNumberTest instanceVariableNames: 'versions' classVariableNames: '' poolDictionaries: '' category: 'Flair-Tests'! !FLVersionNumberTest methodsFor: 'setup' stamp: 'lr 4/15/2009 22:30'! setUp super setUp. versions := OrderedCollection new. versions add: (FLVersionNumber on: #()). versions add: (FLVersionNumber on: #(1)). versions add: (FLVersionNumber on: #(1 1 2)). versions add: (FLVersionNumber on: #(1 1 3)). versions add: (FLVersionNumber on: #(1 2)). versions add: (FLVersionNumber on: #(1 2 0)). versions add: (FLVersionNumber on: #(1 3 1)). versions add: (FLVersionNumber on: #(3))! ! !FLVersionNumberTest methodsFor: 'testing' stamp: 'lr 4/15/2009 22:30'! testEqual self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 = i2 ifTrue: [ self assert: v1 = v2 ] ifFalse: [ self deny: v1 = v2 ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing-comparing' stamp: 'lr 4/15/2009 22:28'! testGreaterOrEqualThan self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 < i2 ifTrue: [ self deny: v1 >= v2 ]. i1 = i2 ifTrue: [ self assert: v1 >= v2 ]. i1 > i2 ifTrue: [ self assert: v1 >= v2 ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing-comparing' stamp: 'lr 4/15/2009 22:29'! testGreaterThan self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 < i2 ifTrue: [ self deny: v1 > v2 ]. i1 = i2 ifTrue: [ self deny: v1 > v2 ]. i1 > i2 ifTrue: [ self assert: v1 > v2 ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing' stamp: 'lr 4/15/2009 22:30'! testHash self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 = i2 ifTrue: [ self assert: v1 hash = v2 hash ] ifFalse: [ self deny: v1 hash = v2 hash ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing-comparing' stamp: 'lr 4/15/2009 22:29'! testLessOrEqualThan self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 < i2 ifTrue: [ self assert: v1 <= v2 ]. i1 = i2 ifTrue: [ self assert: v1 <= v2 ]. i1 > i2 ifTrue: [ self deny: v1 <= v2 ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing-comparing' stamp: 'lr 4/15/2009 22:29'! testLessThan self versions keysAndValuesDo: [ :i1 :v1 | self versions keysAndValuesDo: [ :i2 :v2 | i1 < i2 ifTrue: [ self assert: v1 < v2 ]. i1 = i2 ifTrue: [ self deny: v1 < v2 ]. i1 > i2 ifTrue: [ self deny: v1 < v2 ] ] ]! ! !FLVersionNumberTest methodsFor: 'testing' stamp: 'lr 4/15/2009 22:32'! testPrint self versions keysAndValuesDo: [ :i :v | i = 1 ifTrue: [ self assert: v printString = '' ] ifFalse: [ self assert: (v printString occurrencesOf: $.) = (v size - 1) ] ]! ! !FLVersionNumberTest methodsFor: 'accessing' stamp: 'lr 4/15/2009 22:24'! versions ^ versions! !