'From Squeak3.9gamma of ''23 July 2006'' [latest update: #7064] on 7 November 2006 at 7:09:55 pm'!
Object subclass: #Installer
	instanceVariableNames: 'sm wsm mc ma url user markers password project package bug answers packages messagesToSuppress'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Installer-Core'!
!Installer commentStamp: 'kph 11/7/2006 05:45' prior: 0!
Installer provides a simple Domain Specific Language for installing packages from monticello and squeakmap of various version.

One design decision is to be able to paste scripts a workspace and run and tested from there without any special editing.

Examples - Using SqueakMap


1)
squeakmap := Installer squeakmap.
squeakmap install: 'DynamicBindings'.
squeakmap open.
2)
Installer squeakmap install: 'DynamicBindings'.
3) Alternatively using websqueakmap
squeakmap := Installer websqueakmap.
squeakmap package: 'DynamicBindings'; install.

Examples - Using Monticello

1)
squeaksource := Installer repository: 'http://www.squeaksource.com'.
seaside := squeaksource project: 'Seaside'.
seaside install: 'Comet-lr.8';
		install: 'Scriptaculous'.
2) 
squeaksource := Installer repository: 'http://www.squeaksource.com'		
squeaksource project: 'Seaside';
			  install: 'Comet-lr.8;
			  install: 'Scriptaculous'.

Examples - install straight from a url

1a)
(Installer url: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/MakeTestsGreen39.cs') install.
1b)
Installer installUrl: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/MakeTestsGreen39.cs'.

2)
| page |
page := Installer url: 'http://minnow.cc.gatech.edu/squeak/uploads/5889/'.
page package: 'MakeTestsGreen39.cs'.
page install.

3)
In html page scripts are delimited by <code begin> </code end>
| page |
page := Installer url: 'http://wiki.squeak.org/742'.
page install.
4)
specify your own delimeters

| page |
page := Installer url: 'http://wiki.squeak.org/742'.
page markers: 'begin>...</code'.
page install.!


!Installer methodsFor: 'accessing' stamp: 'kph 10/17/2006 13:06'!
answers

^ answers ifNil: [ answers := OrderedCollection new ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/19/2006 06:55'!
answers: anObject
	"Set the value of answers"

	answers := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 05:06'!
bug
	"Answer the value of bug"

	^ bug! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/21/2006 02:45'!
bug: aBugNo fix: aFileName

	| stream |

	self logCR: 'obtaining ', aFileName, '...'.

	stream := self streamFor: aBugNo file: aFileName.

	self install: aFileName fromStream: stream.! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 04:04'!
install

self mc ifNotNil: [ self mcInstall ].
self wsm ifNotNil: [ self wsmInstall ].
self url ifNotNil: [ self urlInstall ].
self sm ifTrue: [ self smInstall ].
! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/18/2006 11:29'!
install: packageNameCollectionOrDetectBlock

self package: packageNameCollectionOrDetectBlock.

self install! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 05:09'!
install: aFileName fromStream: stream

| done |

done := false.

	self log: 'installing...'.

	self withAnswersDo:	[
		(aFileName endsWith: '.cs') ifTrue: [ stream fileIn. done := true. ].
		(aFileName endsWith: '.st') ifTrue: [ stream fileIn. done := true.  ].
		(aFileName endsWith: '.html') ifTrue: [ self fileInFromHtml: stream. done := true.  ].
		(aFileName endsWith: '.mcz') ifTrue: [ MczInstaller installStream: stream. done := true.  ].
	].

	self log: (done ifTrue: ['done'] ifFalse: [ 'source not found' ]).! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/17/2006 12:13'!
log: text

Transcript show: text.! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/17/2006 12:14'!
logCR: text

Transcript cr; show: text.! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/19/2006 06:55'!
ma
	"Answer the value of ma"

	^ ma! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/19/2006 07:07'!
ma: aUrl
 
	"Set the value of host"

	ma := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 06:19'!
markers
	"Answer the value of markers"

	^ markers ifNil: [ '<code st>...</code st>' ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 05:06'!
markers: anObject
	"Set the value of markers"

	markers := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 06:38'!
mc
	"Answer the value of mc"

	^ mc! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/19/2006 07:07'!
mc: aUrl
 
	"Set the value of host"

	mc := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/17/2006 14:30'!
messagesToSuppress

^ messagesToSuppress ifNil: [ messagesToSuppress := OrderedCollection new ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/19/2006 06:55'!
messagesToSuppress: anObject
	"Set the value of messagesToSuppress"

	messagesToSuppress := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 07:59'!
open
	
self sm ifTrue: [ SMLoader open ].
self mc ifNotNil: [self mcRepository morphicOpen: nil ].! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 04:05'!
package
	"Answer the value of package"

	^ package! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 04:05'!
package: anObject
	"Set the value of package"

	package := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/21/2006 03:08'!
packages
	
self sm ifTrue: [ ^SMLoader new packages ].
self mc ifNotNil: [ ^self mcRepository allFileNames ].
self wsm ifNotNil: [ ^self wsmPackagesByName keys ].! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 05:06'!
packages: anObject
	"Set the value of packages"

	packages := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/21/2006 03:09'!
packagesMatching: aMatch

self sm ifTrue: [ ^ (self packages select: [ :p | aMatch match: p name ]) collect: [ :p | self copy package: p name; yourself ] ].
self mc ifNotNil: [ ^ (self packages select: [ :p | ( aMatch , '.mcz' ) match: p ]) collect: [ :p | self copy package: p ; yourself ] ].
self wsm ifNotNil: [ ^ (self packages select: [ :p | ( aMatch) match: p ]) collect: [ :p | self copy package: p ; yourself ] ].! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 04:16'!
password
	"Answer the value of password"

	^ password  ifNil: [ '' ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 03:56'!
password: anObject
	"Set the value of password"

	password := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/21/2006 06:14'!
printOn: s
 
s nextPutAll: '(Installer'.

self sm ifTrue: [ s nextPutAll: ' squeakmap' ].
self ma ifNotNil: [ s nextPutAll: ' mantis' ].
self wsm ifNotNil: [ s nextPutAll: ' websqueakmap' ].
self mc ifNotNil: [ s nextPutAll: ' repository:''', self mc,'''' ].

s nextPut: $).

self project ifNotNil: [ s nextPutAll: ' project:';
  						nextPutAll: '''', self project, ''''.
					   self package ifNotNil: [ s nextPutAll: '; '] ].
					
self package ifNotNil: [ s nextPutAll: ' package:';
  						 nextPutAll: '''', self package asString, '''' ].
					
s nextPut: $..! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 06:30'!
project
	"Answer the value of project"

	^ project! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 06:33'!
project: anObject
	"Set the value of project"

	project := anObject.

	^self copy.! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 06:55'!
sm
	"Answer the value of sm"

	^ sm ifNil: [ false ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 06:38'!
sm: anObject
	"Set the value of sm"

	sm := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/17/2006 15:37'!
unload: workingCopyPackageName 

self logCR: 'Unloading ', workingCopyPackageName.
 (MCWorkingCopy forPackage: (MCPackage new name: workingCopyPackageName)) unload! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 04:23'!
url

^url! !

!Installer methodsFor: 'accessing' stamp: 'kph 11/7/2006 04:23'!
url: aUrl
 
 url := aUrl! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 04:15'!
user
	"Answer the value of user"

	^ user ifNil: [ '' ]! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/15/2006 03:56'!
user: anObject
	"Set the value of user"

	user := anObject! !

!Installer methodsFor: 'accessing' stamp: 'kph 10/21/2006 05:50'!
versions
	
self sm ifTrue: [ ^self smVersions ].
self mc ifNotNil: [ ^self mcVersions ].
self wsm ifNotNil: [ ^self wsmVersions ].! !


!Installer methodsFor: 'monticello' stamp: 'kph 10/21/2006 06:53'!
mcInstall

	| repository sortMczs files fileToLoad  version detectFileBlock  count |

	self logCR: 'installing ', self package asString, '...'.

	self package isString ifTrue: [ detectFileBlock := [ :file | file beginsWith: self package ] ].
	(self package isKindOf: Array) 
			ifTrue: [ detectFileBlock :=  [ :file | (self package detect: [ :item | file beginsWith: item ] ifNone: [ false ]) ~= false ] ].
	self package isBlock ifTrue: [ detectFileBlock := self package ].
  

	repository := MCHttpRepository location: self mcUrl user: self user password: self password.

	sortMczs := [:a :b | 
        	[(a findBetweenSubStrs: #($.)) allButLast last asInteger > (b findBetweenSubStrs: #($.)) allButLast last asInteger] on: Error do: [:ex | false]].

	"several attempts to read files - repository readableFileNames sometimes fails"

	count := 0. fileToLoad := nil.
	
	[count := count + 1.
	 (fileToLoad = nil) and:[ count < 5 ] ] 
		whileTrue: [
						files := repository readableFileNames asSortedCollection: sortMczs.
						fileToLoad := files detect: detectFileBlock ifNone: [ nil ].
																						].

	version := repository versionFromFileNamed: fileToLoad.
	version workingCopy repositoryGroup addRepository: repository.
	repository creationTemplate: 'MCHttpRepository
        	location: ''', self mcUrl, '''
        	user: ''', self user, '''
        	password: ''', self password, ''''.
	self log: ' ', version fileName, '...'.

	self withAnswersDo: [ version load ].

	self log: 'done'.
! !

!Installer methodsFor: 'monticello' stamp: 'kph 10/15/2006 07:59'!
mcRepository

^MCHttpRepository location: (self mcUrl) user: self user password: self password.! !

!Installer methodsFor: 'monticello' stamp: 'kph 10/15/2006 06:49'!
mcUrl

^ self mc, self project! !

!Installer methodsFor: 'monticello' stamp: 'kph 10/21/2006 05:47'!
mcVersions

^ (self packages select: [ :p | ( self package,'-*.mcz' ) match: p ]) collect: [ :p | self copy package: p  ; yourself ].
 ! !

!Installer methodsFor: 'monticello' stamp: 'kph 10/21/2006 06:52'!
withAnswersDo: aBlock

	(aBlock respondsTo: #valueSuppressingMessages:supplyingAnswers: )
		ifTrue: [aBlock valueSuppressingMessages: self messagesToSuppress supplyingAnswers: self answers.]
		ifFalse: [ aBlock value ]
! !


!Installer methodsFor: 'auto answering' stamp: 'kph 10/17/2006 13:07'!
answer: aString with: anAnswer

^self answers add: ( Array with: aString with: anAnswer )! !

!Installer methodsFor: 'auto answering' stamp: 'kph 10/17/2006 14:30'!
suppress: aMessage

messagesToSuppress add: aMessage! !


!Installer methodsFor: 'squeakmap' stamp: 'kph 10/21/2006 06:54'!
smInstall 

	| pkgAndVersion releases release |

	pkgAndVersion := self smPackageAndVersion.

	self logCR: 'installing ', self package, ' from SqueakMap...'.


	releases := self smReleasesForPackage: pkgAndVersion first.
 	
	release := pkgAndVersion last isEmpty ifTrue: [ releases last ]
					ifFalse:[ releases detect: [ :rel | rel version = pkgAndVersion last ] ]. 
	
	self withAnswersDo: [ release install ].

	self log: ' done'.
! !

!Installer methodsFor: 'squeakmap' stamp: 'kph 10/17/2006 15:24'!
smPackageAndVersion

| p |

p := ReadStream on: self package .

^Array with: (p upTo: $() with: (p upTo: $)).! !

!Installer methodsFor: 'squeakmap' stamp: 'kph 10/21/2006 06:09'!
smReleasesForPackage: name 

^(SMSqueakMap default packageWithName: name) releases! !

!Installer methodsFor: 'squeakmap' stamp: 'kph 10/21/2006 06:12'!
smVersions

^ (self smReleasesForPackage: self package) collect: [ :p | self copy package: (p name,'(',p version,')'); yourself. ] ! !


!Installer methodsFor: 'websqueakmap' stamp: 'kph 10/21/2006 01:37'!
wsm
	"Answer the value of wsm"
	
	^ wsm! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 10/21/2006 01:37'!
wsm: aUrl
 
	"Set the value of host"

	wsm := aUrl last = $/ ifTrue: [ aUrl ] ifFalse: [ aUrl, '/' ]! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 11/7/2006 18:57'!
wsmDownloadUrl 

| pkgAndVersion packageId packageName packageVersion releaseAutoVersion
 downloadPage |

	pkgAndVersion := self smPackageAndVersion.
	packageName := pkgAndVersion first.
	packageVersion := pkgAndVersion last.
	packageVersion isEmpty ifTrue: [ packageVersion := #latest ].

	packageId := self wsmPackagesByName at: packageName.
	releaseAutoVersion := (self wsmReleasesFor: packageId) at: packageVersion.
					 
	downloadPage := HTTPSocket httpGet: (self wsm,'/package/',packageId,'/autoversion/', releaseAutoVersion).
						 
	^ downloadPage upToAll: '<b>Download:</b>'; upToAll: 'href="'; upTo: $"
	
! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 11/7/2006 18:57'!
wsmInstall 

	| downloadUrl |

	self logCR: 'finding ', self package, ' from websqueakmap(', self wsm, ') ...'.

	downloadUrl := self wsmDownloadUrl.
	
	self logCR: 'found at ', downloadUrl asString, ' ...'.
	 
	self install: downloadUrl fromStream: (HTTPSocket httpGet: downloadUrl).

	! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 11/7/2006 18:54'!
wsmPackagesByName

	| html id name | 
	
	packages ifNotNil: [ ^packages ].
	
	packages := Dictionary new.
	
	html := HTTPSocket httpGet: (self wsm, 'packagesbyname').
	
	[
		id := html upToAll: '/package/'; upToAll: '">'.
		name := html upTo: $<.
		
		(id notEmpty and: [ name notEmpty ]) 

	] whileTrue: [ packages at: name put: id ].

	^ packages	
	! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 11/7/2006 18:54'!
wsmReleasesFor: packageId

	| html autoVersion version releases |
		
	releases := Dictionary new.
	
	html := HTTPSocket httpGet: (self wsm, '/package/', packageId ).
	
	[
		releases at: #latest put: autoVersion.
		autoVersion := html upToAll: '/autoversion/'; upTo: $".
		version := html upTo: $-; upTo: $<.
		
		(autoVersion notEmpty and: [version notEmpty ]) 

	] whileTrue: [ releases at: version put: autoVersion ].

	^ releases
	! !

!Installer methodsFor: 'websqueakmap' stamp: 'kph 10/21/2006 06:04'!
wsmVersions

| pkgAndVersion packageId packageName packageVersion versions |

	pkgAndVersion := self smPackageAndVersion.
	packageName := pkgAndVersion first.
	packageVersion := pkgAndVersion last.
	packageVersion isEmpty ifTrue: [ packageVersion := #latest ].

	packageId := self wsmPackagesByName at: packageName.
	
	versions := (self wsmReleasesFor: packageId) keys.
	versions remove: #latest.
	
	^ versions collect: [ :version | self copy package: (packageName,'(', version ,')'); yourself ]. ! !


!Installer methodsFor: 'mantis' stamp: 'kph 10/19/2006 12:21'!
bug: aBugNo

^ (self maFilesFor: aBugNo) keys! !

!Installer methodsFor: 'mantis' stamp: 'kph 10/19/2006 13:55'!
bug: aBugNo retrieve: aFileName

	^ (self streamFor: aBugNo file: aFileName) contents! !

!Installer methodsFor: 'mantis' stamp: 'kph 11/7/2006 18:53'!
maFilesFor: maBugNo
  "
  self mantis bug: 5251.
"
 
 | file files bugPage id | 
 
 files := Dictionary new.
 
 bugPage :=HTTPSocket httpGet: (self ma, 'view.php?id=', maBugNo asString).

 [
  id := bugPage upToAll: 'href="file_download.php?file_id='; upTo: $&. 
 file := bugPage upToAll: 'amp;type=bug"' ; upTo: $<.
 
 ((file size > 1) and: [file first = $>]) ifTrue: [ files at: file copyWithoutFirst put: id ].
 
 id notEmpty ] whileTrue.

^files ! !

!Installer methodsFor: 'mantis' stamp: 'kph 11/7/2006 18:53'!
streamFor: aBugNo file: aFileName

	| fileId  |

 	fileId :=  (self maFilesFor: aBugNo) at: aFileName.

 	^ HTTPSocket httpGet: (self ma, 'file_download.php?file_id=' , fileId , '&type=bug').
		 ! !


!Installer methodsFor: 'url' stamp: 'kph 11/7/2006 18:51'!
fileInFromHtml: html

	| source in start stop  |
 
	start := self markers copyUpTo: $..
	stop := self markers copyAfterLast: $..
		 
	html upToAll: start.
	in := (html upToAll: stop) readStream.  

	source := ReadWriteStream on: (String new: 100).

	[ in atEnd ] whileFalse: [ 
		source nextPutAll: (in upTo: $<).
		in upTo: $>.	
	].
 
	source reset fileIn.
! !

!Installer methodsFor: 'url' stamp: 'kph 11/7/2006 18:38'!
urlInstall 

"
Installer installUrl: 'wiki.squeak.org/742'.
"
	| downloadUrl page  |

	downloadUrl := self url, self package.
	
	self logCR: 'found ', downloadUrl , ' ...'.
	 
	page := HTTPSocket httpGet: downloadUrl.
	 
	((page upTo: $L) = '<!!DOCTYPE HTM') ifTrue: [ downloadUrl := downloadUrl, ' is .html'].
	
	self install:  downloadUrl fromStream: page reset

	! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Installer class
	instanceVariableNames: ''!

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 11/7/2006 04:24'!
installUrl: urlString

^(self url: urlString) install! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/19/2006 06:55'!
mantis

^self mantis: 'http://bugs.impara.de/'! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/19/2006 06:56'!
mantis: host

^self new ma: host; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/15/2006 06:37'!
repository: host

^self new mc: host; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/15/2006 06:37'!
repository: host user: uName password: pWord

^self new mc: host; user: uName; password: pWord; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/15/2006 06:37'!
squeakmap

^self new sm: true; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 11/7/2006 05:05'!
url: urlString

^self new url: urlString; package: ''; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/21/2006 01:38'!
websqueakmap

^self new wsm: 'http://map.squeak.org'; yourself! !

!Installer class methodsFor: 'as yet unclassified' stamp: 'kph 10/21/2006 01:38'!
websqueakmap: host

^self new wsm: host; yourself! !