"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      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.

"

Object subclass:#AbstractSourceCodeManager

	instanceVariableNames:''

	classVariableNames:'DefaultManager CachingSources CacheDirectoryName UseWorkTree

		WorkTreeDirectoryName'

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

!AbstractSourceCodeManager class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 by Claus Gittinger

	      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.

"

!

documentation

"

    Abstract superclass for sourceCodeManagers.

    Concrete subclasses provide access to a source repository.

    All protocol here traps into subclassResponsbility errors.

    Please read more documentation in concrete subclasses 

    (especially: CVSSourceCodeManager) for how to use this manager.

    [author:]

        Claus Gittinger

"

! !

!AbstractSourceCodeManager class methodsFor:'initialization'!

initCacheDirPath

    "initialize the name of the cacheDirectory.

     This is one of:

          STX_TMPPATH/stx_sourceCache

          TMPPATH/stx_sourceCache

          TMPDIR/stx_sourceCache

          /tmp/stx_sourceCache.

     whichever variable is first found to be nonEmpty."

    |path|

    path := OperatingSystem getEnvironment:'STX_TMPPATH'.

    path isNil ifTrue:[

        path := OperatingSystem getEnvironment:'TMPPATH'.

        path isNil ifTrue:[

            path := OperatingSystem getEnvironment:'TMPDIR'.

            path isNil ifTrue:[

                path := '/tmp'

            ]

        ]

    ].

    CacheDirectoryName := path , '/stx_sourceCache'.

    "Modified: 12.9.1996 / 02:27:48 / cg"

!

initialize

    "setup for no caching and no workTree"

    CachingSources := UseWorkTree := false.

    CacheDirectoryName := WorkTreeDirectoryName := ''.

    "Created: 16.12.1995 / 15:41:00 / cg"

    "Modified: 12.9.1996 / 02:28:11 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'accessing'!

cacheDirectoryName

    "return the name of the cache directory, where checked out class

     sources are kept for faster access. The default is '/tmp/stx_sourceCache'.

     This cache is shared among all ST/X users on a system."

    ^ CacheDirectoryName

    "Modified: 12.9.1996 / 02:20:45 / cg"

!

cacheDirectoryName:aStringOrFilename

    "set the name of the cache directory, where checked out class

     sources are kept for faster access. The default is '/tmp/stx_sourceCache'.

     This cache is shared among all ST/X users on a system.

     The directory is typically set via the launchers setting menu, or

     from a startup rc-file."

    CacheDirectoryName := aStringOrFilename

    "Created: 16.12.1995 / 15:18:43 / cg"

    "Modified: 12.9.1996 / 02:21:35 / cg"

!

cachingSources

    "return true, if source caching is enabled.

     (see cacheDirectoryName for what that means)"

    ^ CachingSources

    "Created: 16.12.1995 / 15:17:50 / cg"

    "Modified: 12.9.1996 / 02:22:19 / cg"

!

cachingSources:aBoolean

    "enable/disable the caching of source files.

     (see cacheDirectoryName for what that means)"

    CachingSources := aBoolean

    "Created: 16.12.1995 / 15:18:13 / cg"

    "Modified: 12.9.1996 / 02:22:42 / cg"

!

defaultManager

    "return the default sourceCodeManager class"

    ^ DefaultManager

    "Created: 7.12.1995 / 17:14:22 / cg"

    "Modified: 12.9.1996 / 02:22:56 / cg"

!

repositoryName

    "return the name of the repository.

     Since this is an abstract class, return nil (i.e. none)"

    ^ nil

    "Modified: 12.9.1996 / 02:20:45 / cg"

    "Created: 14.9.1996 / 13:21:37 / cg"

!

useWorkTree

    "return the setting of useWorkTree, which (eventually)

     controls if an up-to-date view of a CVS working tree should be

     kept in sync. This is not yet implemented."

    ^ UseWorkTree

    "Created: 16.12.1995 / 15:36:48 / cg"

    "Modified: 12.9.1996 / 02:24:01 / cg"

!

useWorkTree:aBoolean

    "enable/disable the useWorkTree feature, which (eventually)

     controls if an up-to-date view of a CVS working tree should be

     kept in sync. This is not yet implemented."

    UseWorkTree := aBoolean

    "Created: 16.12.1995 / 15:37:29 / cg"

    "Modified: 12.9.1996 / 02:24:38 / cg"

!

workTreeDirectoryName

    "return the name of the workTree, which is kept in sync

     with the current class versions. This is not yet implemented"

    ^ WorkTreeDirectoryName

    "Created: 16.12.1995 / 15:35:21 / cg"

    "Modified: 12.9.1996 / 02:25:13 / cg"

!

workTreeDirectoryName:aStringOrFilename

    "set the name of the workTree, which is kept in sync

     with the current class versions. This is not yet implemented"

    WorkTreeDirectoryName := aStringOrFilename

    "Created: 16.12.1995 / 15:35:34 / cg"

    "Modified: 12.9.1996 / 02:25:19 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'private'!

containerFromSourceInfo:info

    "given a sourceInfo, return the classes container"

    (info includesKey:#fileName) ifTrue:[

        ^ info at:#fileName

    ].

    (info includesKey:#expectedFileName) ifTrue:[

        ^ info at:#expectedFileName

    ].

    ^ (info at:#classFileNameBase) , '.st'

    "Modified: 12.9.1996 / 02:31:52 / cg"

!

directoryFromContainerPath:containerPath

    "given a full path as in an RCS header, extract the directory (i.e. package)."

    |path idx|

    path := self pathInRepositoryFrom:containerPath.

    path notNil ifTrue:[

        idx := path indexOf:(Filename separator).

        idx ~~ 0 ifTrue:[

            path := path copyFrom:(idx + 1)

        ].

        ^ path asFilename directoryName

    ].

    ^ nil

    "

     SourceCodeManager directoryFromContainerPath:'/files/CVS/stx/libbasic/Array.st'

    "

    "Created: 25.11.1995 / 18:42:20 / cg"

    "Modified: 13.12.1995 / 13:06:15 / cg"

!

filenameFromContainerPath:containerPath

    "given some path as present in an RCS Header string, extract the containers

     name.

     OBSOLETE - this is no longer used."

    |top rest|

    containerPath notNil ifTrue:[

        top := self repositoryTopDirectory.

        top notNil ifTrue:[

            (containerPath startsWith:(top , '/')) ifTrue:[

                rest := containerPath copyFrom:(top size + 2).

                ^ rest asFilename baseName

            ].

            (containerPath startsWith:(top)) ifTrue:[

                rest := containerPath copyFrom:(top size + 1).

                ^ rest asFilename baseName

            ]

        ]

    ].

    ^ containerPath

    "Created: 25.11.1995 / 18:42:34 / cg"

    "Modified: 11.11.1996 / 16:04:39 / cg"

!

moduleFromContainerPath:containerPath

    "given a full path as in an RCS header, extract the module."

    |path idx|

    path := self pathInRepositoryFrom:containerPath.

    path notNil ifTrue:[

        idx := path indexOf:(Filename separator).

        idx == 0 ifTrue:[^ path].

        ^ path copyTo:(idx - 1)

    ].

    ^ nil

    "

     SourceCodeManager moduleFromContainerPath:'/files/CVS/stx/libbasic/Array.st'

    "

    "Created: 25.11.1995 / 18:42:20 / cg"

    "Modified: 13.12.1995 / 13:06:03 / cg"

!

moduleFromSourceInfo:info

    "given a sourceInfo, return the classes module directory"

    ^ info at:#module.  "/ use the modules name as CVS module

    "Created: 6.2.1996 / 17:26:38 / cg"

    "Modified: 12.9.1996 / 02:32:23 / cg"

!

packageFromSourceInfo:info

    "given a sourceInfo, return the classes package directory"

    ^ info at:#directory.

    "Created: 6.2.1996 / 17:26:23 / cg"

    "Modified: 12.9.1996 / 02:32:19 / cg"

!

pathInRepositoryFrom:containerPath

    "this tries to extract the path within a repository, given some path

     as present in an RCS Header string.

     Typically, this ought to be that string directly; 

     however, if the repository directory is accessed via a symbolic link during

     ci/co, some systems extract different strings with co.

     One such system here had a symbolic link from /phys/ibm/CVS... to /file/CVS,

     and extracted sources had /phys/ibm/CVS in their header.

     Do not depend on the code below to work correctly all the time."

    |top lastTop idx|

    containerPath notNil ifTrue:[

        top := self repositoryTopDirectory.

        top notNil ifTrue:[

            (containerPath startsWith:(top , '/')) ifTrue:[

                ^ containerPath copyFrom:(top size + 2).

            ].

            (containerPath startsWith:(top)) ifTrue:[

                ^ containerPath copyFrom:(top size + 1).

            ].

            "/ hardcase - the repository-filename in the versionInfo

            "/ does no match my repository top.

            "/ check for mangled prefix (happens with symbolic links)

            lastTop := '/' , top asFilename baseName, '/'.

            idx := containerPath indexOfSubCollection:lastTop.

            idx ~~ 0 ifTrue:[

                ^ containerPath copyFrom:(idx + lastTop size).

            ]

        ]

    ].

    ^ nil

    "

     SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st'

     SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st'

    "

    "Created: 25.11.1995 / 18:42:20 / cg"

!

repositoryTopDirectory

    "return the name of the repository"

    ^ nil

    "Created: 25.11.1995 / 18:38:59 / cg"

    "Modified: 12.9.1996 / 02:32:40 / cg"

!

revisionAfter:aRevisionString

    "generate the next revision number after the given number"

    |idx|

    idx := aRevisionString lastIndexOf:$..

    idx == 0 ifTrue:[

        ^ ((Integer readFrom:aRevisionString) + 1) printString

    ].

    ^ (aRevisionString copyTo:idx) , ((Integer readFrom:(aRevisionString copyFrom:(idx+1)))+1) printString

    "

     SourceCodeManager revisionAfter:'1.2.3.4' 

     SourceCodeManager revisionAfter:'123'  

     SourceCodeManager revisionAfter:'1.24'  

    "

    "Created: 20.11.1995 / 12:54:05 / cg"

    "Modified: 12.9.1996 / 02:33:03 / cg"

!

sourceCacheDirectory

    "return the sourceCache directories name"

    |dir nm|

    (nm := self cacheDirectoryName) isNil ifTrue:[^ nil].

    (dir := nm asFilename) exists ifFalse:[

        dir makeDirectory.

        dir exists ifFalse:[

            ^ nil

        ].

        "/

        "/ make it read/writable for everyone

        "/

        dir makeReadableForAll.

        dir makeWritableForAll.

        dir makeExecutableForAll.

    ].

    ^ dir

!

sourceInfoOfClass:aClass

    "helper: return a classes sourceCodeInfo"

    |cls binaryInfo revInfo actualSourceFileName classFileNameBase

     newInfo container expectedFileName

     directoryFromRev moduleFromRev fileNameFromRev directoryFromBin moduleFromBin|

    cls := aClass.

    cls isMeta ifTrue:[

        cls := cls soleInstance

    ].

    newInfo := IdentityDictionary new.

    "/

    "/ the info given by the classes source ...

    "/

    revInfo := aClass revisionInfo.

    revInfo notNil ifTrue:[

        revInfo keysAndValuesDo:[:key :value |

            newInfo at:key put:value

        ]

    ].

    "/

    "/ the info given by the classes binary ...

    "/ if present, we better trust that one.

    "/ however, it only contains partial information (directory & module).

    "/ (but is available even without a source)

    "/

    binaryInfo := cls packageSourceCodeInfo.

    binaryInfo notNil ifTrue:[

        binaryInfo keysAndValuesDo:[:key :value |

            newInfo at:key put:value

        ]

    ].

    "/

    "/ no information

    "/

    (binaryInfo isNil and:[revInfo isNil]) ifTrue:[

        ^ nil

    ].

    "/

    "/ validate for conflicts

    "/ trust binary if in doubt

    "/ (in case some cheater edited the version string)

    revInfo notNil ifTrue:[

        (revInfo includesKey:#repositoryPathName) ifTrue:[

            container := revInfo at:#repositoryPathName ifAbsent:nil.

            newInfo at:#directory put:(directoryFromRev := self directoryFromContainerPath:container).

            newInfo at:#module put:(moduleFromRev := self moduleFromContainerPath:container).

            fileNameFromRev := container asFilename baseName.

"/            fileNameFromRev := self filenameFromContainerPath:container.

            newInfo at:#fileName put:(fileNameFromRev copyWithoutLast:2).

            binaryInfo notNil ifTrue:[

                (binaryInfo includesKey:#directory) ifTrue:[

                    directoryFromBin := binaryInfo at:#directory.

                    moduleFromBin := binaryInfo at:#module.

                    (directoryFromBin ~= directoryFromRev 

                    or:[moduleFromBin ~= moduleFromRev]) ifTrue:[

                        (directoryFromRev isNil or:[moduleFromRev isNil]) ifTrue:[

                                , moduleFromBin , '/' , directoryFromBin

                            ) infoPrintCR.

                        ] ifFalse:[

                                , moduleFromBin  , '/' , directoryFromBin

                                , ' vs. source:'

                                , moduleFromRev  , '/' , directoryFromRev

                                , ')') infoPrintCR.

                        ].

                        newInfo at:#directory put:directoryFromBin.

                        newInfo at:#module put:moduleFromBin.

                    ]

                ]

            ].

        ]

    ].