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

!

!PerforceSourceCodeManager class methodsFor:'initialization'!

forgetDisabledModules

    ^ self

!

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

!

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:''))

! !

!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:['.

    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:'  ].'.

    "Created: / 09-11-2006 / 15:09:25 / cg"

    "Modified: / 10-11-2006 / 18:14:16 / cg"

!

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'

"

!

checkForExistingModule:moduleName directory:packageDir

    "check for a package directory to be present"

    |modulePath cmd inDirectory inStream line workSpaceDefinition repositoryDir|

    modulePath :=  moduleName , '/' , packageDir.

    inDirectory := (Filename currentDirectory asAbsoluteFilename) pathName.

    workSpaceDefinition := self getWorkSpaceForModule:moduleName modulePath:modulePath.

    workSpaceDefinition isNil ifTrue:[

	('PerforceSourceCodeManager [error]: cant get perforce client info for ', moduleName) errorPrintCR.

	^ false

    ].

    repositoryDir := workSpaceDefinition at:#repositoryDir.

    (repositoryDir endsWith:'...') ifTrue:[

	repositoryDir := repositoryDir copyTo:(repositoryDir size - 3).

    ].

    cmd := ('sync ' , repositoryDir, modulePath, '/...').

    inStream := self executePerforceCommand:cmd

			module:moduleName

			inDirectory:inDirectory

			log:true

			pipe:true.

    inStream isNil ifTrue:[

	('PerforceSourceCodeManager [error]: cannot open pipe to perforce sync ', moduleName) errorPrintCR.

	^ false

    ].

    "/

    "/ read the commands pipe output and extract the container info

    "/

    [inStream atEnd not] whileTrue:[

	line:= inStream nextLine.

	line notNil ifTrue:[

	    (line endsWith:'no such file(s).') ifTrue:[

		^ false

	    ].

	]

    ].

    ^ true

"

    self checkForExistingModule:'testModule' directory:'libTestPerforce'

"

!

checkinClass:cls fileName:classFileName directory:packageDir module:moduleName logMessage:logMessage force:forceArg

    "enter a classes source code

     into the source repository. If the force argument is true, no merge is done;

     instead, the code is checked in as given (Dangerous).

     Return true if ok, false if not."

    |tempdir cmd checkoutName logMsg locRevision newestRevision binRevision modulePath newVersionString

     workspaceDefinitionFile workSpaceName result checkInDefinition workSpaceDefinition depotRoot|

    cls isPrivate ifTrue:[

	self reportError:'refuse to check in private classes.'.