hg/stx-libbasic: comparison PipeStream.st

equal deleted inserted replaced

-:260a66f9f4e2
+:1fcf6dfb6004
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 NonPositionableExternalStream subclass:#PipeStream
-	instanceVariableNames:'commandString pid exitStatus exitSema'
+	instanceVariableNames:'commandString pid exitStatus exitSema exitAction'
 	classVariableNames:'BrokenPipeSignal'
 	poolDictionaries:''
 	category:'Streams-External'
 !
 "
 Pipestreams allow reading or writing from/to a unix command.
 For example, to get a stream reading the output of an 'ls -l'
 command, a PipeStream can be created with:
-PipeStream readingFrom:'ls -l'
+	PipeStream readingFrom:'ls -l'
 the characters of the commands output can be read using the
 standard stream messages as next, nextLine etc.
 If a writing pipeStream is written to, after the command has finished,
 UNIX will generate an error-signal (SIGPIPE), which will raise the BrokenPipeSignal.
 Thus, to handle this condition correctly, the following code is suggested:
-|p|
+	|p|
-p := PipeStream writingTo:'echo hello'.
+	p := PipeStream writingTo:'echo hello'.
-PipeStream brokenPipeSignal handle:[:ex |
+	PipeStream brokenPipeSignal handle:[:ex |
-'broken pipe' printNewline.
+	    'broken pipe' printNewline.
-p shutDown.
+	    p shutDown.
-ex return
+	    ex return
-] do:[
+	] do:[
-p nextPutLine:'oops'.
+	    p nextPutLine:'oops'.
-'after write' printNewline.
+	   'after write' printNewline.
-p close.
+	    p close.
-'after close' printNewline
+	   'after close' printNewline
-]
+	]
 Notice, that iff the Stream is buffered, the Signal may occur some time after
 the write - or even at close time; to avoid a recursive signal in the exception
 handler, a #shutDown is useful there; if you use close in the handler, this would
 try to send any buffered output to the pipe, leading to another brokenPipe exception.
 Currently, no filtering pipeStreams (i.e. both reading AND writing) are provided.
 However, if you look at how things are setup, this can be implemented using the
 low level primitives #mapePipe and #executeCommand from the OS class protocol.
 [author:]
-Claus Gittinger
+	Claus Gittinger
 [see also:]
 	ExternalStream FileStream Socket
 	OperatingSystem
 "
 	BrokenPipeSignal nameClass:self message:#brokenPipeSignal.
 	BrokenPipeSignal notifierString:'write on a pipe with no one to read'.
 ]
 ! !
+!PipeStream class methodsFor:'helpers'!
+createCOMFileForVMSCommands:aCollectionOfCommandStrings
+"since DCL seems to not support multiple commands in one
+line, create a temporary COM file for them and let DCL
+execute that one.
+A kludge around a poor CLI design."
+|tmpComFile s|
+tmpComFile := Filename newTemporary withSuffix:'COM'.
+s := tmpComFile writeStream.
+aCollectionOfCommandStrings do:[:aCommand |
+	s nextPutAll:'$'.
+	s nextPutAll:aCommand.
+	s nextPut:(Character nl).
+].
+s close.
+^ tmpComFile.
+!
+createCOMFileForVMSCommand:aCommandString in:aDirectory
+"since DCL seems to not support multiple commands in one
+line, create a temporary COM file for a set def, followed
+by the actual command string.
+A kludge around a poor CLI design."
+^ self
+	createCOMFileForVMSCommands:(Array
+					with:('$set def ' , aDirectory asFilename pathName asFilename osNameForDirectory)
+					with:('$' , aCommandString)).
+! !
 !PipeStream class methodsFor:'instance creation'!
 readingFrom:commandString
 "create and return a new pipeStream which can read from the unix command
 given by command."
 ^ (self basicNew) readingFrom:commandString
 "unix:
-PipeStream readingFrom:'ls -l'.
+	PipeStream readingFrom:'ls -l'.
 "
 "
-p := PipeStream readingFrom:'ls -l'.
+	p := PipeStream readingFrom:'ls -l'.
 	Transcript showCR:p nextLine.
 	p close
 "
 "
-|s|
+	|s|
-s := PipeStream readingFrom:'sh -c sleep\ 600'.
+	s := PipeStream readingFrom:'sh -c sleep\ 600'.
-(Delay forSeconds:2) wait.
+	(Delay forSeconds:2) wait.
-s shutDown
+	s shutDown
 "
 "vms:
 	PipeStream readingFrom:'dir'.
 "
 "
-|p|
+	|p|
 	p := PipeStream readingFrom:'dir'.
 	Transcript showCR:p nextLine.
 	p close
 "
 "msdos:
 	PipeStream readingFrom:'dir'.
 "
 "
-|p|
+	|p|
 	p := PipeStream readingFrom:'dir'.
 	Transcript showCR:p nextLine.
 	p close
 "
 "Modified: 24.4.1996 / 09:09:25 / stefan"
 !
+readingFrom:commandString inDirectory:aDirectory
+"similar to #readingFrom, but changes the directory while
+executing the command. Use this if a command is to be
+executed in another directory, to avoid any OS dependencies
+in your code."
+|cmd tmpComFile pipe|
+(OperatingSystem platformName == #vms) ifTrue:[
+	tmpComFile := self createCOMFileForVMSCommand:commandString in:aDirectory.
+	cmd := '@' , tmpComFile osName.
+	pipe := self readingFrom:cmd.
+	pipe notNil ifTrue:[
+	    pipe exitAction:[tmpComFile delete].
+	].
+	^ pipe
+].
+"/ unix - prepend a 'cd' to the command
+cmd := 'cd ' , aDirectory asFilename pathName, '; ' , commandString.
+^ self readingFrom:cmd
+!
 writingTo:commandString
 "create and return a new pipeStream which can write to the unix command
 given by command."
 ^ (self basicNew) writingTo:commandString
 "unix:
-PipeStream writingTo:'sort'
+	 PipeStream writingTo:'sort'
 "
+!
+writingTo:commandString inDirectory:aDirectory
+"similar to #writingTo, but changes the directory while
+executing the command. Use this if a command is to be
+executed in another directory, to avoid any OS dependencies
+in your code."
+|cmd tmpComFile pipe|
+(OperatingSystem platformName == #vms) ifTrue:[
+	tmpComFile := self createCOMFileForVMSCommand:commandString in:aDirectory.
+	cmd := '@' , tmpComFile osName.
+	pipe := self writingTo:cmd.
+	pipe notNil ifTrue:[
+	    pipe exitAction:[tmpComFile delete].
+	].
+	^ pipe
+].
+"/ unix - prepend a 'cd' to the command
+cmd := 'cd ' , aDirectory asFilename pathName, '; ' , commandString.
+^ self writingTo:cmd
 ! !
 !PipeStream class methodsFor:'Signal constants'!
 brokenPipeSignal
 "low level close
 This waits for the command to finish.
 Use shutDown for a fast (nonBlocking) close."
 filePointer notNil ifTrue:[
-super closeFile.
+	super closeFile.
-filePointer := nil.
+	filePointer := nil.
-pid notNil ifTrue:[
+	pid notNil ifTrue:[
 	    [
-pid notNil ifTrue:[
+		pid notNil ifTrue:[
-exitSema wait.
+		    exitSema wait.
 		]
 	    ] valueUninterruptably
-].
+	].
 ].
 !
 closeFileDescriptor
 "alternative very low level close
 This closes the underlying OS-fileDescriptor
 - and will NOT write any buffered data to the stream.
 You have been warned."
-%{  /* NOCONTEXT */
+|action|
+%{
 #if !defined(transputer) && !defined(MSDOS_LIKE)
 OBJ fp;
 FILE *f;
 if ((fp = __INST(filePointer)) != nil) {
 	__BEGIN_INTERRUPTABLE__
 	close(fileno(f));
 	__END_INTERRUPTABLE__
 }
 #endif /* not transputer && not MSDOS_LIKE */
-%}
+%}.
+exitAction notNil ifTrue:[
+	action := exitAction.
+	exitAction := nil.
+	action value.
+]
 !
 disposed
 "redefined to avoid blocking in close."
 shutDown
 "close the Stream, ignoring any broken-pipe errors.
 Terminate the command"
 BrokenPipeSignal catch:[
-|tpid|
+	|tpid|
-Lobby unregister:self.
+	Lobby unregister:self.
-self closeFileDescriptor.
+	self closeFileDescriptor.
-tpid := pid.                    "copy pid to avoid race"
+	tpid := pid.                    "copy pid to avoid race"
-tpid notNil ifTrue:[
+	tpid notNil ifTrue:[
-"/
+	    "/
-"/ Terminate both the process and group, just in case the
+	    "/ Terminate both the process and group, just in case the
-"/ operating system does not support process groups.
+	    "/ operating system does not support process groups.
-"/
+	    "/
-OperatingSystem terminateProcess:tpid.
+	    OperatingSystem terminateProcess:tpid.
-OperatingSystem terminateProcessGroup:tpid.
+	    OperatingSystem terminateProcessGroup:tpid.
-pid := nil.
+	    pid := nil.
-].
+	].
 ]
 "Modified: 23.5.1996 / 09:15:41 / stefan"
 ! !
 !PipeStream methodsFor:'private'!
+exitAction:aBlock
+"define a block to be evaluated when the pipe is closed.
+This is only used with VMS, to remove any temporary COM file.
+(see readingFrom:inDirectory:)"
+exitAction := aBlock
+!
 openPipeFor:aCommandString withMode:mode
 "open a pipe to the unix command in commandString;
 mode may be 'r' or 'w'"
 |blocked pipeFdArray execFdArray execFd myFd
 osType shellPath shellArgs closeFdArray mbx mbxName|
 filePointer notNil ifTrue:[
-"the pipe was already open ...
+	"the pipe was already open ...
-this should (can) not happen."
+	 this should (can) not happen."
-^ self errorOpen
+	^ self errorOpen
 ].
 lastErrorNumber := nil.
 exitStatus := nil.
 exitSema := Semaphore new name:'pipe exitSema'.
 osType := OperatingSystem platformName.
 osType == #vms ifTrue:[
-mbx := OperatingSystem createMailBox.
+	mbx := OperatingSystem createMailBox.
 	mbx isNil ifTrue:[
 	    lastErrorNumber := OperatingSystem currentErrorNumber.
 	    ^ self openError
 	].
-'mailBox is ' print. mbx printCR.
+	mbxName := OperatingSystem mailBoxNameOf:mbx.
+'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
 	shellPath := ''.
 	shellArgs := aCommandString.
 	mode = 'r' ifTrue:[
 	    execFdArray := Array with:0 with:mbx with:2.
 	] ifFalse:[
 	    execFdArray := Array with:mbx with:1 with:2.
 	].
 	closeFdArray := nil.
 ] ifFalse:[
-pipeFdArray := OperatingSystem makePipe.
+	pipeFdArray := OperatingSystem makePipe.
-pipeFdArray isNil ifTrue:[
+	pipeFdArray isNil ifTrue:[
-lastErrorNumber := OperatingSystem currentErrorNumber.
+	    lastErrorNumber := OperatingSystem currentErrorNumber.
-^ self openError
+	    ^ self openError
 	].
-osType == #unix ifTrue:[
+	osType == #unix ifTrue:[
 	    shellPath := '/bin/sh'.
 	    shellArgs := Array with:'sh' with:'-c' with:aCommandString.
-] ifFalse:[
+	] ifFalse:[
-osType == #win32 ifTrue:[
+	    osType == #win32 ifTrue:[
-	        shellPath := 'C:\WINNT\System32\cmd /c'.
+		shellPath := 'C:\WINNT\System32\cmd /c'.
-	        shellArgs := aCommandString.
+		shellArgs := aCommandString.
 	    ] ifFalse:[
 		OperatingSystem closeFd:execFd; closeFd:myFd.
 		"/
 		"/ dont know how to do it ...
 		"/
-^ self openError
+		^ self openError
 	    ]
 	].
-mode = 'r' ifTrue:[
+	mode = 'r' ifTrue:[
-execFd := pipeFdArray at:2.
+	    execFd := pipeFdArray at:2.
-execFdArray := Array with:0 with:execFd with:2.
+	    execFdArray := Array with:0 with:execFd with:2.
-myFd := pipeFdArray at:1.
+	    myFd := pipeFdArray at:1.
-] ifFalse:[
+	] ifFalse:[
-execFd := pipeFdArray at:1.
+	    execFd := pipeFdArray at:1.
-execFdArray := Array with:execFd with:1 with:2.
+	    execFdArray := Array with:execFd with:1 with:2.
-myFd := pipeFdArray at:2.
+	    myFd := pipeFdArray at:2.
-].
+	].
 	closeFdArray := Array with:myFd.
 ].
 "/ must block here, to avoid races due to early finishing
 blocked := OperatingSystem blockInterrupts.
 pid := Processor
 	       monitor:[
-	          OperatingSystem
+		  OperatingSystem
 		      exec:shellPath
-withArguments:shellArgs
+		      withArguments:shellArgs
-fileDescriptors:execFdArray
+		      fileDescriptors:execFdArray
 		      closeDescriptors:closeFdArray
-fork:true
+		      fork:true
 		      newPgrp:true.
 	       ]
 	       action:[:status |
-status stillAlive ifFalse:[
+		  status stillAlive ifFalse:[
 		      exitStatus := status.
-pid := nil.
+		      pid := nil.
-exitSema signal.
+		      exitSema signal.
-	          ].
+		  ].
-].
+	       ].
 (osType ~~ #vms) ifTrue:[
-OperatingSystem closeFd:execFd.
+	OperatingSystem closeFd:execFd.
 ].
 pid notNil ifTrue:[
-(osType == #win32) ifTrue:[
+	(osType == #win32) ifTrue:[
-self setFileHandle:myFd mode:mode
+	    self setFileHandle:myFd mode:mode
 	] ifFalse:[
 	    (osType == #vms) ifTrue:[
 		"/
 		"/ reopen the mailbox as a file ...
 		"/
-	        mbxName := OperatingSystem mailBoxNameOf:mbx.
+		mbxName := OperatingSystem mailBoxNameOf:mbx.
 		mbxName notNil ifTrue:[
 		    super open:mbxName withMode:mode
 		].
 	    ] ifFalse:[
-self setFileDescriptor:myFd mode:mode.
+		self setFileDescriptor:myFd mode:mode.
 	    ]
 	]
 ] ifFalse:[
-lastErrorNumber := OperatingSystem currentErrorNumber.
+	lastErrorNumber := OperatingSystem currentErrorNumber.
-osType ~~ #vms ifTrue:[
+	osType ~~ #vms ifTrue:[
-OperatingSystem closeFd:myFd.
+	    OperatingSystem closeFd:myFd.
 	] ifFalse:[
 	    OperatingSystem destroyMailBox:mbx
 	].
 ].
 blocked ifFalse:[
-OperatingSystem unblockInterrupts
+	OperatingSystem unblockInterrupts
 ].
 lastErrorNumber notNil ifTrue:[
-"
+	"
-the pipe open failed for some reason ...
+	 the pipe open failed for some reason ...
-... this may be either due to an invalid command string,
+	 ... this may be either due to an invalid command string,
-or due to the system running out of memory (when forking
+	 or due to the system running out of memory (when forking
-the unix process)
+	 the unix process)
-"
+	"
-^ self openError
+	^ self openError
 ].
 commandString := aCommandString.
 %{
 /* LINUX stdio is corrupt here ... */
 ! !
 !PipeStream class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.58 1997-09-22 19:05:40 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.59 1997-09-22 19:38:56 cg Exp $'
 ! !
 PipeStream initialize!

changeset 2969	1fcf6dfb6004
parent 2966	856dfc8a294a
child 2970	f846e7c1962c