SystemOrganization addCategory: #'FS-Memory'! !FSFilesystem classSide methodsFor: '*fs-memory' stamp: 'cwp 2/18/2011 23:12'! inMemory ^ self store: (FSMemoryStore new)! ! FSFileStream subclass: #FSMemoryFileStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Memory'! !FSMemoryFileStream commentStamp: 'cwp 11/18/2009 13:04' prior: 0! I am a legacy-compatibility stream. I am protocol compatible with StandardFileStream, but I operate on an in-memory file in a MemoryFilesystem.! !FSMemoryFileStream methodsFor: 'file status' stamp: 'cwp 2/19/2011 01:20'! close store replaceFile: path in: [ :bytes | bytes first: position ] ! ! !FSMemoryFileStream methodsFor: 'private' stamp: 'cwp 2/19/2011 01:20'! growTo: anInteger collection := store growFile: path to: anInteger. writeLimit := collection size! ! !FSMemoryFileStream methodsFor: 'private' stamp: 'cwp 2/19/2011 01:20'! pastEndPut: anObject | oldSize newSize | oldSize := collection size. newSize := oldSize + ((oldSize max: 20) min: 1000000). collection := store growFile: path to: newSize. writeLimit := collection size. collection at: (position := position + 1) put: anObject. ^ anObject! ! FSStore subclass: #FSMemoryStore instanceVariableNames: 'root' classVariableNames: '' poolDictionaries: '' category: 'FS-Memory'! !FSMemoryStore classSide methodsFor: 'public' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ $/! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:08'! basenameFromEntry: association ^ association key! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 4/3/2011 22:16'! basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock filesystem: aFilesystem self nodeAt: source ifPresent: [ :bytes | (self basicIsFile: bytes) ifFalse: [ aBlock value ]. self nodeAt: destination parent ifPresent: [ :dict | (self basicIsDirectory: dict) ifFalse: [ self signalDirectoryDoesNotExist: destination parent ]. (dict includesKey: destination basename) ifTrue: [ pBlock value ]. dict at: destination basename put: bytes copy ] ifAbsent: [ self signalDirectoryDoesNotExist: destination parent ] ] ifAbsent: aBlock! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 13:14'! basicIsDirectory: entry ^ entry isDictionary! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 14:31'! basicIsFile: entry ^ entry isDictionary not! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 4/3/2011 22:17'! basicOpen: path writable: aBoolean ^ self nodeAt: path ifPresent: [ :bytes | bytes ] ifAbsent: [ aBoolean ifFalse: [ self signalFileDoesNotExist: path ] ifTrue: [ self createFile: path ] ]! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 4/3/2011 22:17'! createDirectory: path | parent | parent := path parent. ^ self nodeAt: parent ifPresent: [ :dict | dict at: path basename ifPresent: [ :node | node isDictionary ifTrue: [ self signalDirectoryExists: path ] ifFalse: [ self signalFileExists: path ] ]. dict at: path basename put: Dictionary new ] ifAbsent: [ self signalDirectoryDoesNotExist: parent ]! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 4/3/2011 22:16'! createFile: aPath ^ self nodeAt: aPath parent ifPresent: [ :dict | (self basicIsDirectory: dict) ifTrue: [ dict at: aPath basename put: ByteArray new ] ] ifAbsent: [ self signalDirectoryDoesNotExist: aPath parent ]! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:24'! delete: path self nodeAt: path parent ifPresent: [ :dict | dict removeKey: path basename ] ifAbsent: [ ]! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 13:06'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock ^ self nodeAt: aPath ifPresent: [ :directory | directory isDictionary ifFalse: [ ^ absentBlock value ]. directory associations sorted do: aBlock ] ifAbsent: absentBlock! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 14:46'! entryFromNode: anObject filesystem: aFilesystem path: aPath ^ FSDirectoryEntry filesystem: aFilesystem path: aPath creation: 0 modification: 0 isDir: anObject isDictionary size: (anObject isDictionary ifTrue: [ 0 ] ifFalse: [ anObject size ])! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:53'! entryFromNode: association path: path for: aFilesystem | entryPath | entryPath := path / (self basenameFromEntry: association). ^ self entryFromNode: association value filesystem: aFilesystem path: entryPath! ! !FSMemoryStore methodsFor: 'printing' stamp: 'cwp 2/18/2011 16:32'! forReferencePrintOn: aStream aStream nextPutAll: 'memory:'! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/19/2011 01:02'! growFile: path to: anInteger ^ self replaceFile: path in: [ :bytes | (bytes class new: anInteger) replaceFrom: 1 to: bytes size with: bytes startingAt: 1; yourself ]! ! !FSMemoryStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 16:01'! handleClass ^ FSMemoryHandle ! ! !FSMemoryStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 12:46'! initialize root := Dictionary new! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 12:48'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock | current | current := self root. aPath do: [ :segment | current isDictionary ifTrue: [ current := current at: segment ifAbsent: [ ^ absentBlock value ] ] ifFalse: [ ^ absentBlock value ] ]. ^ presentBlock value: current! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 2/19/2011 01:22'! openFileStream: path writable: anObject | bytes | bytes := self nodeAt: path ifPresent: [ :array | array ] ifAbsent: [ self createFile: path ]. ^ FSMemoryFileStream on: bytes store: self path: path! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 4/3/2011 22:17'! replaceFile: path in: aBlock ^ self nodeAt: path parent ifPresent: [ :dict | | old new | (self basicIsDirectory: dict) ifFalse: [ self signalFileDoesNotExist: path ]. old := dict at: path basename ifAbsent: [ self signalFileDoesNotExist: path ]. new := aBlock value: old. dict at: path basename put: new ] ifAbsent: [ self signalFileDoesNotExist: path ]! ! !FSMemoryStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 12:46'! root ^ root! ! FSHandle subclass: #FSMemoryHandle instanceVariableNames: 'bytes size' classVariableNames: '' poolDictionaries: '' category: 'FS-Memory'! !FSMemoryHandle commentStamp: 'cwp 11/19/2009 00:01' prior: 0! I provide "primitives" for doing IO on files in a FSMemoryFilesystem. I buffer writes until the stream is flushed or closed. ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 7/29/2009 22:07'! at: index ^ bytes at: index! ! !FSMemoryHandle methodsFor: 'public' stamp: 'lr 4/13/2010 16:12'! at: index put: anObject index > bytes size ifTrue: [self grow]. bytes at: index put: (anObject isCharacter ifTrue: [ anObject codePoint ] ifFalse: [ anObject ]). size := size max: index! ! !FSMemoryHandle methodsFor: 'public' stamp: 'lr 2/15/2010 20:54'! at: index read: aCollection startingAt: start count: count | max stop | max := size - index + 1 min: count. stop := start + max - 1. aCollection replaceFrom: start to: stop with: bytes startingAt: index. ^ stop - start + 1! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 1/31/2010 22:39'! at: first write: aCollection startingAt: start count: count | last | writable ifFalse: [ self primitiveFailed ]. last := first + count - 1. last > bytes size ifTrue: [self growTo: last]. bytes replaceFrom: first to: last with: aCollection startingAt: start. size := last! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 7/28/2009 23:10'! close self truncateTo: size. bytes := nil! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 7/29/2009 22:23'! flush self truncateTo: size! ! !FSMemoryHandle methodsFor: 'private' stamp: 'cwp 1/31/2010 22:45'! grow ^ self growTo: bytes size + 1! ! !FSMemoryHandle methodsFor: 'private' stamp: 'cwp 2/19/2011 01:10'! growTo: anInteger | path | path := reference filesystem resolve: reference path. bytes := reference filesystem store growFile: path to: anInteger + self sizeIncrement! ! !FSMemoryHandle methodsFor: 'testing' stamp: 'cwp 7/26/2009 14:08'! isOpen ^ bytes notNil! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 14:26'! open bytes := reference filesystem basicOpen: reference path writable: writable. size := bytes size.! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 14:27'! size ^ size! ! !FSMemoryHandle methodsFor: 'private' stamp: 'cwp 1/31/2010 22:40'! sizeIncrement ^ (bytes size min: 20) max: 1024! ! !FSMemoryHandle methodsFor: 'public' stamp: 'cwp 2/19/2011 00:58'! truncateTo: anInteger | path | path := reference filesystem resolve: reference path. bytes := reference filesystem store replaceFile: path in: [ :all | all first: anInteger ]. size := anInteger! !