'From Squeak3.8beta of ''22 October 2004'' [latest update: #6375] on 16 November 2004 at 7:24:19 pm'! "Change Set: socketStreamEnh-mir Date: 16 November 2004 Author: MIchael Rueger, Luciano Notarfrancesco, miso This change set adds support for binary and ascii modes in SocketStreams, and implements the methods nextAvailable and nextAvailable:. Based on a suggestion by miso upToAll: was optimized. SocketStream is now a subclass of PositionableStream, allowing it to use all the data reading methods. Also undoes update 6366Socket."! PositionableStream subclass: #SocketStream instanceVariableNames: 'socket inStream outStream timeout autoFlush buffered bufferSize binary ' classVariableNames: '' poolDictionaries: '' category: 'Network-Kernel'! !PositionableStream methodsFor: 'positioning' stamp: 'mir 6/29/2004 17:35'! positionOfSubCollection: subCollection "Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position. If no such match is found, answer 0." ^self positionOfSubCollection: subCollection ifAbsent: [0]! ! !PositionableStream methodsFor: 'positioning' stamp: 'mir 6/29/2004 17:34'! positionOfSubCollection: subCollection ifAbsent: exceptionBlock "Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position. If no such match is found, answer the result of evaluating argument, exceptionBlock." | pattern startPosition currentPosition | pattern _ ReadStream on: subCollection. startPosition := self position. [pattern atEnd] whileFalse: [self atEnd ifTrue: [^exceptionBlock value]. self next = pattern next ifFalse: [pattern reset]]. currentPosition := self position. self position: startPosition. ^pattern atEnd ifTrue: [currentPosition - subCollection size] ifFalse: [exceptionBlock value]! ! !SocketStream methodsFor: 'stream in' stamp: 'len 7/19/2003 18:03'! nextAvailable "Answer all the data currently available." self inStream atEnd ifFalse: [^ self inStream upToEnd]. self isDataAvailable ifTrue: [self receiveData]. ^self inStream upToEnd! ! !SocketStream methodsFor: 'stream in' stamp: 'len 7/24/2003 14:36'! nextAvailable: howMany "Answer howMany bytes of data at most, otherwise answer as many as available." self inStream atEnd ifFalse: [^ self inStream next: howMany]. self isDataAvailable ifTrue: [self receiveData]. ^self inStream next: howMany! ! !SocketStream methodsFor: 'stream in' stamp: 'mir 11/16/2004 11:57'! upTo: delim | resultStream nextChar | resultStream _ WriteStream on: (self streamBuffer: 100). [(nextChar _ self next) = delim] whileFalse: [ nextChar ifNil: [^resultStream contents] ifNotNil: [resultStream nextPut: nextChar]]. ^resultStream contents! ! !SocketStream methodsFor: 'stream in' stamp: 'mir 6/29/2004 18:37'! upToAll: delims "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aCollection. If aCollection is not in the stream, answer the entire rest of the stream." "Optimized version using the positionOfSubCollection:. Based on a suggestion by miso" | searchBuffer index nextStartOfSearch currentContents | searchBuffer _ ReadWriteStream on: (String new: 1000). [nextStartOfSearch _ (searchBuffer position - delims size) max: 0. searchBuffer nextPutAll: self inStream upToEnd. self resetInStream. searchBuffer position: nextStartOfSearch. index _ searchBuffer positionOfSubCollection: delims. index = 0 and: [self atEnd not]] whileTrue: [self receiveData]. currentContents := searchBuffer contents. ^index = 0 ifTrue: [currentContents] ifFalse: [ self pushBack: (currentContents copyFrom: index + delims size + 1 to: currentContents size). currentContents copyFrom: 1 to: (0 max: index-1)]! ! !SocketStream methodsFor: 'stream in' stamp: 'mir 11/16/2004 11:58'! upToEnd "Answer a subcollection from the current access position through the last element of the receiver." | resultStream | resultStream _ WriteStream on: (self streamBuffer: 100). [resultStream nextPutAll: self inStream upToEnd. self atEnd not or: [self isDataAvailable]] whileTrue: [self receiveData]. ^resultStream contents! ! !SocketStream methodsFor: 'testing' stamp: 'mir 12/22/2003 15:38'! isBinary ^binary! ! !SocketStream methodsFor: 'accessing' stamp: 'mir 12/22/2003 15:38'! ascii binary := false! ! !SocketStream methodsFor: 'accessing' stamp: 'mir 1/3/2004 14:51'! binary binary := true. self resetInStream. self resetOutStream! ! !SocketStream methodsFor: 'initialize-release' stamp: 'mir 12/22/2003 15:37'! initialize buffered := true. autoFlush := true. binary := false! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/3/2004 15:06'! inStream inStream ifNil: [inStream _ ReadStream on: (self streamBuffer: 0)]. ^inStream! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/3/2004 14:53'! outStream outStream ifNil: [outStream _ WriteStream on: (self streamBuffer: self bufferSize)]. ^outStream! ! !SocketStream methodsFor: 'private' stamp: 'len 7/19/2003 12:00'! pushBack: aStringOrByteArray inStream _ ReadStream on: (aStringOrByteArray , self inStream contents)! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/7/2004 18:12'! receiveData | buffer bytesRead | buffer _ self streamBuffer: self bufferSize. bytesRead := self shouldTimeout ifTrue: [self socket receiveDataTimeout: self timeout into: buffer] ifFalse: [self socket receiveDataInto: buffer]. bytesRead > 0 ifTrue: [ inStream := ReadStream on: (self inStream upToEnd , (buffer copyFrom: 1 to: bytesRead))]! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/8/2004 00:13'! receiveDataIfAvailable "Only used to check if after dataAvailable on the socket is true that there really are data. See also isDataAvailable" | buffer bytesRead | buffer _ self streamBuffer: 1. bytesRead :=self socket receiveSomeDataInto: buffer. bytesRead > 0 ifTrue: [ inStream := ReadStream on: (self inStream upToEnd , (buffer copyFrom: 1 to: bytesRead))]! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/3/2004 14:50'! streamBuffer ^(self isBinary ifTrue: [String] ifFalse: [ByteArray]) new: self bufferSize! ! !SocketStream methodsFor: 'private' stamp: 'mir 1/3/2004 15:02'! streamBuffer: size ^(self isBinary ifTrue: [ByteArray] ifFalse: [String]) new: size! ! !SocketStream methodsFor: 'stream out' stamp: 'mir 6/3/2004 17:39'! nextPut: char self outStream nextPut: (self isBinary ifTrue: [char asInteger] ifFalse: [char asCharacter]). self checkFlush! ! !SocketStream methodsFor: 'stream out' stamp: 'mir 6/18/2004 14:17'! nextPutAll: aCollection self outStream nextPutAll: (self isBinary ifTrue: [aCollection asByteArray] ifFalse: [aCollection asString]). self checkFlush! ! PositionableStream subclass: #SocketStream instanceVariableNames: 'socket inStream outStream timeout autoFlush buffered bufferSize binary' classVariableNames: '' poolDictionaries: '' category: 'Network-Kernel'! Socket removeSelector: #getData! Socket removeSelector: #getObject! Socket removeSelector: #sendObject:! Socket removeSelector: #waitForConnectionUntil:! Socket removeSelector: #waitForDataUntil:! Socket removeSelector: #waitForDisconnectionUntil:! Socket removeSelector: #waitForSendDoneUntil:! !Socket reorganize! ('initialize-destroy' acceptFrom: destroy initialize: initializeNetwork) ('accessing' address localAddress localPort peerName port primitiveOnlySupportsOneSemaphore readSemaphore remoteAddress remotePort semaphore socketHandle writeSemaphore) ('queries' dataAvailable isConnected isOtherEndClosed isThisEndClosed isUnconnected isUnconnectedOrInvalid isValid isWaitingForConnection sendDone socketError statusString) ('connection open/close' accept close closeAndDestroy closeAndDestroy: connectNonBlockingTo:port: connectTo:port: connectTo:port:waitForConnectionFor: connectToHostNamed:port: disconnect listenOn: listenOn:backlogSize: listenOn:backlogSize:interface:) ('receiving' discardReceivedData receiveAvailableData receiveAvailableDataInto: receiveAvailableDataInto:startingAt: receiveData receiveDataInto: receiveDataInto:startingAt: receiveDataTimeout: receiveDataTimeout:into: receiveDataTimeout:into:startingAt: receiveDataWithTimeout receiveDataWithTimeoutInto: receiveDataWithTimeoutInto:startingAt: receiveSomeData receiveSomeDataInto: receiveSomeDataInto:startingAt:) ('sending' sendData: sendData:count: sendSomeData: sendSomeData:startIndex: sendSomeData:startIndex:count: sendStreamContents: sendStreamContents:checkBlock:) ('waiting' waitForAcceptFor: waitForAcceptFor:ifTimedOut: waitForConnectionFor: waitForConnectionFor:ifTimedOut: waitForData waitForDataFor: waitForDataFor:ifClosed:ifTimedOut: waitForDataIfClosed: waitForDisconnectionFor: waitForSendDoneFor:) ('primitives' primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex: primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: primSocket:connectTo:port: primSocket:getOption: primSocket:listenOn: primSocket:listenOn:backlogSize: primSocket:listenOn:backlogSize:interface: primSocket:receiveDataInto:startingAt:count: primSocket:receiveUDPDataInto:startingAt:count: primSocket:sendData:startIndex:count: primSocket:sendUDPData:toHost:port:startIndex:count: primSocket:setOption:value: primSocket:setPort: primSocketAbortConnection: primSocketCloseConnection: primSocketConnectionStatus: primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: primSocketDestroy: primSocketDestroyGently: primSocketError: primSocketLocalAddress: primSocketLocalPort: primSocketReceiveDataAvailable: primSocketRemoteAddress: primSocketRemotePort: primSocketSendDone:) ('registry' register unregister) ('finalization' finalize) ('printing' printOn:) ('datagrams' receiveDataInto:fromHost:port: receiveUDPDataInto: sendData:toHost:port: sendUDPData:toHost:port: setPeer:port: setPort:) ('other' getOption: setOption:value:) !