MCSmalltalkhubRepository.st
author Claus Gittinger <cg@exept.de>
Sun, 26 Aug 2018 14:44:04 +0200
changeset 1068 d31a825dfb42
parent 1057 03fb4863fcb7
child 1070 7b9c9cafec32
permissions -rw-r--r--
#OTHER by cg update

"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

MCHttpRepository subclass:#MCSmalltalkhubRepository
	instanceVariableNames:'owner project'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-RemoteRepositories'
!

MCSmalltalkhubRepository comment:'I am specialized version of an MCHttpRepository for http://smalltalkhub.com.
I support a faster mcz listing that does not rely on parsing an html size.'
!


!MCSmalltalkhubRepository class methodsFor:'instance creation'!

owner: owner project: project 
	^ self
		owner: owner
		project: project
		user: String empty
		password: String empty
!

owner: owner project: project user: user password: password
	^ self new
		owner: owner;
		project: project;
		user: user;
		password: password;
		yourself
! !

!MCSmalltalkhubRepository class methodsFor:'accessing'!

baseURL
	^ self smalltalkhubUrl, 'mc/'
!

description
	^ 'smalltalkhub.com'
!

hostName
	^ 'smalltalkhub.com'
!

smalltalkhubUrl
	^ 'http://', self hostName, '/'
! !

!MCSmalltalkhubRepository class methodsFor:'creation template'!

creationTemplate
	^self creationTemplateOwner: ''
		project: ''
		user: ''
		password: ''
!

creationTemplateOwner: owner project: project user: user password: password
	^ String streamContents: [ :s|
		s 
			nextPutAll: self name; cr;
			tab; nextPutAll: 'owner: '; print: owner; cr;
			tab; nextPutAll: 'project: '; print: project; cr;
			tab; nextPutAll: 'user: '; print: user; cr;
			tab; nextPutAll: 'password: '; print: password ].
! !

!MCSmalltalkhubRepository class methodsFor:'testing'!

isResponsibleFor: aUrl
	^ aUrl includesSubstring: self hostName
! !

!MCSmalltalkhubRepository methodsFor:'*Komitter-Models'!

koRemote

	^ KomitSmalltalkhubRemote new
		remote: self;
		yourself
! !

!MCSmalltalkhubRepository methodsFor:'accessing'!

location
	^ 'http://smalltalkhub.com/mc/', self owner, '/', self project, '/main/' 
!

location: aUrlString
	| pathSegments |
	(self class isResponsibleFor: aUrlString)
		ifFalse: [ Error signal: 'Please provide a smalltalkhub url' ].
	"extract the smalltalkhub properties from the path part in the given URL"
	pathSegments := aUrlString asZnUrl pathSegments reject: [ :each | each = 'mc' ].
	self owner: pathSegments first.
	self project: pathSegments second.
!

locationWithTrailingSlash
	^ self location
!

owner
	
	^ owner
!

owner: aString
	
	owner := aString
!

project
	
	^ project
!

project: aString
	
	project := aString
! !

!MCSmalltalkhubRepository methodsFor:'converting'!

asCreationTemplate
	^self class 
		creationTemplateOwner: self owner project: self project user: user password: password
! !

!MCSmalltalkhubRepository methodsFor:'interface'!

includesFileNamed: aString
	"avoid the slower default method and simply do a head request "
	self httpClient
		numberOfRetries: 0;
		ifFail: [ :exception | 
			((exception isKindOf: ZnHttpUnsuccessful) and: [ exception response isNotFound ])
				ifTrue: [ ^ false ].
			exception pass];
		head: (self urlForFileNamed: aString).
	^ true
!

includesVersionNamed: aString
	"directly do a filename check since squeaksource only stores mcz"
	^ self includesFileNamed: aString, '.mcz'
!

loadAllFileNames
	| client |
	client := self httpClient.
	client
		ifFail: [ :exception | self error: 'Could not access ', self location, ': ', exception printString ];
		url: self locationWithTrailingSlash;
		queryAt: 'format' put: 'raw';
		get.
	self assertNonBinaryResponse: client response.
	^ self parseFileNamesFromStream: client contents
!

parseFileNamesFromStream: aNewLineDelimitedString
	^ aNewLineDelimitedString 
		ifNil: [ ^ OrderedCollection new ]
		ifNotNil: [ aNewLineDelimitedString substrings: String crlf ]
! !

!MCSmalltalkhubRepository class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !