"{ 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)}

!

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"

  (MetacelloPlatform current gitBranchNameFor: self directory fullName)

    ifNotNil: [ :sha | ^ sha ].

  ^ super repositoryBranchName

!

repositoryDescription

  ^ self description , ' [' , self repositoryVersionString , ':'

    , self repositoryBranchName , ']'

!

repositoryVersionString

  "extract a version string from the repository ... if possible"

  (MetacelloPlatform current gitCommitShaFor: self directory fullName)

    ifNotNil: [ :sha | ^ sha ].

  ^ super repositoryVersionString

! !

!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

  repositoryProperties

    ifNil: [ 

      repositoryProperties := Dictionary new.

      (self fileUtils directoryExists: directory)

        ifFalse: [ 

          self

            error:

              'filetree:// repository '

                ,

                  (self fileUtils directoryPathString: self directory) printString

                , ' does not exist.' ].

      (self directory entries

        detect: [ :entry | entry name = '.filetree' ]

        ifNone: [  ])

        ifNil: [ 

          repositoryProperties := self defaultRepositoryProperties.

          self writeRepositoryProperties ]

        ifNotNil: [ :configEntry | 

          configEntry

            readStreamDo: [ :fileStream | repositoryProperties := MCFileTreeJsonParser parseStream: fileStream ] ] ].

  ^ repositoryProperties

!

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$'

! !