"
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' }"

"{ NameSpace: Smalltalk }"

Object subclass:#HG2CVS
	instanceVariableNames:'srcRoot dstRoot script'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Mercurial-CVS'
!

!HG2CVS 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
"
!

documentation
"
    A simple and naive tool to update CVS to match the Mercurial repository.
    Yes, believe or not, there are still CVS repositories out there,

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

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!HG2CVS methodsFor:'accessing'!

dstRoot
    ^ dstRoot
!

dstRoot:something
    dstRoot := something.
!

srcRoot
    ^ srcRoot
!

srcRoot:something
    srcRoot := something.
! !

!HG2CVS methodsFor:'updating'!

add: file
    self cvs: 'add' files: { file } in: file directory.
    file isDirectory ifTrue:[
        |  files dirs |

        files := OrderedCollection new.
        dirs := OrderedCollection new.
        file directoryContentsAsFilenamesDo:[:e|
            (self shouldIgnore: e baseName) ifFalse:[
               e isDirectory ifTrue:[
                   dirs add: e
                ] ifFalse:[
                    files add: e.
                ]
            ]
        ].
        self cvs: 'add' files: files in: file.
        dirs do:[:e|self add: e].


    ].

    "Created: / 15-02-2013 / 11:04:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-02-2013 / 18:33:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cvs: cmd files: files in: wd
    | filesAsString cmdLine |


    files isEmpty ifTrue:[ ^ self ].

    filesAsString := String streamContents:[:s|
        files do:[:e|
            s nextPut: $'; nextPutAll: e baseName; nextPut: $'; space.
        ]
    ].
    cmdLine := ('cvs ', cmd ,' ', filesAsString).
    Transcript showCR: '  --> exec: ', cmdLine.


    script := 
        script , Character cr ,
        ('pushd %1
%2
popd') bindWith: wd asString with: cmdLine.

    "Created: / 15-02-2013 / 12:27:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 06-09-2013 / 00:52:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remove: file

    file isDirectory ifTrue:[
        file directoryContentsAsFilenamesDo:[:e|
            (self shouldIgnore: e baseName) ifFalse:[
               self remove: e
            ].
        ]
    ].
    file isDirectory ifFalse:[
        file remove.
    ].
    self cvs: 'remove' files: { file } in: file directory.

    "Created: / 15-02-2013 / 11:04:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-02-2013 / 18:33:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

shouldIgnore: basename
    ^ #('.cvsignore' 'CVS' '.svn' '.hg' 'thesis') includes: basename

    "Created: / 15-02-2013 / 11:30:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

update

    script := ''.
    self update: srcRoot to: dstRoot.
    script := script , Character cr , 'cvs commit'.

    (dstRoot asFilename / 'commit.sh') writingFileDo:[:s|
        s nextPutAll: script.
        s cr.
    ].

    "Created: / 15-02-2013 / 11:05:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 06-09-2013 / 00:50:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

update: src to: dst
    | srcFiles dstFiles additions removals common additionsF additionsD |

    srcFiles := src directoryContents reject:[:e|self shouldIgnore: e].
    dstFiles := dst directoryContents reject:[:e|self shouldIgnore: e].
    removals := dstFiles \ srcFiles.
    additions := srcFiles \ dstFiles.
    common := srcFiles intersect:dstFiles.


    Transcript showCR: ' ==== ' , dst pathName , ' ===='.
    removals do:[:e|
       Transcript showCR:' Removing ', e.
       self remove: dst / e.
    ].

    additionsF := OrderedCollection new.
    additionsD := OrderedCollection new.
    additions do:[:e|
        | srcF dstF |

        Transcript showCR:' Adding ', e.
        srcF := src / e.
        dstF := dst / e.
        srcF recursiveCopyTo:dstF.
        srcF isDirectory ifTrue:[
            additionsD add: dstF
        ] ifFalse:[
            additionsF add: dstF
        ].
    ].
    additionsD do:[:e|self add:e].
    self cvs: 'add' files: additionsF in: dst.



    common do:[:e|
        | srcF dstF |
        srcF := src / e.
        dstF := dst / e.

        Transcript showCR:' Updating ', e.

        srcF isDirectory ifTrue:[
            self assert: dstF isDirectory.
            self update: srcF to: dstF
        ] ifFalse:[
            srcF copyTo: dstF.
        ]
    ].
    Transcript showCR: ' ==== ===='.

    "Created: / 15-02-2013 / 11:03:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-02-2013 / 18:45:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HG2CVS class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

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