Fix for cvs 1.11.6 and following
authorStefan Vogel <sv@exept.de>
Fri, 23 Apr 2004 13:44:38 +0200
changeset 1390 5ca713ed160e
parent 1389 c77b539fc824
child 1391 68432469745f
Fix for cvs 1.11.6 and following
CVSSourceCodeManager.st
--- a/CVSSourceCodeManager.st	Sat Mar 20 16:37:44 2004 +0100
+++ b/CVSSourceCodeManager.st	Fri Apr 23 13:44:38 2004 +0200
@@ -837,6 +837,76 @@
         pipe:false
 !
 
+executeCVSCommand:cvsCommand module:moduleName inDirectory:dirArg log:doLog errorTo:errorStream
+    "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)
+        ]
+    ].
+    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.
+    ].
+
+    Processor isDispatching ifFalse:[
+        rslt := ok := OperatingSystem executeCommand:command 
+                                inputFrom:nil 
+                                outputTo:nil 
+                                errorTo:errorStream 
+                                auxFrom:nil
+                                inDirectory:pathOfDir
+                                lineWise:false
+                                onError:[:status| false].
+    ] ifTrue:[
+        p := [
+            rslt := ok := OperatingSystem executeCommand:command
+                                inputFrom:nil 
+                                outputTo:nil 
+                                errorTo:errorStream 
+                                auxFrom:nil
+                                inDirectory:pathOfDir
+                                lineWise:false
+                                onError:[:status| false].
+        ] 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"
+!
+
 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.
@@ -2491,7 +2561,10 @@
     ].
 
     cmd := '-n rtag -l -F dummy '.
-    [
+    [  
+        |errorStream|
+        errorStream := '' writeStream.
+        
         ret := self 
                     executeCVSCommand:cmd , fullName 
                     module:moduleDir 
@@ -2499,7 +2572,14 @@
                     "/ with a different CVSRoot in its CVS/Root file ...
                     "/ cvs would complain then.
                     inDirectory:(tempDir pathName) 
-                    log:false.
+                    log:false
+                    errorTo:errorStream.
+
+        "cannot check for exit status starting at cvs 1.11.5, because an exit status 0
+         is returned even if the file does not exist"
+
+        "But: if there is any output, the command failed and the container does not exist"
+        ret := errorStream size == 0.
     ] ensure:[
         tempDir recursiveRemove.
     ].
@@ -4378,7 +4458,7 @@
 !CVSSourceCodeManager class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/CVSSourceCodeManager.st,v 1.284 2004-03-20 15:27:16 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/CVSSourceCodeManager.st,v 1.285 2004-04-23 11:44:38 stefan Exp $'
 ! !
 
 CVSSourceCodeManager initialize!