--- a/CVSSourceCodeManager.st Wed Dec 03 12:34:03 2003 +0100
+++ b/CVSSourceCodeManager.st Wed Dec 10 09:34:19 2003 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-"{ Package: 'stx:libbasic3' }"
+"{ Package: 'unknown' }"
AbstractSourceCodeManager subclass:#CVSSourceCodeManager
instanceVariableNames:''
@@ -20,4358 +20,11 @@
category:'System-SourceCodeManagement'
!
-!CVSSourceCodeManager 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
-"
- SourceCodeManager which accesses the sourcecode through cvs.
- It requires the shell environment variable CVSROOT to be set
- to the top of the repository tree. (or alternatively, the CVSRoot
- variable being set by a private.rc file).
- Under that top, for each module (especially the stx module itself),
- a subdirectory containing that modules directories must exist.
-
- If not specified otherwise, the module defaults to 'stx'.
- If a class has its home in another module, it has to be compiled
- with a corresponding entry in the package string (see below).
- Within a module, classes are organized in classlibraries, and the corresponding
- source code is found in various subdirectories of CVSROOT. The directories
- name can also be provided by the package string - if not, it defaults to the
- libraries name.
- The package string controls all this, and is REQUIRED in order for the sourceCodeManager
- to be able to retrieve a classes source.
- The package strings format is:
- '...any infotext....(sourceCodeInfo)'
- the sourceCOdeInfo consists of multiple entries, separated by colons.
- The following formats are allowed:
- (libraryName) - module defaults to 'stx'; directory to the name of the library
- (foo/bar/x) - module defaults to 'stx'; dir is 'foo/bar/x'; library name defaults to x
- (module:directory:libname) - specifies all components
- The first formats are intermediate, for backward compatibility. We urge everyone
- to use the last format (by changing the Make.proto files and add a -P flag to
- the stc compiler flags (see libbasic/Make.proto as an example).
-
- Notice, that the sourceCodeManager is (currently) only consulted, if no
- source subdirectory exists, or no source file is found there. If it does exist,
- that one is supposed to contain an up-to-date version of the classes source
- (this is temporary - in the future the probe order will be reversed, trying
- the source repository first).
- The source directory is required for systems which do NO source code control.
-
- Setup:
- - make certain, that the commands 'cvs' and 'co' are available on your system.
- - add setup for the CVSROOT environment variable to your .bashrc / .login / .profile
- - Make certain that either no local source directory exists, or it is empty or it contains
- only source code for files NOT found in the repository (this will not be required in future versions).
-
- Caveat:
- currently, the rcs container is accessed directly, since cvs mangles the files ident-string and
- thus does not correctly recreate the original file (all source is offset by some characters w.r.t. the
- compiled file).
- Therefore, sevrer-mode CVS is not supported.
-
- [class variables:]
- CVSTempDir <String | nil> where a directory tree is
- generated temporarily for checkin/checkout
- (default is nil -> current dir)
-
- CVSRoot <String> the CVS root. Imported from the
- CVSROOT shell variable.
-
- RemoteCVS <Boolean> if true, remote CVS access is used
- (i.e. via a socket to a CVS server).
- if false, disk access is used;
- files in CVSRoot must be accessable.
-
- CVSWorkDirectory not yet supported/implemented.
- PLANNED: name of a directory hierarchy,
- which is kept in sync with the current
- version.
-
- CVSBinDir where the CVS commands are found
-
- CVSModuleRoots <Directory> per-module roots.
- If empty, or no entry is found for a
- module is found, CVSRoot is used.
- Otherwise, specifies a per-module CVSRoot.
- (allows multiple CVS hierarchies)
-
- [author:]
- Claus Gittinger
-
- [see also:]
- ( cvs manual page :man: cvs )
- ( Coding style used in Smalltalk/X classes :html: programming/codingStyle.html )
-
- [restrictions:]
- commercial version only
-"
-!
-
-examples
-"
- Default setup:
- This setup accesses all sources from a single repository: /files/CVS.
- Actually, this is the setup as used within eXept for development.
-
- CVSSourceCodeManager initializeForRepository:'/files/CVS'.
-
-
- Dual repository setup:
- This accesses all ST/X standard classes' source from the /files/CVS
- repository, while your private classes are created in and accessed from
- '/files/myCVS'.
- This setup is useful, if you need revision management on the
- ST/X standard classes as well as for your own classes.
- In order to do this, you should (manually) check in all ST/X classes
- into a private repository WHILE preserving the original revision numbers.
- A shell-procedure similar to:
-
- for i in lib*/*.st
- do
- id=`ident $i`
- set $id
- rev=$3
- ci -r$rev <CVSDIR>/$i $i
- done
-
- should acomplish this.
- Now, that you have all ST/X files in your own repository (and with the
- original revision numbers), access is possible by defining CVSROOT
- as above. However, in order to have your own files being stored in
- another repository, you have to give a per-module repository.
-
- This defines the default repository (for your containers):
-
- CVSSourceCodeManager initializeForRepository:'/files/myCVS'.
-
- and this specifies a repository for all standard ST/X classes (in the stx module):
-
- CVSSourceCodeManager repositoryName:'/files/CVS' forModule:'stx'
-
- Dual repository setup for eXept customers with a full licence
- (these can access our in-house master repository, for convenient software update
- and uploading):
- All class sourcees under the 'stx' module (i.e. packageID is 'stx:*') can be accessed
- from the eXept cvs server (i.e. CVSROOT for them is :pserver:userName@exept.de:/files/CVS/stc).
- All local classes should be maintained in and accessed from a local cvs repository
- such as '/files/myCVS'.
-
- Then, tell the CVSSourceCodeManager about this;
- first the default repository:
-
- CVSSourceCodeManager initializeForRepository:'/files/myCVS'.
-
- and the repository for all standard ST/X classes (in the stx module):
-
- CVSSourceCodeManager repositoryName:':pserver:userName@exept.de:/files/CVS' forModule:'stx'
-"
-! !
-
-!CVSSourceCodeManager class methodsFor:'initialization'!
-
-forgetDisabledModules
- DisabledModules := nil.
-!
-
-initCommands
- CMD_checkout := 'cvs -n checkout %1'.
-!
-
-initialize
- "check if $CVSROOT (the shell variable) or CVSRoot (the smalltalk global)
- is set, check if cvs commands can be executed and install myself as the
- SourceCodeManager if this works out ok"
-
- | s f top ok triedPath cvsCmd cmdName |
-
- DisabledModules := nil.
-
- "/ where a temporary directory hierarchy is
- "/ created for checkin/checkout
-
- CVSTempDir ifNil:[
- CVSTempDir := Filename tempDirectory pathName
- ].
-
- "/
- "/ if CVSROOT is non-empty and both cvs and co are available
- "/ as commands, assume this system uses a cvs source code management.
- "/
- CVSRoot ifNil:[
- CVSRoot := OperatingSystem getEnvironment:'CVSROOT'
- ].
-
- CVSRoot ifNil:[
- "disabled since $CVSROOT is not set"
- ^ self
- ].
-
- OperatingSystem isMSDOSlike ifTrue:[
- cvsCmd := 'cvs.exe'
- ] ifFalse:[
- cvsCmd := 'cvs'
- ].
-
- CVSBinDir size > 0 ifTrue:[
- OperatingSystem isMSDOSlike ifTrue:[
- cmdName := CVSBinDir asFilename constructString:cvsCmd.
- ( OperatingSystem canExecuteCommand:cmdName) ifFalse:[
- CVSBinDir := ''.
- ] ifTrue:[
- CVSBinDir := CVSBinDir asFilename pathName
- ]
- ]
- ].
-
- CVSBinDir size == 0 ifTrue:[
- CVSBinDir := ''.
- (ok := OperatingSystem canExecuteCommand:cvsCmd) ifFalse:[
- "/ mhmh - no cvs;
-
- OperatingSystem isUNIXlike ifTrue:[
- triedPath := #( '/usr/local/bin' ).
- ] ifFalse:[
- OperatingSystem isMSDOSlike ifTrue:[
- triedPath := Array with:'c:\bin'
- with:(Filename currentDirectory pathName)
- with:(OperatingSystem stxBinDirPath ? 'c:\windows').
- ] ifFalse:[
- triedPath := #()
- ]
- ].
-
- triedPath do:[:eachTriedDir |
- ok ifFalse:[
- (OperatingSystem canExecuteCommand:(eachTriedDir asFilename constructString:cvsCmd)) ifTrue:[
- ok := true.
- CVSBinDir := eachTriedDir.
- ]
- ]
- ].
- ].
- ] ifFalse:[
- ok := OperatingSystem canExecuteCommand:(CVSBinDir asFilename constructString:cvsCmd).
- ].
-
- ok ifFalse:[
- 'CVSSourceCodeManager [warning]: disabled since no >> cvs << command found' infoPrintCR.
- ^ self
- ].
-
-"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'co')) ifFalse:[
-"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> co << command found' infoPrintCR.
-"/ ].
-"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'rlog')) ifFalse:[
-"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> rlog << command found' infoPrintCR.
-"/ ].
-"/ (OperatingSystem canExecuteCommand:(CVSBinDir , 'patch')) ifFalse:[
-"/ 'CVSSourceCodeManager [warning]: limited functionality - no >> patch << command found' infoPrintCR.
-"/ ].
-
- RemoteCVS := true.
- UseWorkTree := false.
-
- CacheDirectoryName ifNil:[
- self initCacheDirPath.
- ].
- CachingSources ifNil:[
- CachingSources := true.
- ].
-
- "/
- "/ check if there is an stx directory there
- "/
- ((f := CVSRoot asFilename) isDirectory
- and:[(top := f construct:'stx') isDirectory
- and:[top isReadable]]) ifTrue:[
- RemoteCVS := false
- ].
-
- Smalltalk at:#SourceCodeManager put:self.
- DefaultManager := self.
-
- ('CVSSourceCodeManager [info]: repository CVSROOT is ''' , CVSRoot , '''.') infoPrintCR.
- RemoteCVS ifTrue:[
- 'CVSSourceCodeManager [info]: assume remote CVS mode (no stx found in CVSROOT)' infoPrintCR.
- ^ self
- ].
-
- "/
- "/ optionally set the WorkTreeDirectoryName from $STX_WORKTREE;
- "/ if non-nil, a working tree is kept there
- "/ and updated/commited files are not removed.
- "/ If you use a regular (make-) tree,
- "/ set WorkTreeDirectoryName (or the environment variable) to that.
- "/
- "/ this is not yet finished.
- "/
- s := OperatingSystem getEnvironment:'STX_WORKTREE'.
- s notNil ifTrue:[
- WorkTreeDirectoryName := s.
- UseWorkTree := true.
- ]
-
- "
- AbstractSourceCodeManager initialize
- CVSSourceCodeManager initialize
- "
-
- "
- CVSRoot := '/files/CVS'.
- AbstractSourceCodeManager initialize.
- CVSSourceCodeManager initialize.
- "
-
- "Created: / 4.11.1995 / 19:14:38 / cg"
- "Modified: / 19.12.1995 / 14:25:46 / stefan"
- "Modified: / 5.12.2001 / 18:52:00 / cg"
-!
-
-initializeForRepository:aDirectoryName
- "set the global CVSROOT directory (i.e. the repositories name).
- And reinitialize.
- Can be used from the launcher to change/configure the repository."
-
- self repositoryName:aDirectoryName.
- AbstractSourceCodeManager initialize.
- CVSSourceCodeManager initialize.
-
- "
- CVSSourceCodeManager initializeForRepository:'/files/CVS'
- CVSSourceCodeManager initializeForRepository:'ibm:/files/CVS'
- "
-
- "Created: / 13.8.1997 / 17:20:57 / cg"
- "Modified: / 25.9.1997 / 12:28:05 / stefan"
- "Modified: / 2.11.1997 / 17:08:27 / cg"
-! !
-
-!CVSSourceCodeManager class methodsFor:'accessing'!
-
-cvsBinDirectory
- "return the name of the bin repository.
- Thats the directory, where the cvs / cvs.exe command is found."
-
- ^ CVSBinDir
-!
-
-cvsBinDirectory:aString
- "set the name of the bin repository.
- Thats the directory, where the cvs / cvs.exe command is found."
-
- aString isEmpty ifTrue:[
- CVSBinDir := aString
- ] ifFalse:[
- CVSBinDir := aString asFilename pathName.
- (CVSBinDir endsWith:Filename separator) ifTrue:[
- CVSBinDir := CVSBinDir copyWithoutLast:1.
- ]
- ].
-!
-
-repositoryName
- "return the name of the global repository.
- This is used, if no per-module repository is defined."
-
- ^ CVSRoot
-
- "Created: 14.9.1996 / 13:22:05 / cg"
- "Modified: 19.9.1997 / 06:12:02 / cg"
-!
-
-repositoryName:aDirectoryName
- "set the name of the repository;
- thats the name of the global CVSROOT directory, which is used
- if no specific repository was defined for a module.
- Can be used from an rc-script, to override the CVSROOT shell
- variable setting."
-
- DisabledModules := nil.
- CVSRoot := aDirectoryName.
-
- "Created: 14.9.1996 / 13:22:24 / cg"
- "Modified: 19.9.1997 / 06:10:31 / cg"
-!
-
-repositoryName:aRepositoryName forModule:aModuleName
- "set the CVSROOT directory which provides the sources for all
- classes in a particular module.
- This can be used from an rc-script, to specify a repository
- for a particular module.
- If left unspecified, the global (i.e. fallBack) repository is used."
-
- DisabledModules := nil.
- CVSModuleRoots isNil ifTrue:[
- CVSModuleRoots := Dictionary new.
- ].
- CVSModuleRoots at:aModuleName put:aRepositoryName
-
- "Modified: 19.9.1997 / 06:09:40 / cg"
-!
-
-repositoryNameForModule:aModuleName
- "return the CVSROOT directory which provides the sources for all
- classes in a particular module.
- Nil is returned for unspecified moduleRoots; in this case,
- the global (i.e. fallBack) repository will be used for source access."
-
- CVSModuleRoots isNil ifTrue:[^nil].
- ^ CVSModuleRoots at:aModuleName ifAbsent:nil.
-
- "Modified: 19.9.1997 / 06:09:40 / cg"
- "Created: 19.9.1997 / 06:13:06 / cg"
-!
-
-repositoryNamesPerModule
- "return 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."
-
- ^ CVSModuleRoots ? (Dictionary new)
-!
-
-repositoryNamesPerModule: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."
-
- CVSModuleRoots := aDictionary
-! !
-
-!CVSSourceCodeManager class methodsFor:'private'!
-
-checkOut:relativeFilename module:moduleDir in:tempdir
- "checkout realtiveFilename in tempdir"
-
- |cmd|
-
- cmd := 'checkout -l ' , relativeFilename.
- ^ self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- log:false
-
-
- "
- self checkOut:'stx/libbasic/Integer.st' asFilename in:'/tmp' asFilename
- "
-
- "Created: / 18.1.2000 / 20:30:01 / cg"
- "Modified: / 18.1.2000 / 20:35:06 / cg"
-!
-
-checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle
- "trouble checking in - open a dialog"
-
- ^ self
- checkinTroubleDialog:title
- message:message
- log:log
- abortable:abortable
- option:optionTitle
- option2:nil
-
- "Created: 10.12.1995 / 17:34:33 / cg"
- "Modified: 12.9.1996 / 02:39:06 / cg"
-!
-
-checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle option2:optionTitle2
- ^self
- checkinTroubleDialog:title
- message:message
- log:log
- abortable:abortable
- option:optionTitle
- option2:optionTitle2
- option3:nil
-!
-
-checkinTroubleDialog:title message:message log:log abortable:abortable option:optionTitle option2:optionTitle2 option3:optionTitle3
- "trouble checking in - open a dialog"
-
- |l box list listView optionPressed option2Pressed option3Pressed|
-
- l := log collect:[:line | line withTabsExpanded].
- list := SelectionInList with:l.
-
- box := Dialog new.
- box label:(title).
-
- (box addTextLabel:message) borderWidth:0.
-
- listView := SelectionInListView on:list.
- listView disable.
- listView height:200.
- box addComponent:(HVScrollableView forView:listView miniScrollerH:true) tabable:false.
- box addVerticalSpace.
-
- abortable ifTrue:[
- box addAbortButton
- ].
- optionTitle notNil ifTrue:[
- box addOkButton:(Button label:optionTitle action:[optionPressed := true. box hide]).
- ].
- optionTitle2 notNil ifTrue:[
- box addOkButton:(Button label:optionTitle2 action:[option2Pressed := true. box hide]).
- ].
- optionTitle3 notNil ifTrue:[
- box addOkButton:(Button label:optionTitle3 action:[option3Pressed := true. box hide]).
- ].
- box addOkButton.
-
- box extent:(box preferredExtent).
- box minExtent:box extent.
- box maxExtent:box extent.
-
- box open.
-
- box destroy.
- optionPressed == true ifTrue:[^ #option].
- option2Pressed == true ifTrue:[^ #option2].
- option3Pressed == true ifTrue:[^ #option3].
- ^ box accepted
-
- "Created: 9.9.1996 / 19:12:45 / cg"
- "Modified: 12.9.1996 / 02:39:10 / cg"
-!
-
-createEntryFor:pathInRepository module:aModule in:aDirectory revision:rev date:date special:special overwrite:overwrite
- "create an CVS/Repository and CVS/Entries entry for filename.
- If the path does not exist, it will be created
- If overwrite is true, an existing Entry will be overwritten.
- "
-
- |filename cvsRoot cvsDir name entries firstPart s path|
-
- filename := pathInRepository asFilename.
- cvsDir := (aDirectory asFilename construct:'CVS') recursiveMakeDirectory.
- entries := cvsDir construct:'Entries'.
- name := filename baseName.
- firstPart := '/', name, '/'.
-
- s := entries readStreamOrNil.
- s isNil ifTrue:[
- "/
- "/ no Repository yet, create one
- "/
- |index root|
-
- cvsRoot := self getCVSROOTForModule:aModule.
- "/
- "/ match for first '/', to get the path portion without :pserver:host:
- "/
- index := cvsRoot indexOf:$/.
- index > 0 ifTrue:[
- root := cvsRoot copyFrom:(index).
- ] ifFalse:[
- root := cvsRoot.
- ].
- "/ create Repository
- "/ (notice, contents must be a Unix filename ...
-
- s := (cvsDir construct:'Repository') writeStream.
- path := Filename components:filename directory name.
- path := path asStringWith:$/.
- s nextPutLine:(root, '/', path).
- s close.
-
- "/ make new Entries file.
- s := entries writeStream.
- ] ifFalse:[
- |newName newStream line|
-
- newName := Filename newTemporaryIn:cvsDir.
- newStream := newName writeStream.
- [(line := s nextLine) notNil] whileTrue:[
- (line findString:firstPart) ~= 1 ifTrue:[
- "/ we have found an entry for ourself.
- "/ If we do not want to overwrite it, clean up everything and return.
- overwrite ifFalse:[
- newName remove.
- newStream close.
- s close.
- ^ self
- ].
- newStream nextPutLine:line
- ].
- ].
- newName renameTo:entries.
- s close.
- s := newStream.
- ].
- s nextPutLine:firstPart, rev, '/', date, '/', special, '/'.
- s close.
-
- "
- self createEntryFor:'foo/xxx/yyy' in:'foo/xxx' revision:'1.22' date:'dummy' special:''
- self createEntryFor:'foo/xxx/yyy' in:'foo/xxx' revision:'3.44' date:'new dummy' special:'special'
- "
-
- "Created: / 19.9.1997 / 06:21:02 / cg"
- "Modified: / 7.1.1998 / 14:15:35 / stefan"
- "Modified: / 20.8.1998 / 00:12:11 / cg"
-!
-
-createLocalDirectory:packageDir inModule:moduleDir
- "create a local working directory for module/package.
- To speed up things, we checkout the file '.cvsignore', to create
- the whole tree. If the file is not present, we will create it as empty file.
- Return the name of a temporary directory containing the package"
-
- ^ self
- createLocalDirectory:packageDir
- inModule:moduleDir
- with:'.cvsignore'
-
- "
- self createLocalDirectory:'libbasic' inModule:'stx'
- "
-
- "Created: / 23.7.1999 / 19:14:28 / stefan"
- "Modified: / 26.7.1999 / 17:43:35 / stefan"
- "Modified: / 18.1.2000 / 20:56:19 / cg"
-!
-
-createLocalDirectory:packageDir inModule:moduleDir with:fileToCheckout
- "create a local working directory for module/package, and checkout the
- given file there.
- Return the name of a temporary directory containing the package, or nil"
-
- |path absolutePath tempdir workingDir unixPath|
-
- path := (moduleDir asFilename construct:packageDir) construct:fileToCheckout.
-
- tempdir := self createTempDirectory:nil forModule:nil.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
- ^ nil
- ].
-
- [
- OperatingSystem isUNIXlike ifTrue:[
- unixPath := path name.
- ] ifFalse:[
- OperatingSystem isVMSlike ifTrue:[
- self error:'VMS case not yet implemented'
- ].
- unixPath := path name copy replaceAll:$\ with:$/
- ].
-
- (self checkOut:unixPath module:moduleDir in:tempdir) ifFalse:[
- "dummy file does not exist, so create it"
-
- absolutePath := tempdir construct:path.
- absolutePath directory recursiveMakeDirectory.
- "now create the file"
- (absolutePath writeStream close) isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot create dummy') errorPrintCR.
- tempdir recursiveRemove.
- ^ nil.
- ].
-
- "now create the dummy file in the repository"
- (self import:moduleDir in:tempdir) ifFalse:[
- ('CVSSourceCodeManager [error]: cannot import dummy') errorPrintCR.
- ].
-
- "remove the path, so that checkout works"
- (tempdir construct:moduleDir) recursiveRemove.
-
- "checkout the dummy, the intermediate directories will be created"
- (self checkOut:unixPath module:moduleDir in:tempdir) ifFalse:[
- ('CVSSourceCodeManager [warning]: import failed (to create working dir)') errorPrintCR.
-"/false ifTrue:[
-"/ "/ manually create it
-"/
-"/ (tempdir construct:unixPath) directory recursiveMakeDirectory.
-"/ workingDir := tempdir.
-"/ unixPath asFilename directory components do:[:each |
-"/ self executeCVSCommand:('add ' , each) module:moduleDir inDirectory:workingDir.
-"/ workingDir := workingDir construct:each.
-"/ ].
-"/ (absolutePath writeStream close) isNil ifTrue:[
-"/ ('CVSSourceCodeManager [error]: cannot create dummy') errorPrintCR.
-"/ tempdir recursiveRemove.
-"/ ^ nil.
-"/ ].
-"/ self executeCVSCommand:('add ' , fileToCheckout) module:moduleDir inDirectory:workingDir.
-"/ self executeCVSCommand:('commit ' , fileToCheckout) module:moduleDir inDirectory:workingDir.
-"/
-"/ ^ tempdir
-"/].
- tempdir recursiveRemove.
- ^ nil.
- ].
- ].
- ] valueOnUnwindDo:[
- tempdir recursiveRemove.
- ].
-
- ^ tempdir.
-
- "
- self createLocalDirectory:'libbasic' inModule:'stx'
- "
-
- "Modified: / 26.7.1999 / 17:43:35 / stefan"
- "Created: / 18.1.2000 / 20:55:52 / cg"
- "Modified: / 18.1.2000 / 20:56:45 / cg"
-!
-
-createTempDirectory:packageDir forModule:moduleDir
- "create a temp directory for checking out"
-
- |tempdir dir|
-
- "/ if CVSTempDir isNil, use current.
- tempdir := Filename newTemporaryIn:CVSTempDir.
- tempdir exists ifTrue:[
- tempdir recursiveRemove.
- ].
- OperatingSystem errorSignal handle:[:ex |
- 'SourceCodemanager [error]: cannot create temporary directory' errorPrintCR.
- ^ nil.
- ] do:[
- tempdir makeDirectory.
- ].
-
- moduleDir notNil ifTrue:[
- dir := tempdir construct:moduleDir.
- dir makeDirectory.
-
- packageDir notNil ifTrue:[
- dir := dir construct:packageDir.
- dir recursiveMakeDirectory.
- ].
- dir exists ifFalse:[
- tempdir recursiveRemove.
- 'SourceCodemanager [error]: cannot create temporary directory' errorPrintCR.
- ^ nil.
- ].
- ].
- ^ tempdir
-
- "self createTempDirectory:'fooPackage' forModule:'fooModule'"
-
- "Created: 9.12.1995 / 19:14:35 / cg"
- "Modified: 19.12.1995 / 16:13:02 / stefan"
- "Modified: 18.8.1997 / 19:06:52 / cg"
-!
-
-cvsTimeString:absoluteTime
- "convert an absoluteTime to a string suitable for the CVS/Entries file:
-
- 123456789012345678901234
- Tue Dec 19 20:56:26 1995
- "
-
- |date time stream|
-
- date := absoluteTime asDate.
- time := absoluteTime asTime.
- stream := WriteStream on:(String new:24).
-
- (#('Mon' 'Tue' 'Wed' 'Thu' 'Fri' 'Sat' 'Sun') at:(date dayInWeek)) printOn:stream.
- stream space.
-
- (#('Jan' 'Feb' 'Mar' 'Apr' 'May' 'Jun' 'Jul' 'Aug' 'Sep' 'Oct' 'Nov' 'Dec')
- at:(date month)) printOn:stream.
- stream space.
-
- date day printOn:stream.
- stream space.
-
- time print24HourFormatOn: stream.
- stream space.
-
- date year printOn:stream.
-
- ^ stream contents
-
-
- "
- CVSSourceCodeManager cvsTimeString:(AbsoluteTime now)
- "
-
- "Modified: 20.12.1995 / 11:03:32 / stefan"
-!
-
-executeCVSCommand:cvsCommand module:moduleName inDirectory:dir
- "execute command and prepend cvs command name and global options.
- if dir ~= nil, execute command in that directory.
- This also leads to a log-entry to be added to cvs's logfile."
-
- ^ self
- executeCVSCommand:cvsCommand
- module:moduleName
- inDirectory:dir
- log:true
-
- "Modified: / 20.5.1998 / 16:07:28 / cg"
-!
-
-executeCVSCommand:cvsCommand module:moduleName inDirectory:dir log:doLog
- "execute command and prepend cvs command name and global options.
- if dir ~= nil, execute command in that directory.
- The doLog argument, if false supresses a logEntry to be added
- in the cvs log file (used when reading / extracting history)"
-
- ^ self
- executeCVSCommand:cvsCommand module:moduleName inDirectory:dir log:doLog
- pipe:false
-!
-
-executeCVSCommand:cvsCommand module:moduleName inDirectory:dirArg log:doLog pipe:doPipe
- "execute command and prepend cvs command name and global options.
- execute command in the dirArg directory.
- The doLog argument, if false supresses a logEntry to be added
- in the cvs log file (used when reading / extracting history)"
-
- |command cvsRoot rslt ok pathOfDir p dir|
-
- dir := dirArg asFilename.
- pathOfDir := dir pathName.
-
- cvsRoot := self getCVSROOTForModule:moduleName.
-
- command := CVSBinDir.
- command size > 0 ifTrue:[
- (command endsWith:Filename separator) ifFalse:[
- command := command , (Filename separator asString)
- ]
- ].
- command := command , 'cvs'.
- (command includes:Character space) ifTrue:[
- command := '"' , command , '"'
- ].
-
- doLog ifFalse:[
- command := command , ' -l'.
- ].
- command := command , ' -d "', cvsRoot, '" ', cvsCommand.
-
- Verbose == true ifTrue:[
- ('CVSSourceCodeManager [info]: executing: ' , command , ' [in ' , pathOfDir , ']') infoPrintCR.
- ].
-
- doPipe ifTrue:[
- rslt := PipeStream readingFrom:command inDirectory:pathOfDir.
- ok := rslt notNil.
- ] ifFalse:[
- Processor isDispatching ifFalse:[
- rslt := ok := OperatingSystem executeCommand:command inDirectory:pathOfDir.
- ] ifTrue:[
- p := [
- rslt := ok := OperatingSystem executeCommand:command inDirectory:pathOfDir.
- ] fork.
-
- (p waitUntilTerminatedWithTimeout:300) ifTrue:[
- ('CVSSourceCodeManager [info]: command timeout: ' , command) errorPrintCR.
- ^ false
- ].
- ].
- ].
-
- ok ifFalse:[
- ('CVSSourceCodeManager [info]: command failed: ' , command) errorPrintCR.
- ].
- ^ rslt
-
- "Modified: / 23.4.1996 / 15:24:00 / stefan"
- "Created: / 20.5.1998 / 16:06:34 / cg"
- "Modified: / 19.5.1999 / 10:43:57 / cg"
-!
-
-getCVSROOTForModule:aModuleName
- "internal: used when accessing a source repository.
- Return the CVSROOT which provides the sources for a particular module.
- If no specific root was defined for that module, return the value of
- the global (fallBack) CVSRoot.
- Nil is returned if no repository is available."
-
- |root|
-
- CVSModuleRoots isNil ifTrue:[^ CVSRoot].
- aModuleName isNil ifTrue:[^ CVSRoot].
- root := CVSModuleRoots at:aModuleName ifAbsent:nil.
- ^ root ? CVSRoot
-
- "Created: / 19.9.1997 / 06:18:07 / cg"
- "Modified: / 20.5.1998 / 16:30:12 / cg"
-!
-
-getCVSROOTsPerModule
- "return a dictionary, which associates CVSRoots to modules"
-
- ^ CVSModuleRoots ? #()
-!
-
-import:moduleDir in:tempdir
- "import the existing tree in tempdir as repository"
-
- |cmd|
-
- cmd := 'import -m "checkin from stx browser" . initialV initialR'.
- ^ self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- log:false
- "
- |f d|
- f := 'stefan/dummy/fasel'.
- d := '/tmp/tt' asFilename construct:f.
- d directory recursiveMakeDirectory.
- d writeStream close.
- self import:'stefan' in:'/tmp/tt/stefan' asFilename
- "
-
- "Created: / 23.7.1999 / 19:19:34 / stefan"
- "Modified: / 26.7.1999 / 17:46:29 / stefan"
- "Modified: / 18.1.2000 / 20:21:32 / cg"
-!
-
-releaseAndRemove:tempdir module:moduleDir outputTo:outputFilename
- "cleanup; release tree towards cvs and remove the temporary tree"
-
- |cmd redirect|
-
- outputFilename isNil ifTrue:[
- OperatingSystem isMSDOSlike ifTrue:[
- redirect := 'NUL'
- ] ifFalse:[
- redirect := '/dev/null'
- ]
- ] ifFalse:[
- redirect := outputFilename name
- ].
-
- "/
- "/ release it towards cvs
- "/
- cmd := '-l release > ' , redirect.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- log:false
- ) ifFalse:[
-"/ 'CVSMGR: failed to release: ' errorPrint. cmd errorPrintNL.
- ].
-
- tempdir recursiveRemove.
-
- "Modified: / 23.4.1996 / 14:29:49 / stefan"
- "Created: / 19.9.1997 / 06:28:02 / cg"
- "Modified: / 20.5.1998 / 16:44:07 / cg"
- "Modified: / 3.9.1999 / 14:51:29 / ps"
-!
-
-repositoryTopDirectory
- "return the top of the repository. This handles remote CVS connections
- as well"
-
- CVSRoot isNil ifTrue:[^ nil].
- ^ self repositoryTopDirectory:CVSRoot.
-
- "
- CVSSourceCodeManager repositoryTopDirectory
- "
-
- "Created: / 25.11.1995 / 18:39:19 / cg"
- "Modified: / 16.1.1998 / 17:33:31 / stefan"
-!
-
-repositoryTopDirectory:aString
- "return the top of the repository (without remote prefix)"
-
- |idx|
-
- idx := aString indexOf:$/.
- idx <= 1 ifTrue:[
- ^ aString.
- ].
- ^ aString copyFrom:idx.
-
- "
- CVSSourceCodeManager repositoryTopDirectory:':pserver:stefan@ibm.exept.de:/archiv/cvs'
- CVSSourceCodeManager repositoryTopDirectory:'exept:/files/CVS'
- CVSSourceCodeManager repositoryTopDirectory:'/archiv/cvs'
- "
-
- "Modified: / 16.1.1998 / 17:32:03 / stefan"
-!
-
-revisionStringFromLog:log entry:entry forClass:aClass
- "given a log entry, extract a revision string"
-
- |oldRev idx special|
-
- oldRev := aClass revisionString.
- special := ''.
-
- oldRev notNil ifTrue:[
- idx := oldRev lastIndexOf:$[.
- idx ~~ 0 ifTrue:[
- idx := oldRev indexOf:$[ startingAt:idx+1.
- idx ~~ 0 ifTrue:[
- special := ' ' , (oldRev copyFrom:idx).
- ]
- ].
- ].
-
- ^ '$Header: ' , (log at:#container) ,
- ' ' , (entry at:#revision) ,
- ' ' , (entry at:#date) ,
- ' ' , (entry at:#author) ,
- ' ' , (entry at:#state) ,
- ' $' ,
- special
-
- "Created: 16.9.1996 / 20:24:14 / cg"
- "Modified: 3.3.1997 / 22:31:51 / cg"
-!
-
-updatedRevisionStringOf:aClass forRevision:newRevision with:originalVersionString
- "update a revision string"
-
- |idx leftPart rightPart vsnString newVsn|
-
- "/ search for ,v
- idx := originalVersionString indexOfSubCollection:'.st,v'.
- idx == 0 ifTrue:[^ nil].
-
- leftPart := originalVersionString copyTo:(idx - 1 + 5).
- rightPart := (originalVersionString copyFrom:(idx + 5)) withoutSpaces.
- idx := rightPart indexOfSeparator.
- idx == 0 ifTrue:[^ nil].
-
- vsnString := rightPart copyTo:idx - 1.
- rightPart := rightPart copyFrom:idx + 1.
-
- newRevision isNil ifTrue:[
- (vsnString endsWith:'m') ifTrue:[
- "/ alread a modified class
-"/ ('already modified: ' , vsnString) printNL.
- ^ nil
- ].
- newVsn := vsnString , 'm'
- ] ifFalse:[
- newVsn := newRevision
- ].
-
- ^ leftPart , ' ' , newVsn , ' ' , rightPart
-
- "Created: 7.12.1995 / 20:23:38 / cg"
- "Modified: 16.9.1996 / 20:24:28 / cg"
-! !
-
-!CVSSourceCodeManager class methodsFor:'source code access'!
-
-checkin:containerFilename text:someText directory:packageDir module:moduleDir logMessage:logMessage force:force
- "enter some (source) code (which is someText)
- 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 revision logTmp
- cmdOut whatHappened s idx changeLog changesAsLogged l
- newRevision msg answer didMerge
- mySource mergedSource modulePath time
- editor checkInRepaired didAccept emphasizedText repairedText out
- emSep comment|
-
- revision := self newestRevisionInFile:containerFilename directory:packageDir module:moduleDir.
-
- logMsg := logMessage.
- (logMsg isNil or:[logMsg isEmpty]) ifTrue:[
- logMsg := 'checkin from browser'.
- ].
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- "/
- "/ in CVS, we have to checkout the file first, in order
- "/ to get up-to-date CVS entries, and also to be able to merge in
- "/ other users changes.
- "/
-
- "/
- "/ first, create a temporary work tree
- "/
- tempdir := self createTempDirectory:nil forModule:nil.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkin ' , containerFilename) errorPrintCR.
- ^ false
- ].
-
- "/
- "/ next, create CVS/Entries and CVS/Repository with version information of current version
- "/
- modulePath := moduleDir , '/' , packageDir.
- checkoutName := modulePath , '/' , containerFilename.
-
- revision isNil ifTrue:[
- "/ a new file ...
- ^ self
- createContainerForText:someText inModule:moduleDir package:packageDir container:containerFilename
- ].
-
- "/
- "/ correct our current time, so that converting it will give us UTC
- "/
- time := AbsoluteTime now subtractSeconds:1.
- time := time addSeconds:(time utcOffset).
-
- self createEntryFor:checkoutName
- module:moduleDir
- in:(tempdir construct:modulePath)
- revision:revision
- date:(self cvsTimeString:time)
- special:''
- overwrite:true.
-
- "/
- "/ copy-over our current version
- "/
- Stream errorSignal handle:[:ex|
- tempdir recursiveRemove.
- 'CVSSourceCodeManager [error]: cannot copy-over filedOut class source' errorPrintCR.
- ^ false.
- ] do:[
- s := (tempdir construct:checkoutName) writeStream.
- s nextPutAll:someText.
- s close.
- ].
-
- "/
- "/ synchronize i.e. merge in any changes
- "/
- self activityNotification:'merging ' , containerFilename , ' with repository version ...'.
-
- cmd := 'update ', containerFilename, ' >', '"' , cmdOut name , '"'.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:((tempdir construct:moduleDir) constructString:packageDir)
- ) ifFalse:[
- force ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- tempdir recursiveRemove.
- cmdOut remove.
- 'CVSSourceCodeManager [error]: cannot merge current source with repository version' errorPrintCR.
- ^ false.
- ].
- ] ifTrue:[
- "/
- "/ check what happened - the contents of the cmdOut file may be:
- "/ empty -> nothing changed
- "/ M xxx -> merged-in changes from other users
- "/ C xxx -> a conflict occured and the differences have been merged into the source
- "/ needs special action
- "/
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ].
- ].
- cmdOut remove.
-
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- "/
- "/ no change
- "/
-"/ Transcript showCR:'no change in ' , containerFilename , ' (repository unchanged)'.
- force ifFalse:[
- self information:'nothing changed in ' , containerFilename , ' (repository unchanged)'.
- ].
- tempdir recursiveRemove.
- ^ true
- ].
-
- Verbose == true ifTrue:[
- ('CVSMGR: result is: ' , whatHappened) infoPrintCR.
- ].
-
- force ifFalse:[
- revision isNil ifTrue:[
- changeLog := self revisionLogOfContainer:containerFilename directory:packageDir module:moduleDir.
- ] ifFalse:[
- changeLog := self revisionLogOfContainer:containerFilename module:moduleDir package:packageDir fromRevision:(self revisionAfter:revision) toRevision:nil.
- ].
- changeLog notNil ifTrue:[
- s := WriteStream on:String new.
- self writeRevisionLogMessagesFrom:changeLog withHeader:false to:s.
- changesAsLogged := s contents.
- ] ifFalse:[
- "/ mhmh - that should not happen
- changesAsLogged := ''.
- ].
- ].
-
- didMerge := false.
-
- "/
- "/ cvs above rel10 returns a multiline info ...
- "/ we have to extract the one line which states what happened.
- "/
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- whatHappened := whatHappened select:[:line |
- (line startsWith:'RCS file') not
- and:[(line startsWith:'retrieving') not
- and:[(line startsWith:'Merging') not
- and:[line size > 0]]]
- ].
- whatHappened := whatHappened asString.
-
- (force or:[whatHappened startsWith:'M ']) ifTrue:[
- "/
- "/ merged in changes
- "/
- (force
- or:[changeLog isNil
- or:[(changeLog at:#revisions) isEmpty]]) ifTrue:[
- "/
- "/ pretty good - nothing has changed in the meanwhile
- "/
- Transcript showCR:'checking in ' , containerFilename , ' ...'
- ] ifFalse:[
- "/
- "/ someone else has changed things in the meanwhile, but there is no conflict
- "/ and version have been merged.
- "/
- didMerge := true.
- changesAsLogged := changesAsLogged asCollectionOfLines.
-
- s := WriteStream on:String new.
- s nextPutAll:someText.
- mySource := s contents asString.
- mergedSource := (tempdir construct:checkoutName) readStream contents asString.
-
- mySource = mergedSource ifTrue:[
- msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
-
-I have merged your version with the newest repository version,
-and found no differences between the result and your current version
-(i.e. your version seemed up-to-date).'.
-
- self checkinTroubleDialog:'Merging versions'
- message:msg
- log:changesAsLogged
- abortable:false
- option:nil.
- didMerge := false.
- ] ifFalse:[
- msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
-
-If you continue, your new changes (based upon rev. ' , revision printString , ') will be MERGED
-into the newest revision. This will combine the other version with your changes
-into a new common revision which may be different from both.
-Although this is a nice feature, it may fail to create the expected result in certain situations.
-
-You should carefully check the result - by comparing the current version with the
-most recent version in the repository. If that does not contain an acceptable version,
-change methods as required and check in again.
-Be aware, that after that, the actual repository version is different from your current classes,
-and you should update your class from the repository.
-
-Continue ?'.
-
- answer := self checkinTroubleDialog:'Merging versions'
- message:msg
- log:changesAsLogged
- abortable:true
- option:'Stop - see first'.
- answer ~~ true ifTrue:[
- answer == #option ifTrue:[
- DiffTextView
- openOn:mySource
- label:'current version'
- and:mergedSource
- label:'merged version'.
-
- ].
- Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ].
- ].
-
-"/ changesAsLogged := (changesAsLogged asStringCollection collect:[:line | line withTabsExpanded]) asString.
-"/ msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as follows:
-"/' , changesAsLogged , '
-"/
-"/If you continue, your new changes (based upon rev. ' , revision , ') will be MERGED
-"/into the newest revision. This will combine the other version with your changes
-"/into a new common revision which is different from both.
-"/Although convenient, it may fail to create the expected result in certain situations.
-"/
-"/You should carefully check the result - by comparing the current version with the
-"/most recent version in the repository. If that does not contain an acceptable version,
-"/change methods as required and check in again. Be aware, that the actual repository version
-"/is different from your current classes.
-"/
-"/Continue ?'.
-"/ (self confirm:msg) ifFalse:[
-"/ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
-"/ tempdir recursiveRemove.
-"/ ^ false.
-"/ ].
- Transcript showCR:'checking in ' , containerFilename , ' (merged other changes) ...'
- ]
- ] ifFalse:[
- (whatHappened startsWith:'C ') ifTrue:[
- "/
- "/ conflict; someone else checked in something in the meanwhile,
- "/ and there is a conflict between this version and the checked in version.
- "/
-
- changesAsLogged := changesAsLogged asCollectionOfLines.
-
- msg := 'The source of ' , containerFilename , ' has been changed in the meanwhile as listed below.
-
-Your new changes (based upon rev. ' , revision printString , ') CONFLICT with those changes.
-
-You should fix things by comparing your class with the most recent repository version
-and change your methods avoiding conflicts. The checkin again.
-'.
-
- answer := self checkinTroubleDialog:'Version conflict'
- message:msg
- log:changesAsLogged
- abortable:false
- option:'show conflicts'
- option2:'resolve conflicts'.
-
- answer == #option ifTrue:[
- "/
- "/ show conflicts in a 3-way DiffTextView ...
- "/
- Diff3TextView
- openOnMergedText:(tempdir construct:checkoutName) readStream contents
- label:'your version (checkin attempt)'
- label:'original (base version)'
- label:'newest repository version'.
- ].
-
- checkInRepaired := false.
- answer == #option2 ifTrue:[
- "/
- "/ allow checkin of repair version
- "/ this is error prone ...
- "/
- "/
- "/ show merged version in an editor ...
- "/ ... accept will check it in.
- "/
- emphasizedText := (tempdir construct:checkoutName) readStream contents.
- emSep := (Array with:(#color->Color black)
- with:(#backgroundColor->Color green)).
- emphasizedText := Diff3TextView
- emphasizeMergedDiff3Text:emphasizedText
- emphasize1:(Array with:(#color->Color white)
- with:(#backgroundColor->Color blue))
- emphasize2:(Array with:(#color->Color white)
- with:(#backgroundColor->Color red))
- emphasizeSep:emSep.
-
- comment :=
-'"/ ***************************************************************
-"/ This text contains your current versions code (blue)
-"/ merged with the conflicting code as found in the repository (red) which resulted
-"/ from some other checkin.
-"/ Each such conflict is surrounded by green text (like this paragraph).
-"/
-"/ Please have a look at ALL the conflicts and fix things as appropriate.
-"/ Delete the green lines as a confirmation - I will not checkin the changed text,
-"/ unless no more green parts are present. This includes this comment at the top.
-"/ ***************************************************************
-'.
- comment := (Text string:comment emphasis:emSep) asStringCollection.
- emphasizedText := comment , emphasizedText.
-
- didAccept := false. checkInRepaired := true.
- [didAccept not and:[checkInRepaired]] whileTrue:[
- editor := RCSConflictEditTextView
- setupWith:emphasizedText
- title:'Resolve conflicts in ' , containerFilename , ', then accept & close to checkin'.
-
- editor acceptAction:[:dummy |
- repairedText := editor list.
- didAccept := true.
- ].
- didAccept := false.
- editor topView openModal.
-
- didAccept ifFalse:[
- (Dialog confirm:'You did not accept the new text. Edit again ?')
- ifFalse:[
- checkInRepaired := false.
- ]
- ] ifTrue:[
- "/ check if all green-stuff (separators) have been removed
- (repairedText findFirst:[:line | line notNil and:[line notEmpty and:[(line emphasisAt:1) = emSep]]]) ~~ 0 ifTrue:[
- self warn:'You have to look at ALL conflicts, and remove ALL green lines as a confirmation !!'.
- didAccept := false.
- ]
- ].
-
- ].
-
- checkInRepaired ifTrue:[
- [
- out := (tempdir construct:checkoutName) writeStream.
- out nextPutAll:(repairedText asString string).
- didAccept := true.
- out close.
- ] on:FileStream openErrorSignal do:[:ex|
- self warn:'could not write file ' , (tempdir constructString:checkoutName).
- checkInRepaired := false.
- ].
- ]
- ].
-
- checkInRepaired ifTrue:[
- Transcript showCR:'checking in ' , containerFilename , ' (manually repaired version) ...'
- ] ifFalse:[
- 'CVSSourceCodeManager [warning]: cannot (for now) checkin; conflicts found' infoPrintCR.
- Transcript showCR:'checkin of ' , containerFilename , ' aborted (conflicting changes; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ]
- ] ifFalse:[
- (whatHappened startsWith:'U ') ifTrue:[
- "/
- "/ nothing changed here, but the repository already contains
- "/ a newer version.
- "/
- tempdir recursiveRemove.
-
- self information:'nothing changed in your ''' , containerFilename , ''';
-but repository already contains a newer version (repository unchanged).'.
- ^ true.
- ] ifFalse:[
- "/
- "/ unexpected
- "/
- self warn:'unexpected message from CVS:
-' , whatHappened , '
-
-No checkin performed.'.
- Transcript showCR:'*** cannot checkin ' , containerFilename , ' (unexpected CVS response; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ]
- ]
- ].
-
-
- "/
- "/ now check it in again
- "/
- self activityNotification:'saving ' , containerFilename , ' in repository ...'.
-
- logMsg := logMsg replChar:$" withString:'\"'.
-
- OperatingSystem isUNIXlike ifFalse:[
- "/ save the log message into another tempFile ...
- logTmp := Filename newTemporaryIn:tempdir.
- s := logTmp writeStream.
- s nextPutAll:logMsg.
- s close.
-
- cmd := 'commit -F "', logTmp baseName, '" ', checkoutName, ' >', '"' , cmdOut name , '"'.
- ] ifTrue:[
- "/
- "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
- "/ CVS V1.9.16 to stdout.
- "/
- cmd := 'commit -m "', logMsg, '" ', checkoutName, ' >', '"' , cmdOut name , '"' , ' 2>&1'.
- ].
-
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := '<< no message >>'
- ].
- self warn:'The following problem was reported by cvs:
-
-' , whatHappened , '
-
-The class has NOT been checked into the repository.'.
-
- ('CVSSourceCodeManager [error]: cvs: ' , whatHappened) errorPrintCR.
- 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
- logTmp notNil ifTrue:[logTmp remove].
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
- logTmp notNil ifTrue:[logTmp remove].
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := nil
- ].
-
- tempdir recursiveRemove.
- cmdOut remove.
-
- "/
- "/ fetch the new revision nr as found in the commit commands output
- "/
-
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- 'CVSSourceCodeManager [error]: unexpected empty checkin command output' errorPrintCR.
- ] ifFalse:[
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- idx := whatHappened indexOfLineStartingWith:'new revision:'.
- idx == 0 ifTrue:[
- 'CVSSourceCodeManager [error]: unexpected checkin command output (no new-revision info)' errorPrintCR.
- ] ifFalse:[
- l := whatHappened at:idx.
- newRevision := (l copyFrom:14 to:(l indexOf:$; startingAt:14)-1) withoutSpaces.
- ]
- ].
- ^ true
-!
-
-checkinClass:cls fileName:classFileName directory:packageDir module:moduleDir source:sourceFileName logMessage:logMessage force:forceArg
- "enter a classes source code (which has been already filed out into sourceFileName)
- 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 revision logTmp
- cmdOut whatHappened s entry idx changeLog changesAsLogged l
- newRevision newString binRevision className msg answer didMerge
- mySource mergedSource modulePath time
- editor checkInRepaired checkInNew didAccept emphasizedText repairedText out
- emSep comment force|
-
- force := forceArg.
-
- className := cls name.
- cls isPrivate ifTrue:[
- self error:'refuse to check in private classes.'.
- ].
- revision := cls revision.
- (revision notNil
- and:[revision endsWith:$m])
- ifTrue:[
- "/ this class has already been checked in with a merge,
- "/ but not reloaded from the repository.
- "/ must use the original revision string.
- revision := revision copyWithoutLast:1.
- ].
- (binRevision := cls binaryRevision) notNil ifTrue:[
- revision ~= binRevision ifTrue:[
- ('CVSSourceCodeManager [info]: class ' , className , ' is based upon ' , binRevision , ' but has revision ' , (revision ? '?')) infoPrintCR
- ]
- ].
-
- revision isNil ifTrue:[
- revision := self newestRevisionOf:cls.
- revision isNil ifTrue:[
- force ifTrue:[
- revision := self newestRevisionInFile:classFileName directory:packageDir module:moduleDir.
- ] ifFalse:[
- revision := '1.0'
- ]
- ]
- ].
-
- logMsg := logMessage.
- (logMsg isNil or:[logMsg isEmpty]) ifTrue:[
- logMsg := 'checkin from browser'.
- ].
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- "/
- "/ in CVS, we have to checkout the file first, in order
- "/ to get up-to-date CVS entries, and also to be able to merge in
- "/ other users changes.
- "/
-
- "/
- "/ first, create a temporary work tree
- "/
- tempdir := self createTempDirectory:nil forModule:nil.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkin ' , className) errorPrintCR.
- ^ false
- ].
-
- "/
- "/ next, create CVS/Entries and CVS/Repository with version information of current version
- "/
- modulePath := moduleDir , '/' , packageDir.
- checkoutName := modulePath , '/' , classFileName.
-
- "/
- "/ correct our current time, so that converting it will give us UTC
- "/
- time := AbsoluteTime now subtractSeconds:1.
- time := time addSeconds:(time utcOffset).
-
- self createEntryFor:checkoutName
- module:moduleDir
- in:(tempdir construct:modulePath)
- revision:revision
- date:(self cvsTimeString:time)
- special:''
- overwrite:true.
-
- "/
- "/ copy-over our current version
- "/
- Error handle:[:ex|
- tempdir recursiveRemove.
- 'CVSSourceCodeManager [error]: cannot copy-over filedOut class source' errorPrintCR.
- ^ false.
- ] do:[
- sourceFileName asFilename copyTo:(tempdir construct:checkoutName).
- ].
-
- "/
- "/ synchronize i.e. merge in any changes
- "/
- self activityNotification:'merging ' , cls name , ' with repository version ...'.
-
- cmd := 'update ', classFileName, ' >', '"' , cmdOut name , '"'.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:((tempdir construct:moduleDir) constructString:packageDir)
- ) ifFalse:[
- force ifFalse:[
- "/ someone fiddled around with repository ?
- (cls binaryRevision notNil
- and:[(self checkForExistingContainerInModule:moduleDir package:packageDir container:classFileName) not ])
- ifTrue:[
- (Dialog confirm:('Someone seems to have removed the source container for ' , cls name , '\\Force new checkin ?') withCRs)
- ifTrue:[
- cls setBinaryRevision:nil.
- ^ self checkinClass:cls fileName:classFileName directory:packageDir module:moduleDir source:sourceFileName logMessage:logMessage force:force.
- ].
- ].
- ].
- force ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- tempdir recursiveRemove.
- cmdOut remove.
- 'CVSSourceCodeManager [error]: cannot merge current source with repository version' errorPrintCR.
- ^ false.
- ].
- ] ifTrue:[
- "/
- "/ check what happened - the contents of the cmdOut file may be:
- "/ empty -> nothing changed
- "/ M xxx -> merged-in changes from other users
- "/ C xxx -> a conflict occured and the differences have been merged into the source
- "/ needs special action
- "/
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ].
- ].
- cmdOut remove.
-
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- "/
- "/ no change
- "/
-"/ Transcript showCR:'no change in ' , className , ' (repository unchanged)'.
- tempdir recursiveRemove.
-
- force ifFalse:[
-"/ (ChangeSet current includesChangeForClass:cls) ifTrue:[
-"/ (self confirm:('Nothing changed in %1 (repository unchanged).\\Remove entries from changeSet ?' bindWith:className) withCRs) ifTrue:[
-"/ ChangeSet current condenseChangesForClass:cls.
-"/ ].
-"/ ] ifFalse:[
- self information:('Nothing changed in %1 (repository unchanged)' bindWith:className).
-"/ ].
- self postCheckInClass:cls.
- ] ifTrue:[
- changeLog := self revisionLogOfContainer:classFileName directory:packageDir module:moduleDir.
- (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
- 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR.
- cls updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS expansion
- ] ifFalse:[
- entry := (changeLog at:#revisions) first.
- newString := self revisionStringFromLog:changeLog entry:entry forClass:cls.
- cls updateVersionMethodFor:newString.
- cls revision ~= newRevision ifTrue:[
- 'CVSSourceCodeManager [error]: failed to update revisionString' errorPrintCR
- ]
- ]
- ].
-
- ^ true
- ].
-
- Verbose == true ifTrue:[
- ('CVSMGR: result is: ' , whatHappened) infoPrintCR.
- ].
-
- force ifFalse:[
- revision isNil ifTrue:[
- changeLog := self revisionLogOf:cls.
- ] ifFalse:[
- changeLog := self revisionLogOf:cls fromRevision:(self revisionAfter:revision) toRevision:nil.
- ].
- changeLog notNil ifTrue:[
- s := WriteStream on:String new.
- self writeRevisionLogMessagesFrom:changeLog withHeader:false to:s.
- changesAsLogged := s contents.
- ] ifFalse:[
- "/ mhmh - that should not happen
- changesAsLogged := ''.
- ].
- ].
-
- didMerge := false.
- checkInRepaired := checkInNew := false.
-
- "/
- "/ cvs above rel10 returns a multiline info ...
- "/ we have to extract the one line which states what happened.
- "/
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- whatHappened := whatHappened select:[:line |
- (line startsWith:'RCS file') not
- and:[(line startsWith:'retrieving') not
- and:[(line startsWith:'Merging') not
- and:[line size > 0]]]
- ].
- whatHappened := whatHappened asString.
-
- (force or:[whatHappened startsWith:'M ']) ifTrue:[
- "/
- "/ merged in changes
- "/
- (force
- or:[changeLog isNil
- or:[(changeLog at:#revisions) isEmpty]]) ifTrue:[
- "/
- "/ pretty good - nothing has changed in the meanwhile
- "/
- Transcript showCR:'checking in ' , className , ' ...'
- ] ifFalse:[
- "/
- "/ someone else has changed things in the meanwhile, but there is no conflict
- "/ and version have been merged.
- "/
- didMerge := true.
- changesAsLogged := changesAsLogged asCollectionOfLines.
-
- s := WriteStream on:String new.
- cls fileOutOn:s withTimeStamp:false.
- mySource := s contents asString.
- mergedSource := (tempdir construct:checkoutName) readStream contents asString.
-
- mySource = mergedSource ifTrue:[
- msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
-
-I have merged your version with the newest repository version,
-and found no differences between the result and your current version
-(i.e. your version seemed up-to-date).'.
-
- self checkinTroubleDialog:'Merging versions'
- message:msg
- log:changesAsLogged
- abortable:false
- option:nil.
- didMerge := false.
- ] ifFalse:[
- msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
-
-If you continue, your new changes (based upon rev. ' , revision printString , ') will be MERGED
-into the newest revision. This will combine the other version with your changes
-into a new common revision which may be different from both.
-Although this is a nice feature, it may fail to create the expected result in certain situations.
-
-You should carefully check the result - by comparing the current version with the
-most recent version in the repository. If that does not contain an acceptable version,
-change methods as required and check in again.
-Be aware, that after that, the actual repository version is different from your current classes,
-and you should update your class from the repository.
-
-Continue ?'.
-
- answer := self checkinTroubleDialog:'Merging versions'
- message:msg
- log:changesAsLogged
- abortable:true
- option:'Stop - see first'
- option2:'Do NOT Merge - Force my Code'.
-
- answer == #option2 ifTrue:[
- (Dialog confirm:'Are you certain that you want to suppress a merge and force your code to be checked in ?')
- ifTrue:[
- s := (tempdir construct:checkoutName) writeStream.
- cls fileOutOn:s withTimeStamp:false.
- s close.
- answer := true.
- ]
- ].
-
- answer ~~ true ifTrue:[
- answer == #option ifTrue:[
- DiffTextView
- openOn:mySource
- label:'current version'
- and:mergedSource
- label:'merged version'.
-
- ].
- Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ].
- ].
-
-"/ changesAsLogged := (changesAsLogged asStringCollection collect:[:line | line withTabsExpanded]) asString.
-"/ msg := 'The source of ' , className , ' has been changed in the meanwhile as follows:
-"/' , changesAsLogged , '
-"/
-"/If you continue, your new changes (based upon rev. ' , revision , ') will be MERGED
-"/into the newest revision. This will combine the other version with your changes
-"/into a new common revision which is different from both.
-"/Although convenient, it may fail to create the expected result in certain situations.
-"/
-"/You should carefully check the result - by comparing the current version with the
-"/most recent version in the repository. If that does not contain an acceptable version,
-"/change methods as required and check in again. Be aware, that the actual repository version
-"/is different from your current classes.
-"/
-"/Continue ?'.
-"/ (self confirm:msg) ifFalse:[
-"/ Transcript showCR:'checkin aborted - (no merge; repository unchanged)'.
-"/ tempdir recursiveRemove.
-"/ ^ false.
-"/ ].
- Transcript showCR:'checking in ' , className , ' (merged other changes) ...'
- ]
- ] ifFalse:[
- (whatHappened startsWith:'C ') ifTrue:[
- "/
- "/ conflict; someone else checked in something in the meanwhile,
- "/ and there is a conflict between this version and the checked in version.
- "/
-
- changesAsLogged := changesAsLogged asCollectionOfLines.
-
- msg := 'The source of ' , className , ' has been changed in the meanwhile as listed below.
-
-Your new changes (based upon rev. ' , revision printString , ') CONFLICT with those changes.
-
-You should fix things by comparing your class with the most recent repository version
-and change your methods avoiding conflicts. The checkin again.
-'.
-
- answer := self checkinTroubleDialog:'Version conflict'
- message:msg
- log:changesAsLogged
- abortable:false
- option:'Show conflicts'
- option2:'Resolve conflicts'
- option3:'Do NOT Merge - Force my Code'.
-
- answer == #option ifTrue:[
- "/
- "/ show conflicts in a 3-way DiffTextView ...
- "/
- Diff3TextView
- openOnMergedText:(tempdir construct:checkoutName) readStream contents
- label:'your version (checkin attempt)'
- label:'original (base version)'
- label:'newest repository version'.
- ].
-
- answer == #option2 ifTrue:[
- "/
- "/ allow checkin of repair version
- "/ this is error prone ...
- "/
- "/
- "/ show merged version in an editor ...
- "/ ... accept will check it in.
- "/
- emphasizedText := (tempdir construct:checkoutName) readStream contents.
- emSep := (Array with:(#color->Color black)
- with:(#backgroundColor->Color green)).
- emphasizedText := Diff3TextView
- emphasizeMergedDiff3Text:emphasizedText
- emphasize1:(Array with:(#color->Color white)
- with:(#backgroundColor->Color blue))
- emphasize2:(Array with:(#color->Color white)
- with:(#backgroundColor->Color red))
- emphasizeSep:emSep.
-
- comment :=
-'"/ ***************************************************************
-"/ This text contains your current versions code (blue)
-"/ merged with the conflicting code as found in the repository (red) which resulted
-"/ from some other checkin.
-"/ Each such conflict is surrounded by green text (like this paragraph).
-"/
-"/ Please have a look at ALL the conflicts and fix things as appropriate.
-"/ Delete the green lines as a confirmation - I will not checkin the changed text,
-"/ unless no more green parts are present. This includes this comment at the top.
-"/ ***************************************************************
-'.
- comment := (Text string:comment emphasis:emSep) asStringCollection.
- emphasizedText := comment , emphasizedText.
-
- didAccept := false. checkInRepaired := true.
- [didAccept not and:[checkInRepaired]] whileTrue:[
- editor := RCSConflictEditTextView
- setupWith:emphasizedText
- title:'Resolve conflicts in ' , className , ', then accept & close to checkin'.
-
- editor acceptAction:[:dummy |
- repairedText := editor list.
- didAccept := true.
- ].
- didAccept := false.
- editor topView openModal.
-
- didAccept ifFalse:[
- (Dialog confirm:'You did not accept the new text. Edit again ?')
- ifFalse:[
- checkInRepaired := false.
- ]
- ] ifTrue:[
- "/ check if all green-stuff (separators) have been removed
- (repairedText findFirst:[:line | line notNil and:[line notEmpty and:[(line emphasisAt:1) = emSep]]]) ~~ 0 ifTrue:[
- self warn:'You have to look at ALL conflicts, and remove ALL green lines as a confirmation !!'.
- didAccept := false.
- ]
- ].
-
- ].
-
- checkInRepaired ifTrue:[
- [
- out := (tempdir construct:checkoutName) writeStream.
- out nextPutAll:(repairedText asString string).
- didAccept := true.
- out close.
- ] on:FileStream openErrorSignal do:[:ex|
- self warn:'could not write file ' , (tempdir constructString:checkoutName).
- checkInRepaired := false.
- ].
- ]
- ].
-
- answer == #option3 ifTrue:[
- "/
- "/ force checkin of new version
- "/
- "/
- "/ show merged version in an editor ...
- "/ ... accept will check it in.
- "/
- [
- out := (tempdir construct:checkoutName) writeStream.
- out nextPutAll:(mySource asString string).
- didAccept := true.
- out close.
- checkInNew := checkInRepaired := true.
- ] on:FileStream openErrorSignal do:[:ex|
- self warn:'could not write file ' , (tempdir constructString:checkoutName).
- ].
- ].
-
- checkInRepaired ifTrue:[
- checkInNew ifTrue:[
- Transcript showCR:'checking in ' , className , ' (force new version)...'
- ] ifFalse:[
- Transcript showCR:'checking in ' , className , ' (manually repaired version)...'
- ].
- ] ifFalse:[
- 'CVSSourceCodeManager [warning]: cannot (for now) checkin; conflicts found' infoPrintCR.
- Transcript showCR:'checkin of ' , className , ' aborted (conflicting changes; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ]
- ] ifFalse:[
- ((whatHappened startsWith:'U ')
- or:[ (whatHappened startsWith:'P ') ]) ifTrue:[
- "/
- "/ nothing changed here, but the repository already contains
- "/ a newer version.
- "/
- tempdir recursiveRemove.
-
- self information:'nothing changed in your ''' , className , ''';
-but repository already contains a newer version (repository unchanged).'.
- ^ true.
- ] ifFalse:[
- "/
- "/ unexpected
- "/
- self warn:'unexpected message from CVS:
-' , whatHappened , '
-
-No checkin performed.'.
- Transcript showCR:'*** cannot checkin ' , className , ' (unexpected CVS response; repository unchanged)'.
- tempdir recursiveRemove.
- ^ false.
- ]
- ]
- ].
- "/
- "/ now check it in again
- "/
- self activityNotification:'saving ' , cls name , ' in repository ...'.
-
- logMsg := logMsg replChar:$" withString:'\"'.
-
- OperatingSystem isUNIXlike ifFalse:[
- "/ save the log message into another tempFile ...
- logTmp := Filename newTemporaryIn:tempdir.
- s := logTmp writeStream.
- s nextPutAll:logMsg.
- s close.
-
- cmd := 'commit -F "', logTmp baseName, '" ', checkoutName, ' >', '"' , cmdOut name , '"'.
- ] ifTrue:[
- "/
- "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
- "/ CVS V1.9.16 to stdout.
- "/
- cmd := 'commit -m "', logMsg, '" ', checkoutName, ' >', '"', cmdOut name, '"' , ' 2>&1'.
- ].
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := '<< no message >>'
- ].
- self warn:'The following problem was reported by cvs:
-
-' , whatHappened , '
-
-The class has NOT been checked into the repository.'.
-
- 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
- logTmp notNil ifTrue:[logTmp remove].
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
- logTmp notNil ifTrue:[logTmp remove].
- (cmdOut exists and:[cmdOut fileSize > 0]) ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := nil
- ].
-
- tempdir recursiveRemove.
- cmdOut remove.
-
- "/
- "/ fetch the new revision nr as found in the commit commands output
- "/
-
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- 'CVSSourceCodeManager [error]: unexpected empty checkin command output' errorPrintCR.
- ] ifFalse:[
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- idx := whatHappened indexOfLineStartingWith:'new revision:'.
- idx == 0 ifTrue:[
- 'CVSSourceCodeManager [error]: unexpected checkin command output (no new-revision info)' errorPrintCR.
- ] ifFalse:[
- l := whatHappened at:idx.
- newRevision := (l copyFrom:14 to:(l indexOf:$; startingAt:14)-1) withoutSpaces.
- ]
- ].
-
- "/
- "/ if there was no merge (i.e. the current version has been checked in unchanged):
- "/ patch the classes revisionInfo (but keep binaryRevision unchanged) to the new revision
- "/ this makes everyone here believe, that the incore version of the class is based upon
- "/ the newly checked in version.
- "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
- "/ correctly for all unchanged methodss)
- "/
- "/ if there was a merge (i.e. the repository now contains a merge of the current and some
- "/ other version):
- "/ patch the classes revisionInfo (again, keep the binaryRevision) to the old revision
- "/ and add a 'm' (for merged).
- "/ If we later checkin again, the new checkin will be again based on the current revision
- "/
- newRevision notNil ifTrue:[
- didMerge ifFalse:[
- self activityNotification:'fetch new revision number of ', cls name.
-
- changeLog := self revisionLogOf:cls fromRevision:newRevision toRevision:newRevision.
- (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
- force ifTrue:[
- changeLog := self revisionLogOfContainer:classFileName directory:packageDir module:moduleDir.
- ].
- ].
- (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
- 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR.
- cls updateVersionMethodFor:'$' , 'Header' , '$'. "/ concatenated to avoid RCS expansion
- ] ifFalse:[
- entry := (changeLog at:#revisions) first.
- newString := self revisionStringFromLog:changeLog entry:entry forClass:cls.
- cls updateVersionMethodFor:newString.
- cls revision ~= newRevision ifTrue:[
- 'CVSSourceCodeManager [error]: failed to update revisionString' errorPrintCR
- ]
- ]
- ] ifTrue:[
- newString := self updatedRevisionStringOf:cls forRevision:nil with:cls revisionString.
- cls updateVersionMethodFor:newString.
- ].
- ].
-
- Class addChangeRecordForClassCheckIn:cls.
- self postCheckInClass:cls.
-
- (checkInRepaired and:[checkInNew not]) ifTrue:[
- self information:'Now the repository contains a merge between your and the other changes.
-However, the class in your image does NOT contain the other changes.
-This will lead to more conflict-resolving whenever you check this class in again later,
-unless you load the newest (merged) version of the class from the repository.
-
-I recomment doing this as soon as possible via your browsers checkout function.'
- ].
- ^ true
-
- "
- SourceCodeManager checkinClass:Array logMessage:'testing only'
- "
-
- "Created: / 11.9.1996 / 16:16:11 / cg"
- "Modified: / 26.2.1998 / 17:34:16 / stefan"
- "Modified: / 5.11.2001 / 14:35:38 / cg"
-!
-
-checkoutModule:aModule package: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."
-
- |cvsRoot packageDir tempdir cmdOut cmd dirName|
-
- cvsRoot := self getCVSROOTForModule:aModule.
- cvsRoot isNil ifTrue:[^ false ].
-
- aPackage notNil ifTrue:[
- dirName := aModule , '/' , aPackage.
- ] ifFalse:[
- dirName := aModule.
- ].
-
- self activityNotification:'checking out everything in ' , dirName , ' ...'.
-
- tempdir := self createTempDirectory:nil forModule:nil.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
- ^ false
- ].
-
- cmd := '-l checkout ', dirName.
- OperatingSystem isUNIXlike ifTrue:[
- "/ can redirect output
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
- cmd := cmd , ' > ', '"' , cmdOut name, '"' .
- ].
-
- (self
- executeCVSCommand:cmd
- module:aModule
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- cmdOut notNil ifTrue:[cmdOut remove].
- tempdir recursiveRemove.
- ^ false
- ].
-
- cmdOut notNil ifTrue:[
-"/ listOfFiles := cmdOut contents.
- cmdOut remove
- ].
-
- packageDir := (tempdir construct:dirName).
- (packageDir isDirectory) ifFalse:[
- 'CVSSourceCodeManager [error]: checkout failed (no dir)' errorPrintCR.
- tempdir recursiveRemove.
- ^ false
- ].
-
- "/ now, invoke the block ...
- [
- aBlock value:packageDir
- ] ensure:[
- tempdir recursiveRemove.
- ].
-
- ^ true
-
- "Modified: / 28.4.1999 / 12:21:10 / cg"
-!
-
-streamForClass:cls fileName:fileName revision:revision directory:packageDir module:moduleDir cache:cacheIt
- "extract a source file and return an open readStream on it,
- or nil if the extract failed. If revision is nil or (#newest), take
- the latest; otherwise, a specific revisions source is extracted.
- The cls argument is currently ignored, but may be used in future versions,
- to validate the correct container against the class.
- To check out a file (i.e. not a classes file), leave it nil."
-
- |dir cachedSourceFilename cachedFile cmd fullName revisionArg stream
- checkoutName checkoutNameLocal fullTempName fullCachedName tempdir cmdOut
- classFileName cvsRoot tempFile revMsg|
-
- (DisabledModules notNil and:[DisabledModules includes:moduleDir]) ifTrue:[
- Transcript showCR:'cvs access for module ' , moduleDir , ' has been disabled (due to previous failure)'.
- Transcript showCR:'reenable using the launchers source&debugger dialog'.
-
- ^ nil
- ].
-
- cvsRoot := self getCVSROOTForModule:moduleDir.
- cvsRoot isNil ifTrue:[^ nil].
-
- "/ if not already existing, create a cache directory
- "/ where we deposit sources.
- "/ this is used as a cache for further requests, since
- "/ accessing the repository may be slow.
- "/ (if cvs uses a remote connection via ppp, for example)
- "/
-
- revision ~~ #newest ifTrue:[
- (dir := self sourceCacheDirectory) isNil ifTrue:[
- 'CVSSourceCodeManager [warning]: no source cache directory' errorPrintCR.
- ]
- ].
-
- classFileName := fileName.
- (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.
- ].
-
- dir notNil ifTrue:[
- cachedFile := dir construct:cachedSourceFilename.
- cachedFile exists ifTrue:[
-"/ cachedFile fileSize < 10 ifTrue:[
-"/ ('CVSSourceCodeManager [warning]: existing: ', cachedFile name , ' seems corrupted.') errorPrintCR.
-"/ cachedFile remove
-"/ ] ifFalse:[
-"/ ('CVSSourceCodeManager [info]: found existing: ', cachedFile name) infoPrintCR.
- ^ 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.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkout ' , classFileName) errorPrintCR.
- ^ nil
- ].
-
-"/ tempdir := Filename newTemporaryIn:nil.
-"/ tempdir exists ifTrue:[
-"/ tempdir recursiveRemove.
-"/ ].
-"/ tempdir makeDirectory.
-"/ dir := tempdir construct:moduleDir.
-"/ dir makeDirectory.
-"/ dir := dir construct:packageDir.
-"/ dir recursiveMakeDirectory.
-"/ dir exists ifFalse:[
-"/ tempdir recursiveRemove.
-"/ 'CVSMGR: cannot create temporary directory' infoPrintCR.
-"/ ^ nil.
-"/ ].
-
- "/
- "/ check it out there
- "/
- checkoutName := fullName.
-
- checkoutNameLocal := (moduleDir asFilename construct:packageDir) 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.
- OperatingSystem isUNIXlike ifTrue:[
- "/ can redirect output
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
- cmd := '-l checkout' , revisionArg , ' ', checkoutName , ' > ' , '"' , cmdOut name, '"' .
- ] ifFalse:[
- cmd := '-l checkout' , revisionArg , ' ', checkoutName.
- ].
-
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- cmdOut notNil ifTrue:[cmdOut remove].
- tempdir recursiveRemove.
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- "/ see if there is CVS access at all ...
- (self checkForExistingModule:moduleDir) ifFalse:[
- "/ disable
- DisabledModules isNil ifTrue:[
- DisabledModules := Set new.
- ].
- DisabledModules add:moduleDir.
- ('CVSSourceCodeManager [warning]: disabled repository access for module ' , moduleDir) errorPrintCR.
- ].
- ^ nil.
- ].
-
- cmdOut notNil ifTrue:[cmdOut remove].
- fullTempName := tempdir construct:checkoutNameLocal.
- fullCachedName := CacheDirectoryName asFilename constructString:cachedSourceFilename.
-
- fullTempName exists ifFalse:[
- ('CVSSourceCodeManager [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.
- ]
- ].
-
- self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
- ^ stream
-
- "Created: / 4.11.1995 / 19:46:20 / cg"
- "Modified: / 20.8.1997 / 16:37:11 / stefan"
- "Modified: / 23.8.2001 / 12:28:59 / cg"
-! !
-
-!CVSSourceCodeManager class methodsFor:'source code administration'!
-
-checkForExistingContainerInModule:moduleDir package:packageDir container:fileName
- "check for a container to exist"
-
- |fullName ret cvsRoot cmd tempDir|
-
- cvsRoot := self getCVSROOTForModule:moduleDir.
-
- fullName := moduleDir , '/' , packageDir , '/' , fileName.
-
- RemoteCVS ifFalse:[
- cvsRoot asFilename exists ifTrue:[
- "/
- "/ with local CVS - simply check if that file exists
- "/
- (fullName endsWith:',v') ifFalse:[
- fullName := fullName , ',v'.
- ].
- ^ (cvsRoot , '/' , fullName) asFilename exists.
- ].
- ].
-
- tempDir := self createTempDirectory:nil forModule:nil.
-
- "With remote CVS, do a no-op rtag command, which doesn't
- need a working directory, but reports missing files"
-
- (fullName endsWith:',v') ifTrue:[
- fullName := fullName copyWithoutLast:2.
- ].
-
- cmd := '-n rtag -l -F dummy '.
- [
- ret := self
- executeCVSCommand:cmd , fullName
- module:moduleDir
- "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
- "/ with a different CVSRoot in its CVS/Root file ...
- "/ cvs would complain then.
- inDirectory:(tempDir pathName)
- log:false.
- ] ensure:[
- tempDir recursiveRemove.
- ].
- ^ ret
-
- "
- CVSSourceCodeManager
- checkForExistingContainerInModule:'stx'
- package:'libbasic'
- container:'Integer.st'
-
- CVSSourceCodeManager
- checkForExistingContainerInModule:'stx'
- package:'libtool'
- container:'AboutBox.st'
-
- CVSSourceCodeManager
- checkForExistingContainerInModule:'stx'
- package:'libtool'
- container:'AboutBox.st,v'
-
- CVSSourceCodeManager
- checkForExistingContainerInModule:'stx'
- package:'libtool'
- container:'FooBar.st'
-
- CVSSourceCodeManager
- checkForExistingContainerInModule:'DPU'
- package:'test'
- container:'marks'
- "
-
- "Created: / 9.12.1995 / 19:13:37 / cg"
- "Modified: / 1.3.1999 / 19:32:55 / cg"
- "Modified: / 23.7.1999 / 17:36:58 / stefan"
-!
-
-checkForExistingModule:moduleDir
- "check for a module to exist"
-
- |ret cvsRoot cmd tempDir|
-
- self activityNotification:'checking for existing module ' , moduleDir.
-
- cvsRoot := self getCVSROOTForModule:moduleDir.
- cvsRoot isNil ifTrue:[^ false].
-
- RemoteCVS ifFalse:[
- cvsRoot asFilename exists ifTrue:[
- "/
- "/ with local CVS - simply check if that directory exists
- "/
- ^ (cvsRoot , '/' , moduleDir) asFilename isDirectory.
- ]
- ].
-
- tempDir := self createTempDirectory:nil forModule:nil.
-
- "With remote CVS, do a no-op rtag command, which doesn't
- need a working directory, but reports missing files"
-
- cmd := '-n rtag -l dummy '.
- [
- ret := self
- executeCVSCommand:cmd , moduleDir
- module:moduleDir
- "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
- "/ with a different CVSRoot in its CVS/Root file ...
- "/ cvs would complain then.
- inDirectory:(tempDir pathName)
- log:false.
- ] ensure:[
- tempDir recursiveRemove.
- ].
- ^ ret
-
- "
- CVSSourceCodeManager checkForExistingModule:'stx'
- CVSSourceCodeManager checkForExistingModule:'DPU'
- CVSSourceCodeManager checkForExistingModule:'cg'
- CVSSourceCodeManager checkForExistingModule:'aeg'
- CVSSourceCodeManager checkForExistingModule:'foo'
- "
-
- "Created: / 9.12.1995 / 19:13:37 / cg"
- "Modified: / 1.3.1999 / 19:32:59 / cg"
- "Modified: / 23.7.1999 / 17:38:59 / stefan"
-!
-
-checkForExistingModule:moduleDir package:packageDir
- "check for a package to exist"
-
- |ret cvsRoot cmd tempDir fullName |
-
- self activityNotification:'checking for existing package ' , packageDir.
-
- fullName := moduleDir , '/' , packageDir.
- cvsRoot := self getCVSROOTForModule:moduleDir.
-
- RemoteCVS ifFalse:[
- cvsRoot asFilename exists ifTrue:[
- "/
- "/ with local CVS - simply check if that directory exists
- "/
- ^ (cvsRoot , '/' , fullName) asFilename isDirectory.
- ].
- ].
-
- tempDir := self createTempDirectory:nil forModule:nil.
-
- "With remote CVS, do a no-op rtag command, which doesn't
- need a working directory, but reports missing files"
-
- cmd := '-n rtag -l -F dummy '.
- [
- ret := self
- executeCVSCommand:cmd, fullName
- module:moduleDir
- "/ cg; cannot do it in current dir, in case it contains a CVS subDirectory,
- "/ with a different CVSRoot in its CVS/Root file ...
- "/ cvs would complain then.
- inDirectory:(tempDir pathName)
- log:false.
-
- ] ensure:[
- tempDir recursiveRemove.
- ].
- ^ ret
-
- "
- CVSSourceCodeManager checkForExistingModule:'stx' package:'libbasic'
- CVSSourceCodeManager checkForExistingModule:'aeg' package:'libProgram'
- CVSSourceCodeManager checkForExistingModule:'foo' package:'libbasic'
- CVSSourceCodeManager checkForExistingModule:'foo' package:'bar'
- CVSSourceCodeManager checkForExistingModule:'cg' package:'private'
- "
-
- "Created: / 9.12.1995 / 19:13:37 / cg"
- "Modified: / 1.3.1999 / 19:33:04 / cg"
- "Modified: / 23.7.1999 / 17:39:21 / stefan"
-!
-
-createContainerFor:aClass inModule:moduleDir package:packageDir container:fileName
- "create a container - this does an initial checkin
- (i.e. cvs add & cvs commit)"
-
- |fullName tempdir checkoutName cmdOut cmd tempFile idx aStream whatHappened l newRevision
- changeLog entry newString startIdx endIdx checkInDir logTmp s|
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- fullName := moduleDir , '/' , packageDir , '/' , fileName.
- checkoutName := moduleDir , '/' , packageDir.
-
- "/
- "/ first, check out everything there - this creates the CVS helpfiles
- "/ required later.
- "/
-
- self activityNotification:'checking for directory ' , checkoutName.
- tempdir := self createLocalDirectory:packageDir inModule:moduleDir.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- ^ false.
- ].
-
- "/
- "/ create the source there
- "/
- tempFile := (tempdir construct:checkoutName) construct:fileName.
- [
- aStream := tempFile writeStream.
- ] on:FileStream openErrorSignal do:[:ex|
- ('CVSSourceCodeManager [error]: temporary fileout failed -> ', tempFile name) errorPrintCR.
- tempdir recursiveRemove.
- ^ false
- ].
-
- Class fileOutErrorSignal handle:[:ex |
- 'CVSSourceCodeManager [error]: fileout failed' errorPrintCR.
- aStream close.
- tempdir recursiveRemove.
- ^ false
- ] do:[
- aClass fileOutOn:aStream withTimeStamp:false.
- ].
- aStream close.
-
- tempFile exists ifFalse:[
- 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
- tempdir recursiveRemove.
- ^ false
- ].
-
- "/
- "/ and add it to the repository
- "/
- self activityNotification:'adding ' , fileName.
-
- OperatingSystem isUNIXlike ifTrue:[
- checkInDir := tempdir constructString:checkoutName.
- ] ifFalse:[
- OperatingSystem isMSDOSlike ifTrue:[
- checkInDir := tempdir constructString:(checkoutName copyReplaceAll:$/ with:$\).
- ] ifFalse:[
- self error:'VMS case not yet implemented'. "/ add code for VMS ...
- ]
- ].
- cmd := 'add ' , fileName , ' > ', '"' , cmdOut name, '"'.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:checkInDir
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- cmdOut remove.
- tempdir recursiveRemove.
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- ^ false.
- ].
- cmdOut remove.
-
- "/
- "/ commit
- "/
- self activityNotification:'committing ' , fileName.
-
- OperatingSystem isUNIXlike ifFalse:[
- "/ save the log message into another tempFile ...
- logTmp := Filename newTemporaryIn:checkInDir.
- s := logTmp writeStream.
- s nextPutAll:'initial checkin'.
- s close.
-
- cmd := 'commit -F "', logTmp baseName, '" ', fileName, ' > ', '"', cmdOut name, '"'.
- ] ifTrue:[
- "/
- "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
- "/ CVS V1.9.16 to stdout.
- "/
- cmd := 'commit -m "initial checkin" ' , fileName , ' > ', '"' , cmdOut name, '"', ' 2>&1'.
- ].
-
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:checkInDir "tempdir name"
- ) ifFalse:[
- Verbose == true ifTrue:[
- 'CVSMGR: failed to execute: ' infoPrint. cmd infoPrintCR.
- ].
- cmdOut fileSize > 0 ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := '<< no message >>'
- ].
- self warn:'The following problem was reported by cvs:
-
-' , whatHappened , '
-
-The class has NOT been checked into the repository.'.
-
- 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
- whatHappened := cmdOut contentsOfEntireFile asString.
- cmdOut remove.
-
- "/
- "/ release it towards cvs
- "/
- self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
-
- "/
- "/ good - its in the CVS repository; now, we need the updated RCS header
- "/
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- 'CVSSourceCodeManager [warning]: unexpected empty commit command output' errorPrintCR.
- "/ TODO: scan the file for $Header ...
- "/ and extract the revision manually
-
- ] ifFalse:[
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- idx := whatHappened indexOfLineStartingWith:'initial revision:'.
- idx ~~ 0 ifTrue:[
- startIdx := 18
- ] ifFalse:[
- idx := whatHappened indexOfLineStartingWith:'new revision:'.
- idx ~~ 0 ifTrue:[
- 'CVSSourceCodeManager [warning]: container existed before' errorPrintCR.
- startIdx := 14.
- ] ifFalse:[
- 'CVSSourceCodeManager [warning]: unexpected commit command output (no new-revision info)' errorPrintCR.
- ]
- ].
- idx ~~ 0 ifTrue:[
- l := whatHappened at:idx.
- endIdx := (l indexOf:$; startingAt:startIdx) - 1.
- endIdx < 0 ifTrue:[
- endIdx := l size
- ].
- newRevision := (l copyFrom:startIdx to:endIdx) withoutSpaces.
- (Number fromString:newRevision onError:nil) isNil ifTrue:[
- newRevision := '1.1'
- ]
- ]
- ].
-
- Transcript showCR:'created new sourceContainer for ' , aClass name , '.'.
-
- "/
- "/ patch the classes revisionInfo (but keep binaryRevision unchanged)
- "/ this makes everyone here believe, that the incore version of the class is based upon
- "/ the newly checked in version.
- "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
- "/ correctly for all unchanged methodss)
- "/
-
- newRevision notNil ifTrue:[
- changeLog := self
- revisionLogOf:aClass
- fromRevision:newRevision
- toRevision:newRevision
- fileName:fileName
- directory:packageDir
- module:moduleDir.
-
- (changeLog isNil or:[(changeLog at:#revisions) size ~~ 1]) ifTrue:[
- 'CVSSourceCodeManager [error]: failed to update revisionString (no log)' errorPrintCR
- ] ifFalse:[
- entry := (changeLog at:#revisions) first.
- newString := self revisionStringFromLog:changeLog entry:entry forClass:aClass.
- aClass updateVersionMethodFor:newString.
- ('CVSSourceCodeManager [info]: updated revisionString to:',newString) infoPrintCR
- ]
- ].
-
- tempdir recursiveRemove.
-
- Class addChangeRecordForClassCheckIn:aClass.
- self postCheckInClass:aClass.
- ^ true
-
- "Created: / 9.12.1995 / 19:13:37 / cg"
- "Modified: / 23.7.1999 / 19:47:59 / stefan"
- "Modified: / 5.11.2001 / 14:22:56 / cg"
-!
-
-createContainerForText:someText inModule:moduleDir package:packageDir container:fileName
- "create a container - this does an initial checkin
- (i.e. cvs add & cvs commit)"
-
- |fullName tempdir checkoutName cmdOut cmd tempFile idx aStream whatHappened l newRevision
- startIdx endIdx checkInDir logTmp s|
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- fullName := moduleDir , '/' , packageDir , '/' , fileName.
- checkoutName := moduleDir , '/' , packageDir.
-
- "/
- "/ first, check out everything there - this creates the CVS helpfiles
- "/ required later.
- "/
-
- self activityNotification:'checking for directory ' , checkoutName.
- tempdir := self createLocalDirectory:packageDir inModule:moduleDir.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- ^ false.
- ].
-
- [
- "/
- "/ create the source there
- "/
- tempFile := (tempdir construct:checkoutName) construct:fileName.
- [
- aStream := tempFile writeStream.
- ] on:FileStream openErrorSignal do:[:ex|
- ('CVSSourceCodeManager [error]: temporary fileout failed -> ', tempFile name) errorPrintCR.
- ^ false
- ].
-
- aStream nextPutAll:someText.
- aStream close.
-
- tempFile exists ifFalse:[
- 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
- ^ false
- ].
-
- "/
- "/ and add it to the repository
- "/
- self activityNotification:'adding ' , fileName.
-
- OperatingSystem isUNIXlike ifTrue:[
- checkInDir := tempdir constructString:checkoutName.
- ] ifFalse:[
- OperatingSystem isMSDOSlike ifTrue:[
- checkInDir := tempdir constructString:(checkoutName copyReplaceAll:$/ with:$\).
- ] ifFalse:[
- self error:'VMS case not yet implemented'. "/ add code for VMS ...
- ]
- ].
- cmd := 'add ' , fileName , ' > ', '"' , cmdOut name, '"'.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:checkInDir
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- cmdOut remove.
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- ^ false.
- ].
- cmdOut remove.
-
- "/
- "/ commit
- "/
- self activityNotification:'committing ' , fileName.
-
- OperatingSystem isUNIXlike ifFalse:[
- "/ save the log message into another tempFile ...
- logTmp := Filename newTemporaryIn:checkInDir.
- s := logTmp writeStream.
- s nextPutAll:'initial checkin'.
- s close.
-
- cmd := 'commit -F "', logTmp baseName, '" ', fileName, ' >', '"', cmdOut name, '"'.
- ] ifTrue:[
- "/
- "/ CVS up to V1.9.14 prints the 'new revision' to stderr,
- "/ CVS V1.9.16 to stdout.
- "/
- cmd := 'commit -m "initial checkin" ' , fileName , ' > ', '"' , cmdOut name, '"', ' 2>&1'.
- ].
-
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:checkInDir "tempdir name"
- ) ifFalse:[
- Verbose == true ifTrue:[
- 'CVSMGR: failed to execute: ' infoPrint. cmd infoPrintCR.
- ].
- cmdOut fileSize > 0 ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := '<< no message >>'
- ].
- self warn:'The following problem was reported by cvs:
-
-' , whatHappened , '
-
-The class has NOT been checked into the repository.'.
-
- 'CVSSourceCodeManager [error]: cannot checkin modified class source' errorPrintCR.
- cmdOut remove.
- ^ false.
- ].
- whatHappened := cmdOut contentsOfEntireFile asString.
- cmdOut remove.
-
- "/
- "/ release it towards cvs
- "/
- self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
-
- "/
- "/ good - its in the CVS repository; now, we need the updated RCS header
- "/
- (whatHappened isNil or:[whatHappened isEmpty]) ifTrue:[
- 'CVSSourceCodeManager [warning]: unexpected empty commit command output' errorPrintCR.
- "/ TODO: scan the file for $Header ...
- "/ and extract the revision manually
-
- ] ifFalse:[
- whatHappened := whatHappened asCollectionOfLines asStringCollection.
- idx := whatHappened indexOfLineStartingWith:'initial revision:'.
- idx ~~ 0 ifTrue:[
- startIdx := 18
- ] ifFalse:[
- idx := whatHappened indexOfLineStartingWith:'new revision:'.
- idx ~~ 0 ifTrue:[
- 'CVSSourceCodeManager [warning]: container existed before' errorPrintCR.
- startIdx := 14.
- ] ifFalse:[
- 'CVSSourceCodeManager [warning]: unexpected commit command output (no new-revision info)' errorPrintCR.
- ]
- ].
- idx ~~ 0 ifTrue:[
- l := whatHappened at:idx.
- endIdx := (l indexOf:$; startingAt:startIdx) - 1.
- endIdx < 0 ifTrue:[
- endIdx := l size
- ].
- newRevision := (l copyFrom:startIdx to:endIdx) withoutSpaces.
- (Number fromString:newRevision onError:nil) isNil ifTrue:[
- newRevision := '1.1'
- ]
- ]
- ].
-
- Transcript showCR:'created new sourceContainer for ' , fileName , '.'.
- ] ensure:[
- tempdir recursiveRemove.
- ].
- ^ true
-!
-
-createModule:moduleName
- "create a module directory"
-
- |tempdir moduleDir cmdOut cmd|
-
- "/
- "/ first, create a temporary work tree
- "/
- tempdir := self createTempDirectory:nil forModule:moduleName.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot create moduleDirectory') errorPrintCR.
- ^ false
- ].
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- "/
- "/ create the module directory
- "/
- moduleDir := tempdir construct:moduleName.
- moduleDir exists ifFalse:[
- 'CVSSourceCodeManager [error]: failed to create: ' errorPrint. moduleDir name errorPrintCR.
- tempdir recursiveRemove.
- ^ false.
- ].
-
- "/
- "/ then import it into CVS
- "/
-
- cmd := 'import -m "created from browser" ' , moduleName , ' initialV initialR > ' , cmdOut name.
- (self
- executeCVSCommand:cmd
- module:moduleName
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
-
- 'CVSSourceCodeManager [info]: created new module: ' infoPrint. moduleName infoPrintCR.
- tempdir recursiveRemove.
- cmdOut remove.
- ^ true
-
- "Created: / 9.12.1995 / 19:53:51 / cg"
- "Modified: / 7.1.1998 / 14:18:57 / stefan"
- "Modified: / 6.6.1998 / 16:15:34 / cg"
-!
-
-createModule:moduleDirName package:packageDirName
- "create a package directory"
-
- |tempdir cmdOut cmd packageDir moduleDir relativePath idx parentPackage|
-
- "/ any parent package required ?
- idx := packageDirName lastIndexOf:$/.
- idx ~~ 0 ifTrue:[
- parentPackage := packageDirName copyTo:idx-1.
- (self checkForExistingModule:moduleDirName package:parentPackage) ifFalse:[
- (self createModule:moduleDirName package:parentPackage) ifFalse:[
- ^ false.
- ].
- ].
- ].
-
- (moduleDirName asFilename components includes:'core') ifTrue:[
- ('CVSSourceCodeManager [error]: cvs does not allow for a module to be named ''core'' - cannot create moduleDirectory') errorPrintCR.
- ^ false
- ].
-
- "/
- "/ first, create a temporary work tree
- "/
- tempdir := self createTempDirectory:packageDirName forModule:moduleDirName.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot create moduleDirectory') errorPrintCR.
- ^ false
- ].
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- moduleDir := tempdir construct:moduleDirName.
- moduleDir isDirectory ifFalse:[
- 'CVSSourceCodeManager [error]: command failed: ' errorPrint. cmd errorPrintCR.
-
- tempdir recursiveRemove.
- ^ false.
- ].
-
- "/
- "/ create the package directory there
- "/
- packageDir := moduleDir construct:packageDirName.
- OperatingSystem errorSignal catch:[
- packageDir recursiveMakeDirectory.
- ].
- packageDir isDirectory ifFalse:[
- tempdir recursiveRemove.
- ('CVSSourceCodeManager [error]: cannot create new directory: ' , packageDir pathName) errorPrintCR.
- ^ false.
- ].
-
- "/
- "/ then import it into CVS
- "/
-
- relativePath := moduleDirName asFilename constructString:packageDirName.
- cmd := 'import -m "created from browser" . initialV initialR > ' , cmdOut name.
- (self
- executeCVSCommand:cmd
- module:moduleDirName
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- 'CVSSourceCodeManager [error]: output from cvs:' errorPrintCR.
- (cmdOut contentsOfEntireFile) errorPrint.
-
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
-
- tempdir recursiveRemove.
- cmdOut remove.
- ^ true
-
- "
- self createModule:'stefan' package:'dummy1'
- "
-
- "Created: / 9.12.1995 / 20:09:33 / cg"
- "Modified: / 23.7.1999 / 18:40:49 / stefan"
- "Modified: / 18.1.2000 / 20:14:01 / cg"
-!
-
-getExistingContainersInModule:aModule package:aPackage
- "return a list of existing containers.
- This does not work with remote-CVS"
-
- |cvsRoot containers moduleDir packageDir tempdir cmdOut cmd dirName|
-
- cvsRoot := self getCVSROOTForModule:aModule.
- cvsRoot isNil ifTrue:[^ #() ].
-
- dirName := aModule , '/' , aPackage.
-
- self activityNotification:'getting list of containers in ' , dirName , ' ...'.
-
- (RemoteCVS
- or:[cvsRoot asFilename exists not]) ifTrue:[
- "/ remote CVS
- "/ filter the output of the history command
- "/ (sigh - there ought to be some cvs-command for that)
- "/
-
- tempdir := self createTempDirectory:nil forModule:nil.
- tempdir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot checkout') errorPrintCR.
- ^ #()
- ].
-
- cmd := '-l checkout ', dirName.
- OperatingSystem isUNIXlike ifTrue:[
- "/ can redirect output
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
- cmd := cmd , ' > ' , cmdOut name.
- ].
-
- (self
- executeCVSCommand:cmd
- module:aModule
- inDirectory:tempdir name
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
- cmdOut notNil ifTrue:[cmdOut remove].
- tempdir recursiveRemove.
- ^ #()
- ].
-
- cmdOut notNil ifTrue:[cmdOut remove].
-
- packageDir := (tempdir construct:dirName).
- (packageDir isDirectory) ifFalse:[
- 'CVSSourceCodeManager [error]: checkout failed (no dir)' errorPrintCR.
- tempdir recursiveRemove.
- ^ #()
- ].
-
- "/
- "/ enumerate the checkedOut directory, looking for plain files
- "/
- containers := OrderedCollection new.
- packageDir directoryContents do:[:aFilenameString |
- |fn|
-
- (packageDir construct:aFilenameString) isDirectory ifFalse:[
- containers add:aFilenameString
- ]
- ].
- tempdir recursiveRemove.
- ] ifFalse:[
- (cvsRoot := cvsRoot asFilename) exists ifFalse:[
- ^ #()
- ].
- ((moduleDir := cvsRoot construct:aModule) exists
- and:[moduleDir isDirectory]) ifFalse:[
- self warn:'No such module'.
- ^ #()
- ].
- ((packageDir := moduleDir construct:aPackage) exists
- and:[packageDir isDirectory]) ifFalse:[
- self warn:'No such package'.
- ^ #()
- ].
-
- "/
- "/ enumerate the package directory, looking for container files
- "/ strip off the ,v ending.
- "/
- containers := OrderedCollection new.
- packageDir directoryContents do:[:aFilenameString |
- |fn|
-
- (aFilenameString endsWith:',v') ifTrue:[
- containers add:(aFilenameString copyWithoutLast:2)
- ]
- ].
- ].
- ^ containers sort
-
- "
- CVSSourceCodeManager getExistingContainersInModule:'stx' package:'libhtml'
- CVSSourceCodeManager getExistingContainersInModule:'cg' package:'java'
- CVSSourceCodeManager getExistingContainersInModule:'sel' package:'bmti'
- "
-
- "Created: / 20.5.1998 / 19:48:59 / cg"
- "Modified: / 20.5.1998 / 22:08:29 / cg"
-!
-
-getExistingModules
- "return a list of existing modules.
- This does not work with remote-CVS"
-
- |cvsRoot modules inStream list|
-
- cvsRoot := self getCVSROOTForModule:nil.
- cvsRoot isNil ifTrue:[^ #() ].
-
- self activityNotification:'getting list of modules...'.
-
- (RemoteCVS
- or:[cvsRoot asFilename exists not]) ifTrue:[
- "/ remote CVS
- "/ filter the output of the history command
- "/ (sigh - there ought to be some cvs-command for that)
- "/
- inStream := PipeStream readingFrom:'cvs -d ' , cvsRoot , ' history -x A'.
- inStream isNil ifTrue:[
- self warn:'This operation is not possible with this remoteCVS server'.
- ^ #().
- ].
- list := inStream contents asStringCollection.
- inStream close.
-
- modules := Set new.
- list do:[:line |
- |idx items entry|
-
- items := line asCollectionOfWords.
- "/ #( 'A' '10/29' '17:47' '+0000' 'cg' '1.1' '.cvsignore' 'stx' '==' '~/work/stx' )
- "/ fetch the word before '=='
-
- idx := items indexOf:'=='.
- idx > 1 ifTrue:[
- entry := items at:idx-1.
-
- "/ extract the first directory component ...
- idx := entry indexOf:$/.
- idx ~~ 0 ifTrue:[
- entry := entry copyTo:idx-1
- ].
- modules add:entry.
- ]
- ].
- modules := modules asArray
- ] ifFalse:[
- "/ local CVS
- "/
- "/ enumerate the root directory, looking for subdirs
- "/ which contain a CVS subdir.
- "/
- (cvsRoot := cvsRoot asFilename) exists ifFalse:[
- ^ #()
- ].
-
- modules := OrderedCollection new.
- cvsRoot directoryContents do:[:aFilenameString |
- |fn|
-
- (aFilenameString endsWith:',v') ifFalse:[
- (#('CVS' 'CVSROOT' 'Attic') includes:aFilenameString) ifFalse:[
- (fn := (cvsRoot construct:aFilenameString)) isDirectory ifTrue:[
- modules add:aFilenameString
- ]
- ]
- ]
- ].
- ].
-
- ^ modules sort
-
- "
- CVSSourceCodeManager getExistingModules
- "
-
- "Created: / 20.5.1998 / 19:28:43 / cg"
- "Modified: / 20.5.1998 / 22:07:07 / cg"
-!
-
-getExistingPackagesInModule:aModule
- "return a list of existing packages.
- This does not work with remote-CVS"
-
- |cvsRoot packages moduleDir inStream list|
-
- cvsRoot := self getCVSROOTForModule:aModule.
-
- self activityNotification:'getting list of packages in ' , aModule , ' ...'.
-
- (RemoteCVS
- or:[cvsRoot asFilename exists not]) ifTrue:[
- "/ remote CVS
- "/ filter the output of the history command
- "/ (sigh - there ought to be some cvs-command for that)
- "/
- inStream := PipeStream readingFrom:'cvs -d ' , cvsRoot , ' history -x A'.
- inStream isNil ifTrue:[
- self warn:'This operation is not possible with this remoteCVS server'.
- ^ #().
- ].
- list := inStream contents asStringCollection.
- inStream close.
-
- packages := Set new.
- list do:[:line |
- |items idx entry|
-
- items := line asCollectionOfWords.
- "/ #( 'A' '10/29' '17:47' '+0000' 'cg' '1.1' '.cvsignore' 'stx' '==' '~/work/stx' )
- "/ fetch the word before '=='
-
- idx := items indexOf:'=='.
- idx > 1 ifTrue:[
- entry := items at:idx-1.
-
- "/ extract the first directory component ...
- (entry startsWith:aModule) ifTrue:[
- idx := entry indexOf:$/.
- idx ~~ 0 ifTrue:[
- (entry copyTo:idx-1) = aModule ifTrue:[
- packages add:(entry copyFrom:idx+1).
- ]
- ].
- ]
- ]
- ].
- packages := packages asArray
- ] ifFalse:[
- "/ local CVS
- "/
- "/ enumerate the module directory, looking for subdirs
- "/ which contain a CVS subdir.
- "/
-
- (cvsRoot := cvsRoot asFilename) exists ifFalse:[
- ^ #()
- ].
- (moduleDir := cvsRoot construct:aModule) isDirectory ifFalse:[
- self warn:'No such module'.
- ^ #()
- ].
-
- packages := OrderedCollection new.
- moduleDir directoryContents do:[:aFilenameString |
- |fn|
-
- (aFilenameString endsWith:',v') ifFalse:[
- (#('CVS' 'CVSROOT' 'Attic') includes:aFilenameString) ifFalse:[
- (fn := (moduleDir construct:aFilenameString)) isDirectory ifTrue:[
- packages add:aFilenameString
- ]
- ]
- ]
- ].
- ].
- ^ packages sort
-
- "
- CVSSourceCodeManager getExistingPackagesInModule:'stx'
- CVSSourceCodeManager getExistingPackagesInModule:'cg'
- CVSSourceCodeManager getExistingPackagesInModule:'sel'
- "
-
- "Created: / 20.5.1998 / 19:28:43 / cg"
- "Modified: / 20.5.1998 / 22:07:13 / cg"
-!
-
-initialRevisionStringFor:aClass inModule:moduleDir package:packageDir container:fileName
- "return a string usable as initial revision string"
-
- |cvsRoot|
-
- cvsRoot := self getCVSROOTForModule:moduleDir.
- cvsRoot := self repositoryTopDirectory:cvsRoot.
- ^ self
- initialRCSRevisionStringFor:aClass
- in:(cvsRoot , '/' , moduleDir , '/' , packageDir)
- container:fileName
-
- "Modified: / 19.9.1997 / 06:34:10 / cg"
- "Modified: / 16.1.1998 / 17:34:13 / stefan"
-!
-
-newestRevisionInFile:classFileName directory:packageDir module:moduleDir
- "return the newest revision found in a container.
- Return nil on failure.
- Uses 'cvs status', which is much faster than 'cvs log'"
-
- |info|
-
- info := self
- statusOf:nil
- fileName:classFileName
- directory:packageDir
- module:moduleDir.
-
- info isNil ifTrue:[^ nil].
- ^ info at:#newestRevision ifAbsent:nil
-
- "
- SourceCodeManager newestRevisionInFile:'Array.st' directory:'libbasic' module:'stx'
- "
-!
-
-readRevisionLogEntryFromStream:inStream
- "read and parse a single revision info-entry from the cvs log output.
- Return nil on end.
-
- The returned information is a structure (IdentityDictionary)
- filled with:
- #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
- #logMessage -> the checkIn log message
- "
-
- |revLine1 revLine2 record s line atEnd|
-
- atEnd := false.
-
- revLine1 := inStream nextLine.
- [revLine1 notNil and:[(revLine1 startsWith:'revision ') not]]
- whileTrue:[inStream atEnd ifTrue:[
- revLine1 := nil
- ] ifFalse:[
- revLine1 := inStream nextLine.
- ]
- ].
- revLine2 := inStream nextLine.
- (revLine1 notNil and:[revLine2 notNil]) ifTrue:[
- record := IdentityDictionary new.
- record at:#revision put:(revLine1 asCollectionOfWords at:2).
- "/ decompose date/author/state etc.
- (revLine2 asCollectionOfSubstringsSeparatedBy:$;) do:[:info |
- |subEntry|
- subEntry := info withoutSeparators.
- #('date:' #date
- 'author:' #author
- 'state:' #state
- 'lines:' #numberOfChangedLines
- ) pairWiseDo:[:word :key |
- s := subEntry restAfter:word withoutSeparators:true.
- s notNil ifTrue:[record at:key put:s.].
- ].
- ].
-
- "first revision does not hav a 'lines:' entry"
- (record includesKey:#numberOfChangedLines) ifFalse:[
- record at:#numberOfChangedLines put:''
- ].
-
- s := nil.
- line := inStream nextLine.
- [atEnd or:[line isNil or:[line startsWith:'--------']]] whileFalse:[
- (line startsWith:'==========') ifTrue:[
- atEnd := true.
- ] ifFalse:[
- (line withoutSpaces = '.') ifTrue:[
- line := '*** empty log message ***'
- ].
- s isNil ifTrue:[
- s := line
- ] ifFalse:[
- s := s , Character cr asString , line.
- ].
- line := inStream nextLine.
- ]
- ].
- record at:#logMessage put:s.
- ].
- ^record.
-
-!
-
-removeContainerFor:aClass inModule:moduleDir package:packageDir container:fileName
- "remove a container"
-
- (self removeContainerInModule:moduleDir package:packageDir container:fileName) ifFalse:[
- ^ false
- ].
-
- "/
- "/ patch the classes revisionInfo (but keep binaryRevision unchanged)
- "/ this makes everyone here believe, that the incore version of the class is based upon
- "/ some container-less class.
- "/ (however, the binaryRevision must remain as it is - we will need it to fetch the sourceCode
- "/ correctly for all unchanged methodss)
- "/
-
- aClass updateVersionMethodFor:'no longer in repository'.
- Class addChangeRecordForClassContainerRemove:aClass.
- ^ true
-!
-
-removeContainerInModule:moduleDir package:packageDir container:fileName
- "remove a container"
-
- |fullName tempdir checkoutName cmdOut cmd tempFile whatHappened|
-
- fullName := moduleDir , '/' , packageDir , '/' , fileName.
- checkoutName := moduleDir , '/' , packageDir.
-
- (tempdir := self createLocalDirectory:packageDir inModule:moduleDir with:fileName) isNil ifTrue:[
- 'CVSSourceCodeManager [error]: failed to checkout: ' errorPrint. checkoutName errorPrintCR.
- tempdir recursiveRemove.
- ('CVSSourceCodeManager [error]: cannot checkout ' , checkoutName) errorPrintCR.
- ^ false.
- ].
-
- "/
- "/ and remove it to the repository
- "/
- self activityNotification:'removing ' , fileName.
-
- "/
- "/ check presence of source there
- "/
- tempFile := (tempdir construct:checkoutName) construct:fileName.
- tempFile exists ifFalse:[
- 'CVSSourceCodeManager [error]: temporary fileout failed' errorPrintCR.
- tempdir recursiveRemove.
- ^ false
- ].
-
- tempFile exists ifTrue:[
- tempFile remove.
- ].
-
- cmdOut := Filename newTemporary.
- cmdOut exists ifTrue:[
- cmdOut remove.
- ].
-
- cmd := 'remove ' , fileName , ' > ' , cmdOut name.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:(tempdir constructString:checkoutName)
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- cmdOut remove.
- tempdir recursiveRemove.
- ('CVSSourceCodeManager [error]: cannot remove ' , checkoutName) errorPrintCR.
- ^ false.
- ].
- cmdOut remove.
-
- "/
- "/ commit
- "/
- self activityNotification:'committing removal of ' , fileName.
-
- cmd := 'commit -m "removed container" -l ' , fileName , ' 2> ' , cmdOut name.
- (self
- executeCVSCommand:cmd
- module:moduleDir
- inDirectory:(tempdir constructString:checkoutName)
- ) ifFalse:[
- 'CVSSourceCodeManager [error]: failed to execute: ' errorPrint. cmd errorPrintCR.
-
- cmdOut fileSize > 0 ifTrue:[
- whatHappened := cmdOut contentsOfEntireFile asString.
- ] ifFalse:[
- whatHappened := '<< no message >>'
- ].
- self warn:'The following problem was reported by cvs:
-
-' , whatHappened , '
-
-The container has NOT been removed into the repository.'.
-
- 'CVSSourceCodeManager [error]: cannot remove container' errorPrintCR.
- cmdOut remove.
- tempdir recursiveRemove.
- ^ false.
- ].
- cmdOut remove.
-
- "/
- "/ release the temporary tree towards cvs
- "/
- self releaseAndRemove:tempdir module:moduleDir outputTo:nil.
-
- tempdir recursiveRemove.
- ^ true
-
- "
- CVSSourceCodeManager removeContainerInModule:'stx' package:'private' container:'WorldPO.st'
- "
-
- "Modified: / 26.2.1998 / 17:33:57 / stefan"
- "Modified: / 18.1.2000 / 21:02:30 / cg"
-!
-
-reportHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:filterRep filterModules:filterModules inTo:aBlock
- "process a full historyLog, evaluate aBlock for each entry, passing
- the logs info in a dictionary.
- This walks over all possible repositories.
- filterRep may be a collection of repository names
- (i.e. 'stc', 'exept', 'phx' etc.) to only report changes made to one
- of those repositories.
- filterUser, if non-nil, will filter only changes made by that user."
-
- |inStream line words recordType fileName user date time rev pkgDir module idx
- clsName cls clsRev roots info tempDir endReached|
-
- CVSRoot isNil ifTrue:[
- 'CVSSourceCodeManager [info]: CVSROOT not set' infoPrintCR.
- ^ nil
- ].
-
- CVSModuleRoots notNil ifTrue:[
- roots := Set withAll:(CVSModuleRoots values)
- ] ifFalse:[
- roots := Set new.
- ].
- roots add:CVSRoot.
-
- "/ must do it in a tempDir, to avoid cvs validating the -D arg
- "/ against any info found in CVS/Root
-
- tempDir := self createTempDirectory:nil forModule:nil.
- tempDir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
- ^ nil.
- ].
-
- roots do:[:aCVSRoot |
- |root host cmd|
-
- cmd := 'cvs -d ' , aCVSRoot.
-
- "/ workaround a CVS bug ...
- "/ cvs crashes with:
- "/ cvs -d exept:/files/CVS history -x WARM -a -D "yesterday"
- "/
- "/ but works ok, when doing:
- "/ rsh exept cvs -d /files/CVS history -x WARM -a -D "yesterday"
- "/
- (aCVSRoot startsWith:':') ifFalse:[
- OperatingSystem isUNIXlike ifTrue:[
- host := aCVSRoot copyTo:(aCVSRoot indexOf:$:)-1.
- (host size > 0 and:[(host includes:Character space) not]) ifTrue:[
- root := aCVSRoot copyFrom:(aCVSRoot indexOf:$:)+1.
- cmd := 'rsh ' , host , ' cvs -d ' , root
- ]
- ]
- ].
-
- cmd := cmd , ' history -x WARM -a'.
- (timeGoal notNil and:[timeGoal notEmpty]) ifTrue:[
- cmd := cmd , ' -D "' , timeGoal , '"'.
- ].
- filterRep notNil ifTrue:[
- filterRep do:[:aRepository |
- cmd := cmd , ' -p "' , aRepository , '"'.
- ].
- ].
- userFilter notNil ifTrue:[
- userFilter isString ifTrue:[
- cmd := cmd , ' -u "' , userFilter , '"'.
- ] ifFalse:[
- userFilter do:[:user |
- cmd := cmd , ' -u "' , user , '"'.
- ].
- ].
- ].
-
-"/ either I dont understand CVS, or it does not work correctly...
-"/ in any case, the -m option does NOT filter modules. (sigh)
-"/
-"/ filterModules notNil ifTrue:[
-"/ filterModules do:[:aModule |
-"/ cmd := cmd , ' -m "' , aModule , '"'.
-"/ ].
-"/ ].
-
- Transcript showCR:cmd.
-
- inStream := PipeStream readingFrom:cmd inDirectory:tempDir.
- inStream isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot open pipe to ''cvs history''') errorPrintCR.
- ] ifFalse:[
-
- inStream class streamErrorSignal handle:[:ex |
- ('CVSSourceCodeManager [error]: pipe read error (''cvs history'')') errorPrintCR.
- ex return.
- ] do:[
- "/
- "/ read the commands pipe output and reformat the lines
- "/
- endReached := false.
- [endReached] whileFalse:[
- inStream readWait.
- line := inStream nextLine.
- (endReached := line isNil) ifFalse:[
-
- "/ cvs history line is of the following format:
- "/ [Ma] date time +xxx user rev name module/package ....
- words := line asCollectionOfWords.
- words size >= 8 ifFalse:[
- "/ something like 'No records selected' ...
-
- ] ifTrue:[
- recordType := words at:1.
- fileName := words at:7.
- user := words at:5.
-
- (filter not
- or:[fileName endsWith:'.st']) ifTrue:[
- (userFilter isNil
- or:[userFilter = user]) ifTrue:[
-
- date := words at:2.
- time := words at:3.
- rev := words at:6.
- pkgDir := words at:8.
-
- module := pkgDir copy.
- (module startsWith:'./') ifTrue:[
- module := module copyFrom:3.
- ].
- idx := module indexOf:$/.
- idx ~~ 0 ifTrue:[
- module at:idx put:$:
- ].
-
- (filterModules isNil
- or:[filterModules includes:module]) ifTrue:[
-
- recordType = 'M' ifTrue:[
- recordType := ' '
- ] ifFalse:[
- recordType = 'A' ifTrue:[
- recordType := '+'
- ] ifFalse:[
- (recordType = 'R' or:[recordType = 'W']) ifTrue:[
- recordType := '-'
- ]
- ]
- ].
-
- info := Dictionary new.
- info at:#cvsRecordType put:recordType.
- info at:#date put:date.
- info at:#time put:time.
- info at:#user put:user.
- info at:#fileName put:fileName.
- info at:#revision put:rev.
- info at:#directory put:pkgDir.
- info at:#className put:(Smalltalk classNameForFile:fileName).
-
- "/
- "/ for your convenience:
- "/ check what the actual version is in the image
- "/
- clsName := Smalltalk classNameForFile:fileName.
- clsName notNil ifTrue:[
- cls := Smalltalk classNamed:clsName.
- (cls notNil and:[(clsRev := cls revision) notNil]) ifTrue:[
- info at:#classesRevision put:clsRev.
- ].
- ].
- aBlock value:info
- ]
- ]
- ]
- ]
- ]
- ].
- ].
- inStream close.
- ]
- ].
-
- tempDir recursiveRemove.
-
- "Created: / 17.1.2001 / 13:11:20 / cg"
- "Modified: / 17.1.2001 / 13:41:22 / cg"
-!
-
-reportHistoryLogSince:timeGoal filterSTSources:filter filterUser:userFilter filterRepository:filterRep inTo:aBlock
- "process a full historyLog, evaluate aBlock for each entry, passing
- the logs info in a dictionary.
- This walks over all possible repositories.
- filterRep may be a collection of repository names
- (i.e. 'stc', 'exept', 'phx' etc.) to only report changes made to one
- of those repositories.
- filterUser, if non-nil, will filter only changes made by that user."
-
- ^self
- reportHistoryLogSince:timeGoal
- filterSTSources:filter
- filterUser:userFilter
- filterRepository:filterRep
- filterModules:nil
- inTo:aBlock
-
- "Modified: / 17.1.2001 / 13:12:15 / cg"
-!
-
-revisionInfoFromString:aString
- "{ Pragma: +optSpace }"
-
- "return a dictionary filled with revision info.
- This extracts the relevant info from aString."
-
- ^ self revisionInfoFromRCSString:aString
-
- "
- self revisionInfoFromString:(Array version)
- "
-
- "Modified: 29.1.1997 / 19:00:35 / cg"
-!
-
-revisionLogOf:clsOrNil fromRevision:rev1 toRevision:rev2 fileName:classFileName directory:packageDir module:moduleDir
- "return info about the repository container and
- (part of) the revisionlog as a collection of revision entries.
- Return nil on failure.
-
- The returned information is a structure (IdentityDictionary)
- filled with:
- #container -> the RCS/CVS container file name
- #cvsRoot -> the CVS root (repository)
- #filename -> the actual source file name
- #newestRevision -> the revisionString of the newest revision
- #numberOfRevisions -> the number of revisions in the container (nil for all)
- #revisions -> collection of per-revision info (see below)
-
- rev1 / rev2 specify from which revisions a logEntry is wanted:
- -If rev1 is nil, the first revision is the initial revision
- otherwise, the log starts with that revision.
- -If rev2 is nil, the last revision is the newest revision
- otherwise, the log ends with that revision.
-
- -If both are nil, all logEntries are extracted.
- -If both are 0 (not nil), no logEntries are extracted (i.e. only the header).
-
- 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)
- "
-
- |tempDir fullName modulePath inStream inHeaderInfo atEnd line revArg idx
- info record revisionRecords s headerOnly msg |
-
- modulePath := moduleDir , '/' , packageDir.
- fullName := modulePath , '/' , classFileName.
- tempDir := self createTempDirectory:nil forModule:nil.
- tempDir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
- ^ nil.
- ].
-
- [
- self createEntryFor:fullName
- module:moduleDir
- in:(tempDir construct:modulePath)
- revision:'1.1'
- date:'dummy'
- special:''
- overwrite:false.
-
- revArg := ''.
- headerOnly := false.
- (rev1 notNil or:[rev2 notNil]) ifTrue:[
- (rev1 == 0 and:[rev2 == 0]) ifTrue:[
- revArg := '-h'.
- headerOnly := true.
- ] ifFalse:[
- revArg := '-r'.
- rev1 notNil ifTrue:[
- revArg := revArg , rev1
- ].
- revArg := revArg , ':'.
- rev2 notNil ifTrue:[
- revArg := revArg , rev2
- ].
- ]
- ].
-
- headerOnly ifTrue:[
- msg := 'fetching revision info '
- ] ifFalse:[
- msg := 'reading revision log '
- ].
- clsOrNil isNil ifTrue:[
- msg := msg , 'in ' , fullName.
- ] ifFalse:[
- msg := msg , 'of ', clsOrNil name.
- ].
- self activityNotification:msg.
-
- inStream := self
- executeCVSCommand:('log ' , revArg , ' ' , fullName)
- module:moduleDir
- inDirectory:tempDir
- log:true
- pipe:true.
-
- inStream isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
- ^ nil
- ].
-
- "/
- "/ read the commands pipe output and extract the container info
- "/
- info := IdentityDictionary new.
- inHeaderInfo := true.
- [inHeaderInfo and:[inStream atEnd not]] whileTrue:[
- line:= inStream nextLine.
- line notNil ifTrue:[
- |gotIt|
-
- gotIt := false.
- #('RCS file:' #container
- 'Working file:' #filename
- 'head:' #newestRevision
- 'total revisions:' #numberOfRevisions
- ) pairWiseDo:[:word :key |
- gotIt ifFalse:[
- s := line restAfter:word withoutSeparators:true.
- s notNil ifTrue:[info at:key put:s. gotIt := true].
- ]
- ].
- gotIt ifFalse:[
- (line startsWith:'description:') ifTrue:[inHeaderInfo := false].
- ]
- ]
- ].
- inStream nextLine. "/ skip separating line after description.
-
- info isEmpty ifTrue:[
- ('CVSSourceCodeManager [warning]: no log for ', fullName) errorPrintCR.
- ^ nil
- ].
-
- "/ strip selected revisions from the total-revisions entry
- s := info at:#numberOfRevisions.
- (idx := s indexOf:$;) ~~ 0 ifTrue:[
- info at:#numberOfRevisions put:(Integer readFrom:(s copyTo:idx - 1))
- ] ifFalse:[
- info at:#numberOfRevisions put:(Integer readFrom:s onError:[1])
- ].
- headerOnly ifFalse:[
- "/
- "/ continue to read the commands pipe output
- "/ and extract revision info records
- "/
- revisionRecords := OrderedCollection new:(info at:#numberOfRevisions).
- info at:#revisions put:revisionRecords.
-
- atEnd := false.
- [atEnd or:[inStream atEnd]] whileFalse:[
- record := self readRevisionLogEntryFromStream:inStream.
-
-"/ revLine1 := inStream nextLine.
-"/ [revLine1 notNil and:[(revLine1 startsWith:'revision ') not]]
-"/ whileTrue:[inStream atEnd ifTrue:[
-"/ revLine1 := nil
-"/ ] ifFalse:[
-"/ revLine1 := inStream nextLine.]].
-"/ revLine2 := inStream nextLine.
-"/ (revLine1 notNil and:[revLine2 notNil]) ifTrue:[
-"/ record := IdentityDictionary new.
-"/ record at:#revision put:(revLine1 asCollectionOfWords at:2).
-"/ "/ decompose date/author/state etc.
-"/ (revLine2 asCollectionOfSubstringsSeparatedBy:$;) do:[:info |
-"/ |subEntry|
-"/ subEntry := info withoutSeparators.
-"/ #('date:' #date
-"/ 'author:' #author
-"/ 'state:' #state
-"/ 'lines:' #numberOfChangedLines
-"/ ) pairWiseDo:[:word :key |
-"/ s := subEntry restAfter:word withoutSeparators:true.
-"/ s notNil ifTrue:[record at:key put:s.].
-"/ ].
-"/ ].
-"/
-"/ "first revision does not hav a 'lines:' entry"
-"/ (record includesKey:#numberOfChangedLines) ifFalse:[
-"/ record at:#numberOfChangedLines put:''
-"/ ].
-"/
-"/ s := nil.
-"/ line := inStream nextLine.
-"/ [atEnd or:[line isNil or:[line startsWith:'--------']]] whileFalse:[
-"/ (line startsWith:'==========') ifTrue:[
-"/ atEnd := true.
-"/ ] ifFalse:[
-"/ (line withoutSpaces = '.') ifTrue:[
-"/ line := '*** empty log message ***'
-"/ ].
-"/ s isNil ifTrue:[
-"/ s := line
-"/ ] ifFalse:[
-"/ s := s , Character cr asString , line.
-"/ ].
-"/ line := inStream nextLine.
-"/ ]
-"/ ].
-"/ record at:#logMessage put:s.
-"/ revisionRecords add:record.
-"/ ]
- record isNil ifTrue:[
- atEnd := true.
- ] ifFalse:[
- revisionRecords add:record.
- ]
- ].
- ].
- ] ensure:[
- inStream notNil ifTrue:[inStream close].
- tempDir recursiveRemove
- ].
- ^ info
-
- "
- SourceCodeManager revisionLogOf:Array
- SourceCodeManager revisionLogOf:Array fromRevision:'1.40' toRevision:'1.43'
- SourceCodeManager revisionLogOf:Array fromRevision:'1.40' toRevision:nil
- SourceCodeManager revisionLogOf:Array fromRevision:nil toRevision:'1.3'
- SourceCodeManager revisionLogOf:Array fromRevision:nil toRevision:nil
- SourceCodeManager revisionLogOf:Array fromRevision:0 toRevision:0
- "
-
- "Created: / 16.11.1995 / 13:25:30 / cg"
- "Modified: / 29.1.1997 / 16:51:30 / stefan"
- "Modified: / 27.8.1998 / 12:40:59 / cg"
-!
-
-revisionLogOf:clsOrNil numberOfRevisions:numRevisions fileName:classFileName directory:packageDir module:moduleDir
- "return info about the repository container and
- (part of) the revisionlog (numRevisions newest revisions)
- 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 (nil for all)
- #revisions -> collection of per-revision info (see below)
-
- rev1 / rev2 specify from which revisions a logEntry is wanted:
- -If rev1 is nil, the first revision is the initial revision
- otherwise, the log starts with that revision.
- -If rev2 is nil, the last revision is the newest revision
- otherwise, the log ends with that revision.
-
- -If both are nil, all logEntries are extracted.
- -If both are 0 (not nil), no logEntries are extracted (i.e. only the header).
-
- 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
- #logMessage -> the checkIn log message
-
- revisions are ordered newest first
- (i.e. the last entry is for the initial revision; the first for the most recent one)
- "
-
- |tempDir fullName modulePath inStream inHeaderInfo atEnd line revArg idx
- info record revisionRecords s msg|
-
- modulePath := moduleDir , '/' , packageDir.
- fullName := modulePath , '/' , classFileName.
- tempDir := self createTempDirectory:nil forModule:nil.
- tempDir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
- ^ nil.
- ].
-
- [
- self createEntryFor:fullName
- module:moduleDir
- in:(tempDir construct:modulePath)
- revision:'1.1'
- date:'dummy'
- special:''
- overwrite:false.
-
- revArg := ''.
-
- msg := 'reading revision log '.
- clsOrNil isNil ifTrue:[
- msg := msg , 'in ' , fullName.
- ] ifFalse:[
- msg := msg , 'of ', clsOrNil name.
- ].
- self activityNotification:msg.
-
- inStream := self
- executeCVSCommand:('log ' , revArg , ' ' , fullName)
- module:moduleDir
- inDirectory:tempDir
- log:true
- pipe:true.
-
- inStream isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
- ^ nil
- ].
-
- "/
- "/ read the commands pipe output and extract the container info
- "/
- info := IdentityDictionary new.
- inHeaderInfo := true.
- [inHeaderInfo and:[inStream atEnd not]] whileTrue:[
- line:= inStream nextLine.
- line notNil ifTrue:[
- |gotIt|
-
- gotIt := false.
- #('RCS file:' #container
- 'Working file:' #filename
- 'head:' #newestRevision
- 'total revisions:' #numberOfRevisions
- ) pairWiseDo:[:word :key |
- gotIt ifFalse:[
- s := line restAfter:word withoutSeparators:true.
- s notNil ifTrue:[info at:key put:s. gotIt := true].
- ]
- ].
- gotIt ifFalse:[
- (line startsWith:'description:') ifTrue:[inHeaderInfo := false].
- ]
- ]
- ].
- inStream nextLine. "/ skip separating line after description.
-
- info isEmpty ifTrue:[
- ('CVSSourceCodeManager [warning]: no log for ', fullName) errorPrintCR.
- ^ nil
- ].
-
- "/ strip selected revisions from the total-revisions entry
- s := info at:#numberOfRevisions.
- (idx := s indexOf:$;) ~~ 0 ifTrue:[
- info at:#numberOfRevisions put:(Integer readFrom:(s copyTo:idx - 1))
- ] ifFalse:[
- info at:#numberOfRevisions put:(Integer readFrom:s onError:[1])
- ].
-
- "/
- "/ continue to read the commands pipe output
- "/ and extract revision-info records
- "/
- revisionRecords := OrderedCollection new:(info at:#numberOfRevisions).
- info at:#revisions put:revisionRecords.
-
- atEnd := false.
- [atEnd or:[inStream atEnd]] whileFalse:[
- record := self readRevisionLogEntryFromStream:inStream.
- record isNil ifTrue:[
- atEnd := true.
- ] ifFalse:[
- revisionRecords add:record.
- ].
- (numRevisions notNil and:[revisionRecords size >= numRevisions]) ifTrue:[
- atEnd := true
- ]
- ].
- ] ensure:[
- inStream notNil ifTrue:[inStream shutDown "close"].
- tempDir recursiveRemove
- ].
- ^ info
-
- "
- SourceCodeManager revisionLogOf:Array
- SourceCodeManager revisionLogOf:Array numberOfRevisions:5
-
- "
-!
-
-statusOf:clsOrNil fileName:classFileName directory:packageDir module:moduleDir
- "return info about the status repository container.
- Return nil on failure.
-
- The returned information is a structure (IdentityDictionary)
- filled with:
- #newestRevision -> the revisionString of the newest revision
-
- This is much faster than revisionLog info (especially, if there are many revisions),
- and all we need is a classes newest version number.
- "
-
- |tempDir fullName modulePath inStream line
- info s msg|
-
- modulePath := moduleDir , '/' , packageDir.
- fullName := modulePath , '/' , classFileName.
- tempDir := self createTempDirectory:nil forModule:nil.
- tempDir isNil ifTrue:[
- ('CVSSourceCodeManager [error]: no tempDir - cannot extract log') errorPrintCR.
- ^ nil.
- ].
-
- [
- self createEntryFor:fullName
- module:moduleDir
- in:(tempDir construct:modulePath)
- revision:'1.1'
- date:'dummy'
- special:''
- overwrite:false.
-
- msg := 'fetching status info of '.
- clsOrNil isNil ifTrue:[
- msg := msg , fullName.
- ] ifFalse:[
- msg := msg , clsOrNil name.
- ].
- self activityNotification:msg.
-
- inStream := self
- executeCVSCommand:('status ' , fullName)
- module:moduleDir
- inDirectory:tempDir
- log:true
- pipe:true.
-
- inStream isNil ifTrue:[
- ('CVSSourceCodeManager [error]: cannot open pipe to cvs log ', fullName) errorPrintCR.
- ^ nil
- ].
-
- "/
- "/ read the commands pipe output and extract the container info
- "/
- info := IdentityDictionary new.
- [inStream atEnd] whileFalse:[
- line:= inStream nextLine.
- line notNil ifTrue:[
- line := line withoutSeparators.
- ].
- line size > 0 ifTrue:[
- |gotIt i|
-
- gotIt := false.
- #(
- 'Repository revision:' #newestRevision
- ) pairWiseDo:[:word :key |
- gotIt ifFalse:[
- s := line restAfter:word withoutSeparators:true.
- s notNil ifTrue:[
- i := s indexOfSeparator.
- i ~~ 0 ifTrue:[
- s := s copyTo:i-1
- ].
- info at:key put:s.
- gotIt := true.
- ].
- ]
- ].
- ]
- ].
- info isEmpty ifTrue:[
- ('CVSSourceCodeManager [warning]: no status for ', fullName) errorPrintCR.
- ^ nil
- ].
- ] ensure:[
- inStream notNil ifTrue:[inStream close].
- tempDir recursiveRemove
- ].
- ^ info
-
- "
- SourceCodeManager statusOf:Array
- SourceCodeManager statusOf:Array fileName:'Array.st' directory:'libbasic' module:'stx'
- SourceCodeManager statusOf:Filename fileName:'Filename.st' directory:'libbasic' module:'stx'
- SourceCodeManager statusOf:NewSystemBrowser fileName:'NewSystemBrowser.st' directory:'libtool' module:'stx'
- "
-! !
-
-!CVSSourceCodeManager class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libbasic3/CVSSourceCodeManager.st,v 1.278 2003-11-18 14:40:49 cg Exp $'
-! !
CVSSourceCodeManager initialize!