"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License. 

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
"
"{ Package: 'stx:libscm/mercurial' }"

SCMAbstractPackageRevision subclass:#HGPackageRevision
	instanceVariableNames:'changeset changesetRoot'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Mercurial-StX'
!

!HGPackageRevision class methodsFor:'documentation'!

copyright
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License. 

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
"
! !

!HGPackageRevision class methodsFor:'instance creation'!

changeset:anHGChangeset root:anHGChangesetFile 
    "Creates a new HGPackageRevision for given changeset and changeset file
     (assuming that changeset file is root of the package). 

     Raises an HGError when repositoru doesn't contain a Smalltalk/X package."

    ^ self new setChangeset: anHGChangeset root: anHGChangesetFile.

    "Created: / 06-03-2014 / 09:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-03-2014 / 10:35:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

changeset:anHGChangeset root:anHGChangesetFile name: aString
    "Creates a new HGPackageRevision for given changeset,  root and name.
     (assuming that changeset file is root of the package). 

     Raises an HGError when root doesn't contain a Smalltalk/X package."

    ^ self new setChangeset: anHGChangeset root: anHGChangesetFile name: aString

    "Created: / 07-03-2014 / 12:52:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGPackageRevision methodsFor:'accessing'!

revision
    "Return a logical revision package model"

    ^ changeset id

    "Created: / 05-03-2014 / 23:45:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGPackageRevision methodsFor:'accessing-containers'!

containerFor: aString ifAbsent: aBlock
    "Return a container as Filename with given name. If there's no such
     container, evaluates a block"            

    ^ (changesetRoot children includesKey: aString)   
        ifTrue:[ changesetRoot / aString ]
        ifFalse:[ aBlock value ]

    "Created: / 14-03-2014 / 22:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGPackageRevision methodsFor:'accessing-hierarchy'!

children
    children isNil ifTrue:[ 
        children := Dictionary new.
        changesetRoot children do:[:each | 
            each isDirectory ifTrue:[ 
                | childPackageName child |

                childPackageName := (name includes: $:) 
                        ifTrue:[ name , '/' , each baseName ] 
                        ifFalse:[ name , ':' , each baseName ].
                [ 
                    child := self class changeset: changeset root: each name: childPackageName.
                    child setParent: self.
                    children at: each baseName put: child.
                ] on: HGError do:[:ex | 
                    "/ OK, directory does not contain a package...
                ].
            ].
        ].
    ].
    ^ children values

    "Created: / 07-03-2014 / 12:47:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-03-2014 / 14:24:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGPackageRevision methodsFor:'initialization'!

setChangeset: anHGChangeset root: anHGChangesetFile
    "Initializes a package rev for given changeset and root.
     Raises an exception, if given root does not contain
     a Smalltalk/X package"

    | make_spec |

    "/ Look for Make.spec and extract package name from there
    "/ Hmm...stupid, / raises an error when file does not exist.
    "/ Maybe I should change it...
    [
        make_spec := anHGChangesetFile / 'Make.spec'
    ] on: HGError do:[
        make_spec := nil.
    ].
    make_spec notNil ifTrue:[ 
        | module module_dir |
        make_spec readingLinesDo:[:line|
            (line startsWith:'MODULE_DIR=') ifTrue:[ 
                module_dir := line copyFrom: "'MODULE_DIR=' size"11 + 1.
            ] ifFalse:[ 
                (line startsWith:'MODULE=') ifTrue:[ 
                    module := line copyFrom: "'MODULE=' size"7 + 1.
                ]            
            ].
        ].
        (module notNil and:[ module_dir notNil ]) ifTrue:[            
            self setChangeset: anHGChangeset root: anHGChangesetFile name: (module , ':' , module_dir) virtual: false.
            ^ self.
        ].
    ].

    "/ Make.spec not found or failed to extract packagename from there.
    "/ Maybe this is a virtual package container such as stx:libscm.
    "/ Search directories, if any package is found there, derive my name
    "/ child's name.
    children := Dictionary new.
    anHGChangesetFile children do:[:each | 
        each isDirectory ifTrue:[ 
            | child |

            [ 
                child := self class changeset: anHGChangeset root: each.
                child setParent: self.
                children at: each baseName put: child.
            ] on: HGError do:[:ex | 
                "/ OK, directory does not contain a package...
            ].
        ].
    ].
    children notEmpty ifTrue:[ 
        | myName |

        myName := children anElement name asPackageId parentPackage asString.
        self setChangeset: anHGChangeset root: anHGChangesetFile name: myName virtual: true.
        ^ self.
    ].

    "/ None of my subdirectories is a valid Smalltalk/X package,
    "/ so not I'am.
    HGError raise.

    "Created: / 07-03-2014 / 10:38:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 10:06:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setChangeset: anHGChangeset root: anHGChangesetFile name: aString
    "Initializes a package rev with given changeset and root and name."

    | v |

    [
        anHGChangesetFile / 'Make.spec'.
        anHGChangesetFile / ((ProjectDefinition initialClassNameForDefinitionOf: aString) , '.' , SmalltalkLanguage instance sourceFileSuffix).
        v := false
    ] on: HGError do:[
        v := true.
    ].
    self setChangeset: anHGChangeset root: anHGChangesetFile name: aString virtual: v.

    "Created: / 07-03-2014 / 23:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setChangeset: anHGChangeset root: anHGChangesetFile name: aString virtual: aBoolean
    "Initializes a package rev with given changeset and root and name."



    name := aString.
    changeset := anHGChangeset.
    changesetRoot := anHGChangesetFile.
    repository := anHGChangeset repository.
    repositoryRoot := anHGChangesetFile pathName.
    virtual := aBoolean. 

    virtual ifFalse:[
        "/ Check, whether the project definition class really exists
        [ 
            anHGChangesetFile / ((ProjectDefinition initialClassNameForDefinitionOf: aString) , '.' , SmalltalkLanguage instance sourceFileSuffix)
        ] on: HGError do:[ 
            ^ HGError newException
                parameter: (Array with: anHGChangeset with: anHGChangesetFile with: aString);
                messageText: ('No project definition class found for %1' bindWith: aString);
                raise.
        ].
    ].

    "Created: / 07-03-2014 / 23:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-03-2014 / 10:06:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !