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/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/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! !

Object subclass: #IBFactory
	instanceVariableNames: 'name actions version comment'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'InstallBuilder'!

!IBFactory class methodsFor: 'examples' stamp: 'lr 9/13/2007 21:50'!
magritte
	"IBSqueakMap magritte build; dump; publish"

	^ self new
		name: 'Magritte';
		version: '1.0.14';
		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);
		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: 'examples' stamp: 'lr 9/13/2007 21:39'!
pier
	"IBSqueakMap pier build; dump; publish"

	^ self new
		name: 'Pier';
		version: '1.0.14-alpha';
		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: #OBBrowser';
			location: 'http://source.lukas-renggli.ch/pier';
			yourself);
		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: 'examples' stamp: 'lr 9/13/2007 21:39'!
pierSecurity
	"IBSqueakMap pierSecurity build; dump; publish"

	^ self new
		name: 'pierunixsecurity';
		version: '1.0.14-alpha';
		add: (IBSqueakMapAction new
			name: 'Pier';
			yourself);
		add: (IBMonticelloAction new
			name: 'Pier-Security';
			location: 'http://source.lukas-renggli.ch/pier';
			yourself);
		yourself! !

!IBFactory class methodsFor: 'examples' stamp: 'lr 9/13/2007 21:39'!
seaside
	"IBSqueakMap seaside build; dump; publish"

	^ self new
		name: 'Seaside';
		version: '2.8-beta';
		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);
		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: '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: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'InstallBuilder'!

IBFactory subclass: #IBSqueakMap
	instanceVariableNames: 'zip username password script package'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'InstallBuilder'!

!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/13/2007 15:26'!
password
	^ password ifNil: [ password := MACompatibility request: 'Password:' default: '' ]! !

!IBSqueakMap methodsFor: 'accessing' stamp: 'lr 9/13/2007 15:39'!
password: aString
	password := aString! !

!IBSqueakMap methodsFor: 'actions' stamp: 'lr 9/13/2007 21:26'!
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/13/2007 20:14'!
upload
	| result stream |
	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://'.
	^ 'http://' , stream upToEnd! !

!IBSqueakMap methodsFor: 'accessing' stamp: 'lr 9/13/2007 15:26'!
username
	^ username ifNil: [ username := MACompatibility request: 'Username:' default: 'lr' ]! !

!IBSqueakMap methodsFor: 'accessing' stamp: 'lr 9/13/2007 15:39'!
username: aString
	username := aString! !