[ADDON] Streaming streams

Bert Freudenberg bert at isgnw.CS.Uni-Magdeburg.De
Wed Sep 8 16:27:21 UTC 1999


Since there recently was a discussion about Streams in general ...

One thing that bugs me is that most of the higher level stream methods
aren't really streaming. Positions are used a lot ("self position: self
position - 1"), or loops like "[self atEnd] whileTrue: [...]" which
wouldn't be that bad if the primitive wasn't implemented as comparing the
position to the file size.

The bad thing is that's impossible to incrementally file in code from a
pipe or network socket where the size is not known in advance. You have to
get the whole thing until you can do anything with it. This means you
cannot open a splash screen in the first few lines and get the rest
afterwards.

The good thing is that it's fixable. The very basic functions seem to be
okay. So by exclusively using #next and reading some characters ahead you
can implement file in.

I did a kludge to solve this - a wrapper to other streams that only uses
#next for reading but provides all the other functions necessary for file
in. But IMHO it would be better to make the system as a whole aware of
that issue.

Note that the attached changeset requires the lispy-bf changeset for
implementing the look-ahead buffer.

"Change Set:		StreamingStream-bf
Date:			27 August 1999
Author:			Bert Freudenberg
Requires:		lispy-bf

Allows incremental fileIn operations but reads strictly sequential from
e.g. a pipe. See StreamingStream comment."

Content-Type: TEXT/PLAIN; charset=US-ASCII; name="StreamingStream-bf.8Sept911am.cs"
Content-ID: <Pine.LNX.3.96.990908182721.19041I at balloon.cs.uni-magdeburg.de>
Content-Description: 

'From Squeak 2.5 of August 6, 1999 on 8 September 1999 at 9:11:13 am'!
"Change Set:		StreamingStream-bf
Date:			27 August 1999
Author:			Bert Freudenberg
Requires:		lispy-bf

Allows incremental fileIn operations but read strictly sequential from e.g. a pipe. See StreamingStream comment."!

Object subclass: #StreamingStream
	instanceVariableNames: 'stream lookAhead '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Files'!

!StreamingStream commentStamp: 'bf 9/8/1999 08:30' prior: 0!
This is a kludge to allow file in operations but read strictly sequential from e.g. a pipe or network socket.

For example, to read from a named pipe in Unix:
(1)	In a shell, create the fifo:
		mkfifo /tmp/mypipe
	Copy the command in (3) to your shell, but do not yet execute
(2)	In Squeak, do the file in:
		(StreamingStream on: (FileStream readOnlyFileNamed: '/tmp/mypipe')) fileIn
	This blocks because no data is evailable yet.
	(you won't be able to select the line below)
(3)	In the shell, put some data into the pipe:
		echo "StringHolder new textContents: 'Hello World'; openLabel: 'Piping test'" > /tmp/mypipe
!

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 10:13'!
ascii
	stream ascii! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:40'!
atEnd
	^self peek isNil! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 15:45'!
binary
	stream binary! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:51'!
checkForPreamble: chunk
	^stream checkForPreamble: chunk! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:38'!
close
	stream close! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:35'!
fileIn
	| val chunk |
	[self atEnd] whileFalse: 
		[self skipSeparators.
		val _ (self peekFor: $!!)
			ifTrue: [(Compiler evaluate: self nextChunk logged: false)
				scanFrom: self]
			ifFalse: [chunk _ self nextChunk.
				self checkForPreamble: chunk.
				Compiler evaluate: chunk logged: true].
		self skipStyleChunk].
	self close.
	^val! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 17:02'!
fileInObjectAndCode
	"This file may contain:
1) a fileIn of code  
2) just an object in SmartReferenceStream format 
3) both code and an object.
	File it in and return the object."
	| refStream object |
	self ascii.
	self peek asciiValue = 4
		ifTrue: [  "pure object file"
			refStream _ SmartRefStream on: self.
			object _ refStream nextAndClose]
		ifFalse: [  "objects mixed with a fileIn"
			self fileIn.  "reads code and objects, then closes the file"
			object _ SmartRefStream scannedObject].	"set by side effect of one of the chunks"
	SmartRefStream scannedObject: nil.  "clear scannedObject"
	^ object! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 13:48'!
next
	lookAhead notNil ifTrue: [
		lookAhead listHeadAndTailIn: [:head :tail |
			lookAhead _ tail.
			^head]].
	^stream next! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/8/1999 08:01'!
next: anInteger
    "Answer an Array of the next anInteger objects in the stream."
    | array |
    array _ (stream isBinary ifTrue: [ByteArray] ifFalse: [String]) new: anInteger.
    1 to: anInteger do: [:i |
        array at: i put: self next].
    ^ array! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:50'!
nextChunk
	| terminator out ch |
	terminator _ $!!.
	out _ WriteStream on: (String new: 1000).
	self skipSeparators.
	[(ch _ self next) == nil] whileFalse: [
		(ch == terminator) ifTrue: [
			self peek == terminator ifTrue: [
				self next.  "skip doubled terminator"
			] ifFalse: [
				^ out contents  "terminator is not doubled; we're done!!"
			].
		].
		out nextPut: ch.
	].
	^ out contents! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 09:45'!
nextChunkText
	"Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
	| string runsRaw strm runs |
	"Read the plain text"
	string _ self nextChunk.
	
	"Test for ]style[ tag"
	self skipSeparators.
	self peek = $] ifFalse: [^ string asText].  "no tag"
	(self upTo: $[) = ']style' ifFalse: [^ string asText].  "different tag"

	"Read and decode the style chunk"
	runsRaw _ self nextChunk.	"style encoding"
	strm _ ReadStream on: runsRaw from: 1 to: runsRaw size.
	runs _ RunArray scanFrom: strm.

	^ Text basicNew setString: string setRunsChecking: runs.
! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/8/1999 07:47'!
nextMatchAll: aString
	| ch save |
	save _ OrderedCollection new: aString size.
	aString do: [:each |
		ch _ self next.
		save add: ch.
 		ch == each ifFalse: [
			save reverseDo: [:c | self putBack: c].
			^ false]].
	^ true! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 14:36'!
peek
	lookAhead isNil ifTrue: [^lookAhead _ self next].
	^lookAhead listHead! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 10:13'!
peekFor: aCharacter
	| next |
	(next _ self next) == nil ifTrue: [^ false].
	aCharacter == next ifTrue: [^ true].
	self putBack: next.
	^ false! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/8/1999 07:45'!
putBack: aCharacter
 	"Pushes aCharacter back to stream, where it is available for subsequent read operations. Pushed-back characters will be returned in reverse order."
	lookAhead _ lookAhead listHead: aCharacter! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:23'!
setStream: aStream
	stream _ aStream.
	lookAhead _ nil! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 13:08'!
skipSeparators
	| next |
	[(next _ self next) isNil]
		whileFalse:
		[next isSeparator ifFalse: [^ self putBack: next]]! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:55'!
skipStyleChunk
	"Get to the start of the next chunk that is not a style for the previous chunk"

	self skipSeparators.
	self peek == $] 
		ifTrue: [(self upTo: $[) = ']text' 	"old -- no longer needed"
				"now positioned past the open bracket"
			ifFalse: [self nextChunk]]	"absorb ]style[ and its whole chunk"

! !

!StreamingStream methodsFor: 'all' stamp: 'bf 8/29/1999 12:56'!
upTo: aCharacter
	| newStream char |
	newStream _ WriteStream on: (String new: 100).
	[(char _ self next) isNil or: [char == aCharacter]]
		whileFalse: [newStream nextPut: char].
	^ newStream contents

! !

!StreamingStream methodsFor: 'all' stamp: 'bf 9/3/1999 15:36'!
upToEnd
	"Answer a subcollection from the current access position through the last element of the receiver."

	| newStream ch |
	newStream _ WriteStream on: (String new: 100).
	[(ch _ self next) == nil] whileFalse: [ newStream nextPut: ch ].
	^ newStream contents! !


!StreamingStream class methodsFor: 'instance creation' stamp: 'bf 8/29/1999 12:25'!
on: aStream
	"Open a new StreamingStream onto a low-level I/O stream."
	^ self new setStream: aStream! !





More information about the Squeak-dev mailing list