SystemOrganization addCategory: #InstallBuilder! Object subclass: #IBAction instanceVariableNames: 'condition' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBAction methodsFor: 'visiting' stamp: 'lr 9/13/2007 15:49'! build: aFactory self subclassResponsibility! ! !IBAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 20:32'! condition "Define a precondition for this installation step." ^ condition! ! !IBAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 14:20'! condition: aString "Define a precondition for this installation step." condition := aString ! ! IBAction subclass: #IBMonticelloAction instanceVariableNames: 'name location' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBMonticelloAction methodsFor: 'visiting' stamp: 'lr 9/13/2007 15:50'! build: aFactory aFactory buildMonticello: self! ! !IBMonticelloAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 16:05'! location ^ location! ! !IBMonticelloAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 16:05'! location: aString "Define the http repository to be used." location := aString ! ! !IBMonticelloAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 16:00'! name ^ name! ! !IBMonticelloAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 16:00'! name: aString "Define the package name to be used." name := aString! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:11'! package ^ MCPackage new name: self name! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:16'! repository ^ self repositoryGroup repositories detect: [ :each | each isKindOf: MCHttpRepository ] ifNone: [ nil ]! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:16'! repositoryGroup ^ self workingCopy repositoryGroup! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/20/2007 13:11'! url ^ self repository locationWithTrailingSlash , self versionInfo name , '.mcz'! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:40'! version ^ self repositoryGroup versionWithInfo: self versionInfo ifNone: [ MCCacheRepository default versionWithInfo: self versionInfo ifAbsent: [ MCRepositoryGroup default versionWithInfo: self versionInfo ] ]! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:12'! versionInfo ^ self workingCopy currentVersionInfo! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/20/2007 13:15'! versionNumber ^ (self versionInfo name copyAfterLast: $.) asInteger! ! !IBMonticelloAction methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 16:11'! workingCopy ^ MCWorkingCopy forPackage: self package! ! IBAction subclass: #IBRepositoryAction instanceVariableNames: 'location' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBRepositoryAction methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:40'! build: aFactory aFactory buildRepository: self! ! !IBRepositoryAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 20:40'! location ^ location! ! !IBRepositoryAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 20:40'! location: aString location := aString! ! IBAction subclass: #IBSqueakMapAction instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBSqueakMapAction methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:27'! build: aFactory aFactory buildSqueakMap: self! ! !IBSqueakMapAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 20:27'! name ^ name! ! !IBSqueakMapAction methodsFor: 'accessing' stamp: 'lr 9/13/2007 20:28'! name: aString name := aString! ! IBAction subclass: #IBUniverseAction instanceVariableNames: 'name location package' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBUniverseAction methodsFor: 'visiting' stamp: 'lr 9/23/2007 10:33'! build: aFactory aFactory buildUniverse: self! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:52'! location ^ location! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:52'! location: aString "Define the http repository to be used." location := aString ! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:52'! name ^ name! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:52'! name: aString "Define the package name to be used." name := aString! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 11:24'! package ^ package! ! !IBUniverseAction methodsFor: 'accessing' stamp: 'lr 9/23/2007 11:24'! package: aPackage package := aPackage! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! repository ^ self repositoryGroup repositories detect: [ :each | each isKindOf: MCHttpRepository ] ifNone: [ nil ]! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! repositoryGroup ^ self workingCopy repositoryGroup! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! url ^ self repository locationWithTrailingSlash , self versionInfo name , '.mcz'! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! version ^ self repositoryGroup versionWithInfo: self versionInfo ifNone: [ MCCacheRepository default versionWithInfo: self versionInfo ifAbsent: [ MCRepositoryGroup default versionWithInfo: self versionInfo ] ]! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! versionInfo ^ self workingCopy currentVersionInfo! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 10:52'! versionNumber ^ (self versionInfo name copyAfterLast: $.) asInteger! ! !IBUniverseAction methodsFor: 'accessing-monticello' stamp: 'lr 9/23/2007 11:22'! workingCopy ^ MCWorkingCopy forPackage: (MCPackage new name: self name)! ! Object subclass: #IBFactory instanceVariableNames: 'name actions version comment' classVariableNames: '' poolDictionaries: '' category: 'InstallBuilder'! !IBFactory class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:39'! magritte ^ self new name: 'Magritte'; version: '1.0.14'; add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/magritteaddons'; yourself); add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/tutorial'; yourself); yourself! ! !IBFactory class methodsFor: 'instance-creation' stamp: 'lr 9/23/2007 10:42'! new self name = #IBFactory ifTrue: [ self error: self name , ' is abstract.' ]. ^ super new! ! !IBFactory class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:39'! pier ^ self new name: 'Pier'; version: '1.0.14-alpha'; add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/pieraddons'; yourself); add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/audioscrobbler'; yourself); add: (IBRepositoryAction new location: 'http://source.lukas-renggli.ch/topfeeder'; yourself); yourself! ! !IBFactory class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:39'! pierSecurity ^ self new name: 'pierunixsecurity'; version: '1.0.14-alpha'; yourself! ! !IBFactory class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:39'! seaside ^ self new name: 'Seaside'; version: '2.8-beta'; add: (IBRepositoryAction new location: 'http://www.squeaksource.com/Seaside'; yourself); add: (IBRepositoryAction new location: 'http://www.squeaksource.com/rsrss'; yourself); yourself! ! !IBFactory methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 17:11'! actions ^ actions ifNil: [ actions := OrderedCollection new ]! ! !IBFactory methodsFor: 'adding' stamp: 'lr 9/13/2007 16:30'! add: anAction self actions add: anAction! ! !IBFactory methodsFor: 'adding' stamp: 'lr 9/13/2007 20:25'! addAll: aCollection self actions addAll: aCollection! ! !IBFactory methodsFor: 'actions' stamp: 'lr 9/13/2007 16:47'! build "Builds the receiving entity using a double-dispatch trough the actions. Can be changed with pre- and post-conditions in subclasses." self actions do: [ :each | each build: self ] displayingProgress: 'Building ' , self printString! ! !IBFactory methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:40'! buildMonticello: anAction! ! !IBFactory methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:41'! buildRepository: anAction! ! !IBFactory methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:41'! buildSqueakMap: anAction! ! !IBFactory methodsFor: 'visiting' stamp: 'lr 9/23/2007 10:34'! buildUniverse: anAction! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 21:27'! comment ^ comment ifNil: [ comment := String new ]! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 17:14'! comment: aString ^ comment ifNil: [ comment := String new ]! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 17:10'! name ^ name! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 17:10'! name: aString ^ name := aString! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 17:11'! version ^ version! ! !IBFactory methodsFor: 'accessing' stamp: 'lr 9/13/2007 17:10'! version: aString version := aString! ! IBFactory subclass: #IBPackageUniverse instanceVariableNames: 'client' classVariableNames: 'PackageUniversePassword PackageUniverseUsername' poolDictionaries: '' category: 'InstallBuilder'! !IBPackageUniverse class methodsFor: 'examples' stamp: 'lr 9/23/2007 10:48'! magritte "self magritte build" ^ super magritte add: (IBUniverseAction new name: 'Magritte-Model'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBUniverseAction new name: 'Magritte-Tests'; condition: 'Smalltalk includesKey: #TestCase'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBUniverseAction new name: 'Magritte-Morph'; condition: 'Smalltalk includesKey: #Morph'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBUniverseAction new name: 'Magritte-Seaside'; condition: 'Smalltalk includesKey: #WAComponent'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); yourself! ! !IBPackageUniverse class methodsFor: 'examples' stamp: 'lr 9/23/2007 10:48'! pier "self pier build" ^ super pier add: (IBUniverseAction new name: 'Pier-Model'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBUniverseAction new name: 'Pier-Tests'; condition: 'Smalltalk includesKey: #TestCase'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBUniverseAction new name: 'Pier-Seaside'; condition: 'Smalltalk includesKey: #WAComponent'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBUniverseAction new name: 'Pier-OmniBrowser'; condition: 'Smalltalk includesKey: #OBCommand'; location: 'http://source.lukas-renggli.ch/pier'; yourself); yourself! ! !IBPackageUniverse class methodsFor: 'examples' stamp: 'lr 9/23/2007 10:48'! pierSecurity "self pierSecurity build; dump; publish" ^ super pierSecurity add: (IBUniverseAction new name: 'Pier-Security'; location: 'http://source.lukas-renggli.ch/pier'; yourself); yourself! ! !IBPackageUniverse class methodsFor: 'examples' stamp: 'lr 9/23/2007 11:43'! seaside "self seaside build" ^ super seaside add: (IBUniverseAction new name: 'Seaside2'; location: 'http://www.squeaksource.com/Seaside'; package: (UPackage new name: 'Seaside'; depends: #('KomHttpServer'); categoryString: 'Web Development'; homepage: 'http://www.seaside.st' asUrl; maintainer: 'Lukas Renggli '; description: 'A framework for building sophisticated web applications in Squeak. Develop for the web using reusable, embeddable components and unique call/return semantics for moving between pages.'; yourself); yourself); add: (IBUniverseAction new name: 'Scriptaculous'; location: 'http://www.squeaksource.com/Seaside'; package: (UPackage new name: 'Scriptaculous'; depends: #('Seaside'); categoryString: 'Web Development'; homepage: 'http://scriptaculous.seasidehosting.st' asUrl; maintainer: 'Lukas Renggli '; description: 'High-level Javascript bindings for the Seaside web application framework. This package includes PrototypeJS (http://www.prototypejs.org) and script.aculo.us (http://script.aculo.us).'; yourself); yourself); yourself! ! !IBPackageUniverse methodsFor: 'visiting' stamp: 'lr 9/23/2007 11:45'! buildUniverse: anAction | package | self halt. package := anAction package. package version: (UVersion readFromString: self version , '.' , anAction versionNumber asString); url: anAction url asUrl. self client sendMessage: (UMAddPackage username: self username password: self password package: package). self client waitForMessage applyToClient: self client! ! !IBPackageUniverse methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:18'! client ^ client ifNil: [ client := UUniverseClient forUniverse: self universe ]! ! !IBPackageUniverse methodsFor: 'initialization' stamp: 'lr 9/20/2007 13:03'! initialize super initialize. self universe updatePackagesViaWWW! ! !IBPackageUniverse methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:20'! password ^ PackageUniversePassword ifNil: [ PackageUniversePassword := FillInTheBlankMorph request: 'Password:' initialAnswer: '' ]! ! !IBPackageUniverse methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:03'! universe ^ UUniverse systemUniverse! ! !IBPackageUniverse methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:20'! username ^ PackageUniverseUsername ifNil: [ PackageUniverseUsername := FillInTheBlankMorph request: 'Username:' initialAnswer: 'lr' ]! ! IBFactory subclass: #IBSqueakMap instanceVariableNames: 'zip script package url' classVariableNames: 'SqueakMapPassword SqueakMapUsername' poolDictionaries: '' category: 'InstallBuilder'! !IBSqueakMap class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:43'! magritte "self magritte build; dump; publish" ^ super magritte add: (IBSqueakMapAction new name: 'Seaside'; yourself); add: (IBMonticelloAction new name: 'Magritte-Model'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBMonticelloAction new name: 'Magritte-Tests'; condition: 'Smalltalk includesKey: #TestCase'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBMonticelloAction new name: 'Magritte-Morph'; condition: 'Smalltalk includesKey: #Morph'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); add: (IBMonticelloAction new name: 'Magritte-Seaside'; condition: 'Smalltalk includesKey: #WAComponent'; location: 'http://source.lukas-renggli.ch/magritte'; yourself); yourself! ! !IBSqueakMap class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:44'! pier "self pier build; dump; publish" ^ super pier add: (IBSqueakMapAction new name: 'Magritte'; yourself); add: (IBMonticelloAction new name: 'Pier-Model'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBMonticelloAction new name: 'Pier-Tests'; condition: 'Smalltalk includesKey: #TestCase'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBMonticelloAction new name: 'Pier-Seaside'; condition: 'Smalltalk includesKey: #WAComponent'; location: 'http://source.lukas-renggli.ch/pier'; yourself); add: (IBMonticelloAction new name: 'Pier-OmniBrowser'; condition: 'Smalltalk includesKey: #OBCommand'; location: 'http://source.lukas-renggli.ch/pier'; yourself); yourself! ! !IBSqueakMap class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:44'! pierSecurity "self pierSecurity build; dump; publish" ^ super pierSecurity add: (IBSqueakMapAction new name: 'Pier'; yourself); add: (IBMonticelloAction new name: 'Pier-Security'; location: 'http://source.lukas-renggli.ch/pier'; yourself); yourself! ! !IBSqueakMap class methodsFor: 'accessing' stamp: 'lr 9/23/2007 10:45'! seaside "self seaside build; dump; publish" ^ super seaside add: (IBMonticelloAction new condition: 'PasteUpMorph confirm: ''Would you like to install the Kom server?'''; name: 'DynamicBindings'; yourself); add: (IBMonticelloAction new condition: 'Smalltalk includesKey: #DynamicBindings'; name: 'KomServices'; yourself); add: (IBMonticelloAction new condition: 'Smalltalk includesKey: #TcpService'; name: 'KomHttpServer'; yourself); add: (IBMonticelloAction new location: 'http://www.squeaksource.com/Seaside'; name: 'Seaside2'; yourself); add: (IBMonticelloAction new condition: 'PasteUpMorph confirm: ''Would you like to install Scriptaculous?'''; location: 'http://www.squeaksource.com/Seaside'; name: 'Scriptaculous'; yourself); add: (IBMonticelloAction new condition: 'PasteUpMorph confirm: ''Would you like to install RSS support?'''; location: 'http://www.squeaksource.com/rsrss'; name: 'RSRSS2'; yourself); yourself! ! !IBSqueakMap methodsFor: 'actions' stamp: 'lr 9/13/2007 16:49'! build zip := ZipArchive new. script := String new writeStream. super build. (zip addString: script contents as: 'install/preamble') desiredCompressionLevel: 9! ! !IBSqueakMap methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:42'! buildMonticello: anAction | snapshot | snapshot := anAction version. zip addString: (ByteArray streamContents: [ :stream | snapshot fileOutOn: stream. ]) as: snapshot fileName. self conditional: anAction do: [ script nextPutAll: 'self fileInMonticelloZipVersionNamed: '. script print: snapshot fileName. anAction location isNil ifFalse: [ script nextPutAll: '. (MCWorkingCopy forPackage: (MCPackage new name: '. script print: anAction name. script nextPutAll: '))'. script nextPutAll: ' repositoryGroup addRepository: ('. script nextPutAll: (MCHttpRepository creationTemplateLocation: anAction location user: '' password: ''). script nextPut: $) ] ]! ! !IBSqueakMap methodsFor: 'visiting' stamp: 'lr 9/13/2007 21:32'! buildRepository: anAction self conditional: anAction do: [ script nextPutAll: 'MCRepositoryGroup default addRepository: ('. script nextPutAll: (MCHttpRepository creationTemplateLocation: anAction location user: '' password: ''). script nextPut: $) ]! ! !IBSqueakMap methodsFor: 'visiting' stamp: 'lr 9/13/2007 20:34'! buildSqueakMap: anAction self conditional: anAction do: [ script nextPutAll: '(SMSqueakMap default packageWithName: '. script print: anAction name. script nextPutAll: ') lastRelease install' ]! ! !IBSqueakMap methodsFor: 'private' stamp: 'lr 9/13/2007 15:33'! checkResult: aString | result | result := #( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [ :each | aString beginsWith: each ]. result ifFalse: [ self error: aString ]! ! !IBSqueakMap methodsFor: 'private' stamp: 'lr 9/13/2007 20:45'! conditional: anAction do: aBlock anAction condition isNil ifFalse: [ script nextPut: $(; nextPutAll: anAction condition; nextPutAll: ') ifTrue: [' ]. aBlock value. anAction condition isNil ifFalse: [ script nextPut: $] ]. script nextPut: $.; cr! ! !IBSqueakMap methodsFor: 'actions' stamp: 'lr 9/13/2007 20:14'! dump "Dump the SAR archive to the file-system." zip writeToFileNamed: self fileName! ! !IBSqueakMap methodsFor: 'accessing-dynamic' stamp: 'lr 9/13/2007 17:15'! fileName ^ self name asLowercase , '-' , self version asLowercase , '.sar'! ! !IBSqueakMap methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:21'! password ^ SqueakMapPassword ifNil: [ SqueakMapPassword := FillInTheBlankMorph request: 'Password:' initialAnswer: '' ]! ! !IBSqueakMap methodsFor: 'actions' stamp: 'lr 9/17/2007 14:45'! publish "Publish the package as a new release on SqueakMap." | result | result := HTTPSocket httpPost: self squeakMapUrl , 'packagebyname/' , self name , '/newrelease' args: (Array with: 'note' -> (Array with: self comment) with: 'version' -> (Array with: self version) with: 'downloadURL' -> (Array with: self upload)) user: self username passwd: self password. (result contents includesSubString: self version) ifFalse: [ self error: result contents ]! ! !IBSqueakMap methodsFor: 'private' stamp: 'lr 9/13/2007 15:33'! squeakMapUrl ^ 'http://map1.squeakfoundation.org/sm/'! ! !IBSqueakMap methodsFor: 'actions' stamp: 'lr 9/17/2007 14:43'! upload | result stream | url isNil ifFalse: [ ^ url ]. result := HTTPSocket httpPut: (ByteArray streamContents: [ :s | zip writeTo: s ]) to: self squeakMapUrl , 'upload/' , self fileName user: self username passwd: self password. self checkResult: result. stream := result readStream. stream upToAll: 'http://'. ^ url := 'http://' , stream upToEnd! ! !IBSqueakMap methodsFor: 'accessing' stamp: 'lr 9/20/2007 13:21'! username ^ SqueakMapUsername ifNil: [ SqueakMapUsername := FillInTheBlankMorph request: 'Username:' initialAnswer: 'lr' ]! !