MCFileTreeRepository.st
author Claus Gittinger <cg@exept.de>
Sat, 01 Sep 2018 17:35:45 +0200
changeset 1094 55a945c18a3e
parent 1085 f86ba472fa45
permissions -rw-r--r--
#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$'
! !