"

 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'

!

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

"

! !

initCacheDirPath

    |path|

    path := OperatingSystem getEnvironment:'STX_TMPPATH'.

    path isNil ifTrue:[

        path := OperatingSystem getEnvironment:'TMPPATH'.

        path isNil ifTrue:[

            path := '/tmp'

        ]

    ].

    CacheDirectoryName := path , '/stx_sourceCache'.

    "Modified: 16.12.1995 / 15:39:42 / cg"

!

initialize

    CachingSources := UseWorkTree := false.

    CacheDirectoryName := WorkTreeDirectoryName := ''.

    "Modified: 16.12.1995 / 15:39:42 / cg"

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

! !

cacheDirectoryName

    ^ CacheDirectoryName

!

cacheDirectoryName:aStringOrFilename

    CacheDirectoryName := aStringOrFilename

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

!

cachingSources

    ^ CachingSources

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

    "Modified: 16.12.1995 / 15:18:03 / cg"

!

cachingSources:aBoolean

    CachingSources := aBoolean

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

!

defaultManager

    ^ DefaultManager

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

!

useWorkTree

    ^ UseWorkTree

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

    "Modified: 16.12.1995 / 15:37:17 / cg"

!

useWorkTree:aBoolean

    UseWorkTree := aBoolean

    "Modified: 16.12.1995 / 15:18:03 / cg"

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

!

workTreeDirectoryName

    ^ WorkTreeDirectoryName

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

!

workTreeDirectoryName:aStringOrFilename

    WorkTreeDirectoryName := aStringOrFilename

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

! !

containerFromSourceInfo:info

    (info includesKey:#fileName) ifTrue:[

        ^ info at:#fileName

    ].

    (info includesKey:#expectedFileName) ifTrue:[

        ^ info at:#expectedFileName

    ].

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

    "Modified: 6.2.1996 / 17:27:24 / 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

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

    "Modified: 19.2.1996 / 13:35:29 / 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

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

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

!

packageFromSourceInfo:info

    ^ info at:#directory.

    "Created: 6.2.1996 / 17:26:23 / 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 rest lastTop idx|

    containerPath notNil ifTrue:[

        top := self repositoryTopDirectory.

        top notNil ifTrue:[

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

                ^ containerPath copyFrom:(top size + 2).

            ].

            "/ 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:[

                ('SOURCEMGR: warning: repository path mismatch: ' , (containerPath copyTo:idx-1) , lastTop , ' vs. ' , top , '/') infoPrintCR.

                'SOURCEMGR: warning: assuming that mismatch is ok.' infoPrintCR.

                ^ containerPath copyFrom:(idx + lastTop size).

            ]

        ]

    ].

    ^ rest

    "

     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"

    "Modified: 20.5.1996 / 10:30:41 / cg"

!

repositoryTopDirectory

    ^ nil

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

!

revisionAfter:aRevisionString

    |idx s|

    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"

!

sourceCacheDirectory

    |dir nm|

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

    (dir := nm asFilename) exists ifFalse:[

        dir makeDirectory.

        dir exists ifFalse:[

            'SOURCEMGR: could not create cache dir ''' , CacheDirectoryName , '''' infoPrintCR.

            ^ nil

        ].

        "/

        "/ make it read/writable for everyone

        "/

        dir makeReadableForAll.

        dir makeWritableForAll.

        dir makeExecutableForAll.

    ].

    ^ dir

    "Modified: 20.5.1996 / 10:30:44 / cg"

!

sourceInfoOfClass:aClass

    "helper: return a classes sourceCodeInfo"

    |cls binaryInfo revInfo actualSourceFileName classFileNameBase

     newInfo revisionInfo 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:[

        ('SOURCEMGR: class `' , aClass name , ''' has neither source nor compiled-in info') infoPrintCR.

        ^ 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:[

                            ('SOURCEMGR: using binary info: ' 

                                , directoryFromBin , '/' , moduleFromBin

                            ) infoPrintCR.

                        ] ifFalse:[

                            ('SOURCEMGR: conflicting source infos (binary: ' 

                                , directoryFromBin , '/' , moduleFromBin

                                , ' vs. source:'

                                , directoryFromRev , '/' , moduleFromRev

                                , ')') infoPrintCR.

                        ].

                        newInfo at:#directory put:directoryFromBin.

                        newInfo at:#module put:moduleFromBin.

                    ]

                ]

            ].

        ]

    ].

    "/

    "/ the filename I'd expect from its name ...

    "/

    classFileNameBase := Smalltalk fileNameForClass:aClass.

    (newInfo includesKey:#fileName) ifFalse:[

        newInfo at:#fileName put:(classFileNameBase , '.st')

    ].

    "/ guess on the container

    container isNil ifTrue:[

        (newInfo includesKey:#directory) ifTrue:[

            (newInfo includesKey:#module) ifTrue:[

                (newInfo includesKey:#module) ifTrue:[

                    container := (newInfo at:#directory)

                                 , '/'

                                 , (newInfo at:#module)

                                 , '/'

                                 , classFileNameBase , '.st,v'.

                ]

            ]

        ]

    ].

    container notNil ifTrue:[

        newInfo at:#repositoryPathName put:container.

    ].

    "/ check ..

    revInfo notNil ifTrue:[

        actualSourceFileName := revInfo at:#fileName ifAbsent:nil.

        actualSourceFileName notNil ifTrue:[

            expectedFileName := classFileNameBase , '.st'.

            actualSourceFileName ~= expectedFileName ifTrue:[

                ('SOURCEMGR: source of class ' , aClass name , ' in ' , actualSourceFileName , ';') infoPrintCR.

                ('SOURCEMGR: (expected: ' , expectedFileName , '); renamed or missing abbreviation ?') infoPrintCR.

                ('SOURCEMGR: This may fail to autoload later if left unchanged.') infoPrintCR.

                newInfo at:#expectedFileName put:expectedFileName.

                newInfo at:#renamed put:true.

                classFileNameBase := actualSourceFileName copyWithoutLast:3

            ]

        ]

    ].

    newInfo at:#classFileNameBase put:classFileNameBase.

    ^ newInfo

    "Created: 25.11.1995 / 12:40:19 / cg"

    "Modified: 20.5.1996 / 10:30:49 / cg"

!

streamForClass:cls fileName:classFileName revision:revision directory:packageDir module:moduleDir cache:cacheIt

    self subclassResponsibility.

    ^ nil

    "Created: 4.11.1995 / 19:09:12 / cg"

    "Modified: 4.11.1995 / 19:15:43 / cg"

! !

checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    |tempDir tempFile ok|

    tempDir := (Filename newTemporaryIn:nil) makeDirectory.

    [

        |aStream|

        tempFile := tempDir construct:classFileName.

        aStream := tempFile writeStream.

        aStream isNil ifTrue:[

            ^ false

        ].

        Method flushSourceStreamCache.

        Class fileOutErrorSignal handle:[:ex |

            aStream close.

            ^ false

        ] do:[

            aClass fileOutOn:aStream withTimeStamp:false.

        ].