"{ Package: 'stx:libbasic3' }"

AbstractSourceCodeManager subclass:#PerforceSourceCodeManager

	instanceVariableNames:''

	classVariableNames:'PerforceExecutable PerforceModuleRoots PerforceClient

		PerforcePort PerforceUser PerforcePassword PerforceTempDir

		Verbose PerforceCommandSemaphore PerforceEnabled

		PerforceCacheDirectoryName'

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

Object subclass:#CheckInDefinition

	instanceVariableNames:'class packageDir classFileName sourceFileName force logMessage

		moduleName manager tempDirectory workSpaceDefinition

		newestRevision definitionClass'

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

VersionInfo subclass:#PerforceVersionInfo

	instanceVariableNames:'repositoryPathName'

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

Object subclass:#WorkSpaceDefinition

	instanceVariableNames:'client host localDir owner repositoryDir root workSpaceName

		workSpaceDefinitionFilename moduleName'

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

!PerforceSourceCodeManager class methodsFor:'initialization'!

initialize

    PerforceCommandSemaphore := Semaphore new:10.

! !

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

    ^ PerforceCacheDirectoryName

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

    PerforceCacheDirectoryName := aStringOrFilename

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

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

!

perforceClient

    |envVar|

    PerforceClient notNil ifTrue:[ ^ PerforceClient].

    envVar := OperatingSystem getEnvironment:'P4CLIENT'.

    envVar notEmptyOrNil ifTrue:[ ^ envVar].

    ^ 'workspace'

!

perforceClient:something

    PerforceClient := something.

!

perforceEnabled

    PerforceEnabled notNil ifTrue:[ ^ false].

    ^ PerforceEnabled

!

perforceEnabled:enable

    PerforceEnabled := enable.

!

perforceExecutable

    ^ PerforceExecutable ? 'p4'

!

perforceExecutable:aString

    "set the name of the cvs executable."

    aString isEmptyOrNil ifTrue:[

        PerforceExecutable := nil

    ] ifFalse:[

        PerforceExecutable := aString.

    ].

    "Created: / 21-09-2006 / 15:31:59 / cg"

    "Modified: / 21-09-2006 / 16:41:33 / cg"

!

perforcePassword

    |envVar|

    PerforcePassword notNil ifTrue:[ ^ PerforcePassword].

    envVar := OperatingSystem getEnvironment:'P4PASSWD'.

    envVar notEmptyOrNil ifTrue:[ ^ envVar].

    ^ 'pass'

    "Modified: / 19-04-2011 / 10:46:56 / cg"

!

perforcePassword:something

    PerforcePassword := something.

!

perforcePort

    |envVar|

    PerforcePort notNil ifTrue:[ ^ PerforcePort].

    envVar := OperatingSystem getEnvironment:'P4PORT'.

    envVar notEmptyOrNil ifTrue:[ ^ envVar].

    ^ 'localhost:1666'

!

perforcePort:something

    PerforcePort := something.

!

perforceUser

    |envVar|

    PerforceUser notNil ifTrue:[ ^ PerforceUser].

    envVar := OperatingSystem getEnvironment:'P4USER'.

    envVar notEmptyOrNil ifTrue:[ ^ envVar].

    ^ OperatingSystem getLoginName ? 'user'

!

perforceUser:something

    PerforceUser := something.

!

repositoryInfoPerModule

    "Superclass AbstractSourceCodeManager class says that I am responsible to implement this method"

    ^ PerforceModuleRoots ? Dictionary new

!

repositoryInfoPerModule:aDictionary

    "set the dictionary, which associates CVSRoots to module names.

     If no entry is contained in this dictionary for some module,

     the default cvsRoot (CVSRoot) will be used."

    PerforceModuleRoots := aDictionary

!

repositoryName

    "return the name of the repository.

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

    ^ (self perforceClient ,':',

       self perforceUser, ':',

       (self perforcePassword ? 'pass'), '@',

       self perforcePort)

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

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

!

repositoryName:settingsString

    "return the name of the repository.

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

    |settings|

    settings := self getPerforceSettingsFromString:settingsString.

    self perforceClient:(settings at:#client ifAbsent:nil).

    self perforceUser:(settings at:#user ifAbsent:nil).

    self perforcePassword:(settings at:#password ifAbsent:nil).

    self perforcePort:(settings at:#port ifAbsent:nil).

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

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

!

repositoryNameForModule:aModuleName

    |settings|

    settings := self getPerforceSettingsForModule:aModuleName.

    settings isNil ifTrue:[ ^ ''].

    ^ ((settings at:#client ifAbsent:'') ,':',

       (settings at:#user ifAbsent:''), ':',

       (settings at:#password ifAbsent:''), '@',

       (settings at:#port ifAbsent:''))

!

repositoryNameForPackage:packageId 

    ^ self repositoryNameForModule:(packageId upTo:$: )

    "Modified: / 10-10-2011 / 19:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 21-12-2011 / 23:03:41 / cg"

!

verboseSourceCodeAccess

    ^ Verbose

    "Created: / 19-04-2011 / 10:52:29 / cg"

!

verboseSourceCodeAccess:aBoolean

    Verbose := aBoolean

    "Created: / 19-04-2011 / 10:52:43 / cg"

! !

!PerforceSourceCodeManager class methodsFor:'basic access'!

checkoutModule:aModule directory:aPackage andDo:aBlock

    "check out everything from a package into a temporary directory.

     Then evaluate aBlock, passing the name of that temp-directory.

     Afterwards, the tempDir is removed.

     Return true, if OK, false if any error occurred."

    self shouldImplement

!

createTempDirectory:packageDir forModule:moduleDir

    "create a temp directory for checking out"

    |tempdir dir|

    "/ if CVSTempDir isNil, use current.

    OperatingSystem errorSignal handle:[:ex |

        self reportError:('cannot create temporary directory').

        ^ nil.

    ] do:[

        tempdir := Filename newTemporaryDirectoryIn:(self perforceTmpDirectory).

    ].

    moduleDir notNil ifTrue:[

        dir := tempdir construct:moduleDir.

        dir makeDirectory.

        packageDir notNil ifTrue:[

            dir := dir construct:packageDir.

            dir recursiveMakeDirectory.

        ].

        dir exists ifFalse:[

            (tempdir construct:moduleDir) recursiveRemove.

            tempdir recursiveRemove.

            self reportError:('cannot create temporary directory').

            ^ nil.

        ].

    ].

    ^ tempdir

    "self createTempDirectory:'fooPackage' forModule:'fooModule'"

    "Created: / 09-12-1995 / 19:14:35 / cg"

    "Modified: / 19-12-1995 / 16:13:02 / stefan"

    "Modified: / 29-08-2006 / 13:16:23 / cg"

!

savePreferencesOn:aStream

    aStream nextPutLine:'PerforceSourceCodeManager notNil ifTrue:['.

    self repositoryInfoPerModule notEmptyOrNil ifTrue:[

        aStream nextPutLine:'    PerforceSourceCodeManager repositoryInfoPerModule:' , self repositoryInfoPerModule storeString , '.'.

    ].

    PerforceExecutable notNil ifTrue:[

        aStream nextPutLine:'    PerforceSourceCodeManager perforceExecutable:' , PerforceExecutable storeString , '.'.

    ].

    (Smalltalk at:#SourceCodeManager) == self ifTrue:[

        aStream nextPutLine:'    Smalltalk at:#SourceCodeManager put: PerforceSourceCodeManager.'.

        aStream nextPutLine:'    PerforceSourceCodeManager initializeForRepository:' , self repositoryName storeString , '.'.

    ].

    aStream nextPutLine:'].'.

!

streamForClass:cls fileName:fileName revision:revision directory:packageDir module:moduleDir cache:doCache

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

    |cacheIt cacheDir classFileName fullName cachedSourceFilename cacheSubDir cachedFile tempdir checkoutName

     checkoutNameLocal revisionArg revMsg fullTempName fullCachedName stream tempFile cmd inDirectory inStream outStream

     line modulDir lineNr result|

    cacheIt := doCache.

    (cacheIt and:[revision ~~ #newest and:[revision notNil]]) ifTrue:[

        (cacheDir := self sourceCacheDirectory) isNil ifTrue:[

            'PerforceSourceCodeManager [warning]: no source cache directory' errorPrintCR.

        ]

    ].

    classFileName := fileName.

    classFileName isNil ifTrue:[classFileName := cls classBaseFilename].

    (classFileName endsWith:',v') ifTrue:[

        classFileName := classFileName copyWithoutLast:2.

    ].

    (classFileName endsWith:'.st') ifTrue:[

        cls notNil ifTrue:[

            classFileName := classFileName copyWithoutLast:3.

        ]

    ].

    fullName := moduleDir , '/' , packageDir , '/' , classFileName.

    cls notNil ifTrue:[

        fullName := fullName , '.st'.

    ].

    (revision isNil or:[revision == #newest]) ifTrue:[

        cachedSourceFilename := classFileName.

    ] ifFalse:[

        cachedSourceFilename := classFileName , '_' , revision.

    ].

    cacheDir notNil ifTrue:[

        cacheSubDir := cacheDir construct:moduleDir.

        cacheSubDir exists ifTrue:[

            cacheSubDir := cacheSubDir construct:packageDir.

            cacheSubDir exists ifTrue:[

                cachedFile := cacheSubDir construct:cachedSourceFilename.

                cachedFile exists ifTrue:[

                    ^ cachedFile readStream

                ].

            ].

        ].

    ].

    "/

    "/ first, create a temporary work tree

    "/ Do not make module and package directories, their existence cause cvs checkout to fail in server mode

    "/

    tempdir := self createTempDirectory:nil forModule:nil.

    "/

    "/ check it out there

    "/

    checkoutName :=  fullName.

    modulDir := moduleDir asFilename construct:packageDir.

    checkoutNameLocal := modulDir constructString:(fullName asFilename baseName).

    (revision isNil or:[revision == #newest]) ifTrue:[

        cachedSourceFilename := classFileName.

        revisionArg := ''.

        revMsg := ''.

    ] ifFalse:[

        cachedSourceFilename := classFileName , '_' , revision.

        revisionArg := ' -r ' , revision.

        revMsg := ' (' , revision , ')'.

    ].

    self activityNotification:'checking out source ' , checkoutName , revMsg.

    fullTempName := tempdir construct:checkoutNameLocal.

    cmd := ('print ' , classFileName, '.st#', revision).

    inDirectory := (Filename currentDirectory asAbsoluteFilename construct:modulDir) pathName.

    result := self executePerforceCommand:cmd

                    module:moduleDir

                    inDirectory:inDirectory

                    log:false

                    pipe:false.

    result ifFalse:[

        ('PerforceSourceCodeManager [error]: error execute command ', cmd) errorPrintCR.

        ^ nil

    ].

    inStream := self executePerforceCommand:cmd

                    module:moduleDir

                    inDirectory:inDirectory

                    log:true

                    pipe:true.

    inStream isNil ifTrue:[

        ('PerforceSourceCodeManager [error]: could not get Stream from ', cmd) errorPrintCR.

        ^ nil

    ].

    FileStream openErrorSignal handle:[:ex|

        ('PerforceSourceCodeManager [error]: can not create ', fullTempName pathName) errorPrintCR.

        ^ nil.

    ] do:[

        fullTempName directory recursiveMakeDirectory.

        outStream := fullTempName writeStream.

    ].

    lineNr := 1.

    [inStream atEnd not] whileTrue:[

        line:= inStream nextLine.

        line notNil ifTrue:[

            lineNr = 1 ifTrue:[

            ] ifFalse:[

                outStream nextPutLine:line.

            ].

        ].

        lineNr := lineNr + 1.

    ].

    outStream close.

    (cacheSubDir isNil) ifTrue:[

        cacheIt := false

    ] ifFalse:[

        cacheSubDir recursiveMakeDirectory.

        fullCachedName := cacheSubDir constructString:cachedSourceFilename.

    ].

    fullTempName exists ifFalse:[

        ('PerforceSourceCodeManager [error]: failed to checkout ', fullTempName pathName, ' (file does not exist after cvs co)') errorPrintCR.

        tempdir recursiveRemove.

        ^ nil

    ].

    (cacheIt

    and:[cachedFile notNil

    and:[fullTempName exists]])

    ifTrue:[

        (OperatingSystem errorSignal catch:[

            fullTempName moveTo:fullCachedName

        ]) ifTrue:[

            ('CVSSourceCodeManager [error]: failed to rename ', fullTempName pathName, ' to ', cachedSourceFilename) errorPrintCR.

            tempdir recursiveRemove.

            ^ nil

        ].

        fullCachedName asFilename exists ifTrue:[

            stream := fullCachedName asFilename readStream.

        ].

    ] ifFalse:[

        OperatingSystem isUNIXlike ifFalse:[

            "/ cannot remove files which are still open ...

            "/ sigh - need a delete-on-close flag in FileStream.

            "/

            tempFile := Filename newTemporary.

            fullTempName copyTo:tempFile.

            stream := tempFile readStream.

            stream notNil ifTrue:[

                stream removeOnClose:true.

            ].

        ] ifTrue:[

            stream := fullTempName readStream.

        ]

    ].

    ^ stream

! !

!PerforceSourceCodeManager class methodsFor:'basic administration'!

checkForExistingContainer:fileName inModule:moduleDir directory:packageDir

    "check for a container to exist"

    |newestRevision class className|

    fileName isString ifTrue:[

        className := fileName asFilename withoutSuffix baseName.

        class := Smalltalk at:(className asSymbol).

    ] ifFalse:[

        class := fileName.

    ].

    newestRevision := self newestRevisionOf:class.

    ^ newestRevision notNil

!

checkForExistingModule:moduleName

    "check for a module directory to be present"

    |workSpaceDefinition|

    workSpaceDefinition := self getWorkSpaceForModule:moduleName modulePath:nil.

    ^ workSpaceDefinition notNil.

"

self checkForExistingModule:'applistx'

self checkForExistingModule:'balla'

"