#FEATURE by cg
class: MCFileTreeRepository
changed:
#repositoryBranchName
#repositoryProperties
#repositoryVersionString
class: MCFileTreeRepository class
comment/format in: #parseName:extension:
"{ Encoding: utf8 }"
"{ Package: 'stx:goodies/monticello' }"
"{ NameSpace: Smalltalk }"
MCDirectoryRepository subclass:#MCFileTreeRepository
instanceVariableNames:'readonly repositoryProperties'
classVariableNames:''
poolDictionaries:''
category:'SCM-Monticello-FileTree-Core'
!
MCFileTreeRepository class instanceVariableNames:'defaultPackageExtension defaultPropertyFileExtension'
"
No other class instance variables are inherited by this class.
"
!
MCFileTreeRepository comment:'A file tree repository'
!
!MCFileTreeRepository class methodsFor:'instance creation'!
basicFromUrl: aZnUrl
^ self new directory: (self urlAsFileReference: aZnUrl)
!
description
^ 'filetree://'
! !
!MCFileTreeRepository class methodsFor:'accessing'!
defaultPackageExtension
".tree, .pkg, .package are the only formats supported at the moment:
.tree - original structure
.pkg - snapshot structure
.package - cypress structure"
defaultPackageExtension
ifNil: [
defaultPackageExtension := MCFileTreePackageStructureStWriter useCypressWriter
ifTrue: [ '.package' ]
ifFalse: [ '.pkg' ] ].
^ defaultPackageExtension
!
defaultPackageExtension: aString
".tree and .pkg are the only two formats supported at the moment"
"self defaultPackageExtension:'.package'"
(#('.tree' '.pkg' '.package') includes: aString)
ifFalse: [ self error: 'Unsupported package extension: ' , aString printString ].
defaultPackageExtension := aString
!
defaultPropertyFileExtension
defaultPropertyFileExtension
ifNil: [ defaultPropertyFileExtension := '.json' ].
^ defaultPropertyFileExtension
!
defaultPropertyFileExtension: aString
"self defaultPropertyFileExtension:'.ston'"
self validatePropertyFileExtension: aString.
defaultPropertyFileExtension := aString
!
urlSchemes
^ #(#filetree)
!
validatePropertyFileExtension: aString
"see Issue #90: https://github.com/dalehenrich/filetree/issues/90"
(#('.json' '.ston') includes: aString)
ifFalse: [ self error: 'Unsupported property file extension: ' , aString printString ]
! !
!MCFileTreeRepository class methodsFor:'utility'!
parseName: aString
^ self parseName: aString extension: self defaultPackageExtension
!
parseName: aString extension: extension
"picked up from GoferVersionReference>>parseName:"
| "info" basicName package branch author versionNumber packageName |
basicName := aString last isDigit
ifTrue: [ aString ]
ifFalse: [ (aString copyUpToLast: $.) copyUpTo: $( ].
package := basicName copyUpToLast: $-.
(package includes: $.)
ifFalse: [ branch := '' ]
ifTrue: [
branch := '.' , (package copyAfter: $.).
package := package copyUpTo: $. ].
author := (basicName copyAfterLast: $-) copyUpToLast: $..
versionNumber := (basicName copyAfterLast: $-) copyAfterLast: $..
(versionNumber notEmpty and: [ versionNumber allSatisfy: [ :each | each isDigit ] ])
ifTrue: [ versionNumber := versionNumber asNumber ]
ifFalse: [ versionNumber := 0 ].
packageName := package , branch.
^ {packageName.
author.
versionNumber.
(packageName , extension)}
"Modified (comment): / 01-09-2018 / 17:33:38 / Claus Gittinger"
!
urlAsFileReference: aZnUrl
"Extracted from ZnUrl since the scheme is restricted.
We need to keep host as a segment part."
| path |
path := aZnUrl host
ifNotNil: [
((aZnUrl host = #/) and: [ aZnUrl pathSegments isEmpty ])
ifTrue: [ ^ FileSystem root ].
aZnUrl pathSegments copyWithFirst: aZnUrl host ]
ifNil: [ aZnUrl pathSegments copyWithFirst: FileSystem disk delimiter asString ].
^ (String streamContents:
[ :stream |
path
asStringOn: stream
delimiter: FileSystem disk delimiter asString ])
asFileReference
! !
!MCFileTreeRepository methodsFor:'*Komitter-Models'!
isRemote
^ true
! !
!MCFileTreeRepository methodsFor:'*metacello-filetree'!
metacelloProjectClassFor: aScriptEngine
aScriptEngine versionString isEmptyOrNil
ifFalse: [
"If we have a version in the script, then a BaselineOf is not being referenced...use a MetacelloMCProject
see https://github.com/dalehenrich/metacello-work/issues/7"
^ super metacelloProjectClassFor: aScriptEngine ].
^ MetacelloMCBaselineProject
!
repositoryBranchName
"extract a branch name from the repository ... if possible"
|sha|
(sha := MetacelloPlatform current gitBranchNameFor: self directory fullName)
notNil ifTrue:[ ^ sha ].
^ super repositoryBranchName
"Modified: / 01-09-2018 / 17:34:23 / Claus Gittinger"
!
repositoryDescription
^ self description , ' [' , self repositoryVersionString , ':'
, self repositoryBranchName , ']'
!
repositoryVersionString
"extract a version string from the repository ... if possible"
|sha|
(sha := MetacelloPlatform current gitCommitShaFor: self directory fullName)
notNil ifTrue: [^ sha ].
^ super repositoryVersionString
"Modified: / 01-09-2018 / 17:34:51 / Claus Gittinger"
! !
!MCFileTreeRepository methodsFor:'*metacello-mc'!
versionInfoFromVersionNamed: aString
^ self versionInfoForPackageDirectory: (self fileDirectoryOn: (aString, self packageExtension))
! !
!MCFileTreeRepository methodsFor:'accessing'!
allFileNames
^ (self directory entries select: [ :entry | entry isDirectory and: [ self canReadFileNamed: entry name ] ])
collect: [ :entry | entry name ]
!
allFileNamesForVersionNamed: aString
^ self filterFileNames: self readableFileNames forVersionNamed: aString
!
asRepositorySpecFor: aMetacelloMCProject
^ aMetacelloMCProject repositorySpec
description: self description;
type: 'filetree';
yourself
!
defaultRepositoryProperties
^ Dictionary new
at: 'packageExtension' put: self class defaultPackageExtension;
at: 'propertyFileExtension' put: self propertyFileExtension;
yourself
!
directory: aDirectory
super directory: aDirectory.
repositoryProperties := nil. "force properties to be reloaded from new location"
self repositoryProperties "NOW"
!
fileUtils
^ MCFileTreeFileUtils current
!
filterFileNames: aCollection forVersionNamed: aString
^ aCollection select: [:ea | (self versionNameFromFileName: ea) = aString]
!
goferVersionFrom: aVersionReference
"until we no longer find .tree directories in the wild"
((self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ])
select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ])
collect: [ :packageDirectory |
(self versionInfoForPackageDirectory: packageDirectory) name = aVersionReference name
ifTrue: [ ^ self loadVersionFromFileNamed: (self fileUtils directoryName: packageDirectory) ] ].
^ nil
!
readonly
readonly ifNil: [ readonly := false ].
^ readonly
!
readonly: anObject
readonly := anObject
!
repositoryProperties
|configEntry|
repositoryProperties
ifNil: [
repositoryProperties := Dictionary new.
(self fileUtils directoryExists: directory)
ifFalse: [
self
error:
'filetree:// repository '
,
(self fileUtils directoryPathString: self directory) printString
, ' does not exist.' ].
(configEntry := self directory entries
detect: [ :entry | entry name = '.filetree' ]
ifNone: [ ])
isNil ifTrue: [
repositoryProperties := self defaultRepositoryProperties.
self writeRepositoryProperties ]
ifFalse: [
configEntry
readStreamDo: [ :fileStream | repositoryProperties := MCFileTreeJsonParser parseStream: fileStream ] ] ].
^ repositoryProperties
"Modified: / 01-09-2018 / 17:35:33 / Claus Gittinger"
!
versionFrom: aVersionReferenceString
"until we no longer find .tree directories in the wild"
(self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ])
select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ]
thenCollect: [ :packageDirectory |
(self versionInfoForPackageDirectory: packageDirectory) name = aVersionReferenceString
ifTrue: [ ^ self loadVersionFromFileNamed: (self fileUtils directoryName: packageDirectory) ] ].
^ nil
!
versionFromFileNamed: aString
^ self loadVersionFromFileNamed: aString
!
versionInfoFromFileNamed: aString
^ self loadVersionInfoFromFileNamed: aString
!
versionNameFromFileName: aString
| description |
description := self packageDescriptionFromPackageDirectory: (self fileDirectoryOn: aString).
^ description first , '-' , description second , '.' , description third printString
! !
!MCFileTreeRepository methodsFor:'actions'!
fileDirectoryOn: directoryPath
^ self fileUtils directoryFromPath: directoryPath relativeTo: self directory
!
packageDescriptionFromPackageDirectory: packageDirectory
| filename info extension |
filename := self fileUtils current directoryName: packageDirectory.
extension := filename copyFrom: (filename lastIndexOf: $.) to: filename size.
^ ((self packageExtension ~= '.package'
and: [
(self fileUtils filePathExists: 'version' relativeTo: packageDirectory)
and: [ self fileUtils filePathExists: 'package' relativeTo: packageDirectory ] ])
or: [
| dir |
dir := self fileUtils
directoryFromPath: MCFileTreeStCypressWriter monticelloMetaDirName
relativeTo: packageDirectory.
self fileUtils directoryExists: dir ])
ifTrue: [
info := self versionInfoForPackageDirectory: packageDirectory.
self parseName: info name extension: extension ]
ifFalse: [
{(filename copyFrom: 1 to: (filename lastIndexOf: $.) - 1).
'cypress'.
1.
filename} ]
!
packageDescriptionsFromReadableFileNames
^ ((self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ])
select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ])
collect: [ :packageDirectory | self packageDescriptionFromPackageDirectory: packageDirectory ]
!
versionInfoForPackageDirectory: packageDirectory
^ ((MCReader readerClassForFileNamed: (self fileUtils directoryName: packageDirectory))
on: (self fileUtils parentDirectoryOf: packageDirectory)
fileName: (self fileUtils directoryName: packageDirectory))
loadVersionInfo;
info
! !
!MCFileTreeRepository methodsFor:'caching'!
cachedFileNames
^ #()
! !
!MCFileTreeRepository methodsFor:'descriptions'!
description
^ self class description , super description
! !
!MCFileTreeRepository methodsFor:'i/o'!
readStreamForFileNamed: aString do: aBlock
^ aBlock value: self directory
!
writeStreamForFileNamed: aString replace: aBoolean do: aBlock
self error: 'we do not open a single stream, but write multiple files'
! !
!MCFileTreeRepository methodsFor:'interface'!
versionWithInfo: aVersionInfo ifAbsent: errorBlock
(self allFileNamesForVersionNamed: aVersionInfo name)
ifNotEmpty: [ :aCollection | ^ self versionFromFileNamed: aCollection first ].
^ errorBlock value
! !
!MCFileTreeRepository methodsFor:'private'!
flushCache
"force properties to be reread ... if the directory exists, otherwise let nature
take it's course"
super flushCache.
directory
ifNotNil: [
(MCFileTreeFileUtils current directoryExists: directory)
ifTrue: [
repositoryProperties := nil.
self repositoryProperties ] ]
!
packageExtension
^ self repositoryProperties
at: 'packageExtension'
ifAbsent: [ self class defaultPackageExtension ]
!
parseName: aString extension: extension
^ self class parseName: aString extension: extension
!
propertyFileExtension
^ self repositoryProperties
at: 'propertyFileExtension'
ifAbsent: [ self class defaultPropertyFileExtension ]
!
propertyFileExtension: propertyFileExtension
self class validatePropertyFileExtension: propertyFileExtension.
self repositoryProperties
at: 'propertyFileExtension'
put: propertyFileExtension.
self writeRepositoryProperties
! !
!MCFileTreeRepository methodsFor:'storing'!
basicStoreVersion: aVersion
self readonly
ifTrue: [
^ self
error:
'The filetree repository: ' , self description printString
, ' was created read only.' ].
MCFileTreeWriter fileOut: aVersion on: self
! !
!MCFileTreeRepository methodsFor:'testing'!
canReadFileNamed: aString
^ (aString endsWith: self packageExtension)
or: [
(aString endsWith: '.tree')
or: [
"Cypress format"
aString endsWith: '.package' ] ]
!
writeRepositoryProperties
self fileUtils
writeStreamFor: '.filetree'
in: self directory
do: [ :fileStream |
| keyCount propertyCount |
repositoryProperties
ifNil: [ repositoryProperties := self defaultRepositoryProperties ].
keyCount := repositoryProperties size.
propertyCount := 0.
fileStream lineEndConvention: #'lf'.
fileStream nextPutAll: '{'.
repositoryProperties
keysAndValuesDo: [ :propertyName :propertyValue |
propertyCount := propertyCount + 1.
fileStream
nextPut: $";
nextPutAll: propertyName asString;
nextPutAll: '" : "';
nextPutAll: propertyValue asString;
nextPut: $";
yourself.
propertyCount < keyCount
ifTrue: [
fileStream
nextPutAll: ',';
cr ] ].
fileStream nextPutAll: ' }' ]
! !
!MCFileTreeRepository class methodsFor:'documentation'!
version_CVS
^ '$Header$'
! !