"
 COPYRIGHT (c) 2012-2013 by Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libscm/mercurial' }"

Object subclass:#HGRepository
	instanceVariableNames:'uuid path wc changesets branches heads config lock server'
	classVariableNames:'Cache UseCommandServer'
	poolDictionaries:''
	category:'SCM-Mercurial-Core'
!

HGRepositoryObject subclass:#Changesets
	instanceVariableNames:'changesets revno2nodeIdMap'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGRepository
!

!HGRepository class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2012-2013 by Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
! !

!HGRepository class methodsFor:'initialization'!

flush
    "Flush all cached repositories"

    Cache := CacheDictionary new: 8

    "Created: / 25-01-2013 / 18:58:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    Cache := CacheDictionary new: 8.
    UseCommandServer := true.

    "Modified: / 03-03-2013 / 22:57:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'instance creation'!

on: aStringOrFilename
    ^self on: aStringOrFilename cached: false

    "Created: / 17-10-2012 / 13:30:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-12-2012 / 12:59:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

on: aStringOrFilename cached: cache
    | path |

    path := aStringOrFilename asFilename.
    ^cache ifTrue:[
        Cache at: path ifAbsentPut:[self new initializeOn: path]
    ] ifFalse:[
        self new initializeOn: path
    ]

    "Created: / 16-12-2012 / 12:58:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'cloning'!

clone: aFilenameOrUrlOrString to: aStringOrFilename
    "Clones repository at given URL to given directory.
     Returns an instance HGRepository representing the clone."

    ^self clone: aFilenameOrUrlOrString to: aStringOrFilename update: true

    "Created: / 14-11-2012 / 22:46:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-11-2012 / 00:20:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

clone: aFilenameOrUrlOrString to: aStringOrFilename update: update
    "Clones repository at given URL to given directory.
     Returns an instance HGRepository representing the clone."

    | url dst dir |

    url := aFilenameOrUrlOrString asString.
    dst := aStringOrFilename asFilename.

    dst exists ifTrue:[
        HGError raiseErrorString: 'Cannot clone to existsing directory!!'.
        ^nil
    ].
    dir := dst directory.
    dir exists ifFalse:[
        HGError raiseErrorString: 'Directory for clone does not exist!!'.
        ^nil
    ].
    dir isWritable ifFalse:[
        HGError raiseErrorString: 'Cannot clone into write-protected directory'.
        ^nil
    ].

    HGCommand clone
        url: url;
        path: dst pathName;
        update: update;
        execute.
    ^HGRepository on: dst.

    "Created: / 21-11-2012 / 00:20:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'utilities'!

discover: aStringOrFilename
    "Find a Mercurial repository in given directory or super-directories
     and return it (as an instance of Filename). If no repository is found, 
     returns nil.

     Currently, it searches for presence of .hg directory"

    | f |
    f := aStringOrFilename.
    f isDirectory ifFalse:[
        f := f directory
    ].
    [ ( f / '.hg' ) exists ] whileFalse:[
        f isRootDirectory ifTrue:[ ^nil ].
        f := f directory.
    ].
    ^f

    "Created: / 13-11-2012 / 22:34:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 14-11-2012 / 00:02:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'accessing'!

branches
    "Returns a list of named branches in the repository,
     including closed ones"

    branches isNil ifTrue:[
        branches := HGCachedFileData
                        on: ((Filename named: self pathName) / '.hg' / 'store' / '00changelog.i')
                        reader:[:old |
                            | rbranches current names |
                            rbranches := old.
                            current := self execute:
                                        (HGCommand branches
                                            workingDirectory: path pathName;
                                            active: false;
                                            closed: true;
                                            yourself).
                            names := rbranches collect:[:b|b name].
                            current := current reject:[:b|names includes: b name].
                            current do:[:b|b setRepository: self].
                            rbranches addAll: current.
                            rbranches isEmpty ifTrue:[
                                rbranches add: (HGBranch new setName: 'default'; setRepository: self).
                            ].
                            rbranches.
                        ].
        branches setData: OrderedCollection new.
    ].
    ^branches value

    "Created: / 27-11-2012 / 19:57:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2013 / 22:52:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

config
    ^config

    "Created: / 06-12-2012 / 21:40:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

heads
    "Returns a list of heads (as HGChangeset)"

    heads isNil ifTrue:[
        heads := HGCachedFileData
                        on: ((Filename named: self pathName) / '.hg' / 'store' / '00changelog.i')
                        reader:[
                            | ids |

                            ids := self execute: HGCommand heads.
                            ids collect:[:id|self changesetWithId: id].
                        ].                                
    ].
    ^heads value.

    "Created: / 27-11-2012 / 21:33:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2013 / 22:53:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

path
    "Return path to the repository (directory with .hg store)"
    ^ path

    "Modified (comment): / 13-11-2012 / 18:18:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

pathName
    "Return path to the repository (directory with .hg store)"
    ^ path pathName

    "Created: / 16-11-2012 / 22:36:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remoteDefault
    "Return default remote (upstream) repository or nil if none"

    ^self remotes detect:[:e|e isDefault] ifNone:[nil]

    "Created: / 10-12-2012 / 01:26:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remotes
    "Returns a collection of configured remote (upstream) repositories"

    | paths remotes |

    paths := self config get: #paths default: nil.
    paths isNil ifTrue:[ ^ #() ].
    paths isEmpty ifTrue:[ ^ #() ].
    remotes := OrderedCollection new.
    paths keysAndValuesDo:[:name :url|
        remotes add: (HGRemote new setRepository: self; setName: name url:url value).
    ].
    ^remotes

    "Created: / 09-12-2012 / 22:51:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

uuid
    "Returns unique ID identifing this concrete instance
     of a repository"

    ^ uuid

    "Modified (comment): / 14-11-2012 / 23:22:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

workingCopy
    wc isNil ifTrue:[
	wc := HGWorkingCopy new setRepository: self.
    ].
    ^wc

    "Created: / 19-10-2012 / 15:42:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'accessing-changesets'!

@ id
    ^self changesetWithId: id.

    "Created: / 16-11-2012 / 20:29:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

changesetWithId: id
    ^changesets changesetWithId: id

    "Created: / 13-11-2012 / 17:58:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'accessing-private'!

branchWithName: name 
    "Returns branch with given name. If there is no such branch,
     an exception is raised"

    ^self branchWithName: name ifAbsent:[
        HGNoSuchBranchError newException
            parameter: name;
            messageText: 'No such branch: ', name;
            raiseSignal
    ]

    "Created: / 27-11-2012 / 13:55:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

branchWithName: name createIfAbsent: create

    ^self branchWithName: name ifAbsent:[
        | b |
        b := HGBranch new setRepository: self.
        b setName: name.
        branches value add: b.
        b
    ]

    "Created: / 10-12-2012 / 03:14:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-02-2013 / 13:39:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

branchWithName: name ifAbsent: block

    ^self branches detect:[:b|b name = name] ifNone: block

    "Created: / 27-11-2012 / 14:31:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

changesetWithId: id into: cs
    ^changesets load: id into: cs

    "Created: / 16-12-2012 / 01:26:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 22-01-2013 / 20:56:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

lock
    ^lock

    "Created: / 16-12-2012 / 00:39:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'initialize & release'!

finalize
    server notNil ifTrue:[ server stop ].

    "Created: / 03-03-2013 / 23:15:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializeOn: aStringOrFilename
    | p |

    p := aStringOrFilename asFilename.
    p exists ifFalse:[
        HGRepositoryError raiseSignal: 'Given path does not exists'.
        ^nil.
    ].
    p isDirectory ifFalse:[
        HGRepositoryError raiseSignal: 'Given path is not a directory'.
        ^nil.
    ].
    (p / '.hg') isDirectory ifFalse:[
        HGRepositoryError raiseSignal: 'Given path does not contain a repository (.hg subdir not found - try use #lookup:)'.
        ^nil.
    ].
    path := p.
    changesets := HGRepository::Changesets new setRepository: self.
    uuid := UUID new.
    config := HGConfig new setRepository: self.
    lock := RecursionLock new.

    "Created: / 17-10-2012 / 13:35:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 25-01-2013 / 18:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'operations'!

cloneTo: aStringOrFilename
    "Creates a clone of the receiver into given directory.
     Returns an instance HGRepository representing the clone."

    ^self class clone: path to: aStringOrFilename

    "Created: / 14-11-2012 / 22:43:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cloneTo: aStringOrFilename update: update
    "Creates a clone of the receiver into given directory.
     Returns an instance HGRepository representing the clone.
     If update is true, repository working copy is updated, otherwise
     it's left empty"

    ^self class clone: path to: aStringOrFilename update: update

    "Created: / 21-11-2012 / 00:21:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

execute: anHGCommand
    ^UseCommandServer ifTrue:[
        server isNil ifTrue:[
            server := HGCommandServer new repository: self.
            server start.
            self registerForFinalization.
        ].
        server execute: anHGCommand
    ] ifFalse:[
        anHGCommand execute
    ]

    "Created: / 03-03-2013 / 22:52:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

pull
    "Pulls changesets from default upstream repository.
     See .hg/hgrc, section path"

    ^self pull: nil

    "Created: / 15-11-2012 / 10:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 04-02-2013 / 15:31:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

pull: remote
    "Push changesets to given remote repository. 'remote' can be either 
     an instance HGRemote, an instance of URL or a String (remote alias). 
     If 'remote' nil, default upstream repository is used, ' 

    See .hg/hgrc, section for configured aliases"

    ^self execute: 
        (HGCommand pull
            url: (remote ? 'default') asString;
            yourself)

    "Created: / 04-02-2013 / 15:30:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2013 / 22:53:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

push
    "Pushes changesets to default upstream repository.
     See .hg/hgrc, section path"

    ^self push: nil force: false

    "Created: / 15-11-2012 / 09:59:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-11-2012 / 21:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

push: remote
    "Push changesets to given remote repository. 'remote' can be either 
     an instance HGRemote, an instance of URL or a String (remote alias). 
     If 'remote' nil, default upstream repository is used, ' 

    See .hg/hgrc, section for configured aliases"

    ^self push: remote force: false

    "Created: / 15-11-2012 / 10:00:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-11-2012 / 21:59:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 04-02-2013 / 15:31:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

push: remote force: force
    "Push changesets to given remote repository. 'remote' can be either 
     an instance HGRemote, an instance of URL or a String (remote alias)'  
     If force is true, push is forced (allowing creation
     of new heads in remote repo),

     See .hg/hgrc, section path"

    ^self execute:
        (HGCommand push
            workingDirectory: path pathName;
            url: (remote ? 'default') asString;
            force: force;
            yourself)

    "Created: / 27-11-2012 / 21:58:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2013 / 22:54:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository methodsFor:'synchronized evaluation'!

synchronizationSemaphore
    ^lock

    "Created: / 16-12-2012 / 00:40:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

synchronizationSemaphore: aRecursionLock
    lock := aRecursionLock

    "Created: / 16-12-2012 / 00:40:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository::Changesets class methodsFor:'documentation'!

documentation
"
    A simple object to maintain and load changesets metadata lazily.

    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!HGRepository::Changesets class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
! !

!HGRepository::Changesets methodsFor:'accessing'!

changesetWithId: idobj
    | id xid cs |

    id := idobj asHGChangesetId.    
    "/Try to translate it...
    id hasRevnoOnly ifTrue:[
        xid := revno2nodeIdMap at: id revno ifAbsent:[nil].
    ].
    xid := xid ? id.


    "/Look in cache using xlated id...
    cs := changesets at: xid ifAbsent:[ nil ].
    cs notNil ifTrue: [ ^ cs ].

    self synchronized:[
        "/Look in cache using xlated id...
        cs := changesets at: xid ifAbsent:[ nil ].
        cs notNil ifTrue: [ ^ cs ].

        cs := (xid isFull and:[xid hasRevno]) ifTrue:[
                    "/Full id, can make it lazy
                    HGChangeset new setId: xid; setRepository: repository
                ] ifFalse:[
                    "/Short id, we have to load it
                    self load: xid into: nil
                ].

        self assert: cs id isFull.
        self assert: cs id hasRevno.
        changesets at: cs id put: cs.
        revno2nodeIdMap  at: cs id revno put: cs id.
    ].
    ^cs .

    "Created: / 13-11-2012 / 17:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 22-01-2013 / 22:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository::Changesets methodsFor:'initialization'!

initialize
    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)
    changesets := Dictionary new.
    revno2nodeIdMap := Dictionary new.

    "/ super initialize.   -- commented since inherited method does nothing

    "Modified: / 16-11-2012 / 21:58:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository::Changesets methodsFor:'private'!

load: id into: changesetOrNil
    "Load all data for changeset with given id.
     If changesetOrNil is not nil, then update given
     changeset.

     Return changeset with filled data, i.e,, changeset is
     non-lazy"

     | csets cs |
     csets := self repository execute:
                    (HGCommand log
                        workingDirectory: repository path asString;
                        revsets: (self loadRevsetsForLoad: id);
                        yourself).
     "/just to be defensive...
     csets do:[:each| 
        | existing |

        each setRepository: repository.
        existing := changesets at: each id ifAbsentPut:[each].
        existing ~~ each ifTrue:[
            existing setSlotsFrom: each.
            existing setNonLazy.
            self assert: existing id isShort not.
            self assert: existing id revno notNil.
            self assert: existing loaded.
        ].
        existing id = id ifTrue:[
            cs := existing
        ].
    ].
    self assert: cs notNil.
    ^cs

    "Created: / 16-12-2012 / 00:57:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2013 / 22:58:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

loadRevsetsForLoad: id
    | revsets ids start stop addId |

    revsets := OrderedCollection new.
    ids := changesets keys asOrderedCollection sort: [:a :b|a revno > b revno].
    addId := true.
    ids do:[:each| | cs |        
        cs := changesets at: each.
        cs loaded ifFalse:[
            start isNil ifTrue:[
                start := stop := each.
                each = id ifTrue:[
                    addId := false
                ].
            ] ifFalse:[
                each revno < (start revno - 20) ifTrue:[
                    revsets add: (start revno printString , ':' , (start revno - 20) printString).
                    start := each.
                ] ifFalse:[
                    each = id ifTrue:[
                        addId := false
                    ].
                    stop := each.
                ].
            ]
        ] ifTrue:[
            start notNil ifTrue:[
                start ~~ stop ifTrue:[
                    revsets add: (start revno printString , ':' , stop revno printString).
                ] ifFalse:[
                    revsets add: start revno printString
                ].
            ].
            start := stop := nil.
        ]
    ].
    start notNil ifTrue:[
        start ~~ stop ifTrue:[
            revsets add: (start revno printString , ':' , stop revno printString).
        ] ifFalse:[
            revsets add: start revno printString
        ].
    ].
    (addId or:[revsets isEmpty]) ifTrue:[revsets add: id printString].
    ^revsets

    "Created: / 22-01-2013 / 16:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 22-01-2013 / 22:22:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '§Id::                                                                                                                        §'
! !


HGRepository initialize!