Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
PipeStream.st
branchjv
changeset 18786 237a87b4fe8f
parent 18640 358b275dced9
parent 18785 5b58b205c252
child 19863 513bd7237fe7 
--- a/PipeStream.st	Wed Sep 30 07:05:15 2015 +0200
+++ b/PipeStream.st	Thu Oct 01 06:52:24 2015 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
@@ -220,7 +218,7 @@
 	|p|
 
 	p := PipeStream bidirectionalFor:'cat -u'.
-	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
+	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
 	Transcript showCR:p nextLine.
 	p close
     "
@@ -488,13 +486,14 @@
 shutDown
     "close the Stream and terminate the command"
 
-    Lobby unregister:self.
+    self unregisterForFinalization
+       "terminate first under windows".
 
     "terminate first under windows"
     OperatingSystem isMSDOSlike ifTrue:[
-	self terminatePipeCommand.
-	self closeFileDescriptor.
-	^ self.
+        self terminatePipeCommand.
+        self closeFileDescriptor.
+        ^ self.
     ].
 
     "terminate last under unix"
@@ -612,17 +611,17 @@
      realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
 
     handle notNil ifTrue:[
-	"the pipe was already open ...
-	 this should (can) not happen."
-	^ self errorAlreadyOpen
+        "the pipe was already open ...
+         this should (can) not happen."
+        ^ self errorAlreadyOpen
     ].
 
     rwMode = #r ifTrue:[
-	mode := #readonly. didWrite := false.
+        mode := #readonly. didWrite := false.
     ] ifFalse:[rwMode = #'r+' ifTrue:[
-	mode := #readwrite. didWrite := true.
+        mode := #readwrite. didWrite := true.
     ] ifFalse:[
-	mode := #writeonly. didWrite := true.
+        mode := #writeonly. didWrite := true.
     ]].
 
     lastErrorNumber := nil.
@@ -634,79 +633,79 @@
     execFdArray := #(0 1 2) copy.
 
     OperatingSystem isVMSlike ifTrue:[
-	"/
-	"/ the generated COM-file includes a 'set default'
-	"/
-	tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
-	realCmd := '@' , tmpComFile osName.
-	execDirectory := nil.
+        "/
+        "/ the generated COM-file includes a 'set default'
+        "/
+        tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
+        realCmd := '@' , tmpComFile osName.
+        execDirectory := nil.
 
-	mbx := OperatingSystem createMailBox.
-	mbx isNil ifTrue:[
-	    lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-	    tmpComFile delete.
-	    ^ self openError:errorNumber.
-	].
-	mbxName := OperatingSystem mailBoxNameOf:mbx.
+        mbx := OperatingSystem createMailBox.
+        mbx isNil ifTrue:[
+            lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+            tmpComFile delete.
+            ^ self openError:errorNumber.
+        ].
+        mbxName := OperatingSystem mailBoxNameOf:mbx.
 
-	"/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
-	shellPath := ''.
-	shellArgs := realCmd.
+        "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
+        shellPath := ''.
+        shellArgs := realCmd.
 
-	rwMode = #r ifTrue:[
-	    "redirect stdout of subprocess to write to mailbox"
-	    execFdArray at:2 put:mbx.
-	] ifFalse:[
-	    "redirect stdin of subprocess to read from mailbox"
-	    execFdArray at:1 put:mbx.
-	].
+        rwMode = #r ifTrue:[
+            "redirect stdout of subprocess to write to mailbox"
+            execFdArray at:2 put:mbx.
+        ] ifFalse:[
+            "redirect stdin of subprocess to read from mailbox"
+            execFdArray at:1 put:mbx.
+        ].
     ] ifFalse:[
-	shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
-	shellPath := shellAndArgs at:1.
-	shellArgs := shellAndArgs at:2.
+        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
+        shellPath := shellAndArgs at:1.
+        shellArgs := shellAndArgs at:2.
 
-	mode == #readwrite ifTrue:[
-	    pipeFdArray := OperatingSystem makeBidirectionalPipe.
-	    pipeFdArray isNil ifTrue:[
-		lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-		^ self openError:errorNumber.
-	    ].
-	    myFd := pipeFdArray at:1.
-	    execFd := pipeFdArray at:2.
-	    execFdArray at:1 put:execFd.
-	    execFdArray at:2 put:execFd.
-	] ifFalse:[
-	    pipeFdArray := OperatingSystem makePipe.
-	    pipeFdArray isNil ifTrue:[
-		lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-		^ self openError:errorNumber.
-	    ].
+        mode == #readwrite ifTrue:[
+            pipeFdArray := OperatingSystem makeBidirectionalPipe.
+            pipeFdArray isNil ifTrue:[
+                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+                ^ self openError:errorNumber.
+            ].
+            myFd := pipeFdArray at:1.
+            execFd := pipeFdArray at:2.
+            execFdArray at:1 put:execFd.
+            execFdArray at:2 put:execFd.
+        ] ifFalse:[
+            pipeFdArray := OperatingSystem makePipe.
+            pipeFdArray isNil ifTrue:[
+                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+                ^ self openError:errorNumber.
+            ].
 
-	    mode == #readonly ifTrue:[
-		"redirect stdout of subprocess to write to pipe"
-		myFd := pipeFdArray at:1.
-		execFd := pipeFdArray at:2.
-		execFdArray at:2 put:execFd.
-	    ] ifFalse:[
-		"redirect stdin of subprocess to read from pipe"
-		myFd := pipeFdArray at:2.
-		execFd := pipeFdArray at:1.
-		execFdArray at:1 put:execFd.
-	    ].
-	].
+            mode == #readonly ifTrue:[
+                "redirect stdout of subprocess to write to pipe"
+                myFd := pipeFdArray at:1.
+                execFd := pipeFdArray at:2.
+                execFdArray at:2 put:execFd.
+            ] ifFalse:[
+                "redirect stdin of subprocess to read from pipe"
+                myFd := pipeFdArray at:2.
+                execFd := pipeFdArray at:1.
+                execFdArray at:1 put:execFd.
+            ].
+        ].
     ].
 
     errorDisposition == #discard ifTrue:[
-	nullOutput := Filename nullDevice writeStream.
-	execFdArray at:3 put:nullOutput fileDescriptor
+        nullOutput := Filename nullDevice writeStream.
+        execFdArray at:3 put:nullOutput fileDescriptor
     ] ifFalse:[
-	(errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
-	    execFdArray at:3 put:1
-	] ifFalse:[
+        (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
+            execFdArray at:3 put:1
+        ] ifFalse:[
 "/            errorDisposition isStream ifTrue:[
 "/self halt.
 "/            ].
-	].
+        ].
     ].
 
     "/ must block here, to avoid races due to early finishing
@@ -716,84 +715,84 @@
 
     "beware: pid may change if subprocess is fast"
     pid := resultPid :=  Processor
-	       monitor:[
-		  OperatingSystem
-		      exec:shellPath
-		      withArguments:shellArgs
-		      environment:nil
-		      fileDescriptors:execFdArray
-		      fork:true
-		      newPgrp:true
-		      inDirectory:execDirectory.
-	       ]
-	       action:[:status |
-		  status stillAlive ifFalse:[
-		      exitStatus := status.
+               monitor:[
+                  OperatingSystem
+                      exec:shellPath
+                      withArguments:shellArgs
+                      environment:nil
+                      fileDescriptors:execFdArray
+                      fork:true
+                      newPgrp:true
+                      inDirectory:execDirectory.
+               ]
+               action:[:status |
+                  status stillAlive ifFalse:[
+                      exitStatus := status.
 
-		      "writing doesn't make sense - there is no reader any longer"
-		      mode == #readwrite ifTrue:[
-			  "... but allow to read the rest of the command's output"
-			  self shutDownOutput.
-		      ] ifFalse:[mode == #writeonly ifTrue:[
-			  self closeFileDescriptor.
-		      ]].
+                      "writing doesn't make sense - there is no reader any longer"
+                      mode == #readwrite ifTrue:[
+                          "... but allow to read the rest of the command's output"
+                          self shutDownOutput.
+                      ] ifFalse:[mode == #writeonly ifTrue:[
+                          self closeFileDescriptor.
+                      ]].
 
-		      OperatingSystem closePid:pid.
-		      pid := nil.
-		      exitSema signal.
-		  ].
-	       ].
+                      OperatingSystem closePid:pid.
+                      pid := nil.
+                      exitSema signal.
+                  ].
+               ].
 
     "subprocess has been created.
      close unused filedescriptors"
 
     execFd notNil ifTrue:[
-	OperatingSystem closeFd:execFd.
+        OperatingSystem closeFd:execFd.
     ].
 
     nullOutput notNil ifTrue:[
-	nullOutput close
+        nullOutput close
     ].
 
     resultPid notNil ifTrue:[
-	"successfull creation of subprocesss"
-	OperatingSystem isVMSlike ifTrue:[
-	    "/
-	    "/ reopen the mailbox as a file ...
-	    "/
-	    mbxName := OperatingSystem mailBoxNameOf:mbx.
-	    mbxName notNil ifTrue:[
-		super open:mbxName withMode:rwMode.
-		exitAction := [tmpComFile delete].
-	    ].
-	] ifFalse:[
-	    self setFileDescriptor:myFd mode:rwMode.
-	    handleType := #pipeFilePointer.
-	]
+        "successfull creation of subprocesss"
+        OperatingSystem isVMSlike ifTrue:[
+            "/
+            "/ reopen the mailbox as a file ...
+            "/
+            mbxName := OperatingSystem mailBoxNameOf:mbx.
+            mbxName notNil ifTrue:[
+                super open:mbxName withMode:rwMode.
+                exitAction := [tmpComFile delete].
+            ].
+        ] ifFalse:[
+            self setFileDescriptor:myFd mode:rwMode.
+            handleType := #pipeFilePointer.
+        ]
     ] ifFalse:[
-	"creation of subprocesss failed"
-	lastErrorNumber := OperatingSystem currentErrorNumber.
-	OperatingSystem isVMSlike ifTrue:[
-	    OperatingSystem destroyMailBox:mbx.
-	    tmpComFile delete.
-	] ifFalse:[
-	    OperatingSystem closeFd:myFd.
-	].
+        "creation of subprocesss failed"
+        lastErrorNumber := OperatingSystem currentErrorNumber.
+        OperatingSystem isVMSlike ifTrue:[
+            OperatingSystem destroyMailBox:mbx.
+            tmpComFile delete.
+        ] ifFalse:[
+            OperatingSystem closeFd:myFd.
+        ].
     ].
 
     blocked ifFalse:[
-	OperatingSystem unblockInterrupts
+        OperatingSystem unblockInterrupts
     ].
 
     (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
-	"
-	 the pipe open failed for some reason ...
-	 ... this may be either due to an invalid command string,
-	 or due to the system running out of memory (when forking
-	 the unix process)
-	"
-	exitAction value.
-	^ self openError:lastErrorNumber.
+        "
+         the pipe open failed for some reason ...
+         ... this may be either due to an invalid command string,
+         or due to the system running out of memory (when forking
+         the unix process)
+        "
+        exitAction value.
+        ^ self openError:lastErrorNumber.
     ].
 
     commandString := realCmd.
@@ -804,7 +803,7 @@
     position := 0.
     hitEOF := false.
     binary := false.
-    Lobby register:self.
+    self registerForFinalization.
 
     "Modified: / 23.4.1996 / 17:05:59 / stefan"
     "Modified: / 28.1.1998 / 14:47:34 / md"
hg/stx-libbasic