"

 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: / 04-03-2013 / 09:41:30 / 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'!

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.

        ].

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