MCSmalltalkhubRepository.st
author Claus Gittinger <cg@exept.de>
Sat, 01 Sep 2018 17:32:13 +0200
changeset 1086 efc5221435a5
parent 1076 75b47bf25863
permissions -rw-r--r--
initial checkin

"{ Encoding: utf8 }"

"{ 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'!

allFileNames
    ^ self loadAllFileNames

    "Created: / 26-08-2018 / 15:00:32 / Claus Gittinger"
!

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 response|

    Smalltalk isSmalltalkX ifTrue:[
        response := HTTPInterface 
                        get: self locationWithTrailingSlash, '?format=raw' 
                        userName: self user 
                        password: self password.
        response responseCode ~= 200 ifTrue: [
            self error:('Could not access "',location,'" (',response response asString,')')
        ].
        self assertNonBinaryResponse: response.        
        ^ self parseFileNamesFromStream: response data
    ] ifFalse:[
        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
    ].

    "Modified: / 26-08-2018 / 14:59:18 / Claus Gittinger"
!

parseFileNamesFromStream: aNewLineDelimitedString
        aNewLineDelimitedString 
                ifNil: [ ^ OrderedCollection new ]
                ifNotNil: [ ^ aNewLineDelimitedString contents asStringCollection "substrings: String crlf" ]

    "Modified: / 29-08-2018 / 15:17:39 / Claus Gittinger"
! !

!MCSmalltalkhubRepository class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !