"

 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:'CacheDirectoryName DefaultManager'

	 poolDictionaries:''

	 category:'System-Support'

!

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

"

! !

!AbstractSourceCodeManager class methodsFor:'initialization'!

initCacheDirPath

    |path|

    path := OperatingSystem getEnvironment:'STX_TMPPATH'.

    path isNil ifTrue:[

	path := OperatingSystem getEnvironment:'TMPPATH'.

	path isNil ifTrue:[

	    path := '/tmp'

	]

    ].

    CacheDirectoryName := path , '/stx_sourceCache'.

! !

!AbstractSourceCodeManager class methodsFor:'accessing'!

defaultManager

    ^ DefaultManager

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

! !

!AbstractSourceCodeManager class methodsFor:'private'!

cacheDirectoryName

    ^ CacheDirectoryName

!

directoryFromContainerPath:containerPath

    |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: 25.11.1995 / 18:48:46 / cg"

!

filenameFromContainerPath:containerPath

    |top rest|

    containerPath notNil ifTrue:[

	top := self repositoryTopDirectory.

	top notNil ifTrue:[

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

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

		^ rest asFilename baseName

	    ]

	]

    ].

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

!

moduleFromContainerPath:containerPath

    |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: 25.11.1995 / 18:47:27 / cg"

!

pathInRepositoryFrom:containerPath

    |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 , '/') infoPrintNL.

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

		^ 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: 25.11.1995 / 18:59:26 / 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 asFilename exists ifFalse:[

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

	    ^ nil

	].

    ].

    ^ dir

!

sourceInfoOfClass:aClass

    "helper: return a classes sourceCodeInfo"

    |cls sourceInfo revInfo actualSourceFileName classFileName

     newInfo revisionInfo container|

    cls := aClass.

    cls isMeta ifTrue:[

	cls := cls soleInstance

    ].

    "/

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

    "/

    revInfo := aClass revisionInfo.

    "/

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

    "/ if present, we better trust that one.

    "/

    sourceInfo := cls packageSourceCodeInfo.

    sourceInfo isNil ifTrue:[

	revInfo isNil ifTrue:[

	    'SOURCEMGR: class has neither source nor compiled-in info' infoPrintNL.

	    ^ nil

	].

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

	container notNil ifTrue:[

	    sourceInfo := revInfo.

	    sourceInfo at:#directory put:(self directoryFromContainerPath:container).

	    sourceInfo at:#module put:(self moduleFromContainerPath:container).

	]

    ].

    "/

    "/ the filename I would expect from its name ...

    "/

    classFileName := Smalltalk fileNameForClass:aClass.

    newInfo := IdentityDictionary new.

    sourceInfo keysAndValuesDo:[:key :value |

	newInfo at:key put:value

    ].

    "/ check ..

    revInfo notNil ifTrue:[

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

	actualSourceFileName notNil ifTrue:[

	    actualSourceFileName ~= (classFileName , '.st') ifTrue:[

		('SOURCEMGR: source of class ' , aClass name , ' found in ' , actualSourceFileName , ' (expected: ' , classFileName , '.st); renamed ?') printNL.

		newInfo at:#expectedFileName put:(classFileName).

		newInfo at:#renamed put:true.

		classFileName := actualSourceFileName copyWithoutLast:3

	    ]

	]

    ].

    newInfo at:#classFileName put:classFileName.

    ^ newInfo

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

    "Modified: 25.11.1995 / 18:51:16 / 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"

! !

!AbstractSourceCodeManager class methodsFor:'source code access'!

checkinClass:aClass logMessage:logMessage

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    |sourceInfo tempDir packageDir moduleDir tempFile classFileName ok|

    sourceInfo := self sourceInfoOfClass:aClass.

    sourceInfo isNil ifTrue:[

        ('SOURCEMGR: no sourceInfo for class: ' , aClass name) errorPrintNL.

        ^ false

    ].

    packageDir := sourceInfo at:#directory.

    moduleDir := sourceInfo at:#module.  "/ use the modules name as CVS module

    classFileName := sourceInfo at:#classFileName.

"/    classFileName := Smalltalk fileNameForClass:aClass.

    tempDir := (Filename newTemporaryIn:nil) makeDirectory.

    [

        |aStream|

        tempFile := tempDir construct:(classFileName,'.st').

        aStream := tempFile writeStream.

        aStream isNil ifTrue:[

            'SOURCEMGR: temporary fileout failed' errorPrintNL.

            ^ false

        ].

        Class fileOutErrorSignal handle:[:ex |

            'SOURCEMGR: fileout failed' errorPrintNL.

            aStream close.

            ^ false

        ] do:[

            aClass fileOutOn:aStream withTimeStamp:false.

        ].

        aStream close.

        (tempFile := tempDir construct:(classFileName,'.st')) exists ifFalse:[

            'SOURCEMGR: temporary fileout failed' errorPrintNL.

            ^ false

        ].

        ok := self 

            checkinClass:aClass

            fileName:classFileName 

            directory:packageDir 

            module:moduleDir

            source:(tempFile name)

            logMessage:logMessage.

        ^ ok

    ] valueNowOrOnUnwindDo:[

        tempDir recursiveRemove

    ].

    ^ false

    "

     SourceCodeManager checkinClass:Array

    "

    "Created: 6.11.1995 / 18:56:00 / cg"

    "Modified: 9.12.1995 / 16:12:14 / cg"

!

mostRecentSourceStreamForClassNamed:aClassOrClassName

    |classFileName packageDir moduleDir|

    classFileName := Smalltalk fileNameForClass:aClassOrClassName.

    packageDir := Smalltalk sourceDirectoryNameOfClass:aClassOrClassName.

    moduleDir := 'stx'.

    packageDir isNil ifTrue:[^ nil].

    ^ self 

	streamForClass:nil

	fileName:classFileName 

	revision:#newest 

	directory:packageDir 

	module:moduleDir

	cache:false

    "Created: 6.11.1995 / 16:09:06 / cg"

    "Modified: 9.11.1995 / 14:34:15 / cg"

!

sourceStreamFor:aClass

    "extract a classes source code and return an open readStream on it.

     The classes source code is extracted using the revision and the sourceCodeInfo,

     which itself is extracted from the classes packageString."

    ^ self sourceStreamFor:aClass revision:nil

!

sourceStreamFor:aClass revision:aRevisionStringOrNil

    "extract a classes source code and return an open readStream on it.

     A revision of nil selects the current (in image) revision.

     The classes source code is extracted using the revision and the sourceCodeInfo,

     which itself is extracted from the classes packageString."

    |classFileName revision 

     packageDir moduleDir sourceInfo revInfo|

    aRevisionStringOrNil isNil ifTrue:[

	revision := aClass binaryRevision.

	revision isNil ifTrue:[ 

	    'SOURCEMGR: class ' , aClass name , ' has no revision string' infoPrintNL.

	    ^ nil.

	]

    ] ifFalse:[

	revision := aRevisionStringOrNil

    ].

    sourceInfo := self sourceInfoOfClass:aClass.

    sourceInfo isNil ifTrue:[^ nil].

    packageDir := sourceInfo at:#directory.

    moduleDir := sourceInfo at:#module.  "/ use the modules name as CVS module

    classFileName := sourceInfo at:#classFileName.

    ^ self 

	streamForClass:aClass

	fileName:classFileName 

	revision:revision 

	directory:packageDir 

	module:moduleDir

	cache:true

    "Modified: 25.11.1995 / 17:04:38 / cg"

! !

!AbstractSourceCodeManager class methodsFor:'source code administration'!

checkForExistingContainerInModule:moduleName package:dirName container:fileName

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 9.12.1995 / 19:43:39 / cg"

!

checkForExistingModule:moduleName

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 9.12.1995 / 19:43:54 / cg"

!

checkForExistingModule:moduleDir package:packageDir

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 9.12.1995 / 19:44:04 / cg"

!

createContainerFor:aClass inModule:moduleName directory:dirName container:fileName

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:47 / cg"

    "Modified: 9.12.1995 / 19:28:15 / cg"

!

createModule:moduleName

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 9.12.1995 / 19:53:23 / cg"

!

createModule:module package:package

    self subclassResponsibility.

    ^ false

    "Created: 9.12.1995 / 19:02:23 / cg"

    "Modified: 9.12.1995 / 19:54:26 / cg"

!

revisionLogOf:aClass

    "return info about the repository container and

     the revisionlog as a collection of revision entries.

     Return nil on failure.

     The returned information is a structure (IdentityDictionary)

     filled with:

	    #container          -> the RCS container file name

	    #filename           -> the actual source file name

	    #newestRevision     -> the revisionString of the newest revision

	    #numberOfRevisions  -> the number of revisions in the container

	    #revisions          -> collection of per-revision info

	    per revision info consists of one record per revision:

	      #revision              -> the revision string

	      #author                -> who checked that revision into the repository

	      #date                  -> when was it checked in

	      #state                 -> the RCS state

	      #numberOfChangedLines  -> the number of changed line w.r.t the previous

	    revisions are ordered newest first 

	    (i.e. the last entry is for the initial revision; the first for the most recent one)

	"

    ^ self

	revisionLogOf:aClass fromRevision:nil toRevision:nil

    "

     SourceCodeManager revisionLogOf:Array 

    "

    "Created: 25.11.1995 / 11:25:02 / cg"

    "Modified: 25.11.1995 / 11:56:16 / cg"