"{ Package: 'stx:libbasic3' }"

AbstractSourceCodeManager subclass:#PerforceSourceCodeManager

	instanceVariableNames:''

	classVariableNames:'PerforceExecutable PerforceModuleRoots PerforceClient

		PerforcePort PerforceUser PerforcePassword PerforceTempDir

		Verbose PerforceCommandSemaphore PerforceEnabled

		PerforceWorkspaces'

	poolDictionaries:''

	category:'System-SourceCodeManagement'

!

Object subclass:#CheckInDefinition

	instanceVariableNames:'class packageDir classFileName sourceFileName logMessage

		moduleName manager tempDirectory definitionClass workSpace

		temporaryWorkSpace package reposRevisionInfoBeforeAction

		reposRevisionInfoAfterAction revisionStringBeforeAction

		fileContents'

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

ProceedableError subclass:#PerforceError

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

VersionInfo subclass:#PerforceVersionInfo

	instanceVariableNames:'repositoryPathName revisionNumber'

	classVariableNames:''

	poolDictionaries:''

	privateIn:PerforceSourceCodeManager

!

!PerforceSourceCodeManager class methodsFor:'accessing'!

flushPerforceWorkspaces

    PerforceWorkspaces := nil.

!

perforceClient

    |envVar|

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

    ^ nil

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

!

perforceWorkspaces

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

    PerforceWorkspaces isNil ifTrue:[

        PerforceWorkspaces := Dictionary new.

    ].

    ^ PerforceWorkspaces 

!

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

    self flushPerforceWorkspaces.

    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 getPerforceSettingsForPackage:aModuleName.

    settings isNil ifTrue:[ ^ ''].

    ^ settings

!

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"

!

setDefaultPerforceSettingsFromString:aString 

    |settings defaultSettingsString workSpace|

    defaultSettingsString := self getPerforceDefaultSettingsString.

    defaultSettingsString ~= aString ifTrue:[

        settings := PerforceSourceCodeManager 

                    getPerforceSettingsFromString:aString.

        PerforceSourceCodeManager 

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

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

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

        PerforceSourceCodeManager 

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

        self removeWorkSpaceForSettings:defaultSettingsString.

        self perforceError handle:[:ex|

            self reportError:ex description.

            ^nil

        ] do:[

            workSpace := self workSpaceClass newWorkSpaceFor:aString.

        ].

        workSpace isNil ifTrue:[

            ^nil

        ].

        self perforceWorkspaces at:aString put:workSpace.

        defaultSettingsString := aString.

    ].

    "Modified: / 01-06-2012 / 11:06:24 / cg"

!

utilities

    "Returns 'utilities' object that can be used by tools. 

     By default, it returns an instance of

     SourceCodeManagerUtilities with receiver as its

     manager, but individual managers may override this

     method and supply its own, customized utilities."

    ^ PerforceSourceCodeManagerUtilities forManager: self

    "Created: / 10-10-2011 / 15:10:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 21-12-2011 / 20:05:31 / cg"

!

verboseSourceCodeAccess

    ^ Verbose

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

!

verboseSourceCodeAccess:aBoolean

    Verbose := aBoolean

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

!

workSpaceClass

    ^ PerforceSourceCodeManagerUtilities workSpaceClass

    "Modified: / 01-06-2012 / 11:14:15 / cg"

! !

!PerforceSourceCodeManager class methodsFor:'actions'!

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

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    ^self checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage force:force submit:false

!

checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage force:force submit:doSubmit

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    |className answer allLabel allValue 

     nameOfVersionMethodInClasses requestMessage locDoSubmit|

    locDoSubmit := doSubmit.

    className := aClass name.

    nameOfVersionMethodInClasses := self nameOfVersionMethodInClasses.

    aClass revision isNil ifTrue:[ 

        force ifFalse:[

            ('PerforceSourceCodeManager [warning]: class ' , className, ' has no revision string') errorPrintCR.

            AbortAllOperationWantedQuery query ifTrue:[

                allLabel := #('Cancel All').

                allValue := #(cancelAll).

            ] ifFalse:[

                allLabel := #().

                allValue := #().

            ].

            ((aClass theMetaclass includesSelector:#version)

               or:[aClass theMetaclass includesSelector: nameOfVersionMethodInClasses]) ifTrue:[

                requestMessage := ('Class %1 has no (usable) revision string.\\Check in as newest ?' bindWith:className allBold) withCRs.

            ] ifFalse:[

                requestMessage := ('Class %1 has no revision string.\\Check in as newest ?' bindWith:className allBold) withCRs.

            ].

            answer := OptionBox 

                        request: requestMessage

                        label:'Confirm'

                        buttonLabels:(allLabel , #('Cancel' 'CheckIn' 'CheckIn & Submit')) 

                        values:(allValue , #(false #checkIn #checkInAndSubmit ))

                        default:#checkIn.

            answer == false ifTrue:[ AbortSignal raise. ^ false ].

            answer == #cancelAll ifTrue:[ AbortAllSignal raise. ^ false ].

            answer == #checkInAndSubmit ifTrue:[ locDoSubmit := true ].

        ]

    ].

    "Ensure that the method #version_XXX is present before checking in XXX. 

     It will be missing when checking in classes with only the old method #version"

"/ this is wrong - it would add the SVN-id as CVS id...

"/    (aClass theMetaclass includesSelector: nameOfVersionMethodInClasses) ifFalse: [

"/        versionAsKnownBefore := aClass revisionString.   "/ looks in the old version (non-repository based)

"/

"/        self 

"/            compileVersionMethod:nameOfVersionMethodInClasses 

"/            of:aClass 

"/            for:(versionAsKnownBefore ? ('$' , 'Header' , '$')).  "/ concatenated to avoid RCS expansion

"/    ].

    ^ self basicCheckinClass:aClass fileName:classFileName directory:packageDir module:moduleDir logMessage:logMessage force:force submit:locDoSubmit.

    "

     SourceCodeManager checkinClass:Array

    "

    "Created: / 11-09-1996 / 16:15:17 / cg"

    "Modified: / 25-09-1997 / 12:16:00 / stefan"

    "Modified: / 21-12-2011 / 19:30:38 / cg"

!

checkinClass:aClass logMessage:logMessage submit:doSubmit

    "checkin of a class into the source repository.

     Return true if ok, false if not."

    |sourceInfo packageDir moduleDir classFileName|

    sourceInfo := self sourceInfoOfClass:aClass.

    sourceInfo isNil ifTrue:[

        self reportError:('no sourceInfo for class: ' , aClass name).

        ^ false

    ].

    packageDir := self directoryFromSourceInfo:sourceInfo.

    moduleDir := self moduleFromSourceInfo:sourceInfo.  "/ use the modules name as CVS module

    classFileName := self containerFromSourceInfo:sourceInfo.

    ^ self 

        checkinClass:aClass 

        fileName:classFileName 

        directory:packageDir 

        module:moduleDir 

        logMessage:logMessage

        force:false

        submit:doSubmit

    "

     SourceCodeManager checkinClass:Array logMessage:'foo'

    "

    "Created: / 06-11-1995 / 18:56:00 / cg"

    "Modified: / 29-08-2006 / 12:46:28 / cg"

!

createTempDirectory:packageDir forModule:moduleDir

    "create a temp directory for checking out"

    ^ self createTempDirectory:packageDir forModule:moduleDir in:(self perforceTmpDirectory)

!

ensureDollarsInVersionMethod:aString

    "given the source code of my version method, ensure that it contains dollars for

     proper keyword expansion

     do nothing here because we dont need this - make our own version

    "

    ^aString

!

removeContainer:fileName inModule:moduleName directory:packageDir

    "remove a container"

    ^self removeContainer:fileName inModule:moduleName directory:packageDir submit:false

!

removeContainer:fileName inModule:moduleName directory:packageDir submit:doSubmit

    "remove a container"

    |cls checkInDefinition classFileName workSpace clsName|

    clsName := fileName asFilename withoutSuffix baseName.

    cls := Smalltalk at:clsName asSymbol ifAbsent:nil.

    cls isNil ifTrue:[

        self reportError:'Error removing class - ', clsName, ' not exists'.

        ^false

    ].

    classFileName := fileName.

    cls isPrivate ifTrue:[

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

        ^ false.

    ].

    checkInDefinition := CheckInDefinition new.

    checkInDefinition manager:self.

    checkInDefinition setDefinitionClass:cls.

    checkInDefinition classFileName:classFileName.

    checkInDefinition package:moduleName.

    checkInDefinition packageDir:packageDir.

    checkInDefinition setLogMessage:'Remove from Smalltalk Browser'.

    self perforceError handle:[:ex|

        self reportError:ex description.

        ex proceed.

    ] do:[

        workSpace := self getWorkSpaceForPackage:(checkInDefinition packageString).

    ].

    workSpace isNil ifTrue:[

        ^ false

    ].

    checkInDefinition workSpace:workSpace.

    self perforceError handle:[:ex|

        self reportError:ex description.

        ex proceed.

    ] do:[

        ^ workSpace delete:checkInDefinition submit:doSubmit.

    ].

    ^true

"

    self removeContainer:'ActionNQualifier.st' inModule:'applistx' directory:'util/libDataType'

"

!

savePreferencesOn:aStream

    aStream nextPutLine:'PerforceSourceCodeManager notNil ifTrue:['.

    self repositoryInfoPerModule notEmptyOrNil ifTrue:[

    ].

    PerforceExecutable notNil ifTrue:[

    ].

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

    ].

    aStream nextPutLine:'].'.

!

submit

    self perforceWorkspaces do:[:aWorkSpace | 

        self perforceError handle:[:ex|

            self reportError:ex description.

            ex proceed.

        ] do:[

            aWorkSpace submit.

        ].

    ].

! !

!PerforceSourceCodeManager class methodsFor:'basic administration'!

basicCheckinClass:cls fileName:classFileName directory:packageDir module:moduleName logMessage:logMessage force:forceArg submit:doSubmit

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

    ^self basicCheckinClass:cls 

    fileName:classFileName 

    directory:packageDir 

    module:moduleName 

    logMessage:logMessage 

    force:forceArg 

    submit:doSubmit

    fileContents:nil.

!

basicCheckinClass:cls 

    fileName:classFileName 

    directory:packageDir 

    module:moduleName 

    logMessage:logMessage 

    force:forceArg 

    submit:doSubmit

    fileContents:fileContents

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

    |binRevision checkInDefinition workSpace initialResult revisionBeforeCheckin 

   revisionInfoBeforeCheckin revisions revisionInfo locRevision revisionState result|

    (cls notNil and:[cls isPrivate]) ifTrue:[

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

        ^ false.

    ].

    checkInDefinition := CheckInDefinition new.

    checkInDefinition manager:self.

    checkInDefinition setDefinitionClass:cls.